| blob | b15c694e0868953de01a878af21a4416e3f6fbe5 |
1 !WRF:MEDIATION_LAYER:SOLVER
3 SUBROUTINE solve_em ( grid , config_flags &
4 ! Arguments generated from Registry
5 #include "dummy_new_args.inc"
6 !
7 )
8 ! Driver layer modules
9 USE module_state_description
10 USE module_domain, ONLY : &
11 domain, get_ijk_from_grid, get_ijk_from_subgrid &
12 ,domain_get_current_time, domain_get_start_time &
13 ,domain_get_sim_start_time, domain_clock_get
14 USE module_domain_type, ONLY : history_alarm
15 USE module_configure, ONLY : grid_config_rec_type
16 USE module_driver_constants
17 USE module_machine
18 USE module_tiles, ONLY : set_tiles
19 #ifdef DM_PARALLEL
20 USE module_dm, ONLY : &
21 local_communicator, mytask, ntasks, ntasks_x, ntasks_y &
22 ,local_communicator_periodic, wrf_dm_maxval
23 USE module_comm_dm, ONLY : &
24 halo_em_a_sub,halo_em_b_sub,halo_em_c2_sub,halo_em_chem_e_3_sub &
25 ,halo_em_chem_e_5_sub,halo_em_chem_e_7_sub,halo_em_chem_old_e_5_sub &
26 ,halo_em_chem_old_e_7_sub,halo_em_c_sub,halo_em_d2_3_sub &
27 ,halo_em_d2_5_sub,halo_em_d3_3_sub,halo_em_d3_5_sub,halo_em_d_sub &
28 ,halo_em_e_3_sub,halo_em_e_5_sub,halo_em_hydro_uv_sub &
29 ,halo_em_moist_e_3_sub,halo_em_moist_e_5_sub,halo_em_moist_e_7_sub &
30 ,halo_em_moist_old_e_5_sub,halo_em_moist_old_e_7_sub &
31 ,halo_em_scalar_e_3_sub,halo_em_scalar_e_5_sub,halo_em_scalar_e_7_sub &
32 ,halo_em_scalar_old_e_5_sub,halo_em_scalar_old_e_7_sub,halo_em_tke_3_sub &
33 ,halo_em_tke_5_sub,halo_em_tke_7_sub,halo_em_tke_advect_3_sub &
34 ,halo_em_tke_advect_5_sub,halo_em_tke_old_e_5_sub &
35 ,halo_em_tke_old_e_7_sub,halo_em_tracer_e_3_sub,halo_em_tracer_e_5_sub &
36 ,halo_em_tracer_e_7_sub,halo_em_tracer_old_e_5_sub &
37 ,halo_em_tracer_old_e_7_sub,period_bdy_em_a_sub &
38 ,period_bdy_em_b3_sub,period_bdy_em_b_sub,period_bdy_em_chem2_sub &
39 ,period_bdy_em_chem_old_sub,period_bdy_em_chem_sub,period_bdy_em_d3_sub &
40 ,period_bdy_em_d_sub,period_bdy_em_e_sub,period_bdy_em_moist2_sub &
41 ,period_bdy_em_moist_old_sub,period_bdy_em_moist_sub &
42 ,period_bdy_em_scalar2_sub,period_bdy_em_scalar_old_sub &
43 ,period_bdy_em_scalar_sub,period_bdy_em_tke_old_sub &
44 ,period_bdy_em_tracer2_sub,period_bdy_em_tracer_old_sub &
45 ,period_bdy_em_tracer_sub,period_em_da_sub,period_em_hydro_uv_sub
46 #endif
47 USE module_utility
48 ! Mediation layer modules
49 ! Model layer modules
50 USE module_model_constants
51 USE module_small_step_em
52 USE module_em
53 USE module_big_step_utilities_em
54 USE module_bc
55 USE module_bc_em
56 USE module_solvedebug_em
57 USE module_physics_addtendc
58 USE module_diffusion_em
59 USE module_polarfft
60 USE module_microphysics_driver
61 USE module_microphysics_zero_out
62 USE module_fddaobs_driver
63 USE module_diagnostics
64 #ifdef WRF_CHEM
65 USE module_input_chem_data
66 USE module_input_tracer
67 USE module_chem_utilities
68 #endif
69 USE module_first_rk_step_part1
70 USE module_first_rk_step_part2
71 USE module_llxy, ONLY : proj_cassini
72 USE module_avgflx_em, ONLY : zero_avgflx, upd_avgflx
74 IMPLICIT NONE
76 ! Input data.
78 TYPE(domain) , TARGET :: grid
80 ! Definitions of dummy arguments to this routine (generated from Registry).
81 #include "dummy_new_decl.inc"
83 ! Structure that contains run-time configuration (namelist) data for domain
84 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
86 ! Local data
88 INTEGER :: k_start , k_end, its, ite, jts, jte
89 INTEGER :: ids , ide , jds , jde , kds , kde , &
90 ims , ime , jms , jme , kms , kme , &
91 ips , ipe , jps , jpe , kps , kpe
93 INTEGER :: sids , side , sjds , sjde , skds , skde , &
94 sims , sime , sjms , sjme , skms , skme , &
95 sips , sipe , sjps , sjpe , skps , skpe
98 INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
99 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
100 imsy, imey, jmsy, jmey, kmsy, kmey, &
101 ipsy, ipey, jpsy, jpey, kpsy, kpey
103 INTEGER :: ij , iteration
104 INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
105 INTEGER :: loop
106 INTEGER :: sz
107 INTEGER :: iswater
109 LOGICAL :: specified_bdy, channel_bdy
111 REAL :: t_new
113 ! Changes in tendency at this timestep
114 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
115 z_tendency
117 ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
118 LOGICAL :: tenddec
120 #ifdef WRF_CHEM
121 ! Index cross-referencing array for tendency accumulation
122 INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
123 #endif
125 ! storage for tendencies and decoupled state (generated from Registry)
127 #include <i1_decl.inc>
128 ! Previous time level of tracer arrays now defined as i1 variables;
129 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
130 ! Benefit: save memory in nested runs, since only 1 domain is active at a
131 ! time. Potential problem on stack-limited architectures: increases
132 ! amount of data on program stack by making these automatic arrays.
134 INTEGER :: rc
135 INTEGER :: number_of_small_timesteps, rk_step
136 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
137 INTEGER :: idum1, idum2, dynamics_option
139 INTEGER :: rk_order, iwmax, jwmax, kwmax
140 REAL :: dt_rk, dts_rk, dts, dtm, wmax
141 REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp
142 LOGICAL :: leapfrog
143 INTEGER :: l,kte,kk
144 LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd
145 REAL :: curr_secs
146 INTEGER :: num_sound_steps
147 INTEGER :: idex, jdex
148 REAL :: max_msft
149 REAL :: spacing
151 INTEGER :: ii, jj !kk is above after l,kte
152 REAL :: dclat
153 INTEGER :: debug_level
155 ! urban related variables
156 INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
158 TYPE(WRFU_TimeInterval) :: tmpTimeInterval
159 REAL :: real_time
160 LOGICAL :: adapt_step_flag
161 LOGICAL :: fill_w_flag
163 ! variables for flux-averaging code 20091223
164 CHARACTER*256 :: message, message2
165 REAL :: old_dt
166 TYPE(WRFU_Time) :: temp_time, CurrTime
167 INTEGER, PARAMETER :: precision = 100
168 INTEGER :: num, den
169 TYPE(WRFU_TimeInterval) :: dtInterval
171 ! Define benchmarking timers if -DBENCH is compiled
172 #include <bench_solve_em_def.h>
174 !----------------------
175 ! Executable statements
176 !----------------------
178 !<DESCRIPTION>
179 !<pre>
180 ! solve_em is the main driver for advancing a grid a single timestep.
181 ! It is a mediation-layer routine -> DM and SM calls are made where
182 ! needed for parallel processing.
183 !
184 ! solve_em can integrate the equations using 3 time-integration methods
185 !
186 ! - 3rd order Runge-Kutta time integration (recommended)
187 !
188 ! - 2nd order Runge-Kutta time integration
189 !
190 ! The main sections of solve_em are
191 !
192 ! (1) Runge-Kutta (RK) loop
193 !
194 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
195 ! model state variables during the first RK sub-step (loop)
196 !
197 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
198 !
199 ! (4) scalar advance for moist and chem scalar variables (and TKE)
200 ! within the RK sub-steps.
201 !
202 ! (5) time-split physics (after the RK step), currently this includes
203 ! only microphyics
204 !
205 ! A more detailed description of these sections follows.
206 !</pre>
207 !</DESCRIPTION>
209 ! Initialize timers if compiled with -DBENCH
210 #include <bench_solve_em_init.h>
212 ! set runge-kutta solver (2nd or 3rd order)
214 dynamics_option = config_flags%rk_ord
216 ! Obtain dimension information stored in the grid data structure.
218 CALL get_ijk_from_grid ( grid , &
219 ids, ide, jds, jde, kds, kde, &
220 ims, ime, jms, jme, kms, kme, &
221 ips, ipe, jps, jpe, kps, kpe, &
222 imsx, imex, jmsx, jmex, kmsx, kmex, &
223 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
224 imsy, imey, jmsy, jmey, kmsy, kmey, &
225 ipsy, ipey, jpsy, jpey, kpsy, kpey )
227 CALL get_ijk_from_subgrid ( grid , &
228 sids, side, sjds, sjde, skds, skde, &
229 sims, sime, sjms, sjme, skms, skme, &
230 sips, sipe, sjps, sjpe, skps, skpe )
231 k_start = kps
232 k_end = kpe
234 num_3d_m = num_moist
235 num_3d_c = num_chem
236 num_3d_s = num_scalar
238 f_flux = config_flags%do_avgflx_cugd .EQ. 1
240 ! Compute these starting and stopping locations for each tile and number of tiles.
241 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
242 CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
244 ! Max values of CFL for adaptive time step scheme
246 ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
247 ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
249 !
250 ! Calculate current time in seconds since beginning of model run.
251 ! Unfortunately, ESMF does not seem to have a way to return
252 ! floating point seconds based on a TimeInterval. So, we will
253 ! calculate it here--but, this is not clean!!
254 !
255 tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid )
256 curr_secs = real_time(tmpTimeInterval)
258 old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop
259 !-----------------------------------------------------------------------------
260 ! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07
261 ! In this call, we do the time-step adaptation and set time-dependent lateral
262 ! boundary condition nudging weights.
263 !
264 IF ( (config_flags%use_adaptive_time_step) .and. &
265 ( (.not. grid%nested) .or. &
266 ( (grid%nested) .and. (abs(grid%dtbc) < 0.0001) ) ) )THEN
267 CALL adapt_timestep(grid, config_flags)
268 adapt_step_flag = .TRUE.
269 ELSE
270 adapt_step_flag = .FALSE.
271 ENDIF
272 ! End of adaptive time step modifications
273 !-----------------------------------------------------------------------------
275 grid%itimestep = grid%itimestep + 1
277 IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
279 #ifdef WRF_CHEM
281 kte=min(k_end,kde-1)
282 # ifdef DM_PARALLEL
283 if ( num_chem >= PARAM_FIRST_SCALAR ) then
284 !-----------------------------------------------------------------------
285 ! see matching halo calls below for stencils
286 !--------------------------------------------------------------
287 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
288 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
289 # include "HALO_EM_CHEM_E_3.inc"
290 IF( config_flags%progn > 0 ) THEN
291 # include "HALO_EM_SCALAR_E_3.inc"
292 ENDIF
293 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
294 # include "HALO_EM_CHEM_E_5.inc"
295 IF( config_flags%progn > 0 ) THEN
296 # include "HALO_EM_SCALAR_E_5.inc"
297 ENDIF
298 ELSE
299 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
300 CALL wrf_error_fatal(TRIM(wrf_err_message))
301 ENDIF
302 ENDIF
303 if ( num_tracer >= PARAM_FIRST_SCALAR ) then
304 !-----------------------------------------------------------------------
305 ! see matching halo calls below for stencils
306 !--------------------------------------------------------------
307 CALL wrf_debug ( 200 , ' call HALO_RK_tracer' )
308 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
309 # include "HALO_EM_TRACER_E_3.inc"
310 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
311 # include "HALO_EM_TRACER_E_5.inc"
312 ELSE
313 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
314 CALL wrf_error_fatal(TRIM(wrf_err_message))
315 ENDIF
316 ENDIF
317 # endif
318 !--------------------------------------------------------------
319 adv_ct_indices( : ) = 1
320 IF ( config_flags%chemdiag == USECHEMDIAG ) THEN
321 ! modify tendency list here
322 ! note that the referencing direction here is opposite of that in chem_driver
323 adv_ct_indices(p_co ) = p_advh_co
324 adv_ct_indices(p_o3 ) = p_advh_o3
325 adv_ct_indices(p_no ) = p_advh_no
326 adv_ct_indices(p_no2 ) = p_advh_no2
327 adv_ct_indices(p_hno3) = p_advh_hno3
328 adv_ct_indices(p_iso ) = p_advh_iso
329 adv_ct_indices(p_ho ) = p_advh_ho
330 adv_ct_indices(p_ho2 ) = p_advh_ho2
331 END IF
332 #endif
334 rk_order = config_flags%rk_ord
336 IF ( grid%time_step_sound == 0 ) THEN
337 ! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
338 spacing = min(grid%dx, grid%dy)
339 IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
340 max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
341 1.0/COS(config_flags%fft_filter_lat*degrad) )
342 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
343 ELSE IF ( config_flags%use_adaptive_time_step ) THEN
344 max_msft= MAX(grid%max_msftx, grid%max_msfty)
345 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
346 ELSE
347 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 )
348 END IF
349 WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
350 CALL wrf_debug ( 50 , wrf_err_message )
351 ELSE
352 num_sound_steps = grid%time_step_sound
353 ENDIF
355 dts = grid%dt/float(num_sound_steps)
357 IF (config_flags%use_adaptive_time_step) THEN
359 CALL get_wrf_debug_level( debug_level )
360 IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
361 #ifdef DM_PARALLEL
362 CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
363 #endif
364 WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
365 grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
366 CALL wrf_debug ( 0 , wrf_err_message )
367 ENDIF
369 grid%max_cfl_val = 0
370 grid%max_horiz_cfl = 0
371 grid%max_vert_cfl = 0
372 ENDIF
374 ! setting bdy tendencies to zero for DFI if constant_bc = true
376 !$OMP PARALLEL DO &
377 !$OMP PRIVATE ( ij )
378 DO ij = 1 , grid%num_tiles
380 ! IF( config_flags%specified .AND. grid%dfi_opt .NE. DFI_NODFI &
381 ! .AND. config_flags%constant_bc .AND. (grid%dfi_stage .EQ. DFI_BCK .OR. grid%dfi_stage .EQ. DFI_FWD) ) THEN
382 IF( config_flags%specified .AND. config_flags%constant_bc ) THEN
384 CALL zero_bdytend (grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
385 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
386 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
387 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
388 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
389 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
390 moist_btxs,moist_btxe, &
391 moist_btys,moist_btye, &
392 grid%spec_bdy_width,num_3d_m, &
393 ids,ide, jds,jde, kds,kde, &
394 ims,ime, jms,jme, kms,kme, &
395 ips,ipe, jps,jpe, kps,kpe, &
396 grid%i_start(ij), grid%i_end(ij), &
397 grid%j_start(ij), grid%j_end(ij), &
398 k_start, k_end )
400 ENDIF
401 ENDDO
402 !$OMP END PARALLEL DO
404 !**********************************************************************
405 !
406 ! LET US BEGIN.......
407 !
408 !<DESCRIPTION>
409 !<pre>
410 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
411 !
412 ! Predictor-corrector type time integration.
413 ! Advection terms are evaluated at time t for the predictor step,
414 ! and advection is re-evaluated with the latest predicted value for
415 ! each succeeding time corrector step
416 !
417 ! 2nd order Runge Kutta (rk_order = 2):
418 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
419 !
420 ! 3rd order Runge Kutta (rk_order = 3):
421 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
422 ! and step 3 is from t to dt.
423 !
424 ! non-timesplit physics are evaluated during first RK step and
425 ! these physics tendencies are stored for use in each RK pass.
426 !</pre>
427 !</DESCRIPTION>
428 !**********************************************************************
430 Runge_Kutta_loop: DO rk_step = 1, rk_order
432 ! Set the step size and number of small timesteps for
433 ! each part of the timestep
435 dtm = grid%dt
436 IF ( rk_order == 1 ) THEN
438 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
439 CALL wrf_error_fatal( wrf_err_message )
441 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
443 IF ( rk_step == 1) THEN
444 dt_rk = 0.5*grid%dt
445 dts_rk = dts
446 number_of_small_timesteps = num_sound_steps/2
447 ELSE
448 dt_rk = grid%dt
449 dts_rk = dts
450 number_of_small_timesteps = num_sound_steps
451 ENDIF
453 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
455 IF ( rk_step == 1) THEN
456 dt_rk = grid%dt/3.
457 dts_rk = dt_rk
458 number_of_small_timesteps = 1
459 ELSE IF (rk_step == 2) THEN
460 dt_rk = 0.5*grid%dt
461 dts_rk = dts
462 number_of_small_timesteps = num_sound_steps/2
463 ELSE
464 dt_rk = grid%dt
465 dts_rk = dts
466 number_of_small_timesteps = num_sound_steps
467 ENDIF
469 ELSE
471 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
472 CALL wrf_error_fatal( wrf_err_message )
474 END IF
476 ! Ensure that polar meridional velocity is zero
477 IF (config_flags%polar) THEN
478 !$OMP PARALLEL DO &
479 !$OMP PRIVATE ( ij )
480 DO ij = 1 , grid%num_tiles
481 CALL zero_pole ( grid%v_1, &
482 ids, ide, jds, jde, kds, kde, &
483 ims, ime, jms, jme, kms, kme, &
484 grid%i_start(ij), grid%i_end(ij), &
485 grid%j_start(ij), grid%j_end(ij), &
486 k_start, k_end )
487 CALL zero_pole ( grid%v_2, &
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 END DO
494 !$OMP END PARALLEL DO
495 END IF
496 !
497 ! Time level t is in the *_2 variable in the first part
498 ! of the step, and in the *_1 variable after the predictor.
499 ! the latest predicted values are stored in the *_2 variables.
500 !
501 CALL wrf_debug ( 200 , ' call rk_step_prep ' )
503 BENCH_START(step_prep_tim)
504 !$OMP PARALLEL DO &
505 !$OMP PRIVATE ( ij )
507 DO ij = 1 , grid%num_tiles
509 CALL rk_step_prep ( config_flags, rk_step, &
510 grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, &
511 moist, &
512 grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, &
513 grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, &
514 cqu, cqv, cqw, &
515 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
516 grid%msfvy, grid%msftx, grid%msfty, &
517 grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
518 num_3d_m, &
519 ids, ide, jds, jde, kds, kde, &
520 ims, ime, jms, jme, kms, kme, &
521 grid%i_start(ij), grid%i_end(ij), &
522 grid%j_start(ij), grid%j_end(ij), &
523 k_start, k_end )
525 END DO
526 !$OMP END PARALLEL DO
527 BENCH_END(step_prep_tim)
529 #ifdef DM_PARALLEL
530 !-----------------------------------------------------------------------
531 ! Stencils for patch communications (WCS, 29 June 2001)
532 ! Note: the small size of this halo exchange reflects the
533 ! fact that we are carrying the uncoupled variables
534 ! as state variables in the mass coordinate model, as
535 ! opposed to the coupled variables as in the height
536 ! coordinate model.
537 !
538 ! * * * * *
539 ! * * * * * * * * *
540 ! * + * * + * * * + * *
541 ! * * * * * * * * *
542 ! * * * * *
543 !
544 ! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
545 !
546 ! ru x
547 ! rv x
548 ! ww x
549 ! php x
550 ! alt x
551 ! ph_2 x
552 ! phb x
553 !
554 ! the following are 2D (xy) variables
555 !
556 ! muu x
557 ! muv x
558 ! mut x
559 !--------------------------------------------------------------
560 # include "HALO_EM_A.inc"
561 #endif
563 ! set boundary conditions on variables
564 ! from big_step_prep for use in big_step_proc
566 #ifdef DM_PARALLEL
567 # include "PERIOD_BDY_EM_A.inc"
568 #endif
570 BENCH_START(set_phys_bc_tim)
571 !$OMP PARALLEL DO &
572 !$OMP PRIVATE ( ij, ii, jj, kk )
574 DO ij = 1 , grid%num_tiles
576 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
578 CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, &
579 grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, &
580 ids, ide, jds, jde, kds, kde, &
581 ims, ime, jms, jme, kms, kme, &
582 ips, ipe, jps, jpe, kps, kpe, &
583 grid%i_start(ij), grid%i_end(ij), &
584 grid%j_start(ij), grid%j_end(ij), &
585 k_start, k_end )
586 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
587 ids, ide, jds, jde, kds, kde, &
588 ims, ime, jms, jme, kms, kme, &
589 ips, ipe, jps, jpe, kps, kpe, &
590 grid%i_start(ij), grid%i_end(ij), &
591 grid%j_start(ij), grid%j_end(ij), &
592 k_start , k_end )
593 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
594 ids, ide, jds, jde, kds, kde, &
595 ims, ime, jms, jme, kms, kme, &
596 ips, ipe, jps, jpe, kps, kpe, &
597 grid%i_start(ij), grid%i_end(ij), &
598 grid%j_start(ij), grid%j_end(ij), &
599 k_start, k_end )
601 IF (config_flags%polar) THEN
603 !-------------------------------------------------------
604 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
605 !-------------------------------------------------------
607 CALL pole_point_bc ( grid%v_1, &
608 ids, ide, jds, jde, kds, kde, &
609 ims, ime, jms, jme, kms, kme, &
610 grid%i_start(ij), grid%i_end(ij), &
611 grid%j_start(ij), grid%j_end(ij), &
612 k_start, k_end )
614 CALL pole_point_bc ( grid%v_2, &
615 ids, ide, jds, jde, kds, kde, &
616 ims, ime, jms, jme, kms, kme, &
617 grid%i_start(ij), grid%i_end(ij), &
618 grid%j_start(ij), grid%j_end(ij), &
619 k_start, k_end )
621 !-------------------------------------------------------
622 ! end lat-lon grid pole-point (v) specification
623 !-------------------------------------------------------
625 ENDIF
626 END DO
627 !$OMP END PARALLEL DO
628 BENCH_END(set_phys_bc_tim)
630 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
632 !<DESCRIPTION>
633 !<pre>
634 !(2) The non-timesplit physics begins with a call to "phy_prep"
635 ! (which computes some diagnostic variables such as temperature,
636 ! pressure, u and v at p points, etc). This is followed by
637 ! calls to the physics drivers:
638 !
639 ! radiation,
640 ! surface,
641 ! pbl,
642 ! cumulus,
643 ! fddagd,
644 ! 3D TKE and mixing.
645 !<pre>
646 !</DESCRIPTION>
648 CALL first_rk_step_part1 ( grid, config_flags &
649 , moist , moist_tend &
650 , chem , chem_tend &
651 , tracer, tracer_tend &
652 , scalar , scalar_tend &
653 , fdda3d, fdda2d &
654 , ru_tendf, rv_tendf &
655 , rw_tendf, t_tendf &
656 , ph_tendf, mu_tendf &
657 , tke_tend &
658 , adapt_step_flag , curr_secs &
659 , psim , psih , wspd , gz1oz0 &
660 , br , chklowq &
661 , cu_act_flag , hol , th_phy &
662 , pi_phy , p_phy , grid%t_phy &
663 , u_phy , v_phy &
664 , dz8w , p8w , t8w , rho_phy , rho &
665 , ids, ide, jds, jde, kds, kde &
666 , ims, ime, jms, jme, kms, kme &
667 , ips, ipe, jps, jpe, kps, kpe &
668 , imsx, imex, jmsx, jmex, kmsx, kmex &
669 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
670 , imsy, imey, jmsy, jmey, kmsy, kmey &
671 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
672 , k_start , k_end &
673 , f_flux &
674 )
676 #ifdef DM_PARALLEL
677 IF ( config_flags%bl_pbl_physics == MYNNPBLSCHEME2 .OR. &
678 config_flags%bl_pbl_physics == MYNNPBLSCHEME3 ) THEN
679 # include "HALO_EM_SCALAR_E_5.inc"
680 ENDIF
681 #endif
683 CALL first_rk_step_part2 ( grid, config_flags &
684 , moist , moist_tend &
685 , chem , chem_tend &
686 , tracer, tracer_tend &
687 , scalar , scalar_tend &
688 , fdda3d, fdda2d &
689 , ru_tendf, rv_tendf &
690 , rw_tendf, t_tendf &
691 , ph_tendf, mu_tendf &
692 , tke_tend &
693 , adapt_step_flag , curr_secs &
694 , psim , psih , wspd , gz1oz0 &
695 , br , chklowq &
696 , cu_act_flag , hol , th_phy &
697 , pi_phy , p_phy , grid%t_phy &
698 , u_phy , v_phy &
699 , dz8w , p8w , t8w , rho_phy , rho &
700 , nba_mij, num_nba_mij & !JDM
701 , nba_rij, num_nba_rij & !JDM
702 , ids, ide, jds, jde, kds, kde &
703 , ims, ime, jms, jme, kms, kme &
704 , ips, ipe, jps, jpe, kps, kpe &
705 , k_start , k_end &
706 )
708 END IF rk_step_is_one
710 BENCH_START(rk_tend_tim)
711 !$OMP PARALLEL DO &
712 !$OMP PRIVATE ( ij )
713 DO ij = 1 , grid%num_tiles
715 CALL wrf_debug ( 200 , ' call rk_tendency' )
716 CALL rk_tendency ( config_flags, rk_step &
717 ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend &
718 ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf &
719 ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save &
720 ,grid%t_save, mu_save, grid%rthften &
721 ,grid%ru, grid%rv, grid%rw, grid%ww &
722 ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2 &
723 ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1 &
724 ,grid%h_diabatic, grid%phb, grid%t_init &
725 ,grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub &
726 ,grid%al, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw &
727 ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base &
728 ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv &
729 ,grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa &
730 ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw &
731 ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh &
732 ,grid%diff_6th_opt, grid%diff_6th_factor &
733 ,grid%dampcoef,grid%zdamp,config_flags%damp_opt &
734 ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m &
735 ,config_flags%non_hydrostatic, config_flags%top_lid &
736 ,grid%u_frame, grid%v_frame &
737 ,ids, ide, jds, jde, kds, kde &
738 ,ims, ime, jms, jme, kms, kme &
739 ,grid%i_start(ij), grid%i_end(ij) &
740 ,grid%j_start(ij), grid%j_end(ij) &
741 ,k_start, k_end &
742 ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
743 END DO
744 !$OMP END PARALLEL DO
745 BENCH_END(rk_tend_tim)
747 IF (config_flags%use_adaptive_time_step) THEN
748 DO ij = 1 , grid%num_tiles
749 IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
750 grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
751 ENDIF
752 IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
753 grid%max_vert_cfl = max_vert_cfl_tmp(ij)
754 ENDIF
755 END DO
757 IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
758 grid%max_cfl_val = grid%max_horiz_cfl
759 ENDIF
760 IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
761 grid%max_cfl_val = grid%max_vert_cfl
762 ENDIF
763 ENDIF
765 BENCH_START(relax_bdy_dry_tim)
766 !$OMP PARALLEL DO &
767 !$OMP PRIVATE ( ij )
768 DO ij = 1 , grid%num_tiles
770 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
772 CALL relax_bdy_dry ( config_flags, &
773 grid%u_save, grid%v_save, ph_save, grid%t_save, &
774 w_save, mu_tend, &
775 grid%ru, grid%rv, grid%ph_2, grid%t_2, &
776 grid%w_2, grid%mu_2, grid%mut, &
777 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
778 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
779 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
780 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
781 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
782 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
783 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
784 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
785 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
786 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
787 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
788 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
789 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
790 grid%dtbc, grid%fcx, grid%gcx, &
791 ids,ide, jds,jde, kds,kde, &
792 ims,ime, jms,jme, kms,kme, &
793 ips,ipe, jps,jpe, kps,kpe, &
794 grid%i_start(ij), grid%i_end(ij), &
795 grid%j_start(ij), grid%j_end(ij), &
796 k_start, k_end )
798 ENDIF
800 CALL rk_addtend_dry( grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend, &
801 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
802 grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
803 mu_tend, mu_tendf, rk_step, &
804 grid%h_diabatic, grid%mut, grid%msftx, &
805 grid%msfty, grid%msfux,grid%msfuy, &
806 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
807 ids,ide, jds,jde, kds,kde, &
808 ims,ime, jms,jme, kms,kme, &
809 ips,ipe, jps,jpe, kps,kpe, &
810 grid%i_start(ij), grid%i_end(ij), &
811 grid%j_start(ij), grid%j_end(ij), &
812 k_start, k_end )
814 IF( config_flags%specified .or. config_flags%nested ) THEN
815 CALL spec_bdy_dry ( config_flags, &
816 grid%ru_tend, grid%rv_tend, ph_tend, t_tend, &
817 rw_tend, mu_tend, &
818 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
819 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
820 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
821 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
822 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
823 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
824 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
825 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
826 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
827 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
828 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
829 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
830 config_flags%spec_bdy_width, grid%spec_zone, &
831 ids,ide, jds,jde, kds,kde, & ! domain dims
832 ims,ime, jms,jme, kms,kme, & ! memory dims
833 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
834 grid%i_start(ij), grid%i_end(ij), &
835 grid%j_start(ij), grid%j_end(ij), &
836 k_start, k_end )
838 ENDIF
840 END DO
841 !$OMP END PARALLEL DO
842 BENCH_END(relax_bdy_dry_tim)
844 !<DESCRIPTION>
845 !<pre>
846 ! (3) Small (acoustic,sound) steps.
847 !
848 ! Several acoustic steps are taken each RK pass. A small step
849 ! sequence begins with calculating perturbation variables
850 ! and coupling them to the column dry-air-mass mu
851 ! (call to small_step_prep). This is followed by computing
852 ! coefficients for the vertically implicit part of the
853 ! small timestep (call to calc_coef_w).
854 !
855 ! The small steps are taken
856 ! in the named loop "small_steps:". In the small_steps loop, first
857 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
858 ! next mu and theta are advanced (call to advance_mu_t) followed by
859 ! advancing w and the geopotential (call to advance_w). Diagnostic
860 ! values for pressure and inverse density are updated at the end of
861 ! each small_step.
862 !
863 ! The small-step section ends with the change of the perturbation variables
864 ! back to full variables (call to small_step_finish).
865 !</pre>
866 !</DESCRIPTION>
868 BENCH_START(small_step_prep_tim)
869 !$OMP PARALLEL DO &
870 !$OMP PRIVATE ( ij )
871 DO ij = 1 , grid%num_tiles
873 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
874 ! integration. We only need calculate these for the first pass through -
875 ! the predictor step. They are reused as is for the corrector step.
876 ! For third-order RK, we need to recompute these after the first
877 ! predictor because we may have changed the small timestep -> grid%dts.
879 CALL wrf_debug ( 200 , ' call small_step_prep ' )
881 CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2, &
882 grid%t_1,grid%t_2,grid%ph_1,grid%ph_2, &
883 grid%mub, grid%mu_1, grid%mu_2, &
884 grid%muu, muus, grid%muv, muvs, &
885 grid%mut, grid%muts, grid%mudf, &
886 grid%u_save, grid%v_save, w_save, &
887 grid%t_save, ph_save, mu_save, &
888 grid%ww, ww1, &
889 grid%dnw, c2a, grid%pb, grid%p, grid%alt, &
890 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
891 grid%msfvy, grid%msftx,grid%msfty, &
892 grid%rdx, grid%rdy, rk_step, &
893 ids, ide, jds, jde, kds, kde, &
894 ims, ime, jms, jme, kms, kme, &
895 grid%i_start(ij), grid%i_end(ij), &
896 grid%j_start(ij), grid%j_end(ij), &
897 k_start , k_end )
899 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
900 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
901 grid%mu_2, grid%muts, grid%znu, t0, &
902 grid%rdnw, grid%dnw, grid%smdiv, &
903 config_flags%non_hydrostatic, 0, &
904 ids, ide, jds, jde, kds, kde, &
905 ims, ime, jms, jme, kms, kme, &
906 grid%i_start(ij), grid%i_end(ij), &
907 grid%j_start(ij), grid%j_end(ij), &
908 k_start , k_end )
910 IF (config_flags%non_hydrostatic) THEN
911 CALL calc_coef_w( a,alpha,gamma, &
912 grid%mut, cqw, &
913 grid%rdn, grid%rdnw, c2a, &
914 dts_rk, g, grid%epssm, &
915 config_flags%top_lid, &
916 ids, ide, jds, jde, kds, kde, &
917 ims, ime, jms, jme, kms, kme, &
918 grid%i_start(ij), grid%i_end(ij), &
919 grid%j_start(ij), grid%j_end(ij), &
920 k_start , k_end )
921 ENDIF
923 ENDDO
924 !$OMP END PARALLEL DO
925 BENCH_END(small_step_prep_tim)
927 #ifdef DM_PARALLEL
928 !-----------------------------------------------------------------------
929 ! Stencils for patch communications (WCS, 29 June 2001)
930 ! Note: the small size of this halo exchange reflects the
931 ! fact that we are carrying the uncoupled variables
932 ! as state variables in the mass coordinate model, as
933 ! opposed to the coupled variables as in the height
934 ! coordinate model.
935 !
936 ! * * * * *
937 ! * * * * * * * * *
938 ! * + * * + * * * + * *
939 ! * * * * * * * * *
940 ! * * * * *
941 !
942 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
943 !
944 ! ph_2 x
945 ! al x
946 ! p x
947 ! t_1 x
948 ! t_save x
949 ! u_save x
950 ! v_save x
951 !
952 ! the following are 2D (xy) variables
953 !
954 ! mu_1 x
955 ! mu_2 x
956 ! mudf x
957 ! php x
958 ! alt x
959 ! pb x
960 !--------------------------------------------------------------
961 # include "HALO_EM_B.inc"
962 # include "PERIOD_BDY_EM_B.inc"
963 #endif
965 BENCH_START(set_phys_bc2_tim)
966 !$OMP PARALLEL DO &
967 !$OMP PRIVATE ( ij )
969 DO ij = 1 , grid%num_tiles
971 CALL set_physical_bc3d( grid%ru_tend, 'u', 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 )
979 CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags, &
980 ids, ide, jds, jde, kds, kde, &
981 ims, ime, jms, jme, kms, kme, &
982 ips, ipe, jps, jpe, kps, kpe, &
983 grid%i_start(ij), grid%i_end(ij), &
984 grid%j_start(ij), grid%j_end(ij), &
985 k_start , k_end )
987 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
988 ids, ide, jds, jde, kds, kde, &
989 ims, ime, jms, jme, kms, kme, &
990 ips, ipe, jps, jpe, kps, kpe, &
991 grid%i_start(ij), grid%i_end(ij), &
992 grid%j_start(ij), grid%j_end(ij), &
993 k_start , k_end )
995 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
996 ids, ide, jds, jde, kds, kde, &
997 ims, ime, jms, jme, kms, kme, &
998 ips, ipe, jps, jpe, kps, kpe, &
999 grid%i_start(ij), grid%i_end(ij), &
1000 grid%j_start(ij), grid%j_end(ij), &
1001 k_start , k_end )
1003 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1004 ids, ide, jds, jde, kds, kde, &
1005 ims, ime, jms, jme, kms, kme, &
1006 ips, ipe, jps, jpe, kps, kpe, &
1007 grid%i_start(ij), grid%i_end(ij), &
1008 grid%j_start(ij), grid%j_end(ij), &
1009 k_start , k_end )
1011 CALL set_physical_bc3d( grid%t_1, 'p', config_flags, &
1012 ids, ide, jds, jde, kds, kde, &
1013 ims, ime, jms, jme, kms, kme, &
1014 ips, ipe, jps, jpe, kps, kpe, &
1015 grid%i_start(ij), grid%i_end(ij), &
1016 grid%j_start(ij), grid%j_end(ij), &
1017 k_start , k_end )
1019 CALL set_physical_bc3d( grid%t_save, 't', config_flags, &
1020 ids, ide, jds, jde, kds, kde, &
1021 ims, ime, jms, jme, kms, kme, &
1022 ips, ipe, jps, jpe, kps, kpe, &
1023 grid%i_start(ij), grid%i_end(ij), &
1024 grid%j_start(ij), grid%j_end(ij), &
1025 k_start , k_end )
1027 CALL set_physical_bc2d( grid%mu_1, 't', config_flags, &
1028 ids, ide, jds, jde, &
1029 ims, ime, jms, jme, &
1030 ips, ipe, jps, jpe, &
1031 grid%i_start(ij), grid%i_end(ij), &
1032 grid%j_start(ij), grid%j_end(ij) )
1034 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1035 ids, ide, jds, jde, &
1036 ims, ime, jms, jme, &
1037 ips, ipe, jps, jpe, &
1038 grid%i_start(ij), grid%i_end(ij), &
1039 grid%j_start(ij), grid%j_end(ij) )
1041 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1042 ids, ide, jds, jde, &
1043 ims, ime, jms, jme, &
1044 ips, ipe, jps, jpe, &
1045 grid%i_start(ij), grid%i_end(ij), &
1046 grid%j_start(ij), grid%j_end(ij) )
1048 END DO
1049 !$OMP END PARALLEL DO
1050 BENCH_END(set_phys_bc2_tim)
1051 small_steps : DO iteration = 1 , number_of_small_timesteps
1053 ! Boundary condition time (or communication time).
1054 #ifdef DM_PARALLEL
1055 # include "PERIOD_BDY_EM_B.inc"
1056 #endif
1058 !$OMP PARALLEL DO &
1059 !$OMP PRIVATE ( ij )
1061 DO ij = 1 , grid%num_tiles
1063 BENCH_START(advance_uv_tim)
1064 CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend, &
1065 grid%p, grid%pb, &
1066 grid%ph_2, grid%php, grid%alt, grid%al, &
1067 grid%mu_2, &
1068 grid%muu, cqu, grid%muv, cqv, grid%mudf, &
1069 grid%msfux, grid%msfuy, grid%msfvx, &
1070 grid%msfvx_inv, grid%msfvy, &
1071 grid%rdx, grid%rdy, dts_rk, &
1072 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
1073 grid%emdiv, &
1074 grid%rdnw, config_flags,grid%spec_zone, &
1075 config_flags%non_hydrostatic, config_flags%top_lid, &
1076 ids, ide, jds, jde, kds, kde, &
1077 ims, ime, jms, jme, kms, kme, &
1078 grid%i_start(ij), grid%i_end(ij), &
1079 grid%j_start(ij), grid%j_end(ij), &
1080 k_start , k_end )
1081 BENCH_END(advance_uv_tim)
1083 END DO
1084 !$OMP END PARALLEL DO
1086 !-----------------------------------------------------------
1087 ! acoustic integration polar filter for smallstep u, v
1088 !-----------------------------------------------------------
1090 IF (config_flags%polar) THEN
1092 CALL pxft ( grid=grid &
1093 ,lineno=__LINE__ &
1094 ,flag_uv = 1 &
1095 ,flag_rurv = 0 &
1096 ,flag_wph = 0 &
1097 ,flag_ww = 0 &
1098 ,flag_t = 0 &
1099 ,flag_mu = 0 &
1100 ,flag_mut = 0 &
1101 ,flag_moist = 0 &
1102 ,flag_chem = 0 &
1103 ,flag_tracer = 0 &
1104 ,flag_scalar = 0 &
1105 ,positive_definite = .FALSE. &
1106 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1107 ,fft_filter_lat = config_flags%fft_filter_lat &
1108 ,dclat = dclat &
1109 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1110 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1111 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1112 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1113 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1115 END IF
1117 !-----------------------------------------------------------
1118 ! end acoustic integration polar filter for smallstep u, v
1119 !-----------------------------------------------------------
1121 !$OMP PARALLEL DO &
1122 !$OMP PRIVATE ( ij )
1123 DO ij = 1 , grid%num_tiles
1125 BENCH_START(spec_bdy_uv_tim)
1126 IF( config_flags%specified .or. config_flags%nested ) THEN
1127 CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk, &
1128 'u' , config_flags, &
1129 grid%spec_zone, &
1130 ids,ide, jds,jde, kds,kde, & ! domain dims
1131 ims,ime, jms,jme, kms,kme, & ! memory dims
1132 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1133 grid%i_start(ij), grid%i_end(ij), &
1134 grid%j_start(ij), grid%j_end(ij), &
1135 k_start , k_end )
1137 CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk, &
1138 'v' , config_flags, &
1139 grid%spec_zone, &
1140 ids,ide, jds,jde, kds,kde, & ! domain dims
1141 ims,ime, jms,jme, kms,kme, & ! memory dims
1142 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1143 grid%i_start(ij), grid%i_end(ij), &
1144 grid%j_start(ij), grid%j_end(ij), &
1145 k_start , k_end )
1147 ENDIF
1148 BENCH_END(spec_bdy_uv_tim)
1150 END DO
1151 !$OMP END PARALLEL DO
1153 #ifdef DM_PARALLEL
1154 !
1155 ! Stencils for patch communications (WCS, 29 June 2001)
1156 !
1157 ! * *
1158 ! * + * * + * +
1159 ! * *
1160 !
1161 ! u_2 x
1162 ! v_2 x
1163 !
1164 # include "HALO_EM_C.inc"
1165 #endif
1167 !$OMP PARALLEL DO &
1168 !$OMP PRIVATE ( ij )
1169 DO ij = 1 , grid%num_tiles
1171 ! advance the mass in the column, theta, and calculate ww
1173 BENCH_START(advance_mu_t_tim)
1174 CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
1175 grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv, &
1176 grid%mudf, grid%ru_m, grid%rv_m, grid%ww_m, &
1177 grid%t_2, grid%t_save, t_2save, t_tend, &
1178 mu_tend, &
1179 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1180 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1181 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1182 grid%msfvy, grid%msftx,grid%msfty, &
1183 iteration, config_flags, &
1184 ids, ide, jds, jde, kds, kde, &
1185 ims, ime, jms, jme, kms, kme, &
1186 grid%i_start(ij), grid%i_end(ij), &
1187 grid%j_start(ij), grid%j_end(ij), &
1188 k_start , k_end )
1189 BENCH_END(advance_mu_t_tim)
1190 ENDDO
1191 !$OMP END PARALLEL DO
1193 !-----------------------------------------------------------
1194 ! acoustic integration polar filter for smallstep mu, t
1195 !-----------------------------------------------------------
1197 IF ( (config_flags%polar) ) THEN
1199 CALL pxft ( grid=grid &
1200 ,lineno=__LINE__ &
1201 ,flag_uv = 0 &
1202 ,flag_rurv = 0 &
1203 ,flag_wph = 0 &
1204 ,flag_ww = 0 &
1205 ,flag_t = 1 &
1206 ,flag_mu = 1 &
1207 ,flag_mut = 0 &
1208 ,flag_moist = 0 &
1209 ,flag_chem = 0 &
1210 ,flag_tracer = 0 &
1211 ,flag_scalar = 0 &
1212 ,positive_definite = .FALSE. &
1213 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1214 ,fft_filter_lat = config_flags%fft_filter_lat &
1215 ,dclat = dclat &
1216 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1217 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1218 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1219 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1220 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1222 grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1224 END IF
1226 !-----------------------------------------------------------
1227 ! end acoustic integration polar filter for smallstep mu, t
1228 !-----------------------------------------------------------
1230 BENCH_START(spec_bdy_t_tim)
1232 !$OMP PARALLEL DO &
1233 !$OMP PRIVATE ( ij )
1234 DO ij = 1 , grid%num_tiles
1236 IF( config_flags%specified .or. config_flags%nested ) THEN
1238 CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk, &
1239 't' , config_flags, &
1240 grid%spec_zone, &
1241 ids,ide, jds,jde, kds,kde, &
1242 ims,ime, jms,jme, kms,kme, &
1243 ips,ipe, jps,jpe, kps,kpe, &
1244 grid%i_start(ij), grid%i_end(ij),&
1245 grid%j_start(ij), grid%j_end(ij),&
1246 k_start , k_end )
1248 CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk, &
1249 'm' , config_flags, &
1250 grid%spec_zone, &
1251 ids,ide, jds,jde, 1 ,1 , &
1252 ims,ime, jms,jme, 1 ,1 , &
1253 ips,ipe, jps,jpe, 1 ,1 , &
1254 grid%i_start(ij), grid%i_end(ij),&
1255 grid%j_start(ij), grid%j_end(ij),&
1256 1 , 1 )
1258 CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk, &
1259 'm' , config_flags, &
1260 grid%spec_zone, &
1261 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1262 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1263 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1264 grid%i_start(ij), grid%i_end(ij), &
1265 grid%j_start(ij), grid%j_end(ij), &
1266 1 , 1 )
1267 ENDIF
1268 BENCH_END(spec_bdy_t_tim)
1270 ! small (acoustic) step for the vertical momentum,
1271 ! density and coupled potential temperature.
1274 BENCH_START(advance_w_tim)
1275 IF ( config_flags%non_hydrostatic ) THEN
1276 CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save, &
1277 grid%u_2, grid%v_2, &
1278 grid%mu_2, grid%mut, muave, grid%muts, &
1279 t_2save, grid%t_2, grid%t_save, &
1280 grid%ph_2, ph_save, grid%phb, ph_tend, &
1281 grid%ht, c2a, cqw, grid%alt, grid%alb, &
1282 a, alpha, gamma, &
1283 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1284 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1285 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1286 grid%msftx, grid%msfty, &
1287 config_flags, config_flags%top_lid, &
1288 ids,ide, jds,jde, kds,kde, &
1289 ims,ime, jms,jme, kms,kme, &
1290 grid%i_start(ij), grid%i_end(ij), &
1291 grid%j_start(ij), grid%j_end(ij), &
1292 k_start , k_end )
1293 ENDIF
1294 BENCH_END(advance_w_tim)
1296 ENDDO
1297 !$OMP END PARALLEL DO
1299 !-----------------------------------------------------------
1300 ! acoustic integration polar filter for smallstep w, geopotential
1301 !-----------------------------------------------------------
1303 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1305 CALL pxft ( grid=grid &
1306 ,lineno=__LINE__ &
1307 ,flag_uv = 0 &
1308 ,flag_rurv = 0 &
1309 ,flag_wph = 1 &
1310 ,flag_ww = 0 &
1311 ,flag_t = 0 &
1312 ,flag_mu = 0 &
1313 ,flag_mut = 0 &
1314 ,flag_moist = 0 &
1315 ,flag_chem = 0 &
1316 ,flag_tracer = 0 &
1317 ,flag_scalar = 0 &
1318 ,positive_definite = .FALSE. &
1319 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1320 ,fft_filter_lat = config_flags%fft_filter_lat &
1321 ,dclat = dclat &
1322 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1323 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1324 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1325 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1326 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1328 END IF
1330 !-----------------------------------------------------------
1331 ! end acoustic integration polar filter for smallstep w, geopotential
1332 !-----------------------------------------------------------
1334 !$OMP PARALLEL DO &
1335 !$OMP PRIVATE ( ij )
1336 DO ij = 1 , grid%num_tiles
1338 BENCH_START(sumflux_tim)
1339 CALL sumflux ( grid%u_2, grid%v_2, grid%ww, &
1340 grid%u_save, grid%v_save, ww1, &
1341 grid%muu, grid%muv, &
1342 grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm, &
1343 grid%msfux, grid% msfuy, grid%msfvx, &
1344 grid%msfvx_inv, grid%msfvy, &
1345 iteration, number_of_small_timesteps, &
1346 ids, ide, jds, jde, kds, kde, &
1347 ims, ime, jms, jme, kms, kme, &
1348 grid%i_start(ij), grid%i_end(ij), &
1349 grid%j_start(ij), grid%j_end(ij), &
1350 k_start , k_end )
1351 BENCH_END(sumflux_tim)
1353 IF( config_flags%specified .or. config_flags%nested ) THEN
1355 BENCH_START(spec_bdynhyd_tim)
1356 IF (config_flags%non_hydrostatic) THEN
1357 CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend, &
1358 mu_tend, grid%muts, dts_rk, &
1359 'h' , config_flags, &
1360 grid%spec_zone, &
1361 ids,ide, jds,jde, kds,kde, &
1362 ims,ime, jms,jme, kms,kme, &
1363 ips,ipe, jps,jpe, kps,kpe, &
1364 grid%i_start(ij), grid%i_end(ij),&
1365 grid%j_start(ij), grid%j_end(ij),&
1366 k_start , k_end )
1367 IF( config_flags%specified ) THEN
1368 CALL zero_grad_bdy ( grid%w_2, &
1369 'w' , config_flags, &
1370 grid%spec_zone, &
1371 ids,ide, jds,jde, kds,kde, &
1372 ims,ime, jms,jme, kms,kme, &
1373 ips,ipe, jps,jpe, kps,kpe, &
1374 grid%i_start(ij), grid%i_end(ij), &
1375 grid%j_start(ij), grid%j_end(ij), &
1376 k_start , k_end )
1377 ELSE
1378 CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk, &
1379 'h' , config_flags, &
1380 grid%spec_zone, &
1381 ids,ide, jds,jde, kds,kde, &
1382 ims,ime, jms,jme, kms,kme, &
1383 ips,ipe, jps,jpe, kps,kpe, &
1384 grid%i_start(ij), grid%i_end(ij),&
1385 grid%j_start(ij), grid%j_end(ij),&
1386 k_start , k_end )
1387 ENDIF
1388 ENDIF
1389 BENCH_END(spec_bdynhyd_tim)
1390 ENDIF
1392 BENCH_START(cald_p_rho_tim)
1393 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1394 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1395 grid%mu_2, grid%muts, grid%znu, t0, &
1396 grid%rdnw, grid%dnw, grid%smdiv, &
1397 config_flags%non_hydrostatic, iteration, &
1398 ids, ide, jds, jde, kds, kde, &
1399 ims, ime, jms, jme, kms, kme, &
1400 grid%i_start(ij), grid%i_end(ij), &
1401 grid%j_start(ij), grid%j_end(ij), &
1402 k_start , k_end )
1403 BENCH_END(cald_p_rho_tim)
1405 ENDDO
1406 !$OMP END PARALLEL DO
1408 #ifdef DM_PARALLEL
1409 !
1410 ! Stencils for patch communications (WCS, 29 June 2001)
1411 !
1412 ! * *
1413 ! * + * * + * +
1414 ! * *
1415 !
1416 ! ph_2 x
1417 ! al x
1418 ! p x
1419 !
1420 ! 2D variables (x,y)
1421 !
1422 ! mu_2 x
1423 ! muts x
1424 ! mudf x
1426 # include "HALO_EM_C2.inc"
1427 # include "PERIOD_BDY_EM_B3.inc"
1428 #endif
1430 BENCH_START(phys_bc_tim)
1431 !$OMP PARALLEL DO &
1432 !$OMP PRIVATE ( ij )
1433 DO ij = 1 , grid%num_tiles
1435 ! boundary condition set for next small timestep
1437 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1438 ids, ide, jds, jde, kds, kde, &
1439 ims, ime, jms, jme, kms, kme, &
1440 ips, ipe, jps, jpe, kps, kpe, &
1441 grid%i_start(ij), grid%i_end(ij), &
1442 grid%j_start(ij), grid%j_end(ij), &
1443 k_start , k_end )
1445 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1446 ids, ide, jds, jde, kds, kde, &
1447 ims, ime, jms, jme, kms, kme, &
1448 ips, ipe, jps, jpe, kps, kpe, &
1449 grid%i_start(ij), grid%i_end(ij), &
1450 grid%j_start(ij), grid%j_end(ij), &
1451 k_start , k_end )
1453 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1454 ids, ide, jds, jde, kds, kde, &
1455 ims, ime, jms, jme, kms, kme, &
1456 ips, ipe, jps, jpe, kps, kpe, &
1457 grid%i_start(ij), grid%i_end(ij), &
1458 grid%j_start(ij), grid%j_end(ij), &
1459 k_start , k_end )
1461 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1462 ids, ide, jds, jde, &
1463 ims, ime, jms, jme, &
1464 ips, ipe, jps, jpe, &
1465 grid%i_start(ij), grid%i_end(ij), &
1466 grid%j_start(ij), grid%j_end(ij) )
1468 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1469 ids, ide, jds, jde, &
1470 ims, ime, jms, jme, &
1471 ips, ipe, jps, jpe, &
1472 grid%i_start(ij), grid%i_end(ij), &
1473 grid%j_start(ij), grid%j_end(ij) )
1475 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1476 ids, ide, jds, jde, &
1477 ims, ime, jms, jme, &
1478 ips, ipe, jps, jpe, &
1479 grid%i_start(ij), grid%i_end(ij), &
1480 grid%j_start(ij), grid%j_end(ij) )
1482 END DO
1483 !$OMP END PARALLEL DO
1484 BENCH_END(phys_bc_tim)
1486 END DO small_steps
1488 !$OMP PARALLEL DO &
1489 !$OMP PRIVATE ( ij )
1490 DO ij = 1 , grid%num_tiles
1492 CALL wrf_debug ( 200 , ' call rk_small_finish' )
1494 ! change time-perturbation variables back to
1495 ! full perturbation variables.
1496 ! first get updated mu at u and v points
1498 BENCH_START(calc_mu_uv_tim)
1499 CALL calc_mu_uv_1 ( config_flags, &
1500 grid%muts, muus, muvs, &
1501 ids, ide, jds, jde, kds, kde, &
1502 ims, ime, jms, jme, kms, kme, &
1503 grid%i_start(ij), grid%i_end(ij), &
1504 grid%j_start(ij), grid%j_end(ij), &
1505 k_start , k_end )
1506 BENCH_END(calc_mu_uv_tim)
1507 BENCH_START(small_step_finish_tim)
1508 CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1, &
1509 grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1, &
1510 grid%mu_2, grid%mu_1, &
1511 grid%mut, grid%muts, grid%muu, muus, grid%muv, muvs, &
1512 grid%u_save, grid%v_save, w_save, &
1513 grid%t_save, ph_save, mu_save, &
1514 grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
1515 grid%h_diabatic, &
1516 number_of_small_timesteps,dts_rk, &
1517 rk_step, rk_order, &
1518 ids, ide, jds, jde, kds, kde, &
1519 ims, ime, jms, jme, kms, kme, &
1520 grid%i_start(ij), grid%i_end(ij), &
1521 grid%j_start(ij), grid%j_end(ij), &
1522 k_start , k_end )
1523 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
1525 IF (rk_step == rk_order) THEN
1527 CALL set_physical_bc3d( grid%ru_m, 'u', config_flags, &
1528 ids, ide, jds, jde, kds, kde, &
1529 ims, ime, jms, jme, kms, kme, &
1530 ips, ipe, jps, jpe, kps, kpe, &
1531 grid%i_start(ij), grid%i_end(ij), &
1532 grid%j_start(ij), grid%j_end(ij), &
1533 k_start , k_end )
1535 CALL set_physical_bc3d( grid%rv_m, 'v', config_flags, &
1536 ids, ide, jds, jde, kds, kde, &
1537 ims, ime, jms, jme, kms, kme, &
1538 ips, ipe, jps, jpe, kps, kpe, &
1539 grid%i_start(ij), grid%i_end(ij), &
1540 grid%j_start(ij), grid%j_end(ij), &
1541 k_start , k_end )
1543 CALL set_physical_bc3d( grid%ww_m, 'w', config_flags, &
1544 ids, ide, jds, jde, kds, kde, &
1545 ims, ime, jms, jme, kms, kme, &
1546 ips, ipe, jps, jpe, kps, kpe, &
1547 grid%i_start(ij), grid%i_end(ij), &
1548 grid%j_start(ij), grid%j_end(ij), &
1549 k_start , k_end )
1551 CALL set_physical_bc2d( grid%mut, 't', config_flags, &
1552 ids, ide, jds, jde, &
1553 ims, ime, jms, jme, &
1554 ips, ipe, jps, jpe, &
1555 grid%i_start(ij), grid%i_end(ij), &
1556 grid%j_start(ij), grid%j_end(ij) )
1558 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1559 ids, ide, jds, jde, &
1560 ims, ime, jms, jme, &
1561 ips, ipe, jps, jpe, &
1562 grid%i_start(ij), grid%i_end(ij), &
1563 grid%j_start(ij), grid%j_end(ij) )
1565 END IF
1567 BENCH_END(small_step_finish_tim)
1569 END DO
1570 !$OMP END PARALLEL DO
1572 !-----------------------------------------------------------
1573 ! polar filter for full dynamics variables and time-averaged mass fluxes
1574 !-----------------------------------------------------------
1576 IF (config_flags%polar) THEN
1578 CALL pxft ( grid=grid &
1579 ,lineno=__LINE__ &
1580 ,flag_uv = 1 &
1581 ,flag_rurv = 1 &
1582 ,flag_wph = 1 &
1583 ,flag_ww = 1 &
1584 ,flag_t = 1 &
1585 ,flag_mu = 1 &
1586 ,flag_mut = 1 &
1587 ,flag_moist = 0 &
1588 ,flag_chem = 0 &
1589 ,flag_tracer = 0 &
1590 ,flag_scalar = 0 &
1591 ,positive_definite = .FALSE. &
1592 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1593 ,fft_filter_lat = config_flags%fft_filter_lat &
1594 ,dclat = dclat &
1595 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1596 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1597 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1598 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1599 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1601 END IF
1603 !-----------------------------------------------------------
1604 ! end polar filter for full dynamics variables and time-averaged mass fluxes
1605 !-----------------------------------------------------------
1607 !-----------------------------------------------------------------------
1608 ! add in physics tendency first if positive definite advection is used.
1609 ! pd advection applies advective flux limiter on last runge-kutta step
1610 !-----------------------------------------------------------------------
1611 ! first moisture
1613 IF ((config_flags%moist_adv_opt /= ORIGINAL) .and. (rk_step == rk_order)) THEN
1615 !$OMP PARALLEL DO &
1616 !$OMP PRIVATE ( ij )
1617 DO ij = 1 , grid%num_tiles
1618 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1619 DO im = PARAM_FIRST_SCALAR, num_3d_m
1620 CALL rk_update_scalar_pd( im, im, &
1621 moist_old(ims,kms,jms,im), &
1622 moist_tend(ims,kms,jms,im), &
1623 grid%mu_1, grid%mu_1, grid%mub, &
1624 rk_step, dt_rk, grid%spec_zone, &
1625 config_flags, &
1626 ids, ide, jds, jde, kds, kde, &
1627 ims, ime, jms, jme, kms, kme, &
1628 grid%i_start(ij), grid%i_end(ij), &
1629 grid%j_start(ij), grid%j_end(ij), &
1630 k_start , k_end )
1631 ENDDO
1632 END DO
1633 !$OMP END PARALLEL DO
1635 !---------------------- positive definite bc call
1636 #ifdef DM_PARALLEL
1637 IF (config_flags%moist_adv_opt /= ORIGINAL) THEN
1638 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1639 # include "HALO_EM_MOIST_OLD_E_5.inc"
1640 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1641 # include "HALO_EM_MOIST_OLD_E_7.inc"
1642 ELSE
1643 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1644 CALL wrf_error_fatal(TRIM(wrf_err_message))
1645 ENDIF
1646 ENDIF
1647 #endif
1649 #ifdef DM_PARALLEL
1650 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
1651 #endif
1653 !$OMP PARALLEL DO &
1654 !$OMP PRIVATE ( ij )
1655 DO ij = 1 , grid%num_tiles
1656 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1657 DO im = PARAM_FIRST_SCALAR , num_3d_m
1658 CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
1659 ids, ide, jds, jde, kds, kde, &
1660 ims, ime, jms, jme, kms, kme, &
1661 ips, ipe, jps, jpe, kps, kpe, &
1662 grid%i_start(ij), grid%i_end(ij), &
1663 grid%j_start(ij), grid%j_end(ij), &
1664 k_start , k_end )
1665 END DO
1666 ENDIF
1667 END DO
1668 !$OMP END PARALLEL DO
1670 END IF ! end if for moist_adv_opt
1672 ! scalars
1674 IF ((config_flags%scalar_adv_opt /= ORIGINAL) .and. (rk_step == rk_order)) THEN
1676 !$OMP PARALLEL DO &
1677 !$OMP PRIVATE ( ij )
1678 DO ij = 1 , grid%num_tiles
1679 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1680 DO im = PARAM_FIRST_SCALAR, num_3d_s
1681 CALL rk_update_scalar_pd( im, im, &
1682 scalar_old(ims,kms,jms,im), &
1683 scalar_tend(ims,kms,jms,im), &
1684 grid%mu_1, grid%mu_1, grid%mub, &
1685 rk_step, dt_rk, grid%spec_zone, &
1686 config_flags, &
1687 ids, ide, jds, jde, kds, kde, &
1688 ims, ime, jms, jme, kms, kme, &
1689 grid%i_start(ij), grid%i_end(ij), &
1690 grid%j_start(ij), grid%j_end(ij), &
1691 k_start , k_end )
1692 ENDDO
1693 ENDDO
1694 !$OMP END PARALLEL DO
1696 !---------------------- positive definite bc call
1697 #ifdef DM_PARALLEL
1698 IF (config_flags%scalar_adv_opt /= ORIGINAL) THEN
1699 #ifndef RSL
1700 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1701 # include "HALO_EM_SCALAR_OLD_E_5.inc"
1702 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1703 # include "HALO_EM_SCALAR_OLD_E_7.inc"
1704 ELSE
1705 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1706 CALL wrf_error_fatal(TRIM(wrf_err_message))
1707 ENDIF
1708 #else
1709 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1710 CALL wrf_error_fatal(TRIM(wrf_err_message))
1711 #endif
1712 endif
1713 #endif
1715 #ifdef DM_PARALLEL
1716 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1717 #endif
1718 !$OMP PARALLEL DO &
1719 !$OMP PRIVATE ( ij )
1721 DO ij = 1 , grid%num_tiles
1722 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
1723 DO im = PARAM_FIRST_SCALAR , num_3d_s
1724 CALL set_physical_bc3d( scalar_old(ims,kms,jms,im), 'p', config_flags, &
1725 ids, ide, jds, jde, kds, kde, &
1726 ims, ime, jms, jme, kms, kme, &
1727 ips, ipe, jps, jpe, kps, kpe, &
1728 grid%i_start(ij), grid%i_end(ij), &
1729 grid%j_start(ij), grid%j_end(ij), &
1730 k_start , k_end )
1731 END DO
1732 ENDIF
1733 END DO
1734 !$OMP END PARALLEL DO
1736 END IF ! end if for scalar_adv_opt
1738 ! chem
1740 IF ((config_flags%chem_adv_opt /= ORIGINAL) .and. (rk_step == rk_order)) THEN
1742 !$OMP PARALLEL DO &
1743 !$OMP PRIVATE ( ij )
1744 DO ij = 1 , grid%num_tiles
1745 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1746 DO im = PARAM_FIRST_SCALAR, num_3d_c
1747 CALL rk_update_scalar_pd( im, im, &
1748 chem_old(ims,kms,jms,im), &
1749 chem_tend(ims,kms,jms,im), &
1750 grid%mu_1, grid%mu_1, grid%mub, &
1751 rk_step, dt_rk, grid%spec_zone, &
1752 config_flags, &
1753 ids, ide, jds, jde, kds, kde, &
1754 ims, ime, jms, jme, kms, kme, &
1755 grid%i_start(ij), grid%i_end(ij), &
1756 grid%j_start(ij), grid%j_end(ij), &
1757 k_start , k_end )
1758 ENDDO
1759 END DO
1760 !$OMP END PARALLEL DO
1762 !---------------------- positive definite bc call
1763 #ifdef DM_PARALLEL
1764 IF (config_flags%chem_adv_opt /= ORIGINAL) THEN
1765 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1766 # include "HALO_EM_CHEM_OLD_E_5.inc"
1767 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1768 # include "HALO_EM_CHEM_OLD_E_7.inc"
1769 ELSE
1770 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1771 CALL wrf_error_fatal(TRIM(wrf_err_message))
1772 ENDIF
1773 ENDIF
1774 #endif
1776 #ifdef DM_PARALLEL
1777 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
1778 #endif
1780 !$OMP PARALLEL DO &
1781 !$OMP PRIVATE ( ij )
1782 DO ij = 1 , grid%num_tiles
1783 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
1784 DO im = PARAM_FIRST_SCALAR , num_3d_c
1785 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
1786 ids, ide, jds, jde, kds, kde, &
1787 ims, ime, jms, jme, kms, kme, &
1788 ips, ipe, jps, jpe, kps, kpe, &
1789 grid%i_start(ij), grid%i_end(ij), &
1790 grid%j_start(ij), grid%j_end(ij), &
1791 k_start , k_end )
1792 END DO
1793 ENDIF
1794 END DO
1795 !$OMP END PARALLEL DO
1797 ENDIF ! end if for chem_adv_opt
1799 ! tracer
1801 IF ((config_flags%tracer_adv_opt /= ORIGINAL) .and. (rk_step == rk_order)) THEN
1803 !$OMP PARALLEL DO &
1804 !$OMP PRIVATE ( ij )
1805 DO ij = 1 , grid%num_tiles
1806 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1807 DO im = PARAM_FIRST_SCALAR, num_tracer
1808 CALL rk_update_scalar_pd( im, im, &
1809 tracer_old(ims,kms,jms,im), &
1810 tracer_tend(ims,kms,jms,im), &
1811 grid%mu_1, grid%mu_1, grid%mub, &
1812 rk_step, dt_rk, grid%spec_zone, &
1813 config_flags, &
1814 ids, ide, jds, jde, kds, kde, &
1815 ims, ime, jms, jme, kms, kme, &
1816 grid%i_start(ij), grid%i_end(ij), &
1817 grid%j_start(ij), grid%j_end(ij), &
1818 k_start , k_end )
1819 ENDDO
1820 END DO
1821 !$OMP END PARALLEL DO
1823 !---------------------- positive definite bc call
1824 #ifdef DM_PARALLEL
1825 IF (config_flags%tracer_adv_opt /= ORIGINAL) THEN
1826 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1827 # include "HALO_EM_TRACER_OLD_E_5.inc"
1828 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1829 # include "HALO_EM_TRACER_OLD_E_7.inc"
1830 ELSE
1831 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1832 CALL wrf_error_fatal(TRIM(wrf_err_message))
1833 ENDIF
1834 ENDIF
1835 #endif
1837 #ifdef DM_PARALLEL
1838 # include "PERIOD_BDY_EM_TRACER_OLD.inc"
1839 #endif
1841 !$OMP PARALLEL DO &
1842 !$OMP PRIVATE ( ij )
1843 DO ij = 1 , grid%num_tiles
1844 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
1845 DO im = PARAM_FIRST_SCALAR , num_tracer
1846 CALL set_physical_bc3d( tracer_old(ims,kms,jms,im), 'p', config_flags, &
1847 ids, ide, jds, jde, kds, kde, &
1848 ims, ime, jms, jme, kms, kme, &
1849 ips, ipe, jps, jpe, kps, kpe, &
1850 grid%i_start(ij), grid%i_end(ij), &
1851 grid%j_start(ij), grid%j_end(ij), &
1852 k_start , k_end )
1853 END DO
1854 ENDIF
1855 END DO
1856 !$OMP END PARALLEL DO
1858 ENDIF ! end if for tracer_adv_opt
1860 ! tke
1862 IF ((config_flags%tke_adv_opt /= ORIGINAL) .and. (rk_step == rk_order) &
1863 .and. (config_flags%km_opt .eq. 2) ) THEN
1865 !$OMP PARALLEL DO &
1866 !$OMP PRIVATE ( ij )
1867 DO ij = 1 , grid%num_tiles
1868 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1869 CALL rk_update_scalar_pd( 1, 1, &
1870 grid%tke_1, &
1871 tke_tend(ims,kms,jms), &
1872 grid%mu_1, grid%mu_1, grid%mub, &
1873 rk_step, dt_rk, grid%spec_zone, &
1874 config_flags, &
1875 ids, ide, jds, jde, kds, kde, &
1876 ims, ime, jms, jme, kms, kme, &
1877 grid%i_start(ij), grid%i_end(ij), &
1878 grid%j_start(ij), grid%j_end(ij), &
1879 k_start , k_end )
1880 ENDDO
1881 !$OMP END PARALLEL DO
1883 !---------------------- positive definite bc call
1884 #ifdef DM_PARALLEL
1885 IF (config_flags%tke_adv_opt /= ORIGINAL) THEN
1886 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1887 # include "HALO_EM_TKE_OLD_E_5.inc"
1888 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1889 # include "HALO_EM_TKE_OLD_E_7.inc"
1890 ELSE
1891 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1892 CALL wrf_error_fatal(TRIM(wrf_err_message))
1893 ENDIF
1894 ENDIF
1895 #endif
1897 #ifdef DM_PARALLEL
1898 # include "PERIOD_BDY_EM_TKE_OLD.inc"
1899 #endif
1901 !$OMP PARALLEL DO &
1902 !$OMP PRIVATE ( ij )
1903 DO ij = 1 , grid%num_tiles
1904 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
1905 ids, ide, jds, jde, kds, kde, &
1906 ims, ime, jms, jme, kms, kme, &
1907 ips, ipe, jps, jpe, kps, kpe, &
1908 grid%i_start(ij), grid%i_end(ij), &
1909 grid%j_start(ij), grid%j_end(ij), &
1910 k_start , k_end )
1911 END DO
1912 !$OMP END PARALLEL DO
1914 !--- end of positive definite physics tendency update
1916 END IF ! end if for tke_adv_opt
1918 #ifdef DM_PARALLEL
1919 !
1920 ! Stencils for patch communications (WCS, 29 June 2001)
1921 !
1922 ! * * * * *
1923 ! * * * * *
1924 ! * * + * *
1925 ! * * * * *
1926 ! * * * * *
1927 !
1928 ! ru_m x
1929 ! rv_m x
1930 ! ww_m x
1931 ! mut x
1932 !
1933 !--------------------------------------------------------------
1935 # include "HALO_EM_D.inc"
1936 ! WCS addition 11/19/08
1937 # include "PERIOD_EM_DA.inc"
1938 #endif
1940 !<DESCRIPTION>
1941 !<pre>
1942 ! (4) Still within the RK loop, the scalar variables are advanced.
1943 !
1944 ! For the moist and chem variables, each one is advanced
1945 ! individually, using named loops "moist_variable_loop:"
1946 ! and "chem_variable_loop:". Each RK substep begins by
1947 ! calculating the advective tendency, and, for the first RK step,
1948 ! 3D mixing (calling rk_scalar_tend) followed by an update
1949 ! of the scalar (calling rk_scalar_update).
1950 !</pre>
1951 !</DESCRIPTION>
1954 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
1956 moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
1958 ! adv_moist_cond is set in module_physics_init based on mp_physics choice
1959 ! true except for Ferrier scheme
1961 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
1963 !$OMP PARALLEL DO &
1964 !$OMP PRIVATE ( ij )
1965 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
1967 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
1968 tenddec = .false.
1970 BENCH_START(rk_scalar_tend_tim)
1971 CALL rk_scalar_tend ( im, im, config_flags, tenddec, &
1972 rk_step, dt_rk, &
1973 grid%ru_m, grid%rv_m, grid%ww_m, &
1974 grid%muts, grid%mub, grid%mu_1, &
1975 grid%alt, &
1976 moist_old(ims,kms,jms,im), &
1977 moist(ims,kms,jms,im), &
1978 moist_tend(ims,kms,jms,im), &
1979 advect_tend,h_tendency,z_tendency,grid%rqvften, &
1980 grid%qv_base, .true., grid%fnm, grid%fnp, &
1981 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
1982 grid%msfvy, grid%msftx,grid%msfty, &
1983 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
1984 grid%kvdif, grid%xkhh, &
1985 grid%diff_6th_opt, grid%diff_6th_factor, &
1986 config_flags%moist_adv_opt, &
1987 ids, ide, jds, jde, kds, kde, &
1988 ims, ime, jms, jme, kms, kme, &
1989 grid%i_start(ij), grid%i_end(ij), &
1990 grid%j_start(ij), grid%j_end(ij), &
1991 k_start , k_end )
1993 BENCH_END(rk_scalar_tend_tim)
1995 BENCH_START(rlx_bdy_scalar_tim)
1996 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
1997 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
1998 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
1999 moist(ims,kms,jms,im), grid%mut, &
2000 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2001 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2002 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2003 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2004 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2005 grid%dtbc, grid%fcx, grid%gcx, &
2006 config_flags, &
2007 ids,ide, jds,jde, kds,kde, & ! domain dims
2008 ims,ime, jms,jme, kms,kme, & ! memory dims
2009 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2010 grid%i_start(ij), grid%i_end(ij), &
2011 grid%j_start(ij), grid%j_end(ij), &
2012 k_start, k_end )
2014 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2015 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2016 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2017 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2018 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2019 config_flags%spec_bdy_width, grid%spec_zone, &
2020 config_flags, &
2021 ids,ide, jds,jde, kds,kde, & ! domain dims
2022 ims,ime, jms,jme, kms,kme, & ! memory dims
2023 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2024 grid%i_start(ij), grid%i_end(ij), &
2025 grid%j_start(ij), grid%j_end(ij), &
2026 k_start, k_end )
2027 ENDIF
2028 ENDIF
2029 BENCH_END(rlx_bdy_scalar_tim)
2031 ENDDO moist_tile_loop_1
2032 !$OMP END PARALLEL DO
2034 !$OMP PARALLEL DO &
2035 !$OMP PRIVATE ( ij )
2036 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2038 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2039 tenddec = .false.
2041 BENCH_START(update_scal_tim)
2042 CALL rk_update_scalar( im, im, &
2043 moist_old(ims,kms,jms,im), &
2044 moist(ims,kms,jms,im), &
2045 moist_tend(ims,kms,jms,im), &
2046 advh_t(ims,kms,jms,1), &
2047 advz_t(ims,kms,jms,1), &
2048 advect_tend, h_tendency,z_tendency,&
2049 grid%msftx,grid%msfty, &
2050 grid%mu_1, grid%mu_2, grid%mub, &
2051 rk_step, dt_rk, grid%spec_zone, &
2052 config_flags, tenddec, &
2053 ids, ide, jds, jde, kds, kde, &
2054 ims, ime, jms, jme, kms, kme, &
2055 grid%i_start(ij), grid%i_end(ij), &
2056 grid%j_start(ij), grid%j_end(ij), &
2057 k_start , k_end )
2058 BENCH_END(update_scal_tim)
2060 BENCH_START(flow_depbdy_tim)
2061 IF( config_flags%specified ) THEN
2062 IF(im .ne. P_QV)THEN
2063 CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
2064 grid%ru_m, grid%rv_m, config_flags, &
2065 grid%spec_zone, &
2066 ids,ide, jds,jde, kds,kde, &
2067 ims,ime, jms,jme, kms,kme, &
2068 ips,ipe, jps,jpe, kps,kpe, &
2069 grid%i_start(ij), grid%i_end(ij), &
2070 grid%j_start(ij), grid%j_end(ij), &
2071 k_start, k_end )
2072 ENDIF
2073 ENDIF
2074 BENCH_END(flow_depbdy_tim)
2076 ENDDO moist_tile_loop_2
2077 !$OMP END PARALLEL DO
2079 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2081 ENDDO moist_variable_loop
2083 ENDIF moist_scalar_advance
2085 BENCH_START(tke_adv_tim)
2086 TKE_advance: IF (config_flags%km_opt .eq. 2) then
2087 #ifdef DM_PARALLEL
2088 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2089 # include "HALO_EM_TKE_ADVECT_3.inc"
2090 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2091 # include "HALO_EM_TKE_ADVECT_5.inc"
2092 ELSE
2093 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2094 CALL wrf_error_fatal(TRIM(wrf_err_message))
2095 ENDIF
2096 #endif
2097 !$OMP PARALLEL DO &
2098 !$OMP PRIVATE ( ij )
2099 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2101 CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
2102 tenddec = .false.
2103 CALL rk_scalar_tend ( 1, 1, config_flags, tenddec, &
2104 rk_step, dt_rk, &
2105 grid%ru_m, grid%rv_m, grid%ww_m, &
2106 grid%muts, grid%mub, grid%mu_1, &
2107 grid%alt, &
2108 grid%tke_1, &
2109 grid%tke_2, &
2110 tke_tend(ims,kms,jms), &
2111 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2112 grid%qv_base, .false., grid%fnm, grid%fnp, &
2113 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2114 grid%msfvy, grid%msftx,grid%msfty, &
2115 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2116 grid%kvdif, grid%xkhh, &
2117 grid%diff_6th_opt, grid%diff_6th_factor, &
2118 config_flags%tke_adv_opt, &
2119 ids, ide, jds, jde, kds, kde, &
2120 ims, ime, jms, jme, kms, kme, &
2121 grid%i_start(ij), grid%i_end(ij), &
2122 grid%j_start(ij), grid%j_end(ij), &
2123 k_start , k_end )
2125 ENDDO tke_tile_loop_1
2126 !$OMP END PARALLEL DO
2128 !$OMP PARALLEL DO &
2129 !$OMP PRIVATE ( ij )
2130 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2132 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2133 tenddec = .false.
2134 CALL rk_update_scalar( 1, 1, &
2135 grid%tke_1, &
2136 grid%tke_2, &
2137 tke_tend(ims,kms,jms), &
2138 advh_t(ims,kms,jms,1), &
2139 advz_t(ims,kms,jms,1), &
2140 advect_tend,h_tendency,z_tendency, &
2141 grid%msftx,grid%msfty, &
2142 grid%mu_1, grid%mu_2, grid%mub, &
2143 rk_step, dt_rk, grid%spec_zone, &
2144 config_flags, tenddec, &
2145 ids, ide, jds, jde, kds, kde, &
2146 ims, ime, jms, jme, kms, kme, &
2147 grid%i_start(ij), grid%i_end(ij), &
2148 grid%j_start(ij), grid%j_end(ij), &
2149 k_start , k_end )
2151 ! bound the tke (greater than 0, less than tke_upper_bound)
2153 CALL bound_tke( grid%tke_2, grid%tke_upper_bound, &
2154 ids, ide, jds, jde, kds, kde, &
2155 ims, ime, jms, jme, kms, kme, &
2156 grid%i_start(ij), grid%i_end(ij), &
2157 grid%j_start(ij), grid%j_end(ij), &
2158 k_start , k_end )
2160 IF( config_flags%specified .or. config_flags%nested ) THEN
2161 CALL flow_dep_bdy ( grid%tke_2, &
2162 grid%ru_m, grid%rv_m, config_flags, &
2163 grid%spec_zone, &
2164 ids,ide, jds,jde, kds,kde, & ! domain dims
2165 ims,ime, jms,jme, kms,kme, & ! memory dims
2166 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2167 grid%i_start(ij), grid%i_end(ij), &
2168 grid%j_start(ij), grid%j_end(ij), &
2169 k_start, k_end )
2170 ENDIF
2171 ENDDO tke_tile_loop_2
2172 !$OMP END PARALLEL DO
2174 ENDIF TKE_advance
2175 BENCH_END(tke_adv_tim)
2177 #ifdef WRF_CHEM
2178 ! next the chemical species
2179 BENCH_START(chem_adv_tim)
2180 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2182 chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
2184 !$OMP PARALLEL DO &
2185 !$OMP PRIVATE ( ij )
2186 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2188 CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
2189 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2190 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2191 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2192 rk_step, dt_rk, &
2193 grid%ru_m, grid%rv_m, grid%ww_m, &
2194 grid%muts, grid%mub, grid%mu_1, &
2195 grid%alt, &
2196 chem_old(ims,kms,jms,ic), &
2197 chem(ims,kms,jms,ic), &
2198 chem_tend(ims,kms,jms,ic), &
2199 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2200 grid%qv_base, .false., grid%fnm, grid%fnp, &
2201 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2202 grid%msfvy, grid%msftx,grid%msfty, &
2203 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2204 grid%khdif, grid%kvdif, grid%xkhh, &
2205 grid%diff_6th_opt, grid%diff_6th_factor, &
2206 config_flags%chem_adv_opt, &
2207 ids, ide, jds, jde, kds, kde, &
2208 ims, ime, jms, jme, kms, kme, &
2209 grid%i_start(ij), grid%i_end(ij), &
2210 grid%j_start(ij), grid%j_end(ij), &
2211 k_start , k_end )
2212 !
2213 ! Currently, chemistry species with specified boundaries (i.e. the mother
2214 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2215 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2216 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2217 !
2218 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2219 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2220 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2221 chem(ims,kms,jms,ic), grid%mut, &
2222 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2223 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2224 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2225 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2226 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2227 grid%dtbc, grid%fcx, grid%gcx, &
2228 config_flags, &
2229 ids,ide, jds,jde, kds,kde, &
2230 ims,ime, jms,jme, kms,kme, &
2231 ips,ipe, jps,jpe, kps,kpe, &
2232 grid%i_start(ij), grid%i_end(ij), &
2233 grid%j_start(ij), grid%j_end(ij), &
2234 k_start, k_end )
2235 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2236 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2237 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2238 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2239 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2240 config_flags%spec_bdy_width, grid%spec_zone, &
2241 config_flags, &
2242 ids,ide, jds,jde, kds,kde, &
2243 ims,ime, jms,jme, kms,kme, &
2244 ips,ipe, jps,jpe, kps,kpe, &
2245 grid%i_start(ij), grid%i_end(ij), &
2246 grid%j_start(ij), grid%j_end(ij), &
2247 k_start, k_end )
2248 ENDIF
2250 ENDDO chem_tile_loop_1
2251 !$OMP END PARALLEL DO
2253 !$OMP PARALLEL DO &
2254 !$OMP PRIVATE ( ij )
2256 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2258 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2259 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2260 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2261 CALL rk_update_scalar( ic, ic, &
2262 chem_old(ims,kms,jms,ic), & ! was chem_1
2263 chem(ims,kms,jms,ic), &
2264 chem_tend(ims,kms,jms,ic), &
2265 advh_ct(ims,kms,jms,adv_ct_indices(ic)), &
2266 advz_ct(ims,kms,jms,adv_ct_indices(ic)), &
2267 advect_tend,h_tendency,z_tendency, &
2268 grid%msftx, grid%msfty, &
2269 grid%mu_1, grid%mu_2, grid%mub, &
2270 rk_step, dt_rk, grid%spec_zone, &
2271 config_flags, tenddec, &
2272 ids, ide, jds, jde, kds, kde, &
2273 ims, ime, jms, jme, kms, kme, &
2274 grid%i_start(ij), grid%i_end(ij), &
2275 grid%j_start(ij), grid%j_end(ij), &
2276 k_start , k_end )
2278 IF( config_flags%specified ) THEN
2279 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2280 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2281 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2282 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2283 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2284 dt_rk+grid%dtbc, &
2285 config_flags%spec_bdy_width,grid%z, &
2286 grid%have_bcs_chem, &
2287 grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2288 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2289 grid%spec_zone,ic, &
2290 ids,ide, jds,jde, kds,kde, & ! domain dims
2291 ims,ime, jms,jme, kms,kme, & ! memory dims
2292 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2293 grid%i_start(ij), grid%i_end(ij), &
2294 grid%j_start(ij), grid%j_end(ij), &
2295 k_start, k_end )
2296 ENDIF
2297 ENDDO chem_tile_loop_2
2298 !$OMP END PARALLEL DO
2300 ENDDO chem_variable_loop
2301 ENDIF chem_scalar_advance
2302 BENCH_END(chem_adv_tim)
2303 #endif
2304 ! next the chemical species
2305 BENCH_START(tracer_adv_tim)
2306 tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2308 tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
2310 !$OMP PARALLEL DO &
2311 !$OMP PRIVATE ( ij )
2312 tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
2314 CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
2315 tenddec = .false.
2316 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2317 rk_step, dt_rk, &
2318 grid%ru_m, grid%rv_m, grid%ww_m, &
2319 grid%muts, grid%mub, grid%mu_1, &
2320 grid%alt, &
2321 tracer_old(ims,kms,jms,ic), &
2322 tracer(ims,kms,jms,ic), &
2323 tracer_tend(ims,kms,jms,ic), &
2324 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2325 grid%qv_base, .false., grid%fnm, grid%fnp, &
2326 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2327 grid%msfvy, grid%msftx,grid%msfty, &
2328 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2329 grid%khdif, grid%kvdif, grid%xkhh, &
2330 grid%diff_6th_opt, grid%diff_6th_factor, &
2331 config_flags%tracer_adv_opt, &
2332 ids, ide, jds, jde, kds, kde, &
2333 ims, ime, jms, jme, kms, kme, &
2334 grid%i_start(ij), grid%i_end(ij), &
2335 grid%j_start(ij), grid%j_end(ij), &
2336 k_start , k_end )
2337 !
2338 ! Currently, chemistry species with specified boundaries (i.e. the mother
2339 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2340 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2341 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2342 !
2343 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2344 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
2345 CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2346 tracer(ims,kms,jms,ic), grid%mut, &
2347 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2348 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2349 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2350 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2351 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2352 grid%dtbc, grid%fcx, grid%gcx, &
2353 config_flags, &
2354 ids,ide, jds,jde, kds,kde, &
2355 ims,ime, jms,jme, kms,kme, &
2356 ips,ipe, jps,jpe, kps,kpe, &
2357 grid%i_start(ij), grid%i_end(ij), &
2358 grid%j_start(ij), grid%j_end(ij), &
2359 k_start, k_end )
2360 CALL spec_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2361 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2362 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2363 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2364 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2365 config_flags%spec_bdy_width, grid%spec_zone, &
2366 config_flags, &
2367 ids,ide, jds,jde, kds,kde, &
2368 ims,ime, jms,jme, kms,kme, &
2369 ips,ipe, jps,jpe, kps,kpe, &
2370 grid%i_start(ij), grid%i_end(ij), &
2371 grid%j_start(ij), grid%j_end(ij), &
2372 k_start, k_end )
2373 ENDIF
2375 ENDDO tracer_tile_loop_1
2376 !$OMP END PARALLEL DO
2378 !$OMP PARALLEL DO &
2379 !$OMP PRIVATE ( ij )
2381 tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
2383 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2384 tenddec = .false.
2385 CALL rk_update_scalar( ic, ic, &
2386 tracer_old(ims,kms,jms,ic), &
2387 tracer(ims,kms,jms,ic), &
2388 tracer_tend(ims,kms,jms,ic), &
2389 advh_t(ims,kms,jms,1), &
2390 advz_t(ims,kms,jms,1), &
2391 advect_tend,h_tendency,z_tendency, &
2392 grid%msftx, grid%msfty, &
2393 grid%mu_1, grid%mu_2, grid%mub, &
2394 rk_step, dt_rk, grid%spec_zone, &
2395 config_flags, tenddec, &
2396 ids, ide, jds, jde, kds, kde, &
2397 ims, ime, jms, jme, kms, kme, &
2398 grid%i_start(ij), grid%i_end(ij), &
2399 grid%j_start(ij), grid%j_end(ij), &
2400 k_start , k_end )
2402 IF( config_flags%specified ) THEN
2403 #ifdef WRF_CHEM
2404 CALL flow_dep_bdy_tracer( tracer(ims,kms,jms,ic), &
2405 tracer_bxs(jms,kms,1,ic), tracer_btxs(jms,kms,1,ic), &
2406 tracer_bxe(jms,kms,1,ic), tracer_btxe(jms,kms,1,ic), &
2407 tracer_bys(ims,kms,1,ic), tracer_btys(ims,kms,1,ic), &
2408 tracer_bye(ims,kms,1,ic), tracer_btye(ims,kms,1,ic), &
2409 dt_rk+grid%dtbc, &
2410 config_flags%spec_bdy_width,grid%z, &
2411 grid%have_bcs_tracer, &
2412 grid%ru_m, grid%rv_m, config_flags%tracer_opt,grid%alt, &
2413 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2414 grid%spec_zone,ic, &
2415 ids,ide, jds,jde, kds,kde, & ! domain dims
2416 ims,ime, jms,jme, kms,kme, & ! memory dims
2417 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2418 grid%i_start(ij), grid%i_end(ij), &
2419 grid%j_start(ij), grid%j_end(ij), &
2420 k_start, k_end )
2421 #else
2422 CALL flow_dep_bdy ( tracer(ims,kms,jms,ic), &
2423 grid%ru_m, grid%rv_m, config_flags, &
2424 grid%spec_zone, &
2425 ids,ide, jds,jde, kds,kde, & ! domain dims
2426 ims,ime, jms,jme, kms,kme, & ! memory dims
2427 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2428 grid%i_start(ij), grid%i_end(ij), &
2429 grid%j_start(ij), grid%j_end(ij), &
2430 k_start, k_end )
2431 #endif
2432 ENDIF
2433 ENDDO tracer_tile_loop_2
2434 !$OMP END PARALLEL DO
2436 ENDDO tracer_variable_loop
2437 ENDIF tracer_advance
2438 BENCH_END(tracer_adv_tim)
2440 ! next the other scalar species
2441 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2443 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2444 !$OMP PARALLEL DO &
2445 !$OMP PRIVATE ( ij )
2446 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2448 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2449 tenddec = .false.
2450 CALL rk_scalar_tend ( is, is, config_flags, tenddec, &
2451 rk_step, dt_rk, &
2452 grid%ru_m, grid%rv_m, grid%ww_m, &
2453 grid%muts, grid%mub, grid%mu_1, &
2454 grid%alt, &
2455 scalar_old(ims,kms,jms,is), &
2456 scalar(ims,kms,jms,is), &
2457 scalar_tend(ims,kms,jms,is), &
2458 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2459 grid%qv_base, .false., grid%fnm, grid%fnp, &
2460 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2461 grid%msfvy, grid%msftx,grid%msfty, &
2462 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2463 grid%khdif, grid%kvdif, grid%xkhh, &
2464 grid%diff_6th_opt, grid%diff_6th_factor, &
2465 config_flags%scalar_adv_opt, &
2466 ids, ide, jds, jde, kds, kde, &
2467 ims, ime, jms, jme, kms, kme, &
2468 grid%i_start(ij), grid%i_end(ij), &
2469 grid%j_start(ij), grid%j_end(ij), &
2470 k_start , k_end )
2472 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2474 CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2475 scalar(ims,kms,jms,is), grid%mut, &
2476 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2477 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2478 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2479 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2480 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2481 grid%dtbc, grid%fcx, grid%gcx, &
2482 config_flags, &
2483 ids,ide, jds,jde, kds,kde, &
2484 ims,ime, jms,jme, kms,kme, &
2485 ips,ipe, jps,jpe, kps,kpe, &
2486 grid%i_start(ij), grid%i_end(ij), &
2487 grid%j_start(ij), grid%j_end(ij), &
2488 k_start, k_end )
2490 CALL spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2491 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2492 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2493 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2494 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2495 config_flags%spec_bdy_width, grid%spec_zone, &
2496 config_flags, &
2497 ids,ide, jds,jde, kds,kde, &
2498 ims,ime, jms,jme, kms,kme, &
2499 ips,ipe, jps,jpe, kps,kpe, &
2500 grid%i_start(ij), grid%i_end(ij), &
2501 grid%j_start(ij), grid%j_end(ij), &
2502 k_start, k_end )
2504 ENDIF ! b.c test for chem nested boundary condition
2506 ENDDO scalar_tile_loop_1
2507 !$OMP END PARALLEL DO
2509 !$OMP PARALLEL DO &
2510 !$OMP PRIVATE ( ij )
2511 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2513 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2514 tenddec = .false.
2515 CALL rk_update_scalar( is, is, &
2516 scalar_old(ims,kms,jms,is), & ! was scalar_1
2517 scalar(ims,kms,jms,is), &
2518 scalar_tend(ims,kms,jms,is), &
2519 advh_t(ims,kms,jms,1), &
2520 advz_t(ims,kms,jms,1), &
2521 advect_tend,h_tendency,z_tendency,&
2522 grid%msftx, grid%msfty, &
2523 grid%mu_1, grid%mu_2, grid%mub, &
2524 rk_step, dt_rk, grid%spec_zone, &
2525 config_flags, tenddec, &
2526 ids, ide, jds, jde, kds, kde, &
2527 ims, ime, jms, jme, kms, kme, &
2528 grid%i_start(ij), grid%i_end(ij), &
2529 grid%j_start(ij), grid%j_end(ij), &
2530 k_start , k_end )
2533 IF( config_flags%specified ) THEN
2535 CALL flow_dep_bdy ( scalar(ims,kms,jms,is), &
2536 grid%ru_m, grid%rv_m, config_flags, &
2537 grid%spec_zone, &
2538 ids,ide, jds,jde, kds,kde, & ! domain dims
2539 ims,ime, jms,jme, kms,kme, & ! memory dims
2540 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2541 grid%i_start(ij), grid%i_end(ij), &
2542 grid%j_start(ij), grid%j_end(ij), &
2543 k_start, k_end )
2544 ENDIF
2546 ENDDO scalar_tile_loop_2
2547 !$OMP END PARALLEL DO
2549 ENDDO scalar_variable_loop
2551 ENDIF other_scalar_advance
2553 ! update the pressure and density at the new time level
2555 !$OMP PARALLEL DO &
2556 !$OMP PRIVATE ( ij )
2557 DO ij = 1 , grid%num_tiles
2559 BENCH_START(calc_p_rho_tim)
2561 CALL calc_p_rho_phi( moist, num_3d_m, &
2562 grid%al, grid%alb, grid%mu_2, grid%muts, &
2563 grid%ph_2, grid%p, grid%pb, grid%t_2, &
2564 p0, t0, grid%znu, grid%dnw, grid%rdnw, &
2565 grid%rdn, config_flags%non_hydrostatic, &
2566 ids, ide, jds, jde, kds, kde, &
2567 ims, ime, jms, jme, kms, kme, &
2568 grid%i_start(ij), grid%i_end(ij), &
2569 grid%j_start(ij), grid%j_end(ij), &
2570 k_start , k_end )
2572 BENCH_END(calc_p_rho_tim)
2574 ENDDO
2575 !$OMP END PARALLEL DO
2577 ! Reset the boundary conditions if there is another corrector step.
2578 ! (rk_step < rk_order), else we'll handle it at the end of everything
2579 ! (after the split physics, before exiting the timestep).
2581 rk_step_1_check: IF ( rk_step < rk_order ) THEN
2583 !-----------------------------------------------------------
2584 ! rk3 substep polar filter for scalars (moist,chem,scalar)
2585 !-----------------------------------------------------------
2587 IF (config_flags%polar) THEN
2588 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2589 CALL wrf_debug ( 200 , ' call filter moist ' )
2590 DO im = PARAM_FIRST_SCALAR, num_3d_m
2591 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2592 ,MU=grid%mu_2 , MUB=grid%mub &
2593 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2594 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2595 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2596 CALL pxft ( grid=grid &
2597 ,lineno=__LINE__ &
2598 ,flag_uv = 0 &
2599 ,flag_rurv = 0 &
2600 ,flag_wph = 0 &
2601 ,flag_ww = 0 &
2602 ,flag_t = 0 &
2603 ,flag_mu = 0 &
2604 ,flag_mut = 0 &
2605 ,flag_moist = im &
2606 ,flag_chem = 0 &
2607 ,flag_scalar = 0 &
2608 ,flag_tracer = 0 &
2609 ,positive_definite=.FALSE. &
2610 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2611 ,fft_filter_lat = config_flags%fft_filter_lat &
2612 ,dclat = dclat &
2613 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2614 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2615 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2616 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2617 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2618 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2619 ,MU=grid%mu_2 , MUB=grid%mub &
2620 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2621 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2622 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2623 END DO
2624 END IF
2626 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
2627 CALL wrf_debug ( 200 , ' call filter chem ' )
2628 DO im = PARAM_FIRST_SCALAR, num_3d_c
2629 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2630 ,MU=grid%mu_2 , MUB=grid%mub &
2631 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2632 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2633 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2634 CALL pxft ( grid=grid &
2635 ,lineno=__LINE__ &
2636 ,flag_uv = 0 &
2637 ,flag_rurv = 0 &
2638 ,flag_wph = 0 &
2639 ,flag_ww = 0 &
2640 ,flag_t = 0 &
2641 ,flag_mu = 0 &
2642 ,flag_mut = 0 &
2643 ,flag_moist = 0 &
2644 ,flag_chem = im &
2645 ,flag_tracer = 0 &
2646 ,flag_scalar = 0 &
2647 ,positive_definite=.FALSE. &
2648 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2649 ,fft_filter_lat = config_flags%fft_filter_lat &
2650 ,dclat = dclat &
2651 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2652 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2653 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2654 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2655 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2656 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2657 ,MU=grid%mu_2 , MUB=grid%mub &
2658 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2659 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2660 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2661 END DO
2662 END IF
2663 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
2664 CALL wrf_debug ( 200 , ' call filter tracer ' )
2665 DO im = PARAM_FIRST_SCALAR, num_tracer
2666 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2667 ,MU=grid%mu_2 , MUB=grid%mub &
2668 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2669 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2670 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2671 CALL pxft ( grid=grid &
2672 ,lineno=__LINE__ &
2673 ,flag_uv = 0 &
2674 ,flag_rurv = 0 &
2675 ,flag_wph = 0 &
2676 ,flag_ww = 0 &
2677 ,flag_t = 0 &
2678 ,flag_mu = 0 &
2679 ,flag_mut = 0 &
2680 ,flag_moist = 0 &
2681 ,flag_chem = 0 &
2682 ,flag_tracer = im &
2683 ,flag_scalar = 0 &
2684 ,positive_definite=.FALSE. &
2685 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2686 ,fft_filter_lat = config_flags%fft_filter_lat &
2687 ,dclat = dclat &
2688 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2689 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2690 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2691 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2692 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2693 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2694 ,MU=grid%mu_2 , MUB=grid%mub &
2695 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2696 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2697 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2698 END DO
2699 END IF
2701 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
2702 CALL wrf_debug ( 200 , ' call filter scalar ' )
2703 DO im = PARAM_FIRST_SCALAR, num_3d_s
2704 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2705 ,MU=grid%mu_2 , MUB=grid%mub &
2706 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2707 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2708 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2709 CALL pxft ( grid=grid &
2710 ,lineno=__LINE__ &
2711 ,flag_uv = 0 &
2712 ,flag_rurv = 0 &
2713 ,flag_wph = 0 &
2714 ,flag_ww = 0 &
2715 ,flag_t = 0 &
2716 ,flag_mu = 0 &
2717 ,flag_mut = 0 &
2718 ,flag_moist = 0 &
2719 ,flag_chem = 0 &
2720 ,flag_tracer = 0 &
2721 ,flag_scalar = im &
2722 ,positive_definite=.FALSE. &
2723 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2724 ,fft_filter_lat = config_flags%fft_filter_lat &
2725 ,dclat = dclat &
2726 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2727 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2728 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2729 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2730 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2731 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2732 ,MU=grid%mu_2 , MUB=grid%mub &
2733 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2734 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2735 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2736 END DO
2737 END IF
2738 END IF ! polar filter test
2740 !-----------------------------------------------------------
2741 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
2742 !-----------------------------------------------------------
2744 !-----------------------------------------------------------
2745 ! Stencils for patch communications (WCS, 29 June 2001)
2746 !
2747 ! here's where we need a wide comm stencil - these are the
2748 ! uncoupled variables so are used for high order calc in
2749 ! advection and mixong routines.
2750 !
2751 !
2752 ! * * * * * * *
2753 ! * * * * * * * * * * * *
2754 ! * * * * * * * * * * * * *
2755 ! * + * * * + * * * * * + * * *
2756 ! * * * * * * * * * * * * *
2757 ! * * * * * * * * * * * *
2758 ! * * * * * * *
2759 !
2760 ! al x
2761 !
2762 ! 2D variable
2763 ! mu_2 x
2764 !
2765 ! (adv order <=4)
2766 ! u_2 x
2767 ! v_2 x
2768 ! w_2 x
2769 ! t_2 x
2770 ! ph_2 x
2771 !
2772 ! (adv order <=6)
2773 ! u_2 x
2774 ! v_2 x
2775 ! w_2 x
2776 ! t_2 x
2777 ! ph_2 x
2778 !
2779 ! 4D variable
2780 ! moist x
2781 ! chem x
2782 ! scalar x
2784 #ifdef DM_PARALLEL
2785 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2786 # include "HALO_EM_D2_3.inc"
2787 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2788 # include "HALO_EM_D2_5.inc"
2789 ELSE
2790 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2791 CALL wrf_error_fatal(TRIM(wrf_err_message))
2792 ENDIF
2793 # include "PERIOD_BDY_EM_D.inc"
2794 # include "PERIOD_BDY_EM_MOIST2.inc"
2795 # include "PERIOD_BDY_EM_CHEM2.inc"
2796 # include "PERIOD_BDY_EM_TRACER2.inc"
2797 # include "PERIOD_BDY_EM_SCALAR2.inc"
2798 #endif
2800 BENCH_START(bc_end_tim)
2801 !$OMP PARALLEL DO &
2802 !$OMP PRIVATE ( ij )
2803 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
2804 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
2806 CALL rk_phys_bc_dry_2( config_flags, &
2807 grid%u_2, grid%v_2, grid%w_2, &
2808 grid%t_2, grid%ph_2, grid%mu_2, &
2809 ids, ide, jds, jde, kds, kde, &
2810 ims, ime, jms, jme, kms, kme, &
2811 ips, ipe, jps, jpe, kps, kpe, &
2812 grid%i_start(ij), grid%i_end(ij), &
2813 grid%j_start(ij), grid%j_end(ij), &
2814 k_start , k_end )
2816 BENCH_START(diag_w_tim)
2817 IF (.not. config_flags%non_hydrostatic) THEN
2818 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk, &
2819 grid%u_2, grid%v_2, grid%ht, &
2820 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
2821 ids, ide, jds, jde, kds, kde, &
2822 ims, ime, jms, jme, kms, kme, &
2823 grid%i_start(ij), grid%i_end(ij), &
2824 grid%j_start(ij), grid%j_end(ij), &
2825 k_start , k_end )
2826 ENDIF
2827 BENCH_END(diag_w_tim)
2829 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2831 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
2833 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
2834 ids, ide, jds, jde, kds, kde, &
2835 ims, ime, jms, jme, kms, kme, &
2836 ips, ipe, jps, jpe, kps, kpe, &
2837 grid%i_start(ij), grid%i_end(ij), &
2838 grid%j_start(ij), grid%j_end(ij), &
2839 k_start , k_end )
2840 END DO moisture_loop_bdy_1
2842 ENDIF
2844 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2846 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
2848 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
2849 ids, ide, jds, jde, kds, kde, &
2850 ims, ime, jms, jme, kms, kme, &
2851 ips, ipe, jps, jpe, kps, kpe, &
2852 grid%i_start(ij), grid%i_end(ij), &
2853 grid%j_start(ij), grid%j_end(ij), &
2854 k_start , k_end-1 )
2856 END DO chem_species_bdy_loop_1
2858 END IF
2860 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2862 tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
2864 CALL set_physical_bc3d( tracer(ims,kms,jms,ic), 'p', config_flags, &
2865 ids, ide, jds, jde, kds, kde, &
2866 ims, ime, jms, jme, kms, kme, &
2867 ips, ipe, jps, jpe, kps, kpe, &
2868 grid%i_start(ij), grid%i_end(ij), &
2869 grid%j_start(ij), grid%j_end(ij), &
2870 k_start , k_end-1 )
2872 END DO tracer_species_bdy_loop_1
2874 END IF
2876 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2878 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
2880 CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags, &
2881 ids, ide, jds, jde, kds, kde, &
2882 ims, ime, jms, jme, kms, kme, &
2883 ips, ipe, jps, jpe, kps, kpe, &
2884 grid%i_start(ij), grid%i_end(ij), &
2885 grid%j_start(ij), grid%j_end(ij), &
2886 k_start , k_end-1 )
2888 END DO scalar_species_bdy_loop_1
2890 END IF
2892 IF (config_flags%km_opt .eq. 2) THEN
2894 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
2895 ids, ide, jds, jde, kds, kde, &
2896 ims, ime, jms, jme, kms, kme, &
2897 ips, ipe, jps, jpe, kps, kpe, &
2898 grid%i_start(ij), grid%i_end(ij), &
2899 grid%j_start(ij), grid%j_end(ij), &
2900 k_start , k_end )
2901 END IF
2903 END DO tile_bc_loop_1
2904 !$OMP END PARALLEL DO
2905 BENCH_END(bc_end_tim)
2908 #ifdef DM_PARALLEL
2910 ! * * * * *
2911 ! * * * * * * * * *
2912 ! * + * * + * * * + * *
2913 ! * * * * * * * * *
2914 ! * * * * *
2916 ! moist, chem, scalar, tke x
2919 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2920 IF ( (config_flags%tke_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2921 # include "HALO_EM_TKE_5.inc"
2922 ELSE
2923 # include "HALO_EM_TKE_3.inc"
2924 ENDIF
2925 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2926 IF ( (config_flags%tke_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2927 # include "HALO_EM_TKE_7.inc"
2928 ELSE
2929 # include "HALO_EM_TKE_5.inc"
2930 ENDIF
2931 ELSE
2932 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2933 CALL wrf_error_fatal(TRIM(wrf_err_message))
2934 ENDIF
2936 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
2937 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2938 IF ( (config_flags%moist_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2939 # include "HALO_EM_MOIST_E_5.inc"
2940 ELSE
2941 # include "HALO_EM_MOIST_E_3.inc"
2942 END IF
2943 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2944 IF ( (config_flags%moist_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2945 # include "HALO_EM_MOIST_E_7.inc"
2946 ELSE
2947 # include "HALO_EM_MOIST_E_5.inc"
2948 END IF
2949 ELSE
2950 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2951 CALL wrf_error_fatal(TRIM(wrf_err_message))
2952 ENDIF
2953 ENDIF
2954 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
2955 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2956 IF ( (config_flags%chem_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2957 # include "HALO_EM_CHEM_E_5.inc"
2958 ELSE
2959 # include "HALO_EM_CHEM_E_3.inc"
2960 ENDIF
2961 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2962 IF ( (config_flags%chem_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2963 # include "HALO_EM_CHEM_E_7.inc"
2964 ELSE
2965 # include "HALO_EM_CHEM_E_5.inc"
2966 ENDIF
2967 ELSE
2968 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2969 CALL wrf_error_fatal(TRIM(wrf_err_message))
2970 ENDIF
2971 ENDIF
2972 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
2973 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2974 IF ( (config_flags%tracer_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2975 # include "HALO_EM_TRACER_E_5.inc"
2976 ELSE
2977 # include "HALO_EM_TRACER_E_3.inc"
2978 ENDIF
2979 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2980 IF ( (config_flags%tracer_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2981 # include "HALO_EM_TRACER_E_7.inc"
2982 ELSE
2983 # include "HALO_EM_TRACER_E_5.inc"
2984 ENDIF
2985 ELSE
2986 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2987 CALL wrf_error_fatal(TRIM(wrf_err_message))
2988 ENDIF
2989 ENDIF
2990 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
2991 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2992 IF ( (config_flags%scalar_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2993 # include "HALO_EM_SCALAR_E_5.inc"
2994 ELSE
2995 # include "HALO_EM_SCALAR_E_3.inc"
2996 ENDIF
2997 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2998 IF ( (config_flags%scalar_adv_opt /= ORIGINAL) .and. (rk_step == rk_order-1) ) THEN
2999 # include "HALO_EM_SCALAR_E_7.inc"
3000 ELSE
3001 # include "HALO_EM_SCALAR_E_5.inc"
3002 ENDIF
3003 ELSE
3004 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3005 CALL wrf_error_fatal(TRIM(wrf_err_message))
3006 ENDIF
3007 ENDIF
3008 #endif
3010 ENDIF rk_step_1_check
3013 !**********************************************************
3014 !
3015 ! end of RK predictor-corrector loop
3016 !
3017 !**********************************************************
3019 END DO Runge_Kutta_loop
3021 IF (config_flags%do_avgflx_em .EQ. 1) THEN
3022 ! Reinitialize time-averaged fluxes if history output was written after the previous time step:
3023 CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time)
3024 CALL domain_clock_get ( grid, current_time=CurrTime, &
3025 current_timestr=message2 )
3026 ! use overloaded -, .LT. operator to check whether to initialize avgflx:
3027 ! reinitialize after each history output (detect this here by comparing current time
3028 ! against last history time and time step - this code follows what's done in adapt_timestep_em):
3029 WRITE ( message , FMT = '("solve_em: old_dt =",g15.6,", dt=",g15.6," on domain ",I3)' ) &
3030 & old_dt,grid%dt,grid%id
3031 CALL wrf_debug(200,message)
3032 old_dt=min(old_dt,grid%dt)
3033 num = INT(old_dt * precision)
3034 den = precision
3035 CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3036 IF (CurrTime .lt. temp_time + dtInterval) THEN
3037 WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
3038 & TRIM(message2), grid%id
3039 CALL wrf_message(trim(message))
3040 grid%avgflx_count = 0
3041 !tile-loop for zero_avgflx
3042 !$OMP PARALLEL DO &
3043 !$OMP PRIVATE ( ij )
3045 DO ij = 1 , grid%num_tiles
3046 CALL wrf_debug(200,'In solve_em, before zero_avgflx call')
3047 CALL zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3048 & ids, ide, jds, jde, kds, kde, &
3049 & ims, ime, jms, jme, kms, kme, &
3050 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3051 & k_start , k_end, f_flux, &
3052 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3053 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3054 CALL wrf_debug(200,'In solve_em, after zero_avgflx call')
3055 ENDDO
3056 ENDIF
3058 ! Update avgflx quantities
3059 !tile-loop for upd_avgflx
3060 !$OMP PARALLEL DO &
3061 !$OMP PRIVATE ( ij )
3063 DO ij = 1 , grid%num_tiles
3064 CALL wrf_debug(200,'In solve_em, before upd_avgflx call')
3065 CALL upd_avgflx(grid%avgflx_count,grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3066 & grid%ru_m, grid%rv_m, grid%ww_m, &
3067 & ids, ide, jds, jde, kds, kde, &
3068 & ims, ime, jms, jme, kms, kme, &
3069 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3070 & k_start , k_end, f_flux, &
3071 & grid%cfu1,grid%cfd1,grid%dfu1,grid%efu1,grid%dfd1,grid%efd1, &
3072 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3073 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3074 CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
3076 ENDDO
3077 grid%avgflx_count = grid%avgflx_count + 1
3078 ENDIF
3079 !
3080 !$OMP PARALLEL DO &
3081 !$OMP PRIVATE ( ij )
3082 DO ij = 1 , grid%num_tiles
3084 BENCH_START(advance_ppt_tim)
3085 CALL wrf_debug ( 200 , ' call advance_ppt' )
3086 CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
3087 grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%pratec, grid%nca, &
3088 grid%htop,grid%hbot,grid%cutop,grid%cubot, &
3089 grid%cuppt, grid%dt, config_flags, &
3090 ids,ide, jds,jde, kds,kde, &
3091 ims,ime, jms,jme, kms,kme, &
3092 grid%i_start(ij), grid%i_end(ij), &
3093 grid%j_start(ij), grid%j_end(ij), &
3094 k_start , k_end )
3095 BENCH_END(advance_ppt_tim)
3097 ENDDO
3098 !$OMP END PARALLEL DO
3100 !<DESCRIPTION>
3101 !<pre>
3102 ! (5) time-split physics.
3103 !
3104 ! Microphysics are the only time split physics in the WRF model
3105 ! at this time. Split-physics begins with the calculation of
3106 ! needed diagnostic quantities (pressure, temperature, etc.)
3107 ! followed by a call to the microphysics driver,
3108 ! and finishes with a clean-up, storing off of a diabatic tendency
3109 ! from the moist physics, and a re-calulation of the diagnostic
3110 ! quantities pressure and density.
3111 !</pre>
3112 !</DESCRIPTION>
3114 IF( config_flags%specified .or. config_flags%nested ) THEN
3115 sz = grid%spec_zone
3116 ELSE
3117 sz = 0
3118 ENDIF
3120 IF (config_flags%mp_physics /= 0) then
3122 !$OMP PARALLEL DO &
3123 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3125 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3127 IF ( config_flags%periodic_x ) THEN
3128 its = max(grid%i_start(ij),ids)
3129 ite = min(grid%i_end(ij),ide-1)
3130 ELSE
3131 its = max(grid%i_start(ij),ids+sz)
3132 ite = min(grid%i_end(ij),ide-1-sz)
3133 ENDIF
3134 jts = max(grid%j_start(ij),jds+sz)
3135 jte = min(grid%j_end(ij),jde-1-sz)
3137 CALL wrf_debug ( 200 , ' call moist_physics_prep' )
3138 BENCH_START(moist_physics_prep_tim)
3139 CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho, &
3140 grid%al, grid%alb, grid%p, p8w, p0, grid%pb, &
3141 grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
3142 grid%z, grid%z_at_w, dz8w, &
3143 dtm, grid%h_diabatic, &
3144 config_flags,grid%fnm, grid%fnp, &
3145 ids, ide, jds, jde, kds, kde, &
3146 ims, ime, jms, jme, kms, kme, &
3147 its, ite, jts, jte, &
3148 k_start , k_end )
3149 BENCH_END(moist_physics_prep_tim)
3150 END DO scalar_tile_loop_1a
3151 !$OMP END PARALLEL DO
3153 CALL wrf_debug ( 200 , ' call microphysics_driver' )
3155 grid%sr = 0.
3156 specified_bdy = config_flags%specified .OR. config_flags%nested
3157 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3159 BENCH_START(micro_driver_tim)
3161 CALL microphysics_driver( &
3162 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3163 & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy &
3164 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3165 & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
3166 & ,RHO=rho ,SPEC_ZONE=grid%spec_zone &
3167 & ,SR=grid%sr ,TH=th_phy &
3168 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
3169 & ,WARM_RAIN=grid%warm_rain &
3170 & ,T8W=t8w &
3171 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3172 & ,NSOURCE=grid%qndropsource &
3173 #ifdef WRF_CHEM
3174 & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
3175 & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
3176 & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
3177 #endif
3178 & ,XLAND=grid%xland &
3179 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3180 & ,F_RAIN_PHY=grid%f_rain_phy &
3181 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3182 & ,MP_PHYSICS=config_flags%mp_physics &
3183 & ,ID=grid%id &
3184 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3185 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3186 #ifdef RUN_ON_GPU
3187 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3188 #endif
3189 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3190 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3191 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3192 & ,NUM_TILES=grid%num_tiles &
3193 & ,NAER=grid%naer &
3194 ! Optional
3195 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3196 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3197 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
3198 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
3199 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
3200 & , MP_RESTART_STATE=grid%mp_restart_state &
3201 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3202 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3203 & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
3204 & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
3205 & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
3206 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
3207 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
3208 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
3209 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
3210 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3211 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3212 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
3213 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3214 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
3215 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3216 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3217 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3218 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom
3219 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
3220 ! & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! "
3221 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
3222 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
3223 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
3224 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3225 & , qicuten=grid%rqicuten,mu=grid%mut &
3226 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
3227 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
3228 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
3229 ! YLIN
3230 ! RI_CURR INPUT
3231 & , RI_CURR=grid%rimi &
3232 )
3233 BENCH_END(micro_driver_tim)
3235 #if 0
3236 BENCH_START(microswap_2)
3237 ! for load balancing; communication to redistribute the points
3238 IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
3239 #include "SWAP_ETAMP_NEW.inc"
3240 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3241 #include "SWAP_WSM3.inc"
3242 ENDIF
3243 BENCH_END(microswap_2)
3244 #endif
3246 CALL wrf_debug ( 200 , ' call moist_physics_finish' )
3247 BENCH_START(moist_phys_end_tim)
3249 !$OMP PARALLEL DO &
3250 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3252 DO ij = 1 , grid%num_tiles
3254 its = max(grid%i_start(ij),ids)
3255 ite = min(grid%i_end(ij),ide-1)
3256 jts = max(grid%j_start(ij),jds)
3257 jte = min(grid%j_end(ij),jde-1)
3259 CALL microphysics_zero_outb ( &
3260 moist , num_moist , config_flags , &
3261 ids, ide, jds, jde, kds, kde, &
3262 ims, ime, jms, jme, kms, kme, &
3263 its, ite, jts, jte, &
3264 k_start , k_end )
3266 CALL microphysics_zero_outb ( &
3267 scalar , num_scalar , config_flags , &
3268 ids, ide, jds, jde, kds, kde, &
3269 ims, ime, jms, jme, kms, kme, &
3270 its, ite, jts, jte, &
3271 k_start , k_end )
3273 CALL microphysics_zero_outb ( &
3274 chem , num_chem , config_flags , &
3275 ids, ide, jds, jde, kds, kde, &
3276 ims, ime, jms, jme, kms, kme, &
3277 its, ite, jts, jte, &
3278 k_start , k_end )
3279 CALL microphysics_zero_outb ( &
3280 tracer , num_tracer , config_flags , &
3281 ids, ide, jds, jde, kds, kde, &
3282 ims, ime, jms, jme, kms, kme, &
3283 its, ite, jts, jte, &
3284 k_start , k_end )
3286 IF ( config_flags%periodic_x ) THEN
3287 its = max(grid%i_start(ij),ids)
3288 ite = min(grid%i_end(ij),ide-1)
3289 ELSE
3290 its = max(grid%i_start(ij),ids+sz)
3291 ite = min(grid%i_end(ij),ide-1-sz)
3292 ENDIF
3293 jts = max(grid%j_start(ij),jds+sz)
3294 jte = min(grid%j_end(ij),jde-1-sz)
3296 CALL microphysics_zero_outa ( &
3297 moist , num_moist , config_flags , &
3298 ids, ide, jds, jde, kds, kde, &
3299 ims, ime, jms, jme, kms, kme, &
3300 its, ite, jts, jte, &
3301 k_start , k_end )
3303 CALL microphysics_zero_outa ( &
3304 scalar , num_scalar , config_flags , &
3305 ids, ide, jds, jde, kds, kde, &
3306 ims, ime, jms, jme, kms, kme, &
3307 its, ite, jts, jte, &
3308 k_start , k_end )
3310 CALL microphysics_zero_outa ( &
3311 chem , num_chem , config_flags , &
3312 ids, ide, jds, jde, kds, kde, &
3313 ims, ime, jms, jme, kms, kme, &
3314 its, ite, jts, jte, &
3315 k_start , k_end )
3317 CALL microphysics_zero_outa ( &
3318 tracer , num_tracer , config_flags , &
3319 ids, ide, jds, jde, kds, kde, &
3320 ims, ime, jms, jme, kms, kme, &
3321 its, ite, jts, jte, &
3322 k_start , k_end )
3324 CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, &
3325 grid%h_diabatic, dtm, config_flags, &
3326 #if ( WRF_DFI_RADAR == 1 )
3327 grid%dfi_tten_rad,grid%dfi_stage, &
3328 #endif
3329 ids, ide, jds, jde, kds, kde, &
3330 ims, ime, jms, jme, kms, kme, &
3331 its, ite, jts, jte, &
3332 k_start , k_end )
3334 END DO
3335 !$OMP END PARALLEL DO
3337 ENDIF ! microphysics test
3339 !-----------------------------------------------------------
3340 ! filter for moist variables post-microphysics and end of timestep
3341 !-----------------------------------------------------------
3343 IF (config_flags%polar) THEN
3344 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3345 CALL wrf_debug ( 200 , ' call filter moist' )
3346 DO im = PARAM_FIRST_SCALAR, num_3d_m
3347 DO jj = jps, MIN(jpe,jde-1)
3348 DO kk = kps, MIN(kpe,kde-1)
3349 DO ii = ips, MIN(ipe,ide-1)
3350 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3351 ENDDO
3352 ENDDO
3353 ENDDO
3355 CALL pxft ( grid=grid &
3356 ,lineno=__LINE__ &
3357 ,flag_uv = 0 &
3358 ,flag_rurv = 0 &
3359 ,flag_wph = 0 &
3360 ,flag_ww = 0 &
3361 ,flag_t = 0 &
3362 ,flag_mu = 0 &
3363 ,flag_mut = 0 &
3364 ,flag_moist = im &
3365 ,flag_chem = 0 &
3366 ,flag_tracer = 0 &
3367 ,flag_scalar = 0 &
3368 ,positive_definite=.FALSE. &
3369 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3370 ,fft_filter_lat = config_flags%fft_filter_lat &
3371 ,dclat = dclat &
3372 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3373 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3374 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3375 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3376 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3378 DO jj = jps, MIN(jpe,jde-1)
3379 DO kk = kps, MIN(kpe,kde-1)
3380 DO ii = ips, MIN(ipe,ide-1)
3381 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3382 ENDDO
3383 ENDDO
3384 ENDDO
3385 ENDDO
3386 ENDIF
3387 ENDIF
3389 !-----------------------------------------------------------
3390 ! end filter for moist variables post-microphysics and end of timestep
3391 !-----------------------------------------------------------
3393 !$OMP PARALLEL DO &
3394 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3395 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
3397 IF ( config_flags%periodic_x ) THEN
3398 its = max(grid%i_start(ij),ids)
3399 ite = min(grid%i_end(ij),ide-1)
3400 ELSE
3401 its = max(grid%i_start(ij),ids+sz)
3402 ite = min(grid%i_end(ij),ide-1-sz)
3403 ENDIF
3404 jts = max(grid%j_start(ij),jds+sz)
3405 jte = min(grid%j_end(ij),jde-1-sz)
3407 CALL calc_p_rho_phi( moist, num_3d_m, &
3408 grid%al, grid%alb, grid%mu_2, grid%muts, &
3409 grid%ph_2, grid%p, grid%pb, grid%t_2, &
3410 p0, t0, grid%znu, grid%dnw, grid%rdnw, &
3411 grid%rdn, config_flags%non_hydrostatic, &
3412 ids, ide, jds, jde, kds, kde, &
3413 ims, ime, jms, jme, kms, kme, &
3414 its, ite, jts, jte, &
3415 k_start , k_end )
3417 END DO scalar_tile_loop_1ba
3418 !$OMP END PARALLEL DO
3419 BENCH_END(moist_phys_end_tim)
3421 IF (.not. config_flags%non_hydrostatic) THEN
3422 #ifdef DM_PARALLEL
3423 # include "HALO_EM_HYDRO_UV.inc"
3424 # include "PERIOD_EM_HYDRO_UV.inc"
3425 #endif
3426 !$OMP PARALLEL DO &
3427 !$OMP PRIVATE ( ij )
3428 DO ij = 1 , grid%num_tiles
3429 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk, &
3430 grid%u_2, grid%v_2, grid%ht, &
3431 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3432 ids, ide, jds, jde, kds, kde, &
3433 ims, ime, jms, jme, kms, kme, &
3434 grid%i_start(ij), grid%i_end(ij), &
3435 grid%j_start(ij), grid%j_end(ij), &
3436 k_start , k_end )
3438 END DO
3439 !$OMP END PARALLEL DO
3441 END IF
3443 CALL wrf_debug ( 200 , ' call chem polar filter ' )
3445 !-----------------------------------------------------------
3446 ! filter for chem and scalar variables at end of timestep
3447 !-----------------------------------------------------------
3449 IF (config_flags%polar) THEN
3451 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
3452 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
3453 DO jj = jps, MIN(jpe,jde-1)
3454 DO kk = kps, MIN(kpe,kde-1)
3455 DO ii = ips, MIN(ipe,ide-1)
3456 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3457 ENDDO
3458 ENDDO
3459 ENDDO
3461 CALL pxft ( grid=grid &
3462 ,lineno=__LINE__ &
3463 ,flag_uv = 0 &
3464 ,flag_rurv = 0 &
3465 ,flag_wph = 0 &
3466 ,flag_ww = 0 &
3467 ,flag_t = 0 &
3468 ,flag_mu = 0 &
3469 ,flag_mut = 0 &
3470 ,flag_moist = 0 &
3471 ,flag_chem = im &
3472 ,flag_tracer = 0 &
3473 ,flag_scalar = 0 &
3474 ,positive_definite=.FALSE. &
3475 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3476 ,fft_filter_lat = config_flags%fft_filter_lat &
3477 ,dclat = dclat &
3478 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3479 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3480 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3481 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3482 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3484 DO jj = jps, MIN(jpe,jde-1)
3485 DO kk = kps, MIN(kpe,kde-1)
3486 DO ii = ips, MIN(ipe,ide-1)
3487 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3488 ENDDO
3489 ENDDO
3490 ENDDO
3491 ENDDO chem_filter_loop
3492 ENDIF
3493 IF ( num_tracer >= PARAM_FIRST_SCALAR ) then
3494 tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer
3495 DO jj = jps, MIN(jpe,jde-1)
3496 DO kk = kps, MIN(kpe,kde-1)
3497 DO ii = ips, MIN(ipe,ide-1)
3498 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3499 ENDDO
3500 ENDDO
3501 ENDDO
3503 CALL pxft ( grid=grid &
3504 ,lineno=__LINE__ &
3505 ,flag_uv = 0 &
3506 ,flag_rurv = 0 &
3507 ,flag_wph = 0 &
3508 ,flag_ww = 0 &
3509 ,flag_t = 0 &
3510 ,flag_mu = 0 &
3511 ,flag_mut = 0 &
3512 ,flag_moist = 0 &
3513 ,flag_chem = 0 &
3514 ,flag_tracer = im &
3515 ,flag_scalar = 0 &
3516 ,positive_definite=.FALSE. &
3517 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3518 ,fft_filter_lat = config_flags%fft_filter_lat &
3519 ,dclat = dclat &
3520 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3521 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3522 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3523 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3524 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3526 DO jj = jps, MIN(jpe,jde-1)
3527 DO kk = kps, MIN(kpe,kde-1)
3528 DO ii = ips, MIN(ipe,ide-1)
3529 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3530 ENDDO
3531 ENDDO
3532 ENDDO
3533 ENDDO tracer_filter_loop
3534 ENDIF
3536 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
3537 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
3538 DO jj = jps, MIN(jpe,jde-1)
3539 DO kk = kps, MIN(kpe,kde-1)
3540 DO ii = ips, MIN(ipe,ide-1)
3541 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3542 ENDDO
3543 ENDDO
3544 ENDDO
3546 CALL pxft ( grid=grid &
3547 ,lineno=__LINE__ &
3548 ,flag_uv = 0 &
3549 ,flag_rurv = 0 &
3550 ,flag_wph = 0 &
3551 ,flag_ww = 0 &
3552 ,flag_t = 0 &
3553 ,flag_mu = 0 &
3554 ,flag_mut = 0 &
3555 ,flag_moist = 0 &
3556 ,flag_chem = 0 &
3557 ,flag_tracer = 0 &
3558 ,flag_scalar = im &
3559 ,positive_definite=.FALSE. &
3560 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3561 ,fft_filter_lat = config_flags%fft_filter_lat &
3562 ,dclat = dclat &
3563 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3564 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3565 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3566 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3567 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3569 DO jj = jps, MIN(jpe,jde-1)
3570 DO kk = kps, MIN(kpe,kde-1)
3571 DO ii = ips, MIN(ipe,ide-1)
3572 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3573 ENDDO
3574 ENDDO
3575 ENDDO
3576 ENDDO scalar_filter_loop
3577 ENDIF
3578 ENDIF
3580 !-----------------------------------------------------------
3581 ! end filter for chem and scalar variables at end of timestep
3582 !-----------------------------------------------------------
3584 ! We're finished except for boundary condition (and patch) update
3586 ! Boundary condition time (or communication time). At this time, we have
3587 ! implemented periodic and symmetric physical boundary conditions.
3589 ! b.c. routine for data within patch.
3591 ! we need to do both time levels of
3592 ! data because the time filter only works in the physical solution space.
3594 ! First, do patch communications for boundary conditions (periodicity)
3596 !-----------------------------------------------------------
3597 ! Stencils for patch communications (WCS, 29 June 2001)
3598 !
3599 ! here's where we need a wide comm stencil - these are the
3600 ! uncoupled variables so are used for high order calc in
3601 ! advection and mixong routines.
3602 !
3603 ! * * * * *
3604 ! * * * * * * * * *
3605 ! * + * * + * * * + * *
3606 ! * * * * * * * * *
3607 ! * * * * *
3608 !
3609 ! grid%u_1 x
3610 ! grid%u_2 x
3611 ! grid%v_1 x
3612 ! grid%v_2 x
3613 ! grid%w_1 x
3614 ! grid%w_2 x
3615 ! grid%t_1 x
3616 ! grid%t_2 x
3617 ! grid%ph_1 x
3618 ! grid%ph_2 x
3619 ! grid%tke_1 x
3620 ! grid%tke_2 x
3621 !
3622 ! 2D variables
3623 ! grid%mu_1 x
3624 ! grid%mu_2 x
3625 !
3626 ! 4D variables
3627 ! moist x
3628 ! chem x
3629 ! scalar x
3630 !----------------------------------------------------------
3633 #ifdef DM_PARALLEL
3634 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3635 # include "HALO_EM_D3_3.inc"
3636 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3637 # include "HALO_EM_D3_5.inc"
3638 ELSE
3639 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3640 CALL wrf_error_fatal(TRIM(wrf_err_message))
3641 ENDIF
3642 # include "PERIOD_BDY_EM_D3.inc"
3643 # include "PERIOD_BDY_EM_MOIST.inc"
3644 # include "PERIOD_BDY_EM_CHEM.inc"
3645 # include "PERIOD_BDY_EM_TRACER.inc"
3646 # include "PERIOD_BDY_EM_SCALAR.inc"
3647 #endif
3649 ! now set physical b.c on a patch
3651 BENCH_START(bc_2d_tim)
3652 !$OMP PARALLEL DO &
3653 !$OMP PRIVATE ( ij )
3654 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
3656 CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
3658 CALL set_phys_bc_dry_2( config_flags, &
3659 grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2, &
3660 grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2, &
3661 ids, ide, jds, jde, kds, kde, &
3662 ims, ime, jms, jme, kms, kme, &
3663 ips, ipe, jps, jpe, kps, kpe, &
3664 grid%i_start(ij), grid%i_end(ij), &
3665 grid%j_start(ij), grid%j_end(ij), &
3666 k_start , k_end )
3668 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
3669 ids, ide, jds, jde, kds, kde, &
3670 ims, ime, jms, jme, kms, kme, &
3671 ips, ipe, jps, jpe, kps, kpe, &
3672 grid%i_start(ij), grid%i_end(ij), &
3673 grid%j_start(ij), grid%j_end(ij), &
3674 k_start , k_end-1 )
3676 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
3677 ids, ide, jds, jde, kds, kde, &
3678 ims, ime, jms, jme, kms, kme, &
3679 ips, ipe, jps, jpe, kps, kpe, &
3680 grid%i_start(ij), grid%i_end(ij), &
3681 grid%j_start(ij), grid%j_end(ij), &
3682 k_start , k_end )
3684 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3686 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
3687 config_flags, &
3688 ids, ide, jds, jde, kds, kde, &
3689 ims, ime, jms, jme, kms, kme, &
3690 ips, ipe, jps, jpe, kps, kpe, &
3691 grid%i_start(ij), grid%i_end(ij), &
3692 grid%j_start(ij), grid%j_end(ij), &
3693 k_start , k_end )
3695 END DO moisture_loop_bdy_2
3697 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3699 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
3700 ids, ide, jds, jde, kds, kde, &
3701 ims, ime, jms, jme, kms, kme, &
3702 ips, ipe, jps, jpe, kps, kpe, &
3703 grid%i_start(ij), grid%i_end(ij), &
3704 grid%j_start(ij), grid%j_end(ij), &
3705 k_start , k_end )
3707 END DO chem_species_bdy_loop_2
3709 tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
3711 CALL set_physical_bc3d( tracer(ims,kms,jms,ic) , 'p', config_flags, &
3712 ids, ide, jds, jde, kds, kde, &
3713 ims, ime, jms, jme, kms, kme, &
3714 ips, ipe, jps, jpe, kps, kpe, &
3715 grid%i_start(ij), grid%i_end(ij), &
3716 grid%j_start(ij), grid%j_end(ij), &
3717 k_start , k_end )
3719 END DO tracer_species_bdy_loop_2
3721 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3723 CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags, &
3724 ids, ide, jds, jde, kds, kde, &
3725 ims, ime, jms, jme, kms, kme, &
3726 ips, ipe, jps, jpe, kps, kpe, &
3727 grid%i_start(ij), grid%i_end(ij), &
3728 grid%j_start(ij), grid%j_end(ij), &
3729 k_start , k_end )
3731 END DO scalar_species_bdy_loop_2
3733 END DO tile_bc_loop_2
3734 !$OMP END PARALLEL DO
3735 BENCH_END(bc_2d_tim)
3737 IF( config_flags%specified .or. config_flags%nested ) THEN
3738 grid%dtbc = grid%dtbc + grid%dt
3739 ENDIF
3741 ! reset surface w for consistency
3743 #ifdef DM_PARALLEL
3744 # include "HALO_EM_C.inc"
3745 # include "PERIOD_BDY_EM_E.inc"
3746 #endif
3748 CALL wrf_debug ( 10 , ' call set_w_surface' )
3749 fill_w_flag = .false.
3751 !$OMP PARALLEL DO &
3752 !$OMP PRIVATE ( ij )
3753 DO ij = 1 , grid%num_tiles
3754 CALL set_w_surface( config_flags, grid%znw, fill_w_flag, &
3755 grid%w_2, grid%ht, grid%u_2, grid%v_2, &
3756 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
3757 grid%msftx, grid%msfty, &
3758 ids, ide, jds, jde, kds, kde, &
3759 ims, ime, jms, jme, kms, kme, &
3760 grid%i_start(ij), grid%i_end(ij), &
3761 grid%j_start(ij), grid%j_end(ij), &
3762 k_start, k_end )
3763 ! its, ite, jts, jte, k_start, min(k_end,kde-1), &
3765 END DO
3766 !$OMP END PARALLEL DO
3768 ! calculate some model diagnostics.
3770 CALL wrf_debug ( 200 , ' call diagnostic_driver' )
3772 CALL diagnostic_output_calc( &
3773 & DPSDT=grid%dpsdt ,DMUDT=grid%dmudt &
3774 & ,P8W=p8w ,PK1M=grid%pk1m &
3775 & ,MU_2=grid%mu_2 ,MU_2M=grid%mu_2m &
3776 & ,U=grid%u_2 ,V=grid%v_2 &
3777 & ,RAINCV=grid%raincv ,RAINNCV=grid%rainncv &
3778 & ,RAINC=grid%rainc ,RAINNC=grid%rainnc &
3779 & ,I_RAINC=grid%i_rainc ,I_RAINNC=grid%i_rainnc &
3780 & ,HFX=grid%hfx ,SFCEVP=grid%sfcevp ,LH=grid%lh &
3781 & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width &
3782 & ,XTIME=grid%xtime ,T2=grid%t2 &
3783 & ,ACSWUPT=grid%acswupt ,ACSWUPTC=grid%acswuptc &
3784 & ,ACSWDNT=grid%acswdnt ,ACSWDNTC=grid%acswdntc &
3785 & ,ACSWUPB=grid%acswupb ,ACSWUPBC=grid%acswupbc &
3786 & ,ACSWDNB=grid%acswdnb ,ACSWDNBC=grid%acswdnbc &
3787 & ,ACLWUPT=grid%aclwupt ,ACLWUPTC=grid%aclwuptc &
3788 & ,ACLWDNT=grid%aclwdnt ,ACLWDNTC=grid%aclwdntc &
3789 & ,ACLWUPB=grid%aclwupb ,ACLWUPBC=grid%aclwupbc &
3790 & ,ACLWDNB=grid%aclwdnb ,ACLWDNBC=grid%aclwdnbc &
3791 & ,I_ACSWUPT=grid%i_acswupt ,I_ACSWUPTC=grid%i_acswuptc &
3792 & ,I_ACSWDNT=grid%i_acswdnt ,I_ACSWDNTC=grid%i_acswdntc &
3793 & ,I_ACSWUPB=grid%i_acswupb ,I_ACSWUPBC=grid%i_acswupbc &
3794 & ,I_ACSWDNB=grid%i_acswdnb ,I_ACSWDNBC=grid%i_acswdnbc &
3795 & ,I_ACLWUPT=grid%i_aclwupt ,I_ACLWUPTC=grid%i_aclwuptc &
3796 & ,I_ACLWDNT=grid%i_aclwdnt ,I_ACLWDNTC=grid%i_aclwdntc &
3797 & ,I_ACLWUPB=grid%i_aclwupb ,I_ACLWUPBC=grid%i_aclwupbc &
3798 & ,I_ACLWDNB=grid%i_aclwdnb ,I_ACLWDNBC=grid%i_aclwdnbc &
3799 ! Selection flag
3800 & ,DIAG_PRINT=config_flags%diag_print &
3801 & ,BUCKET_MM=config_flags%bucket_mm &
3802 & ,BUCKET_J =config_flags%bucket_J &
3803 & ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc &
3804 & ,PREC_ACC_C=grid%prec_acc_c &
3805 & ,PREC_ACC_NC=grid%prec_acc_nc &
3806 & ,PREC_ACC_DT=config_flags%prec_acc_dt &
3807 & ,CURR_SECS=curr_secs &
3808 ! Dimension arguments
3809 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3810 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3811 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3812 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3813 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3814 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3815 & ,NUM_TILES=grid%num_tiles &
3816 & )
3818 #ifdef DM_PARALLEL
3819 !-----------------------------------------------------------------------
3820 ! see above
3821 !--------------------------------------------------------------
3822 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
3823 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3824 # include "HALO_EM_E_3.inc"
3825 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3826 # include "HALO_EM_E_5.inc"
3827 ELSE
3828 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3829 CALL wrf_error_fatal(TRIM(wrf_err_message))
3830 ENDIF
3831 #endif
3833 #ifdef DM_PARALLEL
3834 IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
3835 !-----------------------------------------------------------------------
3836 ! see above
3837 !--------------------------------------------------------------
3838 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
3839 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3840 # include "HALO_EM_MOIST_E_3.inc"
3841 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3842 # include "HALO_EM_MOIST_E_5.inc"
3843 ELSE
3844 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3845 CALL wrf_error_fatal(TRIM(wrf_err_message))
3846 ENDIF
3847 ENDIF
3848 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3849 !-----------------------------------------------------------------------
3850 ! see above
3851 !--------------------------------------------------------------
3852 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
3853 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3854 # include "HALO_EM_CHEM_E_3.inc"
3855 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3856 # include "HALO_EM_CHEM_E_5.inc"
3857 ELSE
3858 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3859 CALL wrf_error_fatal(TRIM(wrf_err_message))
3860 ENDIF
3861 ENDIF
3862 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3863 !-----------------------------------------------------------------------
3864 ! see above
3865 !--------------------------------------------------------------
3866 CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' )
3867 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3868 # include "HALO_EM_TRACER_E_3.inc"
3869 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3870 # include "HALO_EM_TRACER_E_5.inc"
3871 ELSE
3872 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3873 CALL wrf_error_fatal(TRIM(wrf_err_message))
3874 ENDIF
3875 ENDIF
3876 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3877 !-----------------------------------------------------------------------
3878 ! see above
3879 !--------------------------------------------------------------
3880 CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
3881 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3882 # include "HALO_EM_SCALAR_E_3.inc"
3883 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3884 # include "HALO_EM_SCALAR_E_5.inc"
3885 ELSE
3886 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3887 CALL wrf_error_fatal(TRIM(wrf_err_message))
3888 ENDIF
3889 ENDIF
3890 #endif
3892 ! Max values of CFL for adaptive time step scheme
3894 DEALLOCATE(max_vert_cfl_tmp)
3895 DEALLOCATE(max_horiz_cfl_tmp)
3897 CALL wrf_debug ( 200 , ' call end of solve_em' )
3899 ! Finish timers if compiled with -DBENCH.
3900 #include <bench_solve_em_end.h>
3902 RETURN
3904 END SUBROUTINE solve_em