solve_em_tl.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:SOLVER
2
3 SUBROUTINE solve_em_tl ( grid , config_flags , &
4 ! Actual arguments generated from Registry
5 #include "em_dummy_args.inc"
6 !
7 )
8
9 ! Driver layer modules
10 USE module_domain
11 USE module_configure
12 USE module_driver_constants
13 USE module_machine
14 USE module_tiles
15 USE module_dm
16 ! Mediation layer modules
17 ! Model layer modules
18 USE module_model_constants
19 USE module_small_step_em
20 USE module_em
21 USE module_big_step_utilities_em
22 USE module_bc
23 USE module_bc_em
24 USE module_solvedebug_em
25 USE module_physics_addtendc
26 USE module_diffusion_em
27 ! Registry generated module
28 USE module_state_description
29 USE module_radiation_driver
30 USE module_surface_driver
31 USE module_cumulus_driver
32 USE module_microphysics_driver
33 USE module_pbl_driver
34 #ifdef WRF_CHEM
35 USE module_input_chem_data
36 USE module_chem_utilities
37 #endif
38
39 USE g_module_small_step_em
40 USE g_module_em
41 USE g_module_big_step_utilities_em
42 USE g_module_bc
43 USE g_module_bc_em
44 USE g_module_diffusion_em
45
46 IMPLICIT NONE
47
48 ! Input data.
49
50 TYPE(domain) , TARGET :: grid
51
52 ! Definitions of dummy arguments to this routine (generated from Registry).
53 #include "em_dummy_decl.inc"
54
55 ! Structure that contains run-time configuration (namelist) data for domain
56 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
57
58 ! Local data
59
60 INTEGER :: k_start , k_end, its, ite, jts, jte
61 INTEGER :: ids , ide , jds , jde , kds , kde , &
62 ims , ime , jms , jme , kms , kme , &
63 ips , ipe , jps , jpe , kps , kpe
64 INTEGER :: ij , iteration
65 INTEGER :: im , num_3d_m , ic , num_3d_c, num_3d_s
66 INTEGER :: loop
67 INTEGER :: ijds, ijde
68 INTEGER :: itmpstep
69 INTEGER :: sz
70
71 LOGICAL :: specified_bdy
72
73 ! storage for tendencies and decoupled state (generated from Registry)
74 #include "em_i1_decl.inc"
75 #include "namelist_defines2.inc"
76
77 ! Previous time level of tracer arrays now defined as i1 variables;
78 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
79 ! Benefit: save memory in nested runs, since only 1 domain is active at a
80 ! time. Potential problem on stack-limited architectures: increases
81 ! amount of data on program stack by making these automatic arrays.
82
83 INTEGER :: rc
84 INTEGER :: number_of_small_timesteps, rk_step
85 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
86 INTEGER :: idum1, idum2, dynamics_option
87
88 INTEGER :: rk_order, iwmax, jwmax, kwmax
89 REAL :: dt_rk, dts_rk, dtm, wmax
90 INTEGER :: l,kte,kk
91
92 !--Local variables
93 real, DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: g_z_at_wm
94 real, DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: g_pi_phym
95 real, DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: g_xkmhm
96 real, DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: g_bn2m
97
98 real, DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4,num_chem) :: g_chem_btm
99 real, DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4,num_scalar) :: g_scalar_btm
100 real, DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4,num_moist) :: g_moist_btm
101
102 ! These are used if -DDEREF_KLUDGE is compiled
103 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
104 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
105 INTEGER :: sm31x , em31x , sm32x , em32x , sm33x , em33x
106 INTEGER :: sm31y , em31y , sm32y , em32y , sm33y , em33y
107
108 ! Define benchmarking timers if -DBENCH is compiled
109 #include "bench_solve_em_def.h"
110
111 !----------------------
112 ! Executable statements
113 !----------------------
114
115 ! Trick problematic compilers into not performing copy-in/copy-out by adding
116 ! indices to array arguments in the CALL statements in this routine.
117 ! It has the effect of passing only the first element of the array, rather
118 ! than the entire array. See:
119 ! http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
120 #include "deref_kludge.h"
121
122 ! Limit the number of arguments if compiled with -DLIMIT_ARGS by copying
123 ! scalar (non-array) arguments out of the grid data structure into locally
124 ! defined copies (defined in em_dummy_decl.inc, above, as they are if they
125 ! are arguments). An equivalent include of em_scalar_derefs.inc appears
126 ! at the end of the routine to copy back any chnaged non-array values.
127 ! The definition of COPY_IN or COPY_OUT before the include defines the
128 ! direction of the copy. Em_scalar_derefs.inc is generated from Registry
129 #define COPY_IN
130 #include "em_scalar_derefs.inc"
131
132 ! Needed by some comm layers, e.g. RSL. If needed, nmm_data_calls.inc is
133 ! generated from the registry. The definition of REGISTER_I1 allows
134 ! I1 data to be communicated in this routine if necessary.
135 #ifdef DM_PARALLEL
136 # define REGISTER_I1
137 #include "em_data_calls.inc"
138
139 !<DESCRIPTION>
140 !<pre>
141 ! solve_em_tl is the main driver for advancing a grid a single timestep.
142 ! It is a mediation-layer routine -> DM and SM calls are made where
143 ! needed for parallel processing.
144 !
145 ! solve_em_tl can integrate the equations using 2 time-integration methods
146 !
147 ! - 3rd order Runge-Kutta time integration (recommended)
148 !
149 ! - 2nd order Runge-Kutta time integration
150 !
151 ! The main sections of solve_em_tl are
152 !
153 ! (1) Runge-Kutta (RK) loop
154 !
155 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
156 ! model state variables during the first RK sub-step (loop)
157 !
158 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
159 !
160 ! (4) Scalar advance for moist and chem scalar variables (and TKE)
161 ! within the RK sub-steps.
162 !
163 ! (5) time-split physics (after the RK step), currently this includes
164 ! only microphyics
165 !
166 ! A more detailed description of these sections follows.
167 !</pre>
168 !</DESCRIPTION>
169
170 ! Initialize timers if compiled with -DBENCH
171 #include "bench_solve_em_init.h"
172
173 ! xyh identity operation return here
174 return
175
176
177 ! set runge-kutta solver (2nd or 3rd order)
178
179 dynamics_option = config_flags%rk_ord
180
181 ! Obtain dimension information stored in the grid data structure.
182 CALL get_ijk_from_grid ( grid , &
183 ids, ide, jds, jde, kds, kde, &
184 ims, ime, jms, jme, kms, kme, &
185 ips, ipe, jps, jpe, kps, kpe )
186
187 k_start = kps
188 k_end = kpe
189
190 ijds = min(ids, jds)
191 ijde = max(ide, jde)
192
193 num_3d_m = num_moist
194 num_3d_c = num_chem
195 num_3d_s = num_scalar
196
197 ! Compute these starting and stopping locations for each tile and number of tiles.
198 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
199 CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
200
201 itimestep = itimestep + 1
202
203 !**********************************************************************
204 !
205 ! LET US BEGIN.......
206 !
207 !<DESCRIPTION>
208 !<pre>
209 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
210 !
211 ! Predictor-corrector type time integration.
212 ! Advection terms are evaluated at time t for the predictor step,
213 ! and advection is re-evaluated with the latest predicted value for
214 ! each succeeding time corrector step
215 !
216 ! 2nd order Runge Kutta (rk_order = 2):
217 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
218 !
219 ! 3rd order Runge Kutta (rk_order = 3):
220 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
221 ! and step 3 is from t to dt.
222 !
223 ! non-timesplit physics are evaluated during first RK step and
224 ! these physics tendencies are stored for use in each RK pass.
225 !</pre>
226 !</DESCRIPTION>
227 !**********************************************************************
228
229 #ifdef WRF_CHEM
230 !
231 ! prepare chem aerosols for advection before communication
232 ! so far only for RADM2/SORGAM choice
233 !
234
235 kte=min(k_end,kde-1)
236 !
237 ! change units for advection to mixing ratio
238 !
239 if(imicrogram == 1)then
240
241 if ( p_so4aj >= PARAM_FIRST_SCALAR ) then
242 !$OMP PARALLEL DO &
243 !$OMP PRIVATE ( ij ,its,ite,jts,jte,kte)
244 aerosol_decouple_loop : DO ij = 1 , grid%num_tiles
245 its = max(grid%i_start(ij),ids)
246 ite = min(grid%i_end(ij),ide-1)
247 jts = max(grid%j_start(ij),jds)
248 jte = min(grid%j_end(ij),jde-1)
249 do l=p_so4aj,num_chem
250 do j=jts,jte
251 do k=k_start,kte+1
252 kk=min(k,kde-1)
253 do i=its,ite
254 chem(i,k,j,l)=chem(i,kk,j,l)*alt(i,kk,j)
255 enddo
256 enddo
257 enddo
258 enddo
259 enddo aerosol_decouple_loop
260 endif
261 imicrogram=0
262 endif
263 # ifdef DM_PARALLEL
264 if ( num_chem >= PARAM_FIRST_SCALAR ) then
265 !-----------------------------------------------------------------------
266 ! see above
267 !--------------------------------------------------------------
268 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
269 IF ( h_mom_adv_order <= 4 ) THEN
270 #include "HALO_EM_CHEM_E_3.inc"
271 ELSE IF ( h_mom_adv_order <= 6 ) THEN
272 #include "HALO_EM_CHEM_E_5.inc"
273 ELSE
274 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
275 CALL wrf_error_fatal(TRIM(wrf_err_message))
276 ENDIF
277 endif
278 # endif
279 !--------------------------------------------------------------
280 #endif
281
282 rk_order = config_flags%rk_ord
283 dts = dt/float(time_step_sound)
284
285 Runge_Kutta_loop: DO rk_step = 1, rk_order
286
287 ! Set the step size and number of small timesteps for
288 ! each part of the timestep
289
290 dtm = dt
291 IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
292
293 IF ( rk_step == 1) THEN
294 dt_rk = 0.5*dt
295 dts_rk = dts
296 number_of_small_timesteps = time_step_sound/2
297 ELSE
298 dt_rk = dt
299 dts_rk = dts
300 number_of_small_timesteps = time_step_sound
301 ENDIF
302
303 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
304
305 IF ( rk_step == 1) THEN
306 dt_rk = dt/3.
307 dts_rk = dt_rk
308 number_of_small_timesteps = 1
309 ELSE IF (rk_step == 2) THEN
310 dt_rk = 0.5*dt
311 dts_rk = dts
312 number_of_small_timesteps = time_step_sound/2
313 ELSE
314 dt_rk = dt
315 dts_rk = dts
316 number_of_small_timesteps = time_step_sound
317 ENDIF
318
319 ELSE
320
321 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
322 CALL wrf_error_fatal( wrf_err_message )
323
324 END IF
325
326 !
327 ! Time level t is in the *_2 variable in the first part
328 ! of the step, and in the *_1 variable after the predictor.
329 ! the latest predicted values are stored in the *_2 variables.
330 !
331 CALL wrf_debug ( 200 , ' call rk_step_prep ' )
332
333 BENCH_START(step_prep_tim)
334 !$OMP PARALLEL DO &
335 !$OMP PRIVATE ( ij )
336
337 DO ij = 1 , grid%num_tiles
338 #if 0
339 CALL rk_step_prep ( config_flags, rk_step, &
340 u_2, v_2, w_2, t_2, ph_2, mu_2, &
341 moist, &
342 ru, rv, rw, ww, php, alt, muu, muv, &
343 mub, mut, phb, pb, p, al, alb, &
344 cqu, cqv, cqw, &
345 msfu, msfv, msft, &
346 fnm, fnp, dnw, rdx, rdy, &
347 num_3d_m, &
348 ids, ide, jds, jde, kds, kde, &
349 ims, ime, jms, jme, kms, kme, &
350 grid%i_start(ij), grid%i_end(ij), &
351 grid%j_start(ij), grid%j_end(ij), &
352 k_start, k_end )
353 #endif
354
355 call g_rk_step_prep( config_flags, &
356 u_2,g_u_2,v_2,g_v_2,w_2,g_w_2, &
357 ph_2,g_ph_2,mu_2,g_mu_2, &
358 moist,g_moist, &
359 ru,g_ru,rv,g_rv,rw,g_rw,ww,g_ww, &
360 php,g_php,alt,g_alt,muu,g_muu, &
361 muv,g_muv,mub,mut,g_mut,phb, &
362 al,g_al,alb,cqu,g_cqu,cqv,g_cqv, &
363 cqw,g_cqw,msfu,msfv,msft, &
364 dnw,rdx,rdy,num_3d_m, &
365 ids,ide,jds,jde,kde, &
366 ims,ime,jms,jme,kms,kme, &
367 grid%i_start(ij),grid%i_end(ij), &
368 grid%j_start(ij),grid%j_end(ij), &
369 k_start,k_end )
370
371 END DO
372
373 !$OMP END PARALLEL DO
374 BENCH_END(step_prep_tim)
375
376 #ifdef DM_PARALLEL
377 !-----------------------------------------------------------------------
378 ! Stencils for patch communications (WCS, 29 June 2001)
379 ! Note: the small size of this halo exchange reflects the
380 ! fact that we are carrying the uncoupled variables
381 ! as state variables in the mass coordinate model, as
382 ! opposed to the coupled variables as in the height
383 ! coordinate model.
384 !
385 ! * * * * *
386 ! * * * * * * * * *
387 ! * + * * + * * * + * *
388 ! * * * * * * * * *
389 ! * * * * *
390 !
391 ! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
392 !
393 !j ru x
394 !j rv x
395 !j ww x
396 !j php x
397 !j alt x
398 !j ph_2 x
399 !j phb x
400 !
401 ! the following are 2D (xy) variables
402 !
403 !j muu x
404 !j muv x
405 !j mut x
406 !--------------------------------------------------------------
407 #include "HALO_EM_A.inc"
408 #endif
409
410 ! set boundary conditions on variables
411 ! from big_step_prep for use in big_step_proc
412
413 #ifdef DM_PARALLEL
414 #include "PERIOD_BDY_EM_A.inc"
415 #endif
416
417 ! CALL set_tiles ( grid , ids , ide , jds , jde , ips-1 , ipe+1 , jps-1 , jpe+1 )
418
419 BENCH_START(set_phys_bc_tim)
420 if(dyn_opt == DYN_EM) then
421 !$OMP PARALLEL DO &
422 !$OMP PRIVATE ( ij )
423
424 DO ij = 1 , grid%num_tiles
425
426 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
427
428 CALL rk_phys_bc_dry_1( config_flags, ru, rv, rw, ww, &
429 muu, muv, mut, php, alt, p, &
430 ids, ide, jds, jde, kds, kde, &
431 ims, ime, jms, jme, kms, kme, &
432 ips, ipe, jps, jpe, kps, kpe, &
433 grid%i_start(ij), grid%i_end(ij), &
434 grid%j_start(ij), grid%j_end(ij), &
435 k_start, k_end )
436
437 CALL set_physical_bc3d( ph_2, 'w', config_flags, &
438 ids, ide, jds, jde, kds, kde, &
439 ims, ime, jms, jme, kms, kme, &
440 ips, ipe, jps, jpe, kps, kpe, &
441 grid%i_start(ij), grid%i_end(ij), &
442 grid%j_start(ij), grid%j_end(ij), &
443 k_start, k_end )
444
445 END DO
446 !$OMP END PARALLEL DO
447 endif
448 BENCH_END(set_phys_bc_tim)
449
450 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
451
452 ! initialize all tendencies to zero in order to update physics
453 ! tendencies first (separate from dry dynamics).
454
455 BENCH_START(init_zero_tend_tim)
456 !$OMP PARALLEL DO &
457 !$OMP PRIVATE ( ij )
458
459 DO ij = 1 , grid%num_tiles
460
461 CALL wrf_debug ( 200 , ' call init_zero_tendency' )
462 #if 0
463 CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf, &
464 ph_tendf, t_tendf, tke_tend, &
465 moist_tend,chem_tend, &
466 num_3d_m,num_3d_c,rk_step, &
467 ids, ide, jds, jde, kds, kde, &
468 ims, ime, jms, jme, kms, kme, &
469 grid%i_start(ij), grid%i_end(ij), &
470 grid%j_start(ij), grid%j_end(ij), &
471 k_start, k_end )
472 #endif
473 call g_init_zero_tendency ( ru_tendf,g_ru_tendf,rv_tendf,g_rv_tendf, &
474 rw_tendf,g_rw_tendf,ph_tendf,g_ph_tendf,t_tendf,g_t_tendf,&
475 moist_tend,g_moist_tend, &
476 chem_tend,g_chem_tend, &
477 scalar_tend,g_scalar_tend, &
478 num_3d_m, num_3d_c,num_3d_s, &
479 ims, ime, jms, jme, kms, kme, &
480 grid%i_start(ij), grid%i_end(ij), &
481 grid%j_start(ij), grid%j_end(ij), &
482 k_start, k_end )
483 END DO
484 !$OMP END PARALLEL DO
485 BENCH_END(init_zero_tend_tim)
486
487 #ifdef DM_PARALLEL
488 #include "HALO_EM_PHYS_A.inc"
489 #endif
490
491 !<DESCRIPTION>
492 !<pre>
493 !(2) The non-timesplit physics begins with a call to "phy_prep"
494 ! (which computes some diagnostic variables such as temperature,
495 ! pressure, u and v at p points, etc). This is followed by
496 ! calls to the physics drivers:
497 !
498 ! radiation,
499 ! surface,
500 ! pbl,
501 ! cumulus,
502 ! 3D TKE and mixing.
503 !<pre>
504 !</DESCRIPTION>
505
506
507 BENCH_START(phy_prep_tim)
508 !$OMP PARALLEL DO &
509 !$OMP PRIVATE ( ij )
510 DO ij = 1 , grid%num_tiles
511
512 CALL wrf_debug ( 200 , ' call phy_prep' )
513 #if 0
514 CALL phy_prep ( config_flags, &
515 mut, u_2, v_2, p, pb, alt, &
516 ph_2, phb, t_2, tsk, moist, num_3d_m, &
517 mu_3d, rho, &
518 th_phy, p_phy, pi_phy, u_phy, v_phy, &
519 p8w, t_phy, t8w, z, z_at_w, &
520 dz8w, fnm, fnp, &
521 RTHRATEN, &
522 RTHBLTEN, RUBLTEN, RVBLTEN, &
523 RQVBLTEN, RQCBLTEN, RQIBLTEN, &
524 RTHCUTEN, RQVCUTEN, RQCCUTEN, &
525 RQRCUTEN, RQICUTEN, RQSCUTEN, &
526 RTHFTEN, RQVFTEN, &
527 ids, ide, jds, jde, kds, kde, &
528 ims, ime, jms, jme, kms, kme, &
529 grid%i_start(ij), grid%i_end(ij), &
530 grid%j_start(ij), grid%j_end(ij), &
531 k_start, k_end )
532 #endif
533 call g_phy_prep( p,g_p,pb,ph_2,g_ph_2,phb,t_2,g_t_2,mu_3d,rho,th_phy,g_th_phy,p_phy,g_p_phy,pi_phy,g_pi_phym,u_phy,v_phy,p8w,&
534 &g_p8w,t_phy,g_t_phy,t8w,g_t8w,z,g_z,z_at_w,g_z_at_wm,dz8w,fnm,fnp,rthraten,rthblten,rublten,rvblten,rqvblten,rqcblten,&
535 &rqiblten,rthcuten,rqvcuten,rqccuten,rqrcuten,rqicuten,rqscuten,rthften,rqvften,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%&
536 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
537 ENDDO
538 !$OMP END PARALLEL DO
539
540 BENCH_END(phy_prep_tim)
541
542 ! physics to implement
543
544 ! CALL set_tiles ( grid , ids , ide-1 , jds , jde-1 ips , ipe , jps , jpe )
545
546 ! Open MP loops are in physics drivers
547 ! radiation
548
549 CALL wrf_debug ( 200 , ' call radiation_driver' )
550 BENCH_START(rad_driver_tim)
551 if(dyn_opt == DYN_EM) then
552 CALL radiation_driver( &
553 & ACFRCV=acfrcv ,ACFRST=acfrst ,ALBEDO=albedo &
554 & ,CFRACH=cfrach ,CFRACL=cfracl ,CFRACM=cfracm &
555 & ,CUPPT=cuppt ,CZMEAN=czmean ,DT=grid%dt &
556 & ,DZ8W=dz8w ,EMISS=emiss ,GLW=glw &
557 & ,GMT=grid%gmt ,GSW=gsw ,HBOT=hbot &
558 & ,HTOP=htop ,HBOTR=hbotr, HTOPR=htopr ,ICLOUD=config_flags%icloud &
559 & ,ITIMESTEP=itimestep,JULDAY=grid%julday, JULIAN=julian &
560 & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics &
561 & ,NCFRCV=ncfrcv ,NCFRST=ncfrst ,NPHS=1 &
562 & ,P8W=p8w ,P=p_phy ,PI=pi_phy &
563 & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset &
564 & ,RHO=rho ,RLWTOA=rlwtoa &
565 & ,RSWTOA=rswtoa ,RTHRATEN=rthraten &
566 & ,RTHRATENLW=rthratenlw &
567 & ,RTHRATENSW=rthratensw ,SNOW=snow &
568 & ,STEPRA=stepra ,SWDOWN=swdown ,SWDOWNC=swdownc &
569 & ,SW_PHYSICS=config_flags%ra_sw_physics ,T8W=t8w &
570 & ,T=t_phy ,TAUCLDC=taucldc ,TAUCLDI=taucldi &
571 & ,TSK=tsk ,VEGFRA=vegfra ,WARM_RAIN=warm_rain &
572 & ,XICE=xice &
573 & ,XLAND=xland ,XLAT=xlat ,XLONG=xlong &
574 & ,Z=z &
575 & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm &
576 & ,N_AEROSOLC=num_aerosolc &
577 & ,PAERLEV=grid%paerlev &
578 & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 &
579 & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s &
580 & ,XTIME=xtime &
581 ! indexes
582 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
583 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
584 & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) &
585 & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) &
586 & ,kts=k_start, kte=min(k_end,kde-1) &
587 & ,num_tiles=grid%num_tiles &
588 ! Optional
589 & , CLDFRA=CLDFRA &
590 & , Pb=pb &
591 & , F_ICE_PHY=f_ice_phy,F_RAIN_PHY=f_rain_phy &
592 & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV &
593 & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC &
594 & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
595 & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI &
596 & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS &
597 & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG &
598 #ifdef ACFLUX
599 & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc &
600 & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc &
601 & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc &
602 & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc &
603 & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc &
604 & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc &
605 & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc &
606 & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc &
607 & ,SWUPT=swupt ,SWUPTC=swuptc &
608 & ,SWDNT=swdnt ,SWDNTC=swdntc &
609 & ,SWUPB=swupb ,SWUPBC=swupbc &
610 & ,SWDNB=swdnb ,SWDNBC=swdnbc &
611 & ,LWUPT=lwupt ,LWUPTC=lwuptc &
612 & ,LWDNT=lwdnt ,LWDNTC=lwdntc &
613 & ,LWUPB=lwupb ,LWUPBC=lwupbc &
614 & ,LWDNB=lwdnb ,LWDNBC=lwdnbc &
615 #endif
616 & ,LWCF=lwcf &
617 & ,SWCF=swcf &
618 & ,OLR=olr &
619 & ,OZMIXM=ozmixm, PIN=pin &
620 & ,M_PS_1=m_ps_1, M_PS_2=m_ps_2, AEROSOLC_1=aerosolc_1 &
621 & ,AEROSOLC_2=aerosolc_2, M_HYBI0=m_hybi &
622 & ,ABSTOT=abstot, ABSNXT=absnxt, EMSTOT=emstot &
623 #ifdef WRF_CHEM
624 & ,PM2_5_DRY=pm2_5_dry, PM2_5_WATER=pm2_5_water &
625 & ,PM2_5_DRY_EC=pm2_5_dry_ec &
626 & ,TAUAER300=tauaer1, TAUAER400=tauaer2, TAUAER600=tauaer3, TAUAER999=tauaer4 & ! jcb
627 & ,GAER300=gaer1, GAER400=gaer2, GAER600=gaer3, GAER999=gaer4 & ! jcb
628 & ,WAER300=waer1, WAER400=waer2, WAER600=waer3, WAER999=waer4 & ! jcb
629 #endif
630 & )
631 endif
632 BENCH_END(rad_driver_tim)
633
634
635
636 !********* Surface driver
637 ! surface
638
639 BENCH_START(surf_driver_tim)
640 if(dyn_opt == DYN_EM) then
641 CALL wrf_debug ( 200 , ' call surface_driver' )
642 CALL surface_driver( &
643 & ACSNOM=acsnom ,ACSNOW=acsnow ,AKHS=akhs &
644 & ,AKMS=akms ,ALBBCK=albbck ,ALBEDO=albedo &
645 & ,BR=br ,CANWAT=canwat ,CHKLOWQ=chklowq &
646 & ,CT=ct ,DT=dt ,DX=dx &
647 & ,DZ8W=dz8w ,DZS=dzs ,FLHC=flhc &
648 & ,FLQC=flqc ,GLW=glw ,GRDFLX=grdflx &
649 & ,GSW=gsw ,GZ1OZ0=gz1oz0 ,HFX=hfx &
650 & ,HT=ht ,IFSNOW=ifsnow ,ISFFLX=isfflx &
651 & ,ISLTYP=isltyp ,ITIMESTEP=itimestep &
652 & ,IVGTYP=ivgtyp ,LH=lh ,LOWLYR=lowlyr &
653 & ,MAVAIL=mavail ,NUM_SOIL_LAYERS=num_soil_layers &
654 & ,P8W=p8w ,PBLH=pblh ,PI_PHY=pi_phy &
655 & ,PSFC=psfc ,PSHLTR=pshltr ,PSIH=psih &
656 & ,PSIM=psim ,P_PHY=p_phy ,Q10=q10 &
657 & ,Q2=q2 ,QFX=qfx ,QSFC=qsfc &
658 & ,QSHLTR=qshltr ,QZ0=qz0 ,RAINCV=raincv &
659 & ,RA_LW_PHYSICS=ra_lw_physics ,RHO=rho &
660 & ,RMOL=rmol ,SFCEVP=sfcevp ,SFCEXC=sfcexc &
661 & ,SFCRUNOFF=sfcrunoff &
662 & ,SF_SFCLAY_PHYSICS=sf_sfclay_physics &
663 & ,SF_SURFACE_PHYSICS=sf_surface_physics ,SH2O=sh2o &
664 & ,SHDMAX=shdmax ,SHDMIN=shdmin ,SMOIS=smois &
665 & ,SMSTAV=smstav ,SMSTOT=smstot ,SNOALB=snoalb &
666 & ,SNOW=snow ,SNOWC=snowc ,SNOWH=snowh &
667 & ,SST=sst ,SST_UPDATE=sst_update &
668 & ,STEPBL=stepbl ,TH10=th10 ,TH2=th2 &
669 & ,THZ0=thz0 ,TH_PHY=th_phy ,TKE_MYJ=tke_myj &
670 & ,TMN=tmn ,TSHLTR=tshltr ,TSK=tsk &
671 & ,TSLB=tslb ,T_PHY=t_phy ,U10=u10 &
672 & ,UDRUNOFF=udrunoff ,UST=ust ,UZ0=uz0 &
673 & ,U_FRAME=u_frame ,U_PHY=u_phy ,V10=v10 &
674 & ,VEGFRA=vegfra ,VZ0=vz0 ,V_FRAME=v_frame &
675 & ,V_PHY=v_phy ,WARM_RAIN=warm_rain &
676 & ,WSPD=wspd ,XICE=xice ,XLAND=xland &
677 & ,Z0=z0 ,Z=z ,ZNT=znt &
678 & ,ZS=zs &
679 ! Indexes
680 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
681 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
682 & , I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
683 & , J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
684 & , KTS=k_start, KTE=min(k_end,kde-1) &
685 & , NUM_TILES=grid%num_tiles &
686 ! Optional
687 & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
688 & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
689 & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
690 & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
691 & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
692 & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
693 & ,CAPG=capg, EMISS=emiss, HOL=hol,MOL=mol &
694 & ,RAINBL=rainbl &
695 & ,RAINNCV=rainncv,REGIME=regime,T2=t2,THC=thc &
696 & ,QSG=qsg,QVG=qvg,QCG=qcg,SOILT1=soilt1,TSNAV=tsnav & ! ruc lsm
697 & ,SMFR3D=smfr3d,KEEPFR3DFLAG=keepfr3dflag & ! ruc lsm
698 & )
699 endif
700 BENCH_END(surf_driver_tim)
701
702 !*********
703 ! pbl
704
705 BENCH_START(pbl_driver_tim)
706 if(dyn_opt == DYN_EM) then
707 CALL wrf_debug ( 200 , ' call pbl_driver' )
708 CALL pbl_driver( &
709 & AKHS=akhs ,AKMS=akms &
710 & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics &
711 & ,BR=br ,CHKLOWQ=chklowq ,CT=ct &
712 & ,DT=dt ,DX=dx ,DZ8W=dz8w &
713 & ,EL_MYJ=el_myj ,EXCH_H=exch_h ,GRDFLX=grdflx &
714 & ,GZ1OZ0=gz1oz0 ,HFX=hfx ,HT=ht &
715 & ,ITIMESTEP=itimestep ,KPBL=kpbl &
716 & ,LH=lh ,LOWLYR=lowlyr ,P8W=p8w &
717 & ,PBLH=pblh ,PI_PHY=pi_phy ,PSIH=psih &
718 & ,PSIM=psim ,P_PHY=p_phy ,QFX=qfx &
719 & ,QSFC=qsfc ,QZ0=qz0 &
720 & ,RA_LW_PHYSICS=config_flags%ra_lw_physics &
721 & ,RHO=rho ,RQCBLTEN=rqcblten ,RQIBLTEN=rqiblten &
722 & ,RQVBLTEN=rqvblten ,RTHBLTEN=rthblten ,RUBLTEN=rublten &
723 & ,RVBLTEN=rvblten ,SNOW=snow ,STEPBL=stepbl &
724 & ,THZ0=thz0 ,TH_PHY=th_phy ,TKE_MYJ=tke_myj &
725 & ,TSK=tsk ,T_PHY=t_phy ,UST=ust &
726 & ,UZ0=uz0 ,U_FRAME=u_frame ,U_PHY=u_phy &
727 & ,VZ0=vz0 ,V_FRAME=v_frame ,V_PHY=v_phy &
728 & ,WARM_RAIN=warm_rain ,WSPD=wspd &
729 & ,XICE=xice ,XLAND=xland ,Z=z &
730 & ,ZNT=znt &
731 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
732 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
733 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
734 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
735 & ,KTS=k_start, KTE=min(k_end,kde-1) &
736 & ,NUM_TILES=grid%num_tiles &
737 ! optional
738 & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
739 & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
740 & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
741 & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
742 & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
743 & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
744 & ,HOL=HOL, MOL=MOL, REGIME=REGIME &
745 & )
746 endif
747 BENCH_END(pbl_driver_tim)
748
749 ! cumulus para.
750
751 BENCH_START(cu_driver_tim)
752 if(dyn_opt == DYN_EM) then
753 CALL wrf_debug ( 200 , ' call cumulus_driver' )
754 CALL cumulus_driver( &
755 ! Prognostic variables
756 & U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy &
757 & ,W=w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho &
758 ! Other arguments
759 & ,ITIMESTEP=itimestep ,DT=dt ,DX=dx &
760 & ,RAINC=rainc ,RAINCV=raincv ,NCA=nca &
761 & ,HTOP=htop ,HBOT=hbot ,KPBL=kpbl &
762 & ,DZ8W=dz8w ,P8W=p8w &
763 & ,W0AVG=w0avg ,STEPCU=stepcu &
764 & ,CLDEFI=cldefi ,LOWLYR=lowlyr ,XLAND=xland &
765 & ,APR_GR=apr_gr ,APR_W=apr_w ,APR_MC=apr_mc &
766 & ,APR_ST=apr_st ,APR_AS=apr_as ,APR_CAPMA=apr_capma &
767 & ,APR_CAPME=apr_capme ,APR_CAPMI=apr_capmi &
768 & ,MASS_FLUX=mass_flux ,XF_ENS=xf_ens &
769 & ,PR_ENS=pr_ens ,HT=ht &
770 & ,ENSDIM=ensdim ,MAXIENS=maxiens ,MAXENS=maxens &
771 & ,MAXENS2=maxens2 ,MAXENS3=maxens3 &
772 & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=warm_rain &
773 ! Selection flag
774 & ,CU_PHYSICS=config_flags%cu_physics &
775 ! Dimension arguments
776 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
777 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
778 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
779 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
780 & ,KTS=k_start, KTE=min(k_end,kde-1) &
781 & ,NUM_TILES=grid%num_tiles &
782 ! Moisture tendency arguments
783 & ,RQVCUTEN=rqvcuten , RQCCUTEN=rqccuten &
784 & ,RQRCUTEN=rqrcuten , RQVBLTEN=rqvblten &
785 & ,RQVFTEN=rqvften &
786 ! Other tendency arguments
787 & ,RTHRATEN=rthraten , RTHBLTEN=rthblten &
788 & ,RTHCUTEN=rthcuten , RTHFTEN=rthften &
789 ! Moisture tracer arguments
790 & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
791 & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
792 & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
793 & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
794 & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
795 & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
796 & )
797 endif
798 BENCH_END(cu_driver_tim)
799
800 ! calculate_phy_tend
801
802 BENCH_START(cal_phy_tend)
803 if(dyn_opt == DYN_EM) then
804 !$OMP PARALLEL DO &
805 !$OMP PRIVATE ( ij )
806
807 DO ij = 1 , grid%num_tiles
808
809 CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
810 CALL calculate_phy_tend (config_flags,mut,pi_phy, &
811 RTHRATEN, &
812 RUBLTEN,RVBLTEN,RTHBLTEN, &
813 RQVBLTEN,RQCBLTEN,RQIBLTEN, &
814 RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
815 RQICUTEN,RQSCUTEN, &
816 ids,ide, jds,jde, kds,kde, &
817 ims,ime, jms,jme, kms,kme, &
818 grid%i_start(ij), min(grid%i_end(ij),ide-1), &
819 grid%j_start(ij), min(grid%j_end(ij),jde-1), &
820 k_start , min(k_end,kde-1) )
821
822 ENDDO
823 !$OMP END PARALLEL DO
824 endif
825 BENCH_END(cal_phy_tend)
826
827 ! tke diffusion
828
829 IF(diff_opt .eq. 2 .OR. diff_opt .eq. 1) THEN
830
831 BENCH_START(comp_diff_metrics_tim)
832 if(dyn_opt == DYN_EM) then
833 !$OMP PARALLEL DO &
834 !$OMP PRIVATE ( ij )
835
836 DO ij = 1 , grid%num_tiles
837
838 CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
839 CALL compute_diff_metrics ( config_flags, ph_2, phb, z, rdz, rdzw, &
840 zx, zy, rdx, rdy, &
841 ids, ide, jds, jde, kds, kde, &
842 ims, ime, jms, jme, kms, kme, &
843 grid%i_start(ij), grid%i_end(ij), &
844 grid%j_start(ij), grid%j_end(ij), &
845 k_start , k_end )
846 ENDDO
847 !$OMP END PARALLEL DO
848 endif
849 BENCH_END(comp_diff_metrics_tim)
850
851 #ifdef DM_PARALLEL
852 #include "PERIOD_BDY_EM_A1.inc"
853 #endif
854
855 BENCH_START(tke_diff_bc_tim)
856 if(dyn_opt == DYN_EM) then
857 DO ij = 1 , grid%num_tiles
858
859 CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
860 CALL set_physical_bc3d( rdzw , '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 grid%i_start(ij), grid%i_end(ij), &
865 grid%j_start(ij), grid%j_end(ij), &
866 k_start , k_end )
867 CALL set_physical_bc3d( rdz , 'w', config_flags, &
868 ids, ide, jds, jde, kds, kde, &
869 ims, ime, jms, jme, kms, kme, &
870 ips, ipe, jps, jpe, kps, kpe, &
871 grid%i_start(ij), grid%i_end(ij), &
872 grid%j_start(ij), grid%j_end(ij), &
873 k_start , k_end )
874 CALL set_physical_bc3d( z , 'w', config_flags, &
875 ids, ide, jds, jde, kds, kde, &
876 ims, ime, jms, jme, kms, kme, &
877 ips, ipe, jps, jpe, kps, kpe, &
878 grid%i_start(ij), grid%i_end(ij), &
879 grid%j_start(ij), grid%j_end(ij), &
880 k_start , k_end )
881 CALL set_physical_bc3d( zx , 'w', config_flags, &
882 ids, ide, jds, jde, kds, kde, &
883 ims, ime, jms, jme, kms, kme, &
884 ips, ipe, jps, jpe, kps, kpe, &
885 grid%i_start(ij), grid%i_end(ij), &
886 grid%j_start(ij), grid%j_end(ij), &
887 k_start , k_end )
888 CALL set_physical_bc3d( zy , 'w', config_flags, &
889 ids, ide, jds, jde, kds, kde, &
890 ims, ime, jms, jme, kms, kme, &
891 ips, ipe, jps, jpe, kps, kpe, &
892 grid%i_start(ij), grid%i_end(ij), &
893 grid%j_start(ij), grid%j_end(ij), &
894 k_start , k_end )
895
896 ENDDO
897 endif
898 BENCH_END(tke_diff_bc_tim)
899
900 #ifdef DM_PARALLEL
901 #include "HALO_EM_TKE_C.inc"
902 #endif
903
904 BENCH_START(deform_div_tim)
905 if(dyn_opt == DYN_EM) then
906 !$OMP PARALLEL DO &
907 !$OMP PRIVATE ( ij )
908
909 DO ij = 1 , grid%num_tiles
910
911 CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
912 CALL cal_deform_and_div ( config_flags,u_2,v_2,w_2,div, &
913 defor11,defor22,defor33,defor12, &
914 defor13,defor23, &
915 u_base, v_base,msfu,msfv,msft, &
916 rdx, rdy, dn, dnw, rdz, rdzw, &
917 fnm,fnp,cf1,cf2,cf3,zx,zy, &
918 ids, ide, jds, jde, kds, kde, &
919 ims, ime, jms, jme, kms, kme, &
920 grid%i_start(ij), grid%i_end(ij), &
921 grid%j_start(ij), grid%j_end(ij), &
922 k_start , k_end )
923 ENDDO
924 !$OMP END PARALLEL DO
925 endif
926 BENCH_END(deform_div_tim)
927
928
929 #ifdef DM_PARALLEL
930 #include "HALO_EM_TKE_D.inc"
931 #endif
932
933
934 ! calculate tke, kmh, and kmv
935
936 BENCH_START(calc_tke_tim)
937 !$OMP PARALLEL DO &
938 !$OMP PRIVATE ( ij )
939
940 DO ij = 1 , grid%num_tiles
941 #if 0
942 CALL wrf_debug ( 200 , ' call calculate_km_kh' )
943 CALL calculate_km_kh( config_flags,dt,dampcoef,zdamp,damp_opt, &
944 xkmh,xkmhd,xkmv,xkhh,xkhv,BN2, &
945 khdif,kvdif,div, &
946 defor11,defor22,defor33,defor12, &
947 defor13,defor23, &
948 tke_2(ims,kms,jms),p8w,t8w,th_phy, &
949 t_phy,p_phy,moist,dn,dnw, &
950 dx,dy,rdz,rdzw,mix_cr_len,num_3d_m, &
951 cf1, cf2, cf3, warm_rain, &
952 kh_tke_upper_bound, kv_tke_upper_bound, &
953 ids,ide, jds,jde, kds,kde, &
954 ims,ime, jms,jme, kms,kme, &
955 grid%i_start(ij), grid%i_end(ij), &
956 grid%j_start(ij), grid%j_end(ij), &
957 k_start , k_end )
958 #endif
959 call g_calculate_km_kh( config_flags,dt,dampcoef,zdamp,damp_opt,xkmh,xkmhd,g_xkmhd,xkmv,xkhh,xkhv,bn2,g_bn2m,khdif,defor11,&
960 &defor22,defor33,defor12,defor13,defor23,tke_2(ims,kms,jms),p8w,g_p8w,t8w,g_t8w,th_phy,g_th_phy,t_phy,g_t_phy,p_phy,&
961 &g_p_phy,moist,g_moist,dx,dy,rdz,rdzw,num_3d_m,cf1,cf2,cf3,kh_tke_upper_bound,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,&
962 &kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
963 ENDDO
964 !$OMP END PARALLEL DO
965 BENCH_END(calc_tke_tim)
966
967 #ifdef DM_PARALLEL
968 #include "HALO_EM_TKE_E.inc"
969 #endif
970
971 ENDIF
972
973 #ifdef DM_PARALLEL
974 #include "PERIOD_BDY_EM_PHY_BC.inc"
975 #include "PERIOD_BDY_EM_CHEM.inc"
976 #endif
977
978 BENCH_START(phy_bc_tim)
979 if(dyn_opt == DYN_EM) then
980 !$OMP PARALLEL DO &
981 !$OMP PRIVATE ( ij )
982
983 DO ij = 1 , grid%num_tiles
984
985 CALL wrf_debug ( 200 , ' call phy_bc' )
986 CALL phy_bc (config_flags,div,defor11,defor22,defor33, &
987 defor12,defor13,defor23, &
988 xkmh,xkmhd,xkmv,xkhh,xkhv, &
989 tke_2(ims,kms,jms), &
990 RUBLTEN, RVBLTEN, &
991 ids, ide, jds, jde, kds, kde, &
992 ims, ime, jms, jme, kms, kme, &
993 ips, ipe, jps, jpe, kps, kpe, &
994 grid%i_start(ij), grid%i_end(ij), &
995 grid%j_start(ij), grid%j_end(ij), &
996 k_start , k_end )
997 ENDDO
998 !$OMP END PARALLEL DO
999 endif
1000 BENCH_END(phy_bc_tim)
1001
1002 #ifdef DM_PARALLEL
1003 !-----------------------------------------------------------------------
1004 !
1005 ! MPP for some physics tendency, km, kh, deformation, and divergence
1006 !
1007 ! * *
1008 ! * + * * + * +
1009 ! * *
1010 !
1011 ! (for PBL)
1012 ! RUBLTEN x
1013 ! RVBLTEN x
1014 !
1015 ! (for diff_opt >= 1)
1016 ! defor11 x
1017 ! defor22 x
1018 ! defor12 x
1019 ! defor13 x
1020 ! defor23 x
1021 ! div x
1022 ! xkmv x
1023 ! xkmh x
1024 ! xkmhd x
1025 ! xkhv x
1026 ! xkhh x
1027 ! tke x
1028 !
1029 !-----------------------------------------------------------------------
1030 IF ( bl_pbl_physics .ge. 1 ) THEN
1031 #include "HALO_EM_PHYS_PBL.inc"
1032 ENDIF
1033 IF ( diff_opt .ge. 1 ) THEN
1034 #include "HALO_EM_PHYS_DIFFUSION.inc"
1035 ENDIF
1036
1037 IF ( h_mom_adv_order <= 4 ) THEN
1038 #include "HALO_EM_TKE_3.inc"
1039 ELSE IF ( h_mom_adv_order <= 6 ) THEN
1040 #include "HALO_EM_TKE_5.inc"
1041 ELSE
1042 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
1043 CALL wrf_error_fatal(TRIM(wrf_err_message))
1044 ENDIF
1045 #endif
1046
1047 BENCH_START(update_phy_ten_tim)
1048 if(dyn_opt == DYN_EM) then
1049 !$OMP PARALLEL DO &
1050 !$OMP PRIVATE ( ij )
1051
1052 DO ij = 1 , grid%num_tiles
1053
1054 CALL wrf_debug ( 200 , ' call update_phy_ten' )
1055 CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend, &
1056 RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN, &
1057 RQVBLTEN,RQCBLTEN,RQIBLTEN, &
1058 RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
1059 num_3d_m,config_flags,rk_step, &
1060 ids, ide, jds, jde, kds, kde, &
1061 ims, ime, jms, jme, kms, kme, &
1062 grid%i_start(ij), grid%i_end(ij), &
1063 grid%j_start(ij), grid%j_end(ij), &
1064 k_start, k_end )
1065
1066 END DO
1067 !$OMP END PARALLEL DO
1068 endif
1069 BENCH_END(update_phy_ten_tim)
1070
1071 IF( diff_opt .eq. 2 .and. km_opt .eq. 2 ) THEN
1072
1073 BENCH_START(tke_rhs_tim)
1074 if(dyn_opt == DYN_EM) then
1075 !$OMP PARALLEL DO &
1076 !$OMP PRIVATE ( ij )
1077
1078 DO ij = 1 , grid%num_tiles
1079
1080 CALL tke_rhs ( tke_tend,BN2, &
1081 config_flags,defor11,defor22,defor33, &
1082 defor12,defor13,defor23,u_2,v_2,w_2,div, &
1083 tke_2(ims,kms,jms),mut, &
1084 th_phy,p_phy,p8w,t8w,z,fnm,fnp, &
1085 cf1,cf2,cf3,msft,xkmh,xkmv,xkhv,rdx,rdy, &
1086 dx,dy,dt,zx,zy,rdz,rdzw,dn,dnw,mix_cr_len, &
1087 ids, ide, jds, jde, kds, kde, &
1088 ims, ime, jms, jme, kms, kme, &
1089 grid%i_start(ij), grid%i_end(ij), &
1090 grid%j_start(ij), grid%j_end(ij), &
1091 k_start , k_end )
1092
1093 ENDDO
1094 !$OMP END PARALLEL DO
1095 endif
1096 BENCH_END(tke_rhs_tim)
1097
1098 ENDIF
1099
1100 ! calculate vertical diffusion first and then horizontal
1101 ! (keep this order)
1102
1103 IF(diff_opt .eq. 2) THEN
1104
1105 IF (bl_pbl_physics .eq. 0) THEN
1106
1107 BENCH_START(vert_diff_tim)
1108 if(dyn_opt == DYN_EM) then
1109 !$OMP PARALLEL DO &
1110 !$OMP PRIVATE ( ij )
1111 DO ij = 1 , grid%num_tiles
1112
1113 CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
1114 CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, &
1115 t_tendf, tke_tend, &
1116 moist_tend, num_3d_m, &
1117 chem_tend, num_3d_c, &
1118 scalar_tend, num_3d_s, &
1119 u_2, v_2, &
1120 t_2,u_base,v_base,t_base,qv_base, &
1121 mut,tke_2,config_flags, &
1122 defor13,defor23,defor33, &
1123 div, moist, chem, scalar,xkmv, xkhv, km_opt, &
1124 fnm, fnp, dn, dnw, rdz, rdzw, &
1125 ids, ide, jds, jde, kds, kde, &
1126 ims, ime, jms, jme, kms, kme, &
1127 grid%i_start(ij), grid%i_end(ij), &
1128 grid%j_start(ij), grid%j_end(ij), &
1129 k_start , k_end )
1130
1131 ENDDO
1132 !$OMP END PARALLEL DO
1133 endif
1134 BENCH_END(vert_diff_tim)
1135
1136 ENDIF
1137 !
1138 BENCH_START(hor_diff_tim)
1139 if(dyn_opt == DYN_EM) then
1140 !$OMP PARALLEL DO &
1141 !$OMP PRIVATE ( ij )
1142 DO ij = 1 , grid%num_tiles
1143
1144 CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
1145 CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
1146 tke_tend, &
1147 moist_tend, num_3d_m, &
1148 chem_tend, num_3d_c, &
1149 scalar_tend, num_3d_s, &
1150 t_2, th_phy, &
1151 mut, tke_2, config_flags, &
1152 defor11, defor22, defor12, &
1153 defor13, defor23, div, &
1154 moist, chem,scalar, &
1155 msfu, msfv, msft, xkmhd, xkhh, km_opt, &
1156 rdx, rdy, rdz, rdzw, &
1157 fnm, fnp, cf1, cf2, cf3, &
1158 zx, zy, dn, dnw, &
1159 ids, ide, jds, jde, kds, kde, &
1160 ims, ime, jms, jme, kms, kme, &
1161 grid%i_start(ij), grid%i_end(ij), &
1162 grid%j_start(ij), grid%j_end(ij), &
1163 k_start , k_end )
1164 ENDDO
1165 !$OMP END PARALLEL DO
1166 endif
1167 BENCH_END(hor_diff_tim)
1168
1169 ENDIF
1170
1171 END IF rk_step_is_one
1172
1173
1174 BENCH_START(rk_tend_tim)
1175 !$OMP PARALLEL DO &
1176 !$OMP PRIVATE ( ij )
1177 DO ij = 1 , grid%num_tiles
1178 CALL wrf_debug ( 200 , ' call rk_tendency' )
1179 #if 0
1180 CALL rk_tendency ( config_flags, rk_step, &
1181 ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
1182 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
1183 mu_tend, u_save, v_save, w_save, ph_save, &
1184 t_save, mu_save, RTHFTEN, &
1185 ru, rv, rw, ww, &
1186 u_2, v_2, w_2, t_2, ph_2, &
1187 u_1, v_1, w_1, t_1, ph_1, &
1188 h_diabatic, phb, t_init, &
1189 mu_2, mut, muu, muv, mub, &
1190 al, alt, p, pb, php, cqu, cqv, cqw, &
1191 u_base, v_base, t_base, qv_base, z_base, &
1192 msfu, msfv, msft, f, e, sina, cosa, &
1193 fnm, fnp, rdn, rdnw, &
1194 dt, rdx, rdy, khdif, kvdif, xkmhd, &
1195 cf1, cf2, cf3, cfn, cfn1, num_3d_m, &
1196 non_hydrostatic, &
1197 ids, ide, jds, jde, kds, kde, &
1198 ims, ime, jms, jme, kms, kme, &
1199 grid%i_start(ij), grid%i_end(ij), &
1200 grid%j_start(ij), grid%j_end(ij), &
1201 k_start, k_end )
1202 #endif
1203 call g_rk_tendency( config_flags,rk_step,ru_tend,g_ru_tend,rv_tend,g_rv_tend,rw_tend,g_rw_tend,ph_tend,g_ph_tend,t_tend,&
1204 &g_t_tend,ru_tendf,g_ru_tendf,rv_tendf,g_rv_tendf,rw_tendf,g_rw_tendf,t_tendf,g_t_tendf,mu_tend,g_mu_tend,u_save,g_u_save,&
1205 &v_save,g_v_save,w_save,g_w_save,ph_save,g_ph_save,t_save,g_t_save,ru,g_ru,rv,g_rv,rw,g_rw,ww,g_ww,u_2,g_u_2,v_2,g_v_2,w_2,&
1206 &g_w_2,t_2,g_t_2,ph_2,g_ph_2,u_1,g_u_1,v_1,g_v_1,w_1,g_w_1,t_1,g_t_1,ph_1,g_ph_1,phb,t_init,mu_2,g_mu_2,mut,g_mut,muu,g_muu,&
1207 &muv,g_muv,mub,al,g_al,alt,g_alt,p,g_p,pb,php,g_php,cqu,g_cqu,cqv,g_cqv,cqw,g_cqw,u_base,v_base,z_base,msfu,msfv,msft,f,e,sina,&
1208 &cosa,fnm,fnp,rdn,rdnw,dt,rdx,rdy,kvdif,xkmhd,g_xkmhd,&
1209 dampcoef,zdamp,damp_opt, &
1210 cf1,cf2,cf3,cfn,cfn1,non_hydrostatic,ids,ide,jds,jde,kde,ims,&
1211 &ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1212 END DO
1213 !$OMP END PARALLEL DO
1214 BENCH_END(rk_tend_tim)
1215
1216 BENCH_START(relax_bdy_dry_tim)
1217 !$OMP PARALLEL DO &
1218 !$OMP PRIVATE ( ij )
1219 DO ij = 1 , grid%num_tiles
1220
1221 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
1222 #if 0
1223 CALL relax_bdy_dry ( config_flags, &
1224 u_save, v_save, ph_save, t_save, &
1225 w_save, mu_tend, &
1226 ru, rv, ph_2, t_2, &
1227 w_2, mu_2, mut, &
1228 u_b, v_b, ph_b, t_b, w_b, &
1229 mu_b, &
1230 u_bt, v_bt, ph_bt, t_bt, &
1231 w_bt, mu_bt, &
1232 spec_bdy_width, spec_zone, relax_zone, &
1233 dtbc, fcx, gcx, &
1234 ijds, ijde, &
1235 ids,ide, jds,jde, kds,kde, &
1236 ims,ime, jms,jme, kms,kme, &
1237 ips,ipe, jps,jpe, kps,kpe, &
1238 grid%i_start(ij), grid%i_end(ij), &
1239 grid%j_start(ij), grid%j_end(ij), &
1240 k_start, k_end )
1241 #endif
1242 call g_relax_bdy_dry( config_flags,u_save,g_u_save,v_save,g_v_save,ph_save,g_ph_save,t_save,g_t_save,w_save,g_w_save,mu_tend,&
1243 &g_mu_tend,ru,g_ru,rv,g_rv,ph_2,g_ph_2,t_2,g_t_2,w_2,g_w_2,mu_2,g_mu_2,mut,g_mut,u_b,g_u_b,v_b,g_v_b,ph_b,g_ph_b,t_b,g_t_b,&
1244 &w_b,g_w_b,mu_b,g_mu_b,u_bt,g_u_bt,v_bt,g_v_bt,ph_bt,g_ph_bt,t_bt,g_t_bt,w_bt,g_w_bt,mu_bt,g_mu_bt,spec_bdy_width,spec_zone,&
1245 &relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%&
1246 &j_start(ij),grid%j_end(ij),k_start,k_end )
1247
1248
1249 ENDIF
1250 #if 0
1251 CALL rk_addtend_dry( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
1252 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
1253 u_save, v_save, w_save, ph_save, t_save, rk_step,&
1254 h_diabatic, mut, msft, msfu, msfv, &
1255 ids,ide, jds,jde, kds,kde, &
1256 ims,ime, jms,jme, kms,kme, &
1257 ips,ipe, jps,jpe, kps,kpe, &
1258 grid%i_start(ij), grid%i_end(ij), &
1259 grid%j_start(ij), grid%j_end(ij), &
1260 k_start, k_end )
1261 #endif
1262 call g_rk_addtend_dry( ru_tend,g_ru_tend,rv_tend,g_rv_tend,rw_tend,g_rw_tend,ph_tend,g_ph_tend,t_tend,g_t_tend,ru_tendf,&
1263 &g_ru_tendf,rv_tendf,g_rv_tendf,rw_tendf,g_rw_tendf,ph_tendf,g_ph_tendf,t_tendf,g_t_tendf,u_save,g_u_save,v_save,g_v_save,&
1264 &w_save,g_w_save,ph_save,g_ph_save,t_save,g_t_save,rk_step,h_diabatic,mut,g_mut,msft,msfu,msfv,ide,jde,ims,ime,jms,jme,kms,kme,&
1265 &grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1266
1267 IF( config_flags%specified .or. config_flags%nested ) THEN
1268 #if 0
1269 CALL spec_bdy_dry ( config_flags, &
1270 ru_tend, rv_tend, ph_tend, t_tend, &
1271 rw_tend, mu_tend, &
1272 u_b, v_b, ph_b, t_b, &
1273 w_b, mu_b, &
1274 u_bt, v_bt, ph_bt, t_bt, &
1275 w_bt, mu_bt, &
1276 spec_bdy_width, spec_zone, &
1277 ijds, ijde, & ! min/max(id,jd)
1278 ids,ide, jds,jde, kds,kde, & ! domain dims
1279 ims,ime, jms,jme, kms,kme, & ! memory dims
1280 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1281 grid%i_start(ij), grid%i_end(ij), &
1282 grid%j_start(ij), grid%j_end(ij), &
1283 k_start, k_end )
1284 #endif
1285 call g_spec_bdy_dry( config_flags,ru_tend,g_ru_tend,rv_tend,g_rv_tend,ph_tend,g_ph_tend,t_tend,g_t_tend,rw_tend,g_rw_tend,&
1286 &mu_tend,g_mu_tend,u_bt,g_u_bt,v_bt,g_v_bt,ph_bt,g_ph_bt,t_bt,g_t_bt,w_bt,g_w_bt,mu_bt,g_mu_bt,spec_bdy_width,spec_zone,ijds,&
1287 &ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),&
1288 &k_start,k_end )
1289 ENDIF
1290
1291 END DO
1292 !$OMP END PARALLEL DO
1293 BENCH_END(relax_bdy_dry_tim)
1294
1295
1296 !<DESCRIPTION>
1297 !<pre>
1298 ! (3) Small (acoustic,sound) steps.
1299 !
1300 ! Several acoustic steps are taken each RK pass. A small step
1301 ! sequence begins with calculating perturbation variables
1302 ! and coupling them to the column dry-air-mass mu
1303 ! (call to small_step_prep). This is followed by computing
1304 ! coefficients for the vertically implicit part of the
1305 ! small timestep (call to calc_coef_w).
1306 !
1307 ! The small steps are taken
1308 ! in the named loop "small_steps:". In the small_steps loop, first
1309 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
1310 ! next mu and theta are advanced (call to advance_mu_t) followed by
1311 ! advancing w and the geopotential (call to advance_w). Diagnostic
1312 ! values for pressure and inverse density are updated at the end of
1313 ! each small_step.
1314 !
1315 ! The small-step section ends with the change of the perturbation variables
1316 ! back to full variables (call to small_step_finish).
1317 !</pre>
1318 !</DESCRIPTION>
1319
1320 BENCH_START(small_step_prep_tim)
1321 !$OMP PARALLEL DO &
1322 !$OMP PRIVATE ( ij )
1323
1324 DO ij = 1 , grid%num_tiles
1325
1326 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
1327 ! integration. We only need calculate these for the first pass through -
1328 ! the predictor step. They are reused as is for the corrector step.
1329 ! For third-order RK, we need to recompute these after the first
1330 ! predictor because we may have changed the small timestep -> dts.
1331
1332 CALL wrf_debug ( 200 , ' call calc_coef_w' )
1333 #if 0
1334 CALL small_step_prep( u_1,u_2,v_1,v_2,w_1,w_2, &
1335 t_1,t_2,ph_1,ph_2, &
1336 mub, mu_1, mu_2, &
1337 muu, muus, muv, muvs, &
1338 mut, muts, mudf, &
1339 u_save, v_save, w_save, &
1340 t_save, ph_save, mu_save, &
1341 ww, ww1, &
1342 dnw, c2a, pb, p, alt, &
1343 msfu, msfv, msft, &
1344 rk_step, &
1345 ids, ide, jds, jde, kds, kde, &
1346 ims, ime, jms, jme, kms, kme, &
1347 grid%i_start(ij), grid%i_end(ij), &
1348 grid%j_start(ij), grid%j_end(ij), &
1349 k_start , k_end )
1350 CALL calc_p_rho( al, p, ph_2, &
1351 alt, t_2, t_save, c2a, pm1, &
1352 mu_2, muts, znu, t0, &
1353 rdnw, dnw, smdiv, &
1354 non_hydrostatic, 0, &
1355 ids, ide, jds, jde, kds, kde, &
1356 ims, ime, jms, jme, kms, kme, &
1357 grid%i_start(ij), grid%i_end(ij), &
1358 grid%j_start(ij), grid%j_end(ij), &
1359 k_start , k_end )
1360 #endif
1361 call g_small_step_prep( u_1,g_u_1,u_2,g_u_2,v_1,g_v_1,v_2,g_v_2,w_1,g_w_1,w_2,g_w_2,t_1,g_t_1,t_2,g_t_2,ph_1,g_ph_1,ph_2,&
1362 &g_ph_2,mub,mu_1,g_mu_1,mu_2,g_mu_2,muu,g_muu,muus,g_muus,muv,g_muv,muvs,g_muvs,mut,g_mut,muts,g_muts,mudf,g_mudf,u_save,&
1363 &g_u_save,v_save,g_v_save,w_save,g_w_save,t_save,g_t_save,ph_save,g_ph_save,mu_save,g_mu_save,ww,g_ww,ww1,g_ww1,c2a,g_c2a,pb,p,&
1364 &g_p,alt,g_alt,msfu,msfv,msft,rk_step,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%&
1365 &j_start(ij),grid%j_end(ij),k_start,k_end )
1366 call g_calc_p_rho( al,g_al,p,g_p,ph_2,g_ph_2,alt,g_alt,t_2,g_t_2,t_save,g_t_save,c2a,g_c2a,pm1,g_pm1,mu_2,g_mu_2,muts,g_muts,&
1367 &znu,t0,rdnw,dnw,smdiv,non_hydrostatic,0,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
1368 &grid%j_end(ij),k_start,k_end )
1369 IF (non_hydrostatic) THEN
1370 #if 0
1371 CALL calc_coef_w( a,alpha,gamma, &
1372 mut, cqw, &
1373 rdn, rdnw, c2a, &
1374 dts_rk, g, epssm, &
1375 ids, ide, jds, jde, kds, kde, &
1376 ims, ime, jms, jme, kms, kme, &
1377 grid%i_start(ij), grid%i_end(ij), &
1378 grid%j_start(ij), grid%j_end(ij), &
1379 k_start , k_end )
1380 #endif
1381
1382
1383 call g_calc_coef_w( a,g_a,alpha,g_alpha,gamma,g_gamma,mut,g_mut,cqw,g_cqw,rdn,rdnw,c2a,g_c2a,dts,g,epssm,ide,jde,kde,ims,ime,&
1384 &jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij) )
1385 ENDIF
1386 ENDDO
1387
1388 !$OMP END PARALLEL DO
1389 BENCH_END(small_step_prep_tim)
1390
1391 #ifdef DM_PARALLEL
1392 !-----------------------------------------------------------------------
1393 ! Stencils for patch communications (WCS, 29 June 2001)
1394 ! Note: the small size of this halo exchange reflects the
1395 ! fact that we are carrying the uncoupled variables
1396 ! as state variables in the mass coordinate model, as
1397 ! opposed to the coupled variables as in the height
1398 ! coordinate model.
1399 !
1400 ! * * * * *
1401 ! * * * * * * * * *
1402 ! * + * * + * * * + * *
1403 ! * * * * * * * * *
1404 ! * * * * *
1405 !
1406 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
1407 !
1408 !j ph_2 x
1409 !j al x
1410 !j p x
1411 !j t_1 x
1412 !j t_save x
1413 !j u_save x
1414 !j v_save x
1415 !
1416 ! the following are 2D (xy) variables
1417 !
1418 !j mu_1 x
1419 !j mu_2 x
1420 !j mudf x
1421 !--------------------------------------------------------------
1422 #include "HALO_EM_B.inc"
1423 #include "PERIOD_BDY_EM_B.inc"
1424 #endif
1425
1426 BENCH_START(set_phys_bc2_tim)
1427 if(dyn_opt == DYN_EM) then
1428 !$OMP PARALLEL DO &
1429 !$OMP PRIVATE ( ij )
1430
1431 DO ij = 1 , grid%num_tiles
1432
1433 CALL set_physical_bc3d( ru_tend, 'u', config_flags, &
1434 ids, ide, jds, jde, kds, kde, &
1435 ims, ime, jms, jme, kms, kme, &
1436 ips, ipe, jps, jpe, kps, kpe, &
1437 grid%i_start(ij), grid%i_end(ij), &
1438 grid%j_start(ij), grid%j_end(ij), &
1439 k_start , k_end )
1440
1441 CALL set_physical_bc3d( rv_tend, 'v', config_flags, &
1442 ids, ide, jds, jde, kds, kde, &
1443 ims, ime, jms, jme, kms, kme, &
1444 ips, ipe, jps, jpe, kps, kpe, &
1445 grid%i_start(ij), grid%i_end(ij), &
1446 grid%j_start(ij), grid%j_end(ij), &
1447 k_start , k_end )
1448
1449 CALL set_physical_bc3d( ph_2, 'w', config_flags, &
1450 ids, ide, jds, jde, kds, kde, &
1451 ims, ime, jms, jme, kms, kme, &
1452 ips, ipe, jps, jpe, kps, kpe, &
1453 grid%i_start(ij), grid%i_end(ij), &
1454 grid%j_start(ij), grid%j_end(ij), &
1455 k_start , k_end )
1456
1457 CALL set_physical_bc3d( al, 'p', config_flags, &
1458 ids, ide, jds, jde, kds, kde, &
1459 ims, ime, jms, jme, kms, kme, &
1460 ips, ipe, jps, jpe, kps, kpe, &
1461 grid%i_start(ij), grid%i_end(ij), &
1462 grid%j_start(ij), grid%j_end(ij), &
1463 k_start , k_end )
1464
1465 CALL set_physical_bc3d( p, 'p', config_flags, &
1466 ids, ide, jds, jde, kds, kde, &
1467 ims, ime, jms, jme, kms, kme, &
1468 ips, ipe, jps, jpe, kps, kpe, &
1469 grid%i_start(ij), grid%i_end(ij), &
1470 grid%j_start(ij), grid%j_end(ij), &
1471 k_start , k_end )
1472
1473 CALL set_physical_bc3d( t_1, 'p', config_flags, &
1474 ids, ide, jds, jde, kds, kde, &
1475 ims, ime, jms, jme, kms, kme, &
1476 ips, ipe, jps, jpe, kps, kpe, &
1477 grid%i_start(ij), grid%i_end(ij), &
1478 grid%j_start(ij), grid%j_end(ij), &
1479 k_start , k_end )
1480
1481 CALL set_physical_bc3d( t_save, 't', config_flags, &
1482 ids, ide, jds, jde, kds, kde, &
1483 ims, ime, jms, jme, kms, kme, &
1484 ips, ipe, jps, jpe, kps, kpe, &
1485 grid%i_start(ij), grid%i_end(ij), &
1486 grid%j_start(ij), grid%j_end(ij), &
1487 k_start , k_end )
1488
1489 CALL set_physical_bc2d( mu_1, 't', config_flags, &
1490 ids, ide, jds, jde, &
1491 ims, ime, jms, jme, &
1492 ips, ipe, jps, jpe, &
1493 grid%i_start(ij), grid%i_end(ij), &
1494 grid%j_start(ij), grid%j_end(ij) )
1495
1496 CALL set_physical_bc2d( mu_2, 't', config_flags, &
1497 ids, ide, jds, jde, &
1498 ims, ime, jms, jme, &
1499 ips, ipe, jps, jpe, &
1500 grid%i_start(ij), grid%i_end(ij), &
1501 grid%j_start(ij), grid%j_end(ij) )
1502
1503 CALL set_physical_bc2d( mudf, 't', config_flags, &
1504 ids, ide, jds, jde, &
1505 ims, ime, jms, jme, &
1506 ips, ipe, jps, jpe, &
1507 grid%i_start(ij), grid%i_end(ij), &
1508 grid%j_start(ij), grid%j_end(ij) )
1509
1510 END DO
1511 !$OMP END PARALLEL DO
1512 endif
1513 BENCH_END(set_phys_bc2_tim)
1514
1515
1516 small_steps : DO iteration = 1 , number_of_small_timesteps
1517
1518 ! Boundary condition time (or communication time).
1519
1520 #ifdef DM_PARALLEL
1521 #include "PERIOD_BDY_EM_B.inc"
1522 #endif
1523
1524
1525 !$OMP PARALLEL DO &
1526 !$OMP PRIVATE ( ij )
1527
1528 DO ij = 1 , grid%num_tiles
1529
1530 BENCH_START(advance_uv_tim)
1531 #if 0
1532 CALL advance_uv ( u_2, ru_tend, v_2, rv_tend, &
1533 p, pb, &
1534 ph_2, php, alt, al, mu_2, &
1535 muu, cqu, muv, cqv, mudf, &
1536 rdx, rdy, dts_rk, &
1537 cf1, cf2, cf3, fnm, fnp, &
1538 emdiv, &
1539 rdnw, config_flags,spec_zone, &
1540 non_hydrostatic, &
1541 ids, ide, jds, jde, kds, kde, &
1542 ims, ime, jms, jme, kms, kme, &
1543 grid%i_start(ij), grid%i_end(ij), &
1544 grid%j_start(ij), grid%j_end(ij), &
1545 k_start , k_end )
1546 #endif
1547 call g_advance_uv( u_2,g_u_2,ru_tend,g_ru_tend,v_2,g_v_2,rv_tend,g_rv_tend,p,g_p,pb,ph_2,g_ph_2,php,g_php,alt,g_alt,al,g_al,&
1548 &mu_2,g_mu_2,muu,g_muu,cqu,g_cqu,muv,g_muv,cqv,g_cqv,mudf,g_mudf,rdx,rdy,dts,cf1,cf2,cf3,fnm,fnp,emdiv,rdnw,config_flags,&
1549 &spec_zone,non_hydrostatic,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%&
1550 &j_end(ij),k_start,k_end )
1551 BENCH_END(advance_uv_tim)
1552
1553 BENCH_START(spec_bdy_uv_tim)
1554 IF( config_flags%specified .or. config_flags%nested ) THEN
1555 #if 0
1556 CALL spec_bdyupdate(u_2, ru_tend, dts_rk, &
1557 'u' , config_flags, &
1558 spec_zone, &
1559 ids,ide, jds,jde, kds,kde, & ! domain dims
1560 ims,ime, jms,jme, kms,kme, & ! memory dims
1561 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1562 grid%i_start(ij), grid%i_end(ij), &
1563 grid%j_start(ij), grid%j_end(ij), &
1564 k_start , k_end )
1565 CALL spec_bdyupdate(v_2, rv_tend, dts_rk, &
1566 'v' , config_flags, &
1567 spec_zone, &
1568 ids,ide, jds,jde, kds,kde, & ! domain dims
1569 ims,ime, jms,jme, kms,kme, & ! memory dims
1570 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1571 grid%i_start(ij), grid%i_end(ij), &
1572 grid%j_start(ij), grid%j_end(ij), &
1573 k_start , k_end )
1574 #endif
1575 call g_spec_bdyupdate( u_2,g_u_2,ru_tend,g_ru_tend,dts_rk,'u',spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%&
1576 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1577 call g_spec_bdyupdate( v_2,g_v_2,rv_tend,g_rv_tend,dts_rk,'v',spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%&
1578 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1579 ENDIF
1580 BENCH_END(spec_bdy_uv_tim)
1581
1582 END DO
1583 !$OMP END PARALLEL DO
1584
1585 #ifdef DM_PARALLEL
1586 !
1587 ! Stencils for patch communications (WCS, 29 June 2001)
1588 !
1589 ! * *
1590 ! * + * * + * +
1591 ! * *
1592 !
1593 ! u_2 x
1594 ! v_2 x
1595 !
1596 #include "HALO_EM_C.inc"
1597 #endif
1598
1599 !$OMP PARALLEL DO &
1600 !$OMP PRIVATE ( ij )
1601
1602 DO ij = 1 , grid%num_tiles
1603
1604 ! advance the mass in the column, theta, and calculate ww
1605
1606 BENCH_START(advance_mu_t_tim)
1607 #if 0
1608 CALL advance_mu_t( ww, ww1, u_2, u_save, v_2, v_save, &
1609 mu_2, mut, muave, muts, muu, muv, &
1610 mudf, ru_m, rv_m, ww_m, &
1611 t_2, t_save, t_2save, t_tend, &
1612 mu_tend, &
1613 rdx, rdy, dts_rk, epssm, &
1614 dnw, fnm, fnp, rdnw, &
1615 msfu, msfv, msft, &
1616 iteration, config_flags, &
1617 ids, ide, jds, jde, kds, kde, &
1618 ims, ime, jms, jme, kms, kme, &
1619 grid%i_start(ij), grid%i_end(ij), &
1620 grid%j_start(ij), grid%j_end(ij), &
1621 k_start , k_end )
1622 #endif
1623 call g_advance_mu_t( ww,g_ww,ww1,g_ww1,u_2,g_u_2,u_save,g_u_save,v_2,g_v_2,v_save,g_v_save,mu_2,g_mu_2,mut,g_mut,muave,&
1624 &g_muave,muts,g_muts,muu,g_muu,muv,g_muv,mudf,g_mudf,t_2,g_t_2,t_save,g_t_save,t_2save,g_t_2save,t_tend,g_t_tend,mu_tend,&
1625 &g_mu_tend,rdx,rdy,dts,epssm,dnw,fnm,fnp,rdnw,msfu,msfv,msft,config_flags,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%&
1626 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1627 BENCH_END(advance_mu_t_tim)
1628
1629 BENCH_START(spec_bdy_t_tim)
1630 IF( config_flags%specified .or. config_flags%nested ) THEN
1631 #if 0
1632 CALL spec_bdyupdate(t_2, t_tend, dts_rk, &
1633 't' , config_flags, &
1634 spec_zone, &
1635 ids,ide, jds,jde, kds,kde, & ! domain dims
1636 ims,ime, jms,jme, kms,kme, & ! memory dims
1637 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1638 grid%i_start(ij), grid%i_end(ij), &
1639 grid%j_start(ij), grid%j_end(ij), &
1640 k_start , k_end )
1641
1642 CALL spec_bdyupdate(mu_2, mu_tend, dts_rk, &
1643 'm' , config_flags, &
1644 spec_zone, &
1645 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1646 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1647 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1648 grid%i_start(ij), grid%i_end(ij), &
1649 grid%j_start(ij), grid%j_end(ij), &
1650 1 , 1 )
1651
1652 CALL spec_bdyupdate(muts, mu_tend, dts_rk, &
1653 'm' , config_flags, &
1654 spec_zone, &
1655 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1656 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1657 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1658 grid%i_start(ij), grid%i_end(ij), &
1659 grid%j_start(ij), grid%j_end(ij), &
1660 1 , 1 )
1661 #endif
1662 call g_spec_bdyupdate( t_2,g_t_2,t_tend,g_t_tend,dts_rk,'t',spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%&
1663 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1664 call g_spec_bdyupdate( mu_2,g_mu_2,mu_tend,g_mu_tend,dts_rk,'m',spec_zone,ids,ide,jds,jde,1,ims,ime,jms,jme,1,1,grid%&
1665 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),1,1 )
1666 call g_spec_bdyupdate( muts,g_muts,mu_tend,g_mu_tend,dts_rk,'m',spec_zone,ids,ide,jds,jde,1,ims,ime,jms,jme,1,1,grid%&
1667 &i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),1,1 )
1668 ENDIF
1669 BENCH_END(spec_bdy_t_tim)
1670
1671 ! sumflux accumulates the time-averged mass flux
1672 ! (time averaged over the acoustic steps) for use
1673 ! in the scalar advection (flux divergence). Using
1674 ! time averaged values gives us exact scalar conservation.
1675
1676 BENCH_START(sumflux_tim)
1677 #if 0
1678 CALL sumflux ( u_2, v_2, ww, &
1679 u_save, v_save, ww1, &
1680 muu, muv, &
1681 ru_m, rv_m, ww_m, epssm, &
1682 msfu, msfv, &
1683 iteration, number_of_small_timesteps, &
1684 ids, ide, jds, jde, kds, kde, &
1685 ims, ime, jms, jme, kms, kme, &
1686 grid%i_start(ij), grid%i_end(ij), &
1687 grid%j_start(ij), grid%j_end(ij), &
1688 k_start , k_end )
1689 #endif
1690 call g_sumflux( u_2,g_u_2,v_2,g_v_2,ww,g_ww,u_save,g_u_save,v_save,g_v_save,ww1,g_ww1,muu,g_muu,muv,g_muv,ru_m,g_ru_m,rv_m,&
1691 &g_rv_m,ww_m,g_ww_m,msfu,msfv,iteration,number_of_small_timesteps,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%&
1692 &i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1693 BENCH_END(sumflux_tim)
1694
1695 ! small (acoustic) step for the vertical momentum,
1696 ! density and coupled potential temperature.
1697
1698
1699 BENCH_START(advance_w_tim)
1700 IF ( non_hydrostatic ) THEN
1701 #if 0
1702 CALL advance_w( w_2, rw_tend, ww, u_2, v_2, &
1703 mu_2, mut, muave, muts, &
1704 t_2save, t_2, t_save, &
1705 ph_2, ph_save, phb, ph_tend, &
1706 ht, c2a, cqw, alt, alb, &
1707 a, alpha, gamma, &
1708 rdx, rdy, dts_rk, t0, epssm, &
1709 dnw, fnm, fnp, rdnw, rdn, &
1710 cf1, cf2, cf3, msft, &
1711 config_flags, &
1712 ids,ide, jds,jde, kds,kde, & ! domain dims
1713 ims,ime, jms,jme, kms,kme, & ! memory dims
1714 grid%i_start(ij), grid%i_end(ij), &
1715 grid%j_start(ij), grid%j_end(ij), &
1716 k_start , k_end )
1717 #endif
1718 call g_advance_w( w_2,g_w_2,rw_tend,g_rw_tend,ww,g_ww,u_2,g_u_2,v_2,g_v_2,mu_2,g_mu_2,mut,g_mut,muave,g_muave,muts,g_muts,&
1719 &t_2save,g_t_2save,t_2,g_t_2,t_save,g_t_save,ph_2,g_ph_2,ph_save,g_ph_save,phb,ph_tend,g_ph_tend,ht,c2a,g_c2a,cqw,g_cqw,&
1720 &alt,g_alt,alb,a,g_a,alpha,g_alpha,gamma,g_gamma,rdx,rdy,dts,t0,epssm,fnm,fnp,rdnw,rdn,cf1,cf2,cf3,msft,config_flags,ids,&
1721 &ide,jds,jde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1722 ENDIF
1723 BENCH_END(advance_w_tim)
1724
1725 IF( config_flags%specified .or. config_flags%nested ) THEN
1726
1727 BENCH_START(spec_bdynhyd_tim)
1728 IF (non_hydrostatic) THEN
1729 #if 0
1730 CALL spec_bdyupdate_ph( ph_save, ph_2, ph_tend, mu_tend, muts, dts_rk, &
1731 'h' , config_flags, &
1732 spec_zone, &
1733 ids,ide, jds,jde, kds,kde, & ! domain dims
1734 ims,ime, jms,jme, kms,kme, & ! memory dims
1735 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1736 grid%i_start(ij), grid%i_end(ij), &
1737 grid%j_start(ij), grid%j_end(ij), &
1738 k_start , k_end )
1739 #endif
1740 call g_spec_bdyupdate_ph( ph_save,g_ph_save,ph_2,g_ph_2,ph_tend,g_ph_tend,mu_tend,g_mu_tend,muts,g_muts,dts_rk,'h',&
1741 &spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),&
1742 &k_start,k_end )
1743 IF( config_flags%specified ) THEN
1744 #if 0
1745 CALL zero_grad_bdy ( w_2, &
1746 'w' , config_flags, &
1747 spec_zone, &
1748 ids,ide, jds,jde, kds,kde, & ! domain dims
1749 ims,ime, jms,jme, kms,kme, & ! memory dims
1750 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1751 grid%i_start(ij), grid%i_end(ij), &
1752 grid%j_start(ij), grid%j_end(ij), &
1753 k_start , k_end )
1754 #endif
1755 call g_zero_grad_bdy( w_2,g_w_2,'w',spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%&
1756 &i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start )
1757 ELSE
1758 #if 0
1759 CALL spec_bdyupdate ( w_2, rw_tend, dts_rk, &
1760 'h' , config_flags, &
1761 spec_zone, &
1762 ids,ide, jds,jde, kds,kde, & ! domain dims
1763 ims,ime, jms,jme, kms,kme, & ! memory dims
1764 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1765 grid%i_start(ij), grid%i_end(ij), &
1766 grid%j_start(ij), grid%j_end(ij), &
1767 k_start , k_end )
1768 #endif
1769 call g_spec_bdyupdate( w_2,g_w_2,rw_tend,g_rw_tend,dts_rk,'h',spec_zone,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,&
1770 &grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
1771 ENDIF
1772 ENDIF
1773 BENCH_END(spec_bdynhyd_tim)
1774 ENDIF
1775
1776 BENCH_START(cald_p_rho_tim)
1777 #if 0
1778 CALL calc_p_rho( al, p, ph_2, &
1779 alt, t_2, t_save, c2a, pm1, &
1780 mu_2, muts, znu, t0, &
1781 rdnw, dnw, smdiv, &
1782 non_hydrostatic, iteration, &
1783 ids, ide, jds, jde, kds, kde, &
1784 ims, ime, jms, jme, kms, kme, &
1785 grid%i_start(ij), grid%i_end(ij), &
1786 grid%j_start(ij), grid%j_end(ij), &
1787 k_start , k_end )
1788 #endif
1789 call g_calc_p_rho( al,g_al,p,g_p,ph_2,g_ph_2,alt,g_alt,t_2,g_t_2,t_save,g_t_save,c2a,g_c2a,pm1,g_pm1,mu_2,g_mu_2,muts,g_muts,&
1790 &znu,t0,rdnw,dnw,smdiv,non_hydrostatic,iteration,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%&
1791 &j_start(ij),grid%j_end(ij),k_start,k_end )
1792 BENCH_END(cald_p_rho_tim)
1793
1794 ENDDO
1795 !$OMP END PARALLEL DO
1796
1797 #ifdef DM_PARALLEL
1798 !
1799 ! Stencils for patch communications (WCS, 29 June 2001)
1800 !
1801 ! * *
1802 ! * + * * + * +
1803 ! * *
1804 !
1805 ! ph_2 x
1806 ! al x
1807 ! p x
1808 !
1809 ! 2D variables (x,y)
1810 !
1811 ! mu_2 x
1812 ! muts x
1813 ! mudf x
1814
1815 #include "HALO_EM_C2.inc"
1816 #include "PERIOD_BDY_EM_B3.inc"
1817 #endif
1818
1819 BENCH_START(phys_bc_tim)
1820 if(dyn_opt == DYN_EM) then
1821 !$OMP PARALLEL DO &
1822 !$OMP PRIVATE ( ij )
1823
1824 DO ij = 1 , grid%num_tiles
1825
1826 ! boundary condition set for next small timestep
1827
1828 CALL set_physical_bc3d( ph_2, 'w', config_flags, &
1829 ids, ide, jds, jde, kds, kde, &
1830 ims, ime, jms, jme, kms, kme, &
1831 ips, ipe, jps, jpe, kps, kpe, &
1832 grid%i_start(ij), grid%i_end(ij), &
1833 grid%j_start(ij), grid%j_end(ij), &
1834 k_start , k_end )
1835
1836 CALL set_physical_bc3d( al, 'p', config_flags, &
1837 ids, ide, jds, jde, kds, kde, &
1838 ims, ime, jms, jme, kms, kme, &
1839 ips, ipe, jps, jpe, kps, kpe, &
1840 grid%i_start(ij), grid%i_end(ij), &
1841 grid%j_start(ij), grid%j_end(ij), &
1842 k_start , k_end )
1843
1844 CALL set_physical_bc3d( p, 'p', config_flags, &
1845 ids, ide, jds, jde, kds, kde, &
1846 ims, ime, jms, jme, kms, kme, &
1847 ips, ipe, jps, jpe, kps, kpe, &
1848 grid%i_start(ij), grid%i_end(ij), &
1849 grid%j_start(ij), grid%j_end(ij), &
1850 k_start , k_end )
1851
1852 CALL set_physical_bc2d( muts, 't', config_flags, &
1853 ids, ide, jds, jde, &
1854 ims, ime, jms, jme, &
1855 ips, ipe, jps, jpe, &
1856 grid%i_start(ij), grid%i_end(ij), &
1857 grid%j_start(ij), grid%j_end(ij) )
1858
1859 CALL set_physical_bc2d( mu_2, 't', config_flags, &
1860 ids, ide, jds, jde, &
1861 ims, ime, jms, jme, &
1862 ips, ipe, jps, jpe, &
1863 grid%i_start(ij), grid%i_end(ij), &
1864 grid%j_start(ij), grid%j_end(ij) )
1865
1866 CALL set_physical_bc2d( mudf, 't', config_flags, &
1867 ids, ide, jds, jde, &
1868 ims, ime, jms, jme, &
1869 ips, ipe, jps, jpe, &
1870 grid%i_start(ij), grid%i_end(ij), &
1871 grid%j_start(ij), grid%j_end(ij) )
1872
1873 END DO
1874 !$OMP END PARALLEL DO
1875 endif
1876 BENCH_END(phys_bc_tim)
1877
1878 END DO small_steps
1879
1880
1881 !$OMP PARALLEL DO &
1882 !$OMP PRIVATE ( ij )
1883
1884 DO ij = 1 , grid%num_tiles
1885
1886 CALL wrf_debug ( 200 , ' call rk_small_finish' )
1887
1888 ! change time-perturbation variables back to
1889 ! full perturbation variables.
1890 ! first get updated mu at u and v points
1891
1892 BENCH_START(calc_mu_uv_tim)
1893 #if 0
1894 CALL calc_mu_uv_1 ( config_flags, &
1895 muts, muus, muvs, &
1896 ids, ide, jds, jde, kds, kde, &
1897 ims, ime, jms, jme, kms, kme, &
1898 grid%i_start(ij), grid%i_end(ij), &
1899 grid%j_start(ij), grid%j_end(ij), &
1900 k_start , k_end )
1901 #endif
1902 call g_calc_mu_uv_1( config_flags,muts,g_muts,muus,g_muus,muvs,g_muvs,ids,ide,jds,jde,ims,ime,jms,jme,grid%i_start(ij),grid%&
1903 &i_end(ij),grid%j_start(ij),grid%j_end(ij) )
1904 BENCH_END(calc_mu_uv_tim)
1905 BENCH_START(small_step_finish_tim)
1906 #if 0
1907 CALL small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1, &
1908 t_2, t_1, ph_2, ph_1, ww, ww1, &
1909 mu_2, mu_1, &
1910 mut, muts, muu, muus, muv, muvs, &
1911 u_save, v_save, w_save, &
1912 t_save, ph_save, mu_save, &
1913 msfu, msfv, msft, &
1914 h_diabatic, &
1915 number_of_small_timesteps,dts_rk, &
1916 ids, ide, jds, jde, kds, kde, &
1917 ims, ime, jms, jme, kms, kme, &
1918 grid%i_start(ij), grid%i_end(ij), &
1919 grid%j_start(ij), grid%j_end(ij), &
1920 k_start , k_end )
1921 #endif
1922 call g_small_step_finish( u_2,g_u_2,v_2,g_v_2,w_2,g_w_2,t_2,g_t_2,ph_2,g_ph_2,ww,mu_2,g_mu_2,mut,g_mut,muts,g_muts,muu,g_muu,&
1923 &muus,g_muus,muv,g_muv,muvs,g_muvs,u_save,g_u_save,v_save,g_v_save,w_save,g_w_save,t_save,g_t_save,ph_save,g_ph_save,mu_save,&
1924 &g_mu_save,msfu,msfv,msft,ide,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij) )
1925
1926
1927 BENCH_END(small_step_finish_tim)
1928
1929 END DO
1930 !$OMP END PARALLEL DO
1931
1932
1933
1934 #ifdef DM_PARALLEL
1935 !
1936 ! Stencils for patch communications (WCS, 29 June 2001)
1937 !
1938 !
1939 ! ru_m x
1940 ! rv_m x
1941 !
1942 !--------------------------------------------------------------
1943
1944 #include "HALO_EM_D.inc"
1945 #endif
1946
1947 !<DESCRIPTION>
1948 !<pre>
1949 ! (4) Still within the RK loop, the scalar variables are advanced.
1950 !
1951 ! For the moist and chem variables, each one is advanced
1952 ! individually, using named loops "moist_variable_loop:"
1953 ! and "chem_variable_loop:". Each RK substep begins by
1954 ! calculating the advective tendency, and, for the first RK step,
1955 ! 3D mixing (calling rk_scalar_tend) followed by an update
1956 ! of the scalar (calling rk_scalar_update).
1957 !</pre>
1958 !</DESCRIPTION>
1959
1960 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
1961
1962 moist_variable_loop: do im = PARAM_FIRST_SCALAR, num_3d_m
1963
1964 !$OMP PARALLEL DO &
1965 !$OMP PRIVATE ( ij )
1966
1967 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
1968
1969 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
1970
1971 BENCH_START(rk_scalar_tend_tim)
1972 #if 0
1973 CALL rk_scalar_tend ( im, im, config_flags, &
1974 rk_step, dt_rk, &
1975 ru_m, rv_m, ww_m, &
1976 mut, alt, &
1977 moist(ims,kms,jms,im), &
1978 moist_tend(ims,kms,jms,im), &
1979 advect_tend,RQVFTEN, &
1980 qv_base, .true., fnm, fnp, &
1981 msfu, msfv, msft, &
1982 rdx, rdy, rdn, rdnw, khdif, &
1983 kvdif, xkmhd, &
1984 ids, ide, jds, jde, kds, kde, &
1985 ims, ime, jms, jme, kms, kme, &
1986 grid%i_start(ij), grid%i_end(ij), &
1987 grid%j_start(ij), grid%j_end(ij), &
1988 k_start , k_end )
1989 #endif
1990 call g_rk_scalar_tend( im,im,config_flags,rk_step,ru_m,g_ru_m,rv_m,g_rv_m,ww_m,g_ww_m,mut,g_mut,alt,g_alt,&
1991 &moist(ims,kms,jms,im),g_moist(ims,kms,jms,im),moist_tend(ims,kms,jms,im),&
1992 &g_moist_tend(ims,kms,jms,im),advect_tend,g_advect_tend,qv_base, .true. ,fnm,fnp,msfu,msfv,msft,rdx,rdy,rdn,rdnw,kvdif,&
1993 &xkmhd,g_xkmhd,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%&
1994 &j_end(ij),k_start,k_end )
1995 BENCH_END(rk_scalar_tend_tim)
1996
1997 BENCH_START(rlx_bdy_scalar_tim)
1998 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
1999
2000 IF(im .eq. P_QV)THEN
2001 #if 0
2002 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2003 moist(ims,kms,jms,im), mut, &
2004 moist_b(1,1,1,1,im), &
2005 moist_bt(1,1,1,1,im), &
2006 spec_bdy_width, spec_zone, relax_zone, &
2007 dtbc, fcx, gcx, &
2008 ijds, ijde, & ! min/max(id,jd)
2009 ids,ide, jds,jde, kds,kde, & ! domain dims
2010 ims,ime, jms,jme, kms,kme, & ! memory dims
2011 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2012 grid%i_start(ij), grid%i_end(ij), &
2013 grid%j_start(ij), grid%j_end(ij), &
2014 k_start, k_end )
2015
2016 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2017 moist_b(1,1,1,1,im), &
2018 moist_bt(1,1,1,1,im), &
2019 spec_bdy_width, spec_zone, &
2020 config_flags, &
2021 ijds, ijde, & ! min/max(id,jd)
2022 ids,ide, jds,jde, kds,kde, & ! domain dims
2023 ims,ime, jms,jme, kms,kme, & ! memory dims
2024 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2025 grid%i_start(ij), grid%i_end(ij), &
2026 grid%j_start(ij), grid%j_end(ij), &
2027 k_start, k_end )
2028 #endif
2029 call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),moist_bt(1,1,1,1,im), &
2030 g_moist_bt(1,1,1,1,im),spec_bdy_width,&
2031 &spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2032 &grid%j_end(ij),k_start,k_end )
2033 ENDIF
2034
2035 ENDIF
2036
2037 ! ugly code for nested b.c for moist scalars other than qv
2038
2039 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2040
2041 IF (im .eq. P_QC) THEN
2042 #if 0
2043 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2044 moist(ims,kms,jms,im), mut, &
2045 chem_b(1,1,1,1,im), chem_bt(1,1,1,1,im), &
2046 spec_bdy_width, spec_zone, relax_zone, &
2047 dtbc, fcx, gcx, &
2048 ijds, ijde, & ! min/max(id,jd)
2049 ids,ide, jds,jde, kds,kde, & ! domain dims
2050 ims,ime, jms,jme, kms,kme, & ! memory dims
2051 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2052 grid%i_start(ij), grid%i_end(ij), &
2053 grid%j_start(ij), grid%j_end(ij), &
2054 k_start, k_end )
2055
2056 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2057 chem_b(1,1,1,1,im), chem_bt(1,1,1,1,im), &
2058 spec_bdy_width, spec_zone, &
2059 config_flags, &
2060 ijds, ijde, & ! min/max(id,jd)
2061 ids,ide, jds,jde, kds,kde, & ! domain dims
2062 ims,ime, jms,jme, kms,kme, & ! memory dims
2063 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2064 grid%i_start(ij), grid%i_end(ij), &
2065 grid%j_start(ij), grid%j_end(ij), &
2066 k_start, k_end )
2067 #endif
2068 g_chem_btm(:,:,:,:,im) = 0.
2069 !JRB
2070 ! call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),&
2071 !chem_bt(1,1,1,1,im),g_chem_btm(1,1,1,1,im),spec_bdy_width,&
2072 !&spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2073 !&grid%j_end(ij),k_start,k_end )
2074 ELSE IF (im .eq. P_QR) THEN
2075 #if 0
2076 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2077 moist(ims,kms,jms,im), mut, &
2078 moist_b(1,1,1,1,im), &
2079 moist_bt(1,1,1,1,im), &
2080 spec_bdy_width, spec_zone, relax_zone, &
2081 dtbc, fcx, gcx, &
2082 ijds, ijde, & ! min/max(id,jd)
2083 ids,ide, jds,jde, kds,kde, & ! domain dims
2084 ims,ime, jms,jme, kms,kme, & ! memory dims
2085 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2086 grid%i_start(ij), grid%i_end(ij), &
2087 grid%j_start(ij), grid%j_end(ij), &
2088 k_start, k_end )
2089
2090 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2091 moist_b(1,1,1,1,im), &
2092 moist_bt(1,1,1,1,im), &
2093 spec_bdy_width, spec_zone, &
2094 config_flags, &
2095 ijds, ijde, & ! min/max(id,jd)
2096 ids,ide, jds,jde, kds,kde, & ! domain dims
2097 ims,ime, jms,jme, kms,kme, & ! memory dims
2098 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2099 grid%i_start(ij), grid%i_end(ij), &
2100 grid%j_start(ij), grid%j_end(ij), &
2101 k_start, k_end )
2102 #endif
2103 g_moist_btm(:,:,:,:,im) = 0.
2104 call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),&
2105 moist_bt(1,1,1,1,im),g_moist_btm(1,1,1,1,im),spec_bdy_width,&
2106 &spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2107 &grid%j_end(ij),k_start,k_end )
2108 ELSE IF (im .eq. P_QI) THEN
2109 #if 0
2110 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2111 moist(ims,kms,jms,im), mut, &
2112 moist_b(1,1,1,1,im), &
2113 moist_bt(1,1,1,1,im), &
2114 spec_bdy_width, spec_zone, relax_zone, &
2115 dtbc, fcx, gcx, &
2116 ijds, ijde, & ! min/max(id,jd)
2117 ids,ide, jds,jde, kds,kde, & ! domain dims
2118 ims,ime, jms,jme, kms,kme, & ! memory dims
2119 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2120 grid%i_start(ij), grid%i_end(ij), &
2121 grid%j_start(ij), grid%j_end(ij), &
2122 k_start, k_end )
2123
2124 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2125 moist_b(1,1,1,1,im), &
2126 moist_bt(1,1,1,1,im), &
2127 spec_bdy_width, spec_zone, &
2128 config_flags, &
2129 ijds, ijde, & ! min/max(id,jd)
2130 ids,ide, jds,jde, kds,kde, & ! domain dims
2131 ims,ime, jms,jme, kms,kme, & ! memory dims
2132 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2133 grid%i_start(ij), grid%i_end(ij), &
2134 grid%j_start(ij), grid%j_end(ij), &
2135 k_start, k_end )
2136 #endif
2137 g_moist_btm(:,:,:,:,im) = 0.
2138 call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im), &
2139 moist_bt(1,1,1,1,im),g_moist_btm(1,1,1,1,im),spec_bdy_width,&
2140 &spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2141 &grid%j_end(ij),k_start,k_end )
2142 ELSE IF (im .eq. P_QS) THEN
2143 #if 0
2144 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2145 moist(ims,kms,jms,im), mut, &
2146 scalar_b(1,1,1,1,im), scalar_bt(1,1,1,1,im), &
2147 spec_bdy_width, spec_zone, relax_zone, &
2148 dtbc, fcx, gcx, &
2149 ijds, ijde, & ! min/max(id,jd)
2150 ids,ide, jds,jde, kds,kde, & ! domain dims
2151 ims,ime, jms,jme, kms,kme, & ! memory dims
2152 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2153 grid%i_start(ij), grid%i_end(ij), &
2154 grid%j_start(ij), grid%j_end(ij), &
2155 k_start, k_end )
2156
2157 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2158 scalar_b(1,1,1,1,im), scalar_bt(1,1,1,1,im), &
2159 spec_bdy_width, spec_zone, &
2160 config_flags, &
2161 ijds, ijde, & ! min/max(id,jd)
2162 ids,ide, jds,jde, kds,kde, & ! domain dims
2163 ims,ime, jms,jme, kms,kme, & ! memory dims
2164 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2165 grid%i_start(ij), grid%i_end(ij), &
2166 grid%j_start(ij), grid%j_end(ij), &
2167 k_start, k_end )
2168 #endif
2169 g_scalar_btm(:,:,:,:,im) = 0.
2170 call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),&
2171 scalar_bt(1,1,1,1,im),g_scalar_btm(1,1,1,1,im),spec_bdy_width,&
2172 &spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2173 &grid%j_end(ij),k_start,k_end )
2174
2175 ELSE IF (im .eq. P_QG) THEN
2176 #if 0
2177 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2178 moist(ims,kms,jms,im), mut, &
2179 moist_b(1,1,1,1,im), &
2180 moist_bt(1,1,1,1,im), &
2181 spec_bdy_width, spec_zone, relax_zone, &
2182 dtbc, fcx, gcx, &
2183 ijds, ijde, & ! min/max(id,jd)
2184 ids,ide, jds,jde, kds,kde, & ! domain dims
2185 ims,ime, jms,jme, kms,kme, & ! memory dims
2186 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2187 grid%i_start(ij), grid%i_end(ij), &
2188 grid%j_start(ij), grid%j_end(ij), &
2189 k_start, k_end )
2190
2191 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2192 moist_b(1,1,1,1,im), &
2193 moist_bt(1,1,1,1,im), &
2194 spec_bdy_width, spec_zone, &
2195 config_flags, &
2196 ijds, ijde, & ! min/max(id,jd)
2197 ids,ide, jds,jde, kds,kde, & ! domain dims
2198 ims,ime, jms,jme, kms,kme, & ! memory dims
2199 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2200 grid%i_start(ij), grid%i_end(ij), &
2201 grid%j_start(ij), grid%j_end(ij), &
2202 k_start, k_end )
2203 #endif
2204 g_moist_btm(:,:,:,:,im) = 0.
2205 call g_spec_bdy_scalar( moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),&
2206 moist_bt(1,1,1,1,im),g_moist_btm(1,1,1,1,im),spec_bdy_width,&
2207 &spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),&
2208 &grid%j_end(ij),k_start,k_end )
2209 ENDIF
2210
2211 ENDIF ! b.c test for moist nested boundary condition
2212
2213 BENCH_END(rlx_bdy_scalar_tim)
2214
2215 ENDDO moist_tile_loop_1
2216 !$OMP END PARALLEL DO
2217
2218 !$OMP PARALLEL DO &
2219 !$OMP PRIVATE ( ij )
2220
2221 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2222
2223 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2224
2225 BENCH_START(update_scal_tim)
2226 #if 0
2227 CALL rk_update_scalar( im, im, &
2228 moist_old(ims,kms,jms,im), &
2229 moist(ims,kms,jms,im), &
2230 moist_tend(ims,kms,jms,im), &
2231 advect_tend, msft, &
2232 mu_1, mu_2, mub, &
2233 rk_step, dt_rk, spec_zone, &
2234 config_flags, &
2235 ids, ide, jds, jde, kds, kde, &
2236 ims, ime, jms, jme, kms, kme, &
2237 grid%i_start(ij), grid%i_end(ij), &
2238 grid%j_start(ij), grid%j_end(ij), &
2239 k_start , k_end )
2240 #endif
2241 call g_rk_update_scalar( im,im,moist_old(ims,kms,jms,im),g_moist_old(ims,kms,jms,im),moist(ims,kms,jms,im),g_moist(ims,kms,&
2242 &jms,im),moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im),advect_tend,g_advect_tend,msft,mu_1,g_mu_1,mu_2,g_mu_2,&
2243 &mub,rk_step,dt_rk,spec_zone,config_flags,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%&
2244 &i_end(ij),grid%j_start(ij),grid%j_end(ij),k_start,k_end )
2245 BENCH_END(update_scal_tim)
2246
2247 BENCH_START(flow_depbdy_tim)
2248 if(dyn_opt == DYN_EM) then
2249 IF( config_flags%specified ) THEN
2250 IF(im .ne. P_QV)THEN
2251 CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
2252 ru_m, rv_m, config_flags, &
2253 spec_zone, &
2254 ids,ide, jds,jde, kds,kde, & ! domain dims
2255 ims,ime, jms,jme, kms,kme, & ! memory dims
2256 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2257 grid%i_start(ij), grid%i_end(ij), &
2258 grid%j_start(ij), grid%j_end(ij), &
2259 k_start, k_end )
2260 ENDIF
2261 ENDIF
2262 endif
2263 BENCH_END(flow_depbdy_tim)
2264
2265 ENDDO moist_tile_loop_2
2266 !$OMP END PARALLEL DO
2267
2268 ENDDO moist_variable_loop
2269
2270 ENDIF moist_scalar_advance
2271
2272 BENCH_START(tke_adv_tim)
2273 if(dyn_opt == DYN_EM) then
2274 TKE_advance: IF (km_opt .eq. 2) then
2275
2276 #ifdef DM_PARALLEL
2277 IF ( h_mom_adv_order <= 4 ) THEN
2278 #include "HALO_EM_TKE_ADVECT_3.inc"
2279 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2280 #include "HALO_EM_TKE_ADVECT_5.inc"
2281 ELSE
2282 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2283 CALL wrf_error_fatal(TRIM(wrf_err_message))
2284 ENDIF
2285 #endif
2286
2287 !$OMP PARALLEL DO &
2288 !$OMP PRIVATE ( ij )
2289
2290 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2291
2292 CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
2293 CALL rk_scalar_tend ( 1, 1, config_flags, &
2294 rk_step, dt_rk, &
2295 ru_m, rv_m, ww_m, &
2296 mut, alt, &
2297 tke_2(ims,kms,jms), &
2298 tke_tend(ims,kms,jms), &
2299 advect_tend,RQVFTEN, &
2300 qv_base, .false., fnm, fnp, &
2301 msfu, msfv, msft, &
2302 rdx, rdy, rdn, rdnw, khdif, &
2303 kvdif, xkmhd, &
2304 grid%diff_6th_opt, grid%diff_6th_rate, &
2305 ids, ide, jds, jde, kds, kde, &
2306 ims, ime, jms, jme, kms, kme, &
2307 grid%i_start(ij), grid%i_end(ij), &
2308 grid%j_start(ij), grid%j_end(ij), &
2309 k_start , k_end )
2310
2311 ENDDO tke_tile_loop_1
2312 !$OMP END PARALLEL DO
2313
2314 !$OMP PARALLEL DO &
2315 !$OMP PRIVATE ( ij )
2316
2317 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2318
2319 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2320 CALL rk_update_scalar( 1, 1, &
2321 tke_1(ims,kms,jms), &
2322 tke_2(ims,kms,jms), &
2323 tke_tend(ims,kms,jms), &
2324 advect_tend,msft, &
2325 mu_1, mu_2, mub, &
2326 rk_step, dt_rk, spec_zone, &
2327 config_flags, &
2328 ids, ide, jds, jde, kds, kde, &
2329 ims, ime, jms, jme, kms, kme, &
2330 grid%i_start(ij), grid%i_end(ij), &
2331 grid%j_start(ij), grid%j_end(ij), &
2332 k_start , k_end )
2333
2334 ! bound the tke (greater than 0, less than tke_upper_bound)
2335
2336 CALL bound_tke( tke_2(ims,kms,jms), tke_upper_bound, &
2337 ids, ide, jds, jde, kds, kde, &
2338 ims, ime, jms, jme, kms, kme, &
2339 grid%i_start(ij), grid%i_end(ij), &
2340 grid%j_start(ij), grid%j_end(ij), &
2341 k_start , k_end )
2342
2343 IF( config_flags%specified .or. config_flags%nested ) THEN
2344 CALL flow_dep_bdy ( tke_2(ims,kms,jms), &
2345 ru_m, rv_m, config_flags, &
2346 spec_zone, &
2347 ids,ide, jds,jde, kds,kde, & ! domain dims
2348 ims,ime, jms,jme, kms,kme, & ! memory dims
2349 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2350 grid%i_start(ij), grid%i_end(ij), &
2351 grid%j_start(ij), grid%j_end(ij), &
2352 k_start, k_end )
2353 ENDIF
2354 ENDDO tke_tile_loop_2
2355 !$OMP END PARALLEL DO
2356
2357 END IF TKE_advance
2358 endif
2359 BENCH_END(tke_adv_tim)
2360
2361 ! next the chemical species
2362
2363 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2364
2365 chem_variable_loop: do ic = PARAM_FIRST_SCALAR, num_3d_c
2366
2367 !$OMP PARALLEL DO &
2368 !$OMP PRIVATE ( ij )
2369
2370 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2371
2372 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2373 CALL rk_scalar_tend ( ic, ic, config_flags, &
2374 rk_step, dt_rk, &
2375 ru_m, rv_m, ww_m, &
2376 mut, alt, &
2377 chem(ims,kms,jms,ic), &
2378 chem_tend(ims,kms,jms,ic), &
2379 advect_tend,RQVFTEN, &
2380 qv_base, .false., fnm, fnp, &
2381 msfu, msfv, msft, &
2382 rdx, rdy, rdn, rdnw, &
2383 khdif, kvdif, xkmhd, &
2384 grid%diff_6th_opt, grid%diff_6th_rate, &
2385 ids, ide, jds, jde, kds, kde, &
2386 ims, ime, jms, jme, kms, kme, &
2387 grid%i_start(ij), grid%i_end(ij), &
2388 grid%j_start(ij), grid%j_end(ij), &
2389 k_start , k_end )
2390
2391 ENDDO chem_tile_loop_1
2392 !$OMP END PARALLEL DO
2393
2394
2395 !$OMP PARALLEL DO &
2396 !$OMP PRIVATE ( ij )
2397
2398 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2399
2400 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2401 CALL rk_update_scalar( ic, ic, &
2402 chem_old(ims,kms,jms,ic), &
2403 chem(ims,kms,jms,ic), &
2404 chem_tend(ims,kms,jms,ic), &
2405 advect_tend, msft, &
2406 mu_1, mu_2, mub, &
2407 rk_step, dt_rk, spec_zone, &
2408 config_flags, &
2409 ids, ide, jds, jde, kds, kde, &
2410 ims, ime, jms, jme, kms, kme, &
2411 grid%i_start(ij), grid%i_end(ij), &
2412 grid%j_start(ij), grid%j_end(ij), &
2413 k_start , k_end )
2414
2415
2416 IF( config_flags%specified ) THEN
2417 ! come back to this and figure out why two different routines are needed. JM 20041203
2418 #ifndef WRF_CHEM
2419 CALL flow_dep_bdy ( chem(ims,kms,jms,ic), &
2420 ru_m, rv_m, config_flags, &
2421 spec_zone, &
2422 ids,ide, jds,jde, kds,kde, & ! domain dims
2423 ims,ime, jms,jme, kms,kme, & ! memory dims
2424 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2425 grid%i_start(ij), grid%i_end(ij), &
2426 grid%j_start(ij), grid%j_end(ij), &
2427 k_start, k_end )
2428 #else
2429 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic),z,&
2430 ru_m, rv_m, config_flags,alt, &
2431 t_1,pb,p,t0,p1000mb,rcp,ph_2,phb,g, &
2432 spec_zone,ic, &
2433 ids,ide, jds,jde, kds,kde, & ! domain dims
2434 ims,ime, jms,jme, kms,kme, & ! memory dims
2435 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2436 grid%i_start(ij), grid%i_end(ij), &
2437 grid%j_start(ij), grid%j_end(ij), &
2438 k_start, k_end )
2439 #endif
2440 ENDIF
2441
2442
2443 ENDDO chem_tile_loop_2
2444 !$OMP END PARALLEL DO
2445
2446 ENDDO chem_variable_loop
2447
2448 ENDIF chem_scalar_advance
2449
2450 ! update the pressure and density at the new time level
2451
2452 !$OMP PARALLEL DO &
2453 !$OMP PRIVATE ( ij )
2454 DO ij = 1 , grid%num_tiles
2455
2456 BENCH_START(calc_p_rho_tim)
2457 #if 0
2458 CALL calc_p_rho_phi( moist, num_3d_m, &
2459 al, alb, mu_2, muts, &
2460 ph_2, p, pb, t_2, &
2461 p0, t0, znu, dnw, rdnw, &
2462 rdn, non_hydrostatic, &
2463 ids, ide, jds, jde, kds, kde, &
2464 ims, ime, jms, jme, kms, kme, &
2465 grid%i_start(ij), grid%i_end(ij), &
2466 grid%j_start(ij), grid%j_end(ij), &
2467 k_start , k_end )
2468 #endif
2469 call g_calc_p_rho_phi( moist,g_moist,num_3d_m,al,g_al,alb,mu_2,g_mu_2,muts,g_muts,ph_2,g_ph_2,p,g_p,pb,t_2,g_t_2,p0,t0,dnw,&
2470 &rdnw,rdn,non_hydrostatic,ide,jde,kde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),&
2471 &k_start,k_end )
2472 BENCH_END(calc_p_rho_tim)
2473
2474 BENCH_START(diag_w_tim)
2475 IF (.not. non_hydrostatic) THEN
2476 #if 0
2477 CALL diagnose_w( ph_tend, ph_2, ph_1, w_2, muts, dt_rk, &
2478 u_2, v_2, ht, &
2479 cf1, cf2, cf3, rdx, rdy, msft, &
2480 ids, ide, jds, jde, kds, kde, &
2481 ims, ime, jms, jme, kms, kme, &
2482 grid%i_start(ij), grid%i_end(ij), &
2483 grid%j_start(ij), grid%j_end(ij), &
2484 k_start , k_end )
2485 #endif
2486 call g_diagnose_w( ph_tend,g_ph_tend,ph_2,g_ph_2,ph_1,g_ph_1,w_2,g_w_2,muts,g_muts,dt_rk,u_2,g_u_2,v_2,g_v_2,ht,cf1,cf2,cf3,&
2487 &rdx,rdy,msft,ide,jde,ims,ime,jms,jme,kms,kme,grid%i_start(ij),grid%i_end(ij),grid%j_start(ij),grid%j_end(ij),k_end )
2488 ENDIF
2489 BENCH_END(diag_w_tim)
2490
2491 ENDDO
2492 !$OMP END PARALLEL DO
2493
2494 ! Reset the boundary conditions if there is another corrector step.
2495 ! (rk_step < rk_order), else we'll handle it at the end of everything
2496 ! (after the split physics, before exiting the timestep).
2497
2498 rk_step_1_check: IF ( rk_step < rk_order ) THEN
2499
2500 !-----------------------------------------------------------
2501 ! Stencils for patch communications (WCS, 29 June 2001)
2502 !
2503 ! here's where we need a wide comm stencil - these are the
2504 ! uncoupled variables so are used for high order calc in
2505 ! advection and mixong routines.
2506 !
2507 ! * * * * *
2508 ! * * * * * * * * *
2509 ! * + * * + * * * + * *
2510 ! * * * * * * * * *
2511 ! * * * * *
2512 !
2513 !
2514 ! u_2 x
2515 ! v_2 x
2516 ! w_2 x
2517 ! t_2 x
2518 ! ph_2 x
2519 ! al x
2520 !
2521 ! 2D variable
2522 ! mu_2 x
2523 !
2524 ! 4D variable
2525 ! moist x
2526 ! chem x
2527
2528 #ifdef DM_PARALLEL
2529 IF ( h_mom_adv_order <= 4 ) THEN
2530 #include "HALO_EM_D2_3.inc"
2531 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2532 #include "HALO_EM_D2_5.inc"
2533 ELSE
2534 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2535 CALL wrf_error_fatal(TRIM(wrf_err_message))
2536 ENDIF
2537 #include "PERIOD_BDY_EM_D.inc"
2538 #include "PERIOD_BDY_EM_MOIST.inc"
2539 #include "PERIOD_BDY_EM_CHEM.inc"
2540 #include "PERIOD_BDY_EM_SCALAR.inc"
2541 #endif
2542
2543 BENCH_START(bc_end_tim)
2544 if(dyn_opt == DYN_EM) then
2545 !$OMP PARALLEL DO &
2546 !$OMP PRIVATE ( ij )
2547
2548 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
2549
2550 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
2551
2552 CALL rk_phys_bc_dry_2( config_flags, &
2553 u_2, v_2, w_2, &
2554 t_2, ph_2, mu_2, &
2555 ids, ide, jds, jde, kds, kde, &
2556 ims, ime, jms, jme, kms, kme, &
2557 ips, ipe, jps, jpe, kps, kpe, &
2558 grid%i_start(ij), grid%i_end(ij), &
2559 grid%j_start(ij), grid%j_end(ij), &
2560 k_start , k_end )
2561
2562 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2563
2564 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
2565
2566 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
2567 ids, ide, jds, jde, kds, kde, &
2568 ims, ime, jms, jme, kms, kme, &
2569 ips, ipe, jps, jpe, kps, kpe, &
2570 grid%i_start(ij), grid%i_end(ij), &
2571 grid%j_start(ij), grid%j_end(ij), &
2572 k_start , k_end )
2573 END DO moisture_loop_bdy_1
2574
2575 ENDIF
2576
2577 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2578
2579 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
2580
2581 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
2582 ids, ide, jds, jde, kds, kde, &
2583 ims, ime, jms, jme, kms, kme, &
2584 ips, ipe, jps, jpe, kps, kpe, &
2585 grid%i_start(ij), grid%i_end(ij), &
2586 grid%j_start(ij), grid%j_end(ij), &
2587 k_start , k_end-1 )
2588
2589 END DO chem_species_bdy_loop_1
2590
2591 END IF
2592
2593 IF (km_opt .eq. 2) THEN
2594
2595 CALL set_physical_bc3d( tke_2(ims,kms,jms) , 'p', config_flags, &
2596 ids, ide, jds, jde, kds, kde, &
2597 ims, ime, jms, jme, kms, kme, &
2598 ips, ipe, jps, jpe, kps, kpe, &
2599 grid%i_start(ij), grid%i_end(ij), &
2600 grid%j_start(ij), grid%j_end(ij), &
2601 k_start , k_end )
2602 END IF
2603
2604 END DO tile_bc_loop_1
2605 !$OMP END PARALLEL DO
2606 endif
2607 BENCH_END(bc_end_tim)
2608
2609
2610 #ifdef DM_PARALLEL
2611
2612 IF ( h_mom_adv_order <= 4 ) THEN
2613 #include "HALO_EM_TKE_3.inc"
2614 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2615 #include "HALO_EM_TKE_5.inc"
2616 ELSE
2617 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2618 CALL wrf_error_fatal(TRIM(wrf_err_message))
2619 ENDIF
2620
2621 #if 0
2622 IF (km_opt .eq. 2) THEN
2623 #include "HALO_EM_TKE_F.inc"
2624 ENDIF
2625 #endif
2626
2627 if ( num_moist .ge. PARAM_FIRST_SCALAR ) then
2628
2629 ! * * * * *
2630 ! * * * * * * * * *
2631 ! * + * * + * * * + * *
2632 ! * * * * * * * * *
2633 ! * * * * *
2634
2635 ! moist x
2636
2637 IF ( h_mom_adv_order <= 4 ) THEN
2638 #include "HALO_EM_MOIST_E_3.inc"
2639 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2640 #include "HALO_EM_MOIST_E_5.inc"
2641 ELSE
2642 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2643 CALL wrf_error_fatal(TRIM(wrf_err_message))
2644 ENDIF
2645 endif
2646 if ( num_chem >= PARAM_FIRST_SCALAR ) then
2647
2648 ! * * * * *
2649 ! * * * * * * * * *
2650 ! * + * * + * * * + * *
2651 ! * * * * * * * * *
2652 ! * * * * *
2653
2654 ! chem x
2655
2656 IF ( h_mom_adv_order <= 4 ) THEN
2657 #include "HALO_EM_CHEM_E_3.inc"
2658 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2659 #include "HALO_EM_CHEM_E_5.inc"
2660 ELSE
2661 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2662 CALL wrf_error_fatal(TRIM(wrf_err_message))
2663 ENDIF
2664 endif
2665 #endif
2666
2667 ENDIF rk_step_1_check
2668
2669 !**********************************************************
2670 !
2671 ! end of RK predictor-corrector loop
2672 !
2673 !**********************************************************
2674
2675 END DO Runge_Kutta_loop
2676
2677 #if 0
2678 !$OMP PARALLEL DO &
2679 !$OMP PRIVATE ( ij )
2680
2681 DO ij = 1 , grid%num_tiles
2682
2683 BENCH_START(advance_ppt_tim)
2684 CALL wrf_debug ( 200 , ' call advance_ppt' )
2685 CALL advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
2686 RQICUTEN,RQSCUTEN,RAINC,RAINCV,NCA, &
2687 CUPPT, config_flags, &
2688 ids,ide, jds,jde, kds,kde, &
2689 ims,ime, jms,jme, kms,kme, &
2690 grid%i_start(ij), grid%i_end(ij), &
2691 grid%j_start(ij), grid%j_end(ij), &
2692 k_start , k_end )
2693 BENCH_END(advance_ppt_tim)
2694
2695 ENDDO
2696 !$OMP END PARALLEL DO
2697 #endif
2698
2699 !<DESCRIPTION>
2700 !<pre>
2701 ! (5) time-split physics.
2702 !
2703 ! Microphysics are the only time split physics in the WRF model
2704 ! at this time. Split-physics begins with the calculation of
2705 ! needed diagnostic quantities (pressure, temperature, etc.)
2706 ! followed by a call to the microphysics driver,
2707 ! and finishes with a clean-up, storing off of a diabatic tendency
2708 ! from the moist physics, and a re-calulation of the diagnostic
2709 ! quantities pressure and density.
2710 !</pre>
2711 !</DESCRIPTION>
2712
2713 IF (config_flags%mp_physics /= 0) then
2714
2715 IF( config_flags%specified .or. config_flags%nested ) THEN
2716 sz = spec_zone
2717 ELSE
2718 sz = 0
2719 ENDIF
2720
2721 if(dyn_opt == DYN_EM) then
2722 !$OMP PARALLEL DO &
2723 !$OMP PRIVATE ( ij, its, ite, jts, jte )
2724
2725 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
2726
2727 its = max(grid%i_start(ij),ids+sz)
2728 ite = min(grid%i_end(ij),ide-1-sz)
2729 jts = max(grid%j_start(ij),jds+sz)
2730 jte = min(grid%j_end(ij),jde-1-sz)
2731
2732 CALL wrf_debug ( 200 , ' call moist_physics_prep' )
2733 BENCH_START(moist_physics_prep_tim)
2734 CALL moist_physics_prep_em( t_2, t_1, t0, rho, &
2735 al, alb, p, p8w, p0, pb, &
2736 ph_2, phb, th_phy, pi_phy, p_phy, &
2737 z, z_at_w, dz8w, &
2738 dtm, h_diabatic, &
2739 config_flags,fnm, fnp, &
2740 ids, ide, jds, jde, kds, kde, &
2741 ims, ime, jms, jme, kms, kme, &
2742 its, ite, jts, jte, &
2743 k_start , k_end )
2744 BENCH_END(moist_physics_prep_tim)
2745 END DO scalar_tile_loop_1a
2746 !$OMP END PARALLEL DO
2747
2748 CALL wrf_debug ( 200 , ' call microphysics_driver' )
2749
2750 BENCH_START(micro_driver_tim)
2751 sr = 0.
2752 specified_bdy = config_flags%specified .OR. config_flags%nested
2753
2754 CALL microphysics_driver( &
2755 & DT=dtm ,DX=dx ,DY=dy &
2756 & ,DZ8W=dz8w ,F_ICE_PHY=f_ice_phy &
2757 & ,ITIMESTEP=itimestep ,LOWLYR=lowlyr &
2758 & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
2759 & ,RHO=rho ,SPEC_ZONE=spec_zone &
2760 & ,SR=sr ,TH=th_phy &
2761 & ,WARM_RAIN=warm_rain ,XLAND=xland &
2762 & ,SPECIFIED=specified_bdy &
2763 & ,F_RAIN_PHY=f_rain_phy &
2764 & ,F_RIMEF_PHY=f_rimef_phy &
2765 & ,MP_PHYSICS=config_flags%mp_physics &
2766 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2767 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2768 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
2769 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
2770 & ,KTS=k_start, KTE=min(k_end,kde-1) &
2771 & ,NUM_TILES=grid%num_tiles &
2772 ! Optional
2773 & , RAINNC=rainnc, RAINNCV=rainncv &
2774 & , W=w_2, Z=z, HT=ht &
2775 & , MP_RESTART_STATE=mp_restart_state &
2776 & , TBPVS_STATE=tbpvs_state & ! etampnew
2777 & , TBPVS0_STATE=tbpvs0_state & ! etampnew
2778 & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
2779 & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
2780 & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
2781 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
2782 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
2783 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
2784 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
2785 )
2786 BENCH_END(micro_driver_tim)
2787 endif
2788
2789 CALL wrf_debug ( 200 , ' call moist_physics_finish' )
2790 BENCH_START(moist_phys_end_tim)
2791 !$OMP PARALLEL DO &
2792 !$OMP PRIVATE ( ij, its, ite, jts, jte )
2793
2794 scalar_tile_loop_1b: DO ij = 1 , grid%num_tiles
2795
2796 its = max(grid%i_start(ij),ids+sz)
2797 ite = min(grid%i_end(ij),ide-1-sz)
2798 jts = max(grid%j_start(ij),jds+sz)
2799 jte = min(grid%j_end(ij),jde-1-sz)
2800
2801 CALL moist_physics_finish_em( t_2, t_1, t0, muts, &
2802 th_phy, h_diabatic, dtm, config_flags, &
2803 ids, ide, jds, jde, kds, kde, &
2804 ims, ime, jms, jme, kms, kme, &
2805 its, ite, jts, jte, &
2806 k_start , k_end )
2807
2808
2809 CALL calc_p_rho_phi( moist, num_3d_m, &
2810 al, alb, mu_2, muts, &
2811 ph_2, p, pb, t_2, &
2812 p0, t0, znu, dnw, rdnw, &
2813 rdn, non_hydrostatic, &
2814 ids, ide, jds, jde, kds, kde, &
2815 ims, ime, jms, jme, kms, kme, &
2816 its, ite, jts, jte, &
2817 k_start , k_end )
2818
2819 IF (.not. non_hydrostatic) &
2820 CALL diagnose_w( ph_tend, ph_2, ph_1, w_2, muts, dt_rk, &
2821 u_2, v_2, ht, &
2822 cf1, cf2, cf3, rdx, rdy, msft, &
2823 ids, ide, jds, jde, kds, kde, &
2824 ims, ime, jms, jme, kms, kme, &
2825 its, ite, jts, jte, &
2826 k_start , k_end )
2827
2828 END DO scalar_tile_loop_1b
2829 !$OMP END PARALLEL DO
2830 BENCH_END(moist_phys_end_tim)
2831
2832 ENDIF
2833
2834 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2835
2836 CALL wrf_debug ( 200 , ' call scalar_tile_loop_2' )
2837
2838 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
2839
2840 !
2841 ! tiled chemistry not here, it is called from solve_interface, and found in chem_driver
2842 !
2843
2844 END IF
2845
2846 END DO scalar_tile_loop_2
2847
2848 ! We're finished except for boundary condition (and patch) update
2849
2850 ! Boundary condition time (or communication time). At this time, we have
2851 ! implemented periodic and symmetric physical boundary conditions.
2852
2853 ! b.c. routine for data within patch.
2854
2855 ! we need to do both time levels of
2856 ! data because the time filter only works in the physical solution space.
2857
2858 ! First, do patch communications for boundary conditions (periodicity)
2859
2860 !-----------------------------------------------------------
2861 ! Stencils for patch communications (WCS, 29 June 2001)
2862 !
2863 ! here's where we need a wide comm stencil - these are the
2864 ! uncoupled variables so are used for high order calc in
2865 ! advection and mixong routines.
2866 !
2867 ! * * * * *
2868 ! * * * * * * * * *
2869 ! * + * * + * * * + * *
2870 ! * * * * * * * * *
2871 ! * * * * *
2872 !
2873 ! u_1 x
2874 ! u_2 x
2875 ! v_1 x
2876 ! v_2 x
2877 ! w_1 x
2878 ! w_2 x
2879 ! t_1 x
2880 ! t_2 x
2881 ! ph_1 x
2882 ! ph_2 x
2883 ! tke_1 x
2884 ! tke_2 x
2885 !
2886 ! 2D variables
2887 ! mu_1 x
2888 ! mu_2 x
2889 !
2890 ! 4D variables
2891 ! moist x
2892 ! chem x
2893 !----------------------------------------------------------
2894
2895
2896 #ifdef DM_PARALLEL
2897 IF ( h_mom_adv_order <= 4 ) THEN
2898 #include "HALO_EM_D3_3.inc"
2899 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2900 #include "HALO_EM_D3_5.inc"
2901 ELSE
2902 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2903 CALL wrf_error_fatal(TRIM(wrf_err_message))
2904 ENDIF
2905 #include "PERIOD_BDY_EM_D3.inc"
2906 #include "PERIOD_BDY_EM_MOIST.inc"
2907 #include "PERIOD_BDY_EM_CHEM.inc"
2908 #endif
2909
2910 ! now set physical b.c on a patch
2911
2912 BENCH_START(bc_2d_tim)
2913 if(dyn_opt == DYN_EM) then
2914 !$OMP PARALLEL DO &
2915 !$OMP PRIVATE ( ij )
2916
2917 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
2918
2919 CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
2920
2921 CALL set_phys_bc_dry_2( config_flags, &
2922 u_1, u_2, v_1, v_2, w_1, w_2, &
2923 t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
2924 ids, ide, jds, jde, kds, kde, &
2925 ims, ime, jms, jme, kms, kme, &
2926 ips, ipe, jps, jpe, kps, kpe, &
2927 grid%i_start(ij), grid%i_end(ij), &
2928 grid%j_start(ij), grid%j_end(ij), &
2929 k_start , k_end )
2930
2931 CALL set_physical_bc3d( tke_1(ims,kms,jms), 'p', config_flags, &
2932 ids, ide, jds, jde, kds, kde, &
2933 ims, ime, jms, jme, kms, kme, &
2934 ips, ipe, jps, jpe, kps, kpe, &
2935 grid%i_start(ij), grid%i_end(ij), &
2936 grid%j_start(ij), grid%j_end(ij), &
2937 k_start , k_end-1 )
2938 CALL set_physical_bc3d( tke_2(ims,kms,jms) , 'p', config_flags, &
2939 ids, ide, jds, jde, kds, kde, &
2940 ims, ime, jms, jme, kms, kme, &
2941 ips, ipe, jps, jpe, kps, kpe, &
2942 grid%i_start(ij), grid%i_end(ij), &
2943 grid%j_start(ij), grid%j_end(ij), &
2944 k_start , k_end )
2945
2946 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
2947
2948 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
2949 config_flags, &
2950 ids, ide, jds, jde, kds, kde, &
2951 ims, ime, jms, jme, kms, kme, &
2952 ips, ipe, jps, jpe, kps, kpe, &
2953 grid%i_start(ij), grid%i_end(ij), &
2954 grid%j_start(ij), grid%j_end(ij), &
2955 k_start , k_end )
2956
2957 END DO moisture_loop_bdy_2
2958
2959 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
2960
2961 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
2962 ids, ide, jds, jde, kds, kde, &
2963 ims, ime, jms, jme, kms, kme, &
2964 ips, ipe, jps, jpe, kps, kpe, &
2965 grid%i_start(ij), grid%i_end(ij), &
2966 grid%j_start(ij), grid%j_end(ij), &
2967 k_start , k_end )
2968
2969 END DO chem_species_bdy_loop_2
2970
2971 END DO tile_bc_loop_2
2972 !$OMP END PARALLEL DO
2973 endif
2974 BENCH_END(bc_2d_tim)
2975
2976 IF( config_flags%specified .or. config_flags%nested ) THEN
2977 dtbc = dtbc + dt
2978 ENDIF
2979
2980 #ifdef DM_PARALLEL
2981 !-----------------------------------------------------------------------
2982 ! see above
2983 !--------------------------------------------------------------
2984 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
2985 IF ( h_mom_adv_order <= 4 ) THEN
2986 #include "HALO_EM_E_3.inc"
2987 ELSE IF ( h_mom_adv_order <= 6 ) THEN
2988 #include "HALO_EM_E_5.inc"
2989 ELSE
2990 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
2991 CALL wrf_error_fatal(TRIM(wrf_err_message))
2992 ENDIF
2993 #endif
2994
2995 #ifdef DM_PARALLEL
2996 if ( num_moist >= PARAM_FIRST_SCALAR ) then
2997 !-----------------------------------------------------------------------
2998 ! see above
2999 !--------------------------------------------------------------
3000 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
3001 IF ( h_mom_adv_order <= 4 ) THEN
3002 #include "HALO_EM_MOIST_E_3.inc"
3003 ELSE IF ( h_mom_adv_order <= 6 ) THEN
3004 #include "HALO_EM_MOIST_E_5.inc"
3005 ELSE
3006 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
3007 CALL wrf_error_fatal(TRIM(wrf_err_message))
3008 ENDIF
3009 endif
3010 if ( num_chem >= PARAM_FIRST_SCALAR ) then
3011 !-----------------------------------------------------------------------
3012 ! see above
3013 !--------------------------------------------------------------
3014 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
3015 IF ( h_mom_adv_order <= 4 ) THEN
3016 #include "HALO_EM_CHEM_E_3.inc"
3017 ELSE IF ( h_mom_adv_order <= 6 ) THEN
3018 #include "HALO_EM_CHEM_E_5.inc"
3019 ELSE
3020 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',h_mom_adv_order
3021 CALL wrf_error_fatal(TRIM(wrf_err_message))
3022 ENDIF
3023 endif
3024 #endif
3025
3026 CALL wrf_debug ( 200 , ' call end of solve_em_tl' )
3027
3028 ! Finish timers if compiled with -DBENCH.
3029 #include "bench_solve_em_end.h"
3030
3031 ! See comment before earlier #include of this file.
3032 #define COPY_OUT
3033 #include "em_scalar_derefs.inc"
3034
3035 #endif
3036
3037 RETURN
3038
3039 END SUBROUTINE solve_em_tl
3040