| blob | a8c323a60729776c381e616d678c9aecd1aee5d7 |
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 == MYNNPBLSCHEME ) THEN
673 # include "HALO_EM_SCALAR_E_5.inc"
674 ENDIF
675 #endif
677 CALL g_first_rk_step_part2 ( grid , config_flags &
678 , moist ,g_moist , moist_tend ,g_moist_tend &
679 !!!!! USE THE STATEMENTS REMARKED WHEN chem is NEEDED. Ning Pan, 2010-08-20
680 ! , chem ,g_chem , chem_tend ,g_chem_tend &
681 , chem , chem , chem_tend , chem_tend &
682 , tracer, g_tracer, tracer_tend, g_tracer_tend &
683 , scalar,g_scalar, scalar_tend,g_scalar_tend &
684 !!!!! USE THE STATEMENT REMARKED WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
685 ! , fdda3d,g_fdda3d, fdda2d,g_fdda2d &
686 !!!!! REMOVE THE FOLLOWING STATEMENT WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
687 , fdda3d, fdda3d, fdda2d, fdda2d &
688 , ru_tendf,g_ru_tendf, rv_tendf,g_rv_tendf &
689 , rw_tendf,g_rw_tendf, t_tendf ,g_t_tendf &
690 , ph_tendf,g_ph_tendf, mu_tendf,g_mu_tendf &
691 , tke_tend,g_tke_tend &
692 , adapt_step_flag , curr_secs &
693 !!!!! USE THE STATEMENTS REMARKED WHEN CODING TL OF PHYSICS. Ning Pan, 2010-08-20
694 ! , psim ,g_psim , psih ,g_psih , wspd ,g_wspd , &
695 ! gz1oz0 ,g_gz1oz0 , br ,g_br , chklowq,g_chklowq &
696 ! , cu_act_flag , hol ,g_hol, th_phy,g_th_phy &
697 !!!!! REMOVE THE FOLLOWING 3 STATEMENTS WHEN CODING TL OF PHYSICS. Ning Pan, 2010-08-20
698 , psim , psim , psih , psih , &
699 !201602 gz1oz0 , gz1oz0 , br , br , chklowq, chklowq &
700 !201602: br became a state variable and was removed from the argument
701 gz1oz0 , gz1oz0 , chklowq, chklowq &
702 , cu_act_flag , hol , hol, th_phy,g_th_phy &
703 , pi_phy ,g_pi_phy, p_phy ,g_p_phy , grid%t_phy ,grid%g_t_phy &
704 , dz8w ,g_dz8w , p8w ,g_p8w , t8w ,g_t8w &
705 , nba_mij,g_nba_mij, num_nba_mij &
706 , nba_rij,g_nba_rij, num_nba_rij &
707 , ids, ide, jds, jde, kds, kde &
708 , ims, ime, jms, jme, kms, kme &
709 , ips, ipe, jps, jpe, kps, kpe &
710 , imsx, imex, jmsx, jmex, kmsx, kmex &
711 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
712 , imsy, imey, jmsy, jmey, kmsy, kmey &
713 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
714 , k_start , k_end &
715 )
717 END IF rk_step_is_one
719 BENCH_START(g_rk_tend_tim)
720 !$OMP PARALLEL DO &
721 !$OMP PRIVATE ( ij )
722 DO ij = 1 , grid%num_tiles
724 CALL wrf_debug ( 200 , ' call g_rk_tendency' )
725 CALL g_rk_tendency ( config_flags, rk_step, &
726 grid%ru_tend, grid%g_ru_tend, grid%rv_tend, grid%g_rv_tend, &
727 rw_tend, g_rw_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, &
728 ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, &
729 rw_tendf, g_rw_tendf, ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, &
730 mu_tend, g_mu_tend, &
731 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
732 w_save, g_w_save, ph_save, g_ph_save, &
733 grid%t_save, grid%g_t_save, mu_save, g_mu_save, &
734 grid%rthften, grid%g_rthften, &
735 grid%ru, grid%g_ru, grid%rv, grid%g_rv, grid%rw, grid%g_rw, grid%ww, grid%g_ww, &
736 grid%u_2, grid%g_u_2, grid%v_2, grid%g_v_2, grid%w_2, grid%g_w_2, &
737 grid%t_2, grid%g_t_2, grid%ph_2, grid%g_ph_2, &
738 grid%u_1, grid%g_u_1, grid%v_1, grid%g_v_1, grid%w_1, grid%g_w_1, &
739 grid%t_1, grid%g_t_1, grid%ph_1, grid%g_ph_1, &
740 grid%h_diabatic, grid%g_h_diabatic, grid%phb, grid%t_init, &
741 grid%mu_2, grid%g_mu_2, grid%mut, grid%g_mut, grid%muu, grid%g_muu, &
742 grid%muv, grid%g_muv, grid%mub, &
743 grid%al, grid%g_al, grid%alt, grid%g_alt, grid%p, grid%g_p, grid%pb, &
744 grid%php, grid%g_php, cqu, g_cqu, cqv, g_cqv, cqw, g_cqw, &
745 grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base, &
746 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
747 grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa, &
748 grid%fnm, grid%fnp, grid%rdn, grid%rdnw, &
749 grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, &
750 grid%xkmh,grid%g_xkmh, grid%xkhh,grid%g_xkhh, &
751 grid%diff_6th_opt, grid%diff_6th_factor, &
752 config_flags%momentum_adv_opt, &
753 grid%dampcoef,grid%zdamp,config_flags%damp_opt,config_flags%rad_nudge, &
754 grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m, &
755 config_flags%non_hydrostatic, config_flags%top_lid, &
756 grid%u_frame, grid%v_frame, &
757 ids, ide, jds, jde, kds, kde, &
758 ims, ime, jms, jme, kms, kme, &
759 grid%i_start(ij), grid%i_end(ij), &
760 grid%j_start(ij), grid%j_end(ij), &
761 k_start, k_end, &
762 max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
764 END DO
765 !$OMP END PARALLEL DO
766 BENCH_END(g_rk_tend_tim)
768 IF (config_flags%use_adaptive_time_step) THEN
769 DO ij = 1 , grid%num_tiles
770 IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
771 grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
772 ENDIF
773 IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
774 grid%max_vert_cfl = max_vert_cfl_tmp(ij)
775 ENDIF
776 END DO
778 IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
779 grid%max_cfl_val = grid%max_horiz_cfl
780 ENDIF
781 IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
782 grid%max_cfl_val = grid%max_vert_cfl
783 ENDIF
784 ENDIF
786 BENCH_START(g_relax_bdy_dry_tim)
787 !$OMP PARALLEL DO &
788 !$OMP PRIVATE ( ij )
789 DO ij = 1 , grid%num_tiles
791 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
793 CALL g_relax_bdy_dry ( config_flags, &
794 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
795 ph_save, g_ph_save, grid%t_save, grid%g_t_save, &
796 w_save, g_w_save, mu_tend, g_mu_tend, &
797 grid%ru, grid%g_ru, grid%rv, grid%g_rv, &
798 grid%ph_2, grid%g_ph_2, grid%t_2, grid%g_t_2, &
799 grid%w_2, grid%g_w_2, grid%mu_2, grid%g_mu_2, grid%mut, grid%g_mut, &
800 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
801 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
802 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
803 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
804 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
805 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
806 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
807 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
808 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
809 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
810 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
811 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
812 grid%u_btxs, grid%g_u_btxs, grid%u_btxe, grid%g_u_btxe, &
813 grid%u_btys, grid%g_u_btys, grid%u_btye, grid%g_u_btye, &
814 grid%v_btxs, grid%g_v_btxs, grid%v_btxe, grid%g_v_btxe, &
815 grid%v_btys, grid%g_v_btys, grid%v_btye, grid%g_v_btye, &
816 grid%ph_btxs, grid%g_ph_btxs, grid%ph_btxe, grid%g_ph_btxe, &
817 grid%ph_btys, grid%g_ph_btys, grid%ph_btye, grid%g_ph_btye, &
818 grid%t_btxs, grid%g_t_btxs, grid%t_btxe, grid%g_t_btxe, &
819 grid%t_btys, grid%g_t_btys, grid%t_btye, grid%g_t_btye, &
820 grid%w_btxs, grid%g_w_btxs, grid%w_btxe, grid%g_w_btxe, &
821 grid%w_btys, grid%g_w_btys, grid%w_btye, grid%g_w_btye, &
822 grid%mu_btxs, grid%g_mu_btxs, grid%mu_btxe, grid%g_mu_btxe, &
823 grid%mu_btys, grid%g_mu_btys, grid%mu_btye, grid%g_mu_btye, &
824 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
825 grid%dtbc, grid%fcx, grid%gcx, &
826 ids,ide, jds,jde, kds,kde, &
827 ims,ime, jms,jme, kms,kme, &
828 ips,ipe, jps,jpe, kps,kpe, &
829 grid%i_start(ij), grid%i_end(ij), &
830 grid%j_start(ij), grid%j_end(ij), &
831 k_start, k_end )
833 ENDIF
835 CALL g_rk_addtend_dry ( grid%ru_tend, grid%g_ru_tend, &
836 grid%rv_tend, grid%g_rv_tend, &
837 rw_tend, g_rw_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, &
838 ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, rw_tendf, g_rw_tendf, &
839 ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, &
840 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, &
841 w_save, g_w_save, ph_save, g_ph_save, grid%t_save, grid%g_t_save, &
842 mu_tend, g_mu_tend, mu_tendf, g_mu_tendf, rk_step, &
843 grid%h_diabatic, grid%g_h_diabatic, grid%mut, grid%g_mut, &
844 grid%msftx, grid%msfty, grid%msfux, grid%msfuy, &
845 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
846 ids,ide, jds,jde, kds,kde, &
847 ims,ime, jms,jme, kms,kme, &
848 ips,ipe, jps,jpe, kps,kpe, &
849 grid%i_start(ij), grid%i_end(ij), &
850 grid%j_start(ij), grid%j_end(ij), &
851 k_start, k_end )
853 IF( config_flags%specified .or. config_flags%nested ) THEN
854 CALL g_spec_bdy_dry ( config_flags, &
855 grid%ru_tend, grid%g_ru_tend, grid%rv_tend, grid%g_rv_tend, &
856 ph_tend, g_ph_tend, t_tend, g_t_tend, &
857 rw_tend, g_rw_tend, mu_tend, g_mu_tend, &
858 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
859 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
860 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
861 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
862 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
863 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
864 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
865 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
866 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
867 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
868 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
869 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
870 grid%u_btxs, grid%g_u_btxs, grid%u_btxe, grid%g_u_btxe, &
871 grid%u_btys, grid%g_u_btys, grid%u_btye, grid%g_u_btye, &
872 grid%v_btxs, grid%g_v_btxs, grid%v_btxe, grid%g_v_btxe, &
873 grid%v_btys, grid%g_v_btys, grid%v_btye, grid%g_v_btye, &
874 grid%ph_btxs, grid%g_ph_btxs, grid%ph_btxe, grid%g_ph_btxe, &
875 grid%ph_btys, grid%g_ph_btys, grid%ph_btye, grid%g_ph_btye, &
876 grid%t_btxs, grid%g_t_btxs, grid%t_btxe, grid%g_t_btxe, &
877 grid%t_btys, grid%g_t_btys, grid%t_btye, grid%g_t_btye, &
878 grid%w_btxs, grid%g_w_btxs, grid%w_btxe, grid%g_w_btxe, &
879 grid%w_btys, grid%g_w_btys, grid%w_btye, grid%g_w_btye, &
880 grid%mu_btxs, grid%g_mu_btxs, grid%mu_btxe, grid%g_mu_btxe, &
881 grid%mu_btys, grid%g_mu_btys, grid%mu_btye, grid%g_mu_btye, &
882 config_flags%spec_bdy_width, grid%spec_zone, &
883 ids,ide, jds,jde, kds,kde, & ! domain dims
884 ims,ime, jms,jme, kms,kme, & ! memory dims
885 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
886 grid%i_start(ij), grid%i_end(ij), &
887 grid%j_start(ij), grid%j_end(ij), &
888 k_start, k_end )
890 ENDIF
892 END DO
893 !$OMP END PARALLEL DO
894 BENCH_END(g_relax_bdy_dry_tim)
896 !<DESCRIPTION>
897 !<pre>
898 ! (3) Small (acoustic,sound) steps.
899 !
900 ! Several acoustic steps are taken each RK pass. A small step
901 ! sequence begins with calculating perturbation variables
902 ! and coupling them to the column dry-air-mass mu
903 ! (call to small_step_prep). This is followed by computing
904 ! coefficients for the vertically implicit part of the
905 ! small timestep (call to calc_coef_w).
906 !
907 ! The small steps are taken
908 ! in the named loop "small_steps:". In the small_steps loop, first
909 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
910 ! next mu and theta are advanced (call to advance_mu_t) followed by
911 ! advancing w and the geopotential (call to advance_w). Diagnostic
912 ! values for pressure and inverse density are updated at the end of
913 ! each small_step.
914 !
915 ! The small-step section ends with the change of the perturbation variables
916 ! back to full variables (call to small_step_finish).
917 !</pre>
918 !</DESCRIPTION>
920 BENCH_START(g_small_step_prep_tim)
921 !$OMP PARALLEL DO &
922 !$OMP PRIVATE ( ij )
923 DO ij = 1 , grid%num_tiles
925 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
926 ! integration. We only need calculate these for the first pass through -
927 ! the predictor step. They are reused as is for the corrector step.
928 ! For third-order RK, we need to recompute these after the first
929 ! predictor because we may have changed the small timestep -> grid%dts.
931 CALL wrf_debug ( 200 , ' call g_small_step_prep ' )
933 CALL g_small_step_prep( grid%u_1,grid%g_u_1,grid%u_2,grid%g_u_2, &
934 grid%v_1,grid%g_v_1,grid%v_2,grid%g_v_2, &
935 grid%w_1,grid%g_w_1,grid%w_2,grid%g_w_2, &
936 grid%t_1,grid%g_t_1,grid%t_2,grid%g_t_2, &
937 grid%ph_1,grid%g_ph_1,grid%ph_2,grid%g_ph_2, &
938 grid%mub, grid%mu_1,grid%g_mu_1, grid%mu_2,grid%g_mu_2, &
939 grid%muu,grid%g_muu, grid%muus,grid%g_muus, &
940 grid%muv,grid%g_muv, grid%muvs,grid%g_muvs, &
941 grid%mut,grid%g_mut, grid%muts,grid%g_muts, grid%mudf,grid%g_mudf, &
942 grid%u_save,grid%g_u_save, grid%v_save,grid%g_v_save, w_save,g_w_save, &
943 grid%t_save,grid%g_t_save, ph_save,g_ph_save, mu_save,g_mu_save, &
944 grid%ww,grid%g_ww, ww1,g_ww1, &
945 c2a,g_c2a, grid%pb, grid%p,grid%g_p, grid%alt,grid%g_alt,&
946 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
947 grid%msfvy, grid%msftx,grid%msfty, &
948 grid%rdx, grid%rdy, rk_step, &
949 ids, ide, jds, jde, kds, kde, &
950 ims, ime, jms, jme, kms, kme, &
951 grid%i_start(ij), grid%i_end(ij), &
952 grid%j_start(ij), grid%j_end(ij), &
953 k_start, k_end )
955 CALL g_calc_p_rho( grid%al,grid%g_al, grid%p,grid%g_p, grid%ph_2,grid%g_ph_2, &
956 grid%alt,grid%g_alt, grid%t_2,grid%g_t_2, &
957 grid%t_save,grid%g_t_save, c2a,g_c2a, pm1,g_pm1, &
958 grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, grid%znu, t0, &
959 grid%rdnw, grid%dnw, grid%smdiv, &
960 config_flags%non_hydrostatic, 0, &
961 ids, ide, jds, jde, kds, kde, &
962 ims, ime, jms, jme, kms, kme, &
963 grid%i_start(ij), grid%i_end(ij), &
964 grid%j_start(ij), grid%j_end(ij), &
965 k_start, k_end )
967 IF (config_flags%non_hydrostatic) THEN
968 CALL g_calc_coef_w( a,g_a,alpha,g_alpha,gamma,g_gamma, &
969 grid%mut,grid%g_mut, cqw,g_cqw, &
970 grid%rdn, grid%rdnw, c2a,g_c2a, &
971 dts_rk, g, grid%epssm, &
972 config_flags%top_lid, &
973 ids, ide, jds, jde, kds, kde, &
974 ims, ime, jms, jme, kms, kme, &
975 grid%i_start(ij), grid%i_end(ij), &
976 grid%j_start(ij), grid%j_end(ij), &
977 k_start, k_end )
979 ENDIF
981 ENDDO
982 !$OMP END PARALLEL DO
983 BENCH_END(g_small_step_prep_tim)
985 #ifdef DM_PARALLEL
986 !-----------------------------------------------------------------------
987 ! Stencils for patch communications (WCS, 29 June 2001)
988 ! Note: the small size of this halo exchange reflects the
989 ! fact that we are carrying the uncoupled variables
990 ! as state variables in the mass coordinate model, as
991 ! opposed to the coupled variables as in the height
992 ! coordinate model.
993 !
994 ! * * * * *
995 ! * * * * * * * * *
996 ! * + * * + * * * + * *
997 ! * * * * * * * * *
998 ! * * * * *
999 !
1000 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
1001 !
1002 ! ph_2 x
1003 ! al x
1004 ! p x
1005 ! t_1 x
1006 ! t_save x
1007 ! u_save x
1008 ! v_save x
1009 !
1010 ! the following are 2D (xy) variables
1011 !
1012 ! mu_1 x
1013 ! mu_2 x
1014 ! mudf x
1015 ! php x
1016 ! alt x
1017 ! pb x
1018 !--------------------------------------------------------------
1019 # include "HALO_EM_B_TL.inc"
1020 # include "PERIOD_BDY_EM_B.inc"
1021 #endif
1023 BENCH_START(g_set_phys_bc2_tim)
1024 !$OMP PARALLEL DO &
1025 !$OMP PRIVATE ( ij )
1027 DO ij = 1 , grid%num_tiles
1029 CALL g_set_physical_bc3d( grid%ru_tend,grid%g_ru_tend, 'u', config_flags, &
1030 ids, ide, jds, jde, kds, kde, &
1031 ims, ime, jms, jme, kms, kme, &
1032 ips, ipe, jps, jpe, kps, kpe, &
1033 grid%i_start(ij), grid%i_end(ij), &
1034 grid%j_start(ij), grid%j_end(ij), &
1035 k_start , k_end )
1037 CALL g_set_physical_bc3d( grid%rv_tend,grid%g_rv_tend, 'v', config_flags, &
1038 ids, ide, jds, jde, kds, kde, &
1039 ims, ime, jms, jme, kms, kme, &
1040 ips, ipe, jps, jpe, kps, kpe, &
1041 grid%i_start(ij), grid%i_end(ij), &
1042 grid%j_start(ij), grid%j_end(ij), &
1043 k_start , k_end )
1045 CALL g_set_physical_bc3d( grid%ph_2,grid%g_ph_2, 'w', config_flags, &
1046 ids, ide, jds, jde, kds, kde, &
1047 ims, ime, jms, jme, kms, kme, &
1048 ips, ipe, jps, jpe, kps, kpe, &
1049 grid%i_start(ij), grid%i_end(ij), &
1050 grid%j_start(ij), grid%j_end(ij), &
1051 k_start , k_end )
1053 CALL g_set_physical_bc3d( grid%al,grid%g_al, 'p', config_flags, &
1054 ids, ide, jds, jde, kds, kde, &
1055 ims, ime, jms, jme, kms, kme, &
1056 ips, ipe, jps, jpe, kps, kpe, &
1057 grid%i_start(ij), grid%i_end(ij), &
1058 grid%j_start(ij), grid%j_end(ij), &
1059 k_start , k_end )
1061 CALL g_set_physical_bc3d( grid%p,grid%g_p, 'p', config_flags, &
1062 ids, ide, jds, jde, kds, kde, &
1063 ims, ime, jms, jme, kms, kme, &
1064 ips, ipe, jps, jpe, kps, kpe, &
1065 grid%i_start(ij), grid%i_end(ij), &
1066 grid%j_start(ij), grid%j_end(ij), &
1067 k_start , k_end )
1069 CALL g_set_physical_bc3d( grid%t_1,grid%g_t_1, 'p', config_flags, &
1070 ids, ide, jds, jde, kds, kde, &
1071 ims, ime, jms, jme, kms, kme, &
1072 ips, ipe, jps, jpe, kps, kpe, &
1073 grid%i_start(ij), grid%i_end(ij), &
1074 grid%j_start(ij), grid%j_end(ij), &
1075 k_start , k_end )
1077 CALL g_set_physical_bc3d( grid%t_save,grid%g_t_save, 't', config_flags, &
1078 ids, ide, jds, jde, kds, kde, &
1079 ims, ime, jms, jme, kms, kme, &
1080 ips, ipe, jps, jpe, kps, kpe, &
1081 grid%i_start(ij), grid%i_end(ij), &
1082 grid%j_start(ij), grid%j_end(ij), &
1083 k_start , k_end )
1085 CALL g_set_physical_bc2d( grid%mu_1,grid%g_mu_1, 't', config_flags, &
1086 ids, ide, jds, jde, &
1087 ims, ime, jms, jme, &
1088 ips, ipe, jps, jpe, &
1089 grid%i_start(ij), grid%i_end(ij), &
1090 grid%j_start(ij), grid%j_end(ij) )
1092 CALL g_set_physical_bc2d( grid%mu_2,grid%g_mu_2, 't', config_flags, &
1093 ids, ide, jds, jde, &
1094 ims, ime, jms, jme, &
1095 ips, ipe, jps, jpe, &
1096 grid%i_start(ij), grid%i_end(ij), &
1097 grid%j_start(ij), grid%j_end(ij) )
1099 CALL g_set_physical_bc2d( grid%mudf,grid%g_mudf, 't', config_flags, &
1100 ids, ide, jds, jde, &
1101 ims, ime, jms, jme, &
1102 ips, ipe, jps, jpe, &
1103 grid%i_start(ij), grid%i_end(ij), &
1104 grid%j_start(ij), grid%j_end(ij) )
1106 END DO
1107 !$OMP END PARALLEL DO
1108 BENCH_END(g_set_phys_bc2_tim)
1109 small_steps : DO iteration = 1 , number_of_small_timesteps
1111 ! Boundary condition time (or communication time).
1112 #ifdef DM_PARALLEL
1113 # include "PERIOD_BDY_EM_B.inc"
1114 #endif
1116 !$OMP PARALLEL DO &
1117 !$OMP PRIVATE ( ij )
1119 DO ij = 1 , grid%num_tiles
1121 BENCH_START(g_advance_uv_tim)
1122 CALL g_advance_uv( grid%u_2,grid%g_u_2, grid%ru_tend,grid%g_ru_tend, &
1123 grid%v_2,grid%g_v_2, grid%rv_tend,grid%g_rv_tend, &
1124 grid%p,grid%g_p, grid%pb, &
1125 grid%ph_2,grid%g_ph_2, grid%php,grid%g_php, &
1126 grid%alt,grid%g_alt, grid%al,grid%g_al, &
1127 grid%mu_2,grid%g_mu_2, &
1128 grid%muu,grid%g_muu, cqu,g_cqu, grid%muv,grid%g_muv, cqv,g_cqv, &
1129 grid%mudf,grid%g_mudf, &
1130 grid%msfux, grid%msfuy, grid%msfvx, &
1131 grid%msfvx_inv, grid%msfvy, &
1132 grid%rdx, grid%rdy, dts_rk, &
1133 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
1134 grid%emdiv, &
1135 grid%rdnw, config_flags,grid%spec_zone, &
1136 config_flags%non_hydrostatic, config_flags%top_lid, &
1137 ids, ide, jds, jde, kds, kde, &
1138 ims, ime, jms, jme, kms, kme, &
1139 grid%i_start(ij), grid%i_end(ij), &
1140 grid%j_start(ij), grid%j_end(ij), &
1141 k_start, k_end )
1142 BENCH_END(g_advance_uv_tim)
1144 END DO
1145 !$OMP END PARALLEL DO
1147 !-----------------------------------------------------------
1148 ! acoustic integration polar filter for smallstep u, v
1149 !-----------------------------------------------------------
1151 IF (config_flags%polar) THEN
1154 CALL pxft ( grid=grid &
1155 ,lineno=__LINE__ &
1156 ,flag_uv = 1 &
1157 ,flag_rurv = 0 &
1158 ,flag_wph = 0 &
1159 ,flag_ww = 0 &
1160 ,flag_t = 0 &
1161 ,flag_mu = 0 &
1162 ,flag_mut = 0 &
1163 ,flag_moist = 0 &
1164 ,flag_chem = 0 &
1165 ,flag_tracer = 0 &
1166 ,flag_scalar = 0 &
1167 ,actual_distance_average = .FALSE. &
1168 ,pos_def = .FALSE. &
1169 ,swap_pole_with_next_j = .FALSE. &
1170 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1171 ,fft_filter_lat = config_flags%fft_filter_lat &
1172 ,dclat = dclat &
1173 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1174 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1175 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1176 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1177 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1179 END IF
1181 !-----------------------------------------------------------
1182 ! end acoustic integration polar filter for smallstep u, v
1183 !-----------------------------------------------------------
1185 !$OMP PARALLEL DO &
1186 !$OMP PRIVATE ( ij )
1187 DO ij = 1 , grid%num_tiles
1189 BENCH_START(g_spec_bdy_uv_tim)
1190 IF( config_flags%specified .or. config_flags%nested ) THEN
1191 CALL g_spec_bdyupdate ( grid%u_2, grid%g_u_2, &
1192 grid%ru_tend, grid%g_ru_tend, dts_rk, &
1193 'u' , config_flags, &
1194 grid%spec_zone, &
1195 ids,ide, jds,jde, kds,kde, & ! domain dims
1196 ims,ime, jms,jme, kms,kme, & ! memory dims
1197 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1198 grid%i_start(ij), grid%i_end(ij), &
1199 grid%j_start(ij), grid%j_end(ij), &
1200 k_start, k_end )
1202 CALL g_spec_bdyupdate ( grid%v_2, grid%g_v_2, &
1203 grid%rv_tend, grid%g_rv_tend, dts_rk, &
1204 'v' , config_flags, &
1205 grid%spec_zone, &
1206 ids,ide, jds,jde, kds,kde, & ! domain dims
1207 ims,ime, jms,jme, kms,kme, & ! memory dims
1208 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1209 grid%i_start(ij), grid%i_end(ij), &
1210 grid%j_start(ij), grid%j_end(ij), &
1211 k_start, k_end )
1213 ENDIF
1214 BENCH_END(g_spec_bdy_uv_tim)
1216 END DO
1217 !$OMP END PARALLEL DO
1219 #ifdef DM_PARALLEL
1220 !
1221 ! Stencils for patch communications (WCS, 29 June 2001)
1222 !
1223 ! * *
1224 ! * + * * + * +
1225 ! * *
1226 !
1227 ! u_2 x
1228 ! v_2 x
1229 !
1230 # include "HALO_EM_C_TL.inc"
1231 #endif
1233 !$OMP PARALLEL DO &
1234 !$OMP PRIVATE ( ij )
1235 DO ij = 1 , grid%num_tiles
1237 ! advance the mass in the column, theta, and calculate ww
1239 BENCH_START(g_advance_mu_t_tim)
1240 CALL g_advance_mu_t( grid%ww,grid%g_ww, ww1,g_ww1, &
1241 grid%u_2,grid%g_u_2, grid%u_save,grid%g_u_save, &
1242 grid%v_2,grid%g_v_2, grid%v_save,grid%g_v_save, &
1243 grid%mu_2,grid%g_mu_2, grid%mut,grid%g_mut, &
1244 muave,g_muave, grid%muts,grid%g_muts, &
1245 grid%muu,grid%g_muu, grid%muv,grid%g_muv, grid%mudf,grid%g_mudf, &
1246 grid%ru_m,grid%g_ru_m, grid%rv_m,grid%g_rv_m, grid%ww_m,grid%g_ww_m, &
1247 grid%t_2,grid%g_t_2, grid%t_save,grid%g_t_save, &
1248 t_2save,g_t_2save, t_tend,g_t_tend, &
1249 mu_tend,g_mu_tend, &
1250 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1251 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1252 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1253 grid%msfvy, grid%msftx,grid%msfty, &
1254 iteration, config_flags, &
1255 ids, ide, jds, jde, kds, kde, &
1256 ims, ime, jms, jme, kms, kme, &
1257 grid%i_start(ij), grid%i_end(ij), &
1258 grid%j_start(ij), grid%j_end(ij), &
1259 k_start, k_end )
1261 BENCH_END(g_advance_mu_t_tim)
1262 ENDDO
1263 !$OMP END PARALLEL DO
1265 !-----------------------------------------------------------
1266 ! acoustic integration polar filter for smallstep mu, t
1267 !-----------------------------------------------------------
1269 IF ( (config_flags%polar) ) THEN
1271 CALL pxft ( grid=grid &
1272 ,lineno=__LINE__ &
1273 ,flag_uv = 0 &
1274 ,flag_rurv = 0 &
1275 ,flag_wph = 0 &
1276 ,flag_ww = 0 &
1277 ,flag_t = 1 &
1278 ,flag_mu = 1 &
1279 ,flag_mut = 0 &
1280 ,flag_moist = 0 &
1281 ,flag_chem = 0 &
1282 ,flag_tracer = 0 &
1283 ,flag_scalar = 0 &
1284 ,actual_distance_average = .FALSE. &
1285 ,pos_def = .FALSE. &
1286 ,swap_pole_with_next_j = .FALSE. &
1287 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1288 ,fft_filter_lat = config_flags%fft_filter_lat &
1289 ,dclat = dclat &
1290 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1291 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1292 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1293 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1294 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1296 grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1298 END IF
1300 !-----------------------------------------------------------
1301 ! end acoustic integration polar filter for smallstep mu, t
1302 !-----------------------------------------------------------
1304 BENCH_START(g_spec_bdy_t_tim)
1306 !$OMP PARALLEL DO &
1307 !$OMP PRIVATE ( ij )
1308 DO ij = 1 , grid%num_tiles
1310 IF( config_flags%specified .or. config_flags%nested ) THEN
1312 CALL g_spec_bdyupdate ( grid%t_2, grid%g_t_2, &
1313 t_tend, g_t_tend, dts_rk, &
1314 't' , config_flags, &
1315 grid%spec_zone, &
1316 ids,ide, jds,jde, kds,kde, & ! domain dims
1317 ims,ime, jms,jme, kms,kme, & ! memory dims
1318 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1319 grid%i_start(ij), grid%i_end(ij), &
1320 grid%j_start(ij), grid%j_end(ij), &
1321 k_start, k_end )
1323 CALL g_spec_bdyupdate ( grid%mu_2, grid%g_mu_2, &
1324 mu_tend, g_mu_tend, dts_rk, &
1325 'm' , config_flags, &
1326 grid%spec_zone, &
1327 ids,ide, jds,jde, 1 ,1 , &
1328 ims,ime, jms,jme, 1 ,1 , &
1329 ips,ipe, jps,jpe, 1 ,1 , &
1330 grid%i_start(ij), grid%i_end(ij), &
1331 grid%j_start(ij), grid%j_end(ij), &
1332 1, 1 )
1334 CALL g_spec_bdyupdate ( grid%muts, grid%g_muts, mu_tend, g_mu_tend, dts_rk, &
1335 'm' , config_flags, &
1336 grid%spec_zone, &
1337 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1338 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1339 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1340 grid%i_start(ij), grid%i_end(ij), &
1341 grid%j_start(ij), grid%j_end(ij), &
1342 1, 1 )
1344 ENDIF
1345 BENCH_END(g_spec_bdy_t_tim)
1347 ! small (acoustic) step for the vertical momentum,
1348 ! density and coupled potential temperature.
1351 BENCH_START(g_advance_w_tim)
1352 IF ( config_flags%non_hydrostatic ) THEN
1353 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, &
1354 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, &
1355 grid%mu_2,grid%mut,grid%g_mut, &
1356 muave,g_muave, grid%muts,grid%g_muts, &
1357 t_2save,g_t_2save, grid%t_2,grid%g_t_2, grid%t_save,grid%g_t_save, &
1358 grid%ph_2,grid%g_ph_2, ph_save,g_ph_save, grid%phb, ph_tend,g_ph_tend, &
1359 grid%ht, c2a,g_c2a, cqw,g_cqw, grid%alt,grid%g_alt, grid%alb, &
1360 a,g_a, alpha,g_alpha, gamma,g_gamma, &
1361 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1362 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1363 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1364 grid%msftx, grid%msfty, &
1365 config_flags, config_flags%top_lid, &
1366 ids,ide, jds,jde, kds,kde, &
1367 ims,ime, jms,jme, kms,kme, &
1368 grid%i_start(ij), grid%i_end(ij), &
1369 grid%j_start(ij), grid%j_end(ij), &
1370 k_start, k_end )
1372 ENDIF
1373 BENCH_END(g_advance_w_tim)
1375 ENDDO
1376 !$OMP END PARALLEL DO
1378 !-----------------------------------------------------------
1379 ! acoustic integration polar filter for smallstep w, geopotential
1380 !-----------------------------------------------------------
1382 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1384 CALL pxft ( grid=grid &
1385 ,lineno=__LINE__ &
1386 ,flag_uv = 0 &
1387 ,flag_rurv = 0 &
1388 ,flag_wph = 1 &
1389 ,flag_ww = 0 &
1390 ,flag_t = 0 &
1391 ,flag_mu = 0 &
1392 ,flag_mut = 0 &
1393 ,flag_moist = 0 &
1394 ,flag_chem = 0 &
1395 ,flag_tracer = 0 &
1396 ,flag_scalar = 0 &
1397 ,actual_distance_average = .FALSE. &
1398 ,pos_def = .FALSE. &
1399 ,swap_pole_with_next_j = .FALSE. &
1400 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1401 ,fft_filter_lat = config_flags%fft_filter_lat &
1402 ,dclat = dclat &
1403 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1404 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1405 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1406 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1407 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1409 END IF
1411 !-----------------------------------------------------------
1412 ! end acoustic integration polar filter for smallstep w, geopotential
1413 !-----------------------------------------------------------
1415 !$OMP PARALLEL DO &
1416 !$OMP PRIVATE ( ij )
1417 DO ij = 1 , grid%num_tiles
1419 BENCH_START(g_sumflux_tim)
1420 CALL g_sumflux ( grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ww,grid%g_ww, &
1421 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, ww1, g_ww1, &
1422 grid%muu, grid%g_muu, grid%muv, grid%g_muv, &
1423 grid%ru_m, grid%g_ru_m, grid%rv_m, grid%g_rv_m, grid%ww_m, grid%g_ww_m, &
1424 grid%epssm, &
1425 grid%msfux, grid% msfuy, grid%msfvx, &
1426 grid%msfvx_inv, grid%msfvy, &
1427 iteration, number_of_small_timesteps, &
1428 ids, ide, jds, jde, kds, kde, &
1429 ims, ime, jms, jme, kms, kme, &
1430 grid%i_start(ij), grid%i_end(ij), &
1431 grid%j_start(ij), grid%j_end(ij), &
1432 k_start , k_end )
1433 BENCH_END(g_sumflux_tim)
1435 IF( config_flags%specified .or. config_flags%nested ) THEN
1437 BENCH_START(g_spec_bdynhyd_tim)
1438 IF (config_flags%non_hydrostatic) THEN
1439 CALL g_spec_bdyupdate_ph ( ph_save, g_ph_save, grid%ph_2, grid%g_ph_2, &
1440 ph_tend, g_ph_tend, &
1441 mu_tend, g_mu_tend, grid%muts, grid%g_muts, dts_rk, &
1442 'h' , config_flags, &
1443 grid%spec_zone, &
1444 ids,ide, jds,jde, kds,kde, &
1445 ims,ime, jms,jme, kms,kme, &
1446 ips,ipe, jps,jpe, kps,kpe, &
1447 grid%i_start(ij), grid%i_end(ij),&
1448 grid%j_start(ij), grid%j_end(ij),&
1449 k_start, k_end )
1451 IF( config_flags%specified ) THEN
1452 CALL g_zero_grad_bdy ( grid%w_2, grid%g_w_2, &
1453 'w' , config_flags, &
1454 grid%spec_zone, &
1455 ids,ide, jds,jde, kds,kde, &
1456 ims,ime, jms,jme, kms,kme, &
1457 ips,ipe, jps,jpe, kps,kpe, &
1458 grid%i_start(ij), grid%i_end(ij), &
1459 grid%j_start(ij), grid%j_end(ij), &
1460 k_start, k_end )
1462 ELSE
1463 CALL g_spec_bdyupdate ( grid%w_2, grid%g_w_2, &
1464 rw_tend, g_rw_tend, dts_rk, &
1465 'h' , config_flags, &
1466 grid%spec_zone, &
1467 ids,ide, jds,jde, kds,kde, & ! domain dims
1468 ims,ime, jms,jme, kms,kme, & ! memory dims
1469 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1470 grid%i_start(ij), grid%i_end(ij), &
1471 grid%j_start(ij), grid%j_end(ij), &
1472 k_start, k_end )
1473 ENDIF
1474 ENDIF
1475 BENCH_END(g_spec_bdynhyd_tim)
1476 ENDIF
1478 BENCH_START(g_cald_p_rho_tim)
1479 CALL g_calc_p_rho( grid%al, grid%g_al, grid%p, grid%g_p, grid%ph_2, grid%g_ph_2, &
1480 grid%alt, grid%g_alt, grid%t_2, grid%g_t_2, grid%t_save, grid%g_t_save, &
1481 c2a, g_c2a, pm1, g_pm1, &
1482 grid%mu_2, grid%g_mu_2, grid%muts, grid%g_muts, grid%znu, t0, &
1483 grid%rdnw, grid%dnw, grid%smdiv, &
1484 config_flags%non_hydrostatic, iteration, &
1485 ids, ide, jds, jde, kds, kde, &
1486 ims, ime, jms, jme, kms, kme, &
1487 grid%i_start(ij), grid%i_end(ij), &
1488 grid%j_start(ij), grid%j_end(ij), &
1489 k_start, k_end )
1490 BENCH_END(g_cald_p_rho_tim)
1492 ENDDO
1493 !$OMP END PARALLEL DO
1495 #ifdef DM_PARALLEL
1496 !
1497 ! Stencils for patch communications (WCS, 29 June 2001)
1498 !
1499 ! * *
1500 ! * + * * + * +
1501 ! * *
1502 !
1503 ! ph_2 x
1504 ! al x
1505 ! p x
1506 !
1507 ! 2D variables (x,y)
1508 !
1509 ! mu_2 x
1510 ! muts x
1511 ! mudf x
1513 # include "HALO_EM_C2_TL.inc"
1514 # include "PERIOD_BDY_EM_B3.inc"
1515 #endif
1517 BENCH_START(g_phys_bc_tim)
1518 !$OMP PARALLEL DO &
1519 !$OMP PRIVATE ( ij )
1520 DO ij = 1 , grid%num_tiles
1522 ! boundary condition set for next small timestep
1524 CALL g_set_physical_bc3d( grid%ph_2,grid%g_ph_2, 'w', config_flags, &
1525 ids, ide, jds, jde, kds, kde, &
1526 ims, ime, jms, jme, kms, kme, &
1527 ips, ipe, jps, jpe, kps, kpe, &
1528 grid%i_start(ij), grid%i_end(ij), &
1529 grid%j_start(ij), grid%j_end(ij), &
1530 k_start , k_end )
1532 CALL g_set_physical_bc3d( grid%al,grid%g_al, 'p', config_flags, &
1533 ids, ide, jds, jde, kds, kde, &
1534 ims, ime, jms, jme, kms, kme, &
1535 ips, ipe, jps, jpe, kps, kpe, &
1536 grid%i_start(ij), grid%i_end(ij), &
1537 grid%j_start(ij), grid%j_end(ij), &
1538 k_start , k_end )
1540 CALL g_set_physical_bc3d( grid%p,grid%g_p, 'p', config_flags, &
1541 ids, ide, jds, jde, kds, kde, &
1542 ims, ime, jms, jme, kms, kme, &
1543 ips, ipe, jps, jpe, kps, kpe, &
1544 grid%i_start(ij), grid%i_end(ij), &
1545 grid%j_start(ij), grid%j_end(ij), &
1546 k_start , k_end )
1548 CALL g_set_physical_bc2d( grid%muts,grid%g_muts, 't', config_flags, &
1549 ids, ide, jds, jde, &
1550 ims, ime, jms, jme, &
1551 ips, ipe, jps, jpe, &
1552 grid%i_start(ij), grid%i_end(ij), &
1553 grid%j_start(ij), grid%j_end(ij) )
1555 CALL g_set_physical_bc2d( grid%mu_2,grid%g_mu_2, 't', config_flags, &
1556 ids, ide, jds, jde, &
1557 ims, ime, jms, jme, &
1558 ips, ipe, jps, jpe, &
1559 grid%i_start(ij), grid%i_end(ij), &
1560 grid%j_start(ij), grid%j_end(ij) )
1562 CALL g_set_physical_bc2d( grid%mudf,grid%g_mudf, 't', config_flags, &
1563 ids, ide, jds, jde, &
1564 ims, ime, jms, jme, &
1565 ips, ipe, jps, jpe, &
1566 grid%i_start(ij), grid%i_end(ij), &
1567 grid%j_start(ij), grid%j_end(ij) )
1569 END DO
1570 !$OMP END PARALLEL DO
1571 BENCH_END(g_phys_bc_tim)
1573 END DO small_steps
1575 !$OMP PARALLEL DO &
1576 !$OMP PRIVATE ( ij )
1577 DO ij = 1 , grid%num_tiles
1579 CALL wrf_debug ( 200 , ' call g_rk_small_finish' )
1581 ! change time-perturbation variables back to
1582 ! full perturbation variables.
1583 ! first get updated mu at u and v points
1585 BENCH_START(g_calc_mu_uv_tim)
1586 CALL g_calc_mu_uv_1 ( config_flags, &
1587 grid%muts, grid%g_muts, &
1588 grid%muus, grid%g_muus, &
1589 grid%muvs, grid%g_muvs, &
1590 ids, ide, jds, jde, kds, kde, &
1591 ims, ime, jms, jme, kms, kme, &
1592 grid%i_start(ij), grid%i_end(ij), &
1593 grid%j_start(ij), grid%j_end(ij), &
1594 k_start, k_end )
1595 BENCH_END(g_calc_mu_uv_tim)
1596 BENCH_START(g_small_step_finish_tim)
1597 CALL g_small_step_finish( grid%u_2, grid%g_u_2, grid%u_1, &
1598 grid%v_2, grid%g_v_2, grid%v_1, &
1599 grid%w_2, grid%g_w_2, grid%w_1, &
1600 grid%t_2, grid%g_t_2, grid%t_1, &
1601 grid%ph_2, grid%g_ph_2, grid%ph_1, &
1602 grid%ww, grid%g_ww, ww1, g_ww1, &
1603 grid%mu_2, grid%g_mu_2, grid%mu_1, &
1604 grid%mut, grid%g_mut, grid%muts, grid%g_muts, &
1605 grid%muu, grid%g_muu, grid%muus, grid%g_muus, &
1606 grid%muv, grid%g_muv, grid%muvs, grid%g_muvs, &
1607 grid%u_save, grid%g_u_save, grid%v_save, grid%g_v_save, w_save, g_w_save, &
1608 grid%t_save, grid%g_t_save, ph_save, g_ph_save, mu_save, g_mu_save, &
1609 grid%msfux,grid%msfuy,grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
1610 grid%h_diabatic, grid%g_h_diabatic, &
1611 number_of_small_timesteps,dts_rk, &
1612 rk_step, rk_order, &
1613 ids, ide, jds, jde, kds, kde, &
1614 ims, ime, jms, jme, kms, kme, &
1615 grid%i_start(ij), grid%i_end(ij), &
1616 grid%j_start(ij), grid%j_end(ij), &
1617 k_start, k_end )
1619 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
1621 IF (rk_step == rk_order) THEN
1623 CALL g_set_physical_bc3d( grid%ru_m,grid%g_ru_m, 'u', config_flags, &
1624 ids, ide, jds, jde, kds, kde, &
1625 ims, ime, jms, jme, kms, kme, &
1626 ips, ipe, jps, jpe, kps, kpe, &
1627 grid%i_start(ij), grid%i_end(ij), &
1628 grid%j_start(ij), grid%j_end(ij), &
1629 k_start , k_end )
1631 CALL g_set_physical_bc3d( grid%rv_m,grid%g_rv_m, 'v', config_flags, &
1632 ids, ide, jds, jde, kds, kde, &
1633 ims, ime, jms, jme, kms, kme, &
1634 ips, ipe, jps, jpe, kps, kpe, &
1635 grid%i_start(ij), grid%i_end(ij), &
1636 grid%j_start(ij), grid%j_end(ij), &
1637 k_start , k_end )
1639 CALL g_set_physical_bc3d( grid%ww_m,grid%g_ww_m, 'w', config_flags, &
1640 ids, ide, jds, jde, kds, kde, &
1641 ims, ime, jms, jme, kms, kme, &
1642 ips, ipe, jps, jpe, kps, kpe, &
1643 grid%i_start(ij), grid%i_end(ij), &
1644 grid%j_start(ij), grid%j_end(ij), &
1645 k_start , k_end )
1647 CALL g_set_physical_bc2d( grid%mut,grid%g_mut, 't', config_flags, &
1648 ids, ide, jds, jde, &
1649 ims, ime, jms, jme, &
1650 ips, ipe, jps, jpe, &
1651 grid%i_start(ij), grid%i_end(ij), &
1652 grid%j_start(ij), grid%j_end(ij) )
1654 CALL g_set_physical_bc2d( grid%muts,grid%g_muts, 't', config_flags, &
1655 ids, ide, jds, jde, &
1656 ims, ime, jms, jme, &
1657 ips, ipe, jps, jpe, &
1658 grid%i_start(ij), grid%i_end(ij), &
1659 grid%j_start(ij), grid%j_end(ij) )
1661 END IF
1663 BENCH_END(g_small_step_finish_tim)
1665 END DO
1666 !$OMP END PARALLEL DO
1668 !-----------------------------------------------------------
1669 ! polar filter for full dynamics variables and time-averaged mass fluxes
1670 !-----------------------------------------------------------
1672 IF (config_flags%polar) THEN
1674 CALL pxft ( grid=grid &
1675 ,lineno=__LINE__ &
1676 ,flag_uv = 1 &
1677 ,flag_rurv = 1 &
1678 ,flag_wph = 1 &
1679 ,flag_ww = 1 &
1680 ,flag_t = 1 &
1681 ,flag_mu = 1 &
1682 ,flag_mut = 1 &
1683 ,flag_moist = 0 &
1684 ,flag_chem = 0 &
1685 ,flag_tracer = 0 &
1686 ,flag_scalar = 0 &
1687 ,actual_distance_average = .FALSE. &
1688 ,pos_def = .FALSE. &
1689 ,swap_pole_with_next_j = .FALSE. &
1690 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1691 ,fft_filter_lat = config_flags%fft_filter_lat &
1692 ,dclat = dclat &
1693 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1694 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1695 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1696 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1697 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1699 END IF
1701 !-----------------------------------------------------------
1702 ! end polar filter for full dynamics variables and time-averaged mass fluxes
1703 !-----------------------------------------------------------
1705 !-----------------------------------------------------------------------
1706 ! add in physics tendency first if positive definite advection is used.
1707 ! pd advection applies advective flux limiter on last runge-kutta step
1708 !-----------------------------------------------------------------------
1709 ! first moisture
1711 IF ((config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1713 !$OMP PARALLEL DO &
1714 !$OMP PRIVATE ( ij )
1715 DO ij = 1 , grid%num_tiles
1716 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd moist ' )
1717 DO im = PARAM_FIRST_SCALAR, num_3d_m
1718 CALL g_rk_update_scalar_pd( im, im, &
1719 moist_old(ims,kms,jms,im),g_moist_old(ims,kms,jms,im), &
1720 moist_tend(ims,kms,jms,im),g_moist_tend(ims,kms,jms,im), &
1721 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1722 rk_step, dt_rk, grid%spec_zone, &
1723 config_flags, &
1724 ids, ide, jds, jde, kds, kde, &
1725 ims, ime, jms, jme, kms, kme, &
1726 grid%i_start(ij), grid%i_end(ij), &
1727 grid%j_start(ij), grid%j_end(ij), &
1728 k_start , k_end )
1730 ENDDO
1731 END DO
1732 !$OMP END PARALLEL DO
1734 !---------------------- positive definite bc call
1735 #ifdef DM_PARALLEL
1736 IF (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) THEN
1737 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1738 # include "HALO_EM_MOIST_OLD_E_5_TL.inc"
1739 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1740 # include "HALO_EM_MOIST_OLD_E_7_TL.inc"
1741 ELSE
1742 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1743 CALL wrf_error_fatal(TRIM(wrf_err_message))
1744 ENDIF
1745 ENDIF
1746 #endif
1748 #ifdef DM_PARALLEL
1749 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
1750 #endif
1752 !$OMP PARALLEL DO &
1753 !$OMP PRIVATE ( ij )
1754 DO ij = 1 , grid%num_tiles
1755 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1756 DO im = PARAM_FIRST_SCALAR , num_3d_m
1757 CALL g_set_physical_bc3d( moist_old(ims,kms,jms,im),g_moist_old(ims,kms,jms,im), 'p', config_flags, &
1758 ids, ide, jds, jde, kds, kde, &
1759 ims, ime, jms, jme, kms, kme, &
1760 ips, ipe, jps, jpe, kps, kpe, &
1761 grid%i_start(ij), grid%i_end(ij), &
1762 grid%j_start(ij), grid%j_end(ij), &
1763 k_start , k_end )
1764 END DO
1765 ENDIF
1766 END DO
1767 !$OMP END PARALLEL DO
1769 END IF ! end if for moist_adv_opt
1771 ! scalars
1773 IF ((config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1775 !$OMP PARALLEL DO &
1776 !$OMP PRIVATE ( ij )
1777 DO ij = 1 , grid%num_tiles
1778 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd scalar ' )
1779 DO im = PARAM_FIRST_SCALAR, num_3d_s
1780 CALL g_rk_update_scalar_pd( im, im, &
1781 scalar_old(ims,kms,jms,im),g_scalar_old(ims,kms,jms,im), &
1782 scalar_tend(ims,kms,jms,im),g_scalar_tend(ims,kms,jms,im),&
1783 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1784 rk_step, dt_rk, grid%spec_zone, &
1785 config_flags, &
1786 ids, ide, jds, jde, kds, kde, &
1787 ims, ime, jms, jme, kms, kme, &
1788 grid%i_start(ij), grid%i_end(ij), &
1789 grid%j_start(ij), grid%j_end(ij), &
1790 k_start , k_end )
1791 ENDDO
1792 ENDDO
1793 !$OMP END PARALLEL DO
1795 !---------------------- positive definite bc call
1796 #ifdef DM_PARALLEL
1797 IF (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) THEN
1798 #ifndef RSL
1799 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1800 # include "HALO_EM_SCALAR_OLD_E_5.inc"
1801 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1802 # include "HALO_EM_SCALAR_OLD_E_7.inc"
1803 ELSE
1804 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1805 CALL wrf_error_fatal(TRIM(wrf_err_message))
1806 ENDIF
1807 #else
1808 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1809 CALL wrf_error_fatal(TRIM(wrf_err_message))
1810 #endif
1811 endif
1812 #endif
1814 #ifdef DM_PARALLEL
1815 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1816 #endif
1817 !$OMP PARALLEL DO &
1818 !$OMP PRIVATE ( ij )
1820 DO ij = 1 , grid%num_tiles
1821 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
1822 DO im = PARAM_FIRST_SCALAR , num_3d_s
1823 CALL g_set_physical_bc3d( scalar_old(ims,kms,jms,im),g_scalar_old(ims,kms,jms,im), 'p', config_flags, &
1824 ids, ide, jds, jde, kds, kde, &
1825 ims, ime, jms, jme, kms, kme, &
1826 ips, ipe, jps, jpe, kps, kpe, &
1827 grid%i_start(ij), grid%i_end(ij), &
1828 grid%j_start(ij), grid%j_end(ij), &
1829 k_start , k_end )
1830 END DO
1831 ENDIF
1832 END DO
1833 !$OMP END PARALLEL DO
1835 END IF ! end if for scalar_adv_opt
1837 ! chem
1839 IF ((config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1841 !$OMP PARALLEL DO &
1842 !$OMP PRIVATE ( ij )
1843 DO ij = 1 , grid%num_tiles
1844 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd chem' )
1845 DO im = PARAM_FIRST_SCALAR, num_3d_c
1847 !!!!! REPLACE WITH g_rk_update_scalar_pd WHEN chem IS NEEDED. Ning Pan
1848 CALL rk_update_scalar_pd( im, im, &
1849 chem_old(ims,kms,jms,im), &
1850 chem_tend(ims,kms,jms,im), &
1851 grid%c1h, grid%c2h, &
1852 grid%mu_1, grid%mu_1, grid%mub, &
1853 rk_step, dt_rk, grid%spec_zone, &
1854 config_flags, &
1855 ids, ide, jds, jde, kds, kde, &
1856 ims, ime, jms, jme, kms, kme, &
1857 grid%i_start(ij), grid%i_end(ij), &
1858 grid%j_start(ij), grid%j_end(ij), &
1859 k_start , k_end )
1861 ENDDO
1862 END DO
1863 !$OMP END PARALLEL DO
1865 !---------------------- positive definite bc call
1866 #ifdef DM_PARALLEL
1867 IF (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) THEN
1868 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1869 # include "HALO_EM_CHEM_OLD_E_5.inc"
1870 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1871 # include "HALO_EM_CHEM_OLD_E_7.inc"
1872 ELSE
1873 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1874 CALL wrf_error_fatal(TRIM(wrf_err_message))
1875 ENDIF
1876 ENDIF
1877 #endif
1879 #ifdef DM_PARALLEL
1880 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
1881 #endif
1883 !$OMP PARALLEL DO &
1884 !$OMP PRIVATE ( ij )
1885 DO ij = 1 , grid%num_tiles
1886 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
1887 DO im = PARAM_FIRST_SCALAR , num_3d_c
1889 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
1890 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
1891 ids, ide, jds, jde, kds, kde, &
1892 ims, ime, jms, jme, kms, kme, &
1893 ips, ipe, jps, jpe, kps, kpe, &
1894 grid%i_start(ij), grid%i_end(ij), &
1895 grid%j_start(ij), grid%j_end(ij), &
1896 k_start , k_end )
1897 END DO
1899 ENDIF
1900 END DO
1901 !$OMP END PARALLEL DO
1903 ENDIF ! end if for chem_adv_opt
1905 ! tracer
1907 IF ((config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1909 !$OMP PARALLEL DO &
1910 !$OMP PRIVATE ( ij )
1911 DO ij = 1 , grid%num_tiles
1912 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd tracer' )
1913 DO im = PARAM_FIRST_SCALAR, num_tracer
1915 CALL g_rk_update_scalar_pd( im, im, &
1916 tracer_old(ims,kms,jms,im),g_tracer_old(ims,kms,jms,im), &
1917 tracer_tend(ims,kms,jms,im),g_tracer_tend(ims,kms,jms,im), &
1918 grid%mu_1, grid%g_mu_1, grid%mu_1, grid%g_mu_1, grid%mub, &
1919 rk_step, dt_rk, grid%spec_zone, &
1920 config_flags, &
1921 ids, ide, jds, jde, kds, kde, &
1922 ims, ime, jms, jme, kms, kme, &
1923 grid%i_start(ij), grid%i_end(ij), &
1924 grid%j_start(ij), grid%j_end(ij), &
1925 k_start , k_end )
1927 ENDDO
1928 END DO
1929 !$OMP END PARALLEL DO
1931 !---------------------- positive definite bc call
1932 #ifdef DM_PARALLEL
1933 IF (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) THEN
1934 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1935 # include "HALO_EM_TRACER_OLD_E_5_TL.inc"
1936 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1937 # include "HALO_EM_TRACER_OLD_E_7_TL.inc"
1938 ELSE
1939 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1940 CALL wrf_error_fatal(TRIM(wrf_err_message))
1941 ENDIF
1942 ENDIF
1943 #endif
1945 #ifdef DM_PARALLEL
1946 # include "PERIOD_BDY_EM_TRACER_OLD.inc"
1947 #endif
1949 !$OMP PARALLEL DO &
1950 !$OMP PRIVATE ( ij )
1951 DO ij = 1 , grid%num_tiles
1952 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
1953 DO im = PARAM_FIRST_SCALAR , num_tracer
1955 CALL g_set_physical_bc3d( tracer_old(ims,kms,jms,im), &
1956 g_tracer_old(ims,kms,jms,im), 'p', config_flags, &
1957 ids, ide, jds, jde, kds, kde, &
1958 ims, ime, jms, jme, kms, kme, &
1959 ips, ipe, jps, jpe, kps, kpe, &
1960 grid%i_start(ij), grid%i_end(ij), &
1961 grid%j_start(ij), grid%j_end(ij), &
1962 k_start , k_end )
1963 END DO
1965 ENDIF
1966 END DO
1967 !$OMP END PARALLEL DO
1969 ENDIF ! end if for tracer_adv_opt
1971 ! tke
1973 IF ((config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order) &
1974 .and. (config_flags%km_opt .eq. 2) ) THEN
1976 !$OMP PARALLEL DO &
1977 !$OMP PRIVATE ( ij )
1978 DO ij = 1 , grid%num_tiles
1979 CALL wrf_debug ( 200 , ' call g_rk_update_scalar_pd tke ' )
1980 CALL g_rk_update_scalar_pd( 1, 1, &
1981 grid%tke_1,grid%g_tke_1, &
1982 tke_tend(ims,kms,jms),g_tke_tend(ims,kms,jms), &
1983 grid%mu_1,grid%g_mu_1, grid%mu_1,grid%g_mu_1, grid%mub, &
1984 rk_step, dt_rk, grid%spec_zone, &
1985 config_flags, &
1986 ids, ide, jds, jde, kds, kde, &
1987 ims, ime, jms, jme, kms, kme, &
1988 grid%i_start(ij), grid%i_end(ij), &
1989 grid%j_start(ij), grid%j_end(ij), &
1990 k_start , k_end )
1991 ENDDO
1992 !$OMP END PARALLEL DO
1994 !---------------------- positive definite bc call
1995 #ifdef DM_PARALLEL
1996 IF (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) THEN
1997 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1998 # include "HALO_EM_TKE_OLD_E_5_TL.inc"
1999 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2000 # include "HALO_EM_TKE_OLD_E_7_TL.inc"
2001 ELSE
2002 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2003 CALL wrf_error_fatal(TRIM(wrf_err_message))
2004 ENDIF
2005 ENDIF
2006 #endif
2008 #ifdef DM_PARALLEL
2009 # include "PERIOD_BDY_EM_TKE_OLD.inc"
2010 #endif
2012 !$OMP PARALLEL DO &
2013 !$OMP PRIVATE ( ij )
2014 DO ij = 1 , grid%num_tiles
2015 CALL g_set_physical_bc3d( grid%tke_1,grid%g_tke_1, 'p', config_flags, &
2016 ids, ide, jds, jde, kds, kde, &
2017 ims, ime, jms, jme, kms, kme, &
2018 ips, ipe, jps, jpe, kps, kpe, &
2019 grid%i_start(ij), grid%i_end(ij), &
2020 grid%j_start(ij), grid%j_end(ij), &
2021 k_start , k_end )
2022 END DO
2023 !$OMP END PARALLEL DO
2025 !--- end of positive definite physics tendency update
2027 END IF ! end if for tke_adv_opt
2029 #ifdef DM_PARALLEL
2030 !
2031 ! Stencils for patch communications (WCS, 29 June 2001)
2032 !
2033 ! * * * * *
2034 ! * * * * *
2035 ! * * + * *
2036 ! * * * * *
2037 ! * * * * *
2038 !
2039 ! ru_m x
2040 ! rv_m x
2041 ! ww_m x
2042 ! mut x
2043 !
2044 !--------------------------------------------------------------
2046 # include "HALO_EM_D_TL.inc"
2047 ! WCS addition 11/19/08
2048 # include "PERIOD_EM_DA.inc"
2049 #endif
2051 !<DESCRIPTION>
2052 !<pre>
2053 ! (4) Still within the RK loop, the scalar variables are advanced.
2054 !
2055 ! For the moist and chem variables, each one is advanced
2056 ! individually, using named loops "moist_variable_loop:"
2057 ! and "chem_variable_loop:". Each RK substep begins by
2058 ! calculating the advective tendency, and, for the first RK step,
2059 ! 3D mixing (calling rk_scalar_tend) followed by an update
2060 ! of the scalar (calling rk_update_scalar).
2061 !</pre>
2062 !</DESCRIPTION>
2065 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2067 moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
2069 ! adv_moist_cond is set in module_physics_init based on mp_physics choice
2070 ! true except for Ferrier scheme
2072 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
2074 !$OMP PARALLEL DO &
2075 !$OMP PRIVATE ( ij, tenddec )
2076 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
2078 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend moist' )
2079 tenddec = .false.
2081 BENCH_START(g_rk_scalar_tend_tim)
2082 CALL g_rk_scalar_tend ( im, im, config_flags, tenddec, &
2083 rk_step, dt_rk, &
2084 grid%ru_m, grid%g_ru_m, &
2085 grid%rv_m, grid%g_rv_m, &
2086 grid%ww_m, grid%g_ww_m, &
2087 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2088 grid%alt, grid%g_alt, &
2089 moist_old(ims,kms,jms,im), g_moist_old(ims,kms,jms,im), &
2090 moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2091 moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2092 advect_tend, g_advect_tend, h_tendency, g_h_tendency, &
2093 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2094 grid%qv_base, .true., grid%fnm, grid%fnp, &
2095 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
2096 grid%msfvy, grid%msftx,grid%msfty, &
2097 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2098 grid%kvdif, grid%xkhh,grid%g_xkhh, &
2099 grid%diff_6th_opt, grid%diff_6th_factor, &
2100 config_flags%moist_adv_opt, &
2101 ids, ide, jds, jde, kds, kde, &
2102 ims, ime, jms, jme, kms, kme, &
2103 grid%i_start(ij), grid%i_end(ij), &
2104 grid%j_start(ij), grid%j_end(ij), &
2105 k_start , k_end )
2107 ! IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
2108 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2109 ! CALL g_q_diabatic_add ( im, im, &
2110 ! dt_rk, grid%mut, grid%g_mut, &
2111 ! grid%qv_diabatic, grid%g_qv_diabatic, &
2112 ! grid%qc_diabatic, grid%g_qc_diabatic, &
2113 ! moist_tend(ims,kms,jms,im), &
2114 ! g_moist_tend(ims,kms,jms,im), &
2115 ! ids, ide, jds, jde, kds, kde, &
2116 ! ims, ime, jms, jme, kms, kme, &
2117 ! grid%i_start(ij), grid%i_end(ij), &
2118 ! grid%j_start(ij), grid%j_end(ij), &
2119 ! k_start , k_end )
2120 ! ENDIF
2121 ! ENDIF
2123 BENCH_END(g_rk_scalar_tend_tim)
2125 BENCH_START(g_rlx_bdy_scalar_tim)
2126 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
2127 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
2128 CALL g_relax_bdy_scalar ( moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2129 moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2130 grid%mut, grid%g_mut, &
2131 moist_bxs(jms,kms,1,im),g_moist_bxs(jms,kms,1,im), &
2132 moist_bxe(jms,kms,1,im),g_moist_bxe(jms,kms,1,im), &
2133 moist_bys(ims,kms,1,im),g_moist_bys(ims,kms,1,im), &
2134 moist_bye(ims,kms,1,im),g_moist_bye(ims,kms,1,im), &
2135 moist_btxs(jms,kms,1,im),g_moist_btxs(jms,kms,1,im), &
2136 moist_btxe(jms,kms,1,im),g_moist_btxe(jms,kms,1,im), &
2137 moist_btys(ims,kms,1,im),g_moist_btys(ims,kms,1,im), &
2138 moist_btye(ims,kms,1,im),g_moist_btye(ims,kms,1,im), &
2139 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2140 grid%dtbc, grid%fcx, grid%gcx, &
2141 config_flags, &
2142 ids,ide, jds,jde, kds,kde, & ! domain dims
2143 ims,ime, jms,jme, kms,kme, & ! memory dims
2144 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2145 grid%i_start(ij), grid%i_end(ij), &
2146 grid%j_start(ij), grid%j_end(ij), &
2147 k_start, k_end )
2149 CALL g_spec_bdy_scalar ( moist_tend(ims,kms,jms,im), g_moist_tend(ims,kms,jms,im), &
2150 moist_bxs(jms,kms,1,im),g_moist_bxs(jms,kms,1,im), &
2151 moist_bxe(jms,kms,1,im),g_moist_bxe(jms,kms,1,im), &
2152 moist_bys(ims,kms,1,im),g_moist_bys(ims,kms,1,im), &
2153 moist_bye(ims,kms,1,im),g_moist_bye(ims,kms,1,im), &
2154 moist_btxs(jms,kms,1,im),g_moist_btxs(jms,kms,1,im), &
2155 moist_btxe(jms,kms,1,im),g_moist_btxe(jms,kms,1,im), &
2156 moist_btys(ims,kms,1,im),g_moist_btys(ims,kms,1,im), &
2157 moist_btye(ims,kms,1,im),g_moist_btye(ims,kms,1,im), &
2158 config_flags%spec_bdy_width, grid%spec_zone, &
2159 config_flags, &
2160 ids,ide, jds,jde, kds,kde, & ! domain dims
2161 ims,ime, jms,jme, kms,kme, & ! memory dims
2162 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2163 grid%i_start(ij), grid%i_end(ij), &
2164 grid%j_start(ij), grid%j_end(ij), &
2165 k_start, k_end )
2167 ENDIF
2168 ENDIF
2169 BENCH_END(g_rlx_bdy_scalar_tim)
2171 ENDDO moist_tile_loop_1
2172 !$OMP END PARALLEL DO
2174 !$OMP PARALLEL DO &
2175 !$OMP PRIVATE ( ij, tenddec )
2176 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2178 CALL wrf_debug ( 200 , ' call g_rk_update_scalar' )
2179 tenddec = .false.
2181 BENCH_START(g_update_scal_tim)
2182 CALL g_rk_update_scalar( scs=im, sce=im, &
2183 scalar_1=moist_old(ims,kms,jms,im), &
2184 g_scalar_1=g_moist_old(ims,kms,jms,im), &
2185 scalar_2=moist(ims,kms,jms,im), &
2186 g_scalar_2=g_moist(ims,kms,jms,im), &
2187 sc_tend=moist_tend(ims,kms,jms,im), &
2188 g_sc_tend=g_moist_tend(ims,kms,jms,im), &
2189 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2190 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2191 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2192 msftx=grid%msftx,msfty=grid%msfty, &
2193 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2194 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2195 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2196 config_flags=config_flags, tenddec=tenddec, &
2197 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2198 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2199 its=grid%i_start(ij), ite=grid%i_end(ij), &
2200 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2201 kts=k_start , kte=k_end )
2203 ! IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
2204 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2205 ! CALL g_q_diabatic_subtr( im, im, &
2206 ! dt_rk, &
2207 ! grid%qv_diabatic, grid%g_qv_diabatic, &
2208 ! grid%qc_diabatic, grid%g_qc_diabatic, &
2209 ! moist(ims,kms,jms,im), &
2210 ! g_moist(ims,kms,jms,im), &
2211 ! ids, ide, jds, jde, kds, kde, &
2212 ! ims, ime, jms, jme, kms, kme, &
2213 ! grid%i_start(ij), grid%i_end(ij), &
2214 ! grid%j_start(ij), grid%j_end(ij), &
2215 ! k_start , k_end )
2216 ! ENDIF
2217 ! ENDIF
2219 BENCH_END(g_update_scal_tim)
2221 BENCH_START(g_flow_depbdy_tim)
2222 IF( config_flags%specified ) THEN
2223 IF(im .ne. P_QV)THEN
2224 CALL g_flow_dep_bdy ( moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
2225 grid%ru_m, grid%rv_m, config_flags, &
2226 grid%spec_zone, &
2227 ids,ide, jds,jde, kds,kde, &
2228 ims,ime, jms,jme, kms,kme, &
2229 ips,ipe, jps,jpe, kps,kpe, &
2230 grid%i_start(ij), grid%i_end(ij), &
2231 grid%j_start(ij), grid%j_end(ij), &
2232 k_start, k_end )
2234 ENDIF
2235 ENDIF
2236 BENCH_END(g_flow_depbdy_tim)
2238 ENDDO moist_tile_loop_2
2239 !$OMP END PARALLEL DO
2241 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2243 ENDDO moist_variable_loop
2245 ENDIF moist_scalar_advance
2247 BENCH_START(g_tke_adv_tim)
2248 TKE_advance: IF (config_flags%km_opt .eq. 2) then
2249 #ifdef DM_PARALLEL
2250 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2251 # include "HALO_EM_TKE_ADVECT_3_TL.inc"
2252 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2253 # include "HALO_EM_TKE_ADVECT_5_TL.inc"
2254 ELSE
2255 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2256 CALL wrf_error_fatal(TRIM(wrf_err_message))
2257 ENDIF
2258 #endif
2259 !$OMP PARALLEL DO &
2260 !$OMP PRIVATE ( ij, tenddec )
2261 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2263 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend for tke' )
2265 tenddec = .false.
2266 CALL g_rk_scalar_tend ( 1, 1, config_flags, tenddec, &
2267 rk_step, dt_rk, &
2268 grid%ru_m,grid%g_ru_m, grid%rv_m,grid%g_rv_m, grid%ww_m,grid%g_ww_m, &
2269 grid%muts,grid%g_muts, grid%mub, grid%mu_1,grid%g_mu_1, &
2270 grid%alt,grid%g_alt, &
2271 grid%tke_1,grid%g_tke_1, &
2272 grid%tke_2,grid%g_tke_2, &
2273 tke_tend(ims,kms,jms),g_tke_tend(ims,kms,jms), &
2274 advect_tend,g_advect_tend,h_tendency,g_h_tendency, &
2275 z_tendency,g_z_tendency,grid%rqvften,grid%g_rqvften, &
2276 grid%qv_base, .false., grid%fnm, grid%fnp, &
2277 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2278 grid%msfvy, grid%msftx,grid%msfty, &
2279 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2280 grid%kvdif, grid%xkhh,grid%g_xkhh, &
2281 grid%diff_6th_opt, grid%diff_6th_factor, &
2282 config_flags%tke_adv_opt, &
2283 ids, ide, jds, jde, kds, kde, &
2284 ims, ime, jms, jme, kms, kme, &
2285 grid%i_start(ij), grid%i_end(ij), &
2286 grid%j_start(ij), grid%j_end(ij), &
2287 k_start , k_end )
2289 ENDDO tke_tile_loop_1
2290 !$OMP END PARALLEL DO
2292 !$OMP PARALLEL DO &
2293 !$OMP PRIVATE ( ij, tenddec )
2294 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2296 CALL wrf_debug ( 200 , ' call g_rk_update_scalar tke' )
2298 tenddec = .false.
2299 CALL g_rk_update_scalar( scs=1, sce=1, &
2300 scalar_1=grid%tke_1, g_scalar_1=grid%g_tke_1, &
2301 scalar_2=grid%tke_2, g_scalar_2=grid%g_tke_2, &
2302 sc_tend=tke_tend(ims,kms,jms), &
2303 g_sc_tend=g_tke_tend(ims,kms,jms), &
2304 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2305 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2306 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2307 msftx=grid%msftx,msfty=grid%msfty, &
2308 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2309 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2310 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2311 config_flags=config_flags, tenddec=tenddec, &
2312 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2313 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2314 its=grid%i_start(ij), ite=grid%i_end(ij), &
2315 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2316 kts=k_start , kte=k_end )
2318 ! bound the tke (greater than 0, less than tke_upper_bound)
2320 CALL g_bound_tke( grid%tke_2, grid%g_tke_2, grid%tke_upper_bound, &
2321 ids, ide, jds, jde, kds, kde, &
2322 ims, ime, jms, jme, kms, kme, &
2323 grid%i_start(ij), grid%i_end(ij), &
2324 grid%j_start(ij), grid%j_end(ij), &
2325 k_start , k_end )
2327 IF( config_flags%specified .or. config_flags%nested ) THEN
2328 CALL g_flow_dep_bdy ( grid%tke_2,grid%g_tke_2, &
2329 grid%ru_m, grid%rv_m, config_flags, &
2330 grid%spec_zone, &
2331 ids,ide, jds,jde, kds,kde, & ! domain dims
2332 ims,ime, jms,jme, kms,kme, & ! memory dims
2333 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2334 grid%i_start(ij), grid%i_end(ij), &
2335 grid%j_start(ij), grid%j_end(ij), &
2336 k_start, k_end )
2338 ENDIF
2339 ENDDO tke_tile_loop_2
2340 !$OMP END PARALLEL DO
2342 ENDIF TKE_advance
2343 BENCH_END(g_tke_adv_tim)
2345 #if (WRF_CHEM==1)
2346 ! next the chemical species
2347 BENCH_START(g_chem_adv_tim)
2348 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2350 chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
2352 !$OMP PARALLEL DO &
2353 !$OMP PRIVATE ( ij, tenddec )
2354 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2356 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend in chem_tile_loop_1' )
2358 !!!!! REPLACE WITH g_rk_scalar_tend WHEN chem IS NEEDED. Ning Pan
2359 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2360 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2361 CALL rk_scalar_tend ( ic, ic, config_flags,tenddec, &
2362 rk_step, dt_rk, &
2363 grid%ru_m, grid%rv_m, grid%ww_m, &
2364 grid%muts, grid%mub, grid%mu_1, &
2365 grid%alt, &
2366 chem_old(ims,kms,jms,ic), &
2367 chem(ims,kms,jms,ic), &
2368 chem_tend(ims,kms,jms,ic), &
2369 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2370 grid%qv_base, .false., grid%fnm, grid%fnp, &
2371 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2372 grid%msfvy, grid%msftx,grid%msfty, &
2373 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2374 grid%khdif, grid%kvdif, grid%xkhh, &
2375 grid%diff_6th_opt, grid%diff_6th_factor, &
2376 config_flags%chem_adv_opt, &
2377 ids, ide, jds, jde, kds, kde, &
2378 ims, ime, jms, jme, kms, kme, &
2379 grid%i_start(ij), grid%i_end(ij), &
2380 grid%j_start(ij), grid%j_end(ij), &
2381 k_start , k_end )
2384 !
2385 ! Currently, chemistry species with specified boundaries (i.e. the mother
2386 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2387 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2388 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2389 !
2390 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2391 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2393 !!!!! REPLACE WITH g_relax_bdy_scalar WHEN chem IS NEEDED. Ning Pan
2394 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2395 chem(ims,kms,jms,ic), grid%mut, &
2396 grid%c1h, grid%c2h, &
2397 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2398 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2399 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2400 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2401 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2402 grid%dtbc, grid%fcx, grid%gcx, &
2403 config_flags, &
2404 ids,ide, jds,jde, kds,kde, &
2405 ims,ime, jms,jme, kms,kme, &
2406 ips,ipe, jps,jpe, kps,kpe, &
2407 grid%i_start(ij), grid%i_end(ij), &
2408 grid%j_start(ij), grid%j_end(ij), &
2409 k_start, k_end )
2411 !!!!! REPLACE WITH g_spec_bdy_scalar WHEN chem IS NEEDED. Ning Pan
2412 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2413 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2414 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2415 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2416 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2417 config_flags%spec_bdy_width, grid%spec_zone, &
2418 config_flags, &
2419 ids,ide, jds,jde, kds,kde, &
2420 ims,ime, jms,jme, kms,kme, &
2421 ips,ipe, jps,jpe, kps,kpe, &
2422 grid%i_start(ij), grid%i_end(ij), &
2423 grid%j_start(ij), grid%j_end(ij), &
2424 k_start, k_end )
2426 ENDIF
2428 ENDDO chem_tile_loop_1
2429 !$OMP END PARALLEL DO
2431 !$OMP PARALLEL DO &
2432 !$OMP PRIVATE ( ij, tenddec )
2434 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2436 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2438 !!!!! REPLACE WITH g_rk_update_scalar WHEN chem IS NEEDED. Ning Pan
2439 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2440 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2441 CALL rk_update_scalar( scs=ic, sce=ic, &
2442 scalar_1=chem_old(ims,kms,jms,ic), &
2443 scalar_2=chem(ims,kms,jms,ic), &
2444 sc_tend=chem_tend(ims,kms,jms,ic), &
2445 advect_tend=advect_tend, &
2446 h_tendency=h_tendency, z_tendency=z_tendency, &
2447 msftx=grid%msftx,msfty=grid%msfty, &
2448 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2449 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2450 config_flags=config_flags, tenddec=tenddec, &
2451 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2452 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2453 its=grid%i_start(ij), ite=grid%i_end(ij), &
2454 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2455 kts=k_start , kte=k_end )
2457 IF( config_flags%specified ) THEN
2459 !!!!! REPLACE WITH g_flow_dep_bdy_chem WHEN chem IS NEEDED. Ning Pan
2460 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2461 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2462 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2463 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2464 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2465 dt_rk+grid%dtbc, &
2466 config_flags%spec_bdy_width,grid%z, &
2467 grid%have_bcs_chem, &
2468 grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2469 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2470 grid%spec_zone,ic, &
2471 ids,ide, jds,jde, kds,kde, & ! domain dims
2472 ims,ime, jms,jme, kms,kme, & ! memory dims
2473 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2474 grid%i_start(ij), grid%i_end(ij), &
2475 grid%j_start(ij), grid%j_end(ij), &
2476 k_start, k_end )
2478 ENDIF
2479 ENDDO chem_tile_loop_2
2480 !$OMP END PARALLEL DO
2482 ENDDO chem_variable_loop
2483 ENDIF chem_scalar_advance
2484 BENCH_END(g_chem_adv_tim)
2485 #endif
2486 ! next the chemical species
2487 BENCH_START(g_tracer_adv_tim)
2488 tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2490 tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
2492 !$OMP PARALLEL DO &
2493 !$OMP PRIVATE ( ij, tenddec )
2494 tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
2496 CALL wrf_debug ( 15 , ' call g_rk_scalar_tend in tracer_tile_loop_1' )
2498 tenddec = .false.
2499 CALL g_rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2500 rk_step, dt_rk, &
2501 grid%ru_m, grid%g_ru_m, &
2502 grid%rv_m, grid%g_rv_m, &
2503 grid%ww_m, grid%g_ww_m, &
2504 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2505 grid%alt, grid%g_alt, &
2506 tracer_old(ims,kms,jms,ic), g_tracer_old(ims,kms,jms,ic), &
2507 tracer(ims,kms,jms,ic), g_tracer(ims,kms,jms,ic), &
2508 tracer_tend(ims,kms,jms,ic), g_tracer_tend(ims,kms,jms,ic), &
2509 advect_tend, g_advect_tend, h_tendency,g_h_tendency, &
2510 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2511 grid%qv_base, .false., grid%fnm, grid%fnp, &
2512 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2513 grid%msfvy, grid%msftx,grid%msfty, &
2514 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2515 grid%khdif, grid%kvdif, grid%xkhh,grid%g_xkhh, &
2516 grid%diff_6th_opt, grid%diff_6th_factor, &
2517 config_flags%tracer_adv_opt, &
2518 ids, ide, jds, jde, kds, kde, &
2519 ims, ime, jms, jme, kms, kme, &
2520 grid%i_start(ij), grid%i_end(ij), &
2521 grid%j_start(ij), grid%j_end(ij), &
2522 k_start , k_end )
2524 !
2525 ! Currently, chemistry species with specified boundaries (i.e. the mother
2526 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2527 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2528 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2529 !
2530 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2531 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
2533 !!!!! REPLACE WITH g_relax_bdy_scalar WHEN tracer IS NEEDED. Ning Pan
2534 CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2535 tracer(ims,kms,jms,ic), grid%mut, &
2536 grid%c1h, grid%c2h, &
2537 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2538 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2539 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2540 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2541 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2542 grid%dtbc, grid%fcx, grid%gcx, &
2543 config_flags, &
2544 ids,ide, jds,jde, kds,kde, &
2545 ims,ime, jms,jme, kms,kme, &
2546 ips,ipe, jps,jpe, kps,kpe, &
2547 grid%i_start(ij), grid%i_end(ij), &
2548 grid%j_start(ij), grid%j_end(ij), &
2549 k_start, k_end )
2551 !!!!! REPLACE WITH g_spec_bdy_scalar WHEN tracer IS NEEDED. Ning Pan
2552 CALL spec_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2553 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2554 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2555 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2556 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2557 config_flags%spec_bdy_width, grid%spec_zone, &
2558 config_flags, &
2559 ids,ide, jds,jde, kds,kde, &
2560 ims,ime, jms,jme, kms,kme, &
2561 ips,ipe, jps,jpe, kps,kpe, &
2562 grid%i_start(ij), grid%i_end(ij), &
2563 grid%j_start(ij), grid%j_end(ij), &
2564 k_start, k_end )
2566 ENDIF
2568 ENDDO tracer_tile_loop_1
2569 !$OMP END PARALLEL DO
2571 !$OMP PARALLEL DO &
2572 !$OMP PRIVATE ( ij, tenddec )
2574 tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
2576 CALL wrf_debug ( 200 , ' call g_rk_update_scalar tracer ' )
2578 tenddec = .false.
2579 CALL g_rk_update_scalar( scs=ic, sce=ic, &
2580 scalar_1=tracer_old(ims,kms,jms,ic), &
2581 g_scalar_1=g_tracer_old(ims,kms,jms,ic), &
2582 scalar_2=tracer(ims,kms,jms,ic), &
2583 g_scalar_2=g_tracer(ims,kms,jms,ic), &
2584 sc_tend=tracer_tend(ims,kms,jms,ic), &
2585 g_sc_tend=g_tracer_tend(ims,kms,jms,ic), &
2586 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2587 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2588 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2589 msftx=grid%msftx,msfty=grid%msfty, &
2590 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2591 mu_new=grid%mu_2, g_mu_new=grid%g_mu_2, mu_base=grid%mub, &
2592 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2593 config_flags=config_flags, tenddec=tenddec, &
2594 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2595 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2596 its=grid%i_start(ij), ite=grid%i_end(ij), &
2597 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2598 kts=k_start , kte=k_end )
2600 IF( config_flags%specified ) THEN
2601 #if (WRF_CHEM==1)
2603 !!!!! REPLACE WITH a_flow_dep_bdy_tracer WHEN tracer IS NEEDED. Ning Pan
2604 CALL flow_dep_bdy_tracer( tracer(ims,kms,jms,ic), &
2605 tracer_bxs(jms,kms,1,ic), tracer_btxs(jms,kms,1,ic), &
2606 tracer_bxe(jms,kms,1,ic), tracer_btxe(jms,kms,1,ic), &
2607 tracer_bys(ims,kms,1,ic), tracer_btys(ims,kms,1,ic), &
2608 tracer_bye(ims,kms,1,ic), tracer_btye(ims,kms,1,ic), &
2609 dt_rk+grid%dtbc, &
2610 config_flags%spec_bdy_width,grid%z, &
2611 grid%have_bcs_tracer, &
2612 grid%ru_m, grid%rv_m, config_flags%tracer_opt,grid%alt, &
2613 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2614 grid%spec_zone,ic, &
2615 ids,ide, jds,jde, kds,kde, & ! domain dims
2616 ims,ime, jms,jme, kms,kme, & ! memory dims
2617 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2618 grid%i_start(ij), grid%i_end(ij), &
2619 grid%j_start(ij), grid%j_end(ij), &
2620 k_start, k_end )
2622 #else
2623 CALL g_flow_dep_bdy ( tracer(ims,kms,jms,ic),g_tracer(ims,kms,jms,ic), &
2624 grid%ru_m, grid%rv_m, config_flags, &
2625 grid%spec_zone, &
2626 ids,ide, jds,jde, kds,kde, & ! domain dims
2627 ims,ime, jms,jme, kms,kme, & ! memory dims
2628 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2629 grid%i_start(ij), grid%i_end(ij), &
2630 grid%j_start(ij), grid%j_end(ij), &
2631 k_start, k_end )
2632 #endif
2633 ENDIF
2634 ENDDO tracer_tile_loop_2
2635 !$OMP END PARALLEL DO
2637 ENDDO tracer_variable_loop
2638 ENDIF tracer_advance
2639 BENCH_END(g_tracer_adv_tim)
2641 ! next the other scalar species
2642 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2644 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2645 !$OMP PARALLEL DO &
2646 !$OMP PRIVATE ( ij, tenddec )
2647 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2649 CALL wrf_debug ( 200 , ' call g_rk_scalar_tend scalar' )
2651 tenddec = .false.
2652 CALL g_rk_scalar_tend ( is, is, config_flags, tenddec, &
2653 rk_step, dt_rk, &
2654 grid%ru_m, grid%g_ru_m, &
2655 grid%rv_m, grid%g_rv_m, &
2656 grid%ww_m, grid%g_ww_m, &
2657 grid%muts, grid%g_muts, grid%mub, grid%mu_1, grid%g_mu_1, &
2658 grid%alt, grid%g_alt, &
2659 scalar_old(ims,kms,jms,is), g_scalar_old(ims,kms,jms,is), &
2660 scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2661 scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2662 advect_tend, g_advect_tend, h_tendency,g_h_tendency, &
2663 z_tendency, g_z_tendency, grid%rqvften, grid%g_rqvften, &
2664 grid%qv_base, .false., grid%fnm, grid%fnp, &
2665 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2666 grid%msfvy, grid%msftx,grid%msfty, &
2667 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2668 grid%khdif, grid%kvdif, grid%xkhh,grid%g_xkhh, &
2669 grid%diff_6th_opt, grid%diff_6th_factor, &
2670 config_flags%scalar_adv_opt, &
2671 ids, ide, jds, jde, kds, kde, &
2672 ims, ime, jms, jme, kms, kme, &
2673 grid%i_start(ij), grid%i_end(ij), &
2674 grid%j_start(ij), grid%j_end(ij), &
2675 k_start , k_end )
2677 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2679 CALL g_relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2680 scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2681 grid%mut, grid%g_mut, &
2682 scalar_bxs(jms,kms,1,is),g_scalar_bxs(jms,kms,1,is), &
2683 scalar_bxe(jms,kms,1,is),g_scalar_bxe(jms,kms,1,is), &
2684 scalar_bys(ims,kms,1,is),g_scalar_bys(ims,kms,1,is), &
2685 scalar_bye(ims,kms,1,is),g_scalar_bye(ims,kms,1,is), &
2686 scalar_btxs(jms,kms,1,is),g_scalar_btxs(jms,kms,1,is), &
2687 scalar_btxe(jms,kms,1,is),g_scalar_btxe(jms,kms,1,is), &
2688 scalar_btys(ims,kms,1,is),g_scalar_btys(ims,kms,1,is), &
2689 scalar_btye(ims,kms,1,is),g_scalar_btye(ims,kms,1,is), &
2690 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2691 grid%dtbc, grid%fcx, grid%gcx, &
2692 config_flags, &
2693 ids,ide, jds,jde, kds,kde, &
2694 ims,ime, jms,jme, kms,kme, &
2695 ips,ipe, jps,jpe, kps,kpe, &
2696 grid%i_start(ij), grid%i_end(ij), &
2697 grid%j_start(ij), grid%j_end(ij), &
2698 k_start, k_end )
2700 CALL g_spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), g_scalar_tend(ims,kms,jms,is), &
2701 scalar_bxs(jms,kms,1,is),g_scalar_bxs(jms,kms,1,is), &
2702 scalar_bxe(jms,kms,1,is),g_scalar_bxe(jms,kms,1,is), &
2703 scalar_bys(ims,kms,1,is),g_scalar_bys(ims,kms,1,is), &
2704 scalar_bye(ims,kms,1,is),g_scalar_bye(ims,kms,1,is), &
2705 scalar_btxs(jms,kms,1,is),g_scalar_btxs(jms,kms,1,is), &
2706 scalar_btxe(jms,kms,1,is),g_scalar_btxe(jms,kms,1,is), &
2707 scalar_btys(ims,kms,1,is),g_scalar_btys(ims,kms,1,is), &
2708 scalar_btye(ims,kms,1,is),g_scalar_btye(ims,kms,1,is), &
2709 config_flags%spec_bdy_width, grid%spec_zone, &
2710 config_flags, &
2711 ids,ide, jds,jde, kds,kde, &
2712 ims,ime, jms,jme, kms,kme, &
2713 ips,ipe, jps,jpe, kps,kpe, &
2714 grid%i_start(ij), grid%i_end(ij), &
2715 grid%j_start(ij), grid%j_end(ij), &
2716 k_start, k_end )
2719 ENDIF ! b.c test for chem nested boundary condition
2721 ENDDO scalar_tile_loop_1
2722 !$OMP END PARALLEL DO
2724 !$OMP PARALLEL DO &
2725 !$OMP PRIVATE ( ij, tenddec )
2726 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2728 CALL wrf_debug ( 200 , ' call g_rk_update_scalar scalar' )
2730 tenddec = .false.
2731 CALL g_rk_update_scalar( scs=is, sce=is, &
2732 scalar_1=scalar_old(ims,kms,jms,is), &
2733 g_scalar_1=g_scalar_old(ims,kms,jms,is), &
2734 scalar_2=scalar(ims,kms,jms,is), &
2735 g_scalar_2=g_scalar(ims,kms,jms,is), &
2736 sc_tend=scalar_tend(ims,kms,jms,is), &
2737 g_sc_tend=g_scalar_tend(ims,kms,jms,is), &
2738 advect_tend=advect_tend,g_advect_tend=g_advect_tend, &
2739 h_tendency=h_tendency, g_h_tendency=g_h_tendency, &
2740 z_tendency=z_tendency, g_z_tendency=g_z_tendency, &
2741 msftx=grid%msftx,msfty=grid%msfty, &
2742 mu_old=grid%mu_1, g_mu_old=grid%g_mu_1, &
2743 mu_new=grid%mu_2,g_mu_new=grid%g_mu_2,mu_base=grid%mub, &
2744 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2745 config_flags=config_flags, tenddec=tenddec, &
2746 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2747 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2748 its=grid%i_start(ij), ite=grid%i_end(ij), &
2749 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2750 kts=k_start , kte=k_end )
2752 IF( config_flags%specified ) THEN
2753 IF (is.EQ.P_QDCN.OR.is.EQ.P_QTCN.OR.is.EQ.P_QNIN) THEN ! for ntu3m
2754 CALL g_flow_dep_bdy_fixed_inflow(scalar(ims,kms,jms,is),&
2755 g_scalar(ims,kms,jms,is), &
2756 grid%ru_m,grid%rv_m, &
2757 config_flags,grid%spec_zone, &
2758 ids,ide,jds,jde,kds,kde,ims, &
2759 ime,jms,jme,kms,kme,ips,ipe, &
2760 jps,jpe,kps,kpe, &
2761 grid%i_start(ij), &
2762 grid%i_end(ij), &
2763 grid%j_start(ij), &
2764 grid%j_end(ij), &
2765 k_start,k_end)
2766 ELSEIF (is.EQ.P_QNN) THEN
2767 CALL g_flow_dep_bdy_qnn(scalar(ims,kms,jms,is), &
2768 g_scalar(ims,kms,jms,is), &
2769 grid%ru_m,grid%rv_m, &
2770 config_flags,grid%spec_zone, &
2771 grid%ccn_conc,ids,ide,jds,jde,&
2772 kds,kde,ims,ime,jms,jme,kms, &
2773 kme,ips,ipe,jps,jpe,kps,kpe, &
2774 grid%i_start(ij), &
2775 grid%i_end(ij), &
2776 grid%j_start(ij), &
2777 grid%j_end(ij),k_start,k_end)
2778 ELSE
2779 CALL g_flow_dep_bdy(scalar(ims,kms,jms,is), &
2780 g_scalar(ims,kms,jms,is), &
2781 grid%ru_m,grid%rv_m,config_flags, &
2782 grid%spec_zone,ids,ide,jds,jde, &
2783 kds,kde,ims,ime,jms,jme,kms,kme, &
2784 ips,ipe,jps,jpe,kps,kpe, &
2785 grid%i_start(ij),grid%i_end(ij), &
2786 grid%j_start(ij),grid%j_end(ij), &
2787 k_start,k_end) ! for ntu3m
2788 ! IF(is .ne. P_QNN)THEN ! for ntu3m
2789 ! CALL g_flow_dep_bdy ( scalar(ims,kms,jms,is),g_scalar(ims,kms,jms,is), &
2790 ! grid%ru_m, grid%rv_m, config_flags, &
2791 ! grid%spec_zone, &
2792 ! ids,ide, jds,jde, kds,kde, & ! domain dims
2793 ! ims,ime, jms,jme, kms,kme, & ! memory dims
2794 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2795 ! grid%i_start(ij), grid%i_end(ij), &
2796 ! grid%j_start(ij), grid%j_end(ij), &
2797 ! k_start, k_end )
2798 ! ELSE
2799 ! CALL g_flow_dep_bdy_qnn ( scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
2800 ! grid%ru_m, grid%rv_m, config_flags, &
2801 ! grid%spec_zone, &
2802 ! grid%ccn_conc, & ! RAS
2803 ! ids,ide, jds,jde, kds,kde, & ! domain dims
2804 ! ims,ime, jms,jme, kms,kme, & ! memory dims
2805 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2806 ! grid%i_start(ij), grid%i_end(ij), &
2807 ! grid%j_start(ij), grid%j_end(ij), &
2808 ! k_start, k_end ) ! for ntu3m
2809 ENDIF
2811 ENDIF
2813 ENDDO scalar_tile_loop_2
2814 !$OMP END PARALLEL DO
2816 ENDDO scalar_variable_loop
2818 ENDIF other_scalar_advance
2820 ! update the pressure and density at the new time level
2822 !$OMP PARALLEL DO &
2823 !$OMP PRIVATE ( ij )
2824 DO ij = 1 , grid%num_tiles
2826 BENCH_START(g_calc_p_rho_tim)
2828 CALL g_calc_p_rho_phi( moist,g_moist, num_3d_m, config_flags%hypsometric_opt, &
2829 grid%al,grid%g_al, grid%alb, grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, &
2830 grid%ph_2,grid%g_ph_2, grid%phb, grid%p, grid%g_p, grid%pb, grid%t_2,grid%g_t_2, &
2831 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
2832 grid%rdn, config_flags%non_hydrostatic, &
2833 ids, ide, jds, jde, kds, kde, &
2834 ims, ime, jms, jme, kms, kme, &
2835 grid%i_start(ij), grid%i_end(ij), &
2836 grid%j_start(ij), grid%j_end(ij), &
2837 k_start , k_end )
2839 BENCH_END(g_calc_p_rho_tim)
2841 ENDDO
2842 !$OMP END PARALLEL DO
2844 ! Reset the boundary conditions if there is another corrector step.
2845 ! (rk_step < rk_order), else we'll handle it at the end of everything
2846 ! (after the split physics, before exiting the timestep).
2848 rk_step_1_check: IF ( rk_step < rk_order ) THEN
2850 !-----------------------------------------------------------
2851 ! rk3 substep polar filter for scalars (moist,chem,scalar)
2852 !-----------------------------------------------------------
2854 IF (config_flags%polar) THEN
2855 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2856 CALL wrf_debug ( 200 , ' call filter moist ' )
2857 DO im = PARAM_FIRST_SCALAR, num_3d_m
2858 IF ( config_flags%coupled_filtering ) THEN
2859 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2860 ,MU=grid%mu_2 , MUB=grid%mub &
2861 ,C1=grid%c1h , C2=grid%c2h &
2862 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2863 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2864 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2865 END IF
2866 CALL pxft ( grid=grid &
2867 ,lineno=__LINE__ &
2868 ,flag_uv = 0 &
2869 ,flag_rurv = 0 &
2870 ,flag_wph = 0 &
2871 ,flag_ww = 0 &
2872 ,flag_t = 0 &
2873 ,flag_mu = 0 &
2874 ,flag_mut = 0 &
2875 ,flag_moist = im &
2876 ,flag_chem = 0 &
2877 ,flag_scalar = 0 &
2878 ,flag_tracer = 0 &
2879 ,actual_distance_average=config_flags%actual_distance_average&
2880 ,pos_def = config_flags%pos_def &
2881 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2882 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2883 ,fft_filter_lat = config_flags%fft_filter_lat &
2884 ,dclat = dclat &
2885 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2886 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2887 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2888 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2889 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2890 IF ( config_flags%coupled_filtering ) THEN
2891 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2892 ,MU=grid%mu_2 , MUB=grid%mub &
2893 ,C1=grid%c1h , C2=grid%c2h &
2894 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2895 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2896 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2897 END IF
2898 END DO
2899 END IF
2901 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
2902 CALL wrf_debug ( 200 , ' call filter chem ' )
2903 DO im = PARAM_FIRST_SCALAR, num_3d_c
2904 IF ( config_flags%coupled_filtering ) THEN
2905 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2906 ,MU=grid%mu_2 , MUB=grid%mub &
2907 ,C1=grid%c1h , C2=grid%c2h &
2908 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2909 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2910 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2911 END IF
2912 CALL pxft ( grid=grid &
2913 ,lineno=__LINE__ &
2914 ,flag_uv = 0 &
2915 ,flag_rurv = 0 &
2916 ,flag_wph = 0 &
2917 ,flag_ww = 0 &
2918 ,flag_t = 0 &
2919 ,flag_mu = 0 &
2920 ,flag_mut = 0 &
2921 ,flag_moist = 0 &
2922 ,flag_chem = im &
2923 ,flag_tracer = 0 &
2924 ,flag_scalar = 0 &
2925 ,actual_distance_average=config_flags%actual_distance_average&
2926 ,pos_def = config_flags%pos_def &
2927 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2928 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2929 ,fft_filter_lat = config_flags%fft_filter_lat &
2930 ,dclat = dclat &
2931 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2932 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2933 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2934 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2935 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2936 IF ( config_flags%coupled_filtering ) THEN
2937 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2938 ,MU=grid%mu_2 , MUB=grid%mub &
2939 ,C1=grid%c1h , C2=grid%c2h &
2940 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2941 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2942 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2943 END IF
2944 END DO
2945 END IF
2946 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
2947 CALL wrf_debug ( 200 , ' call filter tracer ' )
2948 DO im = PARAM_FIRST_SCALAR, num_tracer
2949 IF ( config_flags%coupled_filtering ) THEN
2950 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2951 ,MU=grid%mu_2 , MUB=grid%mub &
2952 ,C1=grid%c1h , C2=grid%c2h &
2953 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2954 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2955 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2956 END IF
2957 CALL pxft ( grid=grid &
2958 ,lineno=__LINE__ &
2959 ,flag_uv = 0 &
2960 ,flag_rurv = 0 &
2961 ,flag_wph = 0 &
2962 ,flag_ww = 0 &
2963 ,flag_t = 0 &
2964 ,flag_mu = 0 &
2965 ,flag_mut = 0 &
2966 ,flag_moist = 0 &
2967 ,flag_chem = 0 &
2968 ,flag_tracer = im &
2969 ,flag_scalar = 0 &
2970 ,actual_distance_average=config_flags%actual_distance_average&
2971 ,pos_def = config_flags%pos_def &
2972 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
2973 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
2974 ,fft_filter_lat = config_flags%fft_filter_lat &
2975 ,dclat = dclat &
2976 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2977 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2978 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2979 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2980 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2981 IF ( config_flags%coupled_filtering ) THEN
2982 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
2983 ,MU=grid%mu_2 , MUB=grid%mub &
2984 ,C1=grid%c1h , C2=grid%c2h &
2985 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2986 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2987 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2988 END IF
2989 END DO
2990 END IF
2992 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
2993 CALL wrf_debug ( 200 , ' call filter scalar ' )
2994 DO im = PARAM_FIRST_SCALAR, num_3d_s
2995 IF ( config_flags%coupled_filtering ) THEN
2996 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2997 ,MU=grid%mu_2 , MUB=grid%mub &
2998 ,C1=grid%c1h , C2=grid%c2h &
2999 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3000 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3001 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3002 END IF
3003 CALL pxft ( grid=grid &
3004 ,lineno=__LINE__ &
3005 ,flag_uv = 0 &
3006 ,flag_rurv = 0 &
3007 ,flag_wph = 0 &
3008 ,flag_ww = 0 &
3009 ,flag_t = 0 &
3010 ,flag_mu = 0 &
3011 ,flag_mut = 0 &
3012 ,flag_moist = 0 &
3013 ,flag_chem = 0 &
3014 ,flag_tracer = 0 &
3015 ,flag_scalar = im &
3016 ,actual_distance_average=config_flags%actual_distance_average&
3017 ,pos_def = config_flags%pos_def &
3018 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3019 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3020 ,fft_filter_lat = config_flags%fft_filter_lat &
3021 ,dclat = dclat &
3022 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3023 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3024 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3025 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3026 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3027 IF ( config_flags%coupled_filtering ) THEN
3028 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3029 ,MU=grid%mu_2 , MUB=grid%mub &
3030 ,C1=grid%c1h , C2=grid%c2h &
3031 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3032 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3033 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3034 END IF
3035 END DO
3036 END IF
3037 END IF ! polar filter test
3039 !-----------------------------------------------------------
3040 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
3041 !-----------------------------------------------------------
3043 !-----------------------------------------------------------
3044 ! Stencils for patch communications (WCS, 29 June 2001)
3045 !
3046 ! here's where we need a wide comm stencil - these are the
3047 ! uncoupled variables so are used for high order calc in
3048 ! advection and mixong routines.
3049 !
3050 !
3051 ! * * * * * * *
3052 ! * * * * * * * * * * * *
3053 ! * * * * * * * * * * * * *
3054 ! * + * * * + * * * * * + * * *
3055 ! * * * * * * * * * * * * *
3056 ! * * * * * * * * * * * *
3057 ! * * * * * * *
3058 !
3059 ! al x
3060 !
3061 ! 2D variable
3062 ! mu_2 x
3063 !
3064 ! (adv order <=4)
3065 ! u_2 x
3066 ! v_2 x
3067 ! w_2 x
3068 ! t_2 x
3069 ! ph_2 x
3070 !
3071 ! (adv order <=6)
3072 ! u_2 x
3073 ! v_2 x
3074 ! w_2 x
3075 ! t_2 x
3076 ! ph_2 x
3077 !
3078 ! 4D variable
3079 ! moist x
3080 ! chem x
3081 ! scalar x
3083 #ifdef DM_PARALLEL
3084 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3085 # include "HALO_EM_D2_3_TL.inc"
3086 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3087 # include "HALO_EM_D2_5_TL.inc"
3088 ELSE
3089 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3090 CALL wrf_error_fatal(TRIM(wrf_err_message))
3091 ENDIF
3092 # include "PERIOD_BDY_EM_D.inc"
3093 # include "PERIOD_BDY_EM_MOIST2.inc"
3094 # include "PERIOD_BDY_EM_CHEM2.inc"
3095 # include "PERIOD_BDY_EM_TRACER2.inc"
3096 # include "PERIOD_BDY_EM_SCALAR2.inc"
3097 #endif
3099 BENCH_START(g_bc_end_tim)
3100 !$OMP PARALLEL DO &
3101 !$OMP PRIVATE ( ij )
3102 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
3103 CALL wrf_debug ( 200 , ' call g_rk_phys_bc_dry_2' )
3105 CALL g_rk_phys_bc_dry_2( config_flags, &
3106 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%w_2,grid%g_w_2, &
3107 grid%t_2,grid%g_t_2, grid%ph_2,grid%g_ph_2, grid%mu_2,grid%g_mu_2, &
3108 ids, ide, jds, jde, kds, kde, &
3109 ims, ime, jms, jme, kms, kme, &
3110 ips, ipe, jps, jpe, kps, kpe, &
3111 grid%i_start(ij), grid%i_end(ij), &
3112 grid%j_start(ij), grid%j_end(ij), &
3113 k_start , k_end )
3115 BENCH_START(g_diag_w_tim)
3116 IF (.not. config_flags%non_hydrostatic) THEN
3117 CALL g_diagnose_w( ph_tend,g_ph_tend, grid%ph_2,grid%g_ph_2, grid%ph_1,grid%g_ph_1, &
3118 grid%w_2,grid%g_w_2, grid%muts,grid%g_muts, dt_rk, &
3119 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ht, &
3120 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3121 ids, ide, jds, jde, kds, kde, &
3122 ims, ime, jms, jme, kms, kme, &
3123 grid%i_start(ij), grid%i_end(ij), &
3124 grid%j_start(ij), grid%j_end(ij), &
3125 k_start , k_end )
3126 ENDIF
3127 BENCH_END(g_diag_w_tim)
3129 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
3131 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3133 CALL g_set_physical_bc3d( moist(ims,kms,jms,im),g_moist(ims,kms,jms,im), 'p', config_flags, &
3134 ids, ide, jds, jde, kds, kde, &
3135 ims, ime, jms, jme, kms, kme, &
3136 ips, ipe, jps, jpe, kps, kpe, &
3137 grid%i_start(ij), grid%i_end(ij), &
3138 grid%j_start(ij), grid%j_end(ij), &
3139 k_start , k_end )
3141 END DO moisture_loop_bdy_1
3143 ENDIF
3145 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
3147 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3149 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
3150 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
3151 ids, ide, jds, jde, kds, kde, &
3152 ims, ime, jms, jme, kms, kme, &
3153 ips, ipe, jps, jpe, kps, kpe, &
3154 grid%i_start(ij), grid%i_end(ij), &
3155 grid%j_start(ij), grid%j_end(ij), &
3156 k_start , k_end-1 )
3158 END DO chem_species_bdy_loop_1
3160 END IF
3162 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
3164 tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
3166 CALL g_set_physical_bc3d( tracer(ims,kms,jms,ic),g_tracer(ims,kms,jms,ic), 'p', config_flags, &
3167 ids, ide, jds, jde, kds, kde, &
3168 ims, ime, jms, jme, kms, kme, &
3169 ips, ipe, jps, jpe, kps, kpe, &
3170 grid%i_start(ij), grid%i_end(ij), &
3171 grid%j_start(ij), grid%j_end(ij), &
3172 k_start , k_end-1 )
3174 END DO tracer_species_bdy_loop_1
3176 END IF
3178 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
3180 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3182 CALL g_set_physical_bc3d( scalar(ims,kms,jms,is),g_scalar(ims,kms,jms,is), 'p', config_flags, &
3183 ids, ide, jds, jde, kds, kde, &
3184 ims, ime, jms, jme, kms, kme, &
3185 ips, ipe, jps, jpe, kps, kpe, &
3186 grid%i_start(ij), grid%i_end(ij), &
3187 grid%j_start(ij), grid%j_end(ij), &
3188 k_start , k_end-1 )
3190 END DO scalar_species_bdy_loop_1
3192 END IF
3194 IF (config_flags%km_opt .eq. 2) THEN
3196 CALL g_set_physical_bc3d( grid%tke_2 ,grid%g_tke_2, 'p', config_flags, &
3197 ids, ide, jds, jde, kds, kde, &
3198 ims, ime, jms, jme, kms, kme, &
3199 ips, ipe, jps, jpe, kps, kpe, &
3200 grid%i_start(ij), grid%i_end(ij), &
3201 grid%j_start(ij), grid%j_end(ij), &
3202 k_start , k_end )
3204 END IF
3206 END DO tile_bc_loop_1
3207 !$OMP END PARALLEL DO
3208 BENCH_END(g_bc_end_tim)
3211 #ifdef DM_PARALLEL
3213 ! * * * * *
3214 ! * * * * * * * * *
3215 ! * + * * + * * * + * *
3216 ! * * * * * * * * *
3217 ! * * * * *
3219 ! moist, chem, scalar, tke x
3222 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3223 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3224 # include "HALO_EM_TKE_5_TL.inc"
3225 ELSE
3226 # include "HALO_EM_TKE_3_TL.inc"
3227 ENDIF
3228 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3229 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3230 # include "HALO_EM_TKE_7_TL.inc"
3231 ELSE
3232 # include "HALO_EM_TKE_5_TL.inc"
3233 ENDIF
3234 ELSE
3235 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3236 CALL wrf_error_fatal(TRIM(wrf_err_message))
3237 ENDIF
3239 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
3240 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3241 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3242 # include "HALO_EM_MOIST_E_5_TL.inc"
3243 ELSE
3244 # include "HALO_EM_MOIST_E_3_TL.inc"
3245 END IF
3246 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3247 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3248 # include "HALO_EM_MOIST_E_7_TL.inc"
3249 ELSE
3250 # include "HALO_EM_MOIST_E_5_TL.inc"
3251 END IF
3252 ELSE
3253 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3254 CALL wrf_error_fatal(TRIM(wrf_err_message))
3255 ENDIF
3256 ENDIF
3257 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3258 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3259 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3260 # include "HALO_EM_CHEM_E_5.inc"
3261 ELSE
3262 # include "HALO_EM_CHEM_E_3.inc"
3263 ENDIF
3264 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3265 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3266 # include "HALO_EM_CHEM_E_7.inc"
3267 ELSE
3268 # include "HALO_EM_CHEM_E_5.inc"
3269 ENDIF
3270 ELSE
3271 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3272 CALL wrf_error_fatal(TRIM(wrf_err_message))
3273 ENDIF
3274 ENDIF
3275 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3276 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3277 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3278 # include "HALO_EM_TRACER_E_5_TL.inc"
3279 ELSE
3280 # include "HALO_EM_TRACER_E_3_TL.inc"
3281 ENDIF
3282 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3283 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3284 # include "HALO_EM_TRACER_E_7_TL.inc"
3285 ELSE
3286 # include "HALO_EM_TRACER_E_5_TL.inc"
3287 ENDIF
3288 ELSE
3289 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3290 CALL wrf_error_fatal(TRIM(wrf_err_message))
3291 ENDIF
3292 ENDIF
3293 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3294 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3295 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3296 # include "HALO_EM_SCALAR_E_5.inc"
3297 ELSE
3298 # include "HALO_EM_SCALAR_E_3.inc"
3299 ENDIF
3300 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3301 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3302 # include "HALO_EM_SCALAR_E_7.inc"
3303 ELSE
3304 # include "HALO_EM_SCALAR_E_5.inc"
3305 ENDIF
3306 ELSE
3307 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3308 CALL wrf_error_fatal(TRIM(wrf_err_message))
3309 ENDIF
3310 ENDIF
3311 #endif
3313 ENDIF rk_step_1_check
3316 !**********************************************************
3317 !
3318 ! end of RK predictor-corrector loop
3319 !
3320 !**********************************************************
3322 END DO Runge_Kutta_loop
3324 IF (config_flags%do_avgflx_em .EQ. 1) THEN
3325 ! Reinitialize time-averaged fluxes if history output was written after the previous time step:
3327 CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time)
3329 CALL domain_clock_get ( grid, current_time=CurrTime, &
3330 current_timestr=message2 )
3332 ! use overloaded -, .LT. operator to check whether to initialize avgflx:
3333 ! reinitialize after each history output (detect this here by comparing current time
3334 ! against last history time and time step - this code follows what's done in adapt_timestep_em):
3335 WRITE ( message , FMT = '("solve_em_tl: old_dt =",g15.6,", dt=",g15.6," on domain ",I3)' ) &
3336 & old_dt,grid%dt,grid%id
3337 CALL wrf_debug(200,message)
3338 old_dt=min(old_dt,grid%dt)
3339 num = INT(old_dt * precision)
3340 den = precision
3342 CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3344 IF (CurrTime .lt. temp_time + dtInterval) THEN
3345 WRITE ( message , FMT = '("solve_em_tl: initializing avgflx at time ",A," on domain ",I3)' ) &
3346 & TRIM(message2), grid%id
3347 CALL wrf_message(trim(message))
3348 grid%avgflx_count = 0
3349 !tile-loop for zero_avgflx
3350 !$OMP PARALLEL DO &
3351 !$OMP PRIVATE ( ij )
3353 DO ij = 1 , grid%num_tiles
3354 CALL wrf_debug(200,'In solve_em_tl, before zero_avgflx call')
3356 CALL zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3357 & ids, ide, jds, jde, kds, kde, &
3358 & ims, ime, jms, jme, kms, kme, &
3359 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3360 & k_start , k_end, f_flux, &
3361 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3362 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3363 CALL wrf_debug(200,'In solve_em_tl, after zero_avgflx call')
3365 ENDDO
3366 ENDIF
3368 ! Update avgflx quantities
3369 !tile-loop for upd_avgflx
3370 !$OMP PARALLEL DO &
3371 !$OMP PRIVATE ( ij )
3373 DO ij = 1 , grid%num_tiles
3374 CALL wrf_debug(200,'In solve_em_tl, before upd_avgflx call')
3376 CALL upd_avgflx(grid%avgflx_count,grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3377 & grid%ru_m, grid%rv_m, grid%ww_m, &
3378 & ids, ide, jds, jde, kds, kde, &
3379 & ims, ime, jms, jme, kms, kme, &
3380 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3381 & k_start , k_end, f_flux, &
3382 & grid%cfu1,grid%cfd1,grid%dfu1,grid%efu1,grid%dfd1,grid%efd1, &
3383 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3384 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3385 CALL wrf_debug(200,'In solve_em_tl, after upd_avgflx call')
3387 ENDDO
3388 grid%avgflx_count = grid%avgflx_count + 1
3389 ENDIF
3390 !
3391 !$OMP PARALLEL DO &
3392 !$OMP PRIVATE ( ij )
3393 DO ij = 1 , grid%num_tiles
3395 BENCH_START(g_advance_ppt_tim)
3396 CALL wrf_debug ( 200 , ' call g_advance_ppt' )
3397 CALL g_advance_ppt(grid%rthcuten,grid%g_rthcuten,grid%rqvcuten,grid%g_rqvcuten, &
3398 grid%rqccuten,grid%g_rqccuten,grid%rqrcuten,grid%g_rqrcuten, &
3399 grid%rqicuten,grid%g_rqicuten,grid%rqscuten,grid%g_rqscuten, &
3400 grid%rainc,grid%g_rainc,grid%raincv,grid%rainsh,grid%g_rainsh,&
3401 grid%pratec,grid%g_pratec,grid%pratesh,grid%g_pratesh, &
3402 grid%nca,grid%g_nca,grid%htop,grid%g_htop,grid%hbot,grid%g_hbot,&
3403 grid%cutop,grid%g_cutop,grid%cubot,grid%g_cubot, &
3404 grid%cuppt, grid%g_cuppt, grid%dt, config_flags, &
3405 ids,ide, jds,jde, kds,kde, &
3406 ims,ime, jms,jme, kms,kme, &
3407 grid%i_start(ij), grid%i_end(ij), &
3408 grid%j_start(ij), grid%j_end(ij), &
3409 k_start , k_end )
3410 BENCH_END(g_advance_ppt_tim)
3412 ENDDO
3413 !$OMP END PARALLEL DO
3415 !$OMP PARALLEL DO &
3416 !$OMP PRIVATE ( ij )
3417 DO ij = 1 , grid%num_tiles
3419 CALL wrf_debug ( 200 , ' call g_phy_prep_part2' )
3420 CALL g_phy_prep_part2 ( config_flags, &
3421 grid%mut,grid%g_mut, grid%muu, grid%g_muu, grid%muv, grid%g_muv, &
3422 grid%rthraten, grid%g_rthraten, &
3423 grid%rthblten, grid%g_rthblten, &
3424 grid%rublten, grid%g_rublten, grid%rvblten, grid%g_rvblten, &
3425 grid%rqvblten, grid%g_rqvblten, grid%rqcblten, grid%g_rqcblten, grid%rqiblten, grid%g_rqiblten, &
3426 grid%rucuten, grid%g_rucuten , grid%rvcuten, grid%g_rvcuten, grid%rthcuten, grid%g_rthcuten, &
3427 grid%rqvcuten, grid%g_rqvcuten, grid%rqccuten, grid%g_rqccuten, grid%rqrcuten, grid%g_rqrcuten, &
3428 grid%rqicuten, grid%g_rqicuten, grid%rqscuten, grid%g_rqscuten, &
3429 grid%rushten, grid%g_rushten, grid%rvshten, grid%g_rvshten, grid%rthshten, grid%g_rthshten, &
3430 grid%rqvshten, grid%g_rqvshten, grid%rqcshten, grid%g_rqcshten, grid%rqrshten, grid%g_rqrshten, &
3431 grid%rqishten, grid%g_rqishten, grid%rqsshten, grid%g_rqsshten, grid%rqgshten, grid%g_rqgshten, &
3432 grid%rthften, grid%g_rthften, grid%rqvften, grid%g_rqvften, &
3433 grid%RUNDGDTEN, grid%g_RUNDGDTEN, grid%RVNDGDTEN, grid%g_RVNDGDTEN, grid%RTHNDGDTEN, grid%g_RTHNDGDTEN, &
3434 grid%RPHNDGDTEN,grid%g_RPHNDGDTEN,grid%RQVNDGDTEN, grid%g_RQVNDGDTEN,grid%RMUNDGDTEN,&
3435 ids, ide, jds, jde, kds, kde, &
3436 ims, ime, jms, jme, kms, kme, &
3437 grid%i_start(ij), grid%i_end(ij), &
3438 grid%j_start(ij), grid%j_end(ij), &
3439 k_start, k_end )
3440 ENDDO
3441 !$OMP END PARALLEL DO
3443 !<DESCRIPTION>
3444 !<pre>
3445 ! (5) time-split physics.
3446 !
3447 ! Microphysics are the only time split physics in the WRF model
3448 ! at this time. Split-physics begins with the calculation of
3449 ! needed diagnostic quantities (pressure, temperature, etc.)
3450 ! followed by a call to the microphysics driver,
3451 ! and finishes with a clean-up, storing off of a diabatic tendency
3452 ! from the moist physics, and a re-calulation of the diagnostic
3453 ! quantities pressure and density.
3454 !</pre>
3455 !</DESCRIPTION>
3457 IF( config_flags%specified .or. config_flags%nested ) THEN
3458 sz = grid%spec_zone
3459 ELSE
3460 sz = 0
3461 ENDIF
3463 IF (config_flags%mp_physics /= 0) then
3465 !$OMP PARALLEL DO &
3466 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3468 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3470 IF ( config_flags%periodic_x ) THEN
3471 its = max(grid%i_start(ij),ids)
3472 ite = min(grid%i_end(ij),ide-1)
3473 ELSE
3474 its = max(grid%i_start(ij),ids+sz)
3475 ite = min(grid%i_end(ij),ide-1-sz)
3476 ENDIF
3477 jts = max(grid%j_start(ij),jds+sz)
3478 jte = min(grid%j_end(ij),jde-1-sz)
3480 CALL wrf_debug ( 200 , ' call g_moist_physics_prep' )
3481 BENCH_START(g_moist_physics_prep_tim)
3482 CALL g_moist_physics_prep_em( grid%t_2,grid%g_t_2, grid%t_1, &
3483 t0, grid%rho,grid%g_rho, &
3484 grid%al,grid%g_al, grid%alb, &
3485 grid%p,grid%g_p, p8w,g_p8w, &
3486 p0, grid%pb, &
3487 grid%ph_2,grid%g_ph_2, grid%phb, &
3488 th_phy, g_th_phy, pi_phy, g_pi_phy, &
3489 p_phy, g_p_phy, &
3490 grid%z, grid%g_z, grid%z_at_w, grid%g_z_at_w, &
3491 dz8w, g_dz8w, &
3492 dtm, grid%h_diabatic, grid%g_h_diabatic, &
3493 moist(ims,kms,jms,P_QV),g_moist(ims,kms,jms,P_QV), &
3494 grid%qv_diabatic, grid%g_qv_diabatic, &
3495 moist(ims,kms,jms,P_QC),g_moist(ims,kms,jms,P_QC), &
3496 grid%qc_diabatic, grid%g_qc_diabatic, &
3497 config_flags,grid%fnm, grid%fnp, &
3498 ids, ide, jds, jde, kds, kde, &
3499 ims, ime, jms, jme, kms, kme, &
3500 its, ite, jts, jte, &
3501 k_start , k_end )
3502 BENCH_END(g_moist_physics_prep_tim)
3503 END DO scalar_tile_loop_1a
3504 !$OMP END PARALLEL DO
3506 CALL wrf_debug ( 200 , ' call g_microphysics_driver' )
3508 grid%g_sr = 0.
3509 grid%sr = 0.
3510 specified_bdy = config_flags%specified .OR. config_flags%nested
3511 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3513 BENCH_START(g_micro_driver_tim)
3515 !
3516 ! WRFU_AlarmIsRinging always returned false, so using an alternate method to find out if it is time
3517 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
3518 !
3519 ! diagflag = .false.
3520 ! CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM
3521 ! ),prevringtime=temp_time,RingInterval=intervaltime)
3522 ! CALL WRFU_ALARMGET(grid%alarms( RESTART_ALARM
3523 ! ),prevringtime=restart_time,RingInterval=restartinterval)
3524 ! CALL domain_clock_get ( grid, current_time=CurrTime )
3525 ! old_dt=min(old_dt,grid%dt)
3526 ! num = INT(old_dt * precision)
3527 ! den = precision
3528 ! CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3529 ! IF (CurrTime .ge. temp_time + intervaltime - dtInterval .or. &
3530 ! CurrTime .ge. restart_time + restartinterval - dtInterval ) THEN
3531 ! diagflag = .true.
3532 ! ENDIF
3533 ! WRITE(wrf_err_message,*)'diag_flag=',diag_flag
3534 ! CALL wrf_debug ( 0 , wrf_err_message )
3536 #ifdef DM_PARALLEL
3537 # include "HALO_EM_SBM_TL.inc"
3538 #endif
3540 CALL g_microphysics_driver( &
3541 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3542 & ,DZ8W=dz8w ,DZ8WD=g_dz8w, F_ICE_PHY=grid%f_ice_phy &
3543 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3544 & ,P8W=p8w ,P=p_phy ,PD=g_p_phy &
3545 & ,PI_PHY=pi_phy,PI_PHYD=g_pi_phy &
3546 & ,RHO=grid%rho ,RHOD=grid%g_rho, SPEC_ZONE=grid%spec_zone &
3547 & ,SR=grid%sr ,TH=th_phy,THD=g_th_phy &
3548 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
3549 & ,WARM_RAIN=grid%warm_rain &
3550 & ,T8W=t8w &
3551 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3552 & ,NSOURCE=grid%qndropsource &
3553 & ,XLAND=grid%xland &
3554 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3555 & ,F_RAIN_PHY=grid%f_rain_phy &
3556 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3557 & ,MP_PHYSICS=config_flags%mp_physics &
3558 & ,ID=grid%id &
3559 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3560 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3561 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3562 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3563 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3564 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3565 & ,NUM_TILES=grid%num_tiles &
3566 & ,NAER=grid%naer &
3567 ! Optional
3568 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3569 & , RAINNCD=grid%g_rainnc, RAINNCVD=grid%g_rainncv &
3570 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3571 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
3572 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
3573 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
3574 & , MP_RESTART_STATE=grid%mp_restart_state &
3575 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3576 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3577 & , QV_CURR=moist(ims,kms,jms,P_QV),QV_CURRD=g_moist(ims,kms,jms,P_QV), F_QV=F_QV &
3578 & , QC_CURR=moist(ims,kms,jms,P_QC),QC_CURRD=g_moist(ims,kms,jms,P_QC), F_QC=F_QC &
3579 & , QR_CURR=moist(ims,kms,jms,P_QR),QR_CURRD=g_moist(ims,kms,jms,P_QR), F_QR=F_QR &
3580 & , QI_CURR=moist(ims,kms,jms,P_QI),QI_CURRD=g_moist(ims,kms,jms,P_QI), F_QI=F_QI &
3581 & , QS_CURR=moist(ims,kms,jms,P_QS),QS_CURRD=g_moist(ims,kms,jms,P_QS), F_QS=F_QS &
3582 & , QG_CURR=moist(ims,kms,jms,P_QG),QG_CURRD=g_moist(ims,kms,jms,P_QG), F_QG=F_QG &
3583 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
3584 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3585 #if (WRF_CHEM==1)
3586 & , RAINPROD=grid%rainprod, EVAPPROD=grid%evapprod &
3587 & , QV_B4MP=grid%qv_b4mp,QC_B4MP=grid%qc_b4mp &
3588 & , QI_B4MP=grid%qi_b4mp, QS_B4MP=grid%qs_b4mp &
3589 #endif
3590 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3591 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
3592 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3593 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
3594 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3595 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3596 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3597 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom and nssl_2mom
3598 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
3599 ! & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! "
3600 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
3601 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
3602 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
3603 & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom
3604 & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom
3605 & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m
3606 & , QTCN_CURR=scalar(ims,kms,jms,P_QTCN), F_QTCN=F_QTCN & ! for ntu3m
3607 & , QCCN_CURR=scalar(ims,kms,jms,P_QCCN), F_QCCN=F_QCCN & ! for ntu3m
3608 & , QRCN_CURR=scalar(ims,kms,jms,P_QRCN), F_QRCN=F_QRCN & ! for ntu3m
3609 & , QNIN_CURR=scalar(ims,kms,jms,P_QNIN), F_QNIN=F_QNIN & ! for ntu3m
3610 & , FI_CURR=scalar(ims,kms,jms,P_FI), F_FI=F_FI & ! for ntu3m
3611 & , FS_CURR=scalar(ims,kms,jms,P_FS), F_FS=F_FS & ! for ntu3m
3612 & , VI_CURR=scalar(ims,kms,jms,P_VI), F_VI=F_VI & ! for ntu3m
3613 & , VS_CURR=scalar(ims,kms,jms,P_VS), F_VS=F_VS & ! for ntu3m
3614 & , VG_CURR=scalar(ims,kms,jms,P_VG), F_VG=F_VG & ! for ntu3m
3615 & , AI_CURR=scalar(ims,kms,jms,P_AI), F_AI=F_AI & ! for ntu3m
3616 & , AS_CURR=scalar(ims,kms,jms,P_AS), F_AS=F_AS & ! for ntu3m
3617 & , AG_CURR=scalar(ims,kms,jms,P_AG), F_AG=F_AG & ! for ntu3m
3618 & , AH_CURR=scalar(ims,kms,jms,P_AH), F_AH=F_AH & ! for ntu3m
3619 & , I3M_CURR=scalar(ims,kms,jms,P_I3M), F_I3M=F_I3m & ! for ntu3m
3620 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3621 & , qicuten=grid%rqicuten &
3622 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
3623 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
3624 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
3625 ! YLIN
3626 ! RI_CURR INPUT
3627 & , RI_CURR=grid%rimi &
3628 & , diagflag=diag_flag, do_radar_ref=config_flags%do_radar_ref &
3629 )
3630 BENCH_END(g_micro_driver_tim)
3632 #if 0
3633 BENCH_START(g_microswap_2)
3634 ! for load balancing; communication to redistribute the points
3635 IF ( config_flags%mp_physics .EQ. ETAMPNEW .OR. &
3636 & config_flags%mp_physics .EQ. FER_MP_HIRES) THEN
3637 #include "SWAP_ETAMP_NEW.inc"
3638 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3639 #include "SWAP_WSM3.inc"
3640 ENDIF
3641 BENCH_END(g_microswap_2)
3642 #endif
3644 CALL wrf_debug ( 200 , ' call g_moist_physics_finish' )
3645 BENCH_START(g_moist_phys_end_tim)
3647 !$OMP PARALLEL DO &
3648 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3650 DO ij = 1 , grid%num_tiles
3652 its = max(grid%i_start(ij),ids)
3653 ite = min(grid%i_end(ij),ide-1)
3654 jts = max(grid%j_start(ij),jds)
3655 jte = min(grid%j_end(ij),jde-1)
3657 CALL g_microphysics_zero_outb ( &
3658 moist , g_moist, num_moist , config_flags , &
3659 ids, ide, jds, jde, kds, kde, &
3660 ims, ime, jms, jme, kms, kme, &
3661 its, ite, jts, jte, &
3662 k_start , k_end )
3664 CALL g_microphysics_zero_outb ( &
3665 scalar , g_scalar, num_scalar , config_flags , &
3666 ids, ide, jds, jde, kds, kde, &
3667 ims, ime, jms, jme, kms, kme, &
3668 its, ite, jts, jte, &
3669 k_start , k_end )
3671 !!!!! REPLACE WITH g_microphysics_zero_outb WHEN CODING TL OF PHYSICS. Ning Pan
3672 CALL microphysics_zero_outb ( &
3673 chem , num_chem , config_flags , &
3674 ids, ide, jds, jde, kds, kde, &
3675 ims, ime, jms, jme, kms, kme, &
3676 its, ite, jts, jte, &
3677 k_start , k_end )
3679 CALL g_microphysics_zero_outb ( &
3680 tracer , g_tracer, num_tracer , config_flags , &
3681 ids, ide, jds, jde, kds, kde, &
3682 ims, ime, jms, jme, kms, kme, &
3683 its, ite, jts, jte, &
3684 k_start , k_end )
3686 IF ( config_flags%periodic_x ) THEN
3687 its = max(grid%i_start(ij),ids)
3688 ite = min(grid%i_end(ij),ide-1)
3689 ELSE
3690 its = max(grid%i_start(ij),ids+sz)
3691 ite = min(grid%i_end(ij),ide-1-sz)
3692 ENDIF
3693 jts = max(grid%j_start(ij),jds+sz)
3694 jte = min(grid%j_end(ij),jde-1-sz)
3696 CALL g_microphysics_zero_outa ( &
3697 moist , g_moist, num_moist , config_flags , &
3698 ids, ide, jds, jde, kds, kde, &
3699 ims, ime, jms, jme, kms, kme, &
3700 its, ite, jts, jte, &
3701 k_start , k_end )
3703 CALL g_microphysics_zero_outa ( &
3704 scalar ,g_scalar, num_scalar , config_flags , &
3705 ids, ide, jds, jde, kds, kde, &
3706 ims, ime, jms, jme, kms, kme, &
3707 its, ite, jts, jte, &
3708 k_start , k_end )
3710 !!!!! REPLACE WITH g_microphysics_zero_outa WHEN CODING TL OF PHYSICS. Ning Pan
3711 CALL microphysics_zero_outa ( &
3712 chem , num_chem , config_flags , &
3713 ids, ide, jds, jde, kds, kde, &
3714 ims, ime, jms, jme, kms, kme, &
3715 its, ite, jts, jte, &
3716 k_start , k_end )
3718 CALL g_microphysics_zero_outa ( &
3719 tracer , g_tracer, num_tracer , config_flags , &
3720 ids, ide, jds, jde, kds, kde, &
3721 ims, ime, jms, jme, kms, kme, &
3722 its, ite, jts, jte, &
3723 k_start , k_end )
3725 CALL g_moist_physics_finish_em( grid%t_2, grid%g_t_2, grid%t_1, &
3726 t0, grid%muts, &
3727 th_phy, g_th_phy, &
3728 grid%h_diabatic,grid%g_h_diabatic, &
3729 moist(ims,kms,jms,P_QV),g_moist(ims,kms,jms,P_QV), &
3730 grid%qv_diabatic, grid%g_qv_diabatic, &
3731 moist(ims,kms,jms,P_QC),g_moist(ims,kms,jms,P_QC), &
3732 grid%qc_diabatic, grid%g_qc_diabatic, &
3733 dtm, config_flags, &
3734 ids, ide, jds, jde, kds, kde, &
3735 ims, ime, jms, jme, kms, kme, &
3736 its, ite, jts, jte, &
3737 k_start , k_end )
3739 END DO
3740 !$OMP END PARALLEL DO
3742 ENDIF ! microphysics test
3744 !-----------------------------------------------------------
3745 ! filter for moist variables post-microphysics and end of timestep
3746 !-----------------------------------------------------------
3748 IF (config_flags%polar) THEN
3749 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3750 CALL wrf_debug ( 200 , ' call filter moist' )
3751 DO im = PARAM_FIRST_SCALAR, num_3d_m
3752 IF ( config_flags%coupled_filtering ) THEN
3753 DO jj = jps, MIN(jpe,jde-1)
3754 DO kk = kps, MIN(kpe,kde-1)
3755 DO ii = ips, MIN(ipe,ide-1)
3756 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3757 ENDDO
3758 ENDDO
3759 ENDDO
3760 END IF
3762 CALL pxft ( grid=grid &
3763 ,lineno=__LINE__ &
3764 ,flag_uv = 0 &
3765 ,flag_rurv = 0 &
3766 ,flag_wph = 0 &
3767 ,flag_ww = 0 &
3768 ,flag_t = 0 &
3769 ,flag_mu = 0 &
3770 ,flag_mut = 0 &
3771 ,flag_moist = im &
3772 ,flag_chem = 0 &
3773 ,flag_tracer = 0 &
3774 ,flag_scalar = 0 &
3775 ,actual_distance_average=config_flags%actual_distance_average&
3776 ,pos_def = config_flags%pos_def &
3777 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3778 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3779 ,fft_filter_lat = config_flags%fft_filter_lat &
3780 ,dclat = dclat &
3781 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3782 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3783 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3784 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3785 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3786 IF ( config_flags%coupled_filtering ) THEN
3787 DO jj = jps, MIN(jpe,jde-1)
3788 DO kk = kps, MIN(kpe,kde-1)
3789 DO ii = ips, MIN(ipe,ide-1)
3790 moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3791 ENDDO
3792 ENDDO
3793 ENDDO
3794 ENDIF
3795 ENDDO
3796 ENDIF
3797 ENDIF
3799 !-----------------------------------------------------------
3800 ! end filter for moist variables post-microphysics and end of timestep
3801 !-----------------------------------------------------------
3803 !$OMP PARALLEL DO &
3804 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
3805 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
3807 IF ( config_flags%periodic_x ) THEN
3808 its = max(grid%i_start(ij),ids)
3809 ite = min(grid%i_end(ij),ide-1)
3810 ELSE
3811 its = max(grid%i_start(ij),ids+sz)
3812 ite = min(grid%i_end(ij),ide-1-sz)
3813 ENDIF
3814 jts = max(grid%j_start(ij),jds+sz)
3815 jte = min(grid%j_end(ij),jde-1-sz)
3817 CALL g_calc_p_rho_phi( moist,g_moist, num_3d_m, config_flags%hypsometric_opt, &
3818 grid%al,grid%g_al, grid%alb, grid%mu_2,grid%g_mu_2, grid%muts,grid%g_muts, &
3819 grid%ph_2,grid%g_ph_2, grid%phb, grid%p,grid%g_p, grid%pb, grid%t_2,grid%g_t_2, &
3820 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
3821 grid%rdn, config_flags%non_hydrostatic, &
3822 ids, ide, jds, jde, kds, kde, &
3823 ims, ime, jms, jme, kms, kme, &
3824 its, ite, jts, jte, &
3825 k_start , k_end )
3827 END DO scalar_tile_loop_1ba
3828 !$OMP END PARALLEL DO
3829 BENCH_END(g_moist_phys_end_tim)
3831 IF (.not. config_flags%non_hydrostatic) THEN
3832 #ifdef DM_PARALLEL
3833 # include "HALO_EM_HYDRO_UV_TL.inc"
3834 # include "PERIOD_EM_HYDRO_UV.inc"
3835 #endif
3836 !$OMP PARALLEL DO &
3837 !$OMP PRIVATE ( ij )
3838 DO ij = 1 , grid%num_tiles
3839 CALL g_diagnose_w( ph_tend,g_ph_tend, grid%ph_2,grid%g_ph_2, grid%ph_1,grid%g_ph_1, &
3840 grid%w_2,grid%g_w_2, grid%muts,grid%g_muts, dt_rk, &
3841 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, grid%ht, &
3842 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3843 ids, ide, jds, jde, kds, kde, &
3844 ims, ime, jms, jme, kms, kme, &
3845 grid%i_start(ij), grid%i_end(ij), &
3846 grid%j_start(ij), grid%j_end(ij), &
3847 k_start , k_end )
3849 END DO
3850 !$OMP END PARALLEL DO
3852 END IF
3854 CALL wrf_debug ( 200 , ' call chem polar filter ' )
3856 !-----------------------------------------------------------
3857 ! filter for chem and scalar variables at end of timestep
3858 !-----------------------------------------------------------
3860 IF (config_flags%polar) THEN
3862 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
3863 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
3864 IF ( config_flags%coupled_filtering ) THEN
3865 DO jj = jps, MIN(jpe,jde-1)
3866 DO kk = kps, MIN(kpe,kde-1)
3867 DO ii = ips, MIN(ipe,ide-1)
3868 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3869 ENDDO
3870 ENDDO
3871 ENDDO
3872 END IF
3874 CALL pxft ( grid=grid &
3875 ,lineno=__LINE__ &
3876 ,flag_uv = 0 &
3877 ,flag_rurv = 0 &
3878 ,flag_wph = 0 &
3879 ,flag_ww = 0 &
3880 ,flag_t = 0 &
3881 ,flag_mu = 0 &
3882 ,flag_mut = 0 &
3883 ,flag_moist = 0 &
3884 ,flag_chem = im &
3885 ,flag_tracer = 0 &
3886 ,flag_scalar = 0 &
3887 ,actual_distance_average=config_flags%actual_distance_average&
3888 ,pos_def = config_flags%pos_def &
3889 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3890 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3891 ,fft_filter_lat = config_flags%fft_filter_lat &
3892 ,dclat = dclat &
3893 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3894 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3895 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3896 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3897 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3899 IF ( config_flags%coupled_filtering ) THEN
3900 DO jj = jps, MIN(jpe,jde-1)
3901 DO kk = kps, MIN(kpe,kde-1)
3902 DO ii = ips, MIN(ipe,ide-1)
3903 chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3904 ENDDO
3905 ENDDO
3906 ENDDO
3907 END IF
3908 ENDDO chem_filter_loop
3909 ENDIF
3910 IF ( num_tracer >= PARAM_FIRST_SCALAR ) then
3911 tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer
3912 IF ( config_flags%coupled_filtering ) THEN
3913 DO jj = jps, MIN(jpe,jde-1)
3914 DO kk = kps, MIN(kpe,kde-1)
3915 DO ii = ips, MIN(ipe,ide-1)
3916 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3917 ENDDO
3918 ENDDO
3919 ENDDO
3920 END IF
3922 CALL pxft ( grid=grid &
3923 ,lineno=__LINE__ &
3924 ,flag_uv = 0 &
3925 ,flag_rurv = 0 &
3926 ,flag_wph = 0 &
3927 ,flag_ww = 0 &
3928 ,flag_t = 0 &
3929 ,flag_mu = 0 &
3930 ,flag_mut = 0 &
3931 ,flag_moist = 0 &
3932 ,flag_chem = 0 &
3933 ,flag_tracer = im &
3934 ,flag_scalar = 0 &
3935 ,actual_distance_average=config_flags%actual_distance_average&
3936 ,pos_def = config_flags%pos_def &
3937 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3938 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3939 ,fft_filter_lat = config_flags%fft_filter_lat &
3940 ,dclat = dclat &
3941 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3942 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3943 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3944 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3945 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3947 IF ( config_flags%coupled_filtering ) THEN
3948 DO jj = jps, MIN(jpe,jde-1)
3949 DO kk = kps, MIN(kpe,kde-1)
3950 DO ii = ips, MIN(ipe,ide-1)
3951 tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3952 ENDDO
3953 ENDDO
3954 ENDDO
3955 END IF
3956 ENDDO tracer_filter_loop
3957 ENDIF
3959 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
3960 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
3961 IF ( config_flags%coupled_filtering ) THEN
3962 DO jj = jps, MIN(jpe,jde-1)
3963 DO kk = kps, MIN(kpe,kde-1)
3964 DO ii = ips, MIN(ipe,ide-1)
3965 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
3966 ENDDO
3967 ENDDO
3968 ENDDO
3969 END IF
3971 CALL pxft ( grid=grid &
3972 ,lineno=__LINE__ &
3973 ,flag_uv = 0 &
3974 ,flag_rurv = 0 &
3975 ,flag_wph = 0 &
3976 ,flag_ww = 0 &
3977 ,flag_t = 0 &
3978 ,flag_mu = 0 &
3979 ,flag_mut = 0 &
3980 ,flag_moist = 0 &
3981 ,flag_chem = 0 &
3982 ,flag_tracer = 0 &
3983 ,flag_scalar = im &
3984 ,actual_distance_average=config_flags%actual_distance_average&
3985 ,pos_def = config_flags%pos_def &
3986 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3987 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3988 ,fft_filter_lat = config_flags%fft_filter_lat &
3989 ,dclat = dclat &
3990 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3991 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3992 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3993 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3994 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3996 IF ( config_flags%coupled_filtering ) THEN
3997 DO jj = jps, MIN(jpe,jde-1)
3998 DO kk = kps, MIN(kpe,kde-1)
3999 DO ii = ips, MIN(ipe,ide-1)
4000 scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
4001 ENDDO
4002 ENDDO
4003 ENDDO
4004 END IF
4005 ENDDO scalar_filter_loop
4006 ENDIF
4007 ENDIF
4009 !-----------------------------------------------------------
4010 ! end filter for chem and scalar variables at end of timestep
4011 !-----------------------------------------------------------
4013 ! We're finished except for boundary condition (and patch) update
4015 ! Boundary condition time (or communication time). At this time, we have
4016 ! implemented periodic and symmetric physical boundary conditions.
4018 ! b.c. routine for data within patch.
4020 ! we need to do both time levels of
4021 ! data because the time filter only works in the physical solution space.
4023 ! First, do patch communications for boundary conditions (periodicity)
4025 !-----------------------------------------------------------
4026 ! Stencils for patch communications (WCS, 29 June 2001)
4027 !
4028 ! here's where we need a wide comm stencil - these are the
4029 ! uncoupled variables so are used for high order calc in
4030 ! advection and mixong routines.
4031 !
4032 ! * * * * *
4033 ! * * * * * * * * *
4034 ! * + * * + * * * + * *
4035 ! * * * * * * * * *
4036 ! * * * * *
4037 !
4038 ! grid%u_1 x
4039 ! grid%u_2 x
4040 ! grid%v_1 x
4041 ! grid%v_2 x
4042 ! grid%w_1 x
4043 ! grid%w_2 x
4044 ! grid%t_1 x
4045 ! grid%t_2 x
4046 ! grid%ph_1 x
4047 ! grid%ph_2 x
4048 ! grid%tke_1 x
4049 ! grid%tke_2 x
4050 !
4051 ! 2D variables
4052 ! grid%mu_1 x
4053 ! grid%mu_2 x
4054 !
4055 ! 4D variables
4056 ! moist x
4057 ! chem x
4058 ! scalar x
4059 !----------------------------------------------------------
4062 #ifdef DM_PARALLEL
4063 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4064 # include "HALO_EM_D3_3_TL.inc"
4065 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4066 # include "HALO_EM_D3_5_TL.inc"
4067 ELSE
4068 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4069 CALL wrf_error_fatal(TRIM(wrf_err_message))
4070 ENDIF
4071 # include "PERIOD_BDY_EM_D3.inc"
4072 # include "PERIOD_BDY_EM_MOIST.inc"
4073 # include "PERIOD_BDY_EM_CHEM.inc"
4074 # include "PERIOD_BDY_EM_TRACER.inc"
4075 # include "PERIOD_BDY_EM_SCALAR.inc"
4076 # include "PERIOD_BDY_EM_TKE.inc"
4077 #endif
4079 ! now set physical b.c on a patch
4081 BENCH_START(g_bc_2d_tim)
4082 !$OMP PARALLEL DO &
4083 !$OMP PRIVATE ( ij )
4084 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
4086 CALL wrf_debug ( 200 , ' call g_set_phys_bc_dry_2' )
4088 CALL g_set_phys_bc_dry_2( config_flags, &
4089 grid%u_1,grid%g_u_1, grid%u_2,grid%g_u_2, &
4090 grid%v_1,grid%g_v_1, grid%v_2,grid%g_v_2, &
4091 grid%w_1,grid%g_w_1, grid%w_2,grid%g_w_2, &
4092 grid%t_1,grid%g_t_1, grid%t_2,grid%g_t_2, &
4093 grid%ph_1,grid%g_ph_1, grid%ph_2,grid%g_ph_2, &
4094 grid%mu_1,grid%g_mu_1, grid%mu_2,grid%g_mu_2, &
4095 ids, ide, jds, jde, kds, kde, &
4096 ims, ime, jms, jme, kms, kme, &
4097 ips, ipe, jps, jpe, kps, kpe, &
4098 grid%i_start(ij), grid%i_end(ij), &
4099 grid%j_start(ij), grid%j_end(ij), &
4100 k_start , k_end )
4102 CALL g_set_physical_bc3d( grid%tke_1,grid%g_tke_1, 'p', config_flags, &
4103 ids, ide, jds, jde, kds, kde, &
4104 ims, ime, jms, jme, kms, kme, &
4105 ips, ipe, jps, jpe, kps, kpe, &
4106 grid%i_start(ij), grid%i_end(ij), &
4107 grid%j_start(ij), grid%j_end(ij), &
4108 k_start , k_end-1 )
4110 CALL g_set_physical_bc3d( grid%tke_2 ,grid%g_tke_2, 'p', config_flags, &
4111 ids, ide, jds, jde, kds, kde, &
4112 ims, ime, jms, jme, kms, kme, &
4113 ips, ipe, jps, jpe, kps, kpe, &
4114 grid%i_start(ij), grid%i_end(ij), &
4115 grid%j_start(ij), grid%j_end(ij), &
4116 k_start , k_end )
4118 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4120 CALL g_set_physical_bc3d( moist(ims,kms,jms,im),g_moist(ims,kms,jms,im), 'p', &
4121 config_flags, &
4122 ids, ide, jds, jde, kds, kde, &
4123 ims, ime, jms, jme, kms, kme, &
4124 ips, ipe, jps, jpe, kps, kpe, &
4125 grid%i_start(ij), grid%i_end(ij), &
4126 grid%j_start(ij), grid%j_end(ij), &
4127 k_start , k_end )
4130 END DO moisture_loop_bdy_2
4132 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4134 !!!!! REPLACE WITH g_set_physical_bc3d WHEN chem IS NEEDED. Ning Pan
4135 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
4136 ids, ide, jds, jde, kds, kde, &
4137 ims, ime, jms, jme, kms, kme, &
4138 ips, ipe, jps, jpe, kps, kpe, &
4139 grid%i_start(ij), grid%i_end(ij), &
4140 grid%j_start(ij), grid%j_end(ij), &
4141 k_start , k_end )
4143 END DO chem_species_bdy_loop_2
4145 tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
4147 CALL g_set_physical_bc3d( tracer(ims,kms,jms,ic) , g_tracer(ims,kms,jms,ic), 'p', config_flags, &
4148 ids, ide, jds, jde, kds, kde, &
4149 ims, ime, jms, jme, kms, kme, &
4150 ips, ipe, jps, jpe, kps, kpe, &
4151 grid%i_start(ij), grid%i_end(ij), &
4152 grid%j_start(ij), grid%j_end(ij), &
4153 k_start , k_end )
4155 END DO tracer_species_bdy_loop_2
4157 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4159 CALL g_set_physical_bc3d( scalar(ims,kms,jms,is) ,g_scalar(ims,kms,jms,is) , 'p', config_flags, &
4160 ids, ide, jds, jde, kds, kde, &
4161 ims, ime, jms, jme, kms, kme, &
4162 ips, ipe, jps, jpe, kps, kpe, &
4163 grid%i_start(ij), grid%i_end(ij), &
4164 grid%j_start(ij), grid%j_end(ij), &
4165 k_start , k_end )
4167 END DO scalar_species_bdy_loop_2
4169 END DO tile_bc_loop_2
4170 !$OMP END PARALLEL DO
4171 BENCH_END(g_bc_2d_tim)
4173 IF( config_flags%specified .or. config_flags%nested ) THEN
4175 ! this code forces boundary values to specified values to avoid drift
4177 !$OMP PARALLEL DO &
4178 !$OMP PRIVATE ( ij )
4179 tile_bc_loop_3: DO ij = 1 , grid%num_tiles
4181 CALL wrf_debug ( 200 , ' call g_spec_bdy_final' )
4183 CALL g_spec_bdy_final ( grid%u_2, grid%g_u_2, grid%muus, grid%g_muus, grid%msfuy, &
4184 grid%u_bxs, grid%g_u_bxs, grid%u_bxe, grid%g_u_bxe, &
4185 grid%u_bys, grid%g_u_bys, grid%u_bye, grid%g_u_bye, &
4186 grid%u_btxs,grid%g_u_btxs,grid%u_btxe,grid%g_u_btxe, &
4187 grid%u_btys,grid%g_u_btys,grid%u_btye,grid%g_u_btye, &
4188 'u', config_flags, &
4189 config_flags%spec_bdy_width, grid%spec_zone, &
4190 grid%dtbc, &
4191 ids,ide, jds,jde, kds,kde, & ! domain dims
4192 ims,ime, jms,jme, kms,kme, & ! memory dims
4193 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4194 grid%i_start(ij), grid%i_end(ij), &
4195 grid%j_start(ij), grid%j_end(ij), &
4196 k_start , k_end )
4198 CALL g_spec_bdy_final ( grid%v_2, grid%g_v_2, grid%muvs, grid%g_muvs, grid%msfvx, &
4199 grid%v_bxs, grid%g_v_bxs, grid%v_bxe, grid%g_v_bxe, &
4200 grid%v_bys, grid%g_v_bys, grid%v_bye, grid%g_v_bye, &
4201 grid%v_btxs,grid%g_v_btxs,grid%v_btxe,grid%g_v_btxe, &
4202 grid%v_btys,grid%g_v_btys,grid%v_btye,grid%g_v_btye, &
4203 'v', config_flags, &
4204 config_flags%spec_bdy_width, grid%spec_zone, &
4205 grid%dtbc, &
4206 ids,ide, jds,jde, kds,kde, & ! domain dims
4207 ims,ime, jms,jme, kms,kme, & ! memory dims
4208 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4209 grid%i_start(ij), grid%i_end(ij), &
4210 grid%j_start(ij), grid%j_end(ij), &
4211 k_start , k_end )
4213 IF( config_flags%nested) THEN
4214 CALL g_spec_bdy_final ( grid%w_2, grid%g_w_2, grid%muts, grid%g_muts, grid%msfty, &
4215 grid%w_bxs, grid%g_w_bxs, grid%w_bxe, grid%g_w_bxe, &
4216 grid%w_bys, grid%g_w_bys, grid%w_bye, grid%g_w_bye, &
4217 grid%w_btxs,grid%g_w_btxs,grid%w_btxe,grid%g_w_btxe, &
4218 grid%w_btys,grid%g_w_btys,grid%w_btye,grid%g_w_btye, &
4219 'w', config_flags, &
4220 config_flags%spec_bdy_width, grid%spec_zone, &
4221 grid%dtbc, &
4222 ids,ide, jds,jde, kds,kde, & ! domain dims
4223 ims,ime, jms,jme, kms,kme, & ! memory dims
4224 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4225 grid%i_start(ij), grid%i_end(ij), &
4226 grid%j_start(ij), grid%j_end(ij), &
4227 k_start , k_end )
4228 ENDIF
4230 CALL g_spec_bdy_final ( grid%t_2, grid%g_t_2, grid%muts, grid%g_muts, grid%msfty, &
4231 grid%t_bxs, grid%g_t_bxs, grid%t_bxe, grid%g_t_bxe, &
4232 grid%t_bys, grid%g_t_bys, grid%t_bye, grid%g_t_bye, &
4233 grid%t_btxs,grid%g_t_btxs,grid%t_btxe,grid%g_t_btxe, &
4234 grid%t_btys,grid%g_t_btys,grid%t_btye,grid%g_t_btye, &
4235 't', config_flags, &
4236 config_flags%spec_bdy_width, grid%spec_zone, &
4237 grid%dtbc, &
4238 ids,ide, jds,jde, kds,kde, & ! domain dims
4239 ims,ime, jms,jme, kms,kme, & ! memory dims
4240 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4241 grid%i_start(ij), grid%i_end(ij), &
4242 grid%j_start(ij), grid%j_end(ij), &
4243 k_start , k_end )
4245 CALL g_spec_bdy_final ( grid%ph_2, grid%g_ph_2, grid%muts, grid%g_muts, grid%msfty, &
4246 grid%ph_bxs, grid%g_ph_bxs, grid%ph_bxe, grid%g_ph_bxe, &
4247 grid%ph_bys, grid%g_ph_bys, grid%ph_bye, grid%g_ph_bye, &
4248 grid%ph_btxs,grid%g_ph_btxs,grid%ph_btxe,grid%g_ph_btxe, &
4249 grid%ph_btys,grid%g_ph_btys,grid%ph_btye,grid%g_ph_btye, &
4250 'h', config_flags, &
4251 config_flags%spec_bdy_width, grid%spec_zone, &
4252 grid%dtbc, &
4253 ids,ide, jds,jde, kds,kde, & ! domain dims
4254 ims,ime, jms,jme, kms,kme, & ! memory dims
4255 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4256 grid%i_start(ij), grid%i_end(ij), &
4257 grid%j_start(ij), grid%j_end(ij), &
4258 k_start , k_end )
4260 CALL g_spec_bdy_final ( grid%mu_2, grid%g_mu_2, grid%muts, grid%g_muts, grid%msfty, &
4261 grid%mu_bxs, grid%g_mu_bxs, grid%mu_bxe, grid%g_mu_bxe, &
4262 grid%mu_bys, grid%g_mu_bys, grid%mu_bye, grid%g_mu_bye, &
4263 grid%mu_btxs,grid%g_mu_btxs,grid%mu_btxe,grid%g_mu_btxe, &
4264 grid%mu_btys,grid%g_mu_btys,grid%mu_btye,grid%g_mu_btye, &
4265 'm', config_flags, &
4266 config_flags%spec_bdy_width, grid%spec_zone, &
4267 grid%dtbc, &
4268 ids,ide, jds,jde, 1, 1, & ! domain dims
4269 ims,ime, jms,jme, 1, 1, & ! memory dims
4270 ips,ipe, jps,jpe, 1, 1, & ! patch dims
4271 grid%i_start(ij), grid%i_end(ij), &
4272 grid%j_start(ij), grid%j_end(ij), &
4273 1 , 1 )
4275 moisture_loop_bdy_3 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4277 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
4278 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
4279 CALL g_spec_bdy_final ( moist(ims,kms,jms,im), g_moist(ims,kms,jms,im), &
4280 grid%muts, grid%g_muts, grid%msfty, &
4281 moist_bxs(jms,kms,1,im), g_moist_bxs(jms,kms,1,im), &
4282 moist_bxe(jms,kms,1,im), g_moist_bxe(jms,kms,1,im), &
4283 moist_bys(ims,kms,1,im), g_moist_bys(ims,kms,1,im), &
4284 moist_bye(ims,kms,1,im), g_moist_bye(ims,kms,1,im), &
4285 moist_btxs(jms,kms,1,im), g_moist_btxs(jms,kms,1,im), &
4286 moist_btxe(jms,kms,1,im), g_moist_btxe(jms,kms,1,im), &
4287 moist_btys(ims,kms,1,im), g_moist_btys(ims,kms,1,im), &
4288 moist_btye(ims,kms,1,im), g_moist_btye(ims,kms,1,im), &
4289 't', config_flags, &
4290 config_flags%spec_bdy_width, grid%spec_zone, &
4291 grid%dtbc, &
4292 ids,ide, jds,jde, kds,kde, & ! domain dims
4293 ims,ime, jms,jme, kms,kme, & ! memory dims
4294 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4295 grid%i_start(ij), grid%i_end(ij), &
4296 grid%j_start(ij), grid%j_end(ij), &
4297 k_start , k_end )
4298 ENDIF
4300 END DO moisture_loop_bdy_3
4302 #if (WRF_CHEM == 1)
4303 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
4304 chem_species_bdy_loop_3 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4306 IF( ( config_flags%nested ) ) THEN
4307 ! CALL g_spec_bdy_final ( chem(ims,kms,jms,ic), g_chem(ims,kms,jms,ic), &
4308 ! grid%muts, grid%g_muts, grid%msfty, &
4309 ! chem_bxs(jms,kms,1,ic), g_chem_bxs(jms,kms,1,ic), &
4310 ! chem_bxe(jms,kms,1,ic), g_chem_bxe(jms,kms,1,ic), &
4311 ! chem_bys(ims,kms,1,ic), g_chem_bys(ims,kms,1,ic), &
4312 ! chem_bye(ims,kms,1,ic), g_chem_bye(ims,kms,1,ic), &
4313 ! chem_btxs(jms,kms,1,ic), g_chem_btxs(jms,kms,1,ic), &
4314 ! chem_btxe(jms,kms,1,ic), g_chem_btxe(jms,kms,1,ic), &
4315 ! chem_btys(ims,kms,1,ic), g_chem_btys(ims,kms,1,ic), &
4316 ! chem_btye(ims,kms,1,ic), g_chem_btye(ims,kms,1,ic), &
4317 !hcl-beg no g_chem for now
4318 CALL g_spec_bdy_final ( chem(ims,kms,jms,ic), chem(ims,kms,jms,ic), &
4319 grid%muts, grid%g_muts, grid%msfty, &
4320 chem_bxs(jms,kms,1,ic), chem_bxs(jms,kms,1,ic), &
4321 chem_bxe(jms,kms,1,ic), chem_bxe(jms,kms,1,ic), &
4322 chem_bys(ims,kms,1,ic), chem_bys(ims,kms,1,ic), &
4323 chem_bye(ims,kms,1,ic), chem_bye(ims,kms,1,ic), &
4324 chem_btxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
4325 chem_btxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
4326 chem_btys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
4327 chem_btye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
4328 !hcl-end no g_chem for now
4329 't', config_flags, &
4330 config_flags%spec_bdy_width, grid%spec_zone, &
4331 grid%dtbc, &
4332 ids,ide, jds,jde, kds,kde, & ! domain dims
4333 ims,ime, jms,jme, kms,kme, & ! memory dims
4334 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4335 grid%i_start(ij), grid%i_end(ij), &
4336 grid%j_start(ij), grid%j_end(ij), &
4337 k_start , k_end )
4338 ENDIF
4340 END DO chem_species_bdy_loop_3
4341 ENDIF
4342 #endif
4344 tracer_species_bdy_loop_3 : DO im = PARAM_FIRST_SCALAR , num_tracer
4346 IF( ( config_flags%nested ) ) THEN
4347 CALL g_spec_bdy_final ( tracer(ims,kms,jms,im), g_tracer(ims,kms,jms,im), &
4348 grid%muts, grid%g_muts, grid%msfty, &
4349 tracer_bxs(jms,kms,1,im), g_tracer_bxs(jms,kms,1,im), &
4350 tracer_bxe(jms,kms,1,im), g_tracer_bxe(jms,kms,1,im), &
4351 tracer_bys(ims,kms,1,im), g_tracer_bys(ims,kms,1,im), &
4352 tracer_bye(ims,kms,1,im), g_tracer_bye(ims,kms,1,im), &
4353 tracer_btxs(jms,kms,1,im), g_tracer_btxs(jms,kms,1,im), &
4354 tracer_btxe(jms,kms,1,im), g_tracer_btxe(jms,kms,1,im), &
4355 tracer_btys(ims,kms,1,im), g_tracer_btys(ims,kms,1,im), &
4356 tracer_btye(ims,kms,1,im), g_tracer_btye(ims,kms,1,im), &
4357 't', config_flags, &
4358 config_flags%spec_bdy_width, grid%spec_zone, &
4359 grid%dtbc, &
4360 ids,ide, jds,jde, kds,kde, & ! domain dims
4361 ims,ime, jms,jme, kms,kme, & ! memory dims
4362 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4363 grid%i_start(ij), grid%i_end(ij), &
4364 grid%j_start(ij), grid%j_end(ij), &
4365 k_start , k_end )
4366 ENDIF
4368 END DO tracer_species_bdy_loop_3
4370 scalar_species_bdy_loop_3 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4372 IF( ( config_flags%nested ) ) THEN
4373 CALL g_spec_bdy_final ( scalar(ims,kms,jms,is), g_scalar(ims,kms,jms,is), &
4374 grid%muts, grid%g_muts, grid%msfty, &
4375 scalar_bxs(jms,kms,1,is), g_scalar_bxs(jms,kms,1,is), &
4376 scalar_bxe(jms,kms,1,is), g_scalar_bxe(jms,kms,1,is), &
4377 scalar_bys(ims,kms,1,is), g_scalar_bys(ims,kms,1,is), &
4378 scalar_bye(ims,kms,1,is), g_scalar_bye(ims,kms,1,is), &
4379 scalar_btxs(jms,kms,1,is), g_scalar_btxs(jms,kms,1,is), &
4380 scalar_btxe(jms,kms,1,is), g_scalar_btxe(jms,kms,1,is), &
4381 scalar_btys(ims,kms,1,is), g_scalar_btys(ims,kms,1,is), &
4382 scalar_btye(ims,kms,1,is), g_scalar_btye(ims,kms,1,is), &
4383 't', config_flags, &
4384 config_flags%spec_bdy_width, grid%spec_zone, &
4385 grid%dtbc, &
4386 ids,ide, jds,jde, kds,kde, & ! domain dims
4387 ims,ime, jms,jme, kms,kme, & ! memory dims
4388 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4389 grid%i_start(ij), grid%i_end(ij), &
4390 grid%j_start(ij), grid%j_end(ij), &
4391 k_start , k_end )
4392 ENDIF
4394 END DO scalar_species_bdy_loop_3
4396 END DO tile_bc_loop_3
4397 !$OMP END PARALLEL DO
4399 CALL wrf_debug ( 200 , ' end call g_spec_bdy_final' )
4401 ENDIF
4403 ! dtbc will be read from basic state at every time step, so it need not to be updated here.
4404 !
4405 ! IF( config_flags%specified .or. config_flags%nested ) THEN
4406 ! grid%dtbc = grid%dtbc + grid%dt
4407 ! ENDIF
4409 ! reset surface w for consistency
4411 #ifdef DM_PARALLEL
4412 # include "HALO_EM_C_TL.inc"
4413 # include "PERIOD_BDY_EM_E.inc"
4414 #endif
4416 CALL wrf_debug ( 10 , ' call g_set_w_surface' )
4417 fill_w_flag = .false.
4419 !$OMP PARALLEL DO &
4420 !$OMP PRIVATE ( ij )
4421 DO ij = 1 , grid%num_tiles
4422 CALL g_set_w_surface( config_flags, grid%znw, fill_w_flag, &
4423 grid%w_2,grid%g_w_2, grid%ht, &
4424 grid%u_2,grid%g_u_2, grid%v_2,grid%g_v_2, &
4425 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
4426 grid%msftx, grid%msfty, &
4427 ids, ide, jds, jde, kds, kde, &
4428 ims, ime, jms, jme, kms, kme, &
4429 grid%i_start(ij), grid%i_end(ij), &
4430 grid%j_start(ij), grid%j_end(ij), &
4431 k_start, k_end )
4433 ! its, ite, jts, jte, k_start, min(k_end,kde-1), &
4435 END DO
4436 !$OMP END PARALLEL DO
4438 !-----------------------------------------------------------
4439 ! After all of the RK steps, after the microphysics, after p-rho-phi,
4440 ! after w, after filtering, we have data ready to use.
4441 !-----------------------------------------------------------
4443 CALL after_all_rk_steps ( grid, config_flags, &
4444 moist, chem, tracer, scalar, &
4445 th_phy, pi_phy, p_phy, &
4446 p8w, t8w, dz8w, &
4447 REAL(curr_secs,8), curr_secs2, &
4448 diag_flag, &
4449 ids, ide, jds, jde, kds, kde, &
4450 ims, ime, jms, jme, kms, kme, &
4451 ips, ipe, jps, jpe, kps, kpe, &
4452 imsx, imex, jmsx, jmex, kmsx, kmex, &
4453 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
4454 imsy, imey, jmsy, jmey, kmsy, kmey, &
4455 ipsy, ipey, jpsy, jpey, kpsy, kpey )
4457 #ifdef DM_PARALLEL
4458 !-----------------------------------------------------------------------
4459 ! see above
4460 !--------------------------------------------------------------
4461 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
4462 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4463 # include "HALO_EM_E_3_TL.inc"
4464 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4465 # include "HALO_EM_E_5_TL.inc"
4466 ELSE
4467 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4468 CALL wrf_error_fatal(TRIM(wrf_err_message))
4469 ENDIF
4470 #endif
4472 #ifdef DM_PARALLEL
4473 IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
4474 !-----------------------------------------------------------------------
4475 ! see above
4476 !--------------------------------------------------------------
4477 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
4478 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4479 # include "HALO_EM_MOIST_E_3_TL.inc"
4480 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4481 # include "HALO_EM_MOIST_E_5_TL.inc"
4482 ELSE
4483 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4484 CALL wrf_error_fatal(TRIM(wrf_err_message))
4485 ENDIF
4486 ENDIF
4487 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
4488 !-----------------------------------------------------------------------
4489 ! see above
4490 !--------------------------------------------------------------
4491 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
4492 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4493 # include "HALO_EM_CHEM_E_3.inc"
4494 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4495 # include "HALO_EM_CHEM_E_5.inc"
4496 ELSE
4497 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4498 CALL wrf_error_fatal(TRIM(wrf_err_message))
4499 ENDIF
4500 ENDIF
4501 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
4502 !-----------------------------------------------------------------------
4503 ! see above
4504 !--------------------------------------------------------------
4505 CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' )
4506 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4507 # include "HALO_EM_TRACER_E_3_TL.inc"
4508 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4509 # include "HALO_EM_TRACER_E_5_TL.inc"
4510 ELSE
4511 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4512 CALL wrf_error_fatal(TRIM(wrf_err_message))
4513 ENDIF
4514 ENDIF
4515 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
4516 !-----------------------------------------------------------------------
4517 ! see above
4518 !--------------------------------------------------------------
4519 CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
4520 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4521 # include "HALO_EM_SCALAR_E_3.inc"
4522 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4523 # include "HALO_EM_SCALAR_E_5.inc"
4524 ELSE
4525 WRITE(wrf_err_message,*)'solve_em_tl: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4526 CALL wrf_error_fatal(TRIM(wrf_err_message))
4527 ENDIF
4528 ENDIF
4529 #endif
4531 ! Max values of CFL for adaptive time step scheme
4533 DEALLOCATE(max_vert_cfl_tmp)
4534 DEALLOCATE(max_horiz_cfl_tmp)
4536 CALL wrf_debug ( 200 , ' call end of solve_em_tl' )
4538 ! Finish timers if compiled with -DBENCH.
4539 #include "bench_solve_em_end.h"
4541 RETURN
4543 END SUBROUTINE solve_em_tl