solve_em.F
References to this file elsewhere.
1 !WRF:MEDIATION_LAYER:SOLVER
2
3 SUBROUTINE solve_em ( grid , config_flags &
4 ! Actual arguments generated from Registry
5 #include "em_dummy_new_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 USE module_polarfft
28 ! Registry generated module
29 USE module_state_description
30 USE module_radiation_driver
31 USE module_surface_driver
32 USE module_cumulus_driver
33 USE module_microphysics_driver
34 USE module_microphysics_zero_out
35 USE module_pbl_driver
36 USE module_fddagd_driver
37 USE module_fddaobs_driver
38 USE module_diagnostics
39 #ifdef WRF_CHEM
40 USE module_input_chem_data
41 USE module_chem_utilities
42 #endif
43
44 IMPLICIT NONE
45
46 ! Input data.
47
48 TYPE(domain) , TARGET :: grid
49
50 ! Definitions of dummy arguments to this routine (generated from Registry).
51 #include "em_dummy_new_decl.inc"
52
53 ! Structure that contains run-time configuration (namelist) data for domain
54 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
55
56 ! Local data
57
58 INTEGER :: k_start , k_end, its, ite, jts, jte
59 INTEGER :: ids , ide , jds , jde , kds , kde , &
60 ims , ime , jms , jme , kms , kme , &
61 ips , ipe , jps , jpe , kps , kpe
62
63 INTEGER :: sids , side , sjds , sjde , skds , skde , &
64 sims , sime , sjms , sjme , skms , skme , &
65 sips , sipe , sjps , sjpe , skps , skpe
66
67
68 INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
69 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
70 imsy, imey, jmsy, jmey, kmsy, kmey, &
71 ipsy, ipey, jpsy, jpey, kpsy, kpey
72
73 INTEGER :: ij , iteration
74 INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
75 INTEGER :: loop
76 INTEGER :: sz
77 INTEGER :: iswater
78
79 LOGICAL :: specified_bdy, channel_bdy
80
81 REAL :: t_new
82
83 ! storage for tendencies and decoupled state (generated from Registry)
84
85 #include <em_i1_decl.inc>
86 ! Previous time level of tracer arrays now defined as i1 variables;
87 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
88 ! Benefit: save memory in nested runs, since only 1 domain is active at a
89 ! time. Potential problem on stack-limited architectures: increases
90 ! amount of data on program stack by making these automatic arrays.
91
92 INTEGER :: rc
93 INTEGER :: number_of_small_timesteps, rk_step
94 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
95 INTEGER :: idum1, idum2, dynamics_option
96
97 INTEGER :: rk_order, iwmax, jwmax, kwmax
98 REAL :: dt_rk, dts_rk, dtm, wmax
99 INTEGER :: l,kte,kk
100
101 INTEGER :: ii, jj !kk is above after l,kte
102 REAL :: dclat
103
104 ! urban related variables
105 INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
106
107 ! Define benchmarking timers if -DBENCH is compiled
108 #include <bench_solve_em_def.h>
109
110 !----------------------
111 ! Executable statements
112 !----------------------
113
114 ! Needed by some comm layers, grid%e.g. RSL. If needed, nmm_data_calls.inc is
115 ! generated from the registry. The definition of REGISTER_I1 allows
116 ! I1 data to be communicated in this routine if necessary.
117 #ifdef DM_PARALLEL
118 # define REGISTER_I1
119 # include "em_data_calls.inc"
120 #endif
121
122 !<DESCRIPTION>
123 !<pre>
124 ! solve_em is the main driver for advancing a grid a single timestep.
125 ! It is a mediation-layer routine -> DM and SM calls are made where
126 ! needed for parallel processing.
127 !
128 ! solve_em can integrate the equations using 3 time-integration methods
129 !
130 ! - 3rd order Runge-Kutta time integration (recommended)
131 !
132 ! - 2nd order Runge-Kutta time integration
133 !
134 ! The main sections of solve_em are
135 !
136 ! (1) Runge-Kutta (RK) loop
137 !
138 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
139 ! model state variables during the first RK sub-step (loop)
140 !
141 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
142 !
143 ! (4) scalar advance for moist and chem scalar variables (and TKE)
144 ! within the RK sub-steps.
145 !
146 ! (5) time-split physics (after the RK step), currently this includes
147 ! only microphyics
148 !
149 ! A more detailed description of these sections follows.
150 !</pre>
151 !</DESCRIPTION>
152
153 ! Initialize timers if compiled with -DBENCH
154 #include <bench_solve_em_init.h>
155
156 ! set runge-kutta solver (2nd or 3rd order)
157
158 dynamics_option = config_flags%rk_ord
159
160 ! Obtain dimension information stored in the grid data structure.
161
162 CALL get_ijk_from_grid ( grid , &
163 ids, ide, jds, jde, kds, kde, &
164 ims, ime, jms, jme, kms, kme, &
165 ips, ipe, jps, jpe, kps, kpe, &
166 imsx, imex, jmsx, jmex, kmsx, kmex, &
167 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
168 imsy, imey, jmsy, jmey, kmsy, kmey, &
169 ipsy, ipey, jpsy, jpey, kpsy, kpey )
170
171 CALL get_ijk_from_subgrid ( grid , &
172 sids, side, sjds, sjde, skds, skde, &
173 sims, sime, sjms, sjme, skms, skme, &
174 sips, sipe, sjps, sjpe, skps, skpe )
175
176 k_start = kps
177 k_end = kpe
178
179 num_3d_m = num_moist
180 num_3d_c = num_chem
181 num_3d_s = num_scalar
182
183
184 ! Compute these starting and stopping locations for each tile and number of tiles.
185 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
186 CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
187
188 grid%itimestep = grid%itimestep + 1
189
190 IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
191
192 !**********************************************************************
193 !
194 ! LET US BEGIN.......
195 !
196 !<DESCRIPTION>
197 !<pre>
198 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
199 !
200 ! Predictor-corrector type time integration.
201 ! Advection terms are evaluated at time t for the predictor step,
202 ! and advection is re-evaluated with the latest predicted value for
203 ! each succeeding time corrector step
204 !
205 ! 2nd order Runge Kutta (rk_order = 2):
206 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
207 !
208 ! 3rd order Runge Kutta (rk_order = 3):
209 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
210 ! and step 3 is from t to dt.
211 !
212 ! non-timesplit physics are evaluated during first RK step and
213 ! these physics tendencies are stored for use in each RK pass.
214 !</pre>
215 !</DESCRIPTION>
216 !**********************************************************************
217
218 #ifdef WRF_CHEM
219 !
220 ! prepare chem aerosols for advection before communication
221 !
222
223 kte=min(k_end,kde-1)
224 # ifdef DM_PARALLEL
225 if ( num_chem >= PARAM_FIRST_SCALAR ) then
226 !-----------------------------------------------------------------------
227 ! see matching halo calls below for stencils
228 !--------------------------------------------------------------
229 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
230 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
231 # include "HALO_EM_CHEM_E_3.inc"
232 if( config_flags%progn > 0 ) then
233 # include "HALO_EM_SCALAR_E_3.inc"
234 end if
235 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
236 # include "HALO_EM_CHEM_E_5.inc"
237 if( config_flags%progn > 0 ) then
238 # include "HALO_EM_SCALAR_E_5.inc"
239 end if
240 ELSE
241 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
242 CALL wrf_error_fatal(TRIM(wrf_err_message))
243 ENDIF
244 endif
245 # endif
246 !--------------------------------------------------------------
247 #endif
248
249 rk_order = config_flags%rk_ord
250 IF (grid%time_step_sound == 0) THEN
251 ! auto-set option
252 ! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
253 grid%time_step_sound = max ( 2 * ( INT (300.*grid%dt/grid%dx-0.01) + 1 ), 4 )
254 WRITE(wrf_err_message,*)'dx, dt, time_step_sound=',grid%dx,grid%dt,grid%time_step_sound
255 CALL wrf_debug ( 50 , wrf_err_message )
256 ENDIF
257
258 grid%dts = grid%dt/float(grid%time_step_sound)
259
260 Runge_Kutta_loop: DO rk_step = 1, rk_order
261
262 ! Set the step size and number of small timesteps for
263 ! each part of the timestep
264
265 dtm = grid%dt
266 IF ( rk_order == 1 ) THEN
267
268 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
269 CALL wrf_error_fatal( wrf_err_message )
270
271 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
272
273 IF ( rk_step == 1) THEN
274 dt_rk = 0.5*grid%dt
275 dts_rk = grid%dts
276 number_of_small_timesteps = grid%time_step_sound/2
277 ELSE
278 dt_rk = grid%dt
279 dts_rk = grid%dts
280 number_of_small_timesteps = grid%time_step_sound
281 ENDIF
282
283 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
284
285 IF ( rk_step == 1) THEN
286 dt_rk = grid%dt/3.
287 dts_rk = dt_rk
288 number_of_small_timesteps = 1
289 ELSE IF (rk_step == 2) THEN
290 dt_rk = 0.5*grid%dt
291 dts_rk = grid%dts
292 number_of_small_timesteps = grid%time_step_sound/2
293 ELSE
294 dt_rk = grid%dt
295 dts_rk = grid%dts
296 number_of_small_timesteps = grid%time_step_sound
297 ENDIF
298
299 ELSE
300
301 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
302 CALL wrf_error_fatal( wrf_err_message )
303
304 END IF
305
306 ! Ensure that polar meridional velocity is zero
307 IF (config_flags%polar) THEN
308 !$OMP PARALLEL DO &
309 !$OMP PRIVATE ( ij )
310 DO ij = 1 , grid%num_tiles
311 CALL zero_pole ( grid%em_v_1, &
312 ids, ide, jds, jde, kds, kde, &
313 ims, ime, jms, jme, kms, kme, &
314 grid%i_start(ij), grid%i_end(ij), &
315 grid%j_start(ij), grid%j_end(ij), &
316 k_start, k_end )
317 CALL zero_pole ( grid%em_v_2, &
318 ids, ide, jds, jde, kds, kde, &
319 ims, ime, jms, jme, kms, kme, &
320 grid%i_start(ij), grid%i_end(ij), &
321 grid%j_start(ij), grid%j_end(ij), &
322 k_start, k_end )
323 END DO
324 !$OMP END PARALLEL DO
325 END IF
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
339 CALL rk_step_prep ( config_flags, rk_step, &
340 grid%em_u_2, grid%em_v_2, grid%em_w_2, grid%em_t_2, grid%em_ph_2, grid%em_mu_2, &
341 moist, &
342 grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww, grid%em_php, grid%em_alt, grid%em_muu, grid%em_muv, &
343 grid%em_mub, grid%em_mut, grid%em_phb, grid%em_pb, grid%em_p, grid%em_al, grid%em_alb, &
344 cqu, cqv, cqw, &
345 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, grid%msfvy, grid%msftx, grid%msfty, &
346 grid%em_fnm, grid%em_fnp, grid%em_dnw, grid%rdx, grid%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
354 END DO
355 !$OMP END PARALLEL DO
356 BENCH_END(step_prep_tim)
357
358 #ifdef DM_PARALLEL
359 !-----------------------------------------------------------------------
360 ! Stencils for patch communications (WCS, 29 June 2001)
361 ! Note: the small size of this halo exchange reflects the
362 ! fact that we are carrying the uncoupled variables
363 ! as state variables in the mass coordinate model, as
364 ! opposed to the coupled variables as in the height
365 ! coordinate model.
366 !
367 ! * * * * *
368 ! * * * * * * * * *
369 ! * + * * + * * * + * *
370 ! * * * * * * * * *
371 ! * * * * *
372 !
373 ! 3D variables - note staggering! grid%em_ru(X), grid%em_rv(Y), grid%em_ww(grid%em_z), grid%em_php(grid%em_z)
374 !
375 !j grid%em_ru x
376 !j grid%em_rv x
377 !j grid%em_ww x
378 !j grid%em_php x
379 !j grid%em_alt x
380 !j grid%em_ph_2 x
381 !j grid%em_phb x
382 !
383 ! the following are 2D (xy) variables
384 !
385 !j grid%em_muu x
386 !j grid%em_muv x
387 !j grid%em_mut x
388 !--------------------------------------------------------------
389 # include "HALO_EM_A.inc"
390 #endif
391
392 ! set boundary conditions on variables
393 ! from big_step_prep for use in big_step_proc
394
395 #ifdef DM_PARALLEL
396 # include "PERIOD_BDY_EM_A.inc"
397 #endif
398
399 ! CALL set_tiles ( grid , ids , ide , jds , jde , ips-1 , ipe+1 , jps-1 , jpe+1 )
400
401 BENCH_START(set_phys_bc_tim)
402 !$OMP PARALLEL DO &
403 !$OMP PRIVATE ( ij, ii, jj, kk )
404
405 DO ij = 1 , grid%num_tiles
406
407 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
408
409 CALL rk_phys_bc_dry_1( config_flags, grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww, &
410 grid%em_muu, grid%em_muv, grid%em_mut, grid%em_php, grid%em_alt, grid%em_p, &
411 ids, ide, jds, jde, kds, kde, &
412 ims, ime, jms, jme, kms, kme, &
413 ips, ipe, jps, jpe, kps, kpe, &
414 grid%i_start(ij), grid%i_end(ij), &
415 grid%j_start(ij), grid%j_end(ij), &
416 k_start, k_end )
417 !TBH: need this 2nd timestep and later
418 CALL set_physical_bc3d( grid%em_al, 'p', config_flags, &
419 ids, ide, jds, jde, kds, kde, &
420 ims, ime, jms, jme, kms, kme, &
421 ips, ipe, jps, jpe, kps, kpe, &
422 grid%i_start(ij), grid%i_end(ij), &
423 grid%j_start(ij), grid%j_end(ij), &
424 k_start , k_end )
425 CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags, &
426 ids, ide, jds, jde, kds, kde, &
427 ims, ime, jms, jme, kms, kme, &
428 ips, ipe, jps, jpe, kps, kpe, &
429 grid%i_start(ij), grid%i_end(ij), &
430 grid%j_start(ij), grid%j_end(ij), &
431 k_start, k_end )
432
433 IF (config_flags%polar) THEN
434
435 !-------------------------------------------------------
436 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
437 !-------------------------------------------------------
438
439 CALL pole_point_bc ( grid%em_v_1, &
440 ids, ide, jds, jde, kds, kde, &
441 ims, ime, jms, jme, kms, kme, &
442 grid%i_start(ij), grid%i_end(ij), &
443 grid%j_start(ij), grid%j_end(ij), &
444 k_start, k_end )
445
446 CALL pole_point_bc ( grid%em_v_2, &
447 ids, ide, jds, jde, kds, kde, &
448 ims, ime, jms, jme, kms, kme, &
449 grid%i_start(ij), grid%i_end(ij), &
450 grid%j_start(ij), grid%j_end(ij), &
451 k_start, k_end )
452
453 ! CALL zero_pole ( grid%em_rv, &
454 ! ids, ide, jds, jde, kds, kde, &
455 ! ims, ime, jms, jme, kms, kme, &
456 ! grid%i_start(ij), grid%i_end(ij), &
457 ! grid%j_start(ij), grid%j_end(ij), &
458 ! k_start, k_end )
459
460 !-------------------------------------------------------
461 ! end lat-lon grid pole-point (v) specification
462 !-------------------------------------------------------
463
464 ENDIF
465
466 END DO
467 !$OMP END PARALLEL DO
468 BENCH_END(set_phys_bc_tim)
469
470 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
471
472 ! initialize all tendencies to zero in order to update physics
473 ! tendencies first (separate from dry dynamics).
474
475 BENCH_START(init_zero_tend_tim)
476 !$OMP PARALLEL DO &
477 !$OMP PRIVATE ( ij )
478
479 DO ij = 1 , grid%num_tiles
480
481 CALL wrf_debug ( 200 , ' call init_zero_tendency' )
482 CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf, &
483 ph_tendf, t_tendf, tke_tend, &
484 mu_tendf, &
485 moist_tend,chem_tend,scalar_tend, &
486 num_3d_m,num_3d_c,num_3d_s, &
487 rk_step, &
488 ids, ide, jds, jde, kds, kde, &
489 ims, ime, jms, jme, kms, kme, &
490 grid%i_start(ij), grid%i_end(ij), &
491 grid%j_start(ij), grid%j_end(ij), &
492 k_start, k_end )
493
494 END DO
495 !$OMP END PARALLEL DO
496 BENCH_END(init_zero_tend_tim)
497
498 #ifdef DM_PARALLEL
499 # include "HALO_EM_PHYS_A.inc"
500 #endif
501
502 !<DESCRIPTION>
503 !<pre>
504 !(2) The non-timesplit physics begins with a call to "phy_prep"
505 ! (which computes some diagnostic variables such as temperature,
506 ! pressure, u and v at p points, etc). This is followed by
507 ! calls to the physics drivers:
508 !
509 ! radiation,
510 ! surface,
511 ! pbl,
512 ! cumulus,
513 ! 3D TKE and mixing.
514 !<pre>
515 !</DESCRIPTION>
516
517
518 BENCH_START(phy_prep_tim)
519 !$OMP PARALLEL DO &
520 !$OMP PRIVATE ( ij )
521 DO ij = 1 , grid%num_tiles
522
523 CALL wrf_debug ( 200 , ' call phy_prep' )
524 CALL phy_prep ( config_flags, &
525 grid%em_mut, grid%em_muu, grid%em_muv, grid%em_u_2, &
526 grid%em_v_2, grid%em_p, grid%em_pb, grid%em_alt, &
527 grid%em_ph_2, grid%em_phb, grid%em_t_2, grid%tsk, moist, num_3d_m, &
528 mu_3d, rho, &
529 th_phy, p_phy, pi_phy, u_phy, v_phy, &
530 p8w, t_phy, t8w, grid%em_z, z_at_w, &
531 dz8w, grid%em_fnm, grid%em_fnp, &
532 grid%rthraten, &
533 grid%rthblten, grid%rublten, grid%rvblten, &
534 grid%rqvblten, grid%rqcblten, grid%rqiblten, &
535 grid%rthcuten, grid%rqvcuten, grid%rqccuten, &
536 grid%rqrcuten, grid%rqicuten, grid%rqscuten, &
537 grid%rthften, grid%rqvften, &
538 grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN, &
539 grid%RQVNDGDTEN, grid%RMUNDGDTEN, &
540 ids, ide, jds, jde, kds, kde, &
541 ims, ime, jms, jme, kms, kme, &
542 grid%i_start(ij), grid%i_end(ij), &
543 grid%j_start(ij), grid%j_end(ij), &
544 k_start, k_end )
545 ENDDO
546 !$OMP END PARALLEL DO
547
548 BENCH_END(phy_prep_tim)
549
550 ! physics to implement
551
552 ! CALL set_tiles ( grid , ids , ide-1 , jds , jde-1 ips , ipe , jps , jpe )
553
554 ! Open MP loops are in physics drivers
555 ! radiation
556
557 !-----------------------------------------------------------------
558 ! urban related variable are added to arguments of radiation_driver
559 !-----------------------------------------------------------------
560
561 CALL wrf_debug ( 200 , ' call radiation_driver' )
562 BENCH_START(rad_driver_tim)
563
564 CALL radiation_driver( &
565 & ACFRCV=grid%acfrcv ,ACFRST=grid%acfrst ,ALBEDO=grid%albedo &
566 & ,CFRACH=grid%cfrach ,CFRACL=grid%cfracl ,CFRACM=grid%cfracm &
567 & ,CUPPT=grid%cuppt ,CZMEAN=grid%czmean ,DT=grid%dt &
568 & ,DZ8W=dz8w ,EMISS=grid%emiss ,GLW=grid%glw &
569 & ,GMT=grid%gmt ,GSW=grid%gsw ,HBOT=grid%hbot &
570 & ,HTOP=grid%htop ,HBOTR=grid%hbotr, HTOPR=grid%htopr ,ICLOUD=config_flags%icloud &
571 & ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday, JULIAN=grid%julian &
572 & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics &
573 & ,NCFRCV=grid%ncfrcv ,NCFRST=grid%ncfrst ,NPHS=1 &
574 & ,P8W=p8w ,P=p_phy ,PI=pi_phy &
575 & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset &
576 & ,RHO=rho ,RLWTOA=grid%rlwtoa &
577 & ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten &
578 & ,RTHRATENLW=grid%rthratenlw &
579 & ,RTHRATENSW=grid%rthratensw ,SNOW=grid%snow &
580 & ,STEPRA=grid%stepra ,SWDOWN=grid%swdown ,SWDOWNC=grid%swdownc &
581 & ,SW_PHYSICS=config_flags%ra_sw_physics ,T8W=t8w &
582 & ,T=t_phy ,TAUCLDC=grid%taucldc ,TAUCLDI=grid%taucldi &
583 & ,TSK=grid%tsk ,VEGFRA=grid%vegfra ,WARM_RAIN=grid%warm_rain &
584 & ,XICE=grid%xice &
585 & ,XLAND=grid%xland ,XLAT=grid%xlat ,XLONG=grid%xlong &
586 !Optional urban
587 & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d &
588 & ,OMG_URB2D=grid%omg_urb2d &
589 !
590 & ,Z=grid%em_z &
591 & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm &
592 & ,N_AEROSOLC=num_aerosolc &
593 & ,PAERLEV=grid%paerlev &
594 & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 &
595 & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s &
596 & ,XTIME=grid%xtime &
597 ! indexes
598 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
599 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
600 & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) &
601 & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) &
602 & ,kts=k_start, kte=min(k_end,kde-1) &
603 & ,num_tiles=grid%num_tiles &
604 ! Optional
605 & , CLDFRA=grid%cldfra &
606 & , PB=grid%em_pb &
607 & , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy &
608 & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV &
609 & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC &
610 & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
611 & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI &
612 & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS &
613 & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG &
614 & , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
615 #ifdef ACFLUX
616 & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc &
617 & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc &
618 & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc &
619 & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc &
620 & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc &
621 & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc &
622 & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc &
623 & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc &
624 & ,SWUPT=swupt ,SWUPTC=swuptc &
625 & ,SWDNT=swdnt ,SWDNTC=swdntc &
626 & ,SWUPB=swupb ,SWUPBC=swupbc &
627 & ,SWDNB=swdnb ,SWDNBC=swdnbc &
628 & ,LWUPT=lwupt ,LWUPTC=lwuptc &
629 & ,LWDNT=lwdnt ,LWDNTC=lwdntc &
630 & ,LWUPB=lwupb ,LWUPBC=lwupbc &
631 & ,LWDNB=lwdnb ,LWDNBC=lwdnbc &
632 #endif
633 & ,LWCF=grid%lwcf &
634 & ,SWCF=grid%swcf &
635 & ,OLR=grid%olr &
636 & ,OZMIXM=grid%ozmixm, PIN=grid%pin &
637 & ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1 &
638 & ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi &
639 & ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot &
640 #ifdef WRF_CHEM
641 & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback &
642 & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback &
643 & ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B &
644 & ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water &
645 & ,PM2_5_DRY_EC=grid%pm2_5_dry_ec &
646 & ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb
647 & ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb
648 & ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb
649 & ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb
650 #endif
651 & )
652
653 BENCH_END(rad_driver_tim)
654
655 !********* Surface driver
656 ! surface
657
658 BENCH_START(surf_driver_tim)
659
660 !-----------------------------------------------------------------
661 ! urban related variable are added to arguments of surface_driver
662 !-----------------------------------------------------------------
663 NUM_ROOF_LAYERS = grid%num_soil_layers !urban
664 NUM_WALL_LAYERS = grid%num_soil_layers !urban
665 NUM_ROAD_LAYERS = grid%num_soil_layers !urban
666 CALL nl_get_iswater(grid%id, iswater)
667
668 CALL wrf_debug ( 200 , ' call surface_driver' )
669 CALL surface_driver( &
670 & ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs &
671 & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo &
672 & ,BR=br ,CANWAT=grid%canwat ,CHKLOWQ=chklowq &
673 & ,CT=grid%ct ,DT=grid%dt ,DX=grid%dx &
674 & ,DZ8W=dz8w ,DZS=grid%dzs ,FLHC=grid%flhc &
675 & ,FLQC=grid%flqc ,GLW=grid%glw ,GRDFLX=grid%grdflx &
676 & ,GSW=grid%gsw ,SWDOWN=grid%swdown ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx &
677 & ,HT=grid%ht ,IFSNOW=config_flags%ifsnow ,ISFFLX=config_flags%isfflx &
678 & ,ISLTYP=grid%isltyp ,ITIMESTEP=grid%itimestep &
679 & ,IVGTYP=grid%ivgtyp ,LH=grid%lh ,LOWLYR=grid%lowlyr &
680 & ,MAVAIL=grid%mavail ,NUM_SOIL_LAYERS=config_flags%num_soil_layers &
681 & ,P8W=p8w ,PBLH=grid%pblh ,PI_PHY=pi_phy &
682 & ,PSFC=grid%psfc ,PSHLTR=grid%pshltr ,PSIH=psih &
683 & ,PSIM=psim ,P_PHY=p_phy ,Q10=grid%q10 &
684 & ,Q2=grid%q2 ,QFX=grid%qfx ,QSFC=grid%qsfc &
685 & ,QSHLTR=grid%qshltr ,QZ0=grid%qz0 ,RAINCV=grid%raincv &
686 & ,RA_LW_PHYSICS=config_flags%ra_lw_physics ,RHO=rho &
687 & ,RMOL=grid%rmol ,SFCEVP=grid%sfcevp ,SFCEXC=grid%sfcexc &
688 & ,SFCRUNOFF=grid%sfcrunoff &
689 & ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics &
690 & ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics ,SH2O=grid%sh2o &
691 & ,SHDMAX=grid%shdmax ,SHDMIN=grid%shdmin ,SMOIS=grid%smois &
692 & ,SMSTAV=grid%smstav ,SMSTOT=grid%smstot ,SNOALB=grid%snoalb &
693 & ,SNOW=grid%snow ,SNOWC=grid%snowc ,SNOWH=grid%snowh &
694 & ,SST=grid%sst ,SST_UPDATE=grid%sst_update &
695 & ,STEPBL=grid%stepbl ,TH10=grid%th10 ,TH2=grid%th2 &
696 & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj &
697 & ,TMN=grid%tmn ,TSHLTR=grid%tshltr ,TSK=grid%tsk &
698 & ,TSLB=grid%tslb ,T_PHY=t_phy ,U10=grid%u10 &
699 & ,URATX=grid%uratx ,VRATX=grid%vratx ,TRATX=grid%tratx &
700 & ,UDRUNOFF=grid%udrunoff ,UST=grid%ust ,UZ0=grid%uz0 &
701 & ,U_FRAME=grid%u_frame ,U_PHY=u_phy ,V10=grid%v10 &
702 & ,VEGFRA=grid%vegfra ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame &
703 & ,V_PHY=v_phy ,WARM_RAIN=grid%warm_rain &
704 & ,WSPD=wspd ,XICE=grid%xice ,XLAND=grid%xland &
705 & ,Z0=grid%z0 ,Z=grid%em_z ,ZNT=grid%znt &
706 & ,ZS=grid%zs ,XICEM=grid%xicem ,ISICE=grid%landuse_isice&
707 & ,ISWATER=iswater &
708 & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & !I urban
709 & ,OMG_URB2D=grid%omg_urb2d ,xlat_urb2d=grid%XLAT & !I urban
710 & ,NUM_ROOF_LAYERS=num_roof_layers & !I urban
711 & ,NUM_WALL_LAYERS=num_wall_layers & !I urban
712 & ,NUM_ROAD_LAYERS=num_road_layers &
713 & ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg & !I urban
714 & ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d &
715 & ,TG_URB2D=grid%tg_urb2d & !H urban
716 & ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d & !H urban
717 & ,UC_URB2D=grid%uc_urb2d & !H urban
718 & ,XXXR_URB2D=grid%xxxr_urb2d &
719 & ,XXXB_URB2D=grid%xxxb_urb2d & !H urban
720 & ,XXXG_URB2D=grid%xxxg_urb2d &
721 & ,XXXC_URB2D=grid%xxxc_urb2d & !H urban
722 & ,TRL_URB3D=grid%trl_urb3d ,TBL_URB3D=grid%tbl_urb3d & !H urban
723 & ,TGL_URB3D=grid%tgl_urb3d & !H urban
724 & ,SH_URB2D=grid%sh_urb2d ,LH_URB2D=grid%lh_urb2d &
725 & ,G_URB2D=grid%g_urb2d & !H urban
726 & ,RN_URB2D=grid%rn_urb2d , TS_URB2D=grid%ts_urb2d & !H urban
727 & ,FRC_URB2D=grid%frc_urb2d & !H urban
728 & ,UTYPE_URB2D=grid%utype_urb2d & !H urban
729 & ,ucmcall=grid%ucmcall & !H urban
730 ! Indexes
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 & ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol &
745 & ,RAINBL=grid%rainbl,SR=grid%em_sr &
746 & ,RAINNCV=grid%rainncv,REGIME=regime,T2=grid%t2,THC=grid%thc &
747 & ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav & ! ruc lsm
748 & ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag & ! ruc lsm
749 & ,POTEVP=grid%em_POTEVP, SNOPCX=grid%em_SNOPCX, SOILTB=grid%em_SOILTB & ! ruc lsm
750 & )
751 BENCH_END(surf_driver_tim)
752
753 !*********
754 ! pbl
755
756 CALL wrf_debug ( 200 , ' call pbl_driver' )
757 BENCH_START(pbl_driver_tim)
758 CALL pbl_driver( &
759 & AKHS=grid%akhs ,AKMS=grid%akms &
760 & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics &
761 & ,BR=br ,CHKLOWQ=chklowq ,CT=grid%ct &
762 & ,DT=grid%dt ,DX=grid%dx ,DZ8W=dz8w &
763 & ,EL_MYJ=grid%el_myj ,EXCH_H=grid%exch_h ,GRDFLX=grid%grdflx &
764 & ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx ,HT=grid%ht &
765 & ,ITIMESTEP=grid%itimestep ,KPBL=grid%kpbl &
766 & ,LH=grid%lh ,LOWLYR=grid%lowlyr ,P8W=p8w &
767 & ,PBLH=grid%pblh ,PI_PHY=pi_phy ,PSIH=psih &
768 & ,PSIM=psim ,P_PHY=p_phy ,QFX=grid%qfx &
769 & ,QSFC=grid%qsfc ,QZ0=grid%qz0 &
770 & ,RA_LW_PHYSICS=config_flags%ra_lw_physics &
771 & ,RHO=rho ,RQCBLTEN=grid%rqcblten ,RQIBLTEN=grid%rqiblten &
772 & ,RQVBLTEN=grid%rqvblten ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten &
773 & ,RVBLTEN=grid%rvblten ,SNOW=grid%snow ,STEPBL=grid%stepbl &
774 & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj &
775 & ,TSK=grid%tsk ,T_PHY=t_phy ,UST=grid%ust &
776 & ,U10=grid%u10 ,UZ0=grid%uz0 ,U_FRAME=grid%u_frame ,U_PHY=u_phy &
777 & ,V10=grid%v10 ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame ,V_PHY=v_phy &
778 & ,WARM_RAIN=grid%warm_rain ,WSPD=wspd &
779 & ,XICE=grid%xice ,XLAND=grid%xland ,Z=grid%em_z &
780 & ,ZNT=grid%znt &
781 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
782 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
783 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
784 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
785 & ,KTS=k_start, KTE=min(k_end,kde-1) &
786 & ,NUM_TILES=grid%num_tiles &
787 ! optional
788 & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
789 & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
790 & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
791 & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
792 & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
793 & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
794 & ,HOL=HOL, MOL=grid%mol, REGIME=REGIME &
795 & )
796
797 BENCH_END(pbl_driver_tim)
798
799 ! cumulus para.
800
801 CALL wrf_debug ( 200 , ' call cumulus_driver' )
802
803 BENCH_START(cu_driver_tim)
804 CALL cumulus_driver( &
805 ! Prognostic variables
806 & U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy &
807 & ,W=grid%em_w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho &
808 ! Other arguments
809 & ,ITIMESTEP=grid%itimestep ,DT=grid%dt ,DX=grid%dx &
810 & ,RAINC=grid%rainc ,RAINCV=grid%raincv ,NCA=grid%nca &
811 & ,HTOP=grid%cutop ,HBOT=grid%cubot ,KPBL=grid%kpbl &
812 & ,DZ8W=dz8w ,P8W=p8w &
813 & ,W0AVG=grid%w0avg ,STEPCU=grid%stepcu &
814 & ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland &
815 & ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w ,APR_MC=grid%apr_mc &
816 & ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma &
817 & ,APR_CAPME=grid%apr_capme ,APR_CAPMI=grid%apr_capmi &
818 & ,MASS_FLUX=grid%mass_flux ,XF_ENS=grid%xf_ens &
819 & ,PR_ENS=grid%pr_ens ,HT=grid%ht &
820 & ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens &
821 & ,MAXENS2=config_flags%maxens2 ,MAXENS3=config_flags%maxens3 &
822 & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=grid%warm_rain &
823 & ,GSW=grid%gsw &
824 ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x) &
825 ,PERIODIC_Y=config_flags%periodic_y &
826 ! Selection flag
827 & ,CU_PHYSICS=config_flags%cu_physics &
828 ! Dimension arguments
829 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
830 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
831 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
832 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
833 & ,KTS=k_start, KTE=min(k_end,kde-1) &
834 & ,NUM_TILES=grid%num_tiles &
835 ! Moisture tendency arguments
836 & ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten &
837 & ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten &
838 & ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten &
839 & ,RQVFTEN=grid%rqvften &
840 ! Other tendency arguments
841 & ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten &
842 & ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften &
843 ! Moisture tracer arguments
844 & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
845 & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
846 & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
847 & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
848 & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
849 & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
850 #ifdef WRF_CHEM
851 & ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2 &
852 #endif
853 & )
854 BENCH_END(cu_driver_tim)
855
856 ! fdda
857
858 CALL wrf_debug ( 200 , ' call fddagd_driver' )
859
860 BENCH_START(fdda_driver_tim)
861 CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, &
862 id=grid%id, &
863 RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, &
864 RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten, &
865 RMUNDGDTEN=grid%rmundgdten, &
866 u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old), &
867 v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old), &
868 t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old), &
869 q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old), &
870 mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old), &
871 u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new), &
872 v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new), &
873 t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new), &
874 q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new), &
875 mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new), &
876 u3d=grid%em_u_2,v3d=grid%em_v_2,th_phy=th_phy,rho=rho,moist=moist, &
877 p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy, &
878 dz8w=dz8w,z=grid%em_z,z_at_w=z_at_w, &
879 config_flags=config_flags,dx=grid%DX,n_moist=num_3d_m, &
880 STEPFG=grid%STEPFG, &
881 pblh=grid%pblh,ht=grid%ht, &
882 IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
883 ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
884 ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
885 ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
886 ,KTS=k_start, KTE=min(k_end,kde-1) &
887 , num_tiles=grid%num_tiles )
888 BENCH_END(fdda_driver_tim)
889
890 ! calculate_phy_tend
891
892 BENCH_START(cal_phy_tend)
893 !$OMP PARALLEL DO &
894 !$OMP PRIVATE ( ij )
895
896 DO ij = 1 , grid%num_tiles
897
898 CALL wrf_debug ( 200 , ' call calculate_phy_tend' )
899 CALL calculate_phy_tend (config_flags,grid%em_mut,grid%em_muu,grid%em_muv,pi_phy, &
900 grid%rthraten, &
901 grid%rublten,grid%rvblten,grid%rthblten, &
902 grid%rqvblten,grid%rqcblten,grid%rqiblten, &
903 grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
904 grid%rqicuten,grid%rqscuten, &
905 grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, &
906 grid%RMUNDGDTEN, &
907 ids,ide, jds,jde, kds,kde, &
908 ims,ime, jms,jme, kms,kme, &
909 grid%i_start(ij), min(grid%i_end(ij),ide-1), &
910 grid%j_start(ij), min(grid%j_end(ij),jde-1), &
911 k_start , min(k_end,kde-1) )
912
913 ENDDO
914 !$OMP END PARALLEL DO
915 BENCH_END(cal_phy_tend)
916
917 ! tke diffusion
918
919 IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN
920
921 BENCH_START(comp_diff_metrics_tim)
922 !$OMP PARALLEL DO &
923 !$OMP PRIVATE ( ij )
924
925 DO ij = 1 , grid%num_tiles
926
927 CALL wrf_debug ( 200 , ' call compute_diff_metrics ' )
928 CALL compute_diff_metrics ( config_flags, grid%em_ph_2, grid%em_phb, grid%em_z, grid%em_rdz, grid%em_rdzw, &
929 grid%em_zx, grid%em_zy, grid%rdx, grid%rdy, &
930 ids, ide, jds, jde, kds, kde, &
931 ims, ime, jms, jme, kms, kme, &
932 grid%i_start(ij), grid%i_end(ij), &
933 grid%j_start(ij), grid%j_end(ij), &
934 k_start , k_end )
935 ENDDO
936 !$OMP END PARALLEL DO
937 BENCH_END(comp_diff_metrics_tim)
938
939 #ifdef DM_PARALLEL
940 # include "PERIOD_BDY_EM_A1.inc"
941 #endif
942
943 BENCH_START(tke_diff_bc_tim)
944 !$OMP PARALLEL DO &
945 !$OMP PRIVATE ( ij )
946
947 DO ij = 1 , grid%num_tiles
948
949 CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' )
950 CALL set_physical_bc3d( grid%em_rdzw , 'w', config_flags, &
951 ids, ide, jds, jde, kds, kde, &
952 ims, ime, jms, jme, kms, kme, &
953 ips, ipe, jps, jpe, kps, kpe, &
954 grid%i_start(ij), grid%i_end(ij), &
955 grid%j_start(ij), grid%j_end(ij), &
956 k_start , k_end )
957 CALL set_physical_bc3d( grid%em_rdz , 'w', config_flags, &
958 ids, ide, jds, jde, kds, kde, &
959 ims, ime, jms, jme, kms, kme, &
960 ips, ipe, jps, jpe, kps, kpe, &
961 grid%i_start(ij), grid%i_end(ij), &
962 grid%j_start(ij), grid%j_end(ij), &
963 k_start , k_end )
964 CALL set_physical_bc3d( grid%em_z , 'w', config_flags, &
965 ids, ide, jds, jde, kds, kde, &
966 ims, ime, jms, jme, kms, kme, &
967 ips, ipe, jps, jpe, kps, kpe, &
968 grid%i_start(ij), grid%i_end(ij), &
969 grid%j_start(ij), grid%j_end(ij), &
970 k_start , k_end )
971 CALL set_physical_bc3d( grid%em_zx , 'w', config_flags, &
972 ids, ide, jds, jde, kds, kde, &
973 ims, ime, jms, jme, kms, kme, &
974 ips, ipe, jps, jpe, kps, kpe, &
975 grid%i_start(ij), grid%i_end(ij), &
976 grid%j_start(ij), grid%j_end(ij), &
977 k_start , k_end )
978 CALL set_physical_bc3d( grid%em_zy , 'w', config_flags, &
979 ids, ide, jds, jde, kds, kde, &
980 ims, ime, jms, jme, kms, kme, &
981 ips, ipe, jps, jpe, kps, kpe, &
982 grid%i_start(ij), grid%i_end(ij), &
983 grid%j_start(ij), grid%j_end(ij), &
984 k_start , k_end )
985
986 ENDDO
987 !$OMP END PARALLEL DO
988 BENCH_END(tke_diff_bc_tim)
989
990 #ifdef DM_PARALLEL
991 # include "HALO_EM_TKE_C.inc"
992 #endif
993
994 BENCH_START(deform_div_tim)
995
996 !$OMP PARALLEL DO &
997 !$OMP PRIVATE ( ij )
998
999 DO ij = 1 , grid%num_tiles
1000
1001 CALL wrf_debug ( 200 , ' call cal_deform_and_div' )
1002 CALL cal_deform_and_div ( config_flags,grid%em_u_2,grid%em_v_2,grid%em_w_2,grid%div, &
1003 grid%defor11,grid%defor22,grid%defor33,grid%defor12, &
1004 grid%defor13,grid%defor23, &
1005 grid%u_base, grid%v_base,grid%msfux,grid%msfuy,grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
1006 grid%rdx, grid%rdy, grid%em_dn, grid%em_dnw, grid%em_rdz, grid%em_rdzw, &
1007 grid%em_fnm,grid%em_fnp,grid%cf1,grid%cf2,grid%cf3,grid%em_zx,grid%em_zy, &
1008 ids, ide, jds, jde, kds, kde, &
1009 ims, ime, jms, jme, kms, kme, &
1010 grid%i_start(ij), grid%i_end(ij), &
1011 grid%j_start(ij), grid%j_end(ij), &
1012 k_start , k_end )
1013 ENDDO
1014 !$OMP END PARALLEL DO
1015 BENCH_END(deform_div_tim)
1016
1017
1018 #ifdef DM_PARALLEL
1019 # include "HALO_EM_TKE_D.inc"
1020 #endif
1021
1022
1023 ! calculate tke, kmh, and kmv
1024
1025 BENCH_START(calc_tke_tim)
1026 !$OMP PARALLEL DO &
1027 !$OMP PRIVATE ( ij )
1028
1029 DO ij = 1 , grid%num_tiles
1030
1031 CALL wrf_debug ( 200 , ' call calculate_km_kh' )
1032 CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp,config_flags%damp_opt, &
1033 grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2, &
1034 grid%khdif,grid%kvdif,grid%div, &
1035 grid%defor11,grid%defor22,grid%defor33,grid%defor12, &
1036 grid%defor13,grid%defor23, &
1037 grid%em_tke_2,p8w,t8w,th_phy, &
1038 t_phy,p_phy,moist,grid%em_dn,grid%em_dnw, &
1039 grid%dx,grid%dy,grid%em_rdz,grid%em_rdzw,config_flags%mix_cr_len,num_3d_m, &
1040 grid%cf1, grid%cf2, grid%cf3, grid%warm_rain, &
1041 grid%kh_tke_upper_bound, grid%kv_tke_upper_bound, &
1042 grid%msftx, grid%msfty, &
1043 ids,ide, jds,jde, kds,kde, &
1044 ims,ime, jms,jme, kms,kme, &
1045 grid%i_start(ij), grid%i_end(ij), &
1046 grid%j_start(ij), grid%j_end(ij), &
1047 k_start , k_end )
1048 ENDDO
1049 !$OMP END PARALLEL DO
1050 BENCH_END(calc_tke_tim)
1051
1052 #ifdef DM_PARALLEL
1053 # include "HALO_EM_TKE_E.inc"
1054 #endif
1055
1056 ENDIF
1057
1058 #ifdef DM_PARALLEL
1059 # include "PERIOD_BDY_EM_PHY_BC.inc"
1060 IF ( config_flags%grid_fdda .eq. 1) THEN
1061 # include "PERIOD_BDY_EM_FDDA_BC.inc"
1062 ENDIF
1063 # include "PERIOD_BDY_EM_CHEM.inc"
1064 #endif
1065
1066 BENCH_START(phy_bc_tim)
1067 !$OMP PARALLEL DO &
1068 !$OMP PRIVATE ( ij )
1069
1070 DO ij = 1 , grid%num_tiles
1071
1072 CALL wrf_debug ( 200 , ' call phy_bc' )
1073 CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33, &
1074 grid%defor12,grid%defor13,grid%defor23, &
1075 grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv, &
1076 grid%em_tke_2, &
1077 grid%rublten, grid%rvblten, &
1078 ids, ide, jds, jde, kds, kde, &
1079 ims, ime, jms, jme, kms, kme, &
1080 ips, ipe, jps, jpe, kps, kpe, &
1081 grid%i_start(ij), grid%i_end(ij), &
1082 grid%j_start(ij), grid%j_end(ij), &
1083 k_start , k_end )
1084 ENDDO
1085 !$OMP END PARALLEL DO
1086 BENCH_END(phy_bc_tim)
1087
1088 #ifdef DM_PARALLEL
1089 !-----------------------------------------------------------------------
1090 !
1091 ! MPP for some physics tendency, km, kh, deformation, and divergence
1092 !
1093 ! * *
1094 ! * + * * + * +
1095 ! * *
1096 !
1097 ! (for PBL)
1098 ! grid%rublten x
1099 ! grid%rvblten x
1100 !
1101 ! (for diff_opt >= 1)
1102 ! grid%defor11 x
1103 ! grid%defor22 x
1104 ! grid%defor12 x
1105 ! grid%defor13 x
1106 ! grid%defor23 x
1107 ! grid%div x
1108 ! grid%xkmv x
1109 ! grid%xkmh x
1110 ! grid%xkhv x
1111 ! grid%xkhh x
1112 ! tke x
1113 !
1114 !-----------------------------------------------------------------------
1115 IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN
1116 # include "HALO_EM_PHYS_PBL.inc"
1117 ENDIF
1118 IF ( config_flags%grid_fdda .eq. 1) THEN
1119 # include "HALO_EM_FDDA.inc"
1120 ENDIF
1121 IF ( config_flags%diff_opt .ge. 1 ) THEN
1122 # include "HALO_EM_PHYS_DIFFUSION.inc"
1123 ENDIF
1124
1125 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
1126 # include "HALO_EM_TKE_3.inc"
1127 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
1128 # include "HALO_EM_TKE_5.inc"
1129 ELSE
1130 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
1131 CALL wrf_error_fatal(TRIM(wrf_err_message))
1132 ENDIF
1133 #endif
1134
1135 BENCH_START(update_phy_ten_tim)
1136 !$OMP PARALLEL DO &
1137 !$OMP PRIVATE ( ij )
1138
1139 DO ij = 1 , grid%num_tiles
1140
1141 CALL wrf_debug ( 200 , ' call update_phy_ten' )
1142 CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend, &
1143 scalar_tend, mu_tendf, &
1144 grid%rthraten,grid%rthblten,grid%rthcuten,grid%rublten,grid%rvblten, &
1145 grid%rqvblten,grid%rqcblten,grid%rqiblten, &
1146 grid%rqvcuten,grid%rqccuten,grid%rqrcuten,grid%rqicuten,grid%rqscuten, &
1147 grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, &
1148 grid%RMUNDGDTEN, &
1149 num_3d_m,num_3d_s,config_flags,rk_step,grid%adv_moist_cond, &
1150 ids, ide, jds, jde, kds, kde, &
1151 ims, ime, jms, jme, kms, kme, &
1152 grid%i_start(ij), grid%i_end(ij), &
1153 grid%j_start(ij), grid%j_end(ij), &
1154 k_start, k_end )
1155
1156 END DO
1157 !$OMP END PARALLEL DO
1158 BENCH_END(update_phy_ten_tim)
1159
1160 #ifdef PLANET
1161 ! do rayleigh (and zonal-average newtonian) damping
1162
1163 ! We are doing this here because we are in an "IF" statement
1164 ! that determines whether we are in the first RK step or not,
1165 ! and we only want to do the top damping once per "timestep".
1166 ! This is after the physics tendencies have been calculated,
1167 ! but before the small time steps have been started, so it seems
1168 ! like a good place to add in the damping tendencies.
1169 ! Remember we are modifying the *tendencies*, not the actual
1170 ! values.
1171 ! u_2 is u on the u-points, *uncoupled*, i.e., it has units of m/s
1172 ! It will get coupled with mu in the small steps (small_step_prep?)
1173 ! If we want tendencies, we will have to be sure to couple them
1174 ! appropriately, with mu. From update_phy_ten above, RTHRATEN (e.g.)
1175 ! and t_tendf are now in the same units, and they are:
1176 ! (temperature tendency [K/s]) * (mut, surface mass)
1177 ! But for RU/VBLTEN, the units are:
1178 ! (momentum tendency (m/s^2) * (muu/v, surface mass)
1179 ! And it is important that these tendencies be tendf and not tend!
1180 ! The tend variables will be set to 0 in rk_tendency, and then the
1181 ! tendf variables will be added to tend variables in rk_addtend_dry
1182 ! The tendf's are "physics" tendencies ... see the subroutine
1183 ! rk_addtend_dry in module_em to see them put together.
1184 ! CALCULATE_PHY_TEND above takes the RUBLTEN, etc. and multiplies
1185 ! them by mu.
1186
1187 IF ( (config_flags%damp_opt == 101) .OR. &
1188 (config_flags%damp_opt == 103) ) THEN
1189 !$OMP PARALLEL DO &
1190 !$OMP PRIVATE ( ij )
1191 DO ij = 1 , grid%num_tiles
1192 CALL damptop( grid%em_u_2, grid%em_v_2, grid%em_t_2, &
1193 grid%em_mut, grid%em_muu, grid%em_muv, &
1194 pi_phy, &
1195 t_tendf, ru_tendf, rv_tendf, P2SI, &
1196 ids, ide, jds, jde, kds, kde, &
1197 ims, ime, jms, jme, kms, kme, &
1198 grid%i_start(ij), grid%i_end(ij), &
1199 grid%j_start(ij), grid%j_end(ij), &
1200 k_start, k_end )
1201 END DO
1202 !$OMP END PARALLEL DO
1203 END IF
1204 #endif
1205
1206 IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN
1207
1208 BENCH_START(tke_rhs_tim)
1209 !$OMP PARALLEL DO &
1210 !$OMP PRIVATE ( ij )
1211
1212 DO ij = 1 , grid%num_tiles
1213
1214 CALL tke_rhs ( tke_tend,grid%bn2, &
1215 config_flags,grid%defor11,grid%defor22,grid%defor33, &
1216 grid%defor12,grid%defor13,grid%defor23,grid%em_u_2,grid%em_v_2,grid%em_w_2,grid%div, &
1217 grid%em_tke_2,grid%em_mut, &
1218 th_phy,p_phy,p8w,t8w,grid%em_z,grid%em_fnm,grid%em_fnp, &
1219 grid%cf1,grid%cf2,grid%cf3,grid%msftx,grid%msfty,grid%xkmh,grid%xkmv,grid%xkhv,grid%rdx,grid%rdy, &
1220 grid%dx,grid%dy,grid%dt,grid%em_zx,grid%em_zy,grid%em_rdz,grid%em_rdzw,grid%em_dn, &
1221 grid%em_dnw,config_flags%mix_cr_len, &
1222 grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV),&
1223 grid%ust, rho, &
1224 ids, ide, jds, jde, kds, kde, &
1225 ims, ime, jms, jme, kms, kme, &
1226 grid%i_start(ij), grid%i_end(ij), &
1227 grid%j_start(ij), grid%j_end(ij), &
1228 k_start , k_end )
1229
1230 ENDDO
1231 !$OMP END PARALLEL DO
1232 BENCH_END(tke_rhs_tim)
1233
1234 ENDIF
1235
1236 ! calculate vertical diffusion first and then horizontal
1237 ! (keep this order)
1238
1239 IF(config_flags%diff_opt .eq. 2) THEN
1240
1241 #ifdef DM_PARALLEL
1242 # include "HALO_EM_TKE_DO2.inc"
1243 #endif
1244
1245
1246 IF (config_flags%bl_pbl_physics .eq. 0) THEN
1247
1248 BENCH_START(vert_diff_tim)
1249 !$OMP PARALLEL DO &
1250 !$OMP PRIVATE ( ij )
1251 DO ij = 1 , grid%num_tiles
1252
1253 CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' )
1254 CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, &
1255 t_tendf, tke_tend, &
1256 moist_tend, num_3d_m, &
1257 chem_tend, num_3d_c, &
1258 scalar_tend, num_3d_s, &
1259 grid%em_u_2, grid%em_v_2, &
1260 grid%em_t_2,grid%u_base,grid%v_base,grid%em_t_base,grid%qv_base, &
1261 grid%em_mut,grid%em_tke_2,config_flags, &
1262 grid%defor13,grid%defor23,grid%defor33, &
1263 grid%div, moist, chem, scalar, &
1264 grid%xkmv, grid%xkhv, config_flags%km_opt, &
1265 grid%em_fnm, grid%em_fnp, grid%em_dn, grid%em_dnw, grid%em_rdz, grid%em_rdzw, &
1266 grid%hfx, grid%qfx, grid%ust, rho, &
1267 ids, ide, jds, jde, kds, kde, &
1268 ims, ime, jms, jme, kms, kme, &
1269 grid%i_start(ij), grid%i_end(ij), &
1270 grid%j_start(ij), grid%j_end(ij), &
1271 k_start, k_end )
1272
1273 ENDDO
1274 !$OMP END PARALLEL DO
1275 BENCH_END(vert_diff_tim)
1276
1277 ENDIF
1278 !
1279 BENCH_START(hor_diff_tim)
1280 !$OMP PARALLEL DO &
1281 !$OMP PRIVATE ( ij )
1282 DO ij = 1 , grid%num_tiles
1283
1284 CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' )
1285 CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, &
1286 tke_tend, &
1287 moist_tend, num_3d_m, &
1288 chem_tend, num_3d_c, &
1289 scalar_tend, num_3d_s, &
1290 grid%em_t_2, th_phy, &
1291 grid%em_mut, grid%em_tke_2, config_flags, &
1292 grid%defor11, grid%defor22, grid%defor12, &
1293 grid%defor13, grid%defor23, grid%div, &
1294 moist, chem, scalar, &
1295 grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt, &
1296 grid%rdx, grid%rdy, grid%em_rdz, grid%em_rdzw, &
1297 grid%em_fnm, grid%em_fnp, grid%cf1, grid%cf2, grid%cf3, &
1298 grid%ht, grid%dx, grid%dy, grid%dt, grid%em_zx, grid%em_zy, grid%em_dn, grid%em_dnw, &
1299 ids, ide, jds, jde, kds, kde, &
1300 ims, ime, jms, jme, kms, kme, &
1301 grid%i_start(ij), grid%i_end(ij), &
1302 grid%j_start(ij), grid%j_end(ij), &
1303 k_start , k_end )
1304 ENDDO
1305 !$OMP END PARALLEL DO
1306 BENCH_END(hor_diff_tim)
1307
1308 ENDIF
1309
1310 # ifdef DM_PARALLEL
1311 # include "HALO_OBS_NUDGE.inc"
1312 #endif
1313 !***********************************************************************
1314 ! This section for obs nudging
1315 !$OMP PARALLEL DO &
1316 !$OMP PRIVATE ( ij )
1317
1318 DO ij = 1 , grid%num_tiles
1319
1320 CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, &
1321 model_config_rec%parent_id, config_flags%restart, &
1322 grid%obs_nudge_opt, &
1323 grid%obs_ipf_errob, &
1324 grid%obs_ipf_nudob, &
1325 grid%fdda_start, &
1326 grid%fdda_end, &
1327 grid%obs_nudge_wind, &
1328 grid%obs_nudge_temp, &
1329 grid%obs_nudge_mois, &
1330 grid%obs_nudge_pstr, &
1331 grid%obs_coef_wind, &
1332 grid%obs_coef_temp, &
1333 grid%obs_coef_mois, &
1334 grid%obs_coef_pstr, &
1335 grid%obs_rinxy, &
1336 grid%obs_rinsig, &
1337 grid%obs_twindo, &
1338 grid%obs_npfi, &
1339 grid%obs_ionf, &
1340 grid%obs_idynin, &
1341 grid%obs_dtramp, &
1342 model_config_rec%cen_lat(1), &
1343 model_config_rec%cen_lon(1), &
1344 config_flags%truelat1, &
1345 config_flags%truelat2, &
1346 config_flags%map_proj, &
1347 model_config_rec%i_parent_start, &
1348 model_config_rec%j_parent_start, &
1349 grid%parent_grid_ratio, &
1350 grid%max_dom, grid%itimestep, &
1351 grid%dt, grid%gmt, grid%julday, grid%fdob, &
1352 grid%max_obs, &
1353 model_config_rec%nobs_ndg_vars, &
1354 model_config_rec%nobs_err_flds, &
1355 grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, &
1356 grid%dx, grid%KPBL,grid%HT, &
1357 grid%em_mut, grid%em_muu, grid%em_muv, &
1358 grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, &
1359 p_phy, t_tendf, t0, &
1360 grid%em_u_2, grid%em_v_2, grid%em_t_2, &
1361 moist(:,:,:,P_QV), &
1362 grid%em_pb, grid%p_top, grid%em_p, &
1363 grid%uratx, grid%vratx, grid%tratx, &
1364 ru_tendf, rv_tendf, &
1365 moist_tend(:,:,:,P_QV), grid%em_obs_savwt, &
1366 ids,ide, jds,jde, kds,kde, &
1367 ims,ime, jms,jme, kms,kme, &
1368 grid%i_start(ij), min(grid%i_end(ij),ide-1), &
1369 grid%j_start(ij), min(grid%j_end(ij),jde-1), &
1370 k_start , min(k_end,kde-1) )
1371
1372 ENDDO
1373
1374 !$OMP END PARALLEL DO
1375 !
1376 !***********************************************************************
1377
1378 END IF rk_step_is_one
1379
1380 BENCH_START(rk_tend_tim)
1381 !$OMP PARALLEL DO &
1382 !$OMP PRIVATE ( ij )
1383 DO ij = 1 , grid%num_tiles
1384
1385 CALL wrf_debug ( 200 , ' call rk_tendency' )
1386 CALL rk_tendency ( config_flags, rk_step, &
1387 grid%em_ru_tend, grid%em_rv_tend, rw_tend, ph_tend, t_tend, &
1388 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
1389 mu_tend, grid%em_u_save, grid%em_v_save, w_save, ph_save, &
1390 grid%em_t_save, mu_save, grid%rthften, &
1391 grid%em_ru, grid%em_rv, grid%em_rw, grid%em_ww, &
1392 grid%em_u_2, grid%em_v_2, grid%em_w_2, grid%em_t_2, grid%em_ph_2, &
1393 grid%em_u_1, grid%em_v_1, grid%em_w_1, grid%em_t_1, grid%em_ph_1, &
1394 grid%h_diabatic, grid%em_phb, grid%em_t_init, &
1395 grid%em_mu_2, grid%em_mut, grid%em_muu, grid%em_muv, grid%em_mub, &
1396 grid%em_al, grid%em_alt, grid%em_p, grid%em_pb, grid%em_php, cqu, cqv, cqw, &
1397 grid%u_base, grid%v_base, grid%em_t_base, grid%qv_base, grid%z_base, &
1398 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1399 grid%msfvy, grid%msftx,grid%msfty, grid%xlat, grid%f, grid%e, grid%sina, grid%cosa, &
1400 grid%em_fnm, grid%em_fnp, grid%em_rdn, grid%em_rdnw, &
1401 grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh, &
1402 grid%diff_6th_opt, grid%diff_6th_factor, &
1403 grid%dampcoef,grid%zdamp,config_flags%damp_opt, &
1404 grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m, &
1405 config_flags%non_hydrostatic, &
1406 grid%u_frame, grid%v_frame, &
1407 ids, ide, jds, jde, kds, kde, &
1408 ims, ime, jms, jme, kms, kme, &
1409 grid%i_start(ij), grid%i_end(ij), &
1410 grid%j_start(ij), grid%j_end(ij), &
1411 k_start, k_end )
1412 END DO
1413 !$OMP END PARALLEL DO
1414 BENCH_END(rk_tend_tim)
1415
1416 BENCH_START(relax_bdy_dry_tim)
1417 !$OMP PARALLEL DO &
1418 !$OMP PRIVATE ( ij )
1419 DO ij = 1 , grid%num_tiles
1420
1421 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
1422
1423 CALL relax_bdy_dry ( config_flags, &
1424 grid%em_u_save, grid%em_v_save, ph_save, grid%em_t_save, &
1425 w_save, mu_tend, &
1426 grid%em_ru, grid%em_rv, grid%em_ph_2, grid%em_t_2, &
1427 grid%em_w_2, grid%em_mu_2, grid%em_mut, &
1428 grid%em_u_bxs,grid%em_u_bxe,grid%em_u_bys,grid%em_u_bye, &
1429 grid%em_v_bxs,grid%em_v_bxe,grid%em_v_bys,grid%em_v_bye, &
1430 grid%em_ph_bxs,grid%em_ph_bxe,grid%em_ph_bys,grid%em_ph_bye, &
1431 grid%em_t_bxs,grid%em_t_bxe,grid%em_t_bys,grid%em_t_bye, &
1432 grid%em_w_bxs,grid%em_w_bxe,grid%em_w_bys,grid%em_w_bye, &
1433 grid%em_mu_bxs,grid%em_mu_bxe,grid%em_mu_bys,grid%em_mu_bye, &
1434 grid%em_u_btxs,grid%em_u_btxe,grid%em_u_btys,grid%em_u_btye, &
1435 grid%em_v_btxs,grid%em_v_btxe,grid%em_v_btys,grid%em_v_btye, &
1436 grid%em_ph_btxs,grid%em_ph_btxe,grid%em_ph_btys,grid%em_ph_btye, &
1437 grid%em_t_btxs,grid%em_t_btxe,grid%em_t_btys,grid%em_t_btye, &
1438 grid%em_w_btxs,grid%em_w_btxe,grid%em_w_btys,grid%em_w_btye, &
1439 grid%em_mu_btxs,grid%em_mu_btxe,grid%em_mu_btys,grid%em_mu_btye, &
1440 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
1441 grid%dtbc, grid%fcx, grid%gcx, &
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
1450 ENDIF
1451
1452 CALL rk_addtend_dry( grid%em_ru_tend, grid%em_rv_tend, rw_tend, ph_tend, t_tend, &
1453 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
1454 grid%em_u_save, grid%em_v_save, w_save, ph_save, grid%em_t_save, &
1455 mu_tend, mu_tendf, rk_step, &
1456 grid%h_diabatic, grid%em_mut, grid%msftx, &
1457 grid%msfty, grid%msfux,grid%msfuy, &
1458 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
1459 ids,ide, jds,jde, kds,kde, &
1460 ims,ime, jms,jme, kms,kme, &
1461 ips,ipe, jps,jpe, kps,kpe, &
1462 grid%i_start(ij), grid%i_end(ij), &
1463 grid%j_start(ij), grid%j_end(ij), &
1464 k_start, k_end )
1465
1466 IF( config_flags%specified .or. config_flags%nested ) THEN
1467 CALL spec_bdy_dry ( config_flags, &
1468 grid%em_ru_tend, grid%em_rv_tend, ph_tend, t_tend, &
1469 rw_tend, mu_tend, &
1470 grid%em_u_bxs,grid%em_u_bxe,grid%em_u_bys,grid%em_u_bye, &
1471 grid%em_v_bxs,grid%em_v_bxe,grid%em_v_bys,grid%em_v_bye, &
1472 grid%em_ph_bxs,grid%em_ph_bxe,grid%em_ph_bys,grid%em_ph_bye, &
1473 grid%em_t_bxs,grid%em_t_bxe,grid%em_t_bys,grid%em_t_bye, &
1474 grid%em_w_bxs,grid%em_w_bxe,grid%em_w_bys,grid%em_w_bye, &
1475 grid%em_mu_bxs,grid%em_mu_bxe,grid%em_mu_bys,grid%em_mu_bye, &
1476 grid%em_u_btxs,grid%em_u_btxe,grid%em_u_btys,grid%em_u_btye, &
1477 grid%em_v_btxs,grid%em_v_btxe,grid%em_v_btys,grid%em_v_btye, &
1478 grid%em_ph_btxs,grid%em_ph_btxe,grid%em_ph_btys,grid%em_ph_btye, &
1479 grid%em_t_btxs,grid%em_t_btxe,grid%em_t_btys,grid%em_t_btye, &
1480 grid%em_w_btxs,grid%em_w_btxe,grid%em_w_btys,grid%em_w_btye, &
1481 grid%em_mu_btxs,grid%em_mu_btxe,grid%em_mu_btys,grid%em_mu_btye, &
1482 config_flags%spec_bdy_width, grid%spec_zone, &
1483 ids,ide, jds,jde, kds,kde, & ! domain dims
1484 ims,ime, jms,jme, kms,kme, & ! memory dims
1485 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1486 grid%i_start(ij), grid%i_end(ij), &
1487 grid%j_start(ij), grid%j_end(ij), &
1488 k_start, k_end )
1489
1490 ENDIF
1491
1492 END DO
1493 !$OMP END PARALLEL DO
1494 BENCH_END(relax_bdy_dry_tim)
1495
1496 !<DESCRIPTION>
1497 !<pre>
1498 ! (3) Small (acoustic,sound) steps.
1499 !
1500 ! Several acoustic steps are taken each RK pass. A small step
1501 ! sequence begins with calculating perturbation variables
1502 ! and coupling them to the column dry-air-mass mu
1503 ! (call to small_step_prep). This is followed by computing
1504 ! coefficients for the vertically implicit part of the
1505 ! small timestep (call to calc_coef_w).
1506 !
1507 ! The small steps are taken
1508 ! in the named loop "small_steps:". In the small_steps loop, first
1509 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
1510 ! next mu and theta are advanced (call to advance_mu_t) followed by
1511 ! advancing w and the geopotential (call to advance_w). Diagnostic
1512 ! values for pressure and inverse density are updated at the end of
1513 ! each small_step.
1514 !
1515 ! The small-step section ends with the change of the perturbation variables
1516 ! back to full variables (call to small_step_finish).
1517 !</pre>
1518 !</DESCRIPTION>
1519
1520 BENCH_START(small_step_prep_tim)
1521 !$OMP PARALLEL DO &
1522 !$OMP PRIVATE ( ij )
1523
1524 DO ij = 1 , grid%num_tiles
1525
1526 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
1527 ! integration. We only need calculate these for the first pass through -
1528 ! the predictor step. They are reused as is for the corrector step.
1529 ! For third-order RK, we need to recompute these after the first
1530 ! predictor because we may have changed the small timestep -> grid%dts.
1531
1532 CALL wrf_debug ( 200 , ' call small_step_prep ' )
1533
1534 CALL small_step_prep( grid%em_u_1,grid%em_u_2,grid%em_v_1,grid%em_v_2,grid%em_w_1,grid%em_w_2, &
1535 grid%em_t_1,grid%em_t_2,grid%em_ph_1,grid%em_ph_2, &
1536 grid%em_mub, grid%em_mu_1, grid%em_mu_2, &
1537 grid%em_muu, muus, grid%em_muv, muvs, &
1538 grid%em_mut, grid%em_muts, grid%em_mudf, &
1539 grid%em_u_save, grid%em_v_save, w_save, &
1540 grid%em_t_save, ph_save, mu_save, &
1541 grid%em_ww, ww1, grid%em_h_div, &
1542 grid%em_dnw, c2a, grid%em_pb, grid%em_p, grid%em_alt, &
1543 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1544 grid%msfvy, grid%msftx,grid%msfty, &
1545 grid%rdx, grid%rdy, rk_step, &
1546 ids, ide, jds, jde, kds, kde, &
1547 ims, ime, jms, jme, kms, kme, &
1548 grid%i_start(ij), grid%i_end(ij), &
1549 grid%j_start(ij), grid%j_end(ij), &
1550 k_start , k_end )
1551
1552 CALL calc_p_rho( grid%em_al, grid%em_p, grid%em_ph_2, &
1553 grid%em_alt, grid%em_t_2, grid%em_t_save, c2a, pm1, &
1554 grid%em_mu_2, grid%em_muts, grid%em_znu, t0, &
1555 grid%em_rdnw, grid%em_dnw, grid%smdiv, &
1556 config_flags%non_hydrostatic, 0, &
1557 ids, ide, jds, jde, kds, kde, &
1558 ims, ime, jms, jme, kms, kme, &
1559 grid%i_start(ij), grid%i_end(ij), &
1560 grid%j_start(ij), grid%j_end(ij), &
1561 k_start , k_end )
1562
1563 IF (config_flags%non_hydrostatic) THEN
1564 CALL calc_coef_w( a,alpha,gamma, &
1565 grid%em_mut, cqw, &
1566 grid%em_rdn, grid%em_rdnw, c2a, &
1567 dts_rk, g, grid%epssm, &
1568 ids, ide, jds, jde, kds, kde, &
1569 ims, ime, jms, jme, kms, kme, &
1570 grid%i_start(ij), grid%i_end(ij), &
1571 grid%j_start(ij), grid%j_end(ij), &
1572 k_start , k_end )
1573 END IF
1574
1575 ENDDO
1576 !$OMP END PARALLEL DO
1577 BENCH_END(small_step_prep_tim)
1578
1579
1580 #ifdef DM_PARALLEL
1581 !-----------------------------------------------------------------------
1582 ! Stencils for patch communications (WCS, 29 June 2001)
1583 ! Note: the small size of this halo exchange reflects the
1584 ! fact that we are carrying the uncoupled variables
1585 ! as state variables in the mass coordinate model, as
1586 ! opposed to the coupled variables as in the height
1587 ! coordinate model.
1588 !
1589 ! * * * * *
1590 ! * * * * * * * * *
1591 ! * + * * + * * * + * *
1592 ! * * * * * * * * *
1593 ! * * * * *
1594 !
1595 ! 3D variables - note staggering! grid%em_ph_2(grid%em_z), grid%em_u_save(X), grid%em_v_save(Y)
1596 !
1597 !j grid%em_ph_2 x
1598 !j grid%em_al x
1599 !j grid%em_p x
1600 !j grid%em_t_1 x
1601 !j grid%em_t_save x
1602 !j grid%em_u_save x
1603 !j grid%em_v_save x
1604 !
1605 ! the following are 2D (xy) variables
1606 !
1607 !j grid%em_mu_1 x
1608 !j grid%em_mu_2 x
1609 !j grid%em_mudf x
1610 !--------------------------------------------------------------
1611 # include "HALO_EM_B.inc"
1612 # include "PERIOD_BDY_EM_B.inc"
1613 #endif
1614
1615 BENCH_START(set_phys_bc2_tim)
1616 !$OMP PARALLEL DO &
1617 !$OMP PRIVATE ( ij )
1618
1619 DO ij = 1 , grid%num_tiles
1620
1621 CALL set_physical_bc3d( grid%em_ru_tend, 'u', config_flags, &
1622 ids, ide, jds, jde, kds, kde, &
1623 ims, ime, jms, jme, kms, kme, &
1624 ips, ipe, jps, jpe, kps, kpe, &
1625 grid%i_start(ij), grid%i_end(ij), &
1626 grid%j_start(ij), grid%j_end(ij), &
1627 k_start , k_end )
1628
1629 CALL set_physical_bc3d( grid%em_rv_tend, 'v', config_flags, &
1630 ids, ide, jds, jde, kds, kde, &
1631 ims, ime, jms, jme, kms, kme, &
1632 ips, ipe, jps, jpe, kps, kpe, &
1633 grid%i_start(ij), grid%i_end(ij), &
1634 grid%j_start(ij), grid%j_end(ij), &
1635 k_start , k_end )
1636
1637 CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags, &
1638 ids, ide, jds, jde, kds, kde, &
1639 ims, ime, jms, jme, kms, kme, &
1640 ips, ipe, jps, jpe, kps, kpe, &
1641 grid%i_start(ij), grid%i_end(ij), &
1642 grid%j_start(ij), grid%j_end(ij), &
1643 k_start , k_end )
1644
1645 CALL set_physical_bc3d( grid%em_al, 'p', config_flags, &
1646 ids, ide, jds, jde, kds, kde, &
1647 ims, ime, jms, jme, kms, kme, &
1648 ips, ipe, jps, jpe, kps, kpe, &
1649 grid%i_start(ij), grid%i_end(ij), &
1650 grid%j_start(ij), grid%j_end(ij), &
1651 k_start , k_end )
1652
1653 CALL set_physical_bc3d( grid%em_p, 'p', config_flags, &
1654 ids, ide, jds, jde, kds, kde, &
1655 ims, ime, jms, jme, kms, kme, &
1656 ips, ipe, jps, jpe, kps, kpe, &
1657 grid%i_start(ij), grid%i_end(ij), &
1658 grid%j_start(ij), grid%j_end(ij), &
1659 k_start , k_end )
1660
1661 CALL set_physical_bc3d( grid%em_t_1, 'p', config_flags, &
1662 ids, ide, jds, jde, kds, kde, &
1663 ims, ime, jms, jme, kms, kme, &
1664 ips, ipe, jps, jpe, kps, kpe, &
1665 grid%i_start(ij), grid%i_end(ij), &
1666 grid%j_start(ij), grid%j_end(ij), &
1667 k_start , k_end )
1668
1669 CALL set_physical_bc3d( grid%em_t_save, 't', config_flags, &
1670 ids, ide, jds, jde, kds, kde, &
1671 ims, ime, jms, jme, kms, kme, &
1672 ips, ipe, jps, jpe, kps, kpe, &
1673 grid%i_start(ij), grid%i_end(ij), &
1674 grid%j_start(ij), grid%j_end(ij), &
1675 k_start , k_end )
1676
1677 CALL set_physical_bc3d( grid%em_h_div, 'p', config_flags, &
1678 ids, ide, jds, jde, kds, kde, &
1679 ims, ime, jms, jme, kms, kme, &
1680 ips, ipe, jps, jpe, kps, kpe, &
1681 grid%i_start(ij), grid%i_end(ij), &
1682 grid%j_start(ij), grid%j_end(ij), &
1683 k_start , k_end )
1684
1685 CALL set_physical_bc2d( grid%em_mu_1, 't', config_flags, &
1686 ids, ide, jds, jde, &
1687 ims, ime, jms, jme, &
1688 ips, ipe, jps, jpe, &
1689 grid%i_start(ij), grid%i_end(ij), &
1690 grid%j_start(ij), grid%j_end(ij) )
1691
1692 CALL set_physical_bc2d( grid%em_mu_2, 't', config_flags, &
1693 ids, ide, jds, jde, &
1694 ims, ime, jms, jme, &
1695 ips, ipe, jps, jpe, &
1696 grid%i_start(ij), grid%i_end(ij), &
1697 grid%j_start(ij), grid%j_end(ij) )
1698
1699 CALL set_physical_bc2d( grid%em_mudf, 't', config_flags, &
1700 ids, ide, jds, jde, &
1701 ims, ime, jms, jme, &
1702 ips, ipe, jps, jpe, &
1703 grid%i_start(ij), grid%i_end(ij), &
1704 grid%j_start(ij), grid%j_end(ij) )
1705
1706 END DO
1707 !$OMP END PARALLEL DO
1708 BENCH_END(set_phys_bc2_tim)
1709 small_steps : DO iteration = 1 , number_of_small_timesteps
1710
1711 ! Boundary condition time (or communication time).
1712
1713 #ifdef DM_PARALLEL
1714 # include "PERIOD_BDY_EM_B.inc"
1715 #endif
1716
1717 !$OMP PARALLEL DO &
1718 !$OMP PRIVATE ( ij )
1719
1720 DO ij = 1 , grid%num_tiles
1721
1722 BENCH_START(advance_uv_tim)
1723 CALL advance_uv ( grid%em_u_2, grid%em_ru_tend, grid%em_v_2, grid%em_rv_tend, &
1724 grid%em_p, grid%em_pb, &
1725 grid%em_ph_2, grid%em_php, grid%em_alt, grid%em_al, &
1726 grid%em_h_div, grid%em_mu_2, &
1727 grid%em_muu, cqu, grid%em_muv, cqv, grid%em_mudf, &
1728 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, grid%msfvy, &
1729 grid%rdx, grid%rdy, dts_rk, &
1730 grid%cf1, grid%cf2, grid%cf3, grid%em_fnm, grid%em_fnp, &
1731 grid%emdiv, grid%hmdiv, &
1732 grid%em_rdnw, config_flags,grid%spec_zone, &
1733 config_flags%non_hydrostatic, &
1734 ids, ide, jds, jde, kds, kde, &
1735 ims, ime, jms, jme, kms, kme, &
1736 grid%i_start(ij), grid%i_end(ij), &
1737 grid%j_start(ij), grid%j_end(ij), &
1738 k_start , k_end )
1739 BENCH_END(advance_uv_tim)
1740
1741 END DO
1742 !$OMP END PARALLEL DO
1743
1744 !-----------------------------------------------------------
1745 ! acoustic integration polar filter for smallstep u, v
1746 !-----------------------------------------------------------
1747
1748 IF (config_flags%polar) THEN
1749
1750 CALL pxft ( grid=grid &
1751 ,lineno=__LINE__ &
1752 ,flag_uv = 1 &
1753 ,flag_rurv = 0 &
1754 ,flag_wph = 0 &
1755 ,flag_ww = 0 &
1756 ,flag_t = 0 &
1757 ,flag_mu = 0 &
1758 ,flag_mut = 0 &
1759 ,flag_moist = 0 &
1760 ,flag_chem = 0 &
1761 ,flag_scalar = 0 &
1762 ,positive_definite = .FALSE. &
1763 ,moist=moist,chem=chem,scalar=scalar &
1764 ,fft_filter_type = config_flags%fft_filter_type &
1765 ,dclat = dclat &
1766 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1767 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1768 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1769 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1770 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1771
1772 END IF
1773
1774 !-----------------------------------------------------------
1775 ! end acoustic integration polar filter for smallstep u, v
1776 !-----------------------------------------------------------
1777
1778 !$OMP PARALLEL DO &
1779 !$OMP PRIVATE ( ij )
1780
1781 DO ij = 1 , grid%num_tiles
1782
1783 BENCH_START(spec_bdy_uv_tim)
1784 IF( config_flags%specified .or. config_flags%nested ) THEN
1785 CALL spec_bdyupdate(grid%em_u_2, grid%em_ru_tend, dts_rk, &
1786 'u' , config_flags, &
1787 grid%spec_zone, &
1788 ids,ide, jds,jde, kds,kde, & ! domain dims
1789 ims,ime, jms,jme, kms,kme, & ! memory dims
1790 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1791 grid%i_start(ij), grid%i_end(ij), &
1792 grid%j_start(ij), grid%j_end(ij), &
1793 k_start , k_end )
1794
1795 CALL spec_bdyupdate(grid%em_v_2, grid%em_rv_tend, dts_rk, &
1796 'v' , config_flags, &
1797 grid%spec_zone, &
1798 ids,ide, jds,jde, kds,kde, & ! domain dims
1799 ims,ime, jms,jme, kms,kme, & ! memory dims
1800 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1801 grid%i_start(ij), grid%i_end(ij), &
1802 grid%j_start(ij), grid%j_end(ij), &
1803 k_start , k_end )
1804
1805 ENDIF
1806 BENCH_END(spec_bdy_uv_tim)
1807
1808 END DO
1809 !$OMP END PARALLEL DO
1810
1811 #ifdef DM_PARALLEL
1812 !
1813 ! Stencils for patch communications (WCS, 29 June 2001)
1814 !
1815 ! * *
1816 ! * + * * + * +
1817 ! * *
1818 !
1819 ! grid%em_u_2 x
1820 ! grid%em_v_2 x
1821 !
1822 # include "HALO_EM_C.inc"
1823 #endif
1824
1825 !$OMP PARALLEL DO &
1826 !$OMP PRIVATE ( ij )
1827
1828 DO ij = 1 , grid%num_tiles
1829
1830 ! advance the mass in the column, theta, and calculate ww
1831
1832 BENCH_START(advance_mu_t_tim)
1833 CALL advance_mu_t( grid%em_ww, ww1, grid%em_u_2, grid%em_u_save, grid%em_v_2, grid%em_v_save, &
1834 grid%em_mu_2, grid%em_mut, muave, grid%em_muts, grid%em_muu, grid%em_muv, &
1835 grid%em_mudf, grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, &
1836 grid%em_t_2, grid%em_t_save, t_2save, t_tend, &
1837 grid%em_h_div, mu_tend, &
1838 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1839 grid%em_dnw, grid%em_fnm, grid%em_fnp, grid%em_rdnw, &
1840 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1841 grid%msfvy, grid%msftx,grid%msfty, &
1842 iteration, config_flags, &
1843 ids, ide, jds, jde, kds, kde, &
1844 ims, ime, jms, jme, kms, kme, &
1845 grid%i_start(ij), grid%i_end(ij), &
1846 grid%j_start(ij), grid%j_end(ij), &
1847 k_start , k_end )
1848 BENCH_END(advance_mu_t_tim)
1849
1850 ENDDO
1851 !$OMP END PARALLEL DO
1852
1853 !-----------------------------------------------------------
1854 ! acoustic integration polar filter for smallstep mu, t
1855 !-----------------------------------------------------------
1856
1857 IF ( (config_flags%polar) ) THEN
1858
1859 CALL pxft ( grid=grid &
1860 ,lineno=__LINE__ &
1861 ,flag_uv = 0 &
1862 ,flag_rurv = 0 &
1863 ,flag_wph = 0 &
1864 ,flag_ww = 0 &
1865 ,flag_t = 1 &
1866 ,flag_mu = 1 &
1867 ,flag_mut = 0 &
1868 ,flag_moist = 0 &
1869 ,flag_chem = 0 &
1870 ,flag_scalar = 0 &
1871 ,positive_definite = .FALSE. &
1872 ,moist=moist,chem=chem,scalar=scalar &
1873 ,fft_filter_type = config_flags%fft_filter_type &
1874 ,dclat = dclat &
1875 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1876 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1877 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1878 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1879 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1880
1881 grid%em_muts = grid%em_mut + grid%em_mu_2 ! reset muts using filtered mu_2
1882
1883 END IF
1884
1885 !-----------------------------------------------------------
1886 ! end acoustic integration polar filter for smallstep mu, t
1887 !-----------------------------------------------------------
1888
1889 BENCH_START(spec_bdy_t_tim)
1890
1891 !$OMP PARALLEL DO &
1892 !$OMP PRIVATE ( ij )
1893
1894 DO ij = 1 , grid%num_tiles
1895
1896 IF( config_flags%specified .or. config_flags%nested ) THEN
1897
1898 CALL spec_bdyupdate(grid%em_t_2, t_tend, dts_rk, &
1899 't' , config_flags, &
1900 grid%spec_zone, &
1901 ids,ide, jds,jde, kds,kde, & ! domain dims
1902 ims,ime, jms,jme, kms,kme, & ! memory dims
1903 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1904 grid%i_start(ij), grid%i_end(ij), &
1905 grid%j_start(ij), grid%j_end(ij), &
1906 k_start , k_end )
1907
1908 CALL spec_bdyupdate(grid%em_mu_2, mu_tend, dts_rk, &
1909 'm' , config_flags, &
1910 grid%spec_zone, &
1911 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1912 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1913 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1914 grid%i_start(ij), grid%i_end(ij), &
1915 grid%j_start(ij), grid%j_end(ij), &
1916 1 , 1 )
1917
1918 CALL spec_bdyupdate(grid%em_muts, mu_tend, dts_rk, &
1919 'm' , config_flags, &
1920 grid%spec_zone, &
1921 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1922 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1923 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1924 grid%i_start(ij), grid%i_end(ij), &
1925 grid%j_start(ij), grid%j_end(ij), &
1926 1 , 1 )
1927 ENDIF
1928 BENCH_END(spec_bdy_t_tim)
1929
1930 ! small (acoustic) step for the vertical momentum,
1931 ! density and coupled potential temperature.
1932
1933
1934 BENCH_START(advance_w_tim)
1935 IF ( config_flags%non_hydrostatic ) THEN
1936 CALL advance_w( grid%em_w_2, rw_tend, grid%em_ww, w_save, grid%em_u_2, grid%em_v_2, &
1937 grid%em_mu_2, grid%em_mut, muave, grid%em_muts, &
1938 t_2save, grid%em_t_2, grid%em_t_save, &
1939 grid%em_ph_2, ph_save, grid%em_phb, ph_tend, &
1940 grid%ht, c2a, cqw, grid%em_alt, grid%em_alb, &
1941 a, alpha, gamma, &
1942 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1943 grid%em_dnw, grid%em_fnm, grid%em_fnp, grid%em_rdnw, grid%em_rdn, &
1944 grid%cf1, grid%cf2, grid%cf3, grid%msftx, grid%msfty, &
1945 config_flags, &
1946 ids,ide, jds,jde, kds,kde, & ! domain dims
1947 ims,ime, jms,jme, kms,kme, & ! memory dims
1948 grid%i_start(ij), grid%i_end(ij), &
1949 grid%j_start(ij), grid%j_end(ij), &
1950 k_start , k_end )
1951 ENDIF
1952 BENCH_END(advance_w_tim)
1953
1954
1955 ENDDO
1956 !$OMP END PARALLEL DO
1957
1958 !-----------------------------------------------------------
1959 ! acoustic integration polar filter for smallstep w, geopotential
1960 !-----------------------------------------------------------
1961
1962 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1963
1964 CALL pxft ( grid=grid &
1965 ,lineno=__LINE__ &
1966 ,flag_uv = 0 &
1967 ,flag_rurv = 0 &
1968 ,flag_wph = 1 &
1969 ,flag_ww = 0 &
1970 ,flag_t = 0 &
1971 ,flag_mu = 0 &
1972 ,flag_mut = 0 &
1973 ,flag_moist = 0 &
1974 ,flag_chem = 0 &
1975 ,flag_scalar = 0 &
1976 ,positive_definite = .FALSE. &
1977 ,moist=moist,chem=chem,scalar=scalar &
1978 ,fft_filter_type = config_flags%fft_filter_type &
1979 ,dclat = dclat &
1980 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1981 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1982 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1983 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1984 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1985
1986 END IF
1987
1988 !-----------------------------------------------------------
1989 ! end acoustic integration polar filter for smallstep w, geopotential
1990 !-----------------------------------------------------------
1991
1992 !$OMP PARALLEL DO &
1993 !$OMP PRIVATE ( ij )
1994
1995 DO ij = 1 , grid%num_tiles
1996
1997 BENCH_START(sumflux_tim)
1998 CALL sumflux ( grid%em_u_2, grid%em_v_2, grid%em_ww, &
1999 grid%em_u_save, grid%em_v_save, ww1, &
2000 grid%em_muu, grid%em_muv, &
2001 grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, grid%epssm, &
2002 grid%msfux, grid% msfuy, grid%msfvx, &
2003 grid%msfvx_inv, grid%msfvy, &
2004 iteration, number_of_small_timesteps, &
2005 ids, ide, jds, jde, kds, kde, &
2006 ims, ime, jms, jme, kms, kme, &
2007 grid%i_start(ij), grid%i_end(ij), &
2008 grid%j_start(ij), grid%j_end(ij), &
2009 k_start , k_end )
2010 BENCH_END(sumflux_tim)
2011
2012 IF( config_flags%specified .or. config_flags%nested ) THEN
2013
2014 BENCH_START(spec_bdynhyd_tim)
2015 IF (config_flags%non_hydrostatic) THEN
2016 CALL spec_bdyupdate_ph( ph_save, grid%em_ph_2, ph_tend, mu_tend, grid%em_muts, dts_rk, &
2017 'h' , config_flags, &
2018 grid%spec_zone, &
2019 ids,ide, jds,jde, kds,kde, & ! domain dims
2020 ims,ime, jms,jme, kms,kme, & ! memory dims
2021 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2022 grid%i_start(ij), grid%i_end(ij), &
2023 grid%j_start(ij), grid%j_end(ij), &
2024 k_start , k_end )
2025 IF( config_flags%specified ) THEN
2026 CALL zero_grad_bdy ( grid%em_w_2, &
2027 'w' , config_flags, &
2028 grid%spec_zone, &
2029 ids,ide, jds,jde, kds,kde, & ! domain dims
2030 ims,ime, jms,jme, kms,kme, & ! memory dims
2031 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2032 grid%i_start(ij), grid%i_end(ij), &
2033 grid%j_start(ij), grid%j_end(ij), &
2034 k_start , k_end )
2035 ELSE
2036 CALL spec_bdyupdate ( grid%em_w_2, rw_tend, dts_rk, &
2037 'h' , config_flags, &
2038 grid%spec_zone, &
2039 ids,ide, jds,jde, kds,kde, & ! domain dims
2040 ims,ime, jms,jme, kms,kme, & ! memory dims
2041 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2042 grid%i_start(ij), grid%i_end(ij), &
2043 grid%j_start(ij), grid%j_end(ij), &
2044 k_start , k_end )
2045 ENDIF
2046 ENDIF
2047 BENCH_END(spec_bdynhyd_tim)
2048 ENDIF
2049
2050 BENCH_START(cald_p_rho_tim)
2051 CALL calc_p_rho( grid%em_al, grid%em_p, grid%em_ph_2, &
2052 grid%em_alt, grid%em_t_2, grid%em_t_save, c2a, pm1, &
2053 grid%em_mu_2, grid%em_muts, grid%em_znu, t0, &
2054 grid%em_rdnw, grid%em_dnw, grid%smdiv, &
2055 config_flags%non_hydrostatic, iteration, &
2056 ids, ide, jds, jde, kds, kde, &
2057 ims, ime, jms, jme, kms, kme, &
2058 grid%i_start(ij), grid%i_end(ij), &
2059 grid%j_start(ij), grid%j_end(ij), &
2060 k_start , k_end )
2061 BENCH_END(cald_p_rho_tim)
2062
2063 ENDDO
2064 !$OMP END PARALLEL DO
2065
2066 #ifdef DM_PARALLEL
2067 !
2068 ! Stencils for patch communications (WCS, 29 June 2001)
2069 !
2070 ! * *
2071 ! * + * * + * +
2072 ! * *
2073 !
2074 ! grid%em_ph_2 x
2075 ! grid%em_al x
2076 ! grid%em_p x
2077 !
2078 ! 2D variables (x,y)
2079 !
2080 ! grid%em_mu_2 x
2081 ! grid%em_muts x
2082 ! grid%em_mudf x
2083
2084 # include "HALO_EM_C2.inc"
2085 # include "PERIOD_BDY_EM_B3.inc"
2086 #endif
2087
2088 BENCH_START(phys_bc_tim)
2089 !$OMP PARALLEL DO &
2090 !$OMP PRIVATE ( ij )
2091
2092 DO ij = 1 , grid%num_tiles
2093
2094 ! boundary condition set for next small timestep
2095
2096 CALL set_physical_bc3d( grid%em_ph_2, 'w', config_flags, &
2097 ids, ide, jds, jde, kds, kde, &
2098 ims, ime, jms, jme, kms, kme, &
2099 ips, ipe, jps, jpe, kps, kpe, &
2100 grid%i_start(ij), grid%i_end(ij), &
2101 grid%j_start(ij), grid%j_end(ij), &
2102 k_start , k_end )
2103
2104 CALL set_physical_bc3d( grid%em_al, 'p', config_flags, &
2105 ids, ide, jds, jde, kds, kde, &
2106 ims, ime, jms, jme, kms, kme, &
2107 ips, ipe, jps, jpe, kps, kpe, &
2108 grid%i_start(ij), grid%i_end(ij), &
2109 grid%j_start(ij), grid%j_end(ij), &
2110 k_start , k_end )
2111
2112 CALL set_physical_bc3d( grid%em_p, 'p', config_flags, &
2113 ids, ide, jds, jde, kds, kde, &
2114 ims, ime, jms, jme, kms, kme, &
2115 ips, ipe, jps, jpe, kps, kpe, &
2116 grid%i_start(ij), grid%i_end(ij), &
2117 grid%j_start(ij), grid%j_end(ij), &
2118 k_start , k_end )
2119
2120 CALL set_physical_bc3d( grid%em_h_div, 'p', config_flags, &
2121 ids, ide, jds, jde, kds, kde, &
2122 ims, ime, jms, jme, kms, kme, &
2123 ips, ipe, jps, jpe, kps, kpe, &
2124 grid%i_start(ij), grid%i_end(ij), &
2125 grid%j_start(ij), grid%j_end(ij), &
2126 k_start , k_end )
2127
2128 CALL set_physical_bc2d( grid%em_muts, 't', config_flags, &
2129 ids, ide, jds, jde, &
2130 ims, ime, jms, jme, &
2131 ips, ipe, jps, jpe, &
2132 grid%i_start(ij), grid%i_end(ij), &
2133 grid%j_start(ij), grid%j_end(ij) )
2134
2135 CALL set_physical_bc2d( grid%em_mu_2, 't', config_flags, &
2136 ids, ide, jds, jde, &
2137 ims, ime, jms, jme, &
2138 ips, ipe, jps, jpe, &
2139 grid%i_start(ij), grid%i_end(ij), &
2140 grid%j_start(ij), grid%j_end(ij) )
2141
2142 CALL set_physical_bc2d( grid%em_mudf, 't', config_flags, &
2143 ids, ide, jds, jde, &
2144 ims, ime, jms, jme, &
2145 ips, ipe, jps, jpe, &
2146 grid%i_start(ij), grid%i_end(ij), &
2147 grid%j_start(ij), grid%j_end(ij) )
2148
2149 END DO
2150 !$OMP END PARALLEL DO
2151 BENCH_END(phys_bc_tim)
2152
2153 END DO small_steps
2154
2155 !$OMP PARALLEL DO &
2156 !$OMP PRIVATE ( ij )
2157
2158 DO ij = 1 , grid%num_tiles
2159
2160 CALL wrf_debug ( 200 , ' call rk_small_finish' )
2161
2162 ! change time-perturbation variables back to
2163 ! full perturbation variables.
2164 ! first get updated mu at u and v points
2165
2166 BENCH_START(calc_mu_uv_tim)
2167 CALL calc_mu_uv_1 ( config_flags, &
2168 grid%em_muts, muus, muvs, &
2169 ids, ide, jds, jde, kds, kde, &
2170 ims, ime, jms, jme, kms, kme, &
2171 grid%i_start(ij), grid%i_end(ij), &
2172 grid%j_start(ij), grid%j_end(ij), &
2173 k_start , k_end )
2174 BENCH_END(calc_mu_uv_tim)
2175 BENCH_START(small_step_finish_tim)
2176 CALL small_step_finish( grid%em_u_2, grid%em_u_1, grid%em_v_2, grid%em_v_1, grid%em_w_2, grid%em_w_1, &
2177 grid%em_t_2, grid%em_t_1, grid%em_ph_2, grid%em_ph_1, grid%em_ww, ww1, &
2178 grid%em_mu_2, grid%em_mu_1, &
2179 grid%em_mut, grid%em_muts, grid%em_muu, muus, grid%em_muv, muvs, &
2180 grid%em_u_save, grid%em_v_save, w_save, &
2181 grid%em_t_save, ph_save, mu_save, &
2182 grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
2183 grid%h_diabatic, &
2184 number_of_small_timesteps,dts_rk, &
2185 rk_step, rk_order, &
2186 ids, ide, jds, jde, kds, kde, &
2187 ims, ime, jms, jme, kms, kme, &
2188 grid%i_start(ij), grid%i_end(ij), &
2189 grid%j_start(ij), grid%j_end(ij), &
2190 k_start , k_end )
2191 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
2192
2193 IF (rk_step == 3) THEN
2194
2195 CALL set_physical_bc3d( grid%em_ru_m, 'u', config_flags, &
2196 ids, ide, jds, jde, kds, kde, &
2197 ims, ime, jms, jme, kms, kme, &
2198 ips, ipe, jps, jpe, kps, kpe, &
2199 grid%i_start(ij), grid%i_end(ij), &
2200 grid%j_start(ij), grid%j_end(ij), &
2201 k_start , k_end )
2202
2203 CALL set_physical_bc3d( grid%em_rv_m, 'v', config_flags, &
2204 ids, ide, jds, jde, kds, kde, &
2205 ims, ime, jms, jme, kms, kme, &
2206 ips, ipe, jps, jpe, kps, kpe, &
2207 grid%i_start(ij), grid%i_end(ij), &
2208 grid%j_start(ij), grid%j_end(ij), &
2209 k_start , k_end )
2210
2211 CALL set_physical_bc3d( grid%em_ww_m, 'w', config_flags, &
2212 ids, ide, jds, jde, kds, kde, &
2213 ims, ime, jms, jme, kms, kme, &
2214 ips, ipe, jps, jpe, kps, kpe, &
2215 grid%i_start(ij), grid%i_end(ij), &
2216 grid%j_start(ij), grid%j_end(ij), &
2217 k_start , k_end )
2218
2219 CALL set_physical_bc2d( grid%em_mut, 't', config_flags, &
2220 ids, ide, jds, jde, &
2221 ims, ime, jms, jme, &
2222 ips, ipe, jps, jpe, &
2223 grid%i_start(ij), grid%i_end(ij), &
2224 grid%j_start(ij), grid%j_end(ij) )
2225
2226 END IF
2227
2228 BENCH_END(small_step_finish_tim)
2229
2230 END DO
2231 !$OMP END PARALLEL DO
2232
2233 !-----------------------------------------------------------
2234 ! polar filter for full dynamics variables and time-averaged mass fluxes
2235 !-----------------------------------------------------------
2236
2237 IF (config_flags%polar) THEN
2238
2239 CALL pxft ( grid=grid &
2240 ,lineno=__LINE__ &
2241 ,flag_uv = 1 &
2242 ,flag_rurv = 1 &
2243 ,flag_wph = 1 &
2244 ,flag_ww = 1 &
2245 ,flag_t = 1 &
2246 ,flag_mu = 1 &
2247 ,flag_mut = 1 &
2248 ,flag_moist = 0 &
2249 ,flag_chem = 0 &
2250 ,flag_scalar = 0 &
2251 ,positive_definite = .FALSE. &
2252 ,moist=moist,chem=chem,scalar=scalar &
2253 ,fft_filter_type = config_flags%fft_filter_type &
2254 ,dclat = dclat &
2255 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2256 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2257 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2258 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2259 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2260
2261 END IF
2262
2263 !-----------------------------------------------------------
2264 ! end polar filter for full dynamics variables and time-averaged mass fluxes
2265 !-----------------------------------------------------------
2266
2267 !-----------------------------------------------------------------------
2268 ! add in physics tendency first if positive definite advection is used.
2269 ! pd advection applies advective flux limiter on last runge-kutta step
2270 !-----------------------------------------------------------------------
2271 ! first moisture
2272
2273 IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
2274
2275 !$OMP PARALLEL DO &
2276 !$OMP PRIVATE ( ij )
2277 DO ij = 1 , grid%num_tiles
2278 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2279 do im = PARAM_FIRST_SCALAR, num_3d_m
2280 CALL rk_update_scalar_pd( im, im, &
2281 moist_old(ims,kms,jms,im), &
2282 moist_tend(ims,kms,jms,im), &
2283 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
2284 rk_step, dt_rk, grid%spec_zone, &
2285 config_flags, &
2286 ids, ide, jds, jde, kds, kde, &
2287 ims, ime, jms, jme, kms, kme, &
2288 grid%i_start(ij), grid%i_end(ij), &
2289 grid%j_start(ij), grid%j_end(ij), &
2290 k_start , k_end )
2291 ENDDO
2292 END DO
2293 !$OMP END PARALLEL DO
2294
2295 !---------------------- positive definite bc call
2296 #ifdef DM_PARALLEL
2297 if(config_flags%pd_moist) then
2298 #ifndef RSL
2299 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2300 # include "HALO_EM_MOIST_OLD_E_5.inc"
2301 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2302 # include "HALO_EM_MOIST_OLD_E_7.inc"
2303 ELSE
2304 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2305 CALL wrf_error_fatal(TRIM(wrf_err_message))
2306 ENDIF
2307 #else
2308 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
2309 CALL wrf_error_fatal(TRIM(wrf_err_message))
2310 #endif
2311 endif
2312 #endif
2313
2314 #ifdef DM_PARALLEL
2315 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
2316 #endif
2317
2318 !$OMP PARALLEL DO &
2319 !$OMP PRIVATE ( ij )
2320 DO ij = 1 , grid%num_tiles
2321 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2322 DO im = PARAM_FIRST_SCALAR , num_3d_m
2323 CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
2324 ids, ide, jds, jde, kds, kde, &
2325 ims, ime, jms, jme, kms, kme, &
2326 ips, ipe, jps, jpe, kps, kpe, &
2327 grid%i_start(ij), grid%i_end(ij), &
2328 grid%j_start(ij), grid%j_end(ij), &
2329 k_start , k_end )
2330 END DO
2331 ENDIF
2332 END DO
2333 !$OMP END PARALLEL DO
2334
2335 END IF ! end if for pd_moist
2336
2337 ! scalars
2338
2339 IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
2340
2341 !$OMP PARALLEL DO &
2342 !$OMP PRIVATE ( ij )
2343
2344 DO ij = 1 , grid%num_tiles
2345 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2346 do im = PARAM_FIRST_SCALAR, num_3d_s
2347 CALL rk_update_scalar_pd( im, im, &
2348 scalar_old(ims,kms,jms,im), &
2349 scalar_tend(ims,kms,jms,im), &
2350 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
2351 rk_step, dt_rk, grid%spec_zone, &
2352 config_flags, &
2353 ids, ide, jds, jde, kds, kde, &
2354 ims, ime, jms, jme, kms, kme, &
2355 grid%i_start(ij), grid%i_end(ij), &
2356 grid%j_start(ij), grid%j_end(ij), &
2357 k_start , k_end )
2358 ENDDO
2359 ENDDO
2360 !$OMP END PARALLEL DO
2361
2362 !---------------------- positive definite bc call
2363 #ifdef DM_PARALLEL
2364 if(config_flags%pd_scalar) then
2365 #ifndef RSL
2366 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2367 # include "HALO_EM_SCALAR_OLD_E_5.inc"
2368 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2369 # include "HALO_EM_SCALAR_OLD_E_7.inc"
2370 ELSE
2371 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2372 CALL wrf_error_fatal(TRIM(wrf_err_message))
2373 ENDIF
2374 #else
2375 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
2376 CALL wrf_error_fatal(TRIM(wrf_err_message))
2377 #endif
2378 endif
2379 #endif
2380
2381 #ifdef DM_PARALLEL
2382 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
2383 #endif
2384 !$OMP PARALLEL DO &
2385 !$OMP PRIVATE ( ij )
2386
2387 DO ij = 1 , grid%num_tiles
2388 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2389 DO im = PARAM_FIRST_SCALAR , num_3d_s
2390 CALL set_physical_bc3d( scalar_old(ims,kms,jms,im), 'p', config_flags, &
2391 ids, ide, jds, jde, kds, kde, &
2392 ims, ime, jms, jme, kms, kme, &
2393 ips, ipe, jps, jpe, kps, kpe, &
2394 grid%i_start(ij), grid%i_end(ij), &
2395 grid%j_start(ij), grid%j_end(ij), &
2396 k_start , k_end )
2397 END DO
2398 ENDIF
2399 END DO
2400 !$OMP END PARALLEL DO
2401
2402 END IF ! end if for pd_scalar
2403
2404 ! chem
2405
2406 IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
2407
2408 !$OMP PARALLEL DO &
2409 !$OMP PRIVATE ( ij )
2410 DO ij = 1 , grid%num_tiles
2411 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2412 do im = PARAM_FIRST_SCALAR, num_3d_c
2413 CALL rk_update_scalar_pd( im, im, &
2414 chem_old(ims,kms,jms,im), &
2415 chem_tend(ims,kms,jms,im), &
2416 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
2417 rk_step, dt_rk, grid%spec_zone, &
2418 config_flags, &
2419 ids, ide, jds, jde, kds, kde, &
2420 ims, ime, jms, jme, kms, kme, &
2421 grid%i_start(ij), grid%i_end(ij), &
2422 grid%j_start(ij), grid%j_end(ij), &
2423 k_start , k_end )
2424 ENDDO
2425 END DO
2426 !$OMP END PARALLEL DO
2427
2428 !---------------------- positive definite bc call
2429 #ifdef DM_PARALLEL
2430 if(config_flags%pd_chem) then
2431 #ifndef RSL
2432 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2433 # include "HALO_EM_CHEM_OLD_E_5.inc"
2434 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2435 # include "HALO_EM_CHEM_OLD_E_7.inc"
2436 ELSE
2437 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2438 CALL wrf_error_fatal(TRIM(wrf_err_message))
2439 ENDIF
2440 #else
2441 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
2442 CALL wrf_error_fatal(TRIM(wrf_err_message))
2443 #endif
2444 endif
2445 #endif
2446
2447 #ifdef DM_PARALLEL
2448 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
2449 #endif
2450
2451 !$OMP PARALLEL DO &
2452 !$OMP PRIVATE ( ij )
2453 DO ij = 1 , grid%num_tiles
2454 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2455 DO im = PARAM_FIRST_SCALAR , num_3d_c
2456 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
2457 ids, ide, jds, jde, kds, kde, &
2458 ims, ime, jms, jme, kms, kme, &
2459 ips, ipe, jps, jpe, kps, kpe, &
2460 grid%i_start(ij), grid%i_end(ij), &
2461 grid%j_start(ij), grid%j_end(ij), &
2462 k_start , k_end )
2463 END DO
2464 ENDIF
2465 END DO
2466 !$OMP END PARALLEL DO
2467
2468 END IF ! end if for pd_chem
2469
2470 ! tke
2471
2472 IF (config_flags%pd_tke .and. (rk_step == rk_order) &
2473 .and. (config_flags%km_opt .eq. 2) ) THEN
2474
2475 !$OMP PARALLEL DO &
2476 !$OMP PRIVATE ( ij )
2477
2478 DO ij = 1 , grid%num_tiles
2479 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2480 CALL rk_update_scalar_pd( 1, 1, &
2481 grid%em_tke_1, &
2482 tke_tend(ims,kms,jms), &
2483 grid%em_mu_1, grid%em_mu_1, grid%em_mub, &
2484 rk_step, dt_rk, grid%spec_zone, &
2485 config_flags, &
2486 ids, ide, jds, jde, kds, kde, &
2487 ims, ime, jms, jme, kms, kme, &
2488 grid%i_start(ij), grid%i_end(ij), &
2489 grid%j_start(ij), grid%j_end(ij), &
2490 k_start , k_end )
2491 END DO
2492 !$OMP END PARALLEL DO
2493
2494 !---------------------- positive definite bc call
2495 #ifdef DM_PARALLEL
2496 if(config_flags%pd_tke) then
2497 #ifndef RSL
2498 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2499 # include "HALO_EM_TKE_OLD_E_5.inc"
2500 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2501 # include "HALO_EM_TKE_OLD_E_7.inc"
2502 ELSE
2503 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2504 CALL wrf_error_fatal(TRIM(wrf_err_message))
2505 ENDIF
2506 #else
2507 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
2508 CALL wrf_error_fatal(TRIM(wrf_err_message))
2509 #endif
2510 endif
2511 #endif
2512
2513 #ifdef DM_PARALLEL
2514 # include "PERIOD_BDY_EM_TKE_OLD.inc"
2515 #endif
2516
2517 !$OMP PARALLEL DO &
2518 !$OMP PRIVATE ( ij )
2519 DO ij = 1 , grid%num_tiles
2520 CALL set_physical_bc3d( grid%em_tke_1, 'p', config_flags, &
2521 ids, ide, jds, jde, kds, kde, &
2522 ims, ime, jms, jme, kms, kme, &
2523 ips, ipe, jps, jpe, kps, kpe, &
2524 grid%i_start(ij), grid%i_end(ij), &
2525 grid%j_start(ij), grid%j_end(ij), &
2526 k_start , k_end )
2527 END DO
2528 !$OMP END PARALLEL DO
2529
2530 !--- end of positive definite physics tendency update
2531
2532 END IF ! end if for pd_tke
2533
2534 #ifdef DM_PARALLEL
2535 !
2536 ! Stencils for patch communications (WCS, 29 June 2001)
2537 !
2538 !
2539 ! grid%em_ru_m x
2540 ! grid%em_rv_m x
2541 ! grid%em_ww_m x
2542 ! grid%em_mut x
2543 !
2544 !--------------------------------------------------------------
2545
2546 # include "HALO_EM_D.inc"
2547 #endif
2548
2549 !<DESCRIPTION>
2550 !<pre>
2551 ! (4) Still within the RK loop, the scalar variables are advanced.
2552 !
2553 ! For the moist and chem variables, each one is advanced
2554 ! individually, using named loops "moist_variable_loop:"
2555 ! and "chem_variable_loop:". Each RK substep begins by
2556 ! calculating the advective tendency, and, for the first RK step,
2557 ! 3D mixing (calling rk_scalar_tend) followed by an update
2558 ! of the scalar (calling rk_scalar_update).
2559 !</pre>
2560 !</DESCRIPTION>
2561
2562
2563 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2564
2565 moist_variable_loop: do im = PARAM_FIRST_SCALAR, num_3d_m
2566
2567 if (grid%adv_moist_cond .or. im==p_qv ) then
2568
2569 !$OMP PARALLEL DO &
2570 !$OMP PRIVATE ( ij )
2571
2572 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
2573
2574 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2575
2576 BENCH_START(rk_scalar_tend_tim)
2577
2578 CALL rk_scalar_tend ( im, im, config_flags, &
2579 rk_step, dt_rk, &
2580 grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, &
2581 grid%em_mut, grid%em_mub, grid%em_mu_1, &
2582 grid%em_alt, &
2583 moist_old(ims,kms,jms,im), &
2584 moist(ims,kms,jms,im), &
2585 moist_tend(ims,kms,jms,im), &
2586 advect_tend,grid%rqvften, &
2587 grid%qv_base, .true., grid%em_fnm, grid%em_fnp, &
2588 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2589 grid%msfvy, grid%msftx,grid%msfty, &
2590 grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, grid%khdif, &
2591 grid%kvdif, grid%xkhh, &
2592 grid%diff_6th_opt, grid%diff_6th_factor, &
2593 config_flags%pd_moist, &
2594 ids, ide, jds, jde, kds, kde, &
2595 ims, ime, jms, jme, kms, kme, &
2596 grid%i_start(ij), grid%i_end(ij), &
2597 grid%j_start(ij), grid%j_end(ij), &
2598 k_start , k_end )
2599
2600 BENCH_END(rk_scalar_tend_tim)
2601
2602 BENCH_START(rlx_bdy_scalar_tim)
2603 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
2604 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
2605 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2606 moist(ims,kms,jms,im), grid%em_mut, &
2607 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2608 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2609 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2610 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2611 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2612 grid%dtbc, grid%fcx, grid%gcx, &
2613 config_flags, &
2614 ids,ide, jds,jde, kds,kde, & ! domain dims
2615 ims,ime, jms,jme, kms,kme, & ! memory dims
2616 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2617 grid%i_start(ij), grid%i_end(ij), &
2618 grid%j_start(ij), grid%j_end(ij), &
2619 k_start, k_end )
2620
2621 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2622 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2623 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2624 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2625 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2626 config_flags%spec_bdy_width, grid%spec_zone, &
2627 config_flags, &
2628 ids,ide, jds,jde, kds,kde, & ! domain dims
2629 ims,ime, jms,jme, kms,kme, & ! memory dims
2630 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2631 grid%i_start(ij), grid%i_end(ij), &
2632 grid%j_start(ij), grid%j_end(ij), &
2633 k_start, k_end )
2634 ENDIF
2635 ENDIF
2636 BENCH_END(rlx_bdy_scalar_tim)
2637
2638 ENDDO moist_tile_loop_1
2639 !$OMP END PARALLEL DO
2640
2641 !$OMP PARALLEL DO &
2642 !$OMP PRIVATE ( ij )
2643
2644 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2645
2646 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2647
2648 BENCH_START(update_scal_tim)
2649 CALL rk_update_scalar( im, im, &
2650 moist_old(ims,kms,jms,im), &
2651 moist(ims,kms,jms,im), &
2652 moist_tend(ims,kms,jms,im), &
2653 advect_tend, grid%msftx,grid%msfty, &
2654 grid%em_mu_1, grid%em_mu_2, grid%em_mub, &
2655 rk_step, dt_rk, grid%spec_zone, &
2656 config_flags, &
2657 ids, ide, jds, jde, kds, kde, &
2658 ims, ime, jms, jme, kms, kme, &
2659 grid%i_start(ij), grid%i_end(ij), &
2660 grid%j_start(ij), grid%j_end(ij), &
2661 k_start , k_end )
2662 BENCH_END(update_scal_tim)
2663
2664 BENCH_START(flow_depbdy_tim)
2665 IF( config_flags%specified ) THEN
2666 IF(im .ne. P_QV)THEN
2667 CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
2668 grid%em_ru_m, grid%em_rv_m, config_flags, &
2669 grid%spec_zone, &
2670 ids,ide, jds,jde, kds,kde, & ! domain dims
2671 ims,ime, jms,jme, kms,kme, & ! memory dims
2672 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2673 grid%i_start(ij), grid%i_end(ij), &
2674 grid%j_start(ij), grid%j_end(ij), &
2675 k_start, k_end )
2676 ENDIF
2677 ENDIF
2678 BENCH_END(flow_depbdy_tim)
2679
2680 ENDDO moist_tile_loop_2
2681 !$OMP END PARALLEL DO
2682
2683 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2684
2685 ENDDO moist_variable_loop
2686
2687 ENDIF moist_scalar_advance
2688
2689 BENCH_START(tke_adv_tim)
2690 TKE_advance: IF (config_flags%km_opt .eq. 2) then
2691
2692 #ifdef DM_PARALLEL
2693 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2694 # include "HALO_EM_TKE_ADVECT_3.inc"
2695 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2696 # include "HALO_EM_TKE_ADVECT_5.inc"
2697 ELSE
2698 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2699 CALL wrf_error_fatal(TRIM(wrf_err_message))
2700 ENDIF
2701 #endif
2702
2703 !$OMP PARALLEL DO &
2704 !$OMP PRIVATE ( ij )
2705
2706 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2707
2708 CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
2709 CALL rk_scalar_tend ( 1, 1, config_flags, &
2710 rk_step, dt_rk, &
2711 grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, &
2712 grid%em_mut, grid%em_mub, grid%em_mu_1, &
2713 grid%em_alt, &
2714 grid%em_tke_1, &
2715 grid%em_tke_2, &
2716 tke_tend(ims,kms,jms), &
2717 advect_tend,grid%rqvften, &
2718 grid%qv_base, .false., grid%em_fnm, grid%em_fnp, &
2719 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2720 grid%msfvy, grid%msftx,grid%msfty, &
2721 grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, grid%khdif, &
2722 grid%kvdif, grid%xkhh, &
2723 grid%diff_6th_opt, grid%diff_6th_factor, &
2724 config_flags%pd_tke, &
2725 ids, ide, jds, jde, kds, kde, &
2726 ims, ime, jms, jme, kms, kme, &
2727 grid%i_start(ij), grid%i_end(ij), &
2728 grid%j_start(ij), grid%j_end(ij), &
2729 k_start , k_end )
2730
2731 ENDDO tke_tile_loop_1
2732 !$OMP END PARALLEL DO
2733
2734 !$OMP PARALLEL DO &
2735 !$OMP PRIVATE ( ij )
2736
2737 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2738
2739 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2740 CALL rk_update_scalar( 1, 1, &
2741 grid%em_tke_1, &
2742 grid%em_tke_2, &
2743 tke_tend(ims,kms,jms), &
2744 advect_tend,grid%msftx,grid%msfty,&
2745 grid%em_mu_1, grid%em_mu_2, grid%em_mub, &
2746 rk_step, dt_rk, grid%spec_zone, &
2747 config_flags, &
2748 ids, ide, jds, jde, kds, kde, &
2749 ims, ime, jms, jme, kms, kme, &
2750 grid%i_start(ij), grid%i_end(ij), &
2751 grid%j_start(ij), grid%j_end(ij), &
2752 k_start , k_end )
2753
2754 ! bound the tke (greater than 0, less than tke_upper_bound)
2755
2756 CALL bound_tke( grid%em_tke_2, grid%tke_upper_bound, &
2757 ids, ide, jds, jde, kds, kde, &
2758 ims, ime, jms, jme, kms, kme, &
2759 grid%i_start(ij), grid%i_end(ij), &
2760 grid%j_start(ij), grid%j_end(ij), &
2761 k_start , k_end )
2762
2763 IF( config_flags%specified .or. config_flags%nested ) THEN
2764 CALL flow_dep_bdy ( grid%em_tke_2, &
2765 grid%em_ru_m, grid%em_rv_m, config_flags, &
2766 grid%spec_zone, &
2767 ids,ide, jds,jde, kds,kde, & ! domain dims
2768 ims,ime, jms,jme, kms,kme, & ! memory dims
2769 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2770 grid%i_start(ij), grid%i_end(ij), &
2771 grid%j_start(ij), grid%j_end(ij), &
2772 k_start, k_end )
2773 ENDIF
2774 ENDDO tke_tile_loop_2
2775 !$OMP END PARALLEL DO
2776
2777 END IF TKE_advance
2778 BENCH_END(tke_adv_tim)
2779
2780 #ifdef WRF_CHEM
2781 ! next the chemical species
2782 BENCH_START(chem_adv_tim)
2783 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2784
2785 chem_variable_loop: do ic = PARAM_FIRST_SCALAR, num_3d_c
2786
2787 !$OMP PARALLEL DO &
2788 !$OMP PRIVATE ( ij )
2789
2790 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2791
2792 CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
2793 CALL rk_scalar_tend ( ic, ic, config_flags, &
2794 rk_step, dt_rk, &
2795 grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, &
2796 grid%em_mut, grid%em_mub, grid%em_mu_1, &
2797 grid%em_alt, &
2798 chem_old(ims,kms,jms,ic), &
2799 chem(ims,kms,jms,ic), &
2800 chem_tend(ims,kms,jms,ic), &
2801 advect_tend,grid%rqvften, &
2802 grid%qv_base, .false., grid%em_fnm, grid%em_fnp, &
2803 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2804 grid%msfvy, grid%msftx,grid%msfty, &
2805 grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, &
2806 grid%khdif, grid%kvdif, grid%xkhh, &
2807 grid%diff_6th_opt, grid%diff_6th_factor, &
2808 config_flags%pd_chem, &
2809 ids, ide, jds, jde, kds, kde, &
2810 ims, ime, jms, jme, kms, kme, &
2811 grid%i_start(ij), grid%i_end(ij), &
2812 grid%j_start(ij), grid%j_end(ij), &
2813 k_start , k_end )
2814 !
2815 ! Currently, chemistry species with specified boundaries (i.e. the mother
2816 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2817 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2818 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2819 !
2820 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2821 if(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2822
2823 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2824 chem(ims,kms,jms,ic), grid%em_mut, &
2825 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2826 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2827 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2828 grid%dtbc, grid%fcx, grid%gcx, &
2829 config_flags, &
2830 ids,ide, jds,jde, kds,kde, & ! domain dims
2831 ims,ime, jms,jme, kms,kme, & ! memory dims
2832 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2833 grid%i_start(ij), grid%i_end(ij), &
2834 grid%j_start(ij), grid%j_end(ij), &
2835 k_start, k_end )
2836 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2837 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2838 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2839 config_flags%spec_bdy_width, grid%spec_zone, &
2840 config_flags, &
2841 ids,ide, jds,jde, kds,kde, & ! domain dims
2842 ims,ime, jms,jme, kms,kme, & ! memory dims
2843 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2844 grid%i_start(ij), grid%i_end(ij), &
2845 grid%j_start(ij), grid%j_end(ij), &
2846 k_start, k_end )
2847 ENDIF
2848
2849 ENDDO chem_tile_loop_1
2850
2851 !$OMP END PARALLEL DO
2852
2853
2854 !$OMP PARALLEL DO &
2855 !$OMP PRIVATE ( ij )
2856
2857 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2858
2859 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2860 CALL rk_update_scalar( ic, ic, &
2861 chem_old(ims,kms,jms,ic), & ! was chem_1
2862 chem(ims,kms,jms,ic), &
2863 chem_tend(ims,kms,jms,ic), &
2864 advect_tend, grid%msftx, grid%msfty, &
2865 grid%em_mu_1, grid%em_mu_2, grid%em_mub, &
2866 rk_step, dt_rk, grid%spec_zone, &
2867 config_flags, &
2868 ids, ide, jds, jde, kds, kde, &
2869 ims, ime, jms, jme, kms, kme, &
2870 grid%i_start(ij), grid%i_end(ij), &
2871 grid%j_start(ij), grid%j_end(ij), &
2872 k_start , k_end )
2873
2874
2875 IF( config_flags%specified ) THEN
2876 ! come back to this and figure out why two different routines are needed. JM 20041203
2877 !#ifndef WRF_CHEM
2878 !!$ CALL flow_dep_bdy ( chem(ims,kms,jms,ic), &
2879 !!$ grid%em_ru_m, grid%em_rv_m, config_flags, &
2880 !!$ grid%spec_zone, &
2881 !!$ ids,ide, jds,jde, kds,kde, & ! domain dims
2882 !!$ ims,ime, jms,jme, kms,kme, & ! memory dims
2883 !!$ ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2884 !!$ grid%i_start(ij), grid%i_end(ij), &
2885 !!$ grid%j_start(ij), grid%j_end(ij), &
2886 !!$ k_start, k_end )
2887 !#else
2888 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2889 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2890 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2891 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2892 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2893 dt_rk+grid%dtbc, &
2894 config_flags%spec_bdy_width,grid%em_z, &
2895 grid%have_bcs_chem, &
2896 grid%em_ru_m, grid%em_rv_m, config_flags,grid%em_alt, &
2897 grid%em_t_1,grid%em_pb,grid%em_p,t0,p1000mb,rcp,grid%em_ph_2,grid%em_phb,g, &
2898 grid%spec_zone,ic, &
2899 ids,ide, jds,jde, kds,kde, & ! domain dims
2900 ims,ime, jms,jme, kms,kme, & ! memory dims
2901 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2902 grid%i_start(ij), grid%i_end(ij), &
2903 grid%j_start(ij), grid%j_end(ij), &
2904 k_start, k_end )
2905 !#endif
2906 ENDIF
2907
2908
2909 ENDDO chem_tile_loop_2
2910 !$OMP END PARALLEL DO
2911
2912 ENDDO chem_variable_loop
2913
2914 ENDIF chem_scalar_advance
2915 BENCH_END(chem_adv_tim)
2916 #endif
2917
2918 ! next the other scalar species
2919 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2920
2921 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2922 !$OMP PARALLEL DO &
2923 !$OMP PRIVATE ( ij )
2924
2925 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2926
2927 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2928 CALL rk_scalar_tend ( is, is, config_flags, &
2929 rk_step, dt_rk, &
2930 grid%em_ru_m, grid%em_rv_m, grid%em_ww_m, &
2931 grid%em_mut, grid%em_mub, grid%em_mu_1, &
2932 grid%em_alt, &
2933 scalar_old(ims,kms,jms,is), &
2934 scalar(ims,kms,jms,is), &
2935 scalar_tend(ims,kms,jms,is), &
2936 advect_tend,grid%rqvften, &
2937 grid%qv_base, .false., grid%em_fnm, grid%em_fnp, &
2938 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2939 grid%msfvy, grid%msftx,grid%msfty, &
2940 grid%rdx, grid%rdy, grid%em_rdn, grid%em_rdnw, &
2941 grid%khdif, grid%kvdif, grid%xkhh, &
2942 grid%diff_6th_opt, grid%diff_6th_factor, &
2943 config_flags%pd_scalar, &
2944 ids, ide, jds, jde, kds, kde, &
2945 ims, ime, jms, jme, kms, kme, &
2946 grid%i_start(ij), grid%i_end(ij), &
2947 grid%j_start(ij), grid%j_end(ij), &
2948 k_start , k_end )
2949
2950 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2951
2952 IF (is .eq. P_QNDROP .OR. is .eq. P_QNI &
2953 .or. is .eq. P_QNS &
2954 .or. is .eq. P_QNR &
2955 .or. is .eq. P_QNG) THEN
2956
2957 CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2958 scalar(ims,kms,jms,is), grid%em_mut, &
2959 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2960 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2961 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2962 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2963 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2964 grid%dtbc, grid%fcx, grid%gcx, &
2965 config_flags, &
2966 ids,ide, jds,jde, kds,kde, & ! domain dims
2967 ims,ime, jms,jme, kms,kme, & ! memory dims
2968 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2969 grid%i_start(ij), grid%i_end(ij), &
2970 grid%j_start(ij), grid%j_end(ij), &
2971 k_start, k_end )
2972
2973 CALL spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2974 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2975 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2976 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2977 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2978 config_flags%spec_bdy_width, grid%spec_zone, &
2979 config_flags, &
2980 ids,ide, jds,jde, kds,kde, & ! domain dims
2981 ims,ime, jms,jme, kms,kme, & ! memory dims
2982 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2983 grid%i_start(ij), grid%i_end(ij), &
2984 grid%j_start(ij), grid%j_end(ij), &
2985 k_start, k_end )
2986
2987 ENDIF
2988
2989 ENDIF ! b.c test for chem nested boundary condition
2990
2991 ENDDO scalar_tile_loop_1
2992 !$OMP END PARALLEL DO
2993
2994
2995 !$OMP PARALLEL DO &
2996 !$OMP PRIVATE ( ij )
2997
2998 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2999
3000 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
3001 CALL rk_update_scalar( is, is, &
3002 scalar_old(ims,kms,jms,is), & ! was scalar_1
3003 scalar(ims,kms,jms,is), &
3004 scalar_tend(ims,kms,jms,is), &
3005 advect_tend, grid%msftx, grid%msfty, &
3006 grid%em_mu_1, grid%em_mu_2, grid%em_mub, &
3007 rk_step, dt_rk, grid%spec_zone, &
3008 config_flags, &
3009 ids, ide, jds, jde, kds, kde, &
3010 ims, ime, jms, jme, kms, kme, &
3011 grid%i_start(ij), grid%i_end(ij), &
3012 grid%j_start(ij), grid%j_end(ij), &
3013 k_start , k_end )
3014
3015
3016 IF( config_flags%specified ) THEN
3017 CALL flow_dep_bdy ( scalar(ims,kms,jms,is), &
3018 grid%em_ru_m, grid%em_rv_m, config_flags, &
3019 grid%spec_zone, &
3020 ids,ide, jds,jde, kds,kde, & ! domain dims
3021 ims,ime, jms,jme, kms,kme, & ! memory dims
3022 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3023 grid%i_start(ij), grid%i_end(ij), &
3024 grid%j_start(ij), grid%j_end(ij), &
3025 k_start, k_end )
3026 ENDIF
3027
3028
3029 ENDDO scalar_tile_loop_2
3030 !$OMP END PARALLEL DO
3031
3032 ENDDO scalar_variable_loop
3033
3034 ENDIF other_scalar_advance
3035
3036 ! update the pressure and density at the new time level
3037
3038 !$OMP PARALLEL DO &
3039 !$OMP PRIVATE ( ij )
3040 DO ij = 1 , grid%num_tiles
3041
3042 BENCH_START(calc_p_rho_tim)
3043
3044 CALL calc_p_rho_phi( moist, num_3d_m, &
3045 grid%em_al, grid%em_alb, grid%em_mu_2, grid%em_muts, &
3046 grid%em_ph_2, grid%em_p, grid%em_pb, grid%em_t_2, &
3047 p0, t0, grid%em_znu, grid%em_dnw, grid%em_rdnw, &
3048 grid%em_rdn, config_flags%non_hydrostatic, &
3049 ids, ide, jds, jde, kds, kde, &
3050 ims, ime, jms, jme, kms, kme, &
3051 grid%i_start(ij), grid%i_end(ij), &
3052 grid%j_start(ij), grid%j_end(ij), &
3053 k_start , k_end )
3054
3055 BENCH_END(calc_p_rho_tim)
3056
3057 ENDDO
3058 !$OMP END PARALLEL DO
3059
3060 ! Reset the boundary conditions if there is another corrector step.
3061 ! (rk_step < rk_order), else we'll handle it at the end of everything
3062 ! (after the split physics, before exiting the timestep).
3063
3064 rk_step_1_check: IF ( rk_step < rk_order ) THEN
3065
3066 !-----------------------------------------------------------
3067 ! rk3 substep polar filter for scalars (moist,chem,scalar)
3068 !-----------------------------------------------------------
3069
3070 IF (config_flags%polar) THEN
3071 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3072 CALL wrf_debug ( 200 , ' call filter moist ' )
3073 DO im = PARAM_FIRST_SCALAR, num_3d_m
3074 CALL couple_scalars_for_filter ( FIELD=moist(:,:,:,im) &
3075 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3076 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3077 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3078 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3079 CALL pxft ( grid=grid &
3080 ,lineno=__LINE__ &
3081 ,flag_uv = 0 &
3082 ,flag_rurv = 0 &
3083 ,flag_wph = 0 &
3084 ,flag_ww = 0 &
3085 ,flag_t = 0 &
3086 ,flag_mu = 0 &
3087 ,flag_mut = 0 &
3088 ,flag_moist = im &
3089 ,flag_chem = 0 &
3090 ,flag_scalar = 0 &
3091 ,positive_definite=.FALSE. &
3092 ,moist=moist,chem=chem,scalar=scalar &
3093 ,fft_filter_type = config_flags%fft_filter_type &
3094 ,dclat = dclat &
3095 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3096 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3097 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3098 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3099 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3100 CALL uncouple_scalars_for_filter ( FIELD=moist(:,:,:,im) &
3101 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3102 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3103 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3104 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3105 END DO
3106 END IF
3107
3108 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
3109 CALL wrf_debug ( 200 , ' call filter chem ' )
3110 DO im = PARAM_FIRST_SCALAR, num_3d_c
3111 CALL couple_scalars_for_filter ( FIELD=chem(:,:,:,im) &
3112 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3113 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3114 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3115 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3116 CALL pxft ( grid=grid &
3117 ,lineno=__LINE__ &
3118 ,flag_uv = 0 &
3119 ,flag_rurv = 0 &
3120 ,flag_wph = 0 &
3121 ,flag_ww = 0 &
3122 ,flag_t = 0 &
3123 ,flag_mu = 0 &
3124 ,flag_mut = 0 &
3125 ,flag_moist = 0 &
3126 ,flag_chem = im &
3127 ,flag_scalar = 0 &
3128 ,positive_definite=.FALSE. &
3129 ,moist=moist,chem=chem,scalar=scalar &
3130 ,fft_filter_type = config_flags%fft_filter_type &
3131 ,dclat = dclat &
3132 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3133 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3134 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3135 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3136 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3137 CALL uncouple_scalars_for_filter ( FIELD=chem(:,:,:,im) &
3138 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3139 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3140 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3141 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3142 END DO
3143 END IF
3144
3145 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
3146 CALL wrf_debug ( 200 , ' call filter scalar ' )
3147 DO im = PARAM_FIRST_SCALAR, num_3d_s
3148 CALL couple_scalars_for_filter ( FIELD=scalar(:,:,:,im) &
3149 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3150 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3151 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3152 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3153 CALL pxft ( grid=grid &
3154 ,lineno=__LINE__ &
3155 ,flag_uv = 0 &
3156 ,flag_rurv = 0 &
3157 ,flag_wph = 0 &
3158 ,flag_ww = 0 &
3159 ,flag_t = 0 &
3160 ,flag_mu = 0 &
3161 ,flag_mut = 0 &
3162 ,flag_moist = 0 &
3163 ,flag_chem = 0 &
3164 ,flag_scalar = im &
3165 ,positive_definite=.FALSE. &
3166 ,moist=moist,chem=chem,scalar=scalar &
3167 ,fft_filter_type = config_flags%fft_filter_type &
3168 ,dclat = dclat &
3169 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3170 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3171 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3172 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3173 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3174 CALL uncouple_scalars_for_filter ( FIELD=scalar(:,:,:,im) &
3175 ,MU=grid%em_mu_2 , MUB=grid%em_mub &
3176 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3177 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3178 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3179 END DO
3180 END IF
3181 END IF ! polar filter test
3182
3183 !-----------------------------------------------------------
3184 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
3185 !-----------------------------------------------------------
3186
3187
3188 !-----------------------------------------------------------
3189 ! Stencils for patch communications (WCS, 29 June 2001)
3190 !
3191 ! here's where we need a wide comm stencil - these are the
3192 ! uncoupled variables so are used for high order calc in
3193 ! advection and mixong routines.
3194 !
3195 ! * * * * *
3196 ! * * * * * * * * *
3197 ! * + * * + * * * + * *
3198 ! * * * * * * * * *
3199 ! * * * * *
3200 !
3201 !
3202 ! grid%em_u_2 x
3203 ! grid%em_v_2 x
3204 ! grid%em_w_2 x
3205 ! grid%em_t_2 x
3206 ! grid%em_ph_2 x
3207 ! grid%em_al x
3208 !
3209 ! 2D variable
3210 ! grid%em_mu_2 x
3211 !
3212 ! 4D variable
3213 ! moist x
3214 ! chem x
3215 !scalar x
3216
3217 #ifdef DM_PARALLEL
3218 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3219 # include "HALO_EM_D2_3.inc"
3220 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3221 # include "HALO_EM_D2_5.inc"
3222 ELSE
3223 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3224 CALL wrf_error_fatal(TRIM(wrf_err_message))
3225 ENDIF
3226 # include "PERIOD_BDY_EM_D.inc"
3227 # include "PERIOD_BDY_EM_MOIST2.inc"
3228 # include "PERIOD_BDY_EM_CHEM2.inc"
3229 # include "PERIOD_BDY_EM_SCALAR2.inc"
3230 #endif
3231
3232 BENCH_START(bc_end_tim)
3233 !$OMP PARALLEL DO &
3234 !$OMP PRIVATE ( ij )
3235
3236 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
3237
3238
3239 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
3240
3241 CALL rk_phys_bc_dry_2( config_flags, &
3242 grid%em_u_2, grid%em_v_2, grid%em_w_2, &
3243 grid%em_t_2, grid%em_ph_2, grid%em_mu_2, &
3244 ids, ide, jds, jde, kds, kde, &
3245 ims, ime, jms, jme, kms, kme, &
3246 ips, ipe, jps, jpe, kps, kpe, &
3247 grid%i_start(ij), grid%i_end(ij), &
3248 grid%j_start(ij), grid%j_end(ij), &
3249 k_start , k_end )
3250
3251 BENCH_START(diag_w_tim)
3252 IF (.not. config_flags%non_hydrostatic) THEN
3253 CALL diagnose_w( ph_tend, grid%em_ph_2, grid%em_ph_1, grid%em_w_2, grid%em_muts, dt_rk, &
3254 grid%em_u_2, grid%em_v_2, grid%ht, &
3255 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3256 ids, ide, jds, jde, kds, kde, &
3257 ims, ime, jms, jme, kms, kme, &
3258 grid%i_start(ij), grid%i_end(ij), &
3259 grid%j_start(ij), grid%j_end(ij), &
3260 k_start , k_end )
3261 ENDIF
3262 BENCH_END(diag_w_tim)
3263
3264 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
3265
3266 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3267
3268 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
3269 ids, ide, jds, jde, kds, kde, &
3270 ims, ime, jms, jme, kms, kme, &
3271 ips, ipe, jps, jpe, kps, kpe, &
3272 grid%i_start(ij), grid%i_end(ij), &
3273 grid%j_start(ij), grid%j_end(ij), &
3274 k_start , k_end )
3275 END DO moisture_loop_bdy_1
3276
3277 ENDIF
3278
3279 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
3280
3281 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3282
3283 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
3284 ids, ide, jds, jde, kds, kde, &
3285 ims, ime, jms, jme, kms, kme, &
3286 ips, ipe, jps, jpe, kps, kpe, &
3287 grid%i_start(ij), grid%i_end(ij), &
3288 grid%j_start(ij), grid%j_end(ij), &
3289 k_start , k_end-1 )
3290
3291 END DO chem_species_bdy_loop_1
3292
3293 END IF
3294
3295 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
3296
3297 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3298
3299 CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags, &
3300 ids, ide, jds, jde, kds, kde, &
3301 ims, ime, jms, jme, kms, kme, &
3302 ips, ipe, jps, jpe, kps, kpe, &
3303 grid%i_start(ij), grid%i_end(ij), &
3304 grid%j_start(ij), grid%j_end(ij), &
3305 k_start , k_end-1 )
3306
3307 END DO scalar_species_bdy_loop_1
3308
3309 END IF
3310
3311 IF (config_flags%km_opt .eq. 2) THEN
3312
3313 CALL set_physical_bc3d( grid%em_tke_2 , 'p', config_flags, &
3314 ids, ide, jds, jde, kds, kde, &
3315 ims, ime, jms, jme, kms, kme, &
3316 ips, ipe, jps, jpe, kps, kpe, &
3317 grid%i_start(ij), grid%i_end(ij), &
3318 grid%j_start(ij), grid%j_end(ij), &
3319 k_start , k_end )
3320 END IF
3321
3322 END DO tile_bc_loop_1
3323 !$OMP END PARALLEL DO
3324 BENCH_END(bc_end_tim)
3325
3326
3327 #ifdef DM_PARALLEL
3328
3329 ! * * * * *
3330 ! * * * * * * * * *
3331 ! * + * * + * * * + * *
3332 ! * * * * * * * * *
3333 ! * * * * *
3334
3335 ! moist, chem, scalar, tke x
3336
3337
3338 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3339 IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
3340 # include "HALO_EM_TKE_5.inc"
3341 ELSE
3342 # include "HALO_EM_TKE_3.inc"
3343 ENDIF
3344 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3345 IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
3346 # include "HALO_EM_TKE_7.inc"
3347 ELSE
3348 # include "HALO_EM_TKE_5.inc"
3349 ENDIF
3350 ELSE
3351 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3352 CALL wrf_error_fatal(TRIM(wrf_err_message))
3353 ENDIF
3354
3355 #if 0
3356 IF (config_flags%km_opt .eq. 2) THEN
3357 # include "HALO_EM_TKE_F.inc"
3358 ENDIF
3359 #endif
3360
3361 if ( num_moist .ge. PARAM_FIRST_SCALAR ) then
3362 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3363 IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
3364 # include "HALO_EM_MOIST_E_5.inc"
3365 ELSE
3366 # include "HALO_EM_MOIST_E_3.inc"
3367 END IF
3368 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3369 IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
3370 # include "HALO_EM_MOIST_E_7.inc"
3371 ELSE
3372 # include "HALO_EM_MOIST_E_5.inc"
3373 END IF
3374 ELSE
3375 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3376 CALL wrf_error_fatal(TRIM(wrf_err_message))
3377 ENDIF
3378 endif
3379 if ( num_chem >= PARAM_FIRST_SCALAR ) then
3380 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3381 IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
3382 # include "HALO_EM_CHEM_E_5.inc"
3383 ELSE
3384 # include "HALO_EM_CHEM_E_3.inc"
3385 END IF
3386 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3387 IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
3388 # include "HALO_EM_CHEM_E_7.inc"
3389 ELSE
3390 # include "HALO_EM_CHEM_E_5.inc"
3391 END IF
3392 ELSE
3393 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3394 CALL wrf_error_fatal(TRIM(wrf_err_message))
3395 ENDIF
3396 endif
3397 if ( num_scalar >= PARAM_FIRST_SCALAR ) then
3398 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3399 IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
3400 # include "HALO_EM_SCALAR_E_5.inc"
3401 ELSE
3402 # include "HALO_EM_SCALAR_E_3.inc"
3403 END IF
3404 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3405 IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
3406 # include "HALO_EM_SCALAR_E_7.inc"
3407 ELSE
3408 # include "HALO_EM_SCALAR_E_5.inc"
3409 END IF
3410 ELSE
3411 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3412 CALL wrf_error_fatal(TRIM(wrf_err_message))
3413 ENDIF
3414 endif
3415 #endif
3416
3417 ENDIF rk_step_1_check
3418
3419
3420 !**********************************************************
3421 !
3422 ! end of RK predictor-corrector loop
3423 !
3424 !**********************************************************
3425
3426 END DO Runge_Kutta_loop
3427
3428 !$OMP PARALLEL DO &
3429 !$OMP PRIVATE ( ij )
3430
3431 DO ij = 1 , grid%num_tiles
3432
3433 BENCH_START(advance_ppt_tim)
3434 CALL wrf_debug ( 200 , ' call advance_ppt' )
3435 CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
3436 grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%nca, &
3437 grid%htop,grid%hbot,grid%cutop,grid%cubot, &
3438 grid%cuppt, config_flags, &
3439 ids,ide, jds,jde, kds,kde, &
3440 ims,ime, jms,jme, kms,kme, &
3441 grid%i_start(ij), grid%i_end(ij), &
3442 grid%j_start(ij), grid%j_end(ij), &
3443 k_start , k_end )
3444 BENCH_END(advance_ppt_tim)
3445
3446 ENDDO
3447 !$OMP END PARALLEL DO
3448
3449 !<DESCRIPTION>
3450 !<pre>
3451 ! (5) time-split physics.
3452 !
3453 ! Microphysics are the only time split physics in the WRF model
3454 ! at this time. Split-physics begins with the calculation of
3455 ! needed diagnostic quantities (pressure, temperature, etc.)
3456 ! followed by a call to the microphysics driver,
3457 ! and finishes with a clean-up, storing off of a diabatic tendency
3458 ! from the moist physics, and a re-calulation of the diagnostic
3459 ! quantities pressure and density.
3460 !</pre>
3461 !</DESCRIPTION>
3462
3463 IF (config_flags%mp_physics /= 0) then
3464
3465 IF( config_flags%specified .or. config_flags%nested ) THEN
3466 sz = grid%spec_zone
3467 ELSE
3468 sz = 0
3469 ENDIF
3470
3471 !$OMP PARALLEL DO &
3472 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3473
3474 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3475
3476 IF ( config_flags%periodic_x ) THEN
3477 its = max(grid%i_start(ij),ids)
3478 ite = min(grid%i_end(ij),ide-1)
3479 ELSE
3480 its = max(grid%i_start(ij),ids+sz)
3481 ite = min(grid%i_end(ij),ide-1-sz)
3482 ENDIF
3483 jts = max(grid%j_start(ij),jds+sz)
3484 jte = min(grid%j_end(ij),jde-1-sz)
3485
3486 CALL wrf_debug ( 200 , ' call moist_physics_prep' )
3487 BENCH_START(moist_physics_prep_tim)
3488 CALL moist_physics_prep_em( grid%em_t_2, grid%em_t_1, t0, rho, &
3489 grid%em_al, grid%em_alb, grid%em_p, p8w, p0, grid%em_pb, &
3490 grid%em_ph_2, grid%em_phb, th_phy, pi_phy, p_phy, &
3491 grid%em_z, z_at_w, dz8w, &
3492 dtm, grid%h_diabatic, &
3493 config_flags,grid%em_fnm, grid%em_fnp, &
3494 ids, ide, jds, jde, kds, kde, &
3495 ims, ime, jms, jme, kms, kme, &
3496 its, ite, jts, jte, &
3497 k_start , k_end )
3498 BENCH_END(moist_physics_prep_tim)
3499 END DO scalar_tile_loop_1a
3500 !$OMP END PARALLEL DO
3501
3502 CALL wrf_debug ( 200 , ' call microphysics_driver' )
3503
3504 grid%em_sr = 0.
3505 specified_bdy = config_flags%specified .OR. config_flags%nested
3506 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3507
3508 #if 0
3509 BENCH_START(microswap_1)
3510 ! for load balancing; communication to redistribute the points
3511 IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
3512 #include "SWAP_ETAMP_NEW.inc"
3513 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3514 #include "SWAP_WSM3.inc"
3515 ENDIF
3516 BENCH_END(microswap_1)
3517 #endif
3518
3519 BENCH_START(micro_driver_tim)
3520
3521 CALL microphysics_driver( &
3522 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3523 & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy &
3524 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3525 & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
3526 & ,RHO=rho ,SPEC_ZONE=grid%spec_zone &
3527 & ,SR=grid%em_sr ,TH=th_phy &
3528 & ,WARM_RAIN=grid%warm_rain &
3529 & ,T8W=t8w &
3530 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3531 & ,NSOURCE=grid%qndropsource &
3532 #ifdef WRF_CHEM
3533 & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
3534 & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
3535 & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
3536 #endif
3537 & ,XLAND=grid%xland &
3538 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3539 & ,F_RAIN_PHY=grid%f_rain_phy &
3540 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3541 & ,MP_PHYSICS=config_flags%mp_physics &
3542 & ,ID=grid%id &
3543 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3544 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3545 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3546 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3547 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3548 & ,NUM_TILES=grid%num_tiles &
3549 & ,NAER=grid%naer &
3550 ! Optional
3551 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3552 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3553 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv &
3554 & , W=grid%em_w_2, Z=grid%em_z, HT=grid%ht &
3555 & , MP_RESTART_STATE=grid%mp_restart_state &
3556 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3557 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3558 & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
3559 & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
3560 & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
3561 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
3562 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
3563 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
3564 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3565 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3566 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3567 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3568 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3569 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3570 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3571 & , qicuten=grid%rqicuten,mu=grid%em_mut &
3572 )
3573 BENCH_END(micro_driver_tim)
3574
3575 #if 0
3576 BENCH_START(microswap_2)
3577 ! for load balancing; communication to redistribute the points
3578 IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
3579 #include "SWAP_ETAMP_NEW.inc"
3580 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3581 #include "SWAP_WSM3.inc"
3582 ENDIF
3583 BENCH_END(microswap_2)
3584 #endif
3585
3586 CALL wrf_debug ( 200 , ' call moist_physics_finish' )
3587 BENCH_START(moist_phys_end_tim)
3588
3589 !$OMP PARALLEL DO &
3590 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3591
3592 DO ij = 1 , grid%num_tiles
3593
3594 IF ( config_flags%periodic_x ) THEN
3595 its = max(grid%i_start(ij),ids)
3596 ite = min(grid%i_end(ij),ide-1)
3597 ELSE
3598 its = max(grid%i_start(ij),ids+sz)
3599 ite = min(grid%i_end(ij),ide-1-sz)
3600 ENDIF
3601 jts = max(grid%j_start(ij),jds+sz)
3602 jte = min(grid%j_end(ij),jde-1-sz)
3603
3604 CALL microphysics_zero_out ( &
3605 moist , num_moist , config_flags , &
3606 ids, ide, jds, jde, kds, kde, &
3607 ims, ime, jms, jme, kms, kme, &
3608 its, ite, jts, jte, &
3609 k_start , k_end )
3610
3611
3612 CALL moist_physics_finish_em( grid%em_t_2, grid%em_t_1, t0, grid%em_muts, th_phy, &
3613 grid%h_diabatic, dtm, config_flags, &
3614 ids, ide, jds, jde, kds, kde, &
3615 ims, ime, jms, jme, kms, kme, &
3616 its, ite, jts, jte, &
3617 k_start , k_end )
3618
3619 END DO
3620 !$OMP END PARALLEL DO
3621
3622 ENDIF ! microphysics test
3623
3624 !-----------------------------------------------------------
3625 ! filter for moist variables post-microphysics and end of timestep
3626 !-----------------------------------------------------------
3627
3628 IF (config_flags%polar) THEN
3629 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3630 CALL wrf_debug ( 200 , ' call filter moist' )
3631 DO im = PARAM_FIRST_SCALAR, num_3d_m
3632 DO jj = jps, MIN(jpe,jde-1)
3633 DO kk = kps, MIN(kpe,kde-1)
3634 DO ii = ips, MIN(ipe,ide-1)
3635 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3636 END DO
3637 END DO
3638 END DO
3639
3640 CALL pxft ( grid=grid &
3641 ,lineno=__LINE__ &
3642 ,flag_uv = 0 &
3643 ,flag_rurv = 0 &
3644 ,flag_wph = 0 &
3645 ,flag_ww = 0 &
3646 ,flag_t = 0 &
3647 ,flag_mu = 0 &
3648 ,flag_mut = 0 &
3649 ,flag_moist = im &
3650 ,flag_chem = 0 &
3651 ,flag_scalar = 0 &
3652 ,positive_definite=.FALSE. &
3653 ,moist=moist,chem=chem,scalar=scalar &
3654 ,fft_filter_type = config_flags%fft_filter_type &
3655 ,dclat = dclat &
3656 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3657 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3658 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3659 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3660 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3661
3662 DO jj = jps, MIN(jpe,jde-1)
3663 DO kk = kps, MIN(kpe,kde-1)
3664 DO ii = ips, MIN(ipe,ide-1)
3665 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3666 END DO
3667 END DO
3668 END DO
3669 END DO
3670 END IF
3671 END IF
3672
3673 !-----------------------------------------------------------
3674 ! end filter for moist variables post-microphysics and end of timestep
3675 !-----------------------------------------------------------
3676
3677 !$OMP PARALLEL DO &
3678 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3679
3680 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
3681
3682 IF ( config_flags%periodic_x ) THEN
3683 its = max(grid%i_start(ij),ids)
3684 ite = min(grid%i_end(ij),ide-1)
3685 ELSE
3686 its = max(grid%i_start(ij),ids+sz)
3687 ite = min(grid%i_end(ij),ide-1-sz)
3688 ENDIF
3689 jts = max(grid%j_start(ij),jds+sz)
3690 jte = min(grid%j_end(ij),jde-1-sz)
3691
3692 CALL calc_p_rho_phi( moist, num_3d_m, &
3693 grid%em_al, grid%em_alb, grid%em_mu_2, grid%em_muts, &
3694 grid%em_ph_2, grid%em_p, grid%em_pb, grid%em_t_2, &
3695 p0, t0, grid%em_znu, grid%em_dnw, grid%em_rdnw, &
3696 grid%em_rdn, config_flags%non_hydrostatic, &
3697 ids, ide, jds, jde, kds, kde, &
3698 ims, ime, jms, jme, kms, kme, &
3699 its, ite, jts, jte, &
3700 k_start , k_end )
3701
3702 END DO scalar_tile_loop_1ba
3703 !$OMP END PARALLEL DO
3704 BENCH_END(moist_phys_end_tim)
3705
3706 IF (.not. config_flags%non_hydrostatic) THEN
3707 #ifdef DM_PARALLEL
3708 # include "HALO_EM_HYDRO_UV.inc"
3709 # include "PERIOD_EM_HYDRO_UV.inc"
3710 #endif
3711 !$OMP PARALLEL DO &
3712 !$OMP PRIVATE ( ij )
3713 DO ij = 1 , grid%num_tiles
3714 CALL diagnose_w( ph_tend, grid%em_ph_2, grid%em_ph_1, grid%em_w_2, grid%em_muts, dt_rk, &
3715 grid%em_u_2, grid%em_v_2, grid%ht, &
3716 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3717 ids, ide, jds, jde, kds, kde, &
3718 ims, ime, jms, jme, kms, kme, &
3719 grid%i_start(ij), grid%i_end(ij), &
3720 grid%j_start(ij), grid%j_end(ij), &
3721 k_start , k_end )
3722
3723 END DO
3724 !$OMP END PARALLEL DO
3725
3726 END IF
3727
3728 CALL wrf_debug ( 200 , ' call chem polar filter ' )
3729
3730 !-----------------------------------------------------------
3731 ! filter for chem and scalar variables at end of timestep
3732 !-----------------------------------------------------------
3733
3734 IF (config_flags%polar) THEN
3735
3736 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
3737 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
3738 DO jj = jps, MIN(jpe,jde-1)
3739 DO kk = kps, MIN(kpe,kde-1)
3740 DO ii = ips, MIN(ipe,ide-1)
3741 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3742 END DO
3743 END DO
3744 END DO
3745
3746 CALL pxft ( grid=grid &
3747 ,lineno=__LINE__ &
3748 ,flag_uv = 0 &
3749 ,flag_rurv = 0 &
3750 ,flag_wph = 0 &
3751 ,flag_ww = 0 &
3752 ,flag_t = 0 &
3753 ,flag_mu = 0 &
3754 ,flag_mut = 0 &
3755 ,flag_moist = 0 &
3756 ,flag_chem = im &
3757 ,flag_scalar = 0 &
3758 ,positive_definite=.FALSE. &
3759 ,moist=moist,chem=chem,scalar=scalar &
3760 ,fft_filter_type = config_flags%fft_filter_type &
3761 ,dclat = dclat &
3762 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3763 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3764 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3765 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3766 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3767
3768 DO jj = jps, MIN(jpe,jde-1)
3769 DO kk = kps, MIN(kpe,kde-1)
3770 DO ii = ips, MIN(ipe,ide-1)
3771 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3772 END DO
3773 END DO
3774 END DO
3775 END DO chem_filter_loop
3776 END IF
3777
3778 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
3779 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
3780 DO jj = jps, MIN(jpe,jde-1)
3781 DO kk = kps, MIN(kpe,kde-1)
3782 DO ii = ips, MIN(ipe,ide-1)
3783 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3784 END DO
3785 END DO
3786 END DO
3787
3788 CALL pxft ( grid=grid &
3789 ,lineno=__LINE__ &
3790 ,flag_uv = 0 &
3791 ,flag_rurv = 0 &
3792 ,flag_wph = 0 &
3793 ,flag_ww = 0 &
3794 ,flag_t = 0 &
3795 ,flag_mu = 0 &
3796 ,flag_mut = 0 &
3797 ,flag_moist = 0 &
3798 ,flag_chem = 0 &
3799 ,flag_scalar = im &
3800 ,positive_definite=.FALSE. &
3801 ,moist=moist,chem=chem,scalar=scalar &
3802 ,fft_filter_type = config_flags%fft_filter_type &
3803 ,dclat = dclat &
3804 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3805 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3806 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3807 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3808 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3809
3810 DO jj = jps, MIN(jpe,jde-1)
3811 DO kk = kps, MIN(kpe,kde-1)
3812 DO ii = ips, MIN(ipe,ide-1)
3813 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%em_mu_2(ii,jj)+grid%em_mub(ii,jj))
3814 END DO
3815 END DO
3816 END DO
3817 END DO scalar_filter_loop
3818 END IF
3819
3820 END IF
3821
3822 !-----------------------------------------------------------
3823 ! end filter for chem and scalar variables at end of timestep
3824 !-----------------------------------------------------------
3825
3826 ! We're finished except for boundary condition (and patch) update
3827
3828 ! Boundary condition time (or communication time). At this time, we have
3829 ! implemented periodic and symmetric physical boundary conditions.
3830
3831 ! b.c. routine for data within patch.
3832
3833 ! we need to do both time levels of
3834 ! data because the time filter only works in the physical solution space.
3835
3836 ! First, do patch communications for boundary conditions (periodicity)
3837
3838 !-----------------------------------------------------------
3839 ! Stencils for patch communications (WCS, 29 June 2001)
3840 !
3841 ! here's where we need a wide comm stencil - these are the
3842 ! uncoupled variables so are used for high order calc in
3843 ! advection and mixong routines.
3844 !
3845 ! * * * * *
3846 ! * * * * * * * * *
3847 ! * + * * + * * * + * *
3848 ! * * * * * * * * *
3849 ! * * * * *
3850 !
3851 ! grid%em_u_1 x
3852 ! grid%em_u_2 x
3853 ! grid%em_v_1 x
3854 ! grid%em_v_2 x
3855 ! grid%em_w_1 x
3856 ! grid%em_w_2 x
3857 ! grid%em_t_1 x
3858 ! grid%em_t_2 x
3859 ! grid%em_ph_1 x
3860 ! grid%em_ph_2 x
3861 ! grid%em_tke_1 x
3862 ! grid%em_tke_2 x
3863 !
3864 ! 2D variables
3865 ! grid%em_mu_1 x
3866 ! grid%em_mu_2 x
3867 !
3868 ! 4D variables
3869 ! moist x
3870 ! chem x
3871 ! scalar x
3872 !----------------------------------------------------------
3873
3874
3875 #ifdef DM_PARALLEL
3876 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3877 # include "HALO_EM_D3_3.inc"
3878 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3879 # include "HALO_EM_D3_5.inc"
3880 ELSE
3881 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3882 CALL wrf_error_fatal(TRIM(wrf_err_message))
3883 ENDIF
3884 # include "PERIOD_BDY_EM_D3.inc"
3885 # include "PERIOD_BDY_EM_MOIST.inc"
3886 # include "PERIOD_BDY_EM_CHEM.inc"
3887 # include "PERIOD_BDY_EM_SCALAR.inc"
3888 #endif
3889
3890 ! now set physical b.c on a patch
3891
3892 BENCH_START(bc_2d_tim)
3893 !$OMP PARALLEL DO &
3894 !$OMP PRIVATE ( ij )
3895
3896 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
3897
3898
3899 CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
3900
3901 CALL set_phys_bc_dry_2( config_flags, &
3902 grid%em_u_1, grid%em_u_2, grid%em_v_1, grid%em_v_2, grid%em_w_1, grid%em_w_2, &
3903 grid%em_t_1, grid%em_t_2, grid%em_ph_1, grid%em_ph_2, grid%em_mu_1, grid%em_mu_2, &
3904 ids, ide, jds, jde, kds, kde, &
3905 ims, ime, jms, jme, kms, kme, &
3906 ips, ipe, jps, jpe, kps, kpe, &
3907 grid%i_start(ij), grid%i_end(ij), &
3908 grid%j_start(ij), grid%j_end(ij), &
3909 k_start , k_end )
3910
3911 CALL set_physical_bc3d( grid%em_tke_1, 'p', config_flags, &
3912 ids, ide, jds, jde, kds, kde, &
3913 ims, ime, jms, jme, kms, kme, &
3914 ips, ipe, jps, jpe, kps, kpe, &
3915 grid%i_start(ij), grid%i_end(ij), &
3916 grid%j_start(ij), grid%j_end(ij), &
3917 k_start , k_end-1 )
3918 CALL set_physical_bc3d( grid%em_tke_2 , 'p', config_flags, &
3919 ids, ide, jds, jde, kds, kde, &
3920 ims, ime, jms, jme, kms, kme, &
3921 ips, ipe, jps, jpe, kps, kpe, &
3922 grid%i_start(ij), grid%i_end(ij), &
3923 grid%j_start(ij), grid%j_end(ij), &
3924 k_start , k_end )
3925
3926 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3927
3928 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
3929 config_flags, &
3930 ids, ide, jds, jde, kds, kde, &
3931 ims, ime, jms, jme, kms, kme, &
3932 ips, ipe, jps, jpe, kps, kpe, &
3933 grid%i_start(ij), grid%i_end(ij), &
3934 grid%j_start(ij), grid%j_end(ij), &
3935 k_start , k_end )
3936
3937 END DO moisture_loop_bdy_2
3938
3939 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3940
3941 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
3942 ids, ide, jds, jde, kds, kde, &
3943 ims, ime, jms, jme, kms, kme, &
3944 ips, ipe, jps, jpe, kps, kpe, &
3945 grid%i_start(ij), grid%i_end(ij), &
3946 grid%j_start(ij), grid%j_end(ij), &
3947 k_start , k_end )
3948
3949 END DO chem_species_bdy_loop_2
3950
3951 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3952
3953 CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags, &
3954 ids, ide, jds, jde, kds, kde, &
3955 ims, ime, jms, jme, kms, kme, &
3956 ips, ipe, jps, jpe, kps, kpe, &
3957 grid%i_start(ij), grid%i_end(ij), &
3958 grid%j_start(ij), grid%j_end(ij), &
3959 k_start , k_end )
3960
3961 END DO scalar_species_bdy_loop_2
3962
3963 END DO tile_bc_loop_2
3964 !$OMP END PARALLEL DO
3965 BENCH_END(bc_2d_tim)
3966
3967 IF( config_flags%specified .or. config_flags%nested ) THEN
3968 grid%dtbc = grid%dtbc + grid%dt
3969 ENDIF
3970
3971 ! calculate some model diagnostics.
3972
3973 CALL wrf_debug ( 200 , ' call diagnostic_driver' )
3974
3975 CALL diagnostic_output_calc( &
3976 & DPSDT=grid%dpsdt ,DMUDT=grid%dmudt &
3977 & ,P_PHY=p_phy ,PK1M=grid%pk1m &
3978 & ,MU_2=grid%em_mu_2 ,MU_2M=grid%mu_2m &
3979 & ,U=grid%em_u_2 ,V=grid%em_v_2 &
3980 & ,RAINCV=grid%raincv ,RAINNCV=grid%rainncv &
3981 & ,RAINC=grid%rainc ,RAINNC=grid%rainnc &
3982 & ,HFX=grid%hfx ,SFCEVP=grid%sfcevp ,LH=grid%lh &
3983 & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width &
3984 & ,XTIME=grid%xtime &
3985 ! Selection flag
3986 & ,DIAG_PRINT=config_flags%diag_print &
3987 ! Dimension arguments
3988 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3989 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3990 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3991 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3992 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3993 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3994 & ,NUM_TILES=grid%num_tiles &
3995 & )
3996
3997 #ifdef DM_PARALLEL
3998 !-----------------------------------------------------------------------
3999 ! see above
4000 !--------------------------------------------------------------
4001 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
4002 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4003 # include "HALO_EM_E_3.inc"
4004 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4005 # include "HALO_EM_E_5.inc"
4006 ELSE
4007 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4008 CALL wrf_error_fatal(TRIM(wrf_err_message))
4009 ENDIF
4010 #endif
4011
4012 #ifdef DM_PARALLEL
4013 if ( num_moist >= PARAM_FIRST_SCALAR ) then
4014 !-----------------------------------------------------------------------
4015 ! see above
4016 !--------------------------------------------------------------
4017 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
4018 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4019 # include "HALO_EM_MOIST_E_3.inc"
4020 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4021 # include "HALO_EM_MOIST_E_5.inc"
4022 ELSE
4023 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4024 CALL wrf_error_fatal(TRIM(wrf_err_message))
4025 ENDIF
4026 endif
4027 if ( num_chem >= PARAM_FIRST_SCALAR ) then
4028 !-----------------------------------------------------------------------
4029 ! see above
4030 !--------------------------------------------------------------
4031 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
4032 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4033 # include "HALO_EM_CHEM_E_3.inc"
4034 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4035 # include "HALO_EM_CHEM_E_5.inc"
4036 ELSE
4037 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4038 CALL wrf_error_fatal(TRIM(wrf_err_message))
4039 ENDIF
4040 endif
4041 if ( num_scalar >= PARAM_FIRST_SCALAR ) then
4042 !-----------------------------------------------------------------------
4043 ! see above
4044 !--------------------------------------------------------------
4045 CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
4046 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4047 # include "HALO_EM_SCALAR_E_3.inc"
4048 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4049 # include "HALO_EM_SCALAR_E_5.inc"
4050 ELSE
4051 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4052 CALL wrf_error_fatal(TRIM(wrf_err_message))
4053 ENDIF
4054 endif
4055 #endif
4056
4057 CALL wrf_debug ( 200 , ' call end of solve_em' )
4058
4059 ! Finish timers if compiled with -DBENCH.
4060 #include <bench_solve_em_end.h>
4061
4062 RETURN
4063
4064 END SUBROUTINE solve_em
4065