| blob | 789c62d591b55dbd615aa97806a29d543766e9ad |
1 !WRF+/TL:MEDIATION_LAYER:SOLVER FOR TL
2 !Created by Xin Zhang and Ning Pan, 2010-08
4 SUBROUTINE solve_em_tl ( grid , config_flags &
5 ! Arguments generated from Registry
6 #include "dummy_new_args.inc"
7 !
8 )
9 ! Driver layer modules
10 USE module_state_description
11 USE module_domain, ONLY : &
12 domain, get_ijk_from_grid, get_ijk_from_subgrid &
13 ,domain_get_current_time, domain_get_start_time &
14 ,domain_get_sim_start_time, domain_clock_get,is_alarm_tstep
15 USE module_domain_type, ONLY : history_alarm, restart_alarm
16 USE module_configure, ONLY : grid_config_rec_type
17 USE module_driver_constants
18 USE module_machine
19 USE module_tiles, ONLY : set_tiles
20 #ifdef DM_PARALLEL
21 USE module_dm, ONLY : &
22 local_communicator, mytask, ntasks, ntasks_x, ntasks_y &
23 ,local_communicator_periodic, wrf_dm_maxval
24 USE module_comm_dm, ONLY : &
25 halo_em_a_tl_sub,halo_em_b_tl_sub,halo_em_c2_tl_sub,halo_em_chem_e_3_sub &
26 ,halo_em_chem_e_5_sub,halo_em_chem_e_7_sub,halo_em_chem_old_e_5_sub &
27 ,halo_em_chem_old_e_7_sub,halo_em_c_tl_sub,halo_em_d2_3_tl_sub &
28 ,halo_em_d2_5_tl_sub,halo_em_d3_3_tl_sub,halo_em_d3_5_tl_sub,halo_em_d_tl_sub &
29 ,halo_em_e_3_tl_sub,halo_em_e_5_tl_sub,halo_em_hydro_uv_tl_sub &
30 ,halo_em_moist_e_3_tl_sub,halo_em_moist_e_5_tl_sub,halo_em_moist_e_7_tl_sub &
31 ,halo_em_moist_old_e_5_tl_sub,halo_em_moist_old_e_7_tl_sub &
32 ,halo_em_scalar_e_3_sub,halo_em_scalar_e_5_sub,halo_em_scalar_e_7_sub &
33 ,halo_em_scalar_old_e_5_sub,halo_em_scalar_old_e_7_sub,halo_em_tke_3_tl_sub &
34 ,halo_em_tke_5_tl_sub,halo_em_tke_7_tl_sub,halo_em_tke_advect_3_tl_sub &
35 ,halo_em_tke_advect_5_tl_sub,halo_em_tke_old_e_5_tl_sub &
36 ,halo_em_tke_old_e_7_tl_sub,halo_em_tracer_e_3_tl_sub,halo_em_tracer_e_5_tl_sub &
37 ,halo_em_tracer_e_7_tl_sub,halo_em_tracer_old_e_5_tl_sub &
38 ,halo_em_tracer_old_e_7_tl_sub,period_bdy_em_a_sub,halo_em_sbm_tl_sub &
39 ,period_bdy_em_b3_sub,period_bdy_em_b_sub,period_bdy_em_chem2_sub &
40 ,period_bdy_em_chem_old_sub,period_bdy_em_chem_sub,period_bdy_em_d3_sub &
41 ,period_bdy_em_d_sub,period_bdy_em_e_sub,period_bdy_em_moist2_sub &
42 ,period_bdy_em_moist_old_sub,period_bdy_em_moist_sub &
43 ,period_bdy_em_scalar2_sub,period_bdy_em_scalar_old_sub &
44 ,period_bdy_em_scalar_sub,period_bdy_em_tke_old_sub,period_bdy_em_tke_sub &
45 ,period_bdy_em_tracer2_sub,period_bdy_em_tracer_old_sub &
46 ,period_bdy_em_tracer_sub,period_em_da_sub,period_em_hydro_uv_sub
47 #endif
48 USE module_utility
49 ! Mediation layer modules
50 ! Model layer modules
51 USE module_model_constants
52 USE g_module_small_step_em
53 USE module_em
54 USE g_module_em
55 USE g_module_big_step_utilities_em
56 USE g_module_bc
57 USE module_bc_em
58 USE g_module_bc_em
59 USE module_solvedebug_em
60 USE g_module_physics_addtendc
61 USE g_module_diffusion_em
62 USE module_polarfft
63 USE g_module_microphysics_driver
64 USE module_microphysics_zero_out
65 USE g_module_microphysics_zero_out
66 USE module_fddaobs_driver
67 ! USE module_diagnostics
68 #if (WRF_CHEM==1)
69 USE module_input_chem_data
70 USE module_input_tracer
71 USE module_chem_utilities
72 #endif
73 USE g_module_first_rk_step_part1
74 USE g_module_first_rk_step_part2
75 USE module_after_all_rk_steps
76 USE module_llxy, ONLY : proj_cassini
77 USE module_avgflx_em, ONLY : zero_avgflx, upd_avgflx
79 IMPLICIT NONE
81 ! Input data.
83 TYPE(domain) , TARGET :: grid
85 ! Definitions of dummy arguments to this routine (generated from Registry).
86 #include "dummy_new_decl.inc"
88 ! Structure that contains run-time configuration (namelist) data for domain
89 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
91 ! Local data
93 INTEGER :: k_start , k_end, its, ite, jts, jte
94 INTEGER :: ids , ide , jds , jde , kds , kde , &
95 ims , ime , jms , jme , kms , kme , &
96 ips , ipe , jps , jpe , kps , kpe
98 INTEGER :: sids , side , sjds , sjde , skds , skde , &
99 sims , sime , sjms , sjme , skms , skme , &
100 sips , sipe , sjps , sjpe , skps , skpe
103 INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
104 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
105 imsy, imey, jmsy, jmey, kmsy, kmey, &
106 ipsy, ipey, jpsy, jpey, kpsy, kpey
108 INTEGER :: ij , iteration
109 INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
110 INTEGER :: loop
111 INTEGER :: sz
112 INTEGER :: iswater
114 LOGICAL :: specified_bdy, channel_bdy
116 REAL :: t_new
118 LOGICAL :: feedback_is_ready ! CMAQ
120 ! Changes in tendency at this timestep
121 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
122 z_tendency
123 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: g_h_tendency, &
124 g_z_tendency
126 ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
127 LOGICAL :: tenddec
129 ! Flag for producing diagnostic fields (e.g., radar reflectivity)
130 LOGICAL :: diag_flag
132 #if (WRF_CHEM==1)
133 ! Index cross-referencing array for tendency accumulation
134 INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
135 #endif
137 ! storage for tendencies and decoupled state (generated from Registry)
139 #include "i1_decl.inc"
140 ! Previous time level of tracer arrays now defined as i1 variables;
141 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
142 ! Benefit: save memory in nested runs, since only 1 domain is active at a
143 ! time. Potential problem on stack-limited architectures: increases
144 ! amount of data on program stack by making these automatic arrays.
146 INTEGER :: rc
147 INTEGER :: number_of_small_timesteps, rk_step
148 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
149 INTEGER :: idum1, idum2, dynamics_option
151 INTEGER :: rk_order, iwmax, jwmax, kwmax
152 REAL :: dt_rk, dts_rk, dts, dtm, wmax
153 REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp
154 LOGICAL :: leapfrog
155 INTEGER :: l,kte,kk
156 LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd
157 REAL :: curr_secs, curr_secs2
158 INTEGER :: num_sound_steps
159 INTEGER :: idex, jdex
160 REAL :: max_msft
161 REAL :: spacing
163 INTEGER :: ii, jj !kk is above after l,kte
164 REAL :: dclat
165 INTEGER :: debug_level
167 ! urban related variables
168 INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
170 TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2
171 REAL :: real_time
172 LOGICAL :: adapt_step_flag
173 LOGICAL :: fill_w_flag
175 ! variables for flux-averaging code 20091223
176 CHARACTER*256 :: message, message2
177 REAL :: old_dt
178 TYPE(WRFU_Time) :: temp_time, CurrTime, restart_time
179 INTEGER, PARAMETER :: precision = 100
180 INTEGER :: num, den
181 TYPE(WRFU_TimeInterval) :: dtInterval, intervaltime,restartinterval
183 ! Define benchmarking timers if -DBENCH is compiled
184 #include "bench_solve_em_def.h"
186 !----------------------
187 ! Executable statements
188 !----------------------
190 !<DESCRIPTION>
191 !<pre>
192 ! solve_em_tl is the main driver for advancing a grid a single timestep.
193 ! It is a mediation-layer routine -> DM and SM calls are made where
194 ! needed for parallel processing.
195 !
196 ! solve_em_tl can integrate the equations using 3 time-integration methods
197 !
198 ! - 3rd order Runge-Kutta time integration (recommended)
199 !
200 ! - 2nd order Runge-Kutta time integration
201 !
202 ! The main sections of solve_em_tl are
203 !
204 ! (1) Runge-Kutta (RK) loop
205 !
206 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
207 ! model state variables during the first RK sub-step (loop)
208 !
209 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
210 !
211 ! (4) scalar advance for moist and chem scalar variables (and TKE)
212 ! within the RK sub-steps.
213 !
214 ! (5) time-split physics (after the RK step), currently this includes
215 ! only microphyics
216 !
217 ! A more detailed description of these sections follows.
218 !</pre>
219 !</DESCRIPTION>
221 ! Initialize timers if compiled with -DBENCH
222 #include "bench_solve_em_init.h"
224 feedback_is_ready = .false.
225 ! set runge-kutta solver (2nd or 3rd order)
227 dynamics_option = config_flags%rk_ord
229 ! Obtain dimension information stored in the grid data structure.
231 CALL get_ijk_from_grid ( grid , &
232 ids, ide, jds, jde, kds, kde, &
233 ims, ime, jms, jme, kms, kme, &
234 ips, ipe, jps, jpe, kps, kpe, &
235 imsx, imex, jmsx, jmex, kmsx, kmex, &
236 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
237 imsy, imey, jmsy, jmey, kmsy, kmey, &
238 ipsy, ipey, jpsy, jpey, kpsy, kpey )
240 CALL get_ijk_from_subgrid ( grid , &
241 sids, side, sjds, sjde, skds, skde, &
242 sims, sime, sjms, sjme, skms, skme, &
243 sips, sipe, sjps, sjpe, skps, skpe )
244 k_start = kps
245 k_end = kpe
247 num_3d_m = num_moist
248 num_3d_c = num_chem
249 num_3d_s = num_scalar
251 f_flux = config_flags%do_avgflx_cugd .EQ. 1
253 ! Compute these starting and stopping locations for each tile and number of tiles.
254 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
255 CALL set_tiles ( ZONE_SOLVE_EM, grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
256 ! CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
258 ! Max values of CFL for adaptive time step scheme
260 ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
261 ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
263 !
264 ! Calculate current time in seconds since beginning of model run.
265 ! Unfortunately, ESMF does not seem to have a way to return
266 ! floating point seconds based on a TimeInterval. So, we will
267 ! calculate it here--but, this is not clean!!
268 !
269 tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid )
270 tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid )
271 curr_secs = real_time(tmpTimeInterval)
272 curr_secs2 = real_time(tmpTimeInterval2)
274 old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop
275 !-----------------------------------------------------------------------------
276 ! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07
277 ! In this call, we do the time-step adaptation and set time-dependent lateral
278 ! boundary condition nudging weights.
279 !
280 IF ( (config_flags%use_adaptive_time_step) .and. &
281 ( (.not. grid%nested) .or. &
282 ( (grid%nested) .and. (abs(grid%dtbc) < 0.0001) ) ) )THEN
283 CALL adapt_timestep(grid, config_flags)
284 adapt_step_flag = .TRUE.
285 ELSE
286 adapt_step_flag = .FALSE.
287 ENDIF
288 ! End of adaptive time step modifications
289 !-----------------------------------------------------------------------------
290 !
291 ! Set diagnostic flag value history output time
292 !-----------------------------------------------------------------------------
293 ! if ( Is_alarm_tstep(grid_clock, grid_alarms(HISTORY_ALARM)) ) then
294 diag_flag = .false.
295 if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(HISTORY_ALARM)) ) then
296 diag_flag = .true.
297 endif
299 grid%itimestep = grid%itimestep + 1
301 IF (config_flags%enable_identity) RETURN
303 IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
305 rk_order = config_flags%rk_ord
307 IF ( grid%time_step_sound == 0 ) THEN
308 ! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
309 spacing = min(grid%dx, grid%dy)
310 IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
311 max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
312 1.0/COS(config_flags%fft_filter_lat*degrad) )
313 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
314 ELSE IF ( config_flags%use_adaptive_time_step ) THEN
315 max_msft= MAX(grid%max_msftx, grid%max_msfty)
316 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
317 ELSE
318 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 )
319 END IF
320 WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
321 CALL wrf_debug ( 50 , wrf_err_message )
322 ELSE
323 num_sound_steps = grid%time_step_sound
324 ENDIF
326 dts = grid%dt/float(num_sound_steps)
328 IF (config_flags%use_adaptive_time_step) THEN
330 CALL get_wrf_debug_level( debug_level )
331 IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
332 #ifdef DM_PARALLEL
333 CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
334 #endif
335 WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
336 grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
337 CALL wrf_debug ( 0 , wrf_err_message )
338 ENDIF
340 grid%max_cfl_val = 0
341 grid%max_horiz_cfl = 0
342 grid%max_vert_cfl = 0
343 ENDIF
345 ! setting bdy tendencies to zero for DFI if constant_bc = true
347 !$OMP PARALLEL DO &
348 !$OMP PRIVATE ( ij )
349 DO ij = 1 , grid%num_tiles
351 ! IF( config_flags%specified .AND. grid%dfi_opt .NE. DFI_NODFI &
352 ! .AND. config_flags%constant_bc .AND. (grid%dfi_stage .EQ. DFI_BCK .OR. grid%dfi_stage .EQ. DFI_FWD) ) THEN
353 IF( config_flags%specified .AND. config_flags%constant_bc ) THEN
355 CALL g_zero_bdytend (grid%u_btxs,grid%g_u_btxs,grid%u_btxe,grid%g_u_btxe, &
356 grid%u_btys,grid%g_u_btys,grid%u_btye,grid%g_u_btye, &
357 grid%v_btxs,grid%g_v_btxs,grid%v_btxe,grid%g_v_btxe, &
358 grid%v_btys,grid%g_v_btys,grid%v_btye,grid%g_v_btye, &
359 grid%ph_btxs,grid%g_ph_btxs,grid%ph_btxe,grid%g_ph_btxe, &
360 grid%ph_btys,grid%g_ph_btys,grid%ph_btye,grid%g_ph_btye, &
361 grid%t_btxs,grid%g_t_btxs,grid%t_btxe,grid%g_t_btxe, &
362 grid%t_btys,grid%g_t_btys,grid%t_btye,grid%g_t_btye, &
363 grid%w_btxs,grid%g_w_btxs,grid%w_btxe,grid%g_w_btxe, &
364 grid%w_btys,grid%g_w_btys,grid%w_btye,grid%g_w_btye, &
365 grid%mu_btxs,grid%g_mu_btxs,grid%mu_btxe,grid%g_mu_btxe, &
366 grid%mu_btys,grid%g_mu_btys,grid%mu_btye,grid%g_mu_btye, &
367 moist_btxs,g_moist_btxs,moist_btxe,g_moist_btxe, &
368 moist_btys,g_moist_btys,moist_btye,g_moist_btye, &
369 scalar_btxs,g_scalar_btxs,scalar_btxe,g_scalar_btxe, &
370 scalar_btys,g_scalar_btys,scalar_btye,g_scalar_btye, &
371 grid%spec_bdy_width,num_3d_m,num_3d_s, &
372 ids,ide, jds,jde, kds,kde, &
373 ims,ime, jms,jme, kms,kme, &
374 ips,ipe, jps,jpe, kps,kpe, &
375 grid%i_start(ij), grid%i_end(ij), &
376 grid%j_start(ij), grid%j_end(ij), &
377 k_start, k_end )
380 ENDIF
381 ENDDO
382 !$OMP END PARALLEL DO
384 !**********************************************************************
385 !
386 ! LET US BEGIN.......
387 !
388 !<DESCRIPTION>
389 !<pre>
390 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
391 !
392 ! Predictor-corrector type time integration.
393 ! Advection terms are evaluated at time t for the predictor step,
394 ! and advection is re-evaluated with the latest predicted value for
395 ! each succeeding time corrector step
396 !
397 ! 2nd order Runge Kutta (rk_order = 2):
398 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
399 !
400 ! 3rd order Runge Kutta (rk_order = 3):
401 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
402 ! and step 3 is from t to dt.
403 !
404 ! non-timesplit physics are evaluated during first RK step and
405 ! these physics tendencies are stored for use in each RK pass.
406 !</pre>
407 !</DESCRIPTION>
408 !**********************************************************************
410 Runge_Kutta_loop: DO rk_step = 1, rk_order
412 ! Set the step size and number of small timesteps for
413 ! each part of the timestep
415 dtm = grid%dt
416 IF ( rk_order == 1 ) THEN
418 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
419 CALL wrf_error_fatal( wrf_err_message )
421 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
423 IF ( rk_step == 1) THEN
424 dt_rk = 0.5*grid%dt
425 dts_rk = dts
426 number_of_small_timesteps = num_sound_steps/2
427 ELSE
428 dt_rk = grid%dt
429 dts_rk = dts
430 number_of_small_timesteps = num_sound_steps
431 ENDIF
433 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
435 IF ( rk_step == 1) THEN
436 dt_rk = grid%dt/3.
437 dts_rk = dt_rk
438 number_of_small_timesteps = 1
439 ELSE IF (rk_step == 2) THEN
440 dt_rk = 0.5*grid%dt
441 dts_rk = dts
442 number_of_small_timesteps = num_sound_steps/2
443 ELSE
444 dt_rk = grid%dt
445 dts_rk = dts
446 number_of_small_timesteps = num_sound_steps
447 ENDIF
449 ELSE
451 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
452 CALL wrf_error_fatal( wrf_err_message )
454 END IF
456 ! Ensure that polar meridional velocity is zero
457 IF (config_flags%polar) THEN
459 WRITE(wrf_err_message,*)'solve_em_tl: please revisit polar = ',config_flags%polar
460 CALL wrf_error_fatal(TRIM(wrf_err_message))
462 ! !$OMP PARALLEL DO &
463 ! !$OMP PRIVATE ( ij )
464 ! DO ij = 1 , grid%num_tiles
465 ! CALL zero_pole ( grid%v_1, &
466 ! ids, ide, jds, jde, kds, kde, &
467 ! ims, ime, jms, jme, kms, kme, &
468 ! grid%i_start(ij), grid%i_end(ij), &
469 ! grid%j_start(ij), grid%j_end(ij), &
470 ! k_start, k_end )
471 ! CALL zero_pole ( grid%v_2, &
472 ! ids, ide, jds, jde, kds, kde, &
473 ! ims, ime, jms, jme, kms, kme, &
474 ! grid%i_start(ij), grid%i_end(ij), &
475 ! grid%j_start(ij), grid%j_end(ij), &
476 ! k_start, k_end )
477 ! END DO
478 ! !$OMP END PARALLEL DO
479 END IF
480 !
481 ! Time level t is in the *_2 variable in the first part
482 ! of the step, and in the *_1 variable after the predictor.
483 ! the latest predicted values are stored in the *_2 variables.
484 !
485 CALL wrf_debug ( 200 , ' call g_rk_step_prep ' )
487 BENCH_START(g_step_prep_tim)
488 !$OMP PARALLEL DO &
489 !$OMP PRIVATE ( ij )
491 DO ij = 1 , grid%num_tiles
493 CALL g_rk_step_prep ( config_flags, rk_step, &
494 grid%u_2, grid%g_u_2, grid%v_2, grid%g_v_2, &
495 grid%w_2, grid%g_w_2, grid%t_2, grid%g_t_2, &
496 grid%ph_2, grid%g_ph_2, grid%mu_2, grid%g_mu_2, &
497 moist, g_moist, &
498 grid%ru, grid%g_ru, grid%rv, grid%g_rv, grid%rw, grid%g_rw, &
499 grid%ww, grid%g_ww, grid%php, grid%g_php, grid%alt, grid%g_alt, &
500 grid%muu, grid%g_muu, grid%muv, grid%g_muv, &
501 grid%mub, grid%mut, grid%g_mut, &
502 grid%phb, grid%pb, grid%p, grid%g_p, grid%al, grid%g_al, grid%alb, &
503 cqu, g_cqu, cqv, g_cqv, cqw, g_cqw, &
504 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
505 grid%msfvy, grid%msftx, grid%msfty, &
506 grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
507 num_3d_m, &
508 ids, ide, jds, jde, kds, kde, &
509 ims, ime, jms, jme, kms, kme, &
510 grid%i_start(ij), grid%i_end(ij), &
511 grid%j_start(ij), grid%j_end(ij), &
512 k_start, k_end )
514 END DO
515 !$OMP END PARALLEL DO
516 BENCH_END(g_step_prep_tim)
518 #ifdef DM_PARALLEL
519 !-----------------------------------------------------------------------
520 ! Stencils for patch communications (WCS, 29 June 2001)
521 ! Note: the small size of this halo exchange reflects the
522 ! fact that we are carrying the uncoupled variables
523 ! as state variables in the mass coordinate model, as
524 ! opposed to the coupled variables as in the height
525 ! coordinate model.
526 !
527 ! * * * * *
528 ! * * * * * * * * *
529 ! * + * * + * * * + * *
530 ! * * * * * * * * *
531 ! * * * * *
532 !
533 ! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
534 !
535 ! ru x
536 ! rv x
537 ! ww x
538 ! php x
539 ! alt x
540 ! ph_2 x
541 ! phb x
542 !
543 ! the following are 2D (xy) variables
544 !
545 ! muu x
546 ! muv x
547 ! mut x
548 !--------------------------------------------------------------
549 # include "HALO_EM_A_TL.inc"
550 #endif
552 ! set boundary conditions on variables
553 ! from big_step_prep for use in big_step_proc
555 #ifdef DM_PARALLEL
556 # include "PERIOD_BDY_EM_A.inc"
557 #endif
559 BENCH_START(g_set_phys_bc_tim)
560 !$OMP PARALLEL DO &
561 !$OMP PRIVATE ( ij, ii, jj, kk )
563 DO ij = 1 , grid%num_tiles
565 CALL wrf_debug ( 200 , ' call g_rk_phys_bc_dry_1' )
567 CALL g_rk_phys_bc_dry_1( config_flags, grid%ru,grid%g_ru, grid%rv,grid%g_rv, &
568 grid%rw,grid%g_rw, grid%ww,grid%g_ww, &
569 grid%muu,grid%g_muu, grid%muv,grid%g_muv, grid%mut,grid%g_mut, &
570 grid%php,grid%g_php, grid%alt,grid%g_alt, grid%p,grid%g_p, &
571 ids, ide, jds, jde, kds, kde, &
572 ims, ime, jms, jme, kms, kme, &
573 ips, ipe, jps, jpe, kps, kpe, &
574 grid%i_start(ij), grid%i_end(ij), &
575 grid%j_start(ij), grid%j_end(ij), &
576 k_start, k_end )
577 CALL g_set_physical_bc3d( grid%al,grid%g_al, 'p', config_flags, &
578 ids, ide, jds, jde, kds, kde, &
579 ims, ime, jms, jme, kms, kme, &
580 ips, ipe, jps, jpe, kps, kpe, &
581 grid%i_start(ij), grid%i_end(ij), &
582 grid%j_start(ij), grid%j_end(ij), &
583 k_start , k_end )
584 CALL g_set_physical_bc3d( grid%ph_2,grid%g_ph_2, 'w', config_flags, &
585 ids, ide, jds, jde, kds, kde, &
586 ims, ime, jms, jme, kms, kme, &
587 ips, ipe, jps, jpe, kps, kpe, &
588 grid%i_start(ij), grid%i_end(ij), &
589 grid%j_start(ij), grid%j_end(ij), &
590 k_start, k_end )
592 IF (config_flags%polar) THEN
594 WRITE(wrf_err_message,*)'solve_em_tl: please revisit polar = ',config_flags%polar
595 CALL wrf_error_fatal(TRIM(wrf_err_message))
596 !-------------------------------------------------------
597 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
598 !-------------------------------------------------------
600 ! CALL pole_point_bc ( grid%v_1, &
601 ! ids, ide, jds, jde, kds, kde, &
602 ! ims, ime, jms, jme, kms, kme, &
603 ! grid%i_start(ij), grid%i_end(ij), &
604 ! grid%j_start(ij), grid%j_end(ij), &
605 ! k_start, k_end )
607 ! CALL pole_point_bc ( grid%v_2, &
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 !-------------------------------------------------------
615 ! end lat-lon grid pole-point (v) specification
616 !-------------------------------------------------------
618 ENDIF
619 END DO
620 !$OMP END PARALLEL DO
621 BENCH_END(g_set_phys_bc_tim)
623 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
625 !<DESCRIPTION>
626 !<pre>
627 !(2) The non-timesplit physics begins with a call to "phy_prep"
628 ! (which computes some diagnostic variables such as temperature,
629 ! pressure, u and v at p points, etc). This is followed by
630 ! calls to the physics drivers:
631 !
632 ! radiation,
633 ! surface,
634 ! pbl,
635 ! cumulus,
636 ! fddagd,
637 ! 3D TKE and mixing.
638 !<pre>
639 !</DESCRIPTION>
641 CALL g_first_rk_step_part1 ( grid , config_flags &
642 , moist , g_moist, moist_tend, g_moist_tend &
643 , chem , chem_tend &
644 , tracer, g_tracer, tracer_tend, g_tracer_tend &
645 , scalar , g_scalar, scalar_tend, g_scalar_tend &
646 , fdda3d, fdda2d &
647 , aerod &
648 , ru_tendf,g_ru_tendf,rv_tendf,g_rv_tendf &
649 , rw_tendf,g_rw_tendf, t_tendf ,g_t_tendf &
650 , ph_tendf,g_ph_tendf, mu_tendf,g_mu_tendf &
651 , tke_tend,g_tke_tend &
652 , config_flags%use_adaptive_time_step &
653 , curr_secs &
654 , psim ,psih &
655 , gz1oz0 , chklowq &
656 , cu_act_flag , hol , th_phy ,g_th_phy &
657 , pi_phy ,g_pi_phy, p_phy ,g_p_phy, grid%t_phy ,grid%g_t_phy &
658 , dz8w ,g_dz8w , p8w ,g_p8w , t8w ,g_t8w &
659 , ids, ide, jds, jde, kds, kde &
660 , ims, ime, jms, jme, kms, kme &
661 , ips, ipe, jps, jpe, kps, kpe &
662 , imsx,imex,jmsx,jmex,kmsx,kmex &
663 , ipsx,ipex,jpsx,jpex,kpsx,kpex &
664 , imsy,imey,jmsy,jmey,kmsy,kmey &
665 , ipsy,ipey,jpsy,jpey,kpsy,kpey &
666 , k_start , k_end &
667 , f_flux=f_flux &
668 , feedback_is_ready=feedback_is_ready &
669 )
671 #ifdef DM_PARALLEL
672 IF ( config_flags%bl_pbl_physics == MYNNPBLSCHEME2 .OR. &
673 config_flags%bl_pbl_physics == MYNNPBLSCHEME3 ) THEN
674 # include "HALO_EM_SCALAR_E_5.inc"
675 ENDIF
676 #endif
678 CALL g_first_rk_step_part2 ( grid , config_flags &
679 , moist ,g_moist , moist_tend ,g_moist_tend &
680 !!!!! USE THE STATEMENTS REMARKED WHEN chem is NEEDED. Ning Pan, 2010-08-20
681 ! , chem ,g_chem , chem_tend ,g_chem_tend &
682 , chem , chem , chem_tend , chem_tend &
683 , tracer, g_tracer, tracer_tend, g_tracer_tend &
684 , scalar,g_scalar, scalar_tend,g_scalar_tend &
685 !!!!! USE THE STATEMENT REMARKED WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
686 ! , fdda3d,g_fdda3d, fdda2d,g_fdda2d &
687 !!!!! REMOVE THE FOLLOWING STATEMENT WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
688 , fdda3d, fdda3d, fdda2d, fdda2d &
689 , ru_tendf,g_ru_tendf, rv_tendf,g_rv_tendf &
690 , rw_tendf,g_rw_tendf, t_tendf ,g_t_tendf &
691 , ph_tendf,g_ph_tendf, mu_tendf,g_mu_tendf &
692 , tke_tend,g_tke_tend &
693 , adapt_step_flag , curr_secs &
694 !!!!! USE THE STATEMENTS REMARKED WHEN CODING TL OF PHYSICS. Ning Pan, 2010-08-20
695 ! , psim ,g_psim , psih ,g_psih , wspd ,g_wspd , &
696 ! gz1oz0 ,g_gz1oz0 , br ,g_br , chklowq,g_chklowq &
697 ! , cu_act_flag , hol ,g_hol, th_phy,g_th_phy &
698 !!!!! REMOVE THE FOLLOWING 3 STATEMENTS WHEN CODING TL OF PHYSICS. Ning Pan, 2010-08-20
699 , psim , psim , psih , psih , &
700 !201602 gz1oz0 , gz1oz0 , br , br , chklowq, chklowq &
701 !201602: br became a state variable and was removed from the argument
702 gz1oz0 , gz1oz0 , chklowq, chklowq &
703 , cu_act_flag , hol , hol, th_phy,g_th_phy &
704 , pi_phy ,g_pi_phy, p_phy ,g_p_phy , grid%t_phy ,grid%g_t_phy &
705 , dz8w ,g_dz8w , p8w ,g_p8w , t8w ,g_t8w &
706 , nba_mij,g_nba_mij, num_nba_mij &
707 , nba_rij,g_nba_rij, num_nba_rij &
708 , ids, ide, jds, jde, kds, kde &
709 , ims, ime, jms, jme, kms, kme &
710 , ips, ipe, jps, jpe, kps, kpe &
711 , imsx, imex, jmsx, jmex, kmsx, kmex &
712 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
713 , imsy, imey, jmsy, jmey, kmsy, kmey &
714 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
715 , k_start , k_end &
716 )
718 END IF rk_step_is_one
720 BENCH_START(g_rk_tend_tim)
721 !$OMP PARALLEL DO &
722 !$OMP PRIVATE ( ij )
723 DO ij = 1 , grid%num_tiles
725 CALL wrf_debug ( 200 , ' call g_rk_tendency' )
726 CALL g_rk_tendency ( config_flags, rk_step, &
727 grid%ru_tend, grid%g_ru_tend, grid%rv_tend, grid%g_rv_tend, &
728 rw_tend, g_rw_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, &
729 ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, &
730 rw_tendf, g_rw_tendf, ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, &
731 mu_tend, g_mu_tend, &
732 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
733 w_save, g_w_save, ph_save, g_ph_save, &
734 grid%t_save, grid%g_t_save, mu_save, g_mu_save, &
735 grid%rthften, grid%g_rthften, &
736 grid%ru, grid%g_ru, grid%rv, grid%g_rv, grid%rw, grid%g_rw, grid%ww, grid%g_ww, &
737 grid%u_2, grid%g_u_2, grid%v_2, grid%g_v_2, grid%w_2, grid%g_w_2, &
738 grid%t_2, grid%g_t_2, grid%ph_2, grid%g_ph_2, &
739 grid%u_1, grid%g_u_1, grid%v_1, grid%g_v_1, grid%w_1, grid%g_w_1, &
740 grid%t_1, grid%g_t_1, grid%ph_1, grid%g_ph_1, &
741 grid%h_diabatic, grid%g_h_diabatic, grid%phb, grid%t_init, &
742 grid%mu_2, grid%g_mu_2, grid%mut, grid%g_mut, grid%muu, grid%g_muu, &
743 grid%muv, grid%g_muv, grid%mub, &
744 grid%al, grid%g_al, grid%alt, grid%g_alt, grid%p, grid%g_p, grid%pb, &
745 grid%php, grid%g_php, cqu, g_cqu, cqv, g_cqv, cqw, g_cqw, &
746 grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base, &
747 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
748 grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa, &
749 grid%fnm, grid%fnp, grid%rdn, grid%rdnw, &
750 grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, &
751 grid%xkmh,grid%g_xkmh, grid%xkhh,grid%g_xkhh, &
752 grid%diff_6th_opt, grid%diff_6th_factor, &
753 config_flags%momentum_adv_opt, &
754 grid%dampcoef,grid%zdamp,config_flags%damp_opt,config_flags%rad_nudge, &
755 grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m, &
756 config_flags%non_hydrostatic, config_flags%top_lid, &
757 grid%u_frame, grid%v_frame, &
758 ids, ide, jds, jde, kds, kde, &
759 ims, ime, jms, jme, kms, kme, &
760 grid%i_start(ij), grid%i_end(ij), &
761 grid%j_start(ij), grid%j_end(ij), &
762 k_start, k_end, &
763 max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
765 END DO
766 !$OMP END PARALLEL DO
767 BENCH_END(g_rk_tend_tim)
769 IF (config_flags%use_adaptive_time_step) THEN
770 DO ij = 1 , grid%num_tiles
771 IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
772 grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
773 ENDIF
774 IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
775 grid%max_vert_cfl = max_vert_cfl_tmp(ij)
776 ENDIF
777 END DO
779 IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
780 grid%max_cfl_val = grid%max_horiz_cfl
781 ENDIF
782 IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
783 grid%max_cfl_val = grid%max_vert_cfl
784 ENDIF
785 ENDIF
787 BENCH_START(g_relax_bdy_dry_tim)
788 !$OMP PARALLEL DO &
789 !$OMP PRIVATE ( ij )
790 DO ij = 1 , grid%num_tiles
792 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
794 CALL g_relax_bdy_dry ( config_flags, &
795 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
796 ph_save, g_ph_save, grid%t_save, grid%g_t_save, &
797 w_save, g_w_save, mu_tend, g_mu_tend, &
798 grid%ru, grid%g_ru, grid%rv, grid%g_rv, &
799 grid%ph_2, grid%g_ph_2, grid%t_2, grid%g_t_2, &
800 grid%w_2, grid%g_w_2, grid%mu_2, grid%g_mu_2, grid%mut, grid%g_mut, &
801 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
802 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
803 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
804 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
805 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
806 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
807 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
808 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
809 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
810 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
811 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
812 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
813 grid%u_btxs, grid%g_u_btxs, grid%u_btxe, grid%g_u_btxe, &
814 grid%u_btys, grid%g_u_btys, grid%u_btye, grid%g_u_btye, &
815 grid%v_btxs, grid%g_v_btxs, grid%v_btxe, grid%g_v_btxe, &
816 grid%v_btys, grid%g_v_btys, grid%v_btye, grid%g_v_btye, &
817 grid%ph_btxs, grid%g_ph_btxs, grid%ph_btxe, grid%g_ph_btxe, &
818 grid%ph_btys, grid%g_ph_btys, grid%ph_btye, grid%g_ph_btye, &
819 grid%t_btxs, grid%g_t_btxs, grid%t_btxe, grid%g_t_btxe, &
820 grid%t_btys, grid%g_t_btys, grid%t_btye, grid%g_t_btye, &
821 grid%w_btxs, grid%g_w_btxs, grid%w_btxe, grid%g_w_btxe, &
822 grid%w_btys, grid%g_w_btys, grid%w_btye, grid%g_w_btye, &
823 grid%mu_btxs, grid%g_mu_btxs, grid%mu_btxe, grid%g_mu_btxe, &
824 grid%mu_btys, grid%g_mu_btys, grid%mu_btye, grid%g_mu_btye, &
825 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
826 grid%dtbc, grid%fcx, grid%gcx, &
827 ids,ide, jds,jde, kds,kde, &
828 ims,ime, jms,jme, kms,kme, &
829 ips,ipe, jps,jpe, kps,kpe, &
830 grid%i_start(ij), grid%i_end(ij), &
831 grid%j_start(ij), grid%j_end(ij), &
832 k_start, k_end )
834 ENDIF
836 CALL g_rk_addtend_dry ( grid%ru_tend, grid%g_ru_tend, &
837 grid%rv_tend, grid%g_rv_tend, &
838 rw_tend, g_rw_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, &
839 ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, rw_tendf, g_rw_tendf, &
840 ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, &
841 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
842 w_save, g_w_save, ph_save, g_ph_save, grid%t_save, grid%g_t_save, &
843 mu_tend, g_mu_tend, mu_tendf, g_mu_tendf, rk_step, &
844 grid%h_diabatic, grid%g_h_diabatic, grid%mut, grid%g_mut, &
845 grid%msftx, grid%msfty, grid%msfux, grid%msfuy, &
846 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
847 ids,ide, jds,jde, kds,kde, &
848 ims,ime, jms,jme, kms,kme, &
849 ips,ipe, jps,jpe, kps,kpe, &
850 grid%i_start(ij), grid%i_end(ij), &
851 grid%j_start(ij), grid%j_end(ij), &
852 k_start, k_end )
854 IF( config_flags%specified .or. config_flags%nested ) THEN
855 CALL g_spec_bdy_dry ( config_flags, &
856 grid%ru_tend, grid%g_ru_tend, grid%rv_tend, grid%g_rv_tend, &
857 ph_tend, g_ph_tend, t_tend, g_t_tend, &
858 rw_tend, g_rw_tend, mu_tend, g_mu_tend, &
859 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
860 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
861 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
862 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
863 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
864 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
865 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
866 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
867 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
868 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
869 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
870 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
871 grid%u_btxs, grid%g_u_btxs, grid%u_btxe, grid%g_u_btxe, &
872 grid%u_btys, grid%g_u_btys, grid%u_btye, grid%g_u_btye, &
873 grid%v_btxs, grid%g_v_btxs, grid%v_btxe, grid%g_v_btxe, &
874 grid%v_btys, grid%g_v_btys, grid%v_btye, grid%g_v_btye, &
875 grid%ph_btxs, grid%g_ph_btxs, grid%ph_btxe, grid%g_ph_btxe, &
876 grid%ph_btys, grid%g_ph_btys, grid%ph_btye, grid%g_ph_btye, &
877 grid%t_btxs, grid%g_t_btxs, grid%t_btxe, grid%g_t_btxe, &
878 grid%t_btys, grid%g_t_btys, grid%t_btye, grid%g_t_btye, &
879 grid%w_btxs, grid%g_w_btxs, grid%w_btxe, grid%g_w_btxe, &
880 grid%w_btys, grid%g_w_btys, grid%w_btye, grid%g_w_btye, &
881 grid%mu_btxs, grid%g_mu_btxs, grid%mu_btxe, grid%g_mu_btxe, &
882 grid%mu_btys, grid%g_mu_btys, grid%mu_btye, grid%g_mu_btye, &
883 config_flags%spec_bdy_width, grid%spec_zone, &
884 ids,ide, jds,jde, kds,kde, & ! domain dims
885 ims,ime, jms,jme, kms,kme, & ! memory dims
886 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
887 grid%i_start(ij), grid%i_end(ij), &
888 grid%j_start(ij), grid%j_end(ij), &
889 k_start, k_end )
891 ENDIF
893 END DO
894 !$OMP END PARALLEL DO
895 BENCH_END(g_relax_bdy_dry_tim)
897 !<DESCRIPTION>
898 !<pre>
899 ! (3) Small (acoustic,sound) steps.
900 !
901 ! Several acoustic steps are taken each RK pass. A small step
902 ! sequence begins with calculating perturbation variables
903 ! and coupling them to the column dry-air-mass mu
904 ! (call to small_step_prep). This is followed by computing
905 ! coefficients for the vertically implicit part of the
906 ! small timestep (call to calc_coef_w).
907 !
908 ! The small steps are taken
909 ! in the named loop "small_steps:". In the small_steps loop, first
910 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
911 ! next mu and theta are advanced (call to advance_mu_t) followed by
912 ! advancing w and the geopotential (call to advance_w). Diagnostic
913 ! values for pressure and inverse density are updated at the end of
914 ! each small_step.
915 !
916 ! The small-step section ends with the change of the perturbation variables
917 ! back to full variables (call to small_step_finish).
918 !</pre>
919 !</DESCRIPTION>
921 BENCH_START(g_small_step_prep_tim)
922 !$OMP PARALLEL DO &
923 !$OMP PRIVATE ( ij )
924 DO ij = 1 , grid%num_tiles
926 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
927 ! integration. We only need calculate these for the first pass through -
928 ! the predictor step. They are reused as is for the corrector step.
929 ! For third-order RK, we need to recompute these after the first
930 ! predictor because we may have changed the small timestep -> grid%dts.
932 CALL wrf_debug ( 200 , ' call g_small_step_prep ' )
934 CALL g_small_step_prep( grid%u_1,grid%g_u_1,grid%u_2,grid%g_u_2, &
935 grid%v_1,grid%g_v_1,grid%v_2,grid%g_v_2, &
936 grid%w_1,grid%g_w_1,grid%w_2,grid%g_w_2, &
937 grid%t_1,grid%g_t_1,grid%t_2,grid%g_t_2, &
938 grid%ph_1,grid%g_ph_1,grid%ph_2,grid%g_ph_2, &
939 grid%mub, grid%mu_1,grid%g_mu_1, grid%mu_2,grid%g_mu_2, &
940 grid%muu,grid%g_muu, grid%muus,grid%g_muus, &
941 grid%muv,grid%g_muv, grid%muvs,grid%g_muvs, &
942 grid%mut,grid%g_mut, grid%muts,grid%g_muts, grid%mudf,grid%g_mudf, &
943 grid%u_save,grid%g_u_save, grid%v_save,grid%g_v_save, w_save,g_w_save, &
944 grid%t_save,grid%g_t_save, ph_save,g_ph_save, mu_save,g_mu_save, &
945 grid%ww,grid%g_ww, ww1,g_ww1, &
946 c2a,g_c2a, grid%pb, grid%p,grid%g_p, grid%alt,grid%g_alt,&
947 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
948 grid%msfvy, grid%msftx,grid%msfty, &
949 grid%rdx, grid%rdy, rk_step, &
950 ids, ide, jds, jde, kds, kde, &
951 ims, ime, jms, jme, kms, kme, &
952 grid%i_start(ij), grid%i_end(ij), &
953 grid%j_start(ij), grid%j_end(ij), &
954 k_start, k_end )
956 CALL g_calc_p_rho( grid%al,grid%g_al, grid%p,grid%g_p, grid%ph_2,grid%g_ph_2, &
957 grid%alt,grid%g_alt, grid%t_2,grid%g_t_2, &
958 grid%t_save,grid%g_t_save, c2a,g_c2a, pm1,g_pm1, &
959 grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, grid%znu, t0, &
960 grid%rdnw, grid%dnw, grid%smdiv, &
961 config_flags%non_hydrostatic, 0, &
962 ids, ide, jds, jde, kds, kde, &
963 ims, ime, jms, jme, kms, kme, &
964 grid%i_start(ij), grid%i_end(ij), &
965 grid%j_start(ij), grid%j_end(ij), &
966 k_start, k_end )
968 IF (config_flags%non_hydrostatic) THEN
969 CALL g_calc_coef_w( a,g_a,alpha,g_alpha,gamma,g_gamma, &
970 grid%mut,grid%g_mut, cqw,g_cqw, &
971 grid%rdn, grid%rdnw, c2a,g_c2a, &
972 dts_rk, g, grid%epssm, &
973 config_flags%top_lid, &
974 ids, ide, jds, jde, kds, kde, &
975 ims, ime, jms, jme, kms, kme, &
976 grid%i_start(ij), grid%i_end(ij), &
977 grid%j_start(ij), grid%j_end(ij), &
978 k_start, k_end )
980 ENDIF
982 ENDDO
983 !$OMP END PARALLEL DO
984 BENCH_END(g_small_step_prep_tim)
986 #ifdef DM_PARALLEL
987 !-----------------------------------------------------------------------
988 ! Stencils for patch communications (WCS, 29 June 2001)
989 ! Note: the small size of this halo exchange reflects the
990 ! fact that we are carrying the uncoupled variables
991 ! as state variables in the mass coordinate model, as
992 ! opposed to the coupled variables as in the height
993 ! coordinate model.
994 !
995 ! * * * * *
996 ! * * * * * * * * *
997 ! * + * * + * * * + * *
998 ! * * * * * * * * *
999 ! * * * * *
1000 !
1001 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
1002 !
1003 ! ph_2 x
1004 ! al x
1005 ! p x
1006 ! t_1 x
1007 ! t_save x
1008 ! u_save x
1009 ! v_save x
1010 !
1011 ! the following are 2D (xy) variables
1012 !
1013 ! mu_1 x
1014 ! mu_2 x
1015 ! mudf x
1016 ! php x
1017 ! alt x
1018 ! pb x
1019 !--------------------------------------------------------------
1020 # include "HALO_EM_B_TL.inc"
1021 # include "PERIOD_BDY_EM_B.inc"
1022 #endif
1024 BENCH_START(g_set_phys_bc2_tim)
1025 !$OMP PARALLEL DO &
1026 !$OMP PRIVATE ( ij )
1028 DO ij = 1 , grid%num_tiles
1030 CALL g_set_physical_bc3d( grid%ru_tend,grid%g_ru_tend, 'u', config_flags, &
1031 ids, ide, jds, jde, kds, kde, &
1032 ims, ime, jms, jme, kms, kme, &
1033 ips, ipe, jps, jpe, kps, kpe, &
1034 grid%i_start(ij), grid%i_end(ij), &
1035 grid%j_start(ij), grid%j_end(ij), &
1036 k_start , k_end )
1038 CALL g_set_physical_bc3d( grid%rv_tend,grid%g_rv_tend, 'v', config_flags, &
1039 ids, ide, jds, jde, kds, kde, &
1040 ims, ime, jms, jme, kms, kme, &
1041 ips, ipe, jps, jpe, kps, kpe, &
1042 grid%i_start(ij), grid%i_end(ij), &
1043 grid%j_start(ij), grid%j_end(ij), &
1044 k_start , k_end )
1046 CALL g_set_physical_bc3d( grid%ph_2,grid%g_ph_2, 'w', config_flags, &
1047 ids, ide, jds, jde, kds, kde, &
1048 ims, ime, jms, jme, kms, kme, &
1049 ips, ipe, jps, jpe, kps, kpe, &
1050 grid%i_start(ij), grid%i_end(ij), &
1051 grid%j_start(ij), grid%j_end(ij), &
1052 k_start , k_end )
1054 CALL g_set_physical_bc3d( grid%al,grid%g_al, 'p', config_flags, &
1055 ids, ide, jds, jde, kds, kde, &
1056 ims, ime, jms, jme, kms, kme, &
1057 ips, ipe, jps, jpe, kps, kpe, &
1058 grid%i_start(ij), grid%i_end(ij), &
1059 grid%j_start(ij), grid%j_end(ij), &
1060 k_start , k_end )
1062 CALL g_set_physical_bc3d( grid%p,grid%g_p, 'p', config_flags, &
1063 ids, ide, jds, jde, kds, kde, &
1064 ims, ime, jms, jme, kms, kme, &
1065 ips, ipe, jps, jpe, kps, kpe, &
1066 grid%i_start(ij), grid%i_end(ij), &
1067 grid%j_start(ij), grid%j_end(ij), &
1068 k_start , k_end )
1070 CALL g_set_physical_bc3d( grid%t_1,grid%g_t_1, 'p', config_flags, &
1071 ids, ide, jds, jde, kds, kde, &
1072 ims, ime, jms, jme, kms, kme, &
1073 ips, ipe, jps, jpe, kps, kpe, &
1074 grid%i_start(ij), grid%i_end(ij), &
1075 grid%j_start(ij), grid%j_end(ij), &
1076 k_start , k_end )
1078 CALL g_set_physical_bc3d( grid%t_save,grid%g_t_save, 't', config_flags, &
1079 ids, ide, jds, jde, kds, kde, &
1080 ims, ime, jms, jme, kms, kme, &
1081 ips, ipe, jps, jpe, kps, kpe, &
1082 grid%i_start(ij), grid%i_end(ij), &
1083 grid%j_start(ij), grid%j_end(ij), &
1084 k_start , k_end )
1086 CALL g_set_physical_bc2d( grid%mu_1,grid%g_mu_1, 't', config_flags, &
1087 ids, ide, jds, jde, &
1088 ims, ime, jms, jme, &
1089 ips, ipe, jps, jpe, &
1090 grid%i_start(ij), grid%i_end(ij), &
1091 grid%j_start(ij), grid%j_end(ij) )
1093 CALL g_set_physical_bc2d( grid%mu_2,grid%g_mu_2, 't', config_flags, &
1094 ids, ide, jds, jde, &
1095 ims, ime, jms, jme, &
1096 ips, ipe, jps, jpe, &
1097 grid%i_start(ij), grid%i_end(ij), &
1098 grid%j_start(ij), grid%j_end(ij) )
1100 CALL g_set_physical_bc2d( grid%mudf,grid%g_mudf, 't', config_flags, &
1101 ids, ide, jds, jde, &
1102 ims, ime, jms, jme, &
1103 ips, ipe, jps, jpe, &
1104 grid%i_start(ij), grid%i_end(ij), &
1105 grid%j_start(ij), grid%j_end(ij) )
1107 END DO
1108 !$OMP END PARALLEL DO
1109 BENCH_END(g_set_phys_bc2_tim)
1110 small_steps : DO iteration = 1 , number_of_small_timesteps
1112 ! Boundary condition time (or communication time).
1113 #ifdef DM_PARALLEL
1114 # include "PERIOD_BDY_EM_B.inc"
1115 #endif
1117 !$OMP PARALLEL DO &
1118 !$OMP PRIVATE ( ij )
1120 DO ij = 1 , grid%num_tiles
1122 BENCH_START(g_advance_uv_tim)
1123 CALL g_advance_uv( grid%u_2,grid%g_u_2, grid%ru_tend,grid%g_ru_tend, &
1124 grid%v_2,grid%g_v_2, grid%rv_tend,grid%g_rv_tend, &
1125 grid%p,grid%g_p, grid%pb, &
1126 grid%ph_2,grid%g_ph_2, grid%php,grid%g_php, &
1127 grid%alt,grid%g_alt, grid%al,grid%g_al, &
1128 grid%mu_2,grid%g_mu_2, &
1129 grid%muu,grid%g_muu, cqu,g_cqu, grid%muv,grid%g_muv, cqv,g_cqv, &
1130 grid%mudf,grid%g_mudf, &
1131 grid%msfux, grid%msfuy, grid%msfvx, &
1132 grid%msfvx_inv, grid%msfvy, &
1133 grid%rdx, grid%rdy, dts_rk, &
1134 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
1135 grid%emdiv, &
1136 grid%rdnw, config_flags,grid%spec_zone, &
1137 config_flags%non_hydrostatic, config_flags%top_lid, &
1138 ids, ide, jds, jde, kds, kde, &
1139 ims, ime, jms, jme, kms, kme, &
1140 grid%i_start(ij), grid%i_end(ij), &
1141 grid%j_start(ij), grid%j_end(ij), &
1142 k_start, k_end )
1143 BENCH_END(g_advance_uv_tim)
1145 END DO
1146 !$OMP END PARALLEL DO
1148 !-----------------------------------------------------------
1149 ! acoustic integration polar filter for smallstep u, v
1150 !-----------------------------------------------------------
1152 IF (config_flags%polar) THEN
1155 CALL pxft ( grid=grid &
1156 ,lineno=__LINE__ &
1157 ,flag_uv = 1 &
1158 ,flag_rurv = 0 &
1159 ,flag_wph = 0 &
1160 ,flag_ww = 0 &
1161 ,flag_t = 0 &
1162 ,flag_mu = 0 &
1163 ,flag_mut = 0 &
1164 ,flag_moist = 0 &
1165 ,flag_chem = 0 &
1166 ,flag_tracer = 0 &
1167 ,flag_scalar = 0 &
1168 ,actual_distance_average = .FALSE. &
1169 ,pos_def = .FALSE. &
1170 ,swap_pole_with_next_j = .FALSE. &
1171 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1172 ,fft_filter_lat = config_flags%fft_filter_lat &
1173 ,dclat = dclat &
1174 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1175 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1176 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1177 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1178 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1180 END IF
1182 !-----------------------------------------------------------
1183 ! end acoustic integration polar filter for smallstep u, v
1184 !-----------------------------------------------------------
1186 !$OMP PARALLEL DO &
1187 !$OMP PRIVATE ( ij )
1188 DO ij = 1 , grid%num_tiles
1190 BENCH_START(g_spec_bdy_uv_tim)
1191 IF( config_flags%specified .or. config_flags%nested ) THEN
1192 CALL g_spec_bdyupdate ( grid%u_2, grid%g_u_2, &
1193 grid%ru_tend, grid%g_ru_tend, dts_rk, &
1194 'u' , config_flags, &
1195 grid%spec_zone, &
1196 ids,ide, jds,jde, kds,kde, & ! domain dims
1197 ims,ime, jms,jme, kms,kme, & ! memory dims
1198 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1199 grid%i_start(ij), grid%i_end(ij), &
1200 grid%j_start(ij), grid%j_end(ij), &
1201 k_start, k_end )
1203 CALL g_spec_bdyupdate ( grid%v_2, grid%g_v_2, &
1204 grid%rv_tend, grid%g_rv_tend, dts_rk, &
1205 'v' , config_flags, &
1206 grid%spec_zone, &
1207 ids,ide, jds,jde, kds,kde, & ! domain dims
1208 ims,ime, jms,jme, kms,kme, & ! memory dims
1209 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1210 grid%i_start(ij), grid%i_end(ij), &
1211 grid%j_start(ij), grid%j_end(ij), &
1212 k_start, k_end )
1214 ENDIF
1215 BENCH_END(g_spec_bdy_uv_tim)
1217 END DO
1218 !$OMP END PARALLEL DO
1220 #ifdef DM_PARALLEL
1221 !
1222 ! Stencils for patch communications (WCS, 29 June 2001)
1223 !
1224 ! * *
1225 ! * + * * + * +
1226 ! * *
1227 !
1228 ! u_2 x
1229 ! v_2 x
1230 !
1231 # include "HALO_EM_C_TL.inc"
1232 #endif
1234 !$OMP PARALLEL DO &
1235 !$OMP PRIVATE ( ij )
1236 DO ij = 1 , grid%num_tiles
1238 ! advance the mass in the column, theta, and calculate ww
1240 BENCH_START(g_advance_mu_t_tim)
1241 CALL g_advance_mu_t( grid%ww,grid%g_ww, ww1,g_ww1, &
1242 grid%u_2,grid%g_u_2, grid%u_save,grid%g_u_save, &
1243 grid%v_2,grid%g_v_2, grid%v_save,grid%g_v_save, &
1244 grid%mu_2,grid%g_mu_2, grid%mut,grid%g_mut, &
1245 muave,g_muave, grid%muts,grid%g_muts, &
1246 grid%muu,grid%g_muu, grid%muv,grid%g_muv, grid%mudf,grid%g_mudf, &
1247 grid%ru_m,grid%g_ru_m, grid%rv_m,grid%g_rv_m, grid%ww_m,grid%g_ww_m, &
1248 grid%t_2,grid%g_t_2, grid%t_save,grid%g_t_save, &
1249 t_2save,g_t_2save, t_tend,g_t_tend, &
1250 mu_tend,g_mu_tend, &
1251 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1252 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1253 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1254 grid%msfvy, grid%msftx,grid%msfty, &
1255 iteration, config_flags, &
1256 ids, ide, jds, jde, kds, kde, &
1257 ims, ime, jms, jme, kms, kme, &
1258 grid%i_start(ij), grid%i_end(ij), &
1259 grid%j_start(ij), grid%j_end(ij), &
1260 k_start, k_end )
1262 BENCH_END(g_advance_mu_t_tim)
1263 ENDDO
1264 !$OMP END PARALLEL DO
1266 !-----------------------------------------------------------
1267 ! acoustic integration polar filter for smallstep mu, t
1268 !-----------------------------------------------------------
1270 IF ( (config_flags%polar) ) THEN
1272 CALL pxft ( grid=grid &
1273 ,lineno=__LINE__ &
1274 ,flag_uv = 0 &
1275 ,flag_rurv = 0 &
1276 ,flag_wph = 0 &
1277 ,flag_ww = 0 &
1278 ,flag_t = 1 &
1279 ,flag_mu = 1 &
1280 ,flag_mut = 0 &
1281 ,flag_moist = 0 &
1282 ,flag_chem = 0 &
1283 ,flag_tracer = 0 &
1284 ,flag_scalar = 0 &
1285 ,actual_distance_average = .FALSE. &
1286 ,pos_def = .FALSE. &
1287 ,swap_pole_with_next_j = .FALSE. &
1288 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1289 ,fft_filter_lat = config_flags%fft_filter_lat &
1290 ,dclat = dclat &
1291 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1292 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1293 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1294 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1295 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1297 grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1299 END IF
1301 !-----------------------------------------------------------
1302 ! end acoustic integration polar filter for smallstep mu, t
1303 !-----------------------------------------------------------
1305 BENCH_START(g_spec_bdy_t_tim)
1307 !$OMP PARALLEL DO &
1308 !$OMP PRIVATE ( ij )
1309 DO ij = 1 , grid%num_tiles
1311 IF( config_flags%specified .or. config_flags%nested ) THEN
1313 CALL g_spec_bdyupdate ( grid%t_2, grid%g_t_2, &
1314 t_tend, g_t_tend, dts_rk, &
1315 't' , config_flags, &
1316 grid%spec_zone, &
1317 ids,ide, jds,jde, kds,kde, & ! domain dims
1318 ims,ime, jms,jme, kms,kme, & ! memory dims
1319 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1320 grid%i_start(ij), grid%i_end(ij), &
1321 grid%j_start(ij), grid%j_end(ij), &
1322 k_start, k_end )
1324 CALL g_spec_bdyupdate ( grid%mu_2, grid%g_mu_2, &
1325 mu_tend, g_mu_tend, dts_rk, &
1326 'm' , config_flags, &
1327 grid%spec_zone, &
1328 ids,ide, jds,jde, 1 ,1 , &
1329 ims,ime, jms,jme, 1 ,1 , &
1330 ips,ipe, jps,jpe, 1 ,1 , &
1331 grid%i_start(ij), grid%i_end(ij), &
1332 grid%j_start(ij), grid%j_end(ij), &
1333 1, 1 )
1335 CALL g_spec_bdyupdate ( grid%muts, grid%g_muts, mu_tend, g_mu_tend, dts_rk, &
1336 'm' , config_flags, &
1337 grid%spec_zone, &
1338 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1339 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1340 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1341 grid%i_start(ij), grid%i_end(ij), &
1342 grid%j_start(ij), grid%j_end(ij), &
1343 1, 1 )
1345 ENDIF
1346 BENCH_END(g_spec_bdy_t_tim)
1348 ! small (acoustic) step for the vertical momentum,
1349 ! density and coupled potential temperature.
1352 BENCH_START(g_advance_w_tim)
1353 IF ( config_flags%non_hydrostatic ) THEN
1354 CALL g_advance_w( grid%w_2,grid%g_w_2, rw_tend,g_rw_tend, grid%ww,grid%g_ww, w_save,g_w_save, &
1355 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, &
1356 grid%mu_2,grid%mut,grid%g_mut, &
1357 muave,g_muave, grid%muts,grid%g_muts, &
1358 t_2save,g_t_2save, grid%t_2,grid%g_t_2, grid%t_save,grid%g_t_save, &
1359 grid%ph_2,grid%g_ph_2, ph_save,g_ph_save, grid%phb, ph_tend,g_ph_tend, &
1360 grid%ht, c2a,g_c2a, cqw,g_cqw, grid%alt,grid%g_alt, grid%alb, &
1361 a,g_a, alpha,g_alpha, gamma,g_gamma, &
1362 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1363 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1364 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1365 grid%msftx, grid%msfty, &
1366 config_flags, config_flags%top_lid, &
1367 ids,ide, jds,jde, kds,kde, &
1368 ims,ime, jms,jme, kms,kme, &
1369 grid%i_start(ij), grid%i_end(ij), &
1370 grid%j_start(ij), grid%j_end(ij), &
1371 k_start, k_end )
1373 ENDIF
1374 BENCH_END(g_advance_w_tim)
1376 ENDDO
1377 !$OMP END PARALLEL DO
1379 !-----------------------------------------------------------
1380 ! acoustic integration polar filter for smallstep w, geopotential
1381 !-----------------------------------------------------------
1383 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1385 CALL pxft ( grid=grid &
1386 ,lineno=__LINE__ &
1387 ,flag_uv = 0 &
1388 ,flag_rurv = 0 &
1389 ,flag_wph = 1 &
1390 ,flag_ww = 0 &
1391 ,flag_t = 0 &
1392 ,flag_mu = 0 &
1393 ,flag_mut = 0 &
1394 ,flag_moist = 0 &
1395 ,flag_chem = 0 &
1396 ,flag_tracer = 0 &
1397 ,flag_scalar = 0 &
1398 ,actual_distance_average = .FALSE. &
1399 ,pos_def = .FALSE. &
1400 ,swap_pole_with_next_j = .FALSE. &
1401 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1402 ,fft_filter_lat = config_flags%fft_filter_lat &
1403 ,dclat = dclat &
1404 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1405 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1406 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1407 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1408 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1410 END IF
1412 !-----------------------------------------------------------
1413 ! end acoustic integration polar filter for smallstep w, geopotential
1414 !-----------------------------------------------------------
1416 !$OMP PARALLEL DO &
1417 !$OMP PRIVATE ( ij )
1418 DO ij = 1 , grid%num_tiles
1420 BENCH_START(g_sumflux_tim)
1421 CALL g_sumflux ( grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ww,grid%g_ww, &
1422 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, ww1, g_ww1, &
1423 grid%muu, grid%g_muu, grid%muv, grid%g_muv, &
1424 grid%ru_m, grid%g_ru_m, grid%rv_m, grid%g_rv_m, grid%ww_m, grid%g_ww_m, &
1425 grid%epssm, &
1426 grid%msfux, grid% msfuy, grid%msfvx, &
1427 grid%msfvx_inv, grid%msfvy, &
1428 iteration, number_of_small_timesteps, &
1429 ids, ide, jds, jde, kds, kde, &
1430 ims, ime, jms, jme, kms, kme, &
1431 grid%i_start(ij), grid%i_end(ij), &
1432 grid%j_start(ij), grid%j_end(ij), &
1433 k_start , k_end )
1434 BENCH_END(g_sumflux_tim)
1436 IF( config_flags%specified .or. config_flags%nested ) THEN
1438 BENCH_START(g_spec_bdynhyd_tim)
1439 IF (config_flags%non_hydrostatic) THEN
1440 CALL g_spec_bdyupdate_ph ( ph_save, g_ph_save, grid%ph_2, grid%g_ph_2, &
1441 ph_tend, g_ph_tend, &
1442 mu_tend, g_mu_tend, grid%muts, grid%g_muts, dts_rk, &
1443 'h' , config_flags, &
1444 grid%spec_zone, &
1445 ids,ide, jds,jde, kds,kde, &
1446 ims,ime, jms,jme, kms,kme, &
1447 ips,ipe, jps,jpe, kps,kpe, &
1448 grid%i_start(ij), grid%i_end(ij),&
1449 grid%j_start(ij), grid%j_end(ij),&
1450 k_start, k_end )
1452 IF( config_flags%specified ) THEN
1453 CALL g_zero_grad_bdy ( grid%w_2, grid%g_w_2, &
1454 'w' , config_flags, &
1455 grid%spec_zone, &
1456 ids,ide, jds,jde, kds,kde, &
1457 ims,ime, jms,jme, kms,kme, &
1458 ips,ipe, jps,jpe, kps,kpe, &
1459 grid%i_start(ij), grid%i_end(ij), &
1460 grid%j_start(ij), grid%j_end(ij), &
1461 k_start, k_end )
1463 ELSE
1464 CALL g_spec_bdyupdate ( grid%w_2, grid%g_w_2, &
1465 rw_tend, g_rw_tend, dts_rk, &
1466 'h' , config_flags, &
1467 grid%spec_zone, &
1468 ids,ide, jds,jde, kds,kde, & ! domain dims
1469 ims,ime, jms,jme, kms,kme, & ! memory dims
1470 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1471 grid%i_start(ij), grid%i_end(ij), &
1472 grid%j_start(ij), grid%j_end(ij), &
1473 k_start, k_end )
1474 ENDIF
1475 ENDIF
1476 BENCH_END(g_spec_bdynhyd_tim)
1477 ENDIF
1479 BENCH_START(g_cald_p_rho_tim)
1480 CALL g_calc_p_rho( grid%al, grid%g_al, grid%p, grid%g_p, grid%ph_2, grid%g_ph_2, &
1481 grid%alt, grid%g_alt, grid%t_2, grid%g_t_2, grid%t_save, grid%g_t_save, &
1482 c2a, g_c2a, pm1, g_pm1, &
1483 grid%mu_2, grid%g_mu_2, grid%muts, grid%g_muts, grid%znu, t0, &
1484 grid%rdnw, grid%dnw, grid%smdiv, &
1485 config_flags%non_hydrostatic, iteration, &
1486 ids, ide, jds, jde, kds, kde, &
1487 ims, ime, jms, jme, kms, kme, &
1488 grid%i_start(ij), grid%i_end(ij), &
1489 grid%j_start(ij), grid%j_end(ij), &
1490 k_start, k_end )
1491 BENCH_END(g_cald_p_rho_tim)
1493 ENDDO
1494 !$OMP END PARALLEL DO
1496 #ifdef DM_PARALLEL
1497 !
1498 ! Stencils for patch communications (WCS, 29 June 2001)
1499 !
1500 ! * *
1501 ! * + * * + * +
1502 ! * *
1503 !
1504 ! ph_2 x
1505 ! al x
1506 ! p x
1507 !
1508 ! 2D variables (x,y)
1509 !
1510 ! mu_2 x
1511 ! muts x
1512 ! mudf x
1514 # include "HALO_EM_C2_TL.inc"
1515 # include "PERIOD_BDY_EM_B3.inc"
1516 #endif
1518 BENCH_START(g_phys_bc_tim)
1519 !$OMP PARALLEL DO &
1520 !$OMP PRIVATE ( ij )
1521 DO ij = 1 , grid%num_tiles
1523 ! boundary condition set for next small timestep
1525 CALL g_set_physical_bc3d( grid%ph_2,grid%g_ph_2, 'w', config_flags, &
1526 ids, ide, jds, jde, kds, kde, &
1527 ims, ime, jms, jme, kms, kme, &
1528 ips, ipe, jps, jpe, kps, kpe, &
1529 grid%i_start(ij), grid%i_end(ij), &
1530 grid%j_start(ij), grid%j_end(ij), &
1531 k_start , k_end )
1533 CALL g_set_physical_bc3d( grid%al,grid%g_al, 'p', config_flags, &
1534 ids, ide, jds, jde, kds, kde, &
1535 ims, ime, jms, jme, kms, kme, &
1536 ips, ipe, jps, jpe, kps, kpe, &
1537 grid%i_start(ij), grid%i_end(ij), &
1538 grid%j_start(ij), grid%j_end(ij), &
1539 k_start , k_end )
1541 CALL g_set_physical_bc3d( grid%p,grid%g_p, 'p', config_flags, &
1542 ids, ide, jds, jde, kds, kde, &
1543 ims, ime, jms, jme, kms, kme, &
1544 ips, ipe, jps, jpe, kps, kpe, &
1545 grid%i_start(ij), grid%i_end(ij), &
1546 grid%j_start(ij), grid%j_end(ij), &
1547 k_start , k_end )
1549 CALL g_set_physical_bc2d( grid%muts,grid%g_muts, 't', config_flags, &
1550 ids, ide, jds, jde, &
1551 ims, ime, jms, jme, &
1552 ips, ipe, jps, jpe, &
1553 grid%i_start(ij), grid%i_end(ij), &
1554 grid%j_start(ij), grid%j_end(ij) )
1556 CALL g_set_physical_bc2d( grid%mu_2,grid%g_mu_2, 't', config_flags, &
1557 ids, ide, jds, jde, &
1558 ims, ime, jms, jme, &
1559 ips, ipe, jps, jpe, &
1560 grid%i_start(ij), grid%i_end(ij), &
1561 grid%j_start(ij), grid%j_end(ij) )
1563 CALL g_set_physical_bc2d( grid%mudf,grid%g_mudf, 't', config_flags, &
1564 ids, ide, jds, jde, &
1565 ims, ime, jms, jme, &
1566 ips, ipe, jps, jpe, &
1567 grid%i_start(ij), grid%i_end(ij), &
1568 grid%j_start(ij), grid%j_end(ij) )
1570 END DO
1571 !$OMP END PARALLEL DO
1572 BENCH_END(g_phys_bc_tim)
1574 END DO small_steps
1576 !$OMP PARALLEL DO &
1577 !$OMP PRIVATE ( ij )
1578 DO ij = 1 , grid%num_tiles
1580 CALL wrf_debug ( 200 , ' call g_rk_small_finish' )
1582 ! change time-perturbation variables back to
1583 ! full perturbation variables.
1584 ! first get updated mu at u and v points
1586 BENCH_START(g_calc_mu_uv_tim)
1587 CALL g_calc_mu_uv_1 ( config_flags, &
1588 grid%muts, grid%g_muts, &
1589 grid%muus, grid%g_muus, &
1590 grid%muvs, grid%g_muvs, &
1591 ids, ide, jds, jde, kds, kde, &
1592 ims, ime, jms, jme, kms, kme, &
1593 grid%i_start(ij), grid%i_end(ij), &
1594 grid%j_start(ij), grid%j_end(ij), &
1595 k_start, k_end )
1596 BENCH_END(g_calc_mu_uv_tim)
1597 BENCH_START(g_small_step_finish_tim)
1598 CALL g_small_step_finish( grid%u_2, grid%g_u_2, grid%u_1, &
1599 grid%v_2, grid%g_v_2, grid%v_1, &
1600 grid%w_2, grid%g_w_2, grid%w_1, &
1601 grid%t_2, grid%g_t_2, grid%t_1, &
1602 grid%ph_2, grid%g_ph_2, grid%ph_1, &
1603 grid%ww, grid%g_ww, ww1, g_ww1, &
1604 grid%mu_2, grid%g_mu_2, grid%mu_1, &
1605 grid%mut, grid%g_mut, grid%muts, grid%g_muts, &
1606 grid%muu, grid%g_muu, grid%muus, grid%g_muus, &
1607 grid%muv, grid%g_muv, grid%muvs, grid%g_muvs, &
1608 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, w_save, g_w_save, &
1609 grid%t_save, grid%g_t_save, ph_save, g_ph_save, mu_save, g_mu_save, &
1610 grid%msfux,grid%msfuy,grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
1611 grid%h_diabatic, grid%g_h_diabatic, &
1612 number_of_small_timesteps,dts_rk, &
1613 rk_step, rk_order, &
1614 ids, ide, jds, jde, kds, kde, &
1615 ims, ime, jms, jme, kms, kme, &
1616 grid%i_start(ij), grid%i_end(ij), &
1617 grid%j_start(ij), grid%j_end(ij), &
1618 k_start, k_end )
1620 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
1622 IF (rk_step == rk_order) THEN
1624 CALL g_set_physical_bc3d( grid%ru_m,grid%g_ru_m, 'u', config_flags, &
1625 ids, ide, jds, jde, kds, kde, &
1626 ims, ime, jms, jme, kms, kme, &
1627 ips, ipe, jps, jpe, kps, kpe, &
1628 grid%i_start(ij), grid%i_end(ij), &
1629 grid%j_start(ij), grid%j_end(ij), &
1630 k_start , k_end )
1632 CALL g_set_physical_bc3d( grid%rv_m,grid%g_rv_m, 'v', config_flags, &
1633 ids, ide, jds, jde, kds, kde, &
1634 ims, ime, jms, jme, kms, kme, &
1635 ips, ipe, jps, jpe, kps, kpe, &
1636 grid%i_start(ij), grid%i_end(ij), &
1637 grid%j_start(ij), grid%j_end(ij), &
1638 k_start , k_end )
1640 CALL g_set_physical_bc3d( grid%ww_m,grid%g_ww_m, 'w', config_flags, &
1641 ids, ide, jds, jde, kds, kde, &
1642 ims, ime, jms, jme, kms, kme, &
1643 ips, ipe, jps, jpe, kps, kpe, &
1644 grid%i_start(ij), grid%i_end(ij), &
1645 grid%j_start(ij), grid%j_end(ij), &
1646 k_start , k_end )
1648 CALL g_set_physical_bc2d( grid%mut,grid%g_mut, 't', config_flags, &
1649 ids, ide, jds, jde, &
1650 ims, ime, jms, jme, &
1651 ips, ipe, jps, jpe, &
1652 grid%i_start(ij), grid%i_end(ij), &
1653 grid%j_start(ij), grid%j_end(ij) )
1655 CALL g_set_physical_bc2d( grid%muts,grid%g_muts, 't', config_flags, &
1656 ids, ide, jds, jde, &
1657 ims, ime, jms, jme, &
1658 ips, ipe, jps, jpe, &
1659 grid%i_start(ij), grid%i_end(ij), &
1660 grid%j_start(ij), grid%j_end(ij) )
1662 END IF
1664 BENCH_END(g_small_step_finish_tim)
1666 END DO
1667 !$OMP END PARALLEL DO
1669 !-----------------------------------------------------------
1670 ! polar filter for full dynamics variables and time-averaged mass fluxes
1671 !-----------------------------------------------------------
1673 IF (config_flags%polar) THEN
1675 CALL pxft ( grid=grid &
1676 ,lineno=__LINE__ &
1677 ,flag_uv = 1 &
1678 ,flag_rurv = 1 &
1679 ,flag_wph = 1 &
1680 ,flag_ww = 1 &
1681 ,flag_t = 1 &
1682 ,flag_mu = 1 &
1683 ,flag_mut = 1 &
1684 ,flag_moist = 0 &
1685 ,flag_chem = 0 &
1686 ,flag_tracer = 0 &
1687 ,flag_scalar = 0 &
1688 ,actual_distance_average = .FALSE. &
1689 ,pos_def = .FALSE. &
1690 ,swap_pole_with_next_j = .FALSE. &
1691 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1692 ,fft_filter_lat = config_flags%fft_filter_lat &
1693 ,dclat = dclat &
1694 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1695 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1696 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1697 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1698 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1700 END IF
1702 !-----------------------------------------------------------
1703 ! end polar filter for full dynamics variables and time-averaged mass fluxes
1704 !-----------------------------------------------------------
1706 !-----------------------------------------------------------------------
1707 ! add in physics tendency first if positive definite advection is used.
1708 ! pd advection applies advective flux limiter on last runge-kutta step
1709 !-----------------------------------------------------------------------
1710 ! first moisture
1712 IF ((config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1714 !$OMP PARALLEL DO &
1715 !$OMP PRIVATE ( ij )
1716 DO ij = 1 , grid%num_tiles
1717 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd moist ' )
1718 DO im = PARAM_FIRST_SCALAR, num_3d_m
1719 CALL g_rk_update_scalar_pd( im, im, &
1720 moist_old(ims,kms,jms,im),g_moist_old(ims,kms,jms,im), &
1721 moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im), &
1722 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1723 rk_step, dt_rk, grid%spec_zone, &
1724 config_flags, &
1725 ids, ide, jds, jde, kds, kde, &
1726 ims, ime, jms, jme, kms, kme, &
1727 grid%i_start(ij), grid%i_end(ij), &
1728 grid%j_start(ij), grid%j_end(ij), &
1729 k_start , k_end )
1731 ENDDO
1732 END DO
1733 !$OMP END PARALLEL DO
1735 !---------------------- positive definite bc call
1736 #ifdef DM_PARALLEL
1737 IF (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) THEN
1738 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1739 # include "HALO_EM_MOIST_OLD_E_5_TL.inc"
1740 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1741 # include "HALO_EM_MOIST_OLD_E_7_TL.inc"
1742 ELSE
1743 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1744 CALL wrf_error_fatal(TRIM(wrf_err_message))
1745 ENDIF
1746 ENDIF
1747 #endif
1749 #ifdef DM_PARALLEL
1750 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
1751 #endif
1753 !$OMP PARALLEL DO &
1754 !$OMP PRIVATE ( ij )
1755 DO ij = 1 , grid%num_tiles
1756 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1757 DO im = PARAM_FIRST_SCALAR , num_3d_m
1758 CALL g_set_physical_bc3d( moist_old(ims,kms,jms,im),g_moist_old(ims,kms,jms,im), 'p', config_flags, &
1759 ids, ide, jds, jde, kds, kde, &
1760 ims, ime, jms, jme, kms, kme, &
1761 ips, ipe, jps, jpe, kps, kpe, &
1762 grid%i_start(ij), grid%i_end(ij), &
1763 grid%j_start(ij), grid%j_end(ij), &
1764 k_start , k_end )
1765 END DO
1766 ENDIF
1767 END DO
1768 !$OMP END PARALLEL DO
1770 END IF ! end if for moist_adv_opt
1772 ! scalars
1774 IF ((config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1776 !$OMP PARALLEL DO &
1777 !$OMP PRIVATE ( ij )
1778 DO ij = 1 , grid%num_tiles
1779 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd scalar ' )
1780 DO im = PARAM_FIRST_SCALAR, num_3d_s
1781 CALL g_rk_update_scalar_pd( im, im, &
1782 scalar_old(ims,kms,jms,im),g_scalar_old(ims,kms,jms,im), &
1783 scalar_tend(ims,kms,jms,im),g_scalar_tend(ims,kms,jms,im),&
1784 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1785 rk_step, dt_rk, grid%spec_zone, &
1786 config_flags, &
1787 ids, ide, jds, jde, kds, kde, &
1788 ims, ime, jms, jme, kms, kme, &
1789 grid%i_start(ij), grid%i_end(ij), &
1790 grid%j_start(ij), grid%j_end(ij), &
1791 k_start , k_end )
1792 ENDDO
1793 ENDDO
1794 !$OMP END PARALLEL DO
1796 !---------------------- positive definite bc call
1797 #ifdef DM_PARALLEL
1798 IF (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) THEN
1799 #ifndef RSL
1800 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1801 # include "HALO_EM_SCALAR_OLD_E_5.inc"
1802 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1803 # include "HALO_EM_SCALAR_OLD_E_7.inc"
1804 ELSE
1805 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1806 CALL wrf_error_fatal(TRIM(wrf_err_message))
1807 ENDIF
1808 #else
1809 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1810 CALL wrf_error_fatal(TRIM(wrf_err_message))
1811 #endif
1812 endif
1813 #endif
1815 #ifdef DM_PARALLEL
1816 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1817 #endif
1818 !$OMP PARALLEL DO &
1819 !$OMP PRIVATE ( ij )
1821 DO ij = 1 , grid%num_tiles
1822 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
1823 DO im = PARAM_FIRST_SCALAR , num_3d_s
1824 CALL g_set_physical_bc3d( scalar_old(ims,kms,jms,im),g_scalar_old(ims,kms,jms,im), 'p', config_flags, &
1825 ids, ide, jds, jde, kds, kde, &
1826 ims, ime, jms, jme, kms, kme, &
1827 ips, ipe, jps, jpe, kps, kpe, &
1828 grid%i_start(ij), grid%i_end(ij), &
1829 grid%j_start(ij), grid%j_end(ij), &
1830 k_start , k_end )
1831 END DO
1832 ENDIF
1833 END DO
1834 !$OMP END PARALLEL DO
1836 END IF ! end if for scalar_adv_opt
1838 ! chem
1840 IF ((config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1842 !$OMP PARALLEL DO &
1843 !$OMP PRIVATE ( ij )
1844 DO ij = 1 , grid%num_tiles
1845 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd chem' )
1846 DO im = PARAM_FIRST_SCALAR, num_3d_c
1848 !!!!! REPLACE WITH g_rk_update_scalar_pd WHEN chem IS NEEDED. Ning Pan
1849 CALL rk_update_scalar_pd( im, im, &
1850 chem_old(ims,kms,jms,im), &
1851 chem_tend(ims,kms,jms,im), &
1852 grid%c1h, grid%c2h, &
1853 grid%mu_1, grid%mu_1, grid%mub, &
1854 rk_step, dt_rk, grid%spec_zone, &
1855 config_flags, &
1856 ids, ide, jds, jde, kds, kde, &
1857 ims, ime, jms, jme, kms, kme, &
1858 grid%i_start(ij), grid%i_end(ij), &
1859 grid%j_start(ij), grid%j_end(ij), &
1860 k_start , k_end )
1862 ENDDO
1863 END DO
1864 !$OMP END PARALLEL DO
1866 !---------------------- positive definite bc call
1867 #ifdef DM_PARALLEL
1868 IF (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) THEN
1869 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1870 # include "HALO_EM_CHEM_OLD_E_5.inc"
1871 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1872 # include "HALO_EM_CHEM_OLD_E_7.inc"
1873 ELSE
1874 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1875 CALL wrf_error_fatal(TRIM(wrf_err_message))
1876 ENDIF
1877 ENDIF
1878 #endif
1880 #ifdef DM_PARALLEL
1881 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
1882 #endif
1884 !$OMP PARALLEL DO &
1885 !$OMP PRIVATE ( ij )
1886 DO ij = 1 , grid%num_tiles
1887 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
1888 DO im = PARAM_FIRST_SCALAR , num_3d_c
1890 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
1891 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
1892 ids, ide, jds, jde, kds, kde, &
1893 ims, ime, jms, jme, kms, kme, &
1894 ips, ipe, jps, jpe, kps, kpe, &
1895 grid%i_start(ij), grid%i_end(ij), &
1896 grid%j_start(ij), grid%j_end(ij), &
1897 k_start , k_end )
1898 END DO
1900 ENDIF
1901 END DO
1902 !$OMP END PARALLEL DO
1904 ENDIF ! end if for chem_adv_opt
1906 ! tracer
1908 IF ((config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1910 !$OMP PARALLEL DO &
1911 !$OMP PRIVATE ( ij )
1912 DO ij = 1 , grid%num_tiles
1913 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd tracer' )
1914 DO im = PARAM_FIRST_SCALAR, num_tracer
1916 CALL g_rk_update_scalar_pd( im, im, &
1917 tracer_old(ims,kms,jms,im),g_tracer_old(ims,kms,jms,im), &
1918 tracer_tend(ims,kms,jms,im),g_tracer_tend(ims,kms,jms,im), &
1919 grid%mu_1, grid%g_mu_1, grid%mu_1, grid%g_mu_1, grid%mub, &
1920 rk_step, dt_rk, grid%spec_zone, &
1921 config_flags, &
1922 ids, ide, jds, jde, kds, kde, &
1923 ims, ime, jms, jme, kms, kme, &
1924 grid%i_start(ij), grid%i_end(ij), &
1925 grid%j_start(ij), grid%j_end(ij), &
1926 k_start , k_end )
1928 ENDDO
1929 END DO
1930 !$OMP END PARALLEL DO
1932 !---------------------- positive definite bc call
1933 #ifdef DM_PARALLEL
1934 IF (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) THEN
1935 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1936 # include "HALO_EM_TRACER_OLD_E_5_TL.inc"
1937 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1938 # include "HALO_EM_TRACER_OLD_E_7_TL.inc"
1939 ELSE
1940 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1941 CALL wrf_error_fatal(TRIM(wrf_err_message))
1942 ENDIF
1943 ENDIF
1944 #endif
1946 #ifdef DM_PARALLEL
1947 # include "PERIOD_BDY_EM_TRACER_OLD.inc"
1948 #endif
1950 !$OMP PARALLEL DO &
1951 !$OMP PRIVATE ( ij )
1952 DO ij = 1 , grid%num_tiles
1953 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
1954 DO im = PARAM_FIRST_SCALAR , num_tracer
1956 CALL g_set_physical_bc3d( tracer_old(ims,kms,jms,im), &
1957 g_tracer_old(ims,kms,jms,im), 'p', config_flags, &
1958 ids, ide, jds, jde, kds, kde, &
1959 ims, ime, jms, jme, kms, kme, &
1960 ips, ipe, jps, jpe, kps, kpe, &
1961 grid%i_start(ij), grid%i_end(ij), &
1962 grid%j_start(ij), grid%j_end(ij), &
1963 k_start , k_end )
1964 END DO
1966 ENDIF
1967 END DO
1968 !$OMP END PARALLEL DO
1970 ENDIF ! end if for tracer_adv_opt
1972 ! tke
1974 IF ((config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order) &
1975 .and. (config_flags%km_opt .eq. 2) ) THEN
1977 !$OMP PARALLEL DO &
1978 !$OMP PRIVATE ( ij )
1979 DO ij = 1 , grid%num_tiles
1980 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd tke ' )
1981 CALL g_rk_update_scalar_pd( 1, 1, &
1982 grid%tke_1,grid%g_tke_1, &
1983 tke_tend(ims,kms,jms),g_tke_tend(ims,kms,jms), &
1984 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1985 rk_step, dt_rk, grid%spec_zone, &
1986 config_flags, &
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 )
1992 ENDDO
1993 !$OMP END PARALLEL DO
1995 !---------------------- positive definite bc call
1996 #ifdef DM_PARALLEL
1997 IF (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) THEN
1998 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1999 # include "HALO_EM_TKE_OLD_E_5_TL.inc"
2000 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2001 # include "HALO_EM_TKE_OLD_E_7_TL.inc"
2002 ELSE
2003 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2004 CALL wrf_error_fatal(TRIM(wrf_err_message))
2005 ENDIF
2006 ENDIF
2007 #endif
2009 #ifdef DM_PARALLEL
2010 # include "PERIOD_BDY_EM_TKE_OLD.inc"
2011 #endif
2013 !$OMP PARALLEL DO &
2014 !$OMP PRIVATE ( ij )
2015 DO ij = 1 , grid%num_tiles
2016 CALL g_set_physical_bc3d( grid%tke_1,grid%g_tke_1, 'p', config_flags, &
2017 ids, ide, jds, jde, kds, kde, &
2018 ims, ime, jms, jme, kms, kme, &
2019 ips, ipe, jps, jpe, kps, kpe, &
2020 grid%i_start(ij), grid%i_end(ij), &
2021 grid%j_start(ij), grid%j_end(ij), &
2022 k_start , k_end )
2023 END DO
2024 !$OMP END PARALLEL DO
2026 !--- end of positive definite physics tendency update
2028 END IF ! end if for tke_adv_opt
2030 #ifdef DM_PARALLEL
2031 !
2032 ! Stencils for patch communications (WCS, 29 June 2001)
2033 !
2034 ! * * * * *
2035 ! * * * * *
2036 ! * * + * *
2037 ! * * * * *
2038 ! * * * * *
2039 !
2040 ! ru_m x
2041 ! rv_m x
2042 ! ww_m x
2043 ! mut x
2044 !
2045 !--------------------------------------------------------------
2047 # include "HALO_EM_D_TL.inc"
2048 ! WCS addition 11/19/08
2049 # include "PERIOD_EM_DA.inc"
2050 #endif
2052 !<DESCRIPTION>
2053 !<pre>
2054 ! (4) Still within the RK loop, the scalar variables are advanced.
2055 !
2056 ! For the moist and chem variables, each one is advanced
2057 ! individually, using named loops "moist_variable_loop:"
2058 ! and "chem_variable_loop:". Each RK substep begins by
2059 ! calculating the advective tendency, and, for the first RK step,
2060 ! 3D mixing (calling rk_scalar_tend) followed by an update
2061 ! of the scalar (calling rk_update_scalar).
2062 !</pre>
2063 !</DESCRIPTION>
2066 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2068 moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
2070 ! adv_moist_cond is set in module_physics_init based on mp_physics choice
2071 ! true except for Ferrier scheme
2073 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
2075 !$OMP PARALLEL DO &
2076 !$OMP PRIVATE ( ij, tenddec )
2077 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
2079 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend moist' )
2080 tenddec = .false.
2082 BENCH_START(g_rk_scalar_tend_tim)
2083 CALL g_rk_scalar_tend ( im, im, config_flags, tenddec, &
2084 rk_step, dt_rk, &
2085 grid%ru_m, grid%g_ru_m, &
2086 grid%rv_m, grid%g_rv_m, &
2087 grid%ww_m, grid%g_ww_m, &
2088 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2089 grid%alt, grid%g_alt, &
2090 moist_old(ims,kms,jms,im), g_moist_old(ims,kms,jms,im), &
2091 moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2092 moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2093 advect_tend, g_advect_tend, h_tendency, g_h_tendency, &
2094 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2095 grid%qv_base, .true., grid%fnm, grid%fnp, &
2096 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
2097 grid%msfvy, grid%msftx,grid%msfty, &
2098 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2099 grid%kvdif, grid%xkhh,grid%g_xkhh, &
2100 grid%diff_6th_opt, grid%diff_6th_factor, &
2101 config_flags%moist_adv_opt, &
2102 ids, ide, jds, jde, kds, kde, &
2103 ims, ime, jms, jme, kms, kme, &
2104 grid%i_start(ij), grid%i_end(ij), &
2105 grid%j_start(ij), grid%j_end(ij), &
2106 k_start , k_end )
2108 ! IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
2109 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2110 ! CALL g_q_diabatic_add ( im, im, &
2111 ! dt_rk, grid%mut, grid%g_mut, &
2112 ! grid%qv_diabatic, grid%g_qv_diabatic, &
2113 ! grid%qc_diabatic, grid%g_qc_diabatic, &
2114 ! moist_tend(ims,kms,jms,im), &
2115 ! g_moist_tend(ims,kms,jms,im), &
2116 ! ids, ide, jds, jde, kds, kde, &
2117 ! ims, ime, jms, jme, kms, kme, &
2118 ! grid%i_start(ij), grid%i_end(ij), &
2119 ! grid%j_start(ij), grid%j_end(ij), &
2120 ! k_start , k_end )
2121 ! ENDIF
2122 ! ENDIF
2124 BENCH_END(g_rk_scalar_tend_tim)
2126 BENCH_START(g_rlx_bdy_scalar_tim)
2127 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
2128 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
2129 CALL g_relax_bdy_scalar ( moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2130 moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2131 grid%mut, grid%g_mut, &
2132 moist_bxs(jms,kms,1,im),g_moist_bxs(jms,kms,1,im), &
2133 moist_bxe(jms,kms,1,im),g_moist_bxe(jms,kms,1,im), &
2134 moist_bys(ims,kms,1,im),g_moist_bys(ims,kms,1,im), &
2135 moist_bye(ims,kms,1,im),g_moist_bye(ims,kms,1,im), &
2136 moist_btxs(jms,kms,1,im),g_moist_btxs(jms,kms,1,im), &
2137 moist_btxe(jms,kms,1,im),g_moist_btxe(jms,kms,1,im), &
2138 moist_btys(ims,kms,1,im),g_moist_btys(ims,kms,1,im), &
2139 moist_btye(ims,kms,1,im),g_moist_btye(ims,kms,1,im), &
2140 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2141 grid%dtbc, grid%fcx, grid%gcx, &
2142 config_flags, &
2143 ids,ide, jds,jde, kds,kde, & ! domain dims
2144 ims,ime, jms,jme, kms,kme, & ! memory dims
2145 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2146 grid%i_start(ij), grid%i_end(ij), &
2147 grid%j_start(ij), grid%j_end(ij), &
2148 k_start, k_end )
2150 CALL g_spec_bdy_scalar ( moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2151 moist_bxs(jms,kms,1,im),g_moist_bxs(jms,kms,1,im), &
2152 moist_bxe(jms,kms,1,im),g_moist_bxe(jms,kms,1,im), &
2153 moist_bys(ims,kms,1,im),g_moist_bys(ims,kms,1,im), &
2154 moist_bye(ims,kms,1,im),g_moist_bye(ims,kms,1,im), &
2155 moist_btxs(jms,kms,1,im),g_moist_btxs(jms,kms,1,im), &
2156 moist_btxe(jms,kms,1,im),g_moist_btxe(jms,kms,1,im), &
2157 moist_btys(ims,kms,1,im),g_moist_btys(ims,kms,1,im), &
2158 moist_btye(ims,kms,1,im),g_moist_btye(ims,kms,1,im), &
2159 config_flags%spec_bdy_width, grid%spec_zone, &
2160 config_flags, &
2161 ids,ide, jds,jde, kds,kde, & ! domain dims
2162 ims,ime, jms,jme, kms,kme, & ! memory dims
2163 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2164 grid%i_start(ij), grid%i_end(ij), &
2165 grid%j_start(ij), grid%j_end(ij), &
2166 k_start, k_end )
2168 ENDIF
2169 ENDIF
2170 BENCH_END(g_rlx_bdy_scalar_tim)
2172 ENDDO moist_tile_loop_1
2173 !$OMP END PARALLEL DO
2175 !$OMP PARALLEL DO &
2176 !$OMP PRIVATE ( ij, tenddec )
2177 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2179 CALL wrf_debug ( 200 , ' call g_rk_update_scalar' )
2180 tenddec = .false.
2182 BENCH_START(g_update_scal_tim)
2183 CALL g_rk_update_scalar( scs=im, sce=im, &
2184 scalar_1=moist_old(ims,kms,jms,im), &
2185 g_scalar_1=g_moist_old(ims,kms,jms,im), &
2186 scalar_2=moist(ims,kms,jms,im), &
2187 g_scalar_2=g_moist(ims,kms,jms,im), &
2188 sc_tend=moist_tend(ims,kms,jms,im), &
2189 g_sc_tend=g_moist_tend(ims,kms,jms,im), &
2190 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2191 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2192 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2193 msftx=grid%msftx,msfty=grid%msfty, &
2194 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2195 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2196 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2197 config_flags=config_flags, tenddec=tenddec, &
2198 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2199 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2200 its=grid%i_start(ij), ite=grid%i_end(ij), &
2201 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2202 kts=k_start , kte=k_end )
2204 ! IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
2205 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2206 ! CALL g_q_diabatic_subtr( im, im, &
2207 ! dt_rk, &
2208 ! grid%qv_diabatic, grid%g_qv_diabatic, &
2209 ! grid%qc_diabatic, grid%g_qc_diabatic, &
2210 ! moist(ims,kms,jms,im), &
2211 ! g_moist(ims,kms,jms,im), &
2212 ! ids, ide, jds, jde, kds, kde, &
2213 ! ims, ime, jms, jme, kms, kme, &
2214 ! grid%i_start(ij), grid%i_end(ij), &
2215 ! grid%j_start(ij), grid%j_end(ij), &
2216 ! k_start , k_end )
2217 ! ENDIF
2218 ! ENDIF
2220 BENCH_END(g_update_scal_tim)
2222 BENCH_START(g_flow_depbdy_tim)
2223 IF( config_flags%specified ) THEN
2224 IF(im .ne. P_QV)THEN
2225 CALL g_flow_dep_bdy ( moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2226 grid%ru_m, grid%rv_m, config_flags, &
2227 grid%spec_zone, &
2228 ids,ide, jds,jde, kds,kde, &
2229 ims,ime, jms,jme, kms,kme, &
2230 ips,ipe, jps,jpe, kps,kpe, &
2231 grid%i_start(ij), grid%i_end(ij), &
2232 grid%j_start(ij), grid%j_end(ij), &
2233 k_start, k_end )
2235 ENDIF
2236 ENDIF
2237 BENCH_END(g_flow_depbdy_tim)
2239 ENDDO moist_tile_loop_2
2240 !$OMP END PARALLEL DO
2242 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2244 ENDDO moist_variable_loop
2246 ENDIF moist_scalar_advance
2248 BENCH_START(g_tke_adv_tim)
2249 TKE_advance: IF (config_flags%km_opt .eq. 2) then
2250 #ifdef DM_PARALLEL
2251 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2252 # include "HALO_EM_TKE_ADVECT_3_TL.inc"
2253 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2254 # include "HALO_EM_TKE_ADVECT_5_TL.inc"
2255 ELSE
2256 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2257 CALL wrf_error_fatal(TRIM(wrf_err_message))
2258 ENDIF
2259 #endif
2260 !$OMP PARALLEL DO &
2261 !$OMP PRIVATE ( ij, tenddec )
2262 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2264 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend for tke' )
2266 tenddec = .false.
2267 CALL g_rk_scalar_tend ( 1, 1, config_flags, tenddec, &
2268 rk_step, dt_rk, &
2269 grid%ru_m,grid%g_ru_m, grid%rv_m,grid%g_rv_m, grid%ww_m,grid%g_ww_m, &
2270 grid%muts,grid%g_muts, grid%mub, grid%mu_1,grid%g_mu_1, &
2271 grid%alt,grid%g_alt, &
2272 grid%tke_1,grid%g_tke_1, &
2273 grid%tke_2,grid%g_tke_2, &
2274 tke_tend(ims,kms,jms),g_tke_tend(ims,kms,jms), &
2275 advect_tend,g_advect_tend,h_tendency,g_h_tendency, &
2276 z_tendency,g_z_tendency,grid%rqvften,grid%g_rqvften, &
2277 grid%qv_base, .false., grid%fnm, grid%fnp, &
2278 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2279 grid%msfvy, grid%msftx,grid%msfty, &
2280 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2281 grid%kvdif, grid%xkhh,grid%g_xkhh, &
2282 grid%diff_6th_opt, grid%diff_6th_factor, &
2283 config_flags%tke_adv_opt, &
2284 ids, ide, jds, jde, kds, kde, &
2285 ims, ime, jms, jme, kms, kme, &
2286 grid%i_start(ij), grid%i_end(ij), &
2287 grid%j_start(ij), grid%j_end(ij), &
2288 k_start , k_end )
2290 ENDDO tke_tile_loop_1
2291 !$OMP END PARALLEL DO
2293 !$OMP PARALLEL DO &
2294 !$OMP PRIVATE ( ij, tenddec )
2295 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2297 CALL wrf_debug ( 200 , ' call g_rk_update_scalar tke' )
2299 tenddec = .false.
2300 CALL g_rk_update_scalar( scs=1, sce=1, &
2301 scalar_1=grid%tke_1, g_scalar_1=grid%g_tke_1, &
2302 scalar_2=grid%tke_2, g_scalar_2=grid%g_tke_2, &
2303 sc_tend=tke_tend(ims,kms,jms), &
2304 g_sc_tend=g_tke_tend(ims,kms,jms), &
2305 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2306 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2307 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2308 msftx=grid%msftx,msfty=grid%msfty, &
2309 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2310 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2311 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2312 config_flags=config_flags, tenddec=tenddec, &
2313 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2314 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2315 its=grid%i_start(ij), ite=grid%i_end(ij), &
2316 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2317 kts=k_start , kte=k_end )
2319 ! bound the tke (greater than 0, less than tke_upper_bound)
2321 CALL g_bound_tke( grid%tke_2, grid%g_tke_2, grid%tke_upper_bound, &
2322 ids, ide, jds, jde, kds, kde, &
2323 ims, ime, jms, jme, kms, kme, &
2324 grid%i_start(ij), grid%i_end(ij), &
2325 grid%j_start(ij), grid%j_end(ij), &
2326 k_start , k_end )
2328 IF( config_flags%specified .or. config_flags%nested ) THEN
2329 CALL g_flow_dep_bdy ( grid%tke_2,grid%g_tke_2, &
2330 grid%ru_m, grid%rv_m, config_flags, &
2331 grid%spec_zone, &
2332 ids,ide, jds,jde, kds,kde, & ! domain dims
2333 ims,ime, jms,jme, kms,kme, & ! memory dims
2334 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2335 grid%i_start(ij), grid%i_end(ij), &
2336 grid%j_start(ij), grid%j_end(ij), &
2337 k_start, k_end )
2339 ENDIF
2340 ENDDO tke_tile_loop_2
2341 !$OMP END PARALLEL DO
2343 ENDIF TKE_advance
2344 BENCH_END(g_tke_adv_tim)
2346 #if (WRF_CHEM==1)
2347 ! next the chemical species
2348 BENCH_START(g_chem_adv_tim)
2349 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2351 chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
2353 !$OMP PARALLEL DO &
2354 !$OMP PRIVATE ( ij, tenddec )
2355 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2357 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend in chem_tile_loop_1' )
2359 !!!!! REPLACE WITH g_rk_scalar_tend WHEN chem IS NEEDED. Ning Pan
2360 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2361 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2362 CALL rk_scalar_tend ( ic, ic, config_flags,tenddec, &
2363 rk_step, dt_rk, &
2364 grid%ru_m, grid%rv_m, grid%ww_m, &
2365 grid%muts, grid%mub, grid%mu_1, &
2366 grid%alt, &
2367 chem_old(ims,kms,jms,ic), &
2368 chem(ims,kms,jms,ic), &
2369 chem_tend(ims,kms,jms,ic), &
2370 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2371 grid%qv_base, .false., grid%fnm, grid%fnp, &
2372 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2373 grid%msfvy, grid%msftx,grid%msfty, &
2374 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2375 grid%khdif, grid%kvdif, grid%xkhh, &
2376 grid%diff_6th_opt, grid%diff_6th_factor, &
2377 config_flags%chem_adv_opt, &
2378 ids, ide, jds, jde, kds, kde, &
2379 ims, ime, jms, jme, kms, kme, &
2380 grid%i_start(ij), grid%i_end(ij), &
2381 grid%j_start(ij), grid%j_end(ij), &
2382 k_start , k_end )
2385 !
2386 ! Currently, chemistry species with specified boundaries (i.e. the mother
2387 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2388 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2389 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2390 !
2391 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2392 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2394 !!!!! REPLACE WITH g_relax_bdy_scalar WHEN chem IS NEEDED. Ning Pan
2395 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2396 chem(ims,kms,jms,ic), grid%mut, &
2397 grid%c1h, grid%c2h, &
2398 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2399 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2400 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2401 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2402 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2403 grid%dtbc, grid%fcx, grid%gcx, &
2404 config_flags, &
2405 ids,ide, jds,jde, kds,kde, &
2406 ims,ime, jms,jme, kms,kme, &
2407 ips,ipe, jps,jpe, kps,kpe, &
2408 grid%i_start(ij), grid%i_end(ij), &
2409 grid%j_start(ij), grid%j_end(ij), &
2410 k_start, k_end )
2412 !!!!! REPLACE WITH g_spec_bdy_scalar WHEN chem IS NEEDED. Ning Pan
2413 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2414 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2415 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2416 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2417 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2418 config_flags%spec_bdy_width, grid%spec_zone, &
2419 config_flags, &
2420 ids,ide, jds,jde, kds,kde, &
2421 ims,ime, jms,jme, kms,kme, &
2422 ips,ipe, jps,jpe, kps,kpe, &
2423 grid%i_start(ij), grid%i_end(ij), &
2424 grid%j_start(ij), grid%j_end(ij), &
2425 k_start, k_end )
2427 ENDIF
2429 ENDDO chem_tile_loop_1
2430 !$OMP END PARALLEL DO
2432 !$OMP PARALLEL DO &
2433 !$OMP PRIVATE ( ij, tenddec )
2435 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2437 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2439 !!!!! REPLACE WITH g_rk_update_scalar WHEN chem IS NEEDED. Ning Pan
2440 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2441 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2442 CALL rk_update_scalar( scs=ic, sce=ic, &
2443 scalar_1=chem_old(ims,kms,jms,ic), &
2444 scalar_2=chem(ims,kms,jms,ic), &
2445 sc_tend=chem_tend(ims,kms,jms,ic), &
2446 advect_tend=advect_tend, &
2447 h_tendency=h_tendency, z_tendency=z_tendency, &
2448 msftx=grid%msftx,msfty=grid%msfty, &
2449 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2450 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2451 config_flags=config_flags, tenddec=tenddec, &
2452 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2453 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2454 its=grid%i_start(ij), ite=grid%i_end(ij), &
2455 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2456 kts=k_start , kte=k_end )
2458 IF( config_flags%specified ) THEN
2460 !!!!! REPLACE WITH g_flow_dep_bdy_chem WHEN chem IS NEEDED. Ning Pan
2461 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2462 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2463 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2464 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2465 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2466 dt_rk+grid%dtbc, &
2467 config_flags%spec_bdy_width,grid%z, &
2468 grid%have_bcs_chem, &
2469 grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2470 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2471 grid%spec_zone,ic, &
2472 ids,ide, jds,jde, kds,kde, & ! domain dims
2473 ims,ime, jms,jme, kms,kme, & ! memory dims
2474 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2475 grid%i_start(ij), grid%i_end(ij), &
2476 grid%j_start(ij), grid%j_end(ij), &
2477 k_start, k_end )
2479 ENDIF
2480 ENDDO chem_tile_loop_2
2481 !$OMP END PARALLEL DO
2483 ENDDO chem_variable_loop
2484 ENDIF chem_scalar_advance
2485 BENCH_END(g_chem_adv_tim)
2486 #endif
2487 ! next the chemical species
2488 BENCH_START(g_tracer_adv_tim)
2489 tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2491 tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
2493 !$OMP PARALLEL DO &
2494 !$OMP PRIVATE ( ij, tenddec )
2495 tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
2497 CALL wrf_debug ( 15 , ' call g_rk_scalar_tend in tracer_tile_loop_1' )
2499 tenddec = .false.
2500 CALL g_rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2501 rk_step, dt_rk, &
2502 grid%ru_m, grid%g_ru_m, &
2503 grid%rv_m, grid%g_rv_m, &
2504 grid%ww_m, grid%g_ww_m, &
2505 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2506 grid%alt, grid%g_alt, &
2507 tracer_old(ims,kms,jms,ic), g_tracer_old(ims,kms,jms,ic), &
2508 tracer(ims,kms,jms,ic), g_tracer(ims,kms,jms,ic), &
2509 tracer_tend(ims,kms,jms,ic), g_tracer_tend(ims,kms,jms,ic), &
2510 advect_tend, g_advect_tend, h_tendency,g_h_tendency, &
2511 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2512 grid%qv_base, .false., grid%fnm, grid%fnp, &
2513 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2514 grid%msfvy, grid%msftx,grid%msfty, &
2515 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2516 grid%khdif, grid%kvdif, grid%xkhh,grid%g_xkhh, &
2517 grid%diff_6th_opt, grid%diff_6th_factor, &
2518 config_flags%tracer_adv_opt, &
2519 ids, ide, jds, jde, kds, kde, &
2520 ims, ime, jms, jme, kms, kme, &
2521 grid%i_start(ij), grid%i_end(ij), &
2522 grid%j_start(ij), grid%j_end(ij), &
2523 k_start , k_end )
2525 !
2526 ! Currently, chemistry species with specified boundaries (i.e. the mother
2527 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2528 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2529 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2530 !
2531 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2532 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
2534 !!!!! REPLACE WITH g_relax_bdy_scalar WHEN tracer IS NEEDED. Ning Pan
2535 CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2536 tracer(ims,kms,jms,ic), grid%mut, &
2537 grid%c1h, grid%c2h, &
2538 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2539 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2540 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2541 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2542 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2543 grid%dtbc, grid%fcx, grid%gcx, &
2544 config_flags, &
2545 ids,ide, jds,jde, kds,kde, &
2546 ims,ime, jms,jme, kms,kme, &
2547 ips,ipe, jps,jpe, kps,kpe, &
2548 grid%i_start(ij), grid%i_end(ij), &
2549 grid%j_start(ij), grid%j_end(ij), &
2550 k_start, k_end )
2552 !!!!! REPLACE WITH g_spec_bdy_scalar WHEN tracer IS NEEDED. Ning Pan
2553 CALL spec_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2554 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2555 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2556 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2557 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2558 config_flags%spec_bdy_width, grid%spec_zone, &
2559 config_flags, &
2560 ids,ide, jds,jde, kds,kde, &
2561 ims,ime, jms,jme, kms,kme, &
2562 ips,ipe, jps,jpe, kps,kpe, &
2563 grid%i_start(ij), grid%i_end(ij), &
2564 grid%j_start(ij), grid%j_end(ij), &
2565 k_start, k_end )
2567 ENDIF
2569 ENDDO tracer_tile_loop_1
2570 !$OMP END PARALLEL DO
2572 !$OMP PARALLEL DO &
2573 !$OMP PRIVATE ( ij, tenddec )
2575 tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
2577 CALL wrf_debug ( 200 , ' call g_rk_update_scalar tracer ' )
2579 tenddec = .false.
2580 CALL g_rk_update_scalar( scs=ic, sce=ic, &
2581 scalar_1=tracer_old(ims,kms,jms,ic), &
2582 g_scalar_1=g_tracer_old(ims,kms,jms,ic), &
2583 scalar_2=tracer(ims,kms,jms,ic), &
2584 g_scalar_2=g_tracer(ims,kms,jms,ic), &
2585 sc_tend=tracer_tend(ims,kms,jms,ic), &
2586 g_sc_tend=g_tracer_tend(ims,kms,jms,ic), &
2587 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2588 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2589 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2590 msftx=grid%msftx,msfty=grid%msfty, &
2591 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2592 mu_new=grid%mu_2, g_mu_new=grid%g_mu_2, mu_base=grid%mub, &
2593 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2594 config_flags=config_flags, tenddec=tenddec, &
2595 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2596 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2597 its=grid%i_start(ij), ite=grid%i_end(ij), &
2598 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2599 kts=k_start , kte=k_end )
2601 IF( config_flags%specified ) THEN
2602 #if (WRF_CHEM==1)
2604 !!!!! REPLACE WITH a_flow_dep_bdy_tracer WHEN tracer IS NEEDED. Ning Pan
2605 CALL flow_dep_bdy_tracer( tracer(ims,kms,jms,ic), &
2606 tracer_bxs(jms,kms,1,ic), tracer_btxs(jms,kms,1,ic), &
2607 tracer_bxe(jms,kms,1,ic), tracer_btxe(jms,kms,1,ic), &
2608 tracer_bys(ims,kms,1,ic), tracer_btys(ims,kms,1,ic), &
2609 tracer_bye(ims,kms,1,ic), tracer_btye(ims,kms,1,ic), &
2610 dt_rk+grid%dtbc, &
2611 config_flags%spec_bdy_width,grid%z, &
2612 grid%have_bcs_tracer, &
2613 grid%ru_m, grid%rv_m, config_flags%tracer_opt,grid%alt, &
2614 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2615 grid%spec_zone,ic, &
2616 ids,ide, jds,jde, kds,kde, & ! domain dims
2617 ims,ime, jms,jme, kms,kme, & ! memory dims
2618 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2619 grid%i_start(ij), grid%i_end(ij), &
2620 grid%j_start(ij), grid%j_end(ij), &
2621 k_start, k_end )
2623 #else
2624 CALL g_flow_dep_bdy ( tracer(ims,kms,jms,ic),g_tracer(ims,kms,jms,ic), &
2625 grid%ru_m, grid%rv_m, config_flags, &
2626 grid%spec_zone, &
2627 ids,ide, jds,jde, kds,kde, & ! domain dims
2628 ims,ime, jms,jme, kms,kme, & ! memory dims
2629 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2630 grid%i_start(ij), grid%i_end(ij), &
2631 grid%j_start(ij), grid%j_end(ij), &
2632 k_start, k_end )
2633 #endif
2634 ENDIF
2635 ENDDO tracer_tile_loop_2
2636 !$OMP END PARALLEL DO
2638 ENDDO tracer_variable_loop
2639 ENDIF tracer_advance
2640 BENCH_END(g_tracer_adv_tim)
2642 ! next the other scalar species
2643 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2645 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2646 !$OMP PARALLEL DO &
2647 !$OMP PRIVATE ( ij, tenddec )
2648 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2650 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend scalar' )
2652 tenddec = .false.
2653 CALL g_rk_scalar_tend ( is, is, config_flags, tenddec, &
2654 rk_step, dt_rk, &
2655 grid%ru_m, grid%g_ru_m, &
2656 grid%rv_m, grid%g_rv_m, &
2657 grid%ww_m, grid%g_ww_m, &
2658 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2659 grid%alt, grid%g_alt, &
2660 scalar_old(ims,kms,jms,is), g_scalar_old(ims,kms,jms,is), &
2661 scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2662 scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2663 advect_tend, g_advect_tend, h_tendency,g_h_tendency, &
2664 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2665 grid%qv_base, .false., grid%fnm, grid%fnp, &
2666 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2667 grid%msfvy, grid%msftx,grid%msfty, &
2668 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2669 grid%khdif, grid%kvdif, grid%xkhh,grid%g_xkhh, &
2670 grid%diff_6th_opt, grid%diff_6th_factor, &
2671 config_flags%scalar_adv_opt, &
2672 ids, ide, jds, jde, kds, kde, &
2673 ims, ime, jms, jme, kms, kme, &
2674 grid%i_start(ij), grid%i_end(ij), &
2675 grid%j_start(ij), grid%j_end(ij), &
2676 k_start , k_end )
2678 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2680 CALL g_relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2681 scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2682 grid%mut, grid%g_mut, &
2683 scalar_bxs(jms,kms,1,is),g_scalar_bxs(jms,kms,1,is), &
2684 scalar_bxe(jms,kms,1,is),g_scalar_bxe(jms,kms,1,is), &
2685 scalar_bys(ims,kms,1,is),g_scalar_bys(ims,kms,1,is), &
2686 scalar_bye(ims,kms,1,is),g_scalar_bye(ims,kms,1,is), &
2687 scalar_btxs(jms,kms,1,is),g_scalar_btxs(jms,kms,1,is), &
2688 scalar_btxe(jms,kms,1,is),g_scalar_btxe(jms,kms,1,is), &
2689 scalar_btys(ims,kms,1,is),g_scalar_btys(ims,kms,1,is), &
2690 scalar_btye(ims,kms,1,is),g_scalar_btye(ims,kms,1,is), &
2691 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2692 grid%dtbc, grid%fcx, grid%gcx, &
2693 config_flags, &
2694 ids,ide, jds,jde, kds,kde, &
2695 ims,ime, jms,jme, kms,kme, &
2696 ips,ipe, jps,jpe, kps,kpe, &
2697 grid%i_start(ij), grid%i_end(ij), &
2698 grid%j_start(ij), grid%j_end(ij), &
2699 k_start, k_end )
2701 CALL g_spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2702 scalar_bxs(jms,kms,1,is),g_scalar_bxs(jms,kms,1,is), &
2703 scalar_bxe(jms,kms,1,is),g_scalar_bxe(jms,kms,1,is), &
2704 scalar_bys(ims,kms,1,is),g_scalar_bys(ims,kms,1,is), &
2705 scalar_bye(ims,kms,1,is),g_scalar_bye(ims,kms,1,is), &
2706 scalar_btxs(jms,kms,1,is),g_scalar_btxs(jms,kms,1,is), &
2707 scalar_btxe(jms,kms,1,is),g_scalar_btxe(jms,kms,1,is), &
2708 scalar_btys(ims,kms,1,is),g_scalar_btys(ims,kms,1,is), &
2709 scalar_btye(ims,kms,1,is),g_scalar_btye(ims,kms,1,is), &
2710 config_flags%spec_bdy_width, grid%spec_zone, &
2711 config_flags, &
2712 ids,ide, jds,jde, kds,kde, &
2713 ims,ime, jms,jme, kms,kme, &
2714 ips,ipe, jps,jpe, kps,kpe, &
2715 grid%i_start(ij), grid%i_end(ij), &
2716 grid%j_start(ij), grid%j_end(ij), &
2717 k_start, k_end )
2720 ENDIF ! b.c test for chem nested boundary condition
2722 ENDDO scalar_tile_loop_1
2723 !$OMP END PARALLEL DO
2725 !$OMP PARALLEL DO &
2726 !$OMP PRIVATE ( ij, tenddec )
2727 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2729 CALL wrf_debug ( 200 , ' call g_rk_update_scalar scalar' )
2731 tenddec = .false.
2732 CALL g_rk_update_scalar( scs=is, sce=is, &
2733 scalar_1=scalar_old(ims,kms,jms,is), &
2734 g_scalar_1=g_scalar_old(ims,kms,jms,is), &
2735 scalar_2=scalar(ims,kms,jms,is), &
2736 g_scalar_2=g_scalar(ims,kms,jms,is), &
2737 sc_tend=scalar_tend(ims,kms,jms,is), &
2738 g_sc_tend=g_scalar_tend(ims,kms,jms,is), &
2739 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2740 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2741 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2742 msftx=grid%msftx,msfty=grid%msfty, &
2743 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2744 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2745 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2746 config_flags=config_flags, tenddec=tenddec, &
2747 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2748 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2749 its=grid%i_start(ij), ite=grid%i_end(ij), &
2750 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2751 kts=k_start , kte=k_end )
2753 IF( config_flags%specified ) THEN
2754 IF (is.EQ.P_QDCN.OR.is.EQ.P_QTCN.OR.is.EQ.P_QNIN) THEN ! for ntu3m
2755 CALL g_flow_dep_bdy_fixed_inflow(scalar(ims,kms,jms,is),&
2756 g_scalar(ims,kms,jms,is), &
2757 grid%ru_m,grid%rv_m, &
2758 config_flags,grid%spec_zone, &
2759 ids,ide,jds,jde,kds,kde,ims, &
2760 ime,jms,jme,kms,kme,ips,ipe, &
2761 jps,jpe,kps,kpe, &
2762 grid%i_start(ij), &
2763 grid%i_end(ij), &
2764 grid%j_start(ij), &
2765 grid%j_end(ij), &
2766 k_start,k_end)
2767 ELSEIF (is.EQ.P_QNN) THEN
2768 CALL g_flow_dep_bdy_qnn(scalar(ims,kms,jms,is), &
2769 g_scalar(ims,kms,jms,is), &
2770 grid%ru_m,grid%rv_m, &
2771 config_flags,grid%spec_zone, &
2772 grid%ccn_conc,ids,ide,jds,jde,&
2773 kds,kde,ims,ime,jms,jme,kms, &
2774 kme,ips,ipe,jps,jpe,kps,kpe, &
2775 grid%i_start(ij), &
2776 grid%i_end(ij), &
2777 grid%j_start(ij), &
2778 grid%j_end(ij),k_start,k_end)
2779 ELSE
2780 CALL g_flow_dep_bdy(scalar(ims,kms,jms,is), &
2781 g_scalar(ims,kms,jms,is), &
2782 grid%ru_m,grid%rv_m,config_flags, &
2783 grid%spec_zone,ids,ide,jds,jde, &
2784 kds,kde,ims,ime,jms,jme,kms,kme, &
2785 ips,ipe,jps,jpe,kps,kpe, &
2786 grid%i_start(ij),grid%i_end(ij), &
2787 grid%j_start(ij),grid%j_end(ij), &
2788 k_start,k_end) ! for ntu3m
2789 ! IF(is .ne. P_QNN)THEN ! for ntu3m
2790 ! CALL g_flow_dep_bdy ( scalar(ims,kms,jms,is),g_scalar(ims,kms,jms,is), &
2791 ! grid%ru_m, grid%rv_m, config_flags, &
2792 ! grid%spec_zone, &
2793 ! ids,ide, jds,jde, kds,kde, & ! domain dims
2794 ! ims,ime, jms,jme, kms,kme, & ! memory dims
2795 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2796 ! grid%i_start(ij), grid%i_end(ij), &
2797 ! grid%j_start(ij), grid%j_end(ij), &
2798 ! k_start, k_end )
2799 ! ELSE
2800 ! CALL g_flow_dep_bdy_qnn ( scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2801 ! grid%ru_m, grid%rv_m, config_flags, &
2802 ! grid%spec_zone, &
2803 ! grid%ccn_conc, & ! RAS
2804 ! ids,ide, jds,jde, kds,kde, & ! domain dims
2805 ! ims,ime, jms,jme, kms,kme, & ! memory dims
2806 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2807 ! grid%i_start(ij), grid%i_end(ij), &
2808 ! grid%j_start(ij), grid%j_end(ij), &
2809 ! k_start, k_end ) ! for ntu3m
2810 ENDIF
2812 ENDIF
2814 ENDDO scalar_tile_loop_2
2815 !$OMP END PARALLEL DO
2817 ENDDO scalar_variable_loop
2819 ENDIF other_scalar_advance
2821 ! update the pressure and density at the new time level
2823 !$OMP PARALLEL DO &
2824 !$OMP PRIVATE ( ij )
2825 DO ij = 1 , grid%num_tiles
2827 BENCH_START(g_calc_p_rho_tim)
2829 CALL g_calc_p_rho_phi( moist,g_moist, num_3d_m, config_flags%hypsometric_opt, &
2830 grid%al,grid%g_al, grid%alb, grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, &
2831 grid%ph_2,grid%g_ph_2, grid%phb, grid%p, grid%g_p, grid%pb, grid%t_2,grid%g_t_2, &
2832 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
2833 grid%rdn, config_flags%non_hydrostatic, &
2834 ids, ide, jds, jde, kds, kde, &
2835 ims, ime, jms, jme, kms, kme, &
2836 grid%i_start(ij), grid%i_end(ij), &
2837 grid%j_start(ij), grid%j_end(ij), &
2838 k_start , k_end )
2840 BENCH_END(g_calc_p_rho_tim)
2842 ENDDO
2843 !$OMP END PARALLEL DO
2845 ! Reset the boundary conditions if there is another corrector step.
2846 ! (rk_step < rk_order), else we'll handle it at the end of everything
2847 ! (after the split physics, before exiting the timestep).
2849 rk_step_1_check: IF ( rk_step < rk_order ) THEN
2851 !-----------------------------------------------------------
2852 ! rk3 substep polar filter for scalars (moist,chem,scalar)
2853 !-----------------------------------------------------------
2855 IF (config_flags%polar) THEN
2856 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2857 CALL wrf_debug ( 200 , ' call filter moist ' )
2858 DO im = PARAM_FIRST_SCALAR, num_3d_m
2859 IF ( config_flags%coupled_filtering ) THEN
2860 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2861 ,MU=grid%mu_2 , MUB=grid%mub &
2862 ,C1=grid%c1h , C2=grid%c2h &
2863 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2864 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2865 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2866 END IF
2867 CALL pxft ( grid=grid &
2868 ,lineno=__LINE__ &
2869 ,flag_uv = 0 &
2870 ,flag_rurv = 0 &
2871 ,flag_wph = 0 &
2872 ,flag_ww = 0 &
2873 ,flag_t = 0 &
2874 ,flag_mu = 0 &
2875 ,flag_mut = 0 &
2876 ,flag_moist = im &
2877 ,flag_chem = 0 &
2878 ,flag_scalar = 0 &
2879 ,flag_tracer = 0 &
2880 ,actual_distance_average=config_flags%actual_distance_average&
2881 ,pos_def = config_flags%pos_def &
2882 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2883 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2884 ,fft_filter_lat = config_flags%fft_filter_lat &
2885 ,dclat = dclat &
2886 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2887 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2888 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2889 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2890 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2891 IF ( config_flags%coupled_filtering ) THEN
2892 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2893 ,MU=grid%mu_2 , MUB=grid%mub &
2894 ,C1=grid%c1h , C2=grid%c2h &
2895 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2896 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2897 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2898 END IF
2899 END DO
2900 END IF
2902 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
2903 CALL wrf_debug ( 200 , ' call filter chem ' )
2904 DO im = PARAM_FIRST_SCALAR, num_3d_c
2905 IF ( config_flags%coupled_filtering ) THEN
2906 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2907 ,MU=grid%mu_2 , MUB=grid%mub &
2908 ,C1=grid%c1h , C2=grid%c2h &
2909 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2910 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2911 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2912 END IF
2913 CALL pxft ( grid=grid &
2914 ,lineno=__LINE__ &
2915 ,flag_uv = 0 &
2916 ,flag_rurv = 0 &
2917 ,flag_wph = 0 &
2918 ,flag_ww = 0 &
2919 ,flag_t = 0 &
2920 ,flag_mu = 0 &
2921 ,flag_mut = 0 &
2922 ,flag_moist = 0 &
2923 ,flag_chem = im &
2924 ,flag_tracer = 0 &
2925 ,flag_scalar = 0 &
2926 ,actual_distance_average=config_flags%actual_distance_average&
2927 ,pos_def = config_flags%pos_def &
2928 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2929 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2930 ,fft_filter_lat = config_flags%fft_filter_lat &
2931 ,dclat = dclat &
2932 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2933 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2934 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2935 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2936 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2937 IF ( config_flags%coupled_filtering ) THEN
2938 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2939 ,MU=grid%mu_2 , MUB=grid%mub &
2940 ,C1=grid%c1h , C2=grid%c2h &
2941 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2942 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2943 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2944 END IF
2945 END DO
2946 END IF
2947 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
2948 CALL wrf_debug ( 200 , ' call filter tracer ' )
2949 DO im = PARAM_FIRST_SCALAR, num_tracer
2950 IF ( config_flags%coupled_filtering ) THEN
2951 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2952 ,MU=grid%mu_2 , MUB=grid%mub &
2953 ,C1=grid%c1h , C2=grid%c2h &
2954 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2955 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2956 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2957 END IF
2958 CALL pxft ( grid=grid &
2959 ,lineno=__LINE__ &
2960 ,flag_uv = 0 &
2961 ,flag_rurv = 0 &
2962 ,flag_wph = 0 &
2963 ,flag_ww = 0 &
2964 ,flag_t = 0 &
2965 ,flag_mu = 0 &
2966 ,flag_mut = 0 &
2967 ,flag_moist = 0 &
2968 ,flag_chem = 0 &
2969 ,flag_tracer = im &
2970 ,flag_scalar = 0 &
2971 ,actual_distance_average=config_flags%actual_distance_average&
2972 ,pos_def = config_flags%pos_def &
2973 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2974 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2975 ,fft_filter_lat = config_flags%fft_filter_lat &
2976 ,dclat = dclat &
2977 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2978 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2979 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2980 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2981 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2982 IF ( config_flags%coupled_filtering ) THEN
2983 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2984 ,MU=grid%mu_2 , MUB=grid%mub &
2985 ,C1=grid%c1h , C2=grid%c2h &
2986 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2987 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2988 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2989 END IF
2990 END DO
2991 END IF
2993 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
2994 CALL wrf_debug ( 200 , ' call filter scalar ' )
2995 DO im = PARAM_FIRST_SCALAR, num_3d_s
2996 IF ( config_flags%coupled_filtering ) THEN
2997 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2998 ,MU=grid%mu_2 , MUB=grid%mub &
2999 ,C1=grid%c1h , C2=grid%c2h &
3000 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3001 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3002 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3003 END IF
3004 CALL pxft ( grid=grid &
3005 ,lineno=__LINE__ &
3006 ,flag_uv = 0 &
3007 ,flag_rurv = 0 &
3008 ,flag_wph = 0 &
3009 ,flag_ww = 0 &
3010 ,flag_t = 0 &
3011 ,flag_mu = 0 &
3012 ,flag_mut = 0 &
3013 ,flag_moist = 0 &
3014 ,flag_chem = 0 &
3015 ,flag_tracer = 0 &
3016 ,flag_scalar = im &
3017 ,actual_distance_average=config_flags%actual_distance_average&
3018 ,pos_def = config_flags%pos_def &
3019 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3020 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3021 ,fft_filter_lat = config_flags%fft_filter_lat &
3022 ,dclat = dclat &
3023 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3024 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3025 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3026 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3027 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3028 IF ( config_flags%coupled_filtering ) THEN
3029 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3030 ,MU=grid%mu_2 , MUB=grid%mub &
3031 ,C1=grid%c1h , C2=grid%c2h &
3032 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3033 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3034 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3035 END IF
3036 END DO
3037 END IF
3038 END IF ! polar filter test
3040 !-----------------------------------------------------------
3041 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
3042 !-----------------------------------------------------------
3044 !-----------------------------------------------------------
3045 ! Stencils for patch communications (WCS, 29 June 2001)
3046 !
3047 ! here's where we need a wide comm stencil - these are the
3048 ! uncoupled variables so are used for high order calc in
3049 ! advection and mixong routines.
3050 !
3051 !
3052 ! * * * * * * *
3053 ! * * * * * * * * * * * *
3054 ! * * * * * * * * * * * * *
3055 ! * + * * * + * * * * * + * * *
3056 ! * * * * * * * * * * * * *
3057 ! * * * * * * * * * * * *
3058 ! * * * * * * *
3059 !
3060 ! al x
3061 !
3062 ! 2D variable
3063 ! mu_2 x
3064 !
3065 ! (adv order <=4)
3066 ! u_2 x
3067 ! v_2 x
3068 ! w_2 x
3069 ! t_2 x
3070 ! ph_2 x
3071 !
3072 ! (adv order <=6)
3073 ! u_2 x
3074 ! v_2 x
3075 ! w_2 x
3076 ! t_2 x
3077 ! ph_2 x
3078 !
3079 ! 4D variable
3080 ! moist x
3081 ! chem x
3082 ! scalar x
3084 #ifdef DM_PARALLEL
3085 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3086 # include "HALO_EM_D2_3_TL.inc"
3087 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3088 # include "HALO_EM_D2_5_TL.inc"
3089 ELSE
3090 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3091 CALL wrf_error_fatal(TRIM(wrf_err_message))
3092 ENDIF
3093 # include "PERIOD_BDY_EM_D.inc"
3094 # include "PERIOD_BDY_EM_MOIST2.inc"
3095 # include "PERIOD_BDY_EM_CHEM2.inc"
3096 # include "PERIOD_BDY_EM_TRACER2.inc"
3097 # include "PERIOD_BDY_EM_SCALAR2.inc"
3098 #endif
3100 BENCH_START(g_bc_end_tim)
3101 !$OMP PARALLEL DO &
3102 !$OMP PRIVATE ( ij )
3103 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
3104 CALL wrf_debug ( 200 , ' call g_rk_phys_bc_dry_2' )
3106 CALL g_rk_phys_bc_dry_2( config_flags, &
3107 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%w_2,grid%g_w_2, &
3108 grid%t_2,grid%g_t_2, grid%ph_2,grid%g_ph_2, grid%mu_2,grid%g_mu_2, &
3109 ids, ide, jds, jde, kds, kde, &
3110 ims, ime, jms, jme, kms, kme, &
3111 ips, ipe, jps, jpe, kps, kpe, &
3112 grid%i_start(ij), grid%i_end(ij), &
3113 grid%j_start(ij), grid%j_end(ij), &
3114 k_start , k_end )
3116 BENCH_START(g_diag_w_tim)
3117 IF (.not. config_flags%non_hydrostatic) THEN
3118 CALL g_diagnose_w( ph_tend,g_ph_tend, grid%ph_2,grid%g_ph_2, grid%ph_1,grid%g_ph_1, &
3119 grid%w_2,grid%g_w_2, grid%muts,grid%g_muts, dt_rk, &
3120 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ht, &
3121 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3122 ids, ide, jds, jde, kds, kde, &
3123 ims, ime, jms, jme, kms, kme, &
3124 grid%i_start(ij), grid%i_end(ij), &
3125 grid%j_start(ij), grid%j_end(ij), &
3126 k_start , k_end )
3127 ENDIF
3128 BENCH_END(g_diag_w_tim)
3130 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
3132 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3134 CALL g_set_physical_bc3d( moist(ims,kms,jms,im),g_moist(ims,kms,jms,im), 'p', config_flags, &
3135 ids, ide, jds, jde, kds, kde, &
3136 ims, ime, jms, jme, kms, kme, &
3137 ips, ipe, jps, jpe, kps, kpe, &
3138 grid%i_start(ij), grid%i_end(ij), &
3139 grid%j_start(ij), grid%j_end(ij), &
3140 k_start , k_end )
3142 END DO moisture_loop_bdy_1
3144 ENDIF
3146 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
3148 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3150 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
3151 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
3152 ids, ide, jds, jde, kds, kde, &
3153 ims, ime, jms, jme, kms, kme, &
3154 ips, ipe, jps, jpe, kps, kpe, &
3155 grid%i_start(ij), grid%i_end(ij), &
3156 grid%j_start(ij), grid%j_end(ij), &
3157 k_start , k_end-1 )
3159 END DO chem_species_bdy_loop_1
3161 END IF
3163 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
3165 tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
3167 CALL g_set_physical_bc3d( tracer(ims,kms,jms,ic),g_tracer(ims,kms,jms,ic), 'p', config_flags, &
3168 ids, ide, jds, jde, kds, kde, &
3169 ims, ime, jms, jme, kms, kme, &
3170 ips, ipe, jps, jpe, kps, kpe, &
3171 grid%i_start(ij), grid%i_end(ij), &
3172 grid%j_start(ij), grid%j_end(ij), &
3173 k_start , k_end-1 )
3175 END DO tracer_species_bdy_loop_1
3177 END IF
3179 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
3181 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3183 CALL g_set_physical_bc3d( scalar(ims,kms,jms,is),g_scalar(ims,kms,jms,is), 'p', config_flags, &
3184 ids, ide, jds, jde, kds, kde, &
3185 ims, ime, jms, jme, kms, kme, &
3186 ips, ipe, jps, jpe, kps, kpe, &
3187 grid%i_start(ij), grid%i_end(ij), &
3188 grid%j_start(ij), grid%j_end(ij), &
3189 k_start , k_end-1 )
3191 END DO scalar_species_bdy_loop_1
3193 END IF
3195 IF (config_flags%km_opt .eq. 2) THEN
3197 CALL g_set_physical_bc3d( grid%tke_2 ,grid%g_tke_2, 'p', config_flags, &
3198 ids, ide, jds, jde, kds, kde, &
3199 ims, ime, jms, jme, kms, kme, &
3200 ips, ipe, jps, jpe, kps, kpe, &
3201 grid%i_start(ij), grid%i_end(ij), &
3202 grid%j_start(ij), grid%j_end(ij), &
3203 k_start , k_end )
3205 END IF
3207 END DO tile_bc_loop_1
3208 !$OMP END PARALLEL DO
3209 BENCH_END(g_bc_end_tim)
3212 #ifdef DM_PARALLEL
3214 ! * * * * *
3215 ! * * * * * * * * *
3216 ! * + * * + * * * + * *
3217 ! * * * * * * * * *
3218 ! * * * * *
3220 ! moist, chem, scalar, tke x
3223 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3224 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3225 # include "HALO_EM_TKE_5_TL.inc"
3226 ELSE
3227 # include "HALO_EM_TKE_3_TL.inc"
3228 ENDIF
3229 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3230 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3231 # include "HALO_EM_TKE_7_TL.inc"
3232 ELSE
3233 # include "HALO_EM_TKE_5_TL.inc"
3234 ENDIF
3235 ELSE
3236 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3237 CALL wrf_error_fatal(TRIM(wrf_err_message))
3238 ENDIF
3240 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
3241 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3242 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3243 # include "HALO_EM_MOIST_E_5_TL.inc"
3244 ELSE
3245 # include "HALO_EM_MOIST_E_3_TL.inc"
3246 END IF
3247 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3248 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3249 # include "HALO_EM_MOIST_E_7_TL.inc"
3250 ELSE
3251 # include "HALO_EM_MOIST_E_5_TL.inc"
3252 END IF
3253 ELSE
3254 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3255 CALL wrf_error_fatal(TRIM(wrf_err_message))
3256 ENDIF
3257 ENDIF
3258 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3259 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3260 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3261 # include "HALO_EM_CHEM_E_5.inc"
3262 ELSE
3263 # include "HALO_EM_CHEM_E_3.inc"
3264 ENDIF
3265 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3266 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3267 # include "HALO_EM_CHEM_E_7.inc"
3268 ELSE
3269 # include "HALO_EM_CHEM_E_5.inc"
3270 ENDIF
3271 ELSE
3272 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3273 CALL wrf_error_fatal(TRIM(wrf_err_message))
3274 ENDIF
3275 ENDIF
3276 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3277 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3278 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3279 # include "HALO_EM_TRACER_E_5_TL.inc"
3280 ELSE
3281 # include "HALO_EM_TRACER_E_3_TL.inc"
3282 ENDIF
3283 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3284 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3285 # include "HALO_EM_TRACER_E_7_TL.inc"
3286 ELSE
3287 # include "HALO_EM_TRACER_E_5_TL.inc"
3288 ENDIF
3289 ELSE
3290 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3291 CALL wrf_error_fatal(TRIM(wrf_err_message))
3292 ENDIF
3293 ENDIF
3294 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3295 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3296 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3297 # include "HALO_EM_SCALAR_E_5.inc"
3298 ELSE
3299 # include "HALO_EM_SCALAR_E_3.inc"
3300 ENDIF
3301 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3302 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3303 # include "HALO_EM_SCALAR_E_7.inc"
3304 ELSE
3305 # include "HALO_EM_SCALAR_E_5.inc"
3306 ENDIF
3307 ELSE
3308 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3309 CALL wrf_error_fatal(TRIM(wrf_err_message))
3310 ENDIF
3311 ENDIF
3312 #endif
3314 ENDIF rk_step_1_check
3317 !**********************************************************
3318 !
3319 ! end of RK predictor-corrector loop
3320 !
3321 !**********************************************************
3323 END DO Runge_Kutta_loop
3325 IF (config_flags%do_avgflx_em .EQ. 1) THEN
3326 ! Reinitialize time-averaged fluxes if history output was written after the previous time step:
3328 CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time)
3330 CALL domain_clock_get ( grid, current_time=CurrTime, &
3331 current_timestr=message2 )
3333 ! use overloaded -, .LT. operator to check whether to initialize avgflx:
3334 ! reinitialize after each history output (detect this here by comparing current time
3335 ! against last history time and time step - this code follows what's done in adapt_timestep_em):
3336 WRITE ( message , FMT = '("solve_em_tl: old_dt =",g15.6,", dt=",g15.6," on domain ",I3)' ) &
3337 & old_dt,grid%dt,grid%id
3338 CALL wrf_debug(200,message)
3339 old_dt=min(old_dt,grid%dt)
3340 num = INT(old_dt * precision)
3341 den = precision
3343 CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3345 IF (CurrTime .lt. temp_time + dtInterval) THEN
3346 WRITE ( message , FMT = '("solve_em_tl: initializing avgflx at time ",A," on domain ",I3)' ) &
3347 & TRIM(message2), grid%id
3348 CALL wrf_message(trim(message))
3349 grid%avgflx_count = 0
3350 !tile-loop for zero_avgflx
3351 !$OMP PARALLEL DO &
3352 !$OMP PRIVATE ( ij )
3354 DO ij = 1 , grid%num_tiles
3355 CALL wrf_debug(200,'In solve_em_tl, before zero_avgflx call')
3357 CALL zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3358 & ids, ide, jds, jde, kds, kde, &
3359 & ims, ime, jms, jme, kms, kme, &
3360 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3361 & k_start , k_end, f_flux, &
3362 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3363 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3364 CALL wrf_debug(200,'In solve_em_tl, after zero_avgflx call')
3366 ENDDO
3367 ENDIF
3369 ! Update avgflx quantities
3370 !tile-loop for upd_avgflx
3371 !$OMP PARALLEL DO &
3372 !$OMP PRIVATE ( ij )
3374 DO ij = 1 , grid%num_tiles
3375 CALL wrf_debug(200,'In solve_em_tl, before upd_avgflx call')
3377 CALL upd_avgflx(grid%avgflx_count,grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3378 & grid%ru_m, grid%rv_m, grid%ww_m, &
3379 & ids, ide, jds, jde, kds, kde, &
3380 & ims, ime, jms, jme, kms, kme, &
3381 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3382 & k_start , k_end, f_flux, &
3383 & grid%cfu1,grid%cfd1,grid%dfu1,grid%efu1,grid%dfd1,grid%efd1, &
3384 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3385 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3386 CALL wrf_debug(200,'In solve_em_tl, after upd_avgflx call')
3388 ENDDO
3389 grid%avgflx_count = grid%avgflx_count + 1
3390 ENDIF
3391 !
3392 !$OMP PARALLEL DO &
3393 !$OMP PRIVATE ( ij )
3394 DO ij = 1 , grid%num_tiles
3396 BENCH_START(g_advance_ppt_tim)
3397 CALL wrf_debug ( 200 , ' call g_advance_ppt' )
3398 CALL g_advance_ppt(grid%rthcuten,grid%g_rthcuten,grid%rqvcuten,grid%g_rqvcuten, &
3399 grid%rqccuten,grid%g_rqccuten,grid%rqrcuten,grid%g_rqrcuten, &
3400 grid%rqicuten,grid%g_rqicuten,grid%rqscuten,grid%g_rqscuten, &
3401 grid%rainc,grid%g_rainc,grid%raincv,grid%rainsh,grid%g_rainsh,&
3402 grid%pratec,grid%g_pratec,grid%pratesh,grid%g_pratesh, &
3403 grid%nca,grid%g_nca,grid%htop,grid%g_htop,grid%hbot,grid%g_hbot,&
3404 grid%cutop,grid%g_cutop,grid%cubot,grid%g_cubot, &
3405 grid%cuppt, grid%g_cuppt, grid%dt, config_flags, &
3406 ids,ide, jds,jde, kds,kde, &
3407 ims,ime, jms,jme, kms,kme, &
3408 grid%i_start(ij), grid%i_end(ij), &
3409 grid%j_start(ij), grid%j_end(ij), &
3410 k_start , k_end )
3411 BENCH_END(g_advance_ppt_tim)
3413 ENDDO
3414 !$OMP END PARALLEL DO
3416 !$OMP PARALLEL DO &
3417 !$OMP PRIVATE ( ij )
3418 DO ij = 1 , grid%num_tiles
3420 CALL wrf_debug ( 200 , ' call g_phy_prep_part2' )
3421 CALL g_phy_prep_part2 ( config_flags, &
3422 grid%mut,grid%g_mut, grid%muu, grid%g_muu, grid%muv, grid%g_muv, &
3423 grid%rthraten, grid%g_rthraten, &
3424 grid%rthblten, grid%g_rthblten, &
3425 grid%rublten, grid%g_rublten, grid%rvblten, grid%g_rvblten, &
3426 grid%rqvblten, grid%g_rqvblten, grid%rqcblten, grid%g_rqcblten, grid%rqiblten, grid%g_rqiblten, &
3427 grid%rucuten, grid%g_rucuten , grid%rvcuten, grid%g_rvcuten, grid%rthcuten, grid%g_rthcuten, &
3428 grid%rqvcuten, grid%g_rqvcuten, grid%rqccuten, grid%g_rqccuten, grid%rqrcuten, grid%g_rqrcuten, &
3429 grid%rqicuten, grid%g_rqicuten, grid%rqscuten, grid%g_rqscuten, &
3430 grid%rushten, grid%g_rushten, grid%rvshten, grid%g_rvshten, grid%rthshten, grid%g_rthshten, &
3431 grid%rqvshten, grid%g_rqvshten, grid%rqcshten, grid%g_rqcshten, grid%rqrshten, grid%g_rqrshten, &
3432 grid%rqishten, grid%g_rqishten, grid%rqsshten, grid%g_rqsshten, grid%rqgshten, grid%g_rqgshten, &
3433 grid%rthften, grid%g_rthften, grid%rqvften, grid%g_rqvften, &
3434 grid%RUNDGDTEN, grid%g_RUNDGDTEN, grid%RVNDGDTEN, grid%g_RVNDGDTEN, grid%RTHNDGDTEN, grid%g_RTHNDGDTEN, &
3435 grid%RPHNDGDTEN,grid%g_RPHNDGDTEN,grid%RQVNDGDTEN, grid%g_RQVNDGDTEN,grid%RMUNDGDTEN,&
3436 ids, ide, jds, jde, kds, kde, &
3437 ims, ime, jms, jme, kms, kme, &
3438 grid%i_start(ij), grid%i_end(ij), &
3439 grid%j_start(ij), grid%j_end(ij), &
3440 k_start, k_end )
3441 ENDDO
3442 !$OMP END PARALLEL DO
3444 !<DESCRIPTION>
3445 !<pre>
3446 ! (5) time-split physics.
3447 !
3448 ! Microphysics are the only time split physics in the WRF model
3449 ! at this time. Split-physics begins with the calculation of
3450 ! needed diagnostic quantities (pressure, temperature, etc.)
3451 ! followed by a call to the microphysics driver,
3452 ! and finishes with a clean-up, storing off of a diabatic tendency
3453 ! from the moist physics, and a re-calulation of the diagnostic
3454 ! quantities pressure and density.
3455 !</pre>
3456 !</DESCRIPTION>
3458 IF( config_flags%specified .or. config_flags%nested ) THEN
3459 sz = grid%spec_zone
3460 ELSE
3461 sz = 0
3462 ENDIF
3464 IF (config_flags%mp_physics /= 0) then
3466 !$OMP PARALLEL DO &
3467 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3469 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3471 IF ( config_flags%periodic_x ) THEN
3472 its = max(grid%i_start(ij),ids)
3473 ite = min(grid%i_end(ij),ide-1)
3474 ELSE
3475 its = max(grid%i_start(ij),ids+sz)
3476 ite = min(grid%i_end(ij),ide-1-sz)
3477 ENDIF
3478 jts = max(grid%j_start(ij),jds+sz)
3479 jte = min(grid%j_end(ij),jde-1-sz)
3481 CALL wrf_debug ( 200 , ' call g_moist_physics_prep' )
3482 BENCH_START(g_moist_physics_prep_tim)
3483 CALL g_moist_physics_prep_em( grid%t_2,grid%g_t_2, grid%t_1, &
3484 t0, grid%rho,grid%g_rho, &
3485 grid%al,grid%g_al, grid%alb, &
3486 grid%p,grid%g_p, p8w,g_p8w, &
3487 p0, grid%pb, &
3488 grid%ph_2,grid%g_ph_2, grid%phb, &
3489 th_phy, g_th_phy, pi_phy, g_pi_phy, &
3490 p_phy, g_p_phy, &
3491 grid%z, grid%g_z, grid%z_at_w, grid%g_z_at_w, &
3492 dz8w, g_dz8w, &
3493 dtm, grid%h_diabatic, grid%g_h_diabatic, &
3494 moist(ims,kms,jms,P_QV),g_moist(ims,kms,jms,P_QV), &
3495 grid%qv_diabatic, grid%g_qv_diabatic, &
3496 moist(ims,kms,jms,P_QC),g_moist(ims,kms,jms,P_QC), &
3497 grid%qc_diabatic, grid%g_qc_diabatic, &
3498 config_flags,grid%fnm, grid%fnp, &
3499 ids, ide, jds, jde, kds, kde, &
3500 ims, ime, jms, jme, kms, kme, &
3501 its, ite, jts, jte, &
3502 k_start , k_end )
3503 BENCH_END(g_moist_physics_prep_tim)
3504 END DO scalar_tile_loop_1a
3505 !$OMP END PARALLEL DO
3507 CALL wrf_debug ( 200 , ' call g_microphysics_driver' )
3509 grid%g_sr = 0.
3510 grid%sr = 0.
3511 specified_bdy = config_flags%specified .OR. config_flags%nested
3512 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3514 BENCH_START(g_micro_driver_tim)
3516 !
3517 ! WRFU_AlarmIsRinging always returned false, so using an alternate method to find out if it is time
3518 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
3519 !
3520 ! diagflag = .false.
3521 ! CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM
3522 ! ),prevringtime=temp_time,RingInterval=intervaltime)
3523 ! CALL WRFU_ALARMGET(grid%alarms( RESTART_ALARM
3524 ! ),prevringtime=restart_time,RingInterval=restartinterval)
3525 ! CALL domain_clock_get ( grid, current_time=CurrTime )
3526 ! old_dt=min(old_dt,grid%dt)
3527 ! num = INT(old_dt * precision)
3528 ! den = precision
3529 ! CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3530 ! IF (CurrTime .ge. temp_time + intervaltime - dtInterval .or. &
3531 ! CurrTime .ge. restart_time + restartinterval - dtInterval ) THEN
3532 ! diagflag = .true.
3533 ! ENDIF
3534 ! WRITE(wrf_err_message,*)'diag_flag=',diag_flag
3535 ! CALL wrf_debug ( 0 , wrf_err_message )
3537 #ifdef DM_PARALLEL
3538 # include "HALO_EM_SBM_TL.inc"
3539 #endif
3541 CALL g_microphysics_driver( &
3542 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3543 & ,DZ8W=dz8w ,DZ8WD=g_dz8w, F_ICE_PHY=grid%f_ice_phy &
3544 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3545 & ,P8W=p8w ,P=p_phy ,PD=g_p_phy &
3546 & ,PI_PHY=pi_phy,PI_PHYD=g_pi_phy &
3547 & ,RHO=grid%rho ,RHOD=grid%g_rho, SPEC_ZONE=grid%spec_zone &
3548 & ,SR=grid%sr ,TH=th_phy,THD=g_th_phy &
3549 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
3550 & ,WARM_RAIN=grid%warm_rain &
3551 & ,T8W=t8w &
3552 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3553 & ,NSOURCE=grid%qndropsource &
3554 & ,XLAND=grid%xland &
3555 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3556 & ,F_RAIN_PHY=grid%f_rain_phy &
3557 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3558 & ,MP_PHYSICS=config_flags%mp_physics &
3559 & ,ID=grid%id &
3560 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3561 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3562 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3563 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3564 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3565 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3566 & ,NUM_TILES=grid%num_tiles &
3567 & ,NAER=grid%naer &
3568 ! Optional
3569 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3570 & , RAINNCD=grid%g_rainnc, RAINNCVD=grid%g_rainncv &
3571 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3572 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
3573 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
3574 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
3575 & , MP_RESTART_STATE=grid%mp_restart_state &
3576 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3577 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3578 & , QV_CURR=moist(ims,kms,jms,P_QV),QV_CURRD=g_moist(ims,kms,jms,P_QV), F_QV=F_QV &
3579 & , QC_CURR=moist(ims,kms,jms,P_QC),QC_CURRD=g_moist(ims,kms,jms,P_QC), F_QC=F_QC &
3580 & , QR_CURR=moist(ims,kms,jms,P_QR),QR_CURRD=g_moist(ims,kms,jms,P_QR), F_QR=F_QR &
3581 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
3582 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
3583 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
3584 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
3585 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3586 #if (WRF_CHEM==1)
3587 & , RAINPROD=grid%rainprod, EVAPPROD=grid%evapprod &
3588 & , QV_B4MP=grid%qv_b4mp,QC_B4MP=grid%qc_b4mp &
3589 & , QI_B4MP=grid%qi_b4mp, QS_B4MP=grid%qs_b4mp &
3590 #endif
3591 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3592 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
3593 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3594 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
3595 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3596 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3597 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3598 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom and nssl_2mom
3599 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
3600 ! & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! "
3601 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
3602 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
3603 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
3604 & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom
3605 & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom
3606 & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m
3607 & , QTCN_CURR=scalar(ims,kms,jms,P_QTCN), F_QTCN=F_QTCN & ! for ntu3m
3608 & , QCCN_CURR=scalar(ims,kms,jms,P_QCCN), F_QCCN=F_QCCN & ! for ntu3m
3609 & , QRCN_CURR=scalar(ims,kms,jms,P_QRCN), F_QRCN=F_QRCN & ! for ntu3m
3610 & , QNIN_CURR=scalar(ims,kms,jms,P_QNIN), F_QNIN=F_QNIN & ! for ntu3m
3611 & , FI_CURR=scalar(ims,kms,jms,P_FI), F_FI=F_FI & ! for ntu3m
3612 & , FS_CURR=scalar(ims,kms,jms,P_FS), F_FS=F_FS & ! for ntu3m
3613 & , VI_CURR=scalar(ims,kms,jms,P_VI), F_VI=F_VI & ! for ntu3m
3614 & , VS_CURR=scalar(ims,kms,jms,P_VS), F_VS=F_VS & ! for ntu3m
3615 & , VG_CURR=scalar(ims,kms,jms,P_VG), F_VG=F_VG & ! for ntu3m
3616 & , AI_CURR=scalar(ims,kms,jms,P_AI), F_AI=F_AI & ! for ntu3m
3617 & , AS_CURR=scalar(ims,kms,jms,P_AS), F_AS=F_AS & ! for ntu3m
3618 & , AG_CURR=scalar(ims,kms,jms,P_AG), F_AG=F_AG & ! for ntu3m
3619 & , AH_CURR=scalar(ims,kms,jms,P_AH), F_AH=F_AH & ! for ntu3m
3620 & , I3M_CURR=scalar(ims,kms,jms,P_I3M), F_I3M=F_I3m & ! for ntu3m
3621 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3622 & , qicuten=grid%rqicuten &
3623 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
3624 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
3625 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
3626 ! YLIN
3627 ! RI_CURR INPUT
3628 & , RI_CURR=grid%rimi &
3629 & , diagflag=diag_flag, do_radar_ref=config_flags%do_radar_ref &
3630 )
3631 BENCH_END(g_micro_driver_tim)
3633 #if 0
3634 BENCH_START(g_microswap_2)
3635 ! for load balancing; communication to redistribute the points
3636 IF ( config_flags%mp_physics .EQ. ETAMPNEW .OR. &
3637 & config_flags%mp_physics .EQ. FER_MP_HIRES) THEN
3638 #include "SWAP_ETAMP_NEW.inc"
3639 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3640 #include "SWAP_WSM3.inc"
3641 ENDIF
3642 BENCH_END(g_microswap_2)
3643 #endif
3645 CALL wrf_debug ( 200 , ' call g_moist_physics_finish' )
3646 BENCH_START(g_moist_phys_end_tim)
3648 !$OMP PARALLEL DO &
3649 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3651 DO ij = 1 , grid%num_tiles
3653 its = max(grid%i_start(ij),ids)
3654 ite = min(grid%i_end(ij),ide-1)
3655 jts = max(grid%j_start(ij),jds)
3656 jte = min(grid%j_end(ij),jde-1)
3658 CALL g_microphysics_zero_outb ( &
3659 moist , g_moist, num_moist , config_flags , &
3660 ids, ide, jds, jde, kds, kde, &
3661 ims, ime, jms, jme, kms, kme, &
3662 its, ite, jts, jte, &
3663 k_start , k_end )
3665 CALL g_microphysics_zero_outb ( &
3666 scalar , g_scalar, num_scalar , config_flags , &
3667 ids, ide, jds, jde, kds, kde, &
3668 ims, ime, jms, jme, kms, kme, &
3669 its, ite, jts, jte, &
3670 k_start , k_end )
3672 !!!!! REPLACE WITH g_microphysics_zero_outb WHEN CODING TL OF PHYSICS. Ning Pan
3673 CALL microphysics_zero_outb ( &
3674 chem , num_chem , config_flags , &
3675 ids, ide, jds, jde, kds, kde, &
3676 ims, ime, jms, jme, kms, kme, &
3677 its, ite, jts, jte, &
3678 k_start , k_end )
3680 CALL g_microphysics_zero_outb ( &
3681 tracer , g_tracer, num_tracer , config_flags , &
3682 ids, ide, jds, jde, kds, kde, &
3683 ims, ime, jms, jme, kms, kme, &
3684 its, ite, jts, jte, &
3685 k_start , k_end )
3687 IF ( config_flags%periodic_x ) THEN
3688 its = max(grid%i_start(ij),ids)
3689 ite = min(grid%i_end(ij),ide-1)
3690 ELSE
3691 its = max(grid%i_start(ij),ids+sz)
3692 ite = min(grid%i_end(ij),ide-1-sz)
3693 ENDIF
3694 jts = max(grid%j_start(ij),jds+sz)
3695 jte = min(grid%j_end(ij),jde-1-sz)
3697 CALL g_microphysics_zero_outa ( &
3698 moist , g_moist, num_moist , config_flags , &
3699 ids, ide, jds, jde, kds, kde, &
3700 ims, ime, jms, jme, kms, kme, &
3701 its, ite, jts, jte, &
3702 k_start , k_end )
3704 CALL g_microphysics_zero_outa ( &
3705 scalar ,g_scalar, num_scalar , config_flags , &
3706 ids, ide, jds, jde, kds, kde, &
3707 ims, ime, jms, jme, kms, kme, &
3708 its, ite, jts, jte, &
3709 k_start , k_end )
3711 !!!!! REPLACE WITH g_microphysics_zero_outa WHEN CODING TL OF PHYSICS. Ning Pan
3712 CALL microphysics_zero_outa ( &
3713 chem , num_chem , config_flags , &
3714 ids, ide, jds, jde, kds, kde, &
3715 ims, ime, jms, jme, kms, kme, &
3716 its, ite, jts, jte, &
3717 k_start , k_end )
3719 CALL g_microphysics_zero_outa ( &
3720 tracer , g_tracer, num_tracer , config_flags , &
3721 ids, ide, jds, jde, kds, kde, &
3722 ims, ime, jms, jme, kms, kme, &
3723 its, ite, jts, jte, &
3724 k_start , k_end )
3726 CALL g_moist_physics_finish_em( grid%t_2, grid%g_t_2, grid%t_1, &
3727 t0, grid%muts, &
3728 th_phy, g_th_phy, &
3729 grid%h_diabatic,grid%g_h_diabatic, &
3730 moist(ims,kms,jms,P_QV),g_moist(ims,kms,jms,P_QV), &
3731 grid%qv_diabatic, grid%g_qv_diabatic, &
3732 moist(ims,kms,jms,P_QC),g_moist(ims,kms,jms,P_QC), &
3733 grid%qc_diabatic, grid%g_qc_diabatic, &
3734 dtm, config_flags, &
3735 ids, ide, jds, jde, kds, kde, &
3736 ims, ime, jms, jme, kms, kme, &
3737 its, ite, jts, jte, &
3738 k_start , k_end )
3740 END DO
3741 !$OMP END PARALLEL DO
3743 ENDIF ! microphysics test
3745 !-----------------------------------------------------------
3746 ! filter for moist variables post-microphysics and end of timestep
3747 !-----------------------------------------------------------
3749 IF (config_flags%polar) THEN
3750 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3751 CALL wrf_debug ( 200 , ' call filter moist' )
3752 DO im = PARAM_FIRST_SCALAR, num_3d_m
3753 IF ( config_flags%coupled_filtering ) THEN
3754 DO jj = jps, MIN(jpe,jde-1)
3755 DO kk = kps, MIN(kpe,kde-1)
3756 DO ii = ips, MIN(ipe,ide-1)
3757 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3758 ENDDO
3759 ENDDO
3760 ENDDO
3761 END IF
3763 CALL pxft ( grid=grid &
3764 ,lineno=__LINE__ &
3765 ,flag_uv = 0 &
3766 ,flag_rurv = 0 &
3767 ,flag_wph = 0 &
3768 ,flag_ww = 0 &
3769 ,flag_t = 0 &
3770 ,flag_mu = 0 &
3771 ,flag_mut = 0 &
3772 ,flag_moist = im &
3773 ,flag_chem = 0 &
3774 ,flag_tracer = 0 &
3775 ,flag_scalar = 0 &
3776 ,actual_distance_average=config_flags%actual_distance_average&
3777 ,pos_def = config_flags%pos_def &
3778 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3779 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3780 ,fft_filter_lat = config_flags%fft_filter_lat &
3781 ,dclat = dclat &
3782 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3783 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3784 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3785 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3786 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3787 IF ( config_flags%coupled_filtering ) THEN
3788 DO jj = jps, MIN(jpe,jde-1)
3789 DO kk = kps, MIN(kpe,kde-1)
3790 DO ii = ips, MIN(ipe,ide-1)
3791 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3792 ENDDO
3793 ENDDO
3794 ENDDO
3795 ENDIF
3796 ENDDO
3797 ENDIF
3798 ENDIF
3800 !-----------------------------------------------------------
3801 ! end filter for moist variables post-microphysics and end of timestep
3802 !-----------------------------------------------------------
3804 !$OMP PARALLEL DO &
3805 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3806 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
3808 IF ( config_flags%periodic_x ) THEN
3809 its = max(grid%i_start(ij),ids)
3810 ite = min(grid%i_end(ij),ide-1)
3811 ELSE
3812 its = max(grid%i_start(ij),ids+sz)
3813 ite = min(grid%i_end(ij),ide-1-sz)
3814 ENDIF
3815 jts = max(grid%j_start(ij),jds+sz)
3816 jte = min(grid%j_end(ij),jde-1-sz)
3818 CALL g_calc_p_rho_phi( moist,g_moist, num_3d_m, config_flags%hypsometric_opt, &
3819 grid%al,grid%g_al, grid%alb, grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, &
3820 grid%ph_2,grid%g_ph_2, grid%phb, grid%p,grid%g_p, grid%pb, grid%t_2,grid%g_t_2, &
3821 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
3822 grid%rdn, config_flags%non_hydrostatic, &
3823 ids, ide, jds, jde, kds, kde, &
3824 ims, ime, jms, jme, kms, kme, &
3825 its, ite, jts, jte, &
3826 k_start , k_end )
3828 END DO scalar_tile_loop_1ba
3829 !$OMP END PARALLEL DO
3830 BENCH_END(g_moist_phys_end_tim)
3832 IF (.not. config_flags%non_hydrostatic) THEN
3833 #ifdef DM_PARALLEL
3834 # include "HALO_EM_HYDRO_UV_TL.inc"
3835 # include "PERIOD_EM_HYDRO_UV.inc"
3836 #endif
3837 !$OMP PARALLEL DO &
3838 !$OMP PRIVATE ( ij )
3839 DO ij = 1 , grid%num_tiles
3840 CALL g_diagnose_w( ph_tend,g_ph_tend, grid%ph_2,grid%g_ph_2, grid%ph_1,grid%g_ph_1, &
3841 grid%w_2,grid%g_w_2, grid%muts,grid%g_muts, dt_rk, &
3842 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ht, &
3843 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3844 ids, ide, jds, jde, kds, kde, &
3845 ims, ime, jms, jme, kms, kme, &
3846 grid%i_start(ij), grid%i_end(ij), &
3847 grid%j_start(ij), grid%j_end(ij), &
3848 k_start , k_end )
3850 END DO
3851 !$OMP END PARALLEL DO
3853 END IF
3855 CALL wrf_debug ( 200 , ' call chem polar filter ' )
3857 !-----------------------------------------------------------
3858 ! filter for chem and scalar variables at end of timestep
3859 !-----------------------------------------------------------
3861 IF (config_flags%polar) THEN
3863 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
3864 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
3865 IF ( config_flags%coupled_filtering ) THEN
3866 DO jj = jps, MIN(jpe,jde-1)
3867 DO kk = kps, MIN(kpe,kde-1)
3868 DO ii = ips, MIN(ipe,ide-1)
3869 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3870 ENDDO
3871 ENDDO
3872 ENDDO
3873 END IF
3875 CALL pxft ( grid=grid &
3876 ,lineno=__LINE__ &
3877 ,flag_uv = 0 &
3878 ,flag_rurv = 0 &
3879 ,flag_wph = 0 &
3880 ,flag_ww = 0 &
3881 ,flag_t = 0 &
3882 ,flag_mu = 0 &
3883 ,flag_mut = 0 &
3884 ,flag_moist = 0 &
3885 ,flag_chem = im &
3886 ,flag_tracer = 0 &
3887 ,flag_scalar = 0 &
3888 ,actual_distance_average=config_flags%actual_distance_average&
3889 ,pos_def = config_flags%pos_def &
3890 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3891 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3892 ,fft_filter_lat = config_flags%fft_filter_lat &
3893 ,dclat = dclat &
3894 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3895 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3896 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3897 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3898 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3900 IF ( config_flags%coupled_filtering ) THEN
3901 DO jj = jps, MIN(jpe,jde-1)
3902 DO kk = kps, MIN(kpe,kde-1)
3903 DO ii = ips, MIN(ipe,ide-1)
3904 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3905 ENDDO
3906 ENDDO
3907 ENDDO
3908 END IF
3909 ENDDO chem_filter_loop
3910 ENDIF
3911 IF ( num_tracer >= PARAM_FIRST_SCALAR ) then
3912 tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer
3913 IF ( config_flags%coupled_filtering ) THEN
3914 DO jj = jps, MIN(jpe,jde-1)
3915 DO kk = kps, MIN(kpe,kde-1)
3916 DO ii = ips, MIN(ipe,ide-1)
3917 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3918 ENDDO
3919 ENDDO
3920 ENDDO
3921 END IF
3923 CALL pxft ( grid=grid &
3924 ,lineno=__LINE__ &
3925 ,flag_uv = 0 &
3926 ,flag_rurv = 0 &
3927 ,flag_wph = 0 &
3928 ,flag_ww = 0 &
3929 ,flag_t = 0 &
3930 ,flag_mu = 0 &
3931 ,flag_mut = 0 &
3932 ,flag_moist = 0 &
3933 ,flag_chem = 0 &
3934 ,flag_tracer = im &
3935 ,flag_scalar = 0 &
3936 ,actual_distance_average=config_flags%actual_distance_average&
3937 ,pos_def = config_flags%pos_def &
3938 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3939 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3940 ,fft_filter_lat = config_flags%fft_filter_lat &
3941 ,dclat = dclat &
3942 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3943 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3944 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3945 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3946 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3948 IF ( config_flags%coupled_filtering ) THEN
3949 DO jj = jps, MIN(jpe,jde-1)
3950 DO kk = kps, MIN(kpe,kde-1)
3951 DO ii = ips, MIN(ipe,ide-1)
3952 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3953 ENDDO
3954 ENDDO
3955 ENDDO
3956 END IF
3957 ENDDO tracer_filter_loop
3958 ENDIF
3960 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
3961 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
3962 IF ( config_flags%coupled_filtering ) THEN
3963 DO jj = jps, MIN(jpe,jde-1)
3964 DO kk = kps, MIN(kpe,kde-1)
3965 DO ii = ips, MIN(ipe,ide-1)
3966 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3967 ENDDO
3968 ENDDO
3969 ENDDO
3970 END IF
3972 CALL pxft ( grid=grid &
3973 ,lineno=__LINE__ &
3974 ,flag_uv = 0 &
3975 ,flag_rurv = 0 &
3976 ,flag_wph = 0 &
3977 ,flag_ww = 0 &
3978 ,flag_t = 0 &
3979 ,flag_mu = 0 &
3980 ,flag_mut = 0 &
3981 ,flag_moist = 0 &
3982 ,flag_chem = 0 &
3983 ,flag_tracer = 0 &
3984 ,flag_scalar = im &
3985 ,actual_distance_average=config_flags%actual_distance_average&
3986 ,pos_def = config_flags%pos_def &
3987 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3988 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3989 ,fft_filter_lat = config_flags%fft_filter_lat &
3990 ,dclat = dclat &
3991 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3992 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3993 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3994 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3995 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3997 IF ( config_flags%coupled_filtering ) THEN
3998 DO jj = jps, MIN(jpe,jde-1)
3999 DO kk = kps, MIN(kpe,kde-1)
4000 DO ii = ips, MIN(ipe,ide-1)
4001 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
4002 ENDDO
4003 ENDDO
4004 ENDDO
4005 END IF
4006 ENDDO scalar_filter_loop
4007 ENDIF
4008 ENDIF
4010 !-----------------------------------------------------------
4011 ! end filter for chem and scalar variables at end of timestep
4012 !-----------------------------------------------------------
4014 ! We're finished except for boundary condition (and patch) update
4016 ! Boundary condition time (or communication time). At this time, we have
4017 ! implemented periodic and symmetric physical boundary conditions.
4019 ! b.c. routine for data within patch.
4021 ! we need to do both time levels of
4022 ! data because the time filter only works in the physical solution space.
4024 ! First, do patch communications for boundary conditions (periodicity)
4026 !-----------------------------------------------------------
4027 ! Stencils for patch communications (WCS, 29 June 2001)
4028 !
4029 ! here's where we need a wide comm stencil - these are the
4030 ! uncoupled variables so are used for high order calc in
4031 ! advection and mixong routines.
4032 !
4033 ! * * * * *
4034 ! * * * * * * * * *
4035 ! * + * * + * * * + * *
4036 ! * * * * * * * * *
4037 ! * * * * *
4038 !
4039 ! grid%u_1 x
4040 ! grid%u_2 x
4041 ! grid%v_1 x
4042 ! grid%v_2 x
4043 ! grid%w_1 x
4044 ! grid%w_2 x
4045 ! grid%t_1 x
4046 ! grid%t_2 x
4047 ! grid%ph_1 x
4048 ! grid%ph_2 x
4049 ! grid%tke_1 x
4050 ! grid%tke_2 x
4051 !
4052 ! 2D variables
4053 ! grid%mu_1 x
4054 ! grid%mu_2 x
4055 !
4056 ! 4D variables
4057 ! moist x
4058 ! chem x
4059 ! scalar x
4060 !----------------------------------------------------------
4063 #ifdef DM_PARALLEL
4064 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4065 # include "HALO_EM_D3_3_TL.inc"
4066 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4067 # include "HALO_EM_D3_5_TL.inc"
4068 ELSE
4069 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4070 CALL wrf_error_fatal(TRIM(wrf_err_message))
4071 ENDIF
4072 # include "PERIOD_BDY_EM_D3.inc"
4073 # include "PERIOD_BDY_EM_MOIST.inc"
4074 # include "PERIOD_BDY_EM_CHEM.inc"
4075 # include "PERIOD_BDY_EM_TRACER.inc"
4076 # include "PERIOD_BDY_EM_SCALAR.inc"
4077 # include "PERIOD_BDY_EM_TKE.inc"
4078 #endif
4080 ! now set physical b.c on a patch
4082 BENCH_START(g_bc_2d_tim)
4083 !$OMP PARALLEL DO &
4084 !$OMP PRIVATE ( ij )
4085 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
4087 CALL wrf_debug ( 200 , ' call g_set_phys_bc_dry_2' )
4089 CALL g_set_phys_bc_dry_2( config_flags, &
4090 grid%u_1,grid%g_u_1, grid%u_2,grid%g_u_2, &
4091 grid%v_1,grid%g_v_1, grid%v_2,grid%g_v_2, &
4092 grid%w_1,grid%g_w_1, grid%w_2,grid%g_w_2, &
4093 grid%t_1,grid%g_t_1, grid%t_2,grid%g_t_2, &
4094 grid%ph_1,grid%g_ph_1, grid%ph_2,grid%g_ph_2, &
4095 grid%mu_1,grid%g_mu_1, grid%mu_2,grid%g_mu_2, &
4096 ids, ide, jds, jde, kds, kde, &
4097 ims, ime, jms, jme, kms, kme, &
4098 ips, ipe, jps, jpe, kps, kpe, &
4099 grid%i_start(ij), grid%i_end(ij), &
4100 grid%j_start(ij), grid%j_end(ij), &
4101 k_start , k_end )
4103 CALL g_set_physical_bc3d( grid%tke_1,grid%g_tke_1, 'p', config_flags, &
4104 ids, ide, jds, jde, kds, kde, &
4105 ims, ime, jms, jme, kms, kme, &
4106 ips, ipe, jps, jpe, kps, kpe, &
4107 grid%i_start(ij), grid%i_end(ij), &
4108 grid%j_start(ij), grid%j_end(ij), &
4109 k_start , k_end-1 )
4111 CALL g_set_physical_bc3d( grid%tke_2 ,grid%g_tke_2, 'p', config_flags, &
4112 ids, ide, jds, jde, kds, kde, &
4113 ims, ime, jms, jme, kms, kme, &
4114 ips, ipe, jps, jpe, kps, kpe, &
4115 grid%i_start(ij), grid%i_end(ij), &
4116 grid%j_start(ij), grid%j_end(ij), &
4117 k_start , k_end )
4119 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4121 CALL g_set_physical_bc3d( moist(ims,kms,jms,im),g_moist(ims,kms,jms,im), 'p', &
4122 config_flags, &
4123 ids, ide, jds, jde, kds, kde, &
4124 ims, ime, jms, jme, kms, kme, &
4125 ips, ipe, jps, jpe, kps, kpe, &
4126 grid%i_start(ij), grid%i_end(ij), &
4127 grid%j_start(ij), grid%j_end(ij), &
4128 k_start , k_end )
4131 END DO moisture_loop_bdy_2
4133 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4135 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
4136 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
4137 ids, ide, jds, jde, kds, kde, &
4138 ims, ime, jms, jme, kms, kme, &
4139 ips, ipe, jps, jpe, kps, kpe, &
4140 grid%i_start(ij), grid%i_end(ij), &
4141 grid%j_start(ij), grid%j_end(ij), &
4142 k_start , k_end )
4144 END DO chem_species_bdy_loop_2
4146 tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
4148 CALL g_set_physical_bc3d( tracer(ims,kms,jms,ic) , g_tracer(ims,kms,jms,ic), 'p', config_flags, &
4149 ids, ide, jds, jde, kds, kde, &
4150 ims, ime, jms, jme, kms, kme, &
4151 ips, ipe, jps, jpe, kps, kpe, &
4152 grid%i_start(ij), grid%i_end(ij), &
4153 grid%j_start(ij), grid%j_end(ij), &
4154 k_start , k_end )
4156 END DO tracer_species_bdy_loop_2
4158 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4160 CALL g_set_physical_bc3d( scalar(ims,kms,jms,is) ,g_scalar(ims,kms,jms,is) , 'p', config_flags, &
4161 ids, ide, jds, jde, kds, kde, &
4162 ims, ime, jms, jme, kms, kme, &
4163 ips, ipe, jps, jpe, kps, kpe, &
4164 grid%i_start(ij), grid%i_end(ij), &
4165 grid%j_start(ij), grid%j_end(ij), &
4166 k_start , k_end )
4168 END DO scalar_species_bdy_loop_2
4170 END DO tile_bc_loop_2
4171 !$OMP END PARALLEL DO
4172 BENCH_END(g_bc_2d_tim)
4174 IF( config_flags%specified .or. config_flags%nested ) THEN
4176 ! this code forces boundary values to specified values to avoid drift
4178 !$OMP PARALLEL DO &
4179 !$OMP PRIVATE ( ij )
4180 tile_bc_loop_3: DO ij = 1 , grid%num_tiles
4182 CALL wrf_debug ( 200 , ' call g_spec_bdy_final' )
4184 CALL g_spec_bdy_final ( grid%u_2, grid%g_u_2, grid%muus, grid%g_muus, grid%msfuy, &
4185 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
4186 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
4187 grid%u_btxs,grid%g_u_btxs,grid%u_btxe,grid%g_u_btxe, &
4188 grid%u_btys,grid%g_u_btys,grid%u_btye,grid%g_u_btye, &
4189 'u', config_flags, &
4190 config_flags%spec_bdy_width, grid%spec_zone, &
4191 grid%dtbc, &
4192 ids,ide, jds,jde, kds,kde, & ! domain dims
4193 ims,ime, jms,jme, kms,kme, & ! memory dims
4194 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4195 grid%i_start(ij), grid%i_end(ij), &
4196 grid%j_start(ij), grid%j_end(ij), &
4197 k_start , k_end )
4199 CALL g_spec_bdy_final ( grid%v_2, grid%g_v_2, grid%muvs, grid%g_muvs, grid%msfvx, &
4200 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
4201 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
4202 grid%v_btxs,grid%g_v_btxs,grid%v_btxe,grid%g_v_btxe, &
4203 grid%v_btys,grid%g_v_btys,grid%v_btye,grid%g_v_btye, &
4204 'v', config_flags, &
4205 config_flags%spec_bdy_width, grid%spec_zone, &
4206 grid%dtbc, &
4207 ids,ide, jds,jde, kds,kde, & ! domain dims
4208 ims,ime, jms,jme, kms,kme, & ! memory dims
4209 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4210 grid%i_start(ij), grid%i_end(ij), &
4211 grid%j_start(ij), grid%j_end(ij), &
4212 k_start , k_end )
4214 IF( config_flags%nested) THEN
4215 CALL g_spec_bdy_final ( grid%w_2, grid%g_w_2, grid%muts, grid%g_muts, grid%msfty, &
4216 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
4217 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
4218 grid%w_btxs,grid%g_w_btxs,grid%w_btxe,grid%g_w_btxe, &
4219 grid%w_btys,grid%g_w_btys,grid%w_btye,grid%g_w_btye, &
4220 'w', config_flags, &
4221 config_flags%spec_bdy_width, grid%spec_zone, &
4222 grid%dtbc, &
4223 ids,ide, jds,jde, kds,kde, & ! domain dims
4224 ims,ime, jms,jme, kms,kme, & ! memory dims
4225 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4226 grid%i_start(ij), grid%i_end(ij), &
4227 grid%j_start(ij), grid%j_end(ij), &
4228 k_start , k_end )
4229 ENDIF
4231 CALL g_spec_bdy_final ( grid%t_2, grid%g_t_2, grid%muts, grid%g_muts, grid%msfty, &
4232 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
4233 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
4234 grid%t_btxs,grid%g_t_btxs,grid%t_btxe,grid%g_t_btxe, &
4235 grid%t_btys,grid%g_t_btys,grid%t_btye,grid%g_t_btye, &
4236 't', config_flags, &
4237 config_flags%spec_bdy_width, grid%spec_zone, &
4238 grid%dtbc, &
4239 ids,ide, jds,jde, kds,kde, & ! domain dims
4240 ims,ime, jms,jme, kms,kme, & ! memory dims
4241 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4242 grid%i_start(ij), grid%i_end(ij), &
4243 grid%j_start(ij), grid%j_end(ij), &
4244 k_start , k_end )
4246 CALL g_spec_bdy_final ( grid%ph_2, grid%g_ph_2, grid%muts, grid%g_muts, grid%msfty, &
4247 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
4248 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
4249 grid%ph_btxs,grid%g_ph_btxs,grid%ph_btxe,grid%g_ph_btxe, &
4250 grid%ph_btys,grid%g_ph_btys,grid%ph_btye,grid%g_ph_btye, &
4251 'h', config_flags, &
4252 config_flags%spec_bdy_width, grid%spec_zone, &
4253 grid%dtbc, &
4254 ids,ide, jds,jde, kds,kde, & ! domain dims
4255 ims,ime, jms,jme, kms,kme, & ! memory dims
4256 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4257 grid%i_start(ij), grid%i_end(ij), &
4258 grid%j_start(ij), grid%j_end(ij), &
4259 k_start , k_end )
4261 CALL g_spec_bdy_final ( grid%mu_2, grid%g_mu_2, grid%muts, grid%g_muts, grid%msfty, &
4262 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
4263 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
4264 grid%mu_btxs,grid%g_mu_btxs,grid%mu_btxe,grid%g_mu_btxe, &
4265 grid%mu_btys,grid%g_mu_btys,grid%mu_btye,grid%g_mu_btye, &
4266 'm', config_flags, &
4267 config_flags%spec_bdy_width, grid%spec_zone, &
4268 grid%dtbc, &
4269 ids,ide, jds,jde, 1, 1, & ! domain dims
4270 ims,ime, jms,jme, 1, 1, & ! memory dims
4271 ips,ipe, jps,jpe, 1, 1, & ! patch dims
4272 grid%i_start(ij), grid%i_end(ij), &
4273 grid%j_start(ij), grid%j_end(ij), &
4274 1 , 1 )
4276 moisture_loop_bdy_3 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4278 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
4279 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
4280 CALL g_spec_bdy_final ( moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
4281 grid%muts, grid%g_muts, grid%msfty, &
4282 moist_bxs(jms,kms,1,im), g_moist_bxs(jms,kms,1,im), &
4283 moist_bxe(jms,kms,1,im), g_moist_bxe(jms,kms,1,im), &
4284 moist_bys(ims,kms,1,im), g_moist_bys(ims,kms,1,im), &
4285 moist_bye(ims,kms,1,im), g_moist_bye(ims,kms,1,im), &
4286 moist_btxs(jms,kms,1,im), g_moist_btxs(jms,kms,1,im), &
4287 moist_btxe(jms,kms,1,im), g_moist_btxe(jms,kms,1,im), &
4288 moist_btys(ims,kms,1,im), g_moist_btys(ims,kms,1,im), &
4289 moist_btye(ims,kms,1,im), g_moist_btye(ims,kms,1,im), &
4290 't', config_flags, &
4291 config_flags%spec_bdy_width, grid%spec_zone, &
4292 grid%dtbc, &
4293 ids,ide, jds,jde, kds,kde, & ! domain dims
4294 ims,ime, jms,jme, kms,kme, & ! memory dims
4295 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4296 grid%i_start(ij), grid%i_end(ij), &
4297 grid%j_start(ij), grid%j_end(ij), &
4298 k_start , k_end )
4299 ENDIF
4301 END DO moisture_loop_bdy_3
4303 #if (WRF_CHEM == 1)
4304 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
4305 chem_species_bdy_loop_3 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4307 IF( ( config_flags%nested ) ) THEN
4308 ! CALL g_spec_bdy_final ( chem(ims,kms,jms,ic), g_chem(ims,kms,jms,ic), &
4309 ! grid%muts, grid%g_muts, grid%msfty, &
4310 ! chem_bxs(jms,kms,1,ic), g_chem_bxs(jms,kms,1,ic), &
4311 ! chem_bxe(jms,kms,1,ic), g_chem_bxe(jms,kms,1,ic), &
4312 ! chem_bys(ims,kms,1,ic), g_chem_bys(ims,kms,1,ic), &
4313 ! chem_bye(ims,kms,1,ic), g_chem_bye(ims,kms,1,ic), &
4314 ! chem_btxs(jms,kms,1,ic), g_chem_btxs(jms,kms,1,ic), &
4315 ! chem_btxe(jms,kms,1,ic), g_chem_btxe(jms,kms,1,ic), &
4316 ! chem_btys(ims,kms,1,ic), g_chem_btys(ims,kms,1,ic), &
4317 ! chem_btye(ims,kms,1,ic), g_chem_btye(ims,kms,1,ic), &
4318 !hcl-beg no g_chem for now
4319 CALL g_spec_bdy_final ( chem(ims,kms,jms,ic), chem(ims,kms,jms,ic), &
4320 grid%muts, grid%g_muts, grid%msfty, &
4321 chem_bxs(jms,kms,1,ic), chem_bxs(jms,kms,1,ic), &
4322 chem_bxe(jms,kms,1,ic), chem_bxe(jms,kms,1,ic), &
4323 chem_bys(ims,kms,1,ic), chem_bys(ims,kms,1,ic), &
4324 chem_bye(ims,kms,1,ic), chem_bye(ims,kms,1,ic), &
4325 chem_btxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
4326 chem_btxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
4327 chem_btys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
4328 chem_btye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
4329 !hcl-end no g_chem for now
4330 't', config_flags, &
4331 config_flags%spec_bdy_width, grid%spec_zone, &
4332 grid%dtbc, &
4333 ids,ide, jds,jde, kds,kde, & ! domain dims
4334 ims,ime, jms,jme, kms,kme, & ! memory dims
4335 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4336 grid%i_start(ij), grid%i_end(ij), &
4337 grid%j_start(ij), grid%j_end(ij), &
4338 k_start , k_end )
4339 ENDIF
4341 END DO chem_species_bdy_loop_3
4342 ENDIF
4343 #endif
4345 tracer_species_bdy_loop_3 : DO im = PARAM_FIRST_SCALAR , num_tracer
4347 IF( ( config_flags%nested ) ) THEN
4348 CALL g_spec_bdy_final ( tracer(ims,kms,jms,im), g_tracer(ims,kms,jms,im), &
4349 grid%muts, grid%g_muts, grid%msfty, &
4350 tracer_bxs(jms,kms,1,im), g_tracer_bxs(jms,kms,1,im), &
4351 tracer_bxe(jms,kms,1,im), g_tracer_bxe(jms,kms,1,im), &
4352 tracer_bys(ims,kms,1,im), g_tracer_bys(ims,kms,1,im), &
4353 tracer_bye(ims,kms,1,im), g_tracer_bye(ims,kms,1,im), &
4354 tracer_btxs(jms,kms,1,im), g_tracer_btxs(jms,kms,1,im), &
4355 tracer_btxe(jms,kms,1,im), g_tracer_btxe(jms,kms,1,im), &
4356 tracer_btys(ims,kms,1,im), g_tracer_btys(ims,kms,1,im), &
4357 tracer_btye(ims,kms,1,im), g_tracer_btye(ims,kms,1,im), &
4358 't', config_flags, &
4359 config_flags%spec_bdy_width, grid%spec_zone, &
4360 grid%dtbc, &
4361 ids,ide, jds,jde, kds,kde, & ! domain dims
4362 ims,ime, jms,jme, kms,kme, & ! memory dims
4363 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4364 grid%i_start(ij), grid%i_end(ij), &
4365 grid%j_start(ij), grid%j_end(ij), &
4366 k_start , k_end )
4367 ENDIF
4369 END DO tracer_species_bdy_loop_3
4371 scalar_species_bdy_loop_3 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4373 IF( ( config_flags%nested ) ) THEN
4374 CALL g_spec_bdy_final ( scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
4375 grid%muts, grid%g_muts, grid%msfty, &
4376 scalar_bxs(jms,kms,1,is), g_scalar_bxs(jms,kms,1,is), &
4377 scalar_bxe(jms,kms,1,is), g_scalar_bxe(jms,kms,1,is), &
4378 scalar_bys(ims,kms,1,is), g_scalar_bys(ims,kms,1,is), &
4379 scalar_bye(ims,kms,1,is), g_scalar_bye(ims,kms,1,is), &
4380 scalar_btxs(jms,kms,1,is), g_scalar_btxs(jms,kms,1,is), &
4381 scalar_btxe(jms,kms,1,is), g_scalar_btxe(jms,kms,1,is), &
4382 scalar_btys(ims,kms,1,is), g_scalar_btys(ims,kms,1,is), &
4383 scalar_btye(ims,kms,1,is), g_scalar_btye(ims,kms,1,is), &
4384 't', config_flags, &
4385 config_flags%spec_bdy_width, grid%spec_zone, &
4386 grid%dtbc, &
4387 ids,ide, jds,jde, kds,kde, & ! domain dims
4388 ims,ime, jms,jme, kms,kme, & ! memory dims
4389 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4390 grid%i_start(ij), grid%i_end(ij), &
4391 grid%j_start(ij), grid%j_end(ij), &
4392 k_start , k_end )
4393 ENDIF
4395 END DO scalar_species_bdy_loop_3
4397 END DO tile_bc_loop_3
4398 !$OMP END PARALLEL DO
4400 CALL wrf_debug ( 200 , ' end call g_spec_bdy_final' )
4402 ENDIF
4404 ! dtbc will be read from basic state at every time step, so it need not to be updated here.
4405 !
4406 ! IF( config_flags%specified .or. config_flags%nested ) THEN
4407 ! grid%dtbc = grid%dtbc + grid%dt
4408 ! ENDIF
4410 ! reset surface w for consistency
4412 #ifdef DM_PARALLEL
4413 # include "HALO_EM_C_TL.inc"
4414 # include "PERIOD_BDY_EM_E.inc"
4415 #endif
4417 CALL wrf_debug ( 10 , ' call g_set_w_surface' )
4418 fill_w_flag = .false.
4420 !$OMP PARALLEL DO &
4421 !$OMP PRIVATE ( ij )
4422 DO ij = 1 , grid%num_tiles
4423 CALL g_set_w_surface( config_flags, grid%znw, fill_w_flag, &
4424 grid%w_2,grid%g_w_2, grid%ht, &
4425 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, &
4426 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
4427 grid%msftx, grid%msfty, &
4428 ids, ide, jds, jde, kds, kde, &
4429 ims, ime, jms, jme, kms, kme, &
4430 grid%i_start(ij), grid%i_end(ij), &
4431 grid%j_start(ij), grid%j_end(ij), &
4432 k_start, k_end )
4434 ! its, ite, jts, jte, k_start, min(k_end,kde-1), &
4436 END DO
4437 !$OMP END PARALLEL DO
4439 !-----------------------------------------------------------
4440 ! After all of the RK steps, after the microphysics, after p-rho-phi,
4441 ! after w, after filtering, we have data ready to use.
4442 !-----------------------------------------------------------
4444 CALL after_all_rk_steps ( grid, config_flags, &
4445 moist, chem, tracer, scalar, &
4446 th_phy, pi_phy, p_phy, &
4447 p8w, t8w, dz8w, &
4448 REAL(curr_secs,8), curr_secs2, &
4449 diag_flag, &
4450 ids, ide, jds, jde, kds, kde, &
4451 ims, ime, jms, jme, kms, kme, &
4452 ips, ipe, jps, jpe, kps, kpe, &
4453 imsx, imex, jmsx, jmex, kmsx, kmex, &
4454 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
4455 imsy, imey, jmsy, jmey, kmsy, kmey, &
4456 ipsy, ipey, jpsy, jpey, kpsy, kpey )
4458 #ifdef DM_PARALLEL
4459 !-----------------------------------------------------------------------
4460 ! see above
4461 !--------------------------------------------------------------
4462 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
4463 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4464 # include "HALO_EM_E_3_TL.inc"
4465 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4466 # include "HALO_EM_E_5_TL.inc"
4467 ELSE
4468 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4469 CALL wrf_error_fatal(TRIM(wrf_err_message))
4470 ENDIF
4471 #endif
4473 #ifdef DM_PARALLEL
4474 IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
4475 !-----------------------------------------------------------------------
4476 ! see above
4477 !--------------------------------------------------------------
4478 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
4479 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4480 # include "HALO_EM_MOIST_E_3_TL.inc"
4481 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4482 # include "HALO_EM_MOIST_E_5_TL.inc"
4483 ELSE
4484 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4485 CALL wrf_error_fatal(TRIM(wrf_err_message))
4486 ENDIF
4487 ENDIF
4488 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
4489 !-----------------------------------------------------------------------
4490 ! see above
4491 !--------------------------------------------------------------
4492 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
4493 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4494 # include "HALO_EM_CHEM_E_3.inc"
4495 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4496 # include "HALO_EM_CHEM_E_5.inc"
4497 ELSE
4498 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4499 CALL wrf_error_fatal(TRIM(wrf_err_message))
4500 ENDIF
4501 ENDIF
4502 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
4503 !-----------------------------------------------------------------------
4504 ! see above
4505 !--------------------------------------------------------------
4506 CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' )
4507 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4508 # include "HALO_EM_TRACER_E_3_TL.inc"
4509 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4510 # include "HALO_EM_TRACER_E_5_TL.inc"
4511 ELSE
4512 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4513 CALL wrf_error_fatal(TRIM(wrf_err_message))
4514 ENDIF
4515 ENDIF
4516 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
4517 !-----------------------------------------------------------------------
4518 ! see above
4519 !--------------------------------------------------------------
4520 CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
4521 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4522 # include "HALO_EM_SCALAR_E_3.inc"
4523 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4524 # include "HALO_EM_SCALAR_E_5.inc"
4525 ELSE
4526 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4527 CALL wrf_error_fatal(TRIM(wrf_err_message))
4528 ENDIF
4529 ENDIF
4530 #endif
4532 ! Max values of CFL for adaptive time step scheme
4534 DEALLOCATE(max_vert_cfl_tmp)
4535 DEALLOCATE(max_horiz_cfl_tmp)
4537 CALL wrf_debug ( 200 , ' call end of solve_em_tl' )
4539 ! Finish timers if compiled with -DBENCH.
4540 #include "bench_solve_em_end.h"
4542 RETURN
4544 END SUBROUTINE solve_em_tl