module_bc_em.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:BOUNDARY
2 !
3 MODULE module_bc_em
4
5 USE module_bc
6 USE module_configure
7 USE module_wrf_error
8
9 CONTAINS
10
11 !------------------------------------------------------------------------
12
13 SUBROUTINE spec_bdyupdate_ph( ph_save, field, &
14 field_tend, mu_tend, muts, dt, &
15 variable_in, config_flags, &
16 spec_zone, &
17 ids,ide, jds,jde, kds,kde, & ! domain dims
18 ims,ime, jms,jme, kms,kme, & ! memory dims
19 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
20 its,ite, jts,jte, kts,kte )
21
22 ! This subroutine adds the tendencies in the boundary specified region.
23 ! spec_zone is the width of the outer specified b.c.s that are set here.
24 ! (JD August 2000)
25
26 IMPLICIT NONE
27
28 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
29 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
30 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
31 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
32 INTEGER, INTENT(IN ) :: spec_zone
33 CHARACTER, INTENT(IN ) :: variable_in
34 REAL, INTENT(IN ) :: dt
35
36
37 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
38 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: field_tend, ph_save
39 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu_tend, muts
40 TYPE( grid_config_rec_type ) config_flags
41
42 CHARACTER :: variable
43 INTEGER :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
44 INTEGER :: b_dist, b_limit
45
46 ! Local array
47
48 REAL, DIMENSION( its:ite , jts:jte ) :: mu_old
49 LOGICAL :: periodic_x
50
51 periodic_x = config_flags%periodic_x
52
53 variable = variable_in
54
55 IF (variable == 'U') variable = 'u'
56 IF (variable == 'V') variable = 'v'
57 IF (variable == 'M') variable = 'm'
58 IF (variable == 'H') variable = 'h'
59
60 ibs = ids
61 ibe = ide-1
62 itf = min(ite,ide-1)
63 jbs = jds
64 jbe = jde-1
65 jtf = min(jte,jde-1)
66 ktf = kde-1
67 IF (variable == 'u') ibe = ide
68 IF (variable == 'u') itf = min(ite,ide)
69 IF (variable == 'v') jbe = jde
70 IF (variable == 'v') jtf = min(jte,jde)
71 IF (variable == 'm') ktf = kte
72 IF (variable == 'h') ktf = kte
73
74 IF (jts - jbs .lt. spec_zone) THEN
75 ! Y-start boundary
76 DO j = jts, min(jtf,jbs+spec_zone-1)
77 b_dist = j - jbs
78 b_limit = b_dist
79 IF(periodic_x)b_limit = 0
80 DO k = kts, ktf
81 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
82
83 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
84
85 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
86 dt*field_tend(i,k,j)/muts(i,j) + &
87 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
88
89 ENDDO
90 ENDDO
91 ENDDO
92 ENDIF
93 IF (jbe - jtf .lt. spec_zone) THEN
94 ! Y-end boundary
95 DO j = max(jts,jbe-spec_zone+1), jtf
96 b_dist = jbe - j
97 b_limit = b_dist
98 IF(periodic_x)b_limit = 0
99 DO k = kts, ktf
100 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
101
102 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
103
104 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
105 dt*field_tend(i,k,j)/muts(i,j) + &
106 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
107
108 ENDDO
109 ENDDO
110 ENDDO
111 ENDIF
112
113 IF(.NOT.periodic_x)THEN
114 IF (its - ibs .lt. spec_zone) THEN
115 ! X-start boundary
116 DO i = its, min(itf,ibs+spec_zone-1)
117 b_dist = i - ibs
118 DO k = kts, ktf
119 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
120
121 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
122
123 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
124 dt*field_tend(i,k,j)/muts(i,j) + &
125 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
126
127 ENDDO
128 ENDDO
129 ENDDO
130 ENDIF
131
132 IF (ibe - itf .lt. spec_zone) THEN
133 ! X-end boundary
134 DO i = max(its,ibe-spec_zone+1), itf
135 b_dist = ibe - i
136 DO k = kts, ktf
137 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
138
139 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
140
141 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
142 dt*field_tend(i,k,j)/muts(i,j) + &
143 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
144
145 ENDDO
146 ENDDO
147 ENDDO
148 ENDIF
149 ENDIF
150
151 END SUBROUTINE spec_bdyupdate_ph
152
153 !------------------------------------------------------------------------
154
155 SUBROUTINE relax_bdy_dry ( config_flags, &
156 ru_tendf, rv_tendf, ph_tendf, t_tendf, &
157 rw_tendf, mu_tend, &
158 ru, rv, ph, t, &
159 w, mu, mut, &
160 u_bxs,u_bxe,u_bys,u_bye, &
161 v_bxs,v_bxe,v_bys,v_bye, &
162 ph_bxs,ph_bxe,ph_bys,ph_bye, &
163 t_bxs,t_bxe,t_bys,t_bye, &
164 w_bxs,w_bxe,w_bys,w_bye, &
165 mu_bxs,mu_bxe,mu_bys,mu_bye, &
166 u_btxs,u_btxe,u_btys,u_btye, &
167 v_btxs,v_btxe,v_btys,v_btye, &
168 ph_btxs,ph_btxe,ph_btys,ph_btye, &
169 t_btxs,t_btxe,t_btys,t_btye, &
170 w_btxs,w_btxe,w_btys,w_btye, &
171 mu_btxs,mu_btxe,mu_btys,mu_btye, &
172 spec_bdy_width, spec_zone, relax_zone, &
173 dtbc, fcx, gcx, &
174 ids,ide, jds,jde, kds,kde, & ! domain dims
175 ims,ime, jms,jme, kms,kme, & ! memory dims
176 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
177 its, ite, jts, jte, kts, kte)
178 IMPLICIT NONE
179
180 ! Input data.
181 TYPE( grid_config_rec_type ) config_flags
182
183 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
184 ims, ime, jms, jme, kms, kme, &
185 ips, ipe, jps, jpe, kps, kpe, &
186 its, ite, jts, jte, kts, kte
187 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
188
189 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: ru, &
190 rv, &
191 ph, &
192 w, &
193 t
194 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu , &
195 mut
196 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tendf, &
197 rv_tendf, &
198 ph_tendf, &
199 rw_tendf, &
200 t_tendf
201 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend
202 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
203
204 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
205 v_bxs,v_bxe, &
206 ph_bxs,ph_bxe, &
207 w_bxs,w_bxe, &
208 t_bxs,t_bxe, &
209 u_btxs,u_btxe, &
210 v_btxs,v_btxe, &
211 ph_btxs,ph_btxe, &
212 w_btxs,w_btxe, &
213 t_btxs,t_btxe
214
215 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
216 v_bys,v_bye, &
217 ph_bys,ph_bye, &
218 w_bys,w_bye, &
219 t_bys,t_bye, &
220 u_btys,u_btye, &
221 v_btys,v_btye, &
222 ph_btys,ph_btye, &
223 w_btys,w_btye, &
224 t_btys,t_btye
225
226
227 REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
228 mu_btxs,mu_btxe
229
230 REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
231 mu_btys,mu_btye
232 REAL, INTENT(IN ) :: dtbc
233
234 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rfield
235 INTEGER :: i_start, i_end, j_start, j_end, i, j, k
236
237 CALL relax_bdytend ( ru, ru_tendf, &
238 u_bxs,u_bxe,u_bys,u_bye,u_btxs,u_btxe,u_btys,u_btye, &
239 'u' , config_flags, &
240 spec_bdy_width, spec_zone, relax_zone, &
241 dtbc, fcx, gcx, &
242 ids,ide, jds,jde, kds,kde, & ! domain dims
243 ims,ime, jms,jme, kms,kme, & ! memory dims
244 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
245 its,ite, jts,jte, kts,kte )
246 CALL relax_bdytend ( rv, rv_tendf, &
247 v_bxs,v_bxe,v_bys,v_bye,v_btxs,v_btxe,v_btys,v_btye, &
248 'v' , config_flags, &
249 spec_bdy_width, spec_zone, relax_zone, &
250 dtbc, fcx, gcx, &
251 ids,ide, jds,jde, kds,kde, & ! domain dims
252 ims,ime, jms,jme, kms,kme, & ! memory dims
253 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
254 its,ite, jts,jte, kts,kte )
255
256 ! rfield will be calculated beyond tile limits because relax_bdytend
257 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
258 ! communication here
259 i_start = max(its-1, ids)
260 i_end = min(ite+1, ide-1)
261 j_start = max(jts-1, jds)
262 j_end = min(jte+1, jde-1)
263
264 DO j=j_start,j_end
265 DO k=kts,kte
266 DO i=i_start,i_end
267 rfield(i,k,j) = ph(i,k,j)*mut(i,j)
268 ENDDO
269 ENDDO
270 ENDDO
271
272 CALL relax_bdytend ( rfield, ph_tendf, &
273 ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
274 'h' , config_flags, &
275 spec_bdy_width, spec_zone, relax_zone, &
276 dtbc, fcx, gcx, &
277 ids,ide, jds,jde, kds,kde, & ! domain dims
278 ims,ime, jms,jme, kms,kme, & ! memory dims
279 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
280 its,ite, jts,jte, kts,kte )
281 DO j=j_start,j_end
282 DO k=kts,kte-1
283 DO i=i_start,i_end
284 rfield(i,k,j) = t(i,k,j)*mut(i,j)
285 ENDDO
286 ENDDO
287 ENDDO
288 CALL relax_bdytend ( rfield, t_tendf, &
289 t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
290 't' , config_flags, &
291 spec_bdy_width, spec_zone, relax_zone, &
292 dtbc, fcx, gcx, &
293 ids,ide, jds,jde, kds,kde, & ! domain dims
294 ims,ime, jms,jme, kms,kme, & ! memory dims
295 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
296 its,ite, jts,jte, kts,kte )
297 CALL relax_bdytend ( mu, mu_tend, &
298 mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
299 'm' , config_flags, &
300 spec_bdy_width, spec_zone, relax_zone, &
301 dtbc, fcx, gcx, &
302 ids,ide, jds,jde, 1 ,1 , & ! domain dims
303 ims,ime, jms,jme, 1 ,1 , & ! memory dims
304 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
305 its,ite, jts,jte, 1 ,1 )
306
307 IF( config_flags%nested) THEN
308
309 i_start = max(its-1, ids)
310 i_end = min(ite+1, ide-1)
311 j_start = max(jts-1, jds)
312 j_end = min(jte+1, jde-1)
313
314 DO j=j_start,j_end
315 DO k=kts,kte
316 DO i=i_start,i_end
317 rfield(i,k,j) = w(i,k,j)*mut(i,j)
318 ENDDO
319 ENDDO
320 ENDDO
321
322 CALL relax_bdytend ( rfield, rw_tendf, &
323 w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
324 'h' , config_flags, &
325 spec_bdy_width, spec_zone, relax_zone, &
326 dtbc, fcx, gcx, &
327 ids,ide, jds,jde, kds,kde, & ! domain dims
328 ims,ime, jms,jme, kms,kme, & ! memory dims
329 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
330 its,ite, jts,jte, kts,kte )
331
332 END IF
333
334 END SUBROUTINE relax_bdy_dry
335 !------------------------------------------------------------------------
336 SUBROUTINE relax_bdy_scalar ( scalar_tend, &
337 scalar, mu, &
338 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
339 scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
340 spec_bdy_width, spec_zone, relax_zone, &
341 dtbc, fcx, gcx, &
342 config_flags, &
343 ids,ide, jds,jde, kds,kde, & ! domain dims
344 ims,ime, jms,jme, kms,kme, & ! memory dims
345 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
346 its, ite, jts, jte, kts, kte)
347 IMPLICIT NONE
348
349 ! Input data.
350 TYPE( grid_config_rec_type ) config_flags
351
352 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
353 ims, ime, jms, jme, kms, kme, &
354 ips, ipe, jps, jpe, kps, kpe, &
355 its, ite, jts, jte, kts, kte
356 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
357
358 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: scalar
359 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu
360 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: scalar_tend
361 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
362
363 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
364 scalar_btxs,scalar_btxe
365 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
366 scalar_btys,scalar_btye
367 REAL, INTENT(IN ) :: dtbc
368 !Local
369 INTEGER :: i,j,k, i_start, i_end, j_start, j_end
370 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rscalar
371
372 ! rscalar will be calculated beyond tile limits because relax_bdytend
373 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
374 ! communication here
375 i_start = max(its-1, ids)
376 i_end = min(ite+1, ide-1)
377 j_start = max(jts-1, jds)
378 j_end = min(jte+1, jde-1)
379
380 DO j=j_start,j_end
381 DO k=kts,min(kte,kde-1)
382 DO i=i_start,i_end
383 rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
384 ENDDO
385 ENDDO
386 ENDDO
387
388 CALL relax_bdytend (rscalar, scalar_tend, &
389 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
390 'q' , config_flags, &
391 spec_bdy_width, spec_zone, relax_zone, &
392 dtbc, fcx, gcx, &
393 ids,ide, jds,jde, kds,kde, & ! domain dims
394 ims,ime, jms,jme, kms,kme, & ! memory dims
395 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
396 its,ite, jts,jte, kts,kte )
397
398
399 END SUBROUTINE relax_bdy_scalar
400
401 !------------------------------------------------------------------------
402 SUBROUTINE spec_bdy_dry ( config_flags, &
403 ru_tend, rv_tend, ph_tend, t_tend, &
404 rw_tend, mu_tend, &
405 u_bxs,u_bxe,u_bys,u_bye, &
406 v_bxs,v_bxe,v_bys,v_bye, &
407 ph_bxs,ph_bxe,ph_bys,ph_bye, &
408 t_bxs,t_bxe,t_bys,t_bye, &
409 w_bxs,w_bxe,w_bys,w_bye, &
410 mu_bxs,mu_bxe,mu_bys,mu_bye, &
411 u_btxs,u_btxe,u_btys,u_btye, &
412 v_btxs,v_btxe,v_btys,v_btye, &
413 ph_btxs,ph_btxe,ph_btys,ph_btye, &
414 t_btxs,t_btxe,t_btys,t_btye, &
415 w_btxs,w_btxe,w_btys,w_btye, &
416 mu_btxs,mu_btxe,mu_btys,mu_btye, &
417 spec_bdy_width, spec_zone, &
418 ids,ide, jds,jde, kds,kde, & ! domain dims
419 ims,ime, jms,jme, kms,kme, & ! memory dims
420 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
421 its, ite, jts, jte, kts, kte)
422 IMPLICIT NONE
423
424 ! Input data.
425 TYPE( grid_config_rec_type ) config_flags
426
427
428 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
429 ims, ime, jms, jme, kms, kme, &
430 ips, ipe, jps, jpe, kps, kpe, &
431 its, ite, jts, jte, kts, kte
432 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
433
434 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: ru_tend, &
435 rv_tend, &
436 ph_tend, &
437 rw_tend, &
438 t_tend
439 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: mu_tend
440
441 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
442 v_bxs,v_bxe, &
443 ph_bxs,ph_bxe, &
444 w_bxs,w_bxe, &
445 t_bxs,t_bxe, &
446 u_btxs,u_btxe, &
447 v_btxs,v_btxe, &
448 ph_btxs,ph_btxe, &
449 w_btxs,w_btxe, &
450 t_btxs,t_btxe
451
452 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
453 v_bys,v_bye, &
454 ph_bys,ph_bye, &
455 w_bys,w_bye, &
456 t_bys,t_bye, &
457 u_btys,u_btye, &
458 v_btys,v_btye, &
459 ph_btys,ph_btye, &
460 w_btys,w_btye, &
461 t_btys,t_btye
462
463 REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
464 mu_btxs,mu_btxe
465
466 REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
467 mu_btys,mu_btye
468 CALL spec_bdytend ( ru_tend, &
469 u_bxs,u_bxe,u_bys,u_bye, u_btxs,u_btxe,u_btys,u_btye, &
470 'u' , config_flags, &
471 spec_bdy_width, spec_zone, &
472 ids,ide, jds,jde, kds,kde, & ! domain dims
473 ims,ime, jms,jme, kms,kme, & ! memory dims
474 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
475 its,ite, jts,jte, kts,kte )
476 CALL spec_bdytend ( rv_tend, &
477 v_bxs,v_bxe,v_bys,v_bye, v_btxs,v_btxe,v_btys,v_btye, &
478 'v' , config_flags, &
479 spec_bdy_width, spec_zone, &
480 ids,ide, jds,jde, kds,kde, & ! domain dims
481 ims,ime, jms,jme, kms,kme, & ! memory dims
482 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
483 its,ite, jts,jte, kts,kte )
484 CALL spec_bdytend ( ph_tend, &
485 ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
486 'h' , config_flags, &
487 spec_bdy_width, spec_zone, &
488 ids,ide, jds,jde, kds,kde, & ! domain dims
489 ims,ime, jms,jme, kms,kme, & ! memory dims
490 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
491 its,ite, jts,jte, kts,kte )
492 CALL spec_bdytend ( t_tend, &
493 t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
494 't' , config_flags, &
495 spec_bdy_width, spec_zone, &
496 ids,ide, jds,jde, kds,kde, & ! domain dims
497 ims,ime, jms,jme, kms,kme, & ! memory dims
498 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
499 its,ite, jts,jte, kts,kte )
500 CALL spec_bdytend ( mu_tend, &
501 mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
502 'm' , config_flags, &
503 spec_bdy_width, spec_zone, &
504 ids,ide, jds,jde, 1 ,1 , & ! domain dims
505 ims,ime, jms,jme, 1 ,1 , & ! memory dims
506 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
507 its,ite, jts,jte, 1 ,1 )
508
509 if(config_flags%nested) &
510 CALL spec_bdytend ( rw_tend, &
511 w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
512 'h' , config_flags, &
513 spec_bdy_width, spec_zone, &
514 ids,ide, jds,jde, kds,kde, & ! domain dims
515 ims,ime, jms,jme, kms,kme, & ! memory dims
516 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
517 its,ite, jts,jte, kts,kte )
518
519 END SUBROUTINE spec_bdy_dry
520
521 !------------------------------------------------------------------------
522 SUBROUTINE spec_bdy_scalar ( scalar_tend, &
523 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
524 scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
525 spec_bdy_width, spec_zone, &
526 config_flags, &
527 ids,ide, jds,jde, kds,kde, & ! domain dims
528 ims,ime, jms,jme, kms,kme, & ! memory dims
529 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
530 its, ite, jts, jte, kts, kte)
531 IMPLICIT NONE
532
533 ! Input data.
534 TYPE( grid_config_rec_type ) config_flags
535
536
537 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
538 ims, ime, jms, jme, kms, kme, &
539 ips, ipe, jps, jpe, kps, kpe, &
540 its, ite, jts, jte, kts, kte
541 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
542
543 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
544
545 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
546 scalar_btxs,scalar_btxe
547
548 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
549 scalar_btys,scalar_btye
550
551 !Local
552 INTEGER :: i,j,k
553
554
555 CALL spec_bdytend ( scalar_tend, &
556 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
557 'q' , config_flags, &
558 spec_bdy_width, spec_zone, &
559 ids,ide, jds,jde, kds,kde, & ! domain dims
560 ims,ime, jms,jme, kms,kme, & ! memory dims
561 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
562 its,ite, jts,jte, kts,kte )
563
564
565 END SUBROUTINE spec_bdy_scalar
566
567 !------------------------------------------------------------------------
568
569 SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, &
570 rw_1, rw_2, w_1, w_2, &
571 t_1, t_2, tp_1, tp_2, pp, pip, &
572 ids,ide, jds,jde, kds,kde, &
573 ims,ime, jms,jme, kms,kme, &
574 ips,ipe, jps,jpe, kps,kpe, &
575 its,ite, jts,jte, kts,kte )
576
577 !
578 ! this is just a wraper to call the boundary condition routines
579 ! for each variable
580 !
581
582 IMPLICIT NONE
583
584 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
585 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
586 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
587 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
588
589 TYPE( grid_config_rec_type ) config_flags
590
591 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
592 u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2, &
593 t_1, t_2, tp_1, tp_2, pp, pip
594
595
596
597 CALL set_physical_bc3d( u_1 , 'u', config_flags, &
598 ids, ide, jds, jde, kds, kde, &
599 ims, ime, jms, jme, kms, kme, &
600 ips, ipe, jps, jpe, kps, kpe, &
601 its, ite, jts, jte, kts, kte )
602 CALL set_physical_bc3d( u_2 , 'u', config_flags, &
603 ids, ide, jds, jde, kds, kde, &
604 ims, ime, jms, jme, kms, kme, &
605 ips, ipe, jps, jpe, kps, kpe, &
606 its, ite, jts, jte, kts, kte )
607 CALL set_physical_bc3d( v_1 , 'v', config_flags, &
608 ids, ide, jds, jde, kds, kde, &
609 ims, ime, jms, jme, kms, kme, &
610 ips, ipe, jps, jpe, kps, kpe, &
611 its, ite, jts, jte, kts, kte )
612 CALL set_physical_bc3d( v_2 , 'v', config_flags, &
613 ids, ide, jds, jde, kds, kde, &
614 ims, ime, jms, jme, kms, kme, &
615 ips, ipe, jps, jpe, kps, kpe, &
616 its, ite, jts, jte, kts, kte )
617 CALL set_physical_bc3d( rw_1 , 'w', config_flags, &
618 ids, ide, jds, jde, kds, kde, &
619 ims, ime, jms, jme, kms, kme, &
620 ips, ipe, jps, jpe, kps, kpe, &
621 its, ite, jts, jte, kts, kte )
622 CALL set_physical_bc3d( rw_2 , 'w', config_flags, &
623 ids, ide, jds, jde, kds, kde, &
624 ims, ime, jms, jme, kms, kme, &
625 ips, ipe, jps, jpe, kps, kpe, &
626 its, ite, jts, jte, kts, kte )
627 CALL set_physical_bc3d( w_1 , 'w', config_flags, &
628 ids, ide, jds, jde, kds, kde, &
629 ims, ime, jms, jme, kms, kme, &
630 ips, ipe, jps, jpe, kps, kpe, &
631 its, ite, jts, jte, kts, kte )
632 CALL set_physical_bc3d( w_2 , 'w', config_flags, &
633 ids, ide, jds, jde, kds, kde, &
634 ims, ime, jms, jme, kms, kme, &
635 ips, ipe, jps, jpe, kps, kpe, &
636 its, ite, jts, jte, kts, kte )
637 CALL set_physical_bc3d( t_1, 'p', config_flags, &
638 ids, ide, jds, jde, kds, kde, &
639 ims, ime, jms, jme, kms, kme, &
640 ips, ipe, jps, jpe, kps, kpe, &
641 its, ite, jts, jte, kts, kte )
642 CALL set_physical_bc3d( t_2, 'p', config_flags, &
643 ids, ide, jds, jde, kds, kde, &
644 ims, ime, jms, jme, kms, kme, &
645 ips, ipe, jps, jpe, kps, kpe, &
646 its, ite, jts, jte, kts, kte )
647 CALL set_physical_bc3d( tp_1, 'p', config_flags, &
648 ids, ide, jds, jde, kds, kde, &
649 ims, ime, jms, jme, kms, kme, &
650 ips, ipe, jps, jpe, kps, kpe, &
651 its, ite, jts, jte, kts, kte )
652 CALL set_physical_bc3d( tp_2, 'p', config_flags, &
653 ids, ide, jds, jde, kds, kde, &
654 ims, ime, jms, jme, kms, kme, &
655 ips, ipe, jps, jpe, kps, kpe, &
656 its, ite, jts, jte, kts, kte )
657 CALL set_physical_bc3d( pp , 'p', config_flags, &
658 ids, ide, jds, jde, kds, kde, &
659 ims, ime, jms, jme, kms, kme, &
660 ips, ipe, jps, jpe, kps, kpe, &
661 its, ite, jts, jte, kts, kte )
662 CALL set_physical_bc3d( pip , 'p', config_flags, &
663 ids, ide, jds, jde, kds, kde, &
664 ims, ime, jms, jme, kms, kme, &
665 ips, ipe, jps, jpe, kps, kpe, &
666 its, ite, jts, jte, kts, kte )
667
668 END SUBROUTINE set_phys_bc_dry_1
669
670 !--------------------------------------------------------------
671
672 SUBROUTINE set_phys_bc_dry_2( config_flags, &
673 u_1, u_2, v_1, v_2, w_1, w_2, &
674 t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
675 ids,ide, jds,jde, kds,kde, &
676 ims,ime, jms,jme, kms,kme, &
677 ips,ipe, jps,jpe, kps,kpe, &
678 its,ite, jts,jte, kts,kte )
679
680 !
681 ! this is just a wraper to call the boundary condition routines
682 ! for each variable
683 !
684
685 IMPLICIT NONE
686
687 TYPE( grid_config_rec_type ) config_flags
688
689 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
690 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
691 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
692 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
693
694 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
695 u_1, u_2, v_1, v_2, w_1, w_2, &
696 t_1, t_2, ph_1, ph_2
697
698 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
699 mu_1, mu_2
700
701
702 CALL set_physical_bc3d( u_1, 'U', config_flags, &
703 ids, ide, jds, jde, kds, kde, &
704 ims, ime, jms, jme, kms, kme, &
705 ips, ipe, jps, jpe, kps, kpe, &
706 its, ite, jts, jte, kts, kte )
707
708 CALL set_physical_bc3d( u_2, 'U', config_flags, &
709 ids, ide, jds, jde, kds, kde, &
710 ims, ime, jms, jme, kms, kme, &
711 ips, ipe, jps, jpe, kps, kpe, &
712 its, ite, jts, jte, kts, kte )
713
714 CALL set_physical_bc3d( v_1 , 'V', config_flags, &
715 ids, ide, jds, jde, kds, kde, &
716 ims, ime, jms, jme, kms, kme, &
717 ips, ipe, jps, jpe, kps, kpe, &
718 its, ite, jts, jte, kts, kte )
719 CALL set_physical_bc3d( v_2 , 'V', config_flags, &
720 ids, ide, jds, jde, kds, kde, &
721 ims, ime, jms, jme, kms, kme, &
722 ips, ipe, jps, jpe, kps, kpe, &
723 its, ite, jts, jte, kts, kte )
724
725 CALL set_physical_bc3d( w_1, 'w', config_flags, &
726 ids, ide, jds, jde, kds, kde, &
727 ims, ime, jms, jme, kms, kme, &
728 ips, ipe, jps, jpe, kps, kpe, &
729 its, ite, jts, jte, kts, kte )
730 CALL set_physical_bc3d( w_2, 'w', config_flags, &
731 ids, ide, jds, jde, kds, kde, &
732 ims, ime, jms, jme, kms, kme, &
733 ips, ipe, jps, jpe, kps, kpe, &
734 its, ite, jts, jte, kts, kte )
735
736 CALL set_physical_bc3d( t_1, 'p', config_flags, &
737 ids, ide, jds, jde, kds, kde, &
738 ims, ime, jms, jme, kms, kme, &
739 ips, ipe, jps, jpe, kps, kpe, &
740 its, ite, jts, jte, kts, kte )
741
742 CALL set_physical_bc3d( t_2, 'p', config_flags, &
743 ids, ide, jds, jde, kds, kde, &
744 ims, ime, jms, jme, kms, kme, &
745 ips, ipe, jps, jpe, kps, kpe, &
746 its, ite, jts, jte, kts, kte )
747
748 CALL set_physical_bc3d( ph_1 , 'w', config_flags, &
749 ids, ide, jds, jde, kds, kde, &
750 ims, ime, jms, jme, kms, kme, &
751 ips, ipe, jps, jpe, kps, kpe, &
752 its, ite, jts, jte, kts, kte )
753
754 CALL set_physical_bc3d( ph_2 , 'w', config_flags, &
755 ids, ide, jds, jde, kds, kde, &
756 ims, ime, jms, jme, kms, kme, &
757 ips, ipe, jps, jpe, kps, kpe, &
758 its, ite, jts, jte, kts, kte )
759
760 CALL set_physical_bc2d( mu_1, 't', config_flags, &
761 ids, ide, jds, jde, &
762 ims, ime, jms, jme, &
763 ips, ipe, jps, jpe, &
764 its, ite, jts, jte )
765
766 CALL set_physical_bc2d( mu_2, 't', config_flags, &
767 ids, ide, jds, jde, &
768 ims, ime, jms, jme, &
769 ips, ipe, jps, jpe, &
770 its, ite, jts, jte )
771
772 END SUBROUTINE set_phys_bc_dry_2
773
774 !------------------------------------------------------------------------
775
776 SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, &
777 ids,ide, jds,jde, kds,kde, &
778 ims,ime, jms,jme, kms,kme, &
779 ips,ipe, jps,jpe, kps,kpe, &
780 its,ite, jts,jte, kts,kte )
781
782 !
783 ! this is just a wraper to call the boundary condition routines
784 ! for each variable
785 !
786
787 IMPLICIT NONE
788
789 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
790 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
791 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
792 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
793
794 TYPE( grid_config_rec_type ) config_flags
795
796 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
797 ru_1,du, rv_1, dv
798
799 CALL set_physical_bc3d( ru_1 , 'u', config_flags, &
800 ids, ide, jds, jde, kds, kde, &
801 ims, ime, jms, jme, kms, kme, &
802 ips, ipe, jps, jpe, kps, kpe, &
803 its, ite, jts, jte, kts, kde )
804 CALL set_physical_bc3d( du , 'u', config_flags, &
805 ids, ide, jds, jde, kds, kde, &
806 ims, ime, jms, jme, kms, kme, &
807 ips, ipe, jps, jpe, kps, kpe, &
808 its, ite, jts, jte, kts, kde )
809 CALL set_physical_bc3d( rv_1 , 'v', config_flags, &
810 ids, ide, jds, jde, kds, kde, &
811 ims, ime, jms, jme, kms, kme, &
812 ips, ipe, jps, jpe, kps, kpe, &
813 its, ite, jts, jte, kts, kde )
814 CALL set_physical_bc3d( dv , 'v', config_flags, &
815 ids, ide, jds, jde, kds, kde, &
816 ims, ime, jms, jme, kms, kme, &
817 ips, ipe, jps, jpe, kps, kpe, &
818 its, ite, jts, jte, kts, kde )
819
820 END SUBROUTINE set_phys_bc_smallstep_1
821
822 !-------------------------------------------------------------------
823
824 SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, &
825 muu, muv, mut, php, alt, p, &
826 ids,ide, jds,jde, kds,kde, &
827 ims,ime, jms,jme, kms,kme, &
828 ips,ipe, jps,jpe, kps,kpe, &
829 its,ite, jts,jte, kts,kte )
830
831 !
832 ! this is just a wraper to call the boundary condition routines
833 ! for each variable
834 !
835
836 IMPLICIT NONE
837
838 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
839 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
840 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
841 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
842
843 TYPE( grid_config_rec_type ) config_flags
844
845 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
846 INTENT(INOUT) :: u, v, rw, w, php, alt, p
847 REAL, DIMENSION( ims:ime, jms:jme ), &
848 INTENT(INOUT) :: muu, muv, mut
849
850 CALL set_physical_bc3d( u , 'u', config_flags, &
851 ids, ide, jds, jde, kds, kde, &
852 ims, ime, jms, jme, kms, kme, &
853 ips, ipe, jps, jpe, kps, kpe, &
854 its, ite, jts, jte, kts, kte )
855 CALL set_physical_bc3d( v , 'v', config_flags, &
856 ids, ide, jds, jde, kds, kde, &
857 ims, ime, jms, jme, kms, kme, &
858 ips, ipe, jps, jpe, kps, kpe, &
859 its, ite, jts, jte, kts, kte )
860 CALL set_physical_bc3d(rw , 'w', config_flags, &
861 ids, ide, jds, jde, kds, kde, &
862 ims, ime, jms, jme, kms, kme, &
863 ips, ipe, jps, jpe, kps, kpe, &
864 its, ite, jts, jte, kts, kte )
865 CALL set_physical_bc3d( w , 'w', config_flags, &
866 ids, ide, jds, jde, kds, kde, &
867 ims, ime, jms, jme, kms, kme, &
868 ips, ipe, jps, jpe, kps, kpe, &
869 its, ite, jts, jte, kts, kte )
870 CALL set_physical_bc3d( php , 'w', config_flags, &
871 ids, ide, jds, jde, kds, kde, &
872 ims, ime, jms, jme, kms, kme, &
873 ips, ipe, jps, jpe, kps, kpe, &
874 its, ite, jts, jte, kts, kte )
875 CALL set_physical_bc3d( alt, 't', config_flags, &
876 ids, ide, jds, jde, kds, kde, &
877 ims, ime, jms, jme, kms, kme, &
878 ips, ipe, jps, jpe, kps, kpe, &
879 its, ite, jts, jte, kts, kte )
880
881 CALL set_physical_bc3d( p, 'p', config_flags, &
882 ids, ide, jds, jde, kds, kde, &
883 ims, ime, jms, jme, kms, kme, &
884 ips, ipe, jps, jpe, kps, kpe, &
885 its, ite, jts, jte, kts, kte )
886
887 CALL set_physical_bc2d( muu, 'u', config_flags, &
888 ids, ide, jds, jde, &
889 ims, ime, jms, jme, &
890 ips, ipe, jps, jpe, &
891 its, ite, jts, jte )
892
893 CALL set_physical_bc2d( muv, 'v', config_flags, &
894 ids, ide, jds, jde, &
895 ims, ime, jms, jme, &
896 ips, ipe, jps, jpe, &
897 its, ite, jts, jte )
898
899 CALL set_physical_bc2d( mut, 't', config_flags, &
900 ids, ide, jds, jde, &
901 ims, ime, jms, jme, &
902 ips, ipe, jps, jpe, &
903 its, ite, jts, jte )
904
905 END SUBROUTINE rk_phys_bc_dry_1
906
907 !------------------------------------------------------------------------
908
909 SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, &
910 t, ph, mu, &
911 ids,ide, jds,jde, kds,kde, &
912 ims,ime, jms,jme, kms,kme, &
913 ips,ipe, jps,jpe, kps,kpe, &
914 its,ite, jts,jte, kts,kte )
915
916 !
917 ! this is just a wraper to call the boundary condition routines
918 ! for each variable
919 !
920
921 IMPLICIT NONE
922
923 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
924 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
925 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
926 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
927
928 TYPE( grid_config_rec_type ) config_flags
929
930 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
931 u, v, w, t, ph
932
933 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
934 mu
935
936 CALL set_physical_bc3d( u , 'U', config_flags, &
937 ids, ide, jds, jde, kds, kde, &
938 ims, ime, jms, jme, kms, kme, &
939 ips, ipe, jps, jpe, kps, kpe, &
940 its, ite, jts, jte, kts, kte )
941 CALL set_physical_bc3d( v , 'V', config_flags, &
942 ids, ide, jds, jde, kds, kde, &
943 ims, ime, jms, jme, kms, kme, &
944 ips, ipe, jps, jpe, kps, kpe, &
945 its, ite, jts, jte, kts, kte )
946 CALL set_physical_bc3d( w , 'w', config_flags, &
947 ids, ide, jds, jde, kds, kde, &
948 ims, ime, jms, jme, kms, kme, &
949 ips, ipe, jps, jpe, kps, kpe, &
950 its, ite, jts, jte, kts, kte )
951 CALL set_physical_bc3d( t, 'p', config_flags, &
952 ids, ide, jds, jde, kds, kde, &
953 ims, ime, jms, jme, kms, kme, &
954 ips, ipe, jps, jpe, kps, kpe, &
955 its, ite, jts, jte, kts, kte )
956 CALL set_physical_bc3d( ph , 'w', config_flags, &
957 ids, ide, jds, jde, kds, kde, &
958 ims, ime, jms, jme, kms, kme, &
959 ips, ipe, jps, jpe, kps, kpe, &
960 its, ite, jts, jte, kts, kte )
961
962 CALL set_physical_bc2d( mu, 't', config_flags, &
963 ids, ide, jds, jde, &
964 ims, ime, jms, jme, &
965 ips, ipe, jps, jpe, &
966 its, ite, jts, jte )
967
968 END SUBROUTINE rk_phys_bc_dry_2
969
970 !---------------------------------------------------------------------
971
972 SUBROUTINE set_w_surface( config_flags, &
973 w, ht, u, v, cf1, cf2, cf3, rdx, rdy, msft, &
974 ids, ide, jds, jde, kds, kde, &
975 ips, ipe, jps, jpe, kps, kpe, &
976 its, ite, jts, jte, kts, kte, &
977 ims, ime, jms, jme, kms, kme )
978 implicit none
979
980 TYPE( grid_config_rec_type ) config_flags
981
982 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
983 ims, ime, jms, jme, kms, kme, &
984 its, ite, jts, jte, kts, kte, &
985 ips, ipe, jps, jpe, kps, kpe
986
987 REAL :: cf1, cf2, cf3, rdx, rdy
988
989
990 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
991 INTENT(IN ) :: u, &
992 v
993
994 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
995 INTENT(INOUT) :: w
996
997 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: ht, msft
998
999 INTEGER :: i,j
1000 INTEGER :: ip1,im1,jp1,jm1
1001
1002 ! set kinematic lower boundary condition on W
1003
1004 DO j = jts,min(jte,jde-1)
1005 jm1 = max(j-1,jds)
1006 jp1 = min(j+1,jde-1)
1007 DO i = its,min(ite,ide-1)
1008 im1 = max(i-1,ids)
1009 ip1 = min(i+1,ide-1)
1010
1011 w(i,1,j)= msft(i,j)*( &
1012 .5*rdy*( &
1013 (ht(i,jp1)-ht(i,j )) &
1014 *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1)) &
1015 +(ht(i,j )-ht(i,jm1)) &
1016 *(cf1*v(i,1,j )+cf2*v(i,2,j )+cf3*v(i,3,j )) ) &
1017 +.5*rdx*( &
1018 (ht(ip1,j)-ht(i,j )) &
1019 *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j)) &
1020 +(ht(i ,j)-ht(im1,j)) &
1021 *(cf1*u(i ,1,j)+cf2*u(i ,2,j)+cf3*u(i ,3,j)) ) &
1022 )
1023 ENDDO
1024 ENDDO
1025
1026 END SUBROUTINE set_w_surface
1027
1028 END MODULE module_bc_em