| blob | 72428e1262189d407d26767538f6bf2dc1f5fb29 |
1 !WRF:MEDIATION_LAYER:SOLVER
3 SUBROUTINE solve_em ( grid , config_flags &
4 ! Arguments generated from Registry
5 #include "dummy_new_args.inc"
6 !
7 )
8 ! Driver layer modules
9 USE module_state_description
10 USE module_domain, ONLY : &
11 domain, get_ijk_from_grid, get_ijk_from_subgrid &
12 ,domain_get_current_time, domain_get_start_time &
13 ,domain_get_sim_start_time, domain_clock_get,is_alarm_tstep
14 USE module_domain_type, ONLY : history_alarm, restart_alarm, auxinput4_alarm &
15 ,boundary_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_sub,halo_em_b_sub,halo_em_c2_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_sub,halo_em_d2_3_sub &
28 ,halo_em_d2_5_sub,halo_em_d3_3_sub,halo_em_d3_5_sub,halo_em_d_sub &
29 ,halo_em_e_3_sub,halo_em_e_5_sub,halo_em_hydro_uv_sub &
30 ,halo_em_moist_e_3_sub,halo_em_moist_e_5_sub,halo_em_moist_e_7_sub &
31 ,halo_em_moist_old_e_5_sub,halo_em_moist_old_e_7_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_sub &
34 ,halo_em_tke_5_sub,halo_em_tke_7_sub,halo_em_tke_advect_3_sub &
35 ,halo_em_tke_advect_5_sub,halo_em_tke_old_e_5_sub &
36 ,halo_em_tke_old_e_7_sub,halo_em_tracer_e_3_sub,halo_em_tracer_e_5_sub &
37 ,halo_em_tracer_e_7_sub,halo_em_tracer_old_e_5_sub &
38 ,halo_em_tracer_old_e_7_sub,halo_em_sbm_sub,period_bdy_em_a_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 ,period_em_f_sub,period_em_g_sub &
48 ,halo_em_f_1_sub,halo_em_init_4_sub,halo_em_thetam_sub,period_em_thetam_sub &
49 ,halo_em_d_pv_sub,halo_firebrand_spotting_5_sub
50 #endif
51 USE module_utility
52 ! Mediation layer modules
53 ! Model layer modules
54 USE module_model_constants
55 USE module_small_step_em
56 USE module_em
57 USE module_big_step_utilities_em
58 USE module_bc
59 USE module_bc_em
60 USE module_solvedebug_em
61 USE module_physics_addtendc
62 USE module_diffusion_em
63 USE module_polarfft
64 USE module_microphysics_driver
65 USE module_microphysics_zero_out
66 ! USE module_lightning_driver, ONLY : lightning_driver
67 USE module_fddaobs_driver
68 ! USE module_diagnostics
69 #if (WRF_CHEM == 1)
70 USE module_input_chem_data
71 USE module_input_tracer
72 USE module_chem_utilities
73 #endif
74 USE module_dust_emis
75 USE module_first_rk_step_part1
76 USE module_first_rk_step_part2
77 USE module_after_all_rk_steps
78 USE module_llxy, ONLY : proj_cassini
79 USE module_avgflx_em, ONLY : zero_avgflx, upd_avgflx
80 USE module_cpl, ONLY : coupler_on, cpl_settime, cpl_store_input
82 #if (WRF_CMAQ == 1)
83 use twoway_data_module
84 #endif
85 USE module_firebrand_spotting, ONLY : firebrand_spotting_em_driver
87 IMPLICIT NONE
89 ! Input data.
91 TYPE(domain) , TARGET :: grid
93 ! Definitions of dummy arguments to this routine (generated from Registry).
94 #include "dummy_new_decl.inc"
96 ! Structure that contains run-time configuration (namelist) data for domain
97 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
99 ! Local data
101 INTEGER :: k_start , k_end, its, ite, jts, jte
102 INTEGER :: ids , ide , jds , jde , kds , kde , &
103 ims , ime , jms , jme , kms , kme , &
104 ips , ipe , jps , jpe , kps , kpe
106 INTEGER :: sids , side , sjds , sjde , skds , skde , &
107 sims , sime , sjms , sjme , skms , skme , &
108 sips , sipe , sjps , sjpe , skps , skpe
111 INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
112 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
113 imsy, imey, jmsy, jmey, kmsy, kmey, &
114 ipsy, ipey, jpsy, jpey, kpsy, kpey
116 INTEGER :: ij , iteration
117 INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
118 INTEGER :: loop
119 INTEGER :: sz
120 INTEGER :: iswater
122 LOGICAL :: specified_bdy, channel_bdy
124 REAL :: t_new, time_duration_of_lbcs
126 ! begin WRF-CMAQ twoway coupled model block
127 integer :: twoway_jdate, & ! CMAQ current job date
128 twoway_jtime, & ! CMAQ current job time
129 met_file_tstep ! MCIP like MET file time step
131 integer, save :: cmaq_nstep, & ! total number of CMAQ steps
132 wrf_end_step, & ! WRF ending step #
133 counter = -1, & ! step counter
134 wrf_cmaq_freq, & ! call frequency between WRF and CMAQ
135 wrf_cmaq_option ! WRF-CMAQ coupled model option
136 ! 0 = run WRF only
137 ! 1 = run WRF only w producing MCIP like GRID and MET files
138 ! 2 = run WRF-CMAQ coupled model w/o producing MCIP like GRID and MET files
139 ! 3 = run WRF-CMAQ coupled model w producing MCIP like GRID and MET files
141 logical :: cmaq_step ! CMAQ step number
143 logical, save :: firstime = .true., & ! logical variable indicating first time
144 feedback_is_ready, & ! logical variable indicating feedback process can proceed
145 feedback_restart, & ! logical variable indicating feedback information is available
146 direct_sw_feedback ! logical variable indicating direct aerosol sw feedback is on or not
147 ! end WRF-CMAQ twoway coupled model block
149 ! Changes in tendency at this timestep
150 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
151 z_tendency
153 ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
154 LOGICAL :: tenddec
156 ! Flag for producing diagnostic fields (e.g., radar reflectivity)
157 LOGICAL :: diag_flag
158 INTEGER :: ke_diag ! tells reflectivity calculation whether to do full depth or only k=1
159 LOGICAL :: restart_flag ! tells if it is a restart timestep to write restart files.
161 #if (WRF_CHEM == 1)
162 ! Index cross-referencing array for tendency accumulation
163 INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
164 #endif
166 ! storage for tendencies and decoupled state (generated from Registry)
168 #include "i1_decl.inc"
169 ! Previous time level of tracer arrays now defined as i1 variables;
170 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
171 ! Benefit: save memory in nested runs, since only 1 domain is active at a
172 ! time. Potential problem on stack-limited architectures: increases
173 ! amount of data on program stack by making these automatic arrays.
175 INTEGER :: rc
176 INTEGER :: number_of_small_timesteps, rk_step
177 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
178 INTEGER :: idum1, idum2, dynamics_option
180 INTEGER :: rk_order, iwmax, jwmax, kwmax
181 REAL :: dt_rk, dts_rk, dts, dtm, wmax
182 REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp
183 LOGICAL :: leapfrog
184 INTEGER :: l,kte,kk
185 LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd
186 REAL :: curr_secs, curr_secs2
187 INTEGER :: num_sound_steps
188 INTEGER :: idex, jdex
189 REAL :: max_msft
190 REAL :: spacing
192 INTEGER :: ii, jj !kk is above after l,kte
193 REAL :: dclat
194 INTEGER :: debug_level
196 ! urban related variables
197 INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
199 TYPE(WRFU_TimeInterval) :: tmpTimeInterval, tmpTimeInterval2
200 REAL :: real_time
201 LOGICAL :: adapt_step_flag
202 LOGICAL :: fill_w_flag
204 ! variables for flux-averaging code 20091223
205 CHARACTER*256 :: message, message2, message3
206 REAL :: old_dt
207 TYPE(WRFU_Time) :: temp_time, CurrTime, restart_time
208 INTEGER, PARAMETER :: precision = 100
209 INTEGER :: num, den
210 TYPE(WRFU_TimeInterval) :: dtInterval, intervaltime,restartinterval
212 #if (WRF_CMAQ == 1)
213 interface
214 SUBROUTINE CMAQ_DRIVER ( MODEL_STDATE, MODEL_STTIME, MODEL_TSTEP, &
215 MODEL_JDATE, MODEL_JTIME, LAST_STEP, &
216 COUPLE_TSTEP, NCOLS_IN, NLAYS_IN)
217 INTEGER, INTENT( IN ) :: MODEL_STDATE, MODEL_STTIME, MODEL_TSTEP
218 INTEGER, INTENT( OUT ) :: MODEL_JDATE, MODEL_JTIME
219 LOGICAL, INTENT( IN ) :: LAST_STEP
220 INTEGER, INTENT( IN ), OPTIONAL :: COUPLE_TSTEP
221 INTEGER, INTENT( IN ), OPTIONAL :: NCOLS_IN, NLAYS_IN
222 END SUBROUTINE CMAQ_DRIVER
223 end interface
224 #endif
226 ! Define benchmarking timers if -DBENCH is compiled
227 #include "bench_solve_em_def.h"
229 !----------------------
230 ! Executable statements
231 !----------------------
233 !<DESCRIPTION>
234 !<pre>
235 ! solve_em is the main driver for advancing a grid a single timestep.
236 ! It is a mediation-layer routine -> DM and SM calls are made where
237 ! needed for parallel processing.
238 !
239 ! solve_em can integrate the equations using 3 time-integration methods
240 !
241 ! - 3rd order Runge-Kutta time integration (recommended)
242 !
243 ! - 2nd order Runge-Kutta time integration
244 !
245 ! The main sections of solve_em are
246 !
247 ! (1) Runge-Kutta (RK) loop
248 !
249 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
250 ! model state variables during the first RK sub-step (loop)
251 !
252 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
253 !
254 ! (4) scalar advance for moist and chem scalar variables (and TKE)
255 ! within the RK sub-steps.
256 !
257 ! (5) time-split physics (after the RK step), currently this includes
258 ! only microphyics
259 !
260 ! A more detailed description of these sections follows.
261 !</pre>
262 !</DESCRIPTION>
264 ! Initialize timers if compiled with -DBENCH
265 #include "bench_solve_em_init.h"
267 #if (WRF_CMAQ == 1)
268 if (firstime) then
269 CALL nl_get_feedback_restart ( .false., feedback_restart )
270 if (feedback_restart) then
271 feedback_is_ready = .true.
272 else
273 feedback_is_ready = .false.
274 end if
275 end if
276 #else
277 feedback_is_ready = .false.
278 #endif
280 ! set runge-kutta solver (2nd or 3rd order)
282 dynamics_option = config_flags%rk_ord
284 ! Obtain dimension information stored in the grid data structure.
286 CALL get_ijk_from_grid ( grid , &
287 ids, ide, jds, jde, kds, kde, &
288 ims, ime, jms, jme, kms, kme, &
289 ips, ipe, jps, jpe, kps, kpe, &
290 imsx, imex, jmsx, jmex, kmsx, kmex, &
291 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
292 imsy, imey, jmsy, jmey, kmsy, kmey, &
293 ipsy, ipey, jpsy, jpey, kpsy, kpey )
295 CALL get_ijk_from_subgrid ( grid , &
296 sids, side, sjds, sjde, skds, skde, &
297 sims, sime, sjms, sjme, skms, skme, &
298 sips, sipe, sjps, sjpe, skps, skpe )
299 k_start = kps
300 k_end = kpe
302 num_3d_m = num_moist
303 num_3d_c = num_chem
304 num_3d_s = num_scalar
306 ! backward integration needs to advect only QV
307 if (grid%dfi_stage .EQ. DFI_BCK) then
308 num_3d_m = P_QV
309 num_3d_s = PARAM_FIRST_SCALAR - 1
310 endif
312 f_flux = config_flags%do_avgflx_cugd .EQ. 1
314 ! Compute these starting and stopping locations for each tile and number of tiles.
315 ! See: https://www2.mmm.ucar.edu/wrf/WG2/topics/settiles
316 CALL set_tiles ( ZONE_SOLVE_EM, grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
317 ! CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
319 ! Max values of CFL for adaptive time step scheme
321 ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
322 ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
324 !
325 ! Calculate current time in seconds since beginning of model run.
326 ! Unfortunately, ESMF does not seem to have a way to return
327 ! floating point seconds based on a TimeInterval. So, we will
328 ! calculate it here--but, this is not clean!!
329 !
330 tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid )
331 tmpTimeInterval2 = domain_get_current_time ( grid ) - domain_get_start_time ( grid )
332 curr_secs = real_time(tmpTimeInterval)
333 curr_secs2 = real_time(tmpTimeInterval2)
335 old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop
337 !-----------------------------------------------------------------------------
338 ! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07
339 ! In this call, we do the time-step adaptation and set time-dependent lateral
340 ! boundary condition nudging weights.
341 !
342 IF ( (config_flags%use_adaptive_time_step) .and. &
343 ( (.not. grid%nested) .or. &
344 ( (grid%nested) .and. (abs(grid%dtbc) < 0.0001) ) ) )THEN
345 CALL adapt_timestep(grid, config_flags)
346 adapt_step_flag = .TRUE.
347 ELSE
348 adapt_step_flag = .FALSE.
349 ENDIF
350 ! End of adaptive time step modifications
351 !-----------------------------------------------------------------------------
352 !
353 ! Set restart flag value history output time
354 !-----------------------------------------------------------------------------
355 restart_flag = .false.
356 if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(restart_alarm)) ) then
357 restart_flag = .true.
358 endif
359 !
360 ! Set diagnostic flag value history output time
361 !-----------------------------------------------------------------------------
363 ke_diag = kms ! default to ke_diag=1 in case of nwp_diagnostics == 1
364 diag_flag = .false.
365 if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(HISTORY_ALARM)) ) then
366 diag_flag = .true.
367 ke_diag = min(k_end,kde-1) ! set depth to full domain for reflectivity field
368 endif
369 IF (config_flags%nwp_diagnostics == 1) diag_flag = .true.
371 grid%itimestep = grid%itimestep + 1
372 grid%dtbc = grid%dtbc + grid%dt
374 IF( coupler_on ) CALL cpl_store_input( grid, config_flags )
376 IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
378 #if (WRF_CHEM == 1)
380 kte=min(k_end,kde-1)
381 # ifdef DM_PARALLEL
382 if ( num_chem >= PARAM_FIRST_SCALAR ) then
383 !-----------------------------------------------------------------------
384 ! see matching halo calls below for stencils
385 !--------------------------------------------------------------
386 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
387 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
388 # include "HALO_EM_CHEM_E_3.inc"
389 IF( config_flags%progn > 0 ) THEN
390 # include "HALO_EM_SCALAR_E_3.inc"
391 ENDIF
392 IF( config_flags%cu_physics == CAMZMSCHEME ) THEN
393 # include "HALO_EM_SCALAR_E_3.inc"
394 ENDIF
395 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
396 # include "HALO_EM_CHEM_E_5.inc"
397 IF( config_flags%cu_physics == CAMZMSCHEME ) THEN
398 # include "HALO_EM_SCALAR_E_5.inc"
399 ENDIF
400 IF( config_flags%progn > 0 ) THEN
401 # include "HALO_EM_SCALAR_E_5.inc"
402 ENDIF
403 ELSE
404 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
405 CALL wrf_error_fatal(TRIM(wrf_err_message))
406 ENDIF
407 ENDIF
408 if ( num_tracer >= PARAM_FIRST_SCALAR ) then
409 !-----------------------------------------------------------------------
410 ! see matching halo calls below for stencils
411 !--------------------------------------------------------------
412 CALL wrf_debug ( 200 , ' call HALO_RK_tracer' )
413 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
414 # include "HALO_EM_TRACER_E_3.inc"
415 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
416 # include "HALO_EM_TRACER_E_5.inc"
417 ELSE
418 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
419 CALL wrf_error_fatal(TRIM(wrf_err_message))
420 ENDIF
421 ENDIF
422 # endif
423 !--------------------------------------------------------------
424 adv_ct_indices( : ) = 1
425 IF ( config_flags%chemdiag == USECHEMDIAG ) THEN
426 ! modify tendency list here
427 ! note that the referencing direction here is opposite of that in chem_driver
428 adv_ct_indices(p_co ) = p_advh_co
429 adv_ct_indices(p_o3 ) = p_advh_o3
430 adv_ct_indices(p_no ) = p_advh_no
431 adv_ct_indices(p_no2 ) = p_advh_no2
432 adv_ct_indices(p_hno3) = p_advh_hno3
433 adv_ct_indices(p_iso ) = p_advh_iso
434 adv_ct_indices(p_ho ) = p_advh_ho
435 adv_ct_indices(p_ho2 ) = p_advh_ho2
436 END IF
437 #endif
439 rk_order = config_flags%rk_ord
441 IF ( grid%time_step_sound == 0 ) THEN
442 ! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
443 spacing = min(grid%dx, grid%dy)
444 IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
445 max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
446 1.0/COS(config_flags%fft_filter_lat*degrad) )
447 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
448 ELSE IF ( config_flags%use_adaptive_time_step ) THEN
449 max_msft= MAX(grid%max_msftx, grid%max_msfty)
450 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
451 ELSE
452 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 )
453 END IF
454 WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
455 CALL wrf_debug ( 50 , wrf_err_message )
456 ELSE
457 num_sound_steps = grid%time_step_sound
458 ENDIF
460 dts = grid%dt/float(num_sound_steps)
462 IF (config_flags%use_adaptive_time_step) THEN
464 CALL get_wrf_debug_level( debug_level )
465 IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
466 #ifdef DM_PARALLEL
467 CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
468 #endif
469 WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
470 grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
471 CALL wrf_debug ( 0 , wrf_err_message )
472 ENDIF
474 grid%max_cfl_val = 0
475 grid%max_horiz_cfl = 0
476 grid%max_vert_cfl = 0
477 ENDIF
479 ! setting bdy tendencies to zero for DFI if constant_bc = true
481 !$OMP PARALLEL DO &
482 !$OMP PRIVATE ( ij )
483 DO ij = 1 , grid%num_tiles
485 ! IF( config_flags%specified .AND. grid%dfi_opt .NE. DFI_NODFI &
486 ! .AND. config_flags%constant_bc .AND. (grid%dfi_stage .EQ. DFI_BCK .OR. grid%dfi_stage .EQ. DFI_FWD) ) THEN
487 IF( config_flags%specified .AND. config_flags%constant_bc ) THEN
489 CALL zero_bdytend (grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
490 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
491 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
492 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
493 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
494 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
495 moist_btxs,moist_btxe, &
496 moist_btys,moist_btye, &
497 scalar_btxs,scalar_btxe, &
498 scalar_btys,scalar_btye, &
499 grid%spec_bdy_width,num_3d_m,num_3d_s, &
500 ids,ide, jds,jde, kds,kde, &
501 ims,ime, jms,jme, kms,kme, &
502 ips,ipe, jps,jpe, kps,kpe, &
503 grid%i_start(ij), grid%i_end(ij), &
504 grid%j_start(ij), grid%j_end(ij), &
505 k_start, k_end )
507 ENDIF
509 ! If the user has requested to optionally select the moist theta (use_theta_m==1)
510 ! switch, the first setting of the "old" value of theta_m uses the "old"
511 ! value of Qv. The moist_old variable does not exist until after the advection
512 ! towards the end of the RK loop. For the first time in the RK loop, we need
513 ! a reasonable value for moist_old.
515 CALL initialize_moist_old ( moist_old(:,:,:,P_Qv), &
516 moist(:,:,:,P_Qv) , &
517 ids,ide, jds,jde, kds,kde, &
518 ims,ime, jms,jme, kms,kme, &
519 grid%i_start(ij), grid%i_end(ij), &
520 grid%j_start(ij), grid%j_end(ij), &
521 k_start, k_end )
522 ENDDO
523 !$OMP END PARALLEL DO
525 ! Now that we have initialized the moist_old values with P_Qv for
526 ! computing a moist t_tendf after rk_step part2, fill in the halo
527 ! and period boundaries.
529 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
530 # include "HALO_EM_MOIST_OLD_E_7.inc"
531 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
532 #endif
533 !$OMP PARALLEL DO &
534 !$OMP PRIVATE ( ij )
535 DO ij = 1 , grid%num_tiles
536 im = P_Qv
537 CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
538 ids, ide, jds, jde, kds, kde, &
539 ims, ime, jms, jme, kms, kme, &
540 ips, ipe, jps, jpe, kps, kpe, &
541 grid%i_start(ij), grid%i_end(ij), &
542 grid%j_start(ij), grid%j_end(ij), &
543 k_start , k_end )
544 END DO
545 !$OMP END PARALLEL DO
547 !**********************************************************************
548 !
549 ! LET US BEGIN.......
550 !
551 !<DESCRIPTION>
552 !<pre>
553 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
554 !
555 ! Predictor-corrector type time integration.
556 ! Advection terms are evaluated at time t for the predictor step,
557 ! and advection is re-evaluated with the latest predicted value for
558 ! each succeeding time corrector step
559 !
560 ! 2nd order Runge Kutta (rk_order = 2):
561 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
562 !
563 ! 3rd order Runge Kutta (rk_order = 3):
564 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
565 ! and step 3 is from t to dt.
566 !
567 ! non-timesplit physics are evaluated during first RK step and
568 ! these physics tendencies are stored for use in each RK pass.
569 !</pre>
570 !</DESCRIPTION>
571 !**********************************************************************
573 Runge_Kutta_loop: DO rk_step = 1, rk_order
575 ! Set the step size and number of small timesteps for
576 ! each part of the timestep
578 dtm = grid%dt
579 IF ( rk_order == 1 ) THEN
581 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
582 CALL wrf_error_fatal( wrf_err_message )
584 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
586 IF ( rk_step == 1) THEN
587 dt_rk = 0.5*grid%dt
588 dts_rk = dts
589 number_of_small_timesteps = num_sound_steps/2
590 ELSE
591 dt_rk = grid%dt
592 dts_rk = dts
593 number_of_small_timesteps = num_sound_steps
594 ENDIF
596 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
598 IF ( rk_step == 1) THEN
599 dt_rk = grid%dt/3.
600 dts_rk = dt_rk
601 number_of_small_timesteps = 1
602 ELSE IF (rk_step == 2) THEN
603 dt_rk = 0.5*grid%dt
604 dts_rk = dts
605 number_of_small_timesteps = num_sound_steps/2
606 ELSE
607 dt_rk = grid%dt
608 dts_rk = dts
609 number_of_small_timesteps = num_sound_steps
610 ENDIF
612 ELSE
614 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
615 CALL wrf_error_fatal( wrf_err_message )
617 END IF
619 ! Ensure that polar meridional velocity is zero
620 IF (config_flags%polar) THEN
621 !$OMP PARALLEL DO &
622 !$OMP PRIVATE ( ij )
623 DO ij = 1 , grid%num_tiles
624 CALL zero_pole ( grid%v_1, &
625 ids, ide, jds, jde, kds, kde, &
626 ims, ime, jms, jme, kms, kme, &
627 grid%i_start(ij), grid%i_end(ij), &
628 grid%j_start(ij), grid%j_end(ij), &
629 k_start, k_end )
630 CALL zero_pole ( grid%v_2, &
631 ids, ide, jds, jde, kds, kde, &
632 ims, ime, jms, jme, kms, kme, &
633 grid%i_start(ij), grid%i_end(ij), &
634 grid%j_start(ij), grid%j_end(ij), &
635 k_start, k_end )
636 END DO
637 !$OMP END PARALLEL DO
638 END IF
639 !
640 ! Time level t is in the *_2 variable in the first part
641 ! of the step, and in the *_1 variable after the predictor.
642 ! the latest predicted values are stored in the *_2 variables.
643 !
644 CALL wrf_debug ( 200 , ' call rk_step_prep ' )
646 BENCH_START(step_prep_tim)
647 !$OMP PARALLEL DO &
648 !$OMP PRIVATE ( ij )
650 DO ij = 1 , grid%num_tiles
652 CALL rk_step_prep ( config_flags, rk_step, &
653 grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, &
654 grid%c1h, grid%c2h, grid%c1f, grid%c2f, moist, &
655 grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, &
656 grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, &
657 cqu, cqv, cqw, &
658 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
659 grid%msfvy, grid%msftx, grid%msfty, &
660 grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
661 num_3d_m, &
662 ids, ide, jds, jde, kds, kde, &
663 ims, ime, jms, jme, kms, kme, &
664 grid%i_start(ij), grid%i_end(ij), &
665 grid%j_start(ij), grid%j_end(ij), &
666 k_start, k_end )
668 END DO
669 !$OMP END PARALLEL DO
670 BENCH_END(step_prep_tim)
672 #ifdef DM_PARALLEL
673 !-----------------------------------------------------------------------
674 ! Stencils for patch communications (WCS, 29 June 2001)
675 ! Note: the small size of this halo exchange reflects the
676 ! fact that we are carrying the uncoupled variables
677 ! as state variables in the mass coordinate model, as
678 ! opposed to the coupled variables as in the height
679 ! coordinate model.
680 !
681 ! * * * * *
682 ! * * * * * * * * *
683 ! * + * * + * * * + * *
684 ! * * * * * * * * *
685 ! * * * * *
686 !
687 ! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
688 !
689 ! ru x
690 ! rv x
691 ! ww x
692 ! php x
693 ! alt x
694 ! ph_2 x
695 ! phb x
696 !
697 ! the following are 2D (xy) variables
698 !
699 ! muu x
700 ! muv x
701 ! mut x
702 !--------------------------------------------------------------
703 # include "HALO_EM_A.inc"
704 #endif
706 ! set boundary conditions on variables
707 ! from big_step_prep for use in big_step_proc
709 #ifdef DM_PARALLEL
710 # include "PERIOD_BDY_EM_A.inc"
711 #endif
713 BENCH_START(set_phys_bc_tim)
714 !$OMP PARALLEL DO &
715 !$OMP PRIVATE ( ij, ii, jj, kk )
717 DO ij = 1 , grid%num_tiles
719 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
721 CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, &
722 grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, &
723 ids, ide, jds, jde, kds, kde, &
724 ims, ime, jms, jme, kms, kme, &
725 ips, ipe, jps, jpe, kps, kpe, &
726 grid%i_start(ij), grid%i_end(ij), &
727 grid%j_start(ij), grid%j_end(ij), &
728 k_start, k_end )
729 CALL set_physical_bc3d( grid%rho, 'p', config_flags, &
730 ids, ide, jds, jde, kds, kde, &
731 ims, ime, jms, jme, kms, kme, &
732 ips, ipe, jps, jpe, kps, kpe, &
733 grid%i_start(ij), grid%i_end(ij), &
734 grid%j_start(ij), grid%j_end(ij), &
735 k_start , k_end )
736 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
737 ids, ide, jds, jde, kds, kde, &
738 ims, ime, jms, jme, kms, kme, &
739 ips, ipe, jps, jpe, kps, kpe, &
740 grid%i_start(ij), grid%i_end(ij), &
741 grid%j_start(ij), grid%j_end(ij), &
742 k_start , k_end )
743 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
744 ids, ide, jds, jde, kds, kde, &
745 ims, ime, jms, jme, kms, kme, &
746 ips, ipe, jps, jpe, kps, kpe, &
747 grid%i_start(ij), grid%i_end(ij), &
748 grid%j_start(ij), grid%j_end(ij), &
749 k_start, k_end )
751 IF (config_flags%polar) THEN
753 !-------------------------------------------------------
754 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
755 !-------------------------------------------------------
757 CALL pole_point_bc ( grid%v_1, &
758 ids, ide, jds, jde, kds, kde, &
759 ims, ime, jms, jme, kms, kme, &
760 grid%i_start(ij), grid%i_end(ij), &
761 grid%j_start(ij), grid%j_end(ij), &
762 k_start, k_end )
764 CALL pole_point_bc ( grid%v_2, &
765 ids, ide, jds, jde, kds, kde, &
766 ims, ime, jms, jme, kms, kme, &
767 grid%i_start(ij), grid%i_end(ij), &
768 grid%j_start(ij), grid%j_end(ij), &
769 k_start, k_end )
771 !-------------------------------------------------------
772 ! end lat-lon grid pole-point (v) specification
773 !-------------------------------------------------------
775 ENDIF
776 END DO
777 !$OMP END PARALLEL DO
778 BENCH_END(set_phys_bc_tim)
780 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
782 BENCH_START(calc_p_rho_tim)
784 !<DESCRIPTION>
785 !<pre>
786 !(2) The non-timesplit physics begins with a call to "phy_prep"
787 ! (which computes some diagnostic variables such as temperature,
788 ! pressure, u and v at p points, etc). This is followed by
789 ! calls to the physics drivers:
790 !
791 ! radiation,
792 ! surface,
793 ! pbl,
794 ! cumulus,
795 ! fddagd,
796 ! 3D TKE and mixing.
797 !<pre>
798 !</DESCRIPTION>
800 IF (coupler_on) CALL cpl_settime( curr_secs2 )
802 CALL first_rk_step_part1 ( grid, config_flags &
803 , moist , moist_tend &
804 , chem , chem_tend &
805 , tracer, tracer_tend &
806 , scalar , scalar_tend &
807 , fdda3d, fdda2d &
808 , aerod &
809 , ru_tendf, rv_tendf &
810 , rw_tendf, t_tendf &
811 , ph_tendf, mu_tendf &
812 , tke_tend &
813 , config_flags%use_adaptive_time_step &
814 , curr_secs &
815 , psim , psih , gz1oz0 &
816 , chklowq &
817 , cu_act_flag , hol , th_phy &
818 , pi_phy , p_phy , grid%t_phy &
819 , dz8w , p8w , t8w &
820 , ids, ide, jds, jde, kds, kde &
821 , ims, ime, jms, jme, kms, kme &
822 , ips, ipe, jps, jpe, kps, kpe &
823 , imsx, imex, jmsx, jmex, kmsx, kmex &
824 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
825 , imsy, imey, jmsy, jmey, kmsy, kmey &
826 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
827 , k_start , k_end &
828 , f_flux=f_flux &
829 , aerocu=aerocu &
830 , restart_flag=restart_flag &
831 , feedback_is_ready=feedback_is_ready &
832 )
834 #ifdef DM_PARALLEL
835 IF ( config_flags%bl_pbl_physics == MYNNPBLSCHEME2 .OR. &
836 config_flags%bl_pbl_physics == MYNNPBLSCHEME3 ) THEN
837 # include "HALO_EM_SCALAR_E_5.inc"
838 ENDIF
839 #endif
841 CALL first_rk_step_part2 ( grid, config_flags &
842 , moist , moist_old , moist_tend &
843 , chem , chem_tend &
844 , tracer, tracer_tend &
845 , scalar , scalar_tend &
846 , fdda3d, fdda2d &
847 , ru_tendf, rv_tendf &
848 , rw_tendf, t_tendf &
849 , ph_tendf, mu_tendf &
850 , tke_tend &
851 , adapt_step_flag , curr_secs &
852 , psim , psih , gz1oz0 &
853 , chklowq &
854 , cu_act_flag , hol , th_phy &
855 , pi_phy , p_phy , grid%t_phy &
856 , dz8w , p8w , t8w &
857 , nba_mij, num_nba_mij & !JDM
858 , nba_rij, num_nba_rij & !JDM
859 , ids, ide, jds, jde, kds, kde &
860 , ims, ime, jms, jme, kms, kme &
861 , ips, ipe, jps, jpe, kps, kpe &
862 , imsx, imex, jmsx, jmex, kmsx, kmex &
863 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
864 , imsy, imey, jmsy, jmey, kmsy, kmey &
865 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
866 , k_start , k_end &
867 )
869 END IF rk_step_is_one
871 BENCH_START(rk_tend_tim)
872 !$OMP PARALLEL DO &
873 !$OMP PRIVATE ( ij )
874 DO ij = 1 , grid%num_tiles
876 CALL wrf_debug ( 200 , ' call rk_tendency' )
877 CALL rk_tendency ( config_flags, rk_step &
878 ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend &
879 ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf &
880 ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save &
881 ,grid%t_save, mu_save, grid%rthften &
882 ,grid%ru, grid%rv, grid%rw, grid%ww, wwE, wwI &
883 ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2 &
884 ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1 &
885 ,grid%h_diabatic, grid%phb, grid%t_init &
886 ,grid%mu_1, grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub &
887 ,grid%c1h, grid%c2h, grid%c1f, grid%c2f &
888 ,grid%al, grid%ht, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw &
889 ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base &
890 ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv &
891 ,grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa &
892 ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw &
893 ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh &
894 ,grid%diff_6th_opt, grid%diff_6th_factor &
895 ,config_flags%momentum_adv_opt &
896 ,grid%dampcoef,grid%zdamp,config_flags%damp_opt,config_flags%rad_nudge &
897 ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m &
898 ,config_flags%non_hydrostatic, config_flags%top_lid &
899 ,grid%u_frame, grid%v_frame &
900 ,ids, ide, jds, jde, kds, kde &
901 ,ims, ime, jms, jme, kms, kme &
902 ,grid%i_start(ij), grid%i_end(ij) &
903 ,grid%j_start(ij), grid%j_end(ij) &
904 ,k_start, k_end &
905 ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
906 END DO
907 !$OMP END PARALLEL DO
908 BENCH_END(rk_tend_tim)
910 IF (config_flags%use_adaptive_time_step) THEN
911 DO ij = 1 , grid%num_tiles
912 IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
913 grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
914 ENDIF
915 IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
916 grid%max_vert_cfl = max_vert_cfl_tmp(ij)
917 ENDIF
918 END DO
920 IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
921 grid%max_cfl_val = grid%max_horiz_cfl
922 ENDIF
923 IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
924 grid%max_cfl_val = grid%max_vert_cfl
925 ENDIF
926 ENDIF
928 BENCH_START(relax_bdy_dry_tim)
929 !$OMP PARALLEL DO &
930 !$OMP PRIVATE ( ij )
931 DO ij = 1 , grid%num_tiles
933 IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN
935 CALL relax_bdy_dry ( config_flags, &
936 grid%u_save, grid%v_save, ph_save, grid%t_save, &
937 w_save, mu_tend, grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
938 grid%ru, grid%rv, grid%ph_2, grid%t_2, &
939 grid%w_2, grid%mu_2, grid%mut, &
940 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
941 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
942 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
943 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
944 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
945 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
946 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
947 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
948 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
949 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
950 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
951 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
952 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
953 grid%dtbc, grid%fcx, grid%gcx, &
954 ids,ide, jds,jde, kds,kde, &
955 ims,ime, jms,jme, kms,kme, &
956 ips,ipe, jps,jpe, kps,kpe, &
957 grid%i_start(ij), grid%i_end(ij), &
958 grid%j_start(ij), grid%j_end(ij), &
959 k_start, k_end )
961 ENDIF
963 CALL rk_addtend_dry( grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend, &
964 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
965 grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
966 mu_tend, mu_tendf, rk_step, &
967 grid%c1h, grid%c2h, &
968 grid%h_diabatic, grid%mut, grid%msftx, &
969 grid%msfty, grid%msfux,grid%msfuy, &
970 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
971 ids,ide, jds,jde, kds,kde, &
972 ims,ime, jms,jme, kms,kme, &
973 ips,ipe, jps,jpe, kps,kpe, &
974 grid%i_start(ij), grid%i_end(ij), &
975 grid%j_start(ij), grid%j_end(ij), &
976 k_start, k_end )
978 IF( config_flags%specified .or. config_flags%nested ) THEN
979 CALL spec_bdy_dry ( config_flags, &
980 grid%ru_tend, grid%rv_tend, ph_tend, t_tend, &
981 rw_tend, mu_tend, &
982 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
983 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
984 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
985 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
986 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
987 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
988 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
989 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
990 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
991 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
992 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
993 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
994 config_flags%spec_bdy_width, grid%spec_zone, &
995 ids,ide, jds,jde, kds,kde, & ! domain dims
996 ims,ime, jms,jme, kms,kme, & ! memory dims
997 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
998 grid%i_start(ij), grid%i_end(ij), &
999 grid%j_start(ij), grid%j_end(ij), &
1000 k_start, k_end )
1003 ENDIF
1005 !---------------------------------------------------------------------------------------------
1006 ! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS
1007 ! pattern passed in for perturbing the specified boundry conditions. If peturb_bdy=2, user
1008 ! must provide pattern. mu_2, mub, msf* also passed in for coupling needed for tendecies.
1009 !---------------------------------------------------------------------------------------------
1010 IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN
1011 CALL spec_bdy_dry_perturb ( config_flags, &
1012 grid%ru_tend, grid%rv_tend, t_tend, &
1013 grid%mu_2, grid%mub, grid%c1h, grid%c2h, &
1014 grid%msfux, grid%msfvx, grid%msft, &
1015 grid%ru_tendf_stoch, grid%rv_tendf_stoch, grid%rt_tendf_stoch, &
1016 config_flags%spec_bdy_width, grid%spec_zone, &
1017 grid%num_stoch_levels, & ! stoch dims
1018 ids,ide, jds,jde, kds,kde, & ! domain dims
1019 ims,ime, jms,jme, kms,kme, & ! memory dims
1020 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1021 grid%i_start(ij), grid%i_end(ij), &
1022 grid%j_start(ij), grid%j_end(ij), &
1023 k_start, k_end )
1025 ENDIF
1027 IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN
1028 CALL spec_bdy_dry_perturb ( config_flags, &
1029 grid%ru_tend, grid%rv_tend, t_tend, &
1030 grid%mu_2, grid%mub, grid%c1h, grid%c2h, &
1031 grid%msfux, grid%msfvx, grid%msft, &
1032 grid%field_u_tend_perturb, grid%field_v_tend_perturb, grid%field_t_tend_perturb, &
1033 config_flags%spec_bdy_width, grid%spec_zone, &
1034 grid%num_stoch_levels, & ! stoch dims
1035 ids,ide, jds,jde, kds,kde, & ! domain dims
1036 ims,ime, jms,jme, kms,kme, & ! memory dims
1037 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1038 grid%i_start(ij), grid%i_end(ij), &
1039 grid%j_start(ij), grid%j_end(ij), &
1040 k_start, k_end )
1042 ENDIF
1044 END DO
1045 !$OMP END PARALLEL DO
1046 BENCH_END(relax_bdy_dry_tim)
1048 !<DESCRIPTION>
1049 !<pre>
1050 ! (3) Small (acoustic,sound) steps.
1051 !
1052 ! Several acoustic steps are taken each RK pass. A small step
1053 ! sequence begins with calculating perturbation variables
1054 ! and coupling them to the column dry-air-mass mu
1055 ! (call to small_step_prep). This is followed by computing
1056 ! coefficients for the vertically implicit part of the
1057 ! small timestep (call to calc_coef_w).
1058 !
1059 ! The small steps are taken
1060 ! in the named loop "small_steps:". In the small_steps loop, first
1061 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
1062 ! next mu and theta are advanced (call to advance_mu_t) followed by
1063 ! advancing w and the geopotential (call to advance_w). Diagnostic
1064 ! values for pressure and inverse density are updated at the end of
1065 ! each small_step.
1066 !
1067 ! The small-step section ends with the change of the perturbation variables
1068 ! back to full variables (call to small_step_finish).
1069 !</pre>
1070 !</DESCRIPTION>
1072 BENCH_START(small_step_prep_tim)
1073 !$OMP PARALLEL DO &
1074 !$OMP PRIVATE ( ij )
1075 DO ij = 1 , grid%num_tiles
1077 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
1078 ! integration. We only need calculate these for the first pass through -
1079 ! the predictor step. They are reused as is for the corrector step.
1080 ! For third-order RK, we need to recompute these after the first
1081 ! predictor because we may have changed the small timestep -> grid%dts.
1083 CALL wrf_debug ( 200 , ' call small_step_prep ' )
1085 CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2, &
1086 grid%t_1,grid%t_2,grid%ph_1,grid%ph_2, &
1087 grid%mub, grid%mu_1, grid%mu_2, &
1088 grid%muu, grid%muus, grid%muv, grid%muvs, &
1089 grid%mut, grid%muts, grid%mudf, &
1090 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1091 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1092 grid%u_save, grid%v_save, w_save, &
1093 grid%t_save, ph_save, mu_save, &
1094 grid%ww, ww1, &
1095 c2a, grid%pb, grid%p, grid%alt, &
1096 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1097 grid%msfvy, grid%msftx,grid%msfty, &
1098 grid%rdx, grid%rdy, rk_step, &
1099 ids, ide, jds, jde, kds, kde, &
1100 ims, ime, jms, jme, kms, kme, &
1101 grid%i_start(ij), grid%i_end(ij), &
1102 grid%j_start(ij), grid%j_end(ij), &
1103 k_start , k_end )
1105 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1106 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1107 grid%mu_2, grid%muts, &
1108 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1109 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1110 grid%znu, t0, &
1111 grid%rdnw, grid%dnw, grid%smdiv, &
1112 config_flags%non_hydrostatic, 0, &
1113 ids, ide, jds, jde, kds, kde, &
1114 ims, ime, jms, jme, kms, kme, &
1115 grid%i_start(ij), grid%i_end(ij), &
1116 grid%j_start(ij), grid%j_end(ij), &
1117 k_start , k_end )
1119 IF (config_flags%non_hydrostatic) THEN
1120 CALL calc_coef_w( a,alpha,gamma, &
1121 grid%mut, &
1122 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1123 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1124 cqw, grid%rdn, grid%rdnw, c2a, &
1125 dts_rk, g, grid%epssm, &
1126 config_flags%top_lid, &
1127 ids, ide, jds, jde, kds, kde, &
1128 ims, ime, jms, jme, kms, kme, &
1129 grid%i_start(ij), grid%i_end(ij), &
1130 grid%j_start(ij), grid%j_end(ij), &
1131 k_start , k_end )
1132 ENDIF
1134 ENDDO
1135 !$OMP END PARALLEL DO
1136 BENCH_END(small_step_prep_tim)
1138 #ifdef DM_PARALLEL
1139 !-----------------------------------------------------------------------
1140 ! Stencils for patch communications (WCS, 29 June 2001)
1141 ! Note: the small size of this halo exchange reflects the
1142 ! fact that we are carrying the uncoupled variables
1143 ! as state variables in the mass coordinate model, as
1144 ! opposed to the coupled variables as in the height
1145 ! coordinate model.
1146 !
1147 ! * * * * *
1148 ! * * * * * * * * *
1149 ! * + * * + * * * + * *
1150 ! * * * * * * * * *
1151 ! * * * * *
1152 !
1153 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
1154 !
1155 ! ph_2 x
1156 ! al x
1157 ! p x
1158 ! t_1 x
1159 ! t_save x
1160 ! u_save x
1161 ! v_save x
1162 !
1163 ! the following are 2D (xy) variables
1164 !
1165 ! mu_1 x
1166 ! mu_2 x
1167 ! mudf x
1168 ! php x
1169 ! alt x
1170 ! pb x
1171 !--------------------------------------------------------------
1172 # include "HALO_EM_B.inc"
1173 # include "PERIOD_BDY_EM_B.inc"
1174 #endif
1176 BENCH_START(set_phys_bc2_tim)
1177 !$OMP PARALLEL DO &
1178 !$OMP PRIVATE ( ij )
1180 DO ij = 1 , grid%num_tiles
1182 CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags, &
1183 ids, ide, jds, jde, kds, kde, &
1184 ims, ime, jms, jme, kms, kme, &
1185 ips, ipe, jps, jpe, kps, kpe, &
1186 grid%i_start(ij), grid%i_end(ij), &
1187 grid%j_start(ij), grid%j_end(ij), &
1188 k_start , k_end )
1190 CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags, &
1191 ids, ide, jds, jde, kds, kde, &
1192 ims, ime, jms, jme, kms, kme, &
1193 ips, ipe, jps, jpe, kps, kpe, &
1194 grid%i_start(ij), grid%i_end(ij), &
1195 grid%j_start(ij), grid%j_end(ij), &
1196 k_start , k_end )
1198 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1199 ids, ide, jds, jde, kds, kde, &
1200 ims, ime, jms, jme, kms, kme, &
1201 ips, ipe, jps, jpe, kps, kpe, &
1202 grid%i_start(ij), grid%i_end(ij), &
1203 grid%j_start(ij), grid%j_end(ij), &
1204 k_start , k_end )
1206 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1207 ids, ide, jds, jde, kds, kde, &
1208 ims, ime, jms, jme, kms, kme, &
1209 ips, ipe, jps, jpe, kps, kpe, &
1210 grid%i_start(ij), grid%i_end(ij), &
1211 grid%j_start(ij), grid%j_end(ij), &
1212 k_start , k_end )
1214 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1215 ids, ide, jds, jde, kds, kde, &
1216 ims, ime, jms, jme, kms, kme, &
1217 ips, ipe, jps, jpe, kps, kpe, &
1218 grid%i_start(ij), grid%i_end(ij), &
1219 grid%j_start(ij), grid%j_end(ij), &
1220 k_start , k_end )
1222 CALL set_physical_bc3d( grid%t_1, 'p', config_flags, &
1223 ids, ide, jds, jde, kds, kde, &
1224 ims, ime, jms, jme, kms, kme, &
1225 ips, ipe, jps, jpe, kps, kpe, &
1226 grid%i_start(ij), grid%i_end(ij), &
1227 grid%j_start(ij), grid%j_end(ij), &
1228 k_start , k_end )
1230 CALL set_physical_bc3d( grid%t_save, 't', config_flags, &
1231 ids, ide, jds, jde, kds, kde, &
1232 ims, ime, jms, jme, kms, kme, &
1233 ips, ipe, jps, jpe, kps, kpe, &
1234 grid%i_start(ij), grid%i_end(ij), &
1235 grid%j_start(ij), grid%j_end(ij), &
1236 k_start , k_end )
1238 CALL set_physical_bc2d( grid%mu_1, 't', config_flags, &
1239 ids, ide, jds, jde, &
1240 ims, ime, jms, jme, &
1241 ips, ipe, jps, jpe, &
1242 grid%i_start(ij), grid%i_end(ij), &
1243 grid%j_start(ij), grid%j_end(ij) )
1245 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1246 ids, ide, jds, jde, &
1247 ims, ime, jms, jme, &
1248 ips, ipe, jps, jpe, &
1249 grid%i_start(ij), grid%i_end(ij), &
1250 grid%j_start(ij), grid%j_end(ij) )
1252 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1253 ids, ide, jds, jde, &
1254 ims, ime, jms, jme, &
1255 ips, ipe, jps, jpe, &
1256 grid%i_start(ij), grid%i_end(ij), &
1257 grid%j_start(ij), grid%j_end(ij) )
1259 END DO
1260 !$OMP END PARALLEL DO
1261 BENCH_END(set_phys_bc2_tim)
1262 small_steps : DO iteration = 1 , number_of_small_timesteps
1264 ! Boundary condition time (or communication time).
1265 #ifdef DM_PARALLEL
1266 # include "PERIOD_BDY_EM_B.inc"
1267 #endif
1269 !$OMP PARALLEL DO &
1270 !$OMP PRIVATE ( ij )
1272 DO ij = 1 , grid%num_tiles
1274 BENCH_START(advance_uv_tim)
1275 CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend, &
1276 grid%p, grid%pb, &
1277 grid%ph_2, grid%php, grid%alt, grid%al, &
1278 grid%mu_2, grid%muu, cqu, grid%muv, cqv, grid%mudf, &
1279 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1280 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1281 grid%msfux, grid%msfuy, grid%msfvx, &
1282 grid%msfvx_inv, grid%msfvy, &
1283 grid%rdx, grid%rdy, dts_rk, &
1284 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
1285 grid%emdiv, &
1286 grid%rdnw, config_flags,grid%spec_zone, &
1287 config_flags%non_hydrostatic, config_flags%top_lid, &
1288 ids, ide, jds, jde, kds, kde, &
1289 ims, ime, jms, jme, kms, kme, &
1290 grid%i_start(ij), grid%i_end(ij), &
1291 grid%j_start(ij), grid%j_end(ij), &
1292 k_start , k_end )
1293 BENCH_END(advance_uv_tim)
1295 END DO
1296 !$OMP END PARALLEL DO
1298 !-----------------------------------------------------------
1299 ! acoustic integration polar filter for smallstep u, v
1300 !-----------------------------------------------------------
1302 IF (config_flags%polar) THEN
1304 CALL pxft ( grid=grid &
1305 ,lineno=__LINE__ &
1306 ,flag_uv = 1 &
1307 ,flag_rurv = 0 &
1308 ,flag_wph = 0 &
1309 ,flag_ww = 0 &
1310 ,flag_t = 0 &
1311 ,flag_mu = 0 &
1312 ,flag_mut = 0 &
1313 ,flag_moist = 0 &
1314 ,flag_chem = 0 &
1315 ,flag_tracer = 0 &
1316 ,flag_scalar = 0 &
1317 ,actual_distance_average = .FALSE. &
1318 ,pos_def = .FALSE. &
1319 ,swap_pole_with_next_j = .FALSE. &
1320 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1321 ,fft_filter_lat = config_flags%fft_filter_lat &
1322 ,dclat = dclat &
1323 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1324 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1325 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1326 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1327 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1329 END IF
1331 !-----------------------------------------------------------
1332 ! end acoustic integration polar filter for smallstep u, v
1333 !-----------------------------------------------------------
1335 !$OMP PARALLEL DO &
1336 !$OMP PRIVATE ( ij )
1337 DO ij = 1 , grid%num_tiles
1339 BENCH_START(spec_bdy_uv_tim)
1340 IF( config_flags%specified .or. config_flags%nested ) THEN
1341 CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk, &
1342 'u' , config_flags, &
1343 grid%spec_zone, &
1344 ids,ide, jds,jde, kds,kde, & ! domain dims
1345 ims,ime, jms,jme, kms,kme, & ! memory dims
1346 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1347 grid%i_start(ij), grid%i_end(ij), &
1348 grid%j_start(ij), grid%j_end(ij), &
1349 k_start , k_end )
1351 CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk, &
1352 'v' , config_flags, &
1353 grid%spec_zone, &
1354 ids,ide, jds,jde, kds,kde, & ! domain dims
1355 ims,ime, jms,jme, kms,kme, & ! memory dims
1356 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1357 grid%i_start(ij), grid%i_end(ij), &
1358 grid%j_start(ij), grid%j_end(ij), &
1359 k_start , k_end )
1361 ENDIF
1362 BENCH_END(spec_bdy_uv_tim)
1364 END DO
1365 !$OMP END PARALLEL DO
1367 #ifdef DM_PARALLEL
1368 !
1369 ! Stencils for patch communications (WCS, 29 June 2001)
1370 !
1371 ! * *
1372 ! * + * * + * +
1373 ! * *
1374 !
1375 ! u_2 x
1376 ! v_2 x
1377 !
1378 # include "HALO_EM_C.inc"
1379 #endif
1381 !$OMP PARALLEL DO &
1382 !$OMP PRIVATE ( ij )
1383 DO ij = 1 , grid%num_tiles
1385 ! advance the mass in the column, theta, and calculate ww
1387 BENCH_START(advance_mu_t_tim)
1388 CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
1389 grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv, &
1390 grid%mudf, &
1391 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1392 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1393 grid%ru_m, grid%rv_m, grid%ww_m, &
1394 grid%t_2, grid%t_save, t_2save, t_tend, &
1395 mu_tend, &
1396 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1397 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1398 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1399 grid%msfvy, grid%msftx,grid%msfty, &
1400 iteration, config_flags, &
1401 ids, ide, jds, jde, kds, kde, &
1402 ims, ime, jms, jme, kms, kme, &
1403 grid%i_start(ij), grid%i_end(ij), &
1404 grid%j_start(ij), grid%j_end(ij), &
1405 k_start , k_end )
1406 BENCH_END(advance_mu_t_tim)
1407 ENDDO
1408 !$OMP END PARALLEL DO
1410 !-----------------------------------------------------------
1411 ! acoustic integration polar filter for smallstep mu, t
1412 !-----------------------------------------------------------
1414 IF ( (config_flags%polar) ) THEN
1416 CALL pxft ( grid=grid &
1417 ,lineno=__LINE__ &
1418 ,flag_uv = 0 &
1419 ,flag_rurv = 0 &
1420 ,flag_wph = 0 &
1421 ,flag_ww = 0 &
1422 ,flag_t = 1 &
1423 ,flag_mu = 1 &
1424 ,flag_mut = 0 &
1425 ,flag_moist = 0 &
1426 ,flag_chem = 0 &
1427 ,flag_tracer = 0 &
1428 ,flag_scalar = 0 &
1429 ,actual_distance_average = .FALSE. &
1430 ,pos_def = .FALSE. &
1431 ,swap_pole_with_next_j = .FALSE. &
1432 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1433 ,fft_filter_lat = config_flags%fft_filter_lat &
1434 ,dclat = dclat &
1435 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1436 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1437 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1438 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1439 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1441 grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1443 END IF
1445 !-----------------------------------------------------------
1446 ! end acoustic integration polar filter for smallstep mu, t
1447 !-----------------------------------------------------------
1449 BENCH_START(spec_bdy_t_tim)
1451 !$OMP PARALLEL DO &
1452 !$OMP PRIVATE ( ij )
1453 DO ij = 1 , grid%num_tiles
1455 IF( config_flags%specified .or. config_flags%nested ) THEN
1457 CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk, &
1458 't' , config_flags, &
1459 grid%spec_zone, &
1460 ids,ide, jds,jde, kds,kde, &
1461 ims,ime, jms,jme, kms,kme, &
1462 ips,ipe, jps,jpe, kps,kpe, &
1463 grid%i_start(ij), grid%i_end(ij),&
1464 grid%j_start(ij), grid%j_end(ij),&
1465 k_start , k_end )
1467 CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk, &
1468 'm' , config_flags, &
1469 grid%spec_zone, &
1470 ids,ide, jds,jde, 1 ,1 , &
1471 ims,ime, jms,jme, 1 ,1 , &
1472 ips,ipe, jps,jpe, 1 ,1 , &
1473 grid%i_start(ij), grid%i_end(ij),&
1474 grid%j_start(ij), grid%j_end(ij),&
1475 1 , 1 )
1477 CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk, &
1478 'm' , config_flags, &
1479 grid%spec_zone, &
1480 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1481 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1482 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1483 grid%i_start(ij), grid%i_end(ij), &
1484 grid%j_start(ij), grid%j_end(ij), &
1485 1 , 1 )
1486 ENDIF
1487 BENCH_END(spec_bdy_t_tim)
1489 ! small (acoustic) step for the vertical momentum,
1490 ! density and coupled potential temperature.
1493 BENCH_START(advance_w_tim)
1494 IF ( config_flags%non_hydrostatic ) THEN
1495 CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save, &
1496 grid%u_2, grid%v_2, &
1497 grid%mu_2, grid%mut, muave, grid%muts, &
1498 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1499 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1500 t_2save, grid%t_2, grid%t_save, &
1501 grid%ph_2, ph_save, grid%phb, ph_tend, &
1502 grid%ht, c2a, cqw, grid%alt, grid%alb, &
1503 a, alpha, gamma, &
1504 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1505 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1506 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1507 grid%msftx, grid%msfty, &
1508 config_flags, config_flags%top_lid, &
1509 ids,ide, jds,jde, kds,kde, &
1510 ims,ime, jms,jme, kms,kme, &
1511 grid%i_start(ij), grid%i_end(ij), &
1512 grid%j_start(ij), grid%j_end(ij), &
1513 k_start , k_end )
1514 ENDIF
1515 BENCH_END(advance_w_tim)
1517 ENDDO
1518 !$OMP END PARALLEL DO
1520 !-----------------------------------------------------------
1521 ! acoustic integration polar filter for smallstep w, geopotential
1522 !-----------------------------------------------------------
1524 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1526 CALL pxft ( grid=grid &
1527 ,lineno=__LINE__ &
1528 ,flag_uv = 0 &
1529 ,flag_rurv = 0 &
1530 ,flag_wph = 1 &
1531 ,flag_ww = 0 &
1532 ,flag_t = 0 &
1533 ,flag_mu = 0 &
1534 ,flag_mut = 0 &
1535 ,flag_moist = 0 &
1536 ,flag_chem = 0 &
1537 ,flag_tracer = 0 &
1538 ,flag_scalar = 0 &
1539 ,actual_distance_average = .FALSE. &
1540 ,pos_def = .FALSE. &
1541 ,swap_pole_with_next_j = .FALSE. &
1542 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1543 ,fft_filter_lat = config_flags%fft_filter_lat &
1544 ,dclat = dclat &
1545 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1546 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1547 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1548 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1549 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1551 END IF
1553 !-----------------------------------------------------------
1554 ! end acoustic integration polar filter for smallstep w, geopotential
1555 !-----------------------------------------------------------
1557 !$OMP PARALLEL DO &
1558 !$OMP PRIVATE ( ij )
1559 DO ij = 1 , grid%num_tiles
1561 BENCH_START(sumflux_tim)
1562 CALL sumflux ( grid%u_2, grid%v_2, grid%ww, &
1563 grid%u_save, grid%v_save, ww1, &
1564 grid%muu, grid%muv, &
1565 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1566 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1567 grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm, &
1568 grid%msfux, grid% msfuy, grid%msfvx, &
1569 grid%msfvx_inv, grid%msfvy, &
1570 iteration, number_of_small_timesteps, &
1571 ids, ide, jds, jde, kds, kde, &
1572 ims, ime, jms, jme, kms, kme, &
1573 grid%i_start(ij), grid%i_end(ij), &
1574 grid%j_start(ij), grid%j_end(ij), &
1575 k_start , k_end )
1576 BENCH_END(sumflux_tim)
1578 IF( config_flags%specified .or. config_flags%nested ) THEN
1580 BENCH_START(spec_bdynhyd_tim)
1581 IF (config_flags%non_hydrostatic) THEN
1582 CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend, &
1583 mu_tend, grid%muts, &
1584 grid%c1f, grid%c2f, dts_rk, &
1585 'h' , config_flags, &
1586 grid%spec_zone, &
1587 ids,ide, jds,jde, kds,kde, &
1588 ims,ime, jms,jme, kms,kme, &
1589 ips,ipe, jps,jpe, kps,kpe, &
1590 grid%i_start(ij), grid%i_end(ij),&
1591 grid%j_start(ij), grid%j_end(ij),&
1592 k_start , k_end )
1593 IF( config_flags%specified ) THEN
1594 CALL zero_grad_bdy ( grid%w_2, &
1595 'w' , config_flags, &
1596 grid%spec_zone, &
1597 ids,ide, jds,jde, kds,kde, &
1598 ims,ime, jms,jme, kms,kme, &
1599 ips,ipe, jps,jpe, kps,kpe, &
1600 grid%i_start(ij), grid%i_end(ij), &
1601 grid%j_start(ij), grid%j_end(ij), &
1602 k_start , k_end )
1603 ELSE
1604 CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk, &
1605 'h' , config_flags, &
1606 grid%spec_zone, &
1607 ids,ide, jds,jde, kds,kde, &
1608 ims,ime, jms,jme, kms,kme, &
1609 ips,ipe, jps,jpe, kps,kpe, &
1610 grid%i_start(ij), grid%i_end(ij),&
1611 grid%j_start(ij), grid%j_end(ij),&
1612 k_start , k_end )
1613 ENDIF
1614 ENDIF
1615 BENCH_END(spec_bdynhyd_tim)
1616 ENDIF
1618 BENCH_START(cald_p_rho_tim)
1619 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1620 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1621 grid%mu_2, grid%muts, &
1622 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1623 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1624 grid%znu, t0, &
1625 grid%rdnw, grid%dnw, grid%smdiv, &
1626 config_flags%non_hydrostatic, iteration, &
1627 ids, ide, jds, jde, kds, kde, &
1628 ims, ime, jms, jme, kms, kme, &
1629 grid%i_start(ij), grid%i_end(ij), &
1630 grid%j_start(ij), grid%j_end(ij), &
1631 k_start , k_end )
1632 BENCH_END(cald_p_rho_tim)
1634 ENDDO
1635 !$OMP END PARALLEL DO
1637 #ifdef DM_PARALLEL
1638 !
1639 ! Stencils for patch communications (WCS, 29 June 2001)
1640 !
1641 ! * *
1642 ! * + * * + * +
1643 ! * *
1644 !
1645 ! ph_2 x
1646 ! al x
1647 ! p x
1648 !
1649 ! 2D variables (x,y)
1650 !
1651 ! mu_2 x
1652 ! muts x
1653 ! mudf x
1655 # include "HALO_EM_C2.inc"
1656 # include "PERIOD_BDY_EM_B3.inc"
1657 #endif
1659 BENCH_START(phys_bc_tim)
1660 !$OMP PARALLEL DO &
1661 !$OMP PRIVATE ( ij )
1662 DO ij = 1 , grid%num_tiles
1664 ! boundary condition set for next small timestep
1666 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1667 ids, ide, jds, jde, kds, kde, &
1668 ims, ime, jms, jme, kms, kme, &
1669 ips, ipe, jps, jpe, kps, kpe, &
1670 grid%i_start(ij), grid%i_end(ij), &
1671 grid%j_start(ij), grid%j_end(ij), &
1672 k_start , k_end )
1674 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1675 ids, ide, jds, jde, kds, kde, &
1676 ims, ime, jms, jme, kms, kme, &
1677 ips, ipe, jps, jpe, kps, kpe, &
1678 grid%i_start(ij), grid%i_end(ij), &
1679 grid%j_start(ij), grid%j_end(ij), &
1680 k_start , k_end )
1682 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1683 ids, ide, jds, jde, kds, kde, &
1684 ims, ime, jms, jme, kms, kme, &
1685 ips, ipe, jps, jpe, kps, kpe, &
1686 grid%i_start(ij), grid%i_end(ij), &
1687 grid%j_start(ij), grid%j_end(ij), &
1688 k_start , k_end )
1690 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1691 ids, ide, jds, jde, &
1692 ims, ime, jms, jme, &
1693 ips, ipe, jps, jpe, &
1694 grid%i_start(ij), grid%i_end(ij), &
1695 grid%j_start(ij), grid%j_end(ij) )
1697 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1698 ids, ide, jds, jde, &
1699 ims, ime, jms, jme, &
1700 ips, ipe, jps, jpe, &
1701 grid%i_start(ij), grid%i_end(ij), &
1702 grid%j_start(ij), grid%j_end(ij) )
1704 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1705 ids, ide, jds, jde, &
1706 ims, ime, jms, jme, &
1707 ips, ipe, jps, jpe, &
1708 grid%i_start(ij), grid%i_end(ij), &
1709 grid%j_start(ij), grid%j_end(ij) )
1711 END DO
1712 !$OMP END PARALLEL DO
1713 BENCH_END(phys_bc_tim)
1715 END DO small_steps
1717 !$OMP PARALLEL DO &
1718 !$OMP PRIVATE ( ij )
1719 DO ij = 1 , grid%num_tiles
1721 CALL wrf_debug ( 200 , ' call rk_small_finish' )
1723 ! change time-perturbation variables back to
1724 ! full perturbation variables.
1725 ! first get updated mu at u and v points
1727 BENCH_START(calc_mu_uv_tim)
1728 CALL calc_mu_uv_1 ( config_flags, &
1729 grid%muts, grid%muus, grid%muvs, &
1730 ids, ide, jds, jde, kds, kde, &
1731 ims, ime, jms, jme, kms, kme, &
1732 grid%i_start(ij), grid%i_end(ij), &
1733 grid%j_start(ij), grid%j_end(ij), &
1734 k_start , k_end )
1735 BENCH_END(calc_mu_uv_tim)
1736 BENCH_START(small_step_finish_tim)
1737 CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1, &
1738 grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1, &
1739 grid%mu_2, grid%mu_1, &
1740 grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs, &
1741 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1742 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1743 grid%u_save, grid%v_save, w_save, &
1744 grid%t_save, ph_save, mu_save, &
1745 grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
1746 grid%h_diabatic, &
1747 number_of_small_timesteps,dts_rk, &
1748 rk_step, rk_order, &
1749 ids, ide, jds, jde, kds, kde, &
1750 ims, ime, jms, jme, kms, kme, &
1751 grid%i_start(ij), grid%i_end(ij), &
1752 grid%j_start(ij), grid%j_end(ij), &
1753 k_start , k_end )
1754 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
1756 IF (rk_step == rk_order) THEN
1758 CALL set_physical_bc3d( grid%ru_m, 'u', config_flags, &
1759 ids, ide, jds, jde, kds, kde, &
1760 ims, ime, jms, jme, kms, kme, &
1761 ips, ipe, jps, jpe, kps, kpe, &
1762 grid%i_start(ij), grid%i_end(ij), &
1763 grid%j_start(ij), grid%j_end(ij), &
1764 k_start , k_end )
1766 CALL set_physical_bc3d( grid%rv_m, 'v', config_flags, &
1767 ids, ide, jds, jde, kds, kde, &
1768 ims, ime, jms, jme, kms, kme, &
1769 ips, ipe, jps, jpe, kps, kpe, &
1770 grid%i_start(ij), grid%i_end(ij), &
1771 grid%j_start(ij), grid%j_end(ij), &
1772 k_start , k_end )
1774 CALL set_physical_bc3d( grid%ww_m, 'w', config_flags, &
1775 ids, ide, jds, jde, kds, kde, &
1776 ims, ime, jms, jme, kms, kme, &
1777 ips, ipe, jps, jpe, kps, kpe, &
1778 grid%i_start(ij), grid%i_end(ij), &
1779 grid%j_start(ij), grid%j_end(ij), &
1780 k_start , k_end )
1782 CALL set_physical_bc2d( grid%mut, 't', config_flags, &
1783 ids, ide, jds, jde, &
1784 ims, ime, jms, jme, &
1785 ips, ipe, jps, jpe, &
1786 grid%i_start(ij), grid%i_end(ij), &
1787 grid%j_start(ij), grid%j_end(ij) )
1789 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1790 ids, ide, jds, jde, &
1791 ims, ime, jms, jme, &
1792 ips, ipe, jps, jpe, &
1793 grid%i_start(ij), grid%i_end(ij), &
1794 grid%j_start(ij), grid%j_end(ij) )
1796 END IF
1798 BENCH_END(small_step_finish_tim)
1800 END DO
1801 !$OMP END PARALLEL DO
1803 !-----------------------------------------------------------
1804 ! polar filter for full dynamics variables and time-averaged mass fluxes
1805 !-----------------------------------------------------------
1807 IF (config_flags%polar) THEN
1809 CALL pxft ( grid=grid &
1810 ,lineno=__LINE__ &
1811 ,flag_uv = 1 &
1812 ,flag_rurv = 1 &
1813 ,flag_wph = 1 &
1814 ,flag_ww = 1 &
1815 ,flag_t = 1 &
1816 ,flag_mu = 1 &
1817 ,flag_mut = 1 &
1818 ,flag_moist = 0 &
1819 ,flag_chem = 0 &
1820 ,flag_tracer = 0 &
1821 ,flag_scalar = 0 &
1822 ,actual_distance_average = .FALSE. &
1823 ,pos_def = .FALSE. &
1824 ,swap_pole_with_next_j = .FALSE. &
1825 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1826 ,fft_filter_lat = config_flags%fft_filter_lat &
1827 ,dclat = dclat &
1828 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1829 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1830 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1831 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1832 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1834 END IF
1836 !-----------------------------------------------------------
1837 ! end polar filter for full dynamics variables and time-averaged mass fluxes
1838 !-----------------------------------------------------------
1840 !-----------------------------------------------------------------------
1841 ! add in physics tendency first if positive definite advection is used.
1842 ! pd advection applies advective flux limiter on last runge-kutta step
1843 !-----------------------------------------------------------------------
1844 ! first moisture
1846 IF ((config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. &
1847 (rk_step == rk_order)) THEN
1849 !$OMP PARALLEL DO &
1850 !$OMP PRIVATE ( ij )
1851 DO ij = 1 , grid%num_tiles
1852 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1853 DO im = PARAM_FIRST_SCALAR, num_3d_m
1854 CALL rk_update_scalar_pd( im, im, &
1855 moist_old(ims,kms,jms,im), &
1856 moist_tend(ims,kms,jms,im), &
1857 grid%c1h, grid%c2h, &
1858 grid%mu_1, grid%mu_1, grid%mub, &
1859 rk_step, dt_rk, grid%spec_zone, &
1860 config_flags, &
1861 ids, ide, jds, jde, kds, kde, &
1862 ims, ime, jms, jme, kms, kme, &
1863 grid%i_start(ij), grid%i_end(ij), &
1864 grid%j_start(ij), grid%j_end(ij), &
1865 k_start , k_end )
1866 ENDDO
1867 END DO
1868 !$OMP END PARALLEL DO
1870 !---------------------- positive definite bc call
1871 #ifdef DM_PARALLEL
1872 IF (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) THEN
1873 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1874 # include "HALO_EM_MOIST_OLD_E_5.inc"
1875 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1876 # include "HALO_EM_MOIST_OLD_E_7.inc"
1877 ELSE
1878 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1879 CALL wrf_error_fatal(TRIM(wrf_err_message))
1880 ENDIF
1881 ENDIF
1882 #endif
1884 #ifdef DM_PARALLEL
1885 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
1886 #endif
1888 !$OMP PARALLEL DO &
1889 !$OMP PRIVATE ( ij )
1890 DO ij = 1 , grid%num_tiles
1891 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1892 DO im = PARAM_FIRST_SCALAR , num_3d_m
1893 CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
1894 ids, ide, jds, jde, kds, kde, &
1895 ims, ime, jms, jme, kms, kme, &
1896 ips, ipe, jps, jpe, kps, kpe, &
1897 grid%i_start(ij), grid%i_end(ij), &
1898 grid%j_start(ij), grid%j_end(ij), &
1899 k_start , k_end )
1900 END DO
1901 ENDIF
1902 END DO
1903 !$OMP END PARALLEL DO
1905 END IF ! end if for moist_adv_opt
1907 ! scalars
1909 IF ((config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. &
1910 (rk_step == rk_order)) THEN
1912 !$OMP PARALLEL DO &
1913 !$OMP PRIVATE ( ij )
1914 DO ij = 1 , grid%num_tiles
1915 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1916 DO im = PARAM_FIRST_SCALAR, num_3d_s
1917 CALL rk_update_scalar_pd( im, im, &
1918 scalar_old(ims,kms,jms,im), &
1919 scalar_tend(ims,kms,jms,im), &
1920 grid%c1h, grid%c2h, &
1921 grid%mu_1, grid%mu_1, grid%mub, &
1922 rk_step, dt_rk, grid%spec_zone, &
1923 config_flags, &
1924 ids, ide, jds, jde, kds, kde, &
1925 ims, ime, jms, jme, kms, kme, &
1926 grid%i_start(ij), grid%i_end(ij), &
1927 grid%j_start(ij), grid%j_end(ij), &
1928 k_start , k_end )
1929 ENDDO
1930 ENDDO
1931 !$OMP END PARALLEL DO
1933 !---------------------- positive definite bc call
1934 #ifdef DM_PARALLEL
1935 IF (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) THEN
1936 #ifndef RSL
1937 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1938 # include "HALO_EM_SCALAR_OLD_E_5.inc"
1939 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1940 # include "HALO_EM_SCALAR_OLD_E_7.inc"
1941 ELSE
1942 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1943 CALL wrf_error_fatal(TRIM(wrf_err_message))
1944 ENDIF
1945 #else
1946 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1947 CALL wrf_error_fatal(TRIM(wrf_err_message))
1948 #endif
1949 endif
1950 #endif
1952 #ifdef DM_PARALLEL
1953 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1954 #endif
1955 !$OMP PARALLEL DO &
1956 !$OMP PRIVATE ( ij )
1958 DO ij = 1 , grid%num_tiles
1959 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
1960 DO im = PARAM_FIRST_SCALAR , num_3d_s
1961 CALL set_physical_bc3d( scalar_old(ims,kms,jms,im), 'p', config_flags, &
1962 ids, ide, jds, jde, kds, kde, &
1963 ims, ime, jms, jme, kms, kme, &
1964 ips, ipe, jps, jpe, kps, kpe, &
1965 grid%i_start(ij), grid%i_end(ij), &
1966 grid%j_start(ij), grid%j_end(ij), &
1967 k_start , k_end )
1968 END DO
1969 ENDIF
1970 END DO
1971 !$OMP END PARALLEL DO
1973 END IF ! end if for scalar_adv_opt
1975 ! chem
1977 IF ((config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1979 !$OMP PARALLEL DO &
1980 !$OMP PRIVATE ( ij )
1981 DO ij = 1 , grid%num_tiles
1982 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1983 DO im = PARAM_FIRST_SCALAR, num_3d_c
1984 CALL rk_update_scalar_pd( im, im, &
1985 chem_old(ims,kms,jms,im), &
1986 chem_tend(ims,kms,jms,im), &
1987 grid%c1h, grid%c2h, &
1988 grid%mu_1, grid%mu_1, grid%mub, &
1989 rk_step, dt_rk, grid%spec_zone, &
1990 config_flags, &
1991 ids, ide, jds, jde, kds, kde, &
1992 ims, ime, jms, jme, kms, kme, &
1993 grid%i_start(ij), grid%i_end(ij), &
1994 grid%j_start(ij), grid%j_end(ij), &
1995 k_start , k_end )
1996 ENDDO
1997 END DO
1998 !$OMP END PARALLEL DO
2000 !---------------------- positive definite bc call
2001 #ifdef DM_PARALLEL
2002 IF (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) THEN
2003 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2004 # include "HALO_EM_CHEM_OLD_E_5.inc"
2005 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2006 # include "HALO_EM_CHEM_OLD_E_7.inc"
2007 ELSE
2008 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2009 CALL wrf_error_fatal(TRIM(wrf_err_message))
2010 ENDIF
2011 ENDIF
2012 #endif
2014 #ifdef DM_PARALLEL
2015 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
2016 #endif
2018 !$OMP PARALLEL DO &
2019 !$OMP PRIVATE ( ij )
2020 DO ij = 1 , grid%num_tiles
2021 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2022 DO im = PARAM_FIRST_SCALAR , num_3d_c
2023 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
2024 ids, ide, jds, jde, kds, kde, &
2025 ims, ime, jms, jme, kms, kme, &
2026 ips, ipe, jps, jpe, kps, kpe, &
2027 grid%i_start(ij), grid%i_end(ij), &
2028 grid%j_start(ij), grid%j_end(ij), &
2029 k_start , k_end )
2030 END DO
2031 ENDIF
2032 END DO
2033 !$OMP END PARALLEL DO
2035 ENDIF ! end if for chem_adv_opt
2037 ! tracer
2039 IF ((config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
2041 !$OMP PARALLEL DO &
2042 !$OMP PRIVATE ( ij )
2043 DO ij = 1 , grid%num_tiles
2044 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2045 DO im = PARAM_FIRST_SCALAR, num_tracer
2046 CALL rk_update_scalar_pd( im, im, &
2047 tracer_old(ims,kms,jms,im), &
2048 tracer_tend(ims,kms,jms,im), &
2049 grid%c1h, grid%c2h, &
2050 grid%mu_1, grid%mu_1, grid%mub, &
2051 rk_step, dt_rk, grid%spec_zone, &
2052 config_flags, &
2053 ids, ide, jds, jde, kds, kde, &
2054 ims, ime, jms, jme, kms, kme, &
2055 grid%i_start(ij), grid%i_end(ij), &
2056 grid%j_start(ij), grid%j_end(ij), &
2057 k_start , k_end )
2058 ENDDO
2059 END DO
2060 !$OMP END PARALLEL DO
2062 !---------------------- positive definite bc call
2063 #ifdef DM_PARALLEL
2064 IF (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) THEN
2065 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2066 # include "HALO_EM_TRACER_OLD_E_5.inc"
2067 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2068 # include "HALO_EM_TRACER_OLD_E_7.inc"
2069 ELSE
2070 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2071 CALL wrf_error_fatal(TRIM(wrf_err_message))
2072 ENDIF
2073 ENDIF
2074 #endif
2076 #ifdef DM_PARALLEL
2077 # include "PERIOD_BDY_EM_TRACER_OLD.inc"
2078 #endif
2080 !$OMP PARALLEL DO &
2081 !$OMP PRIVATE ( ij )
2082 DO ij = 1 , grid%num_tiles
2083 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2084 DO im = PARAM_FIRST_SCALAR , num_tracer
2085 CALL set_physical_bc3d( tracer_old(ims,kms,jms,im), 'p', config_flags, &
2086 ids, ide, jds, jde, kds, kde, &
2087 ims, ime, jms, jme, kms, kme, &
2088 ips, ipe, jps, jpe, kps, kpe, &
2089 grid%i_start(ij), grid%i_end(ij), &
2090 grid%j_start(ij), grid%j_end(ij), &
2091 k_start , k_end )
2092 END DO
2093 ENDIF
2094 END DO
2095 !$OMP END PARALLEL DO
2097 ENDIF ! end if for tracer_adv_opt
2099 ! tke
2101 IF ((config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order) &
2102 .and. (config_flags%km_opt .eq. 2) ) THEN
2104 !$OMP PARALLEL DO &
2105 !$OMP PRIVATE ( ij )
2106 DO ij = 1 , grid%num_tiles
2107 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2108 CALL rk_update_scalar_pd( 1, 1, &
2109 grid%tke_1, &
2110 tke_tend(ims,kms,jms), &
2111 grid%c1h, grid%c2h, &
2112 grid%mu_1, grid%mu_1, grid%mub, &
2113 rk_step, dt_rk, grid%spec_zone, &
2114 config_flags, &
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 ENDDO
2121 !$OMP END PARALLEL DO
2123 !---------------------- positive definite bc call
2124 #ifdef DM_PARALLEL
2125 IF (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) THEN
2126 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2127 # include "HALO_EM_TKE_OLD_E_5.inc"
2128 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2129 # include "HALO_EM_TKE_OLD_E_7.inc"
2130 ELSE
2131 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2132 CALL wrf_error_fatal(TRIM(wrf_err_message))
2133 ENDIF
2134 ENDIF
2135 #endif
2137 #ifdef DM_PARALLEL
2138 # include "PERIOD_BDY_EM_TKE_OLD.inc"
2139 #endif
2141 !$OMP PARALLEL DO &
2142 !$OMP PRIVATE ( ij )
2143 DO ij = 1 , grid%num_tiles
2144 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
2145 ids, ide, jds, jde, kds, kde, &
2146 ims, ime, jms, jme, kms, kme, &
2147 ips, ipe, jps, jpe, kps, kpe, &
2148 grid%i_start(ij), grid%i_end(ij), &
2149 grid%j_start(ij), grid%j_end(ij), &
2150 k_start , k_end )
2151 END DO
2152 !$OMP END PARALLEL DO
2154 !--- end of positive definite physics tendency update
2156 END IF ! end if for tke_adv_opt
2158 #ifdef DM_PARALLEL
2159 !
2160 ! Stencils for patch communications (WCS, 29 June 2001)
2161 !
2162 ! * * * * *
2163 ! * * * * *
2164 ! * * + * *
2165 ! * * * * *
2166 ! * * * * *
2167 !
2168 ! ru_m x
2169 ! rv_m x
2170 ! ww_m x
2171 ! mut x
2172 !
2173 !--------------------------------------------------------------
2175 # include "HALO_EM_D.inc"
2176 ! WCS addition 11/19/08
2177 # include "PERIOD_EM_DA.inc"
2178 #endif
2180 !<DESCRIPTION>
2181 !<pre>
2182 ! (4) Still within the RK loop, the scalar variables are advanced.
2183 !
2184 ! For the moist and chem variables, each one is advanced
2185 ! individually, using named loops "moist_variable_loop:"
2186 ! and "chem_variable_loop:". Each RK substep begins by
2187 ! calculating the advective tendency, and, for the first RK step,
2188 ! 3D mixing (calling rk_scalar_tend) followed by an update
2189 ! of the scalar (calling rk_update_scalar).
2190 !</pre>
2191 !</DESCRIPTION>
2194 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2196 moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
2198 ! adv_moist_cond is set in module_physics_init based on mp_physics choice
2199 ! true except for Ferrier scheme
2201 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
2203 !$OMP PARALLEL DO &
2204 !$OMP PRIVATE ( ij, tenddec )
2205 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
2207 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2208 tenddec = .false.
2210 BENCH_START(rk_scalar_tend_tim)
2211 CALL rk_scalar_tend ( im, im, config_flags, tenddec, &
2212 rk_step, dt_rk, &
2213 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2214 grid%u_1, grid%v_1, &
2215 grid%muts, grid%mub, grid%mu_1, &
2216 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2217 grid%alt, &
2218 moist_old(ims,kms,jms,im), &
2219 moist(ims,kms,jms,im), &
2220 moist_tend(ims,kms,jms,im), &
2221 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2222 grid%qv_base, .true., grid%fnm, grid%fnp, &
2223 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
2224 grid%msfvy, grid%msftx,grid%msfty, &
2225 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2226 grid%kvdif, grid%xkhh, &
2227 grid%diff_6th_opt, grid%diff_6th_factor, &
2228 config_flags%moist_adv_opt, &
2229 grid%phb, grid%ph_2, &
2230 config_flags%moist_mix2_off, &
2231 config_flags%moist_mix6_off, &
2232 ids, ide, jds, jde, kds, kde, &
2233 ims, ime, jms, jme, kms, kme, &
2234 grid%i_start(ij), grid%i_end(ij), &
2235 grid%j_start(ij), grid%j_end(ij), &
2236 k_start , k_end )
2238 IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
2239 IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2240 CALL q_diabatic_add ( im, im, &
2241 dt_rk, grid%mut, &
2242 grid%c1h, grid%c2h, &
2243 grid%qv_diabatic, &
2244 grid%qc_diabatic, &
2245 moist_tend(ims,kms,jms,im), &
2246 ids, ide, jds, jde, kds, kde, &
2247 ims, ime, jms, jme, kms, kme, &
2248 grid%i_start(ij), grid%i_end(ij), &
2249 grid%j_start(ij), grid%j_end(ij), &
2250 k_start , k_end )
2251 ENDIF
2252 ENDIF
2254 BENCH_END(rk_scalar_tend_tim)
2256 BENCH_START(rlx_bdy_scalar_tim)
2257 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
2258 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
2259 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
2260 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2261 moist(ims,kms,jms,im), grid%mut, &
2262 grid%c1h, grid%c2h, &
2263 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2264 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2265 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2266 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2267 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2268 grid%dtbc, grid%fcx, grid%gcx, &
2269 config_flags, &
2270 ids,ide, jds,jde, kds,kde, & ! domain dims
2271 ims,ime, jms,jme, kms,kme, & ! memory dims
2272 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2273 grid%i_start(ij), grid%i_end(ij), &
2274 grid%j_start(ij), grid%j_end(ij), &
2275 k_start, k_end )
2277 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2278 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2279 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2280 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2281 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2282 config_flags%spec_bdy_width, grid%spec_zone, &
2283 config_flags, &
2284 ids,ide, jds,jde, kds,kde, & ! domain dims
2285 ims,ime, jms,jme, kms,kme, & ! memory dims
2286 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2287 grid%i_start(ij), grid%i_end(ij), &
2288 grid%j_start(ij), grid%j_end(ij), &
2289 k_start, k_end )
2290 ENDIF
2291 ENDIF
2292 BENCH_END(rlx_bdy_scalar_tim)
2294 ENDDO moist_tile_loop_1
2295 !$OMP END PARALLEL DO
2297 !$OMP PARALLEL DO &
2298 !$OMP PRIVATE ( ij, tenddec )
2299 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2301 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2302 tenddec = .false.
2304 BENCH_START(update_scal_tim)
2305 CALL rk_update_scalar( scs=im, sce=im, &
2306 scalar_1=moist_old(ims,kms,jms,im), &
2307 scalar_2=moist(ims,kms,jms,im), &
2308 sc_tend=moist_tend(ims,kms,jms,im), &
2309 advect_tend=advect_tend, &
2310 h_tendency=h_tendency, z_tendency=z_tendency, &
2311 msftx=grid%msftx,msfty=grid%msfty, &
2312 c1=grid%c1h, c2=grid%c2h, &
2313 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2314 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2315 config_flags=config_flags, tenddec=tenddec, &
2316 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2317 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2318 its=grid%i_start(ij), ite=grid%i_end(ij), &
2319 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2320 kts=k_start , kte=k_end )
2321 IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
2322 IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2323 CALL q_diabatic_subtr( im, im, &
2324 dt_rk, &
2325 grid%qv_diabatic, &
2326 grid%qc_diabatic, &
2327 moist(ims,kms,jms,im), &
2328 ids, ide, jds, jde, kds, kde, &
2329 ims, ime, jms, jme, kms, kme, &
2330 grid%i_start(ij), grid%i_end(ij), &
2331 grid%j_start(ij), grid%j_end(ij), &
2332 k_start , k_end )
2333 ENDIF
2334 ENDIF
2335 BENCH_END(update_scal_tim)
2337 BENCH_START(flow_depbdy_tim)
2338 IF( config_flags%specified .AND. ( .NOT. config_flags%have_bcs_moist ) ) THEN
2339 IF(im .ne. P_QV)THEN
2340 CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
2341 grid%ru_m, grid%rv_m, config_flags, &
2342 grid%spec_zone, &
2343 ids,ide, jds,jde, kds,kde, &
2344 ims,ime, jms,jme, kms,kme, &
2345 ips,ipe, jps,jpe, kps,kpe, &
2346 grid%i_start(ij), grid%i_end(ij), &
2347 grid%j_start(ij), grid%j_end(ij), &
2348 k_start, k_end )
2349 ENDIF
2350 ENDIF
2351 BENCH_END(flow_depbdy_tim)
2353 ENDDO moist_tile_loop_2
2354 !$OMP END PARALLEL DO
2356 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2358 ENDDO moist_variable_loop
2360 ENDIF moist_scalar_advance
2362 BENCH_START(tke_adv_tim)
2363 TKE_advance: IF (config_flags%km_opt .eq. 2.or.config_flags%km_opt.eq.5) then ! XZ
2364 #ifdef DM_PARALLEL
2365 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2366 # include "HALO_EM_TKE_ADVECT_3.inc"
2367 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2368 # include "HALO_EM_TKE_ADVECT_5.inc"
2369 ELSE
2370 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2371 CALL wrf_error_fatal(TRIM(wrf_err_message))
2372 ENDIF
2373 #endif
2374 !$OMP PARALLEL DO &
2375 !$OMP PRIVATE ( ij, tenddec )
2376 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2378 CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
2379 tenddec = .false.
2380 CALL rk_scalar_tend ( 1, 1, config_flags, tenddec, &
2381 rk_step, dt_rk, &
2382 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2383 grid%u_1, grid%v_1, &
2384 grid%muts, grid%mub, grid%mu_1, &
2385 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2386 grid%alt, &
2387 grid%tke_1, &
2388 grid%tke_2, &
2389 tke_tend(ims,kms,jms), &
2390 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2391 grid%qv_base, .false., grid%fnm, grid%fnp, &
2392 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2393 grid%msfvy, grid%msftx,grid%msfty, &
2394 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2395 grid%kvdif, grid%xkhh, &
2396 grid%diff_6th_opt, grid%diff_6th_factor, &
2397 config_flags%tke_adv_opt, &
2398 grid%phb, grid%ph_2, &
2399 config_flags%tke_mix2_off, &
2400 config_flags%tke_mix6_off, &
2401 ids, ide, jds, jde, kds, kde, &
2402 ims, ime, jms, jme, kms, kme, &
2403 grid%i_start(ij), grid%i_end(ij), &
2404 grid%j_start(ij), grid%j_end(ij), &
2405 k_start , k_end )
2407 ENDDO tke_tile_loop_1
2408 !$OMP END PARALLEL DO
2410 !$OMP PARALLEL DO &
2411 !$OMP PRIVATE ( ij, tenddec )
2412 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2414 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2415 tenddec = .false.
2416 CALL rk_update_scalar( scs=1, sce=1, &
2417 scalar_1=grid%tke_1, &
2418 scalar_2=grid%tke_2, &
2419 sc_tend=tke_tend(ims,kms,jms), &
2420 advect_tend=advect_tend, &
2421 h_tendency=h_tendency, z_tendency=z_tendency, &
2422 msftx=grid%msftx,msfty=grid%msfty, &
2423 c1=grid%c1h, c2=grid%c2h, &
2424 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2425 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2426 config_flags=config_flags, tenddec=tenddec, &
2427 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2428 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2429 its=grid%i_start(ij), ite=grid%i_end(ij), &
2430 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2431 kts=k_start , kte=k_end )
2433 ! bound the tke (greater than 0, less than tke_upper_bound)
2435 CALL bound_tke( grid%tke_2, grid%tke_upper_bound, &
2436 ids, ide, jds, jde, kds, kde, &
2437 ims, ime, jms, jme, kms, kme, &
2438 grid%i_start(ij), grid%i_end(ij), &
2439 grid%j_start(ij), grid%j_end(ij), &
2440 k_start , k_end )
2442 IF( config_flags%specified .or. config_flags%nested ) THEN
2443 CALL flow_dep_bdy ( grid%tke_2, &
2444 grid%ru_m, grid%rv_m, config_flags, &
2445 grid%spec_zone, &
2446 ids,ide, jds,jde, kds,kde, & ! domain dims
2447 ims,ime, jms,jme, kms,kme, & ! memory dims
2448 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2449 grid%i_start(ij), grid%i_end(ij), &
2450 grid%j_start(ij), grid%j_end(ij), &
2451 k_start, k_end )
2452 ENDIF
2453 ENDDO tke_tile_loop_2
2454 !$OMP END PARALLEL DO
2456 ENDIF TKE_advance
2457 BENCH_END(tke_adv_tim)
2459 #if (WRF_CHEM == 1)
2460 ! next the chemical species
2461 BENCH_START(chem_adv_tim)
2462 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2464 chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
2466 !$OMP PARALLEL DO &
2467 !$OMP PRIVATE ( ij, tenddec )
2468 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2470 CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
2471 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2472 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2473 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2474 rk_step, dt_rk, &
2475 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2476 grid%u_1, grid%v_1, &
2477 grid%muts, grid%mub, grid%mu_1, &
2478 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2479 grid%alt, &
2480 chem_old(ims,kms,jms,ic), &
2481 chem(ims,kms,jms,ic), &
2482 chem_tend(ims,kms,jms,ic), &
2483 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2484 grid%qv_base, .false., grid%fnm, grid%fnp, &
2485 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2486 grid%msfvy, grid%msftx,grid%msfty, &
2487 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2488 grid%khdif, grid%kvdif, grid%xkhh, &
2489 grid%diff_6th_opt, grid%diff_6th_factor, &
2490 config_flags%chem_adv_opt, &
2491 grid%phb, grid%ph_2, &
2492 config_flags%chem_mix2_off, &
2493 config_flags%chem_mix6_off, &
2494 ids, ide, jds, jde, kds, kde, &
2495 ims, ime, jms, jme, kms, kme, &
2496 grid%i_start(ij), grid%i_end(ij), &
2497 grid%j_start(ij), grid%j_end(ij), &
2498 k_start , k_end )
2499 !
2500 ! Currently, chemistry species with specified boundaries (i.e. the mother
2501 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2502 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2503 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2504 !
2505 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2506 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2507 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2508 chem(ims,kms,jms,ic), grid%mut, &
2509 grid%c1h, grid%c2h, &
2510 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2511 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2512 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2513 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2514 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2515 grid%dtbc, grid%fcx, grid%gcx, &
2516 config_flags, &
2517 ids,ide, jds,jde, kds,kde, &
2518 ims,ime, jms,jme, kms,kme, &
2519 ips,ipe, jps,jpe, kps,kpe, &
2520 grid%i_start(ij), grid%i_end(ij), &
2521 grid%j_start(ij), grid%j_end(ij), &
2522 k_start, k_end )
2523 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2524 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2525 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2526 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2527 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2528 config_flags%spec_bdy_width, grid%spec_zone, &
2529 config_flags, &
2530 ids,ide, jds,jde, kds,kde, &
2531 ims,ime, jms,jme, kms,kme, &
2532 ips,ipe, jps,jpe, kps,kpe, &
2533 grid%i_start(ij), grid%i_end(ij), &
2534 grid%j_start(ij), grid%j_end(ij), &
2535 k_start, k_end )
2536 ENDIF
2538 ENDDO chem_tile_loop_1
2539 !$OMP END PARALLEL DO
2541 if ( config_flags%do_pvozone ) then
2542 #ifdef DM_PARALLEL
2543 # include "HALO_EM_D_PV.inc"
2544 #endif
2545 end if
2547 !$OMP PARALLEL DO &
2548 !$OMP PRIVATE ( ij, tenddec )
2550 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2552 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2553 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2554 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2555 CALL rk_update_scalar( scs=ic, sce=ic, &
2556 scalar_1=chem_old(ims,kms,jms,ic), &
2557 scalar_2=chem(ims,kms,jms,ic), &
2558 sc_tend=chem_tend(ims,kms,jms,ic), &
2559 advh_t=advh_ct(ims,kms,jms,adv_ct_indices(ic)), &
2560 advz_t=advz_ct(ims,kms,jms,adv_ct_indices(ic)), &
2561 advect_tend=advect_tend, &
2562 h_tendency=h_tendency, z_tendency=z_tendency, &
2563 msftx=grid%msftx,msfty=grid%msfty, &
2564 c1=grid%c1h, c2=grid%c2h, &
2565 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2566 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2567 config_flags=config_flags, tenddec=tenddec, &
2568 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2569 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2570 its=grid%i_start(ij), ite=grid%i_end(ij), &
2571 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2572 kts=k_start , kte=k_end )
2574 IF( config_flags%specified ) THEN
2576 IF( config_flags%perturb_chem_bdy==1 ) THEN
2578 IF(ic.eq.PARAM_FIRST_SCALAR .and. ij.eq.1) &
2579 CALL wrf_debug (10 , ' spec_bdy_chem_perturb' )
2581 CALL spec_bdy_chem_perturb ( config_flags%periodic_x, &
2582 chem_btxs(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2583 chem_btys(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2584 grid%rand_pert, &
2585 config_flags%spec_bdy_width, grid%spec_zone, &
2586 grid%num_stoch_levels, & ! stoch dims
2587 ids,ide, jds,jde, kds,kde, & ! domain dims
2588 ims,ime, jms,jme, kms,kme, & ! memory dims
2589 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2590 grid%i_start(ij), grid%i_end(ij), &
2591 grid%j_start(ij), grid%j_end(ij), &
2592 k_start, k_end )
2593 ENDIF
2595 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2596 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2597 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2598 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2599 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2600 dt_rk+grid%dtbc, &
2601 config_flags%spec_bdy_width,grid%z, &
2602 grid%have_bcs_chem, &
2603 grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2604 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2605 grid%spec_zone,ic,grid%julday, &
2606 ids,ide, jds,jde, kds,kde, & ! domain dims
2607 ims,ime, jms,jme, kms,kme, & ! memory dims
2608 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2609 grid%i_start(ij), grid%i_end(ij), &
2610 grid%j_start(ij), grid%j_end(ij), &
2611 k_start, k_end, &
2612 grid%u_2,grid%v_2,grid%t_2,grid%znu,grid%msft, &
2613 grid%msfu,grid%msfv,grid%f,grid%mub,grid%dx,grid%xlat,grid%pv)
2615 ENDIF
2616 ENDDO chem_tile_loop_2
2617 !$OMP END PARALLEL DO
2619 ENDDO chem_variable_loop
2620 ENDIF chem_scalar_advance
2621 BENCH_END(chem_adv_tim)
2622 #endif
2623 ! next the chemical species
2624 BENCH_START(tracer_adv_tim)
2625 tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2627 tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
2629 !$OMP PARALLEL DO &
2630 !$OMP PRIVATE ( ij, tenddec )
2631 tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
2633 CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
2634 tenddec = .false.
2635 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2636 rk_step, dt_rk, &
2637 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2638 grid%u_1, grid%v_1, &
2639 grid%muts, grid%mub, grid%mu_1, &
2640 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2641 grid%alt, &
2642 tracer_old(ims,kms,jms,ic), &
2643 tracer(ims,kms,jms,ic), &
2644 tracer_tend(ims,kms,jms,ic), &
2645 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2646 grid%qv_base, .false., grid%fnm, grid%fnp, &
2647 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2648 grid%msfvy, grid%msftx,grid%msfty, &
2649 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2650 grid%khdif, grid%kvdif, grid%xkhh, &
2651 grid%diff_6th_opt, grid%diff_6th_factor, &
2652 config_flags%tracer_adv_opt, &
2653 grid%phb, grid%ph_2, &
2654 config_flags%tracer_mix2_off, &
2655 config_flags%tracer_mix6_off, &
2656 ids, ide, jds, jde, kds, kde, &
2657 ims, ime, jms, jme, kms, kme, &
2658 grid%i_start(ij), grid%i_end(ij), &
2659 grid%j_start(ij), grid%j_end(ij), &
2660 k_start , k_end )
2661 !
2662 ! Currently, chemistry species with specified boundaries (i.e. the mother
2663 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2664 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2665 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2666 !
2667 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2668 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
2669 CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2670 tracer(ims,kms,jms,ic), grid%mut, &
2671 grid%c1h, grid%c2h, &
2672 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2673 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2674 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2675 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2676 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2677 grid%dtbc, grid%fcx, grid%gcx, &
2678 config_flags, &
2679 ids,ide, jds,jde, kds,kde, &
2680 ims,ime, jms,jme, kms,kme, &
2681 ips,ipe, jps,jpe, kps,kpe, &
2682 grid%i_start(ij), grid%i_end(ij), &
2683 grid%j_start(ij), grid%j_end(ij), &
2684 k_start, k_end )
2685 CALL spec_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2686 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2687 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2688 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2689 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2690 config_flags%spec_bdy_width, grid%spec_zone, &
2691 config_flags, &
2692 ids,ide, jds,jde, kds,kde, &
2693 ims,ime, jms,jme, kms,kme, &
2694 ips,ipe, jps,jpe, kps,kpe, &
2695 grid%i_start(ij), grid%i_end(ij), &
2696 grid%j_start(ij), grid%j_end(ij), &
2697 k_start, k_end )
2698 ENDIF
2700 ENDDO tracer_tile_loop_1
2701 !$OMP END PARALLEL DO
2703 !$OMP PARALLEL DO &
2704 !$OMP PRIVATE ( ij, tenddec )
2706 tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
2708 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2709 tenddec = .false.
2710 CALL rk_update_scalar( scs=ic, sce=ic, &
2711 scalar_1=tracer_old(ims,kms,jms,ic), &
2712 scalar_2=tracer(ims,kms,jms,ic), &
2713 sc_tend=tracer_tend(ims,kms,jms,ic), &
2714 ! advh_t=advh_t(ims,kms,jms,1), &
2715 ! advz_t=advz_t(ims,kms,jms,1), &
2716 advect_tend=advect_tend, &
2717 h_tendency=h_tendency, z_tendency=z_tendency, &
2718 msftx=grid%msftx,msfty=grid%msfty, &
2719 c1=grid%c1h, c2=grid%c2h, &
2720 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2721 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2722 config_flags=config_flags, tenddec=tenddec, &
2723 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2724 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2725 its=grid%i_start(ij), ite=grid%i_end(ij), &
2726 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2727 kts=k_start , kte=k_end )
2729 IF( config_flags%specified ) THEN
2730 #if (WRF_CHEM == 1)
2731 CALL flow_dep_bdy_tracer( tracer(ims,kms,jms,ic), &
2732 tracer_bxs(jms,kms,1,ic), tracer_btxs(jms,kms,1,ic), &
2733 tracer_bxe(jms,kms,1,ic), tracer_btxe(jms,kms,1,ic), &
2734 tracer_bys(ims,kms,1,ic), tracer_btys(ims,kms,1,ic), &
2735 tracer_bye(ims,kms,1,ic), tracer_btye(ims,kms,1,ic), &
2736 dt_rk+grid%dtbc, &
2737 config_flags%spec_bdy_width,grid%z, &
2738 grid%have_bcs_tracer, &
2739 grid%ru_m, grid%rv_m, config_flags%tracer_opt,grid%alt, &
2740 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2741 grid%spec_zone,ic, &
2742 ids,ide, jds,jde, kds,kde, & ! domain dims
2743 ims,ime, jms,jme, kms,kme, & ! memory dims
2744 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2745 grid%i_start(ij), grid%i_end(ij), &
2746 grid%j_start(ij), grid%j_end(ij), &
2747 k_start, k_end )
2748 #else
2749 CALL flow_dep_bdy ( tracer(ims,kms,jms,ic), &
2750 grid%ru_m, grid%rv_m, config_flags, &
2751 grid%spec_zone, &
2752 ids,ide, jds,jde, kds,kde, & ! domain dims
2753 ims,ime, jms,jme, kms,kme, & ! memory dims
2754 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2755 grid%i_start(ij), grid%i_end(ij), &
2756 grid%j_start(ij), grid%j_end(ij), &
2757 k_start, k_end )
2758 #endif
2759 ENDIF
2760 ENDDO tracer_tile_loop_2
2761 !$OMP END PARALLEL DO
2763 ENDDO tracer_variable_loop
2764 ENDIF tracer_advance
2765 BENCH_END(tracer_adv_tim)
2767 ! next the other scalar species
2768 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2770 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2771 !$OMP PARALLEL DO &
2772 !$OMP PRIVATE ( ij, tenddec )
2773 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2775 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2776 tenddec = .false.
2777 CALL rk_scalar_tend ( is, is, config_flags, tenddec, &
2778 rk_step, dt_rk, &
2779 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2780 grid%u_1, grid%v_1, &
2781 grid%muts, grid%mub, grid%mu_1, &
2782 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2783 grid%alt, &
2784 scalar_old(ims,kms,jms,is), &
2785 scalar(ims,kms,jms,is), &
2786 scalar_tend(ims,kms,jms,is), &
2787 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2788 grid%qv_base, .false., grid%fnm, grid%fnp, &
2789 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2790 grid%msfvy, grid%msftx,grid%msfty, &
2791 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2792 grid%khdif, grid%kvdif, grid%xkhh, &
2793 grid%diff_6th_opt, grid%diff_6th_factor, &
2794 config_flags%scalar_adv_opt, &
2795 grid%phb, grid%ph_2, &
2796 config_flags%scalar_mix2_off, &
2797 config_flags%scalar_mix6_off, &
2798 ids, ide, jds, jde, kds, kde, &
2799 ims, ime, jms, jme, kms, kme, &
2800 grid%i_start(ij), grid%i_end(ij), &
2801 grid%j_start(ij), grid%j_end(ij), &
2802 k_start , k_end )
2804 IF( rk_step == 1 ) THEN
2805 IF ( config_flags%nested .OR. &
2806 ( config_flags%specified .AND. config_flags%have_bcs_scalar ) .OR. &
2807 ( ( is .EQ. P_QNWFA .OR. is .EQ. P_QNIFA .OR. is .EQ. P_QNBCA) .AND. config_flags%aer_init_opt .GT. 0) ) THEN
2809 CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2810 scalar(ims,kms,jms,is), grid%mut, &
2811 grid%c1h, grid%c2h, &
2812 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2813 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2814 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2815 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2816 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2817 grid%dtbc, grid%fcx, grid%gcx, &
2818 config_flags, &
2819 ids,ide, jds,jde, kds,kde, &
2820 ims,ime, jms,jme, kms,kme, &
2821 ips,ipe, jps,jpe, kps,kpe, &
2822 grid%i_start(ij), grid%i_end(ij), &
2823 grid%j_start(ij), grid%j_end(ij), &
2824 k_start, k_end )
2826 CALL spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2827 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2828 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2829 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2830 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2831 config_flags%spec_bdy_width, grid%spec_zone, &
2832 config_flags, &
2833 ids,ide, jds,jde, kds,kde, &
2834 ims,ime, jms,jme, kms,kme, &
2835 ips,ipe, jps,jpe, kps,kpe, &
2836 grid%i_start(ij), grid%i_end(ij), &
2837 grid%j_start(ij), grid%j_end(ij), &
2838 k_start, k_end )
2840 ENDIF
2841 ENDIF ! b.c test for scalars
2843 ENDDO scalar_tile_loop_1
2844 !$OMP END PARALLEL DO
2846 !$OMP PARALLEL DO &
2847 !$OMP PRIVATE ( ij, tenddec )
2848 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2850 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2851 tenddec = .false.
2852 CALL rk_update_scalar( scs=is, sce=is, &
2853 scalar_1=scalar_old(ims,kms,jms,is), &
2854 scalar_2=scalar(ims,kms,jms,is), &
2855 sc_tend=scalar_tend(ims,kms,jms,is), &
2856 ! advh_t=advh_t(ims,kms,jms,1), &
2857 ! advz_t=advz_t(ims,kms,jms,1), &
2858 advect_tend=advect_tend, &
2859 h_tendency=h_tendency, z_tendency=z_tendency, &
2860 msftx=grid%msftx,msfty=grid%msfty, &
2861 c1=grid%c1h, c2=grid%c2h, &
2862 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2863 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2864 config_flags=config_flags, tenddec=tenddec, &
2865 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2866 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2867 its=grid%i_start(ij), ite=grid%i_end(ij), &
2868 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2869 kts=k_start , kte=k_end )
2871 ! bound the aerosol fields (greater than 0) when using first guess aerosol
2872 ! as fields may be highly heterogeneous compared to climatology
2874 IF ( ( ( is .EQ. P_QNWFA ) .OR. ( is .EQ. P_QNIFA ) .OR. ( is .EQ. P_QNBCA ) ) .AND. &
2875 ( config_flags%aer_init_opt .EQ. 2 ) ) THEN
2876 CALL bound_qna( scalar(ims,kms,jms,is), &
2877 ids, ide, jds, jde, kds, kde, &
2878 ims, ime, jms, jme, kms, kme, &
2879 grid%i_start(ij), grid%i_end(ij), &
2880 grid%j_start(ij), grid%j_end(ij), &
2881 k_start , k_end )
2882 END IF
2884 IF ( config_flags%specified ) THEN
2885 IF (is.EQ.P_QDCN.OR.is.EQ.P_QTCN.OR.is.EQ.P_QNIN) THEN ! for ntu3m
2886 CALL flow_dep_bdy_fixed_inflow(scalar(ims,kms,jms,is), &
2887 grid%ru_m,grid%rv_m,config_flags,&
2888 grid%spec_zone,ids,ide,jds,jde, &
2889 kds,kde,ims,ime,jms,jme,kms,kme, &
2890 ips,ipe,jps,jpe,kps,kpe, &
2891 grid%i_start(ij),grid%i_end(ij), &
2892 grid%j_start(ij),grid%j_end(ij), &
2893 k_start,k_end)
2894 ELSEIF (is.EQ.P_QNN) THEN ! for ntu3m
2895 CALL flow_dep_bdy_qnn ( scalar(ims,kms,jms,is), &
2896 grid%ru_m, grid%rv_m, config_flags, &
2897 grid%spec_zone, &
2898 grid%ccn_conc, & ! RAS
2899 ids,ide, jds,jde, kds,kde, & ! domain dims
2900 ims,ime, jms,jme, kms,kme, & ! memory dims
2901 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2902 grid%i_start(ij), grid%i_end(ij), &
2903 grid%j_start(ij), grid%j_end(ij), &
2904 k_start, k_end )
2905 ELSE IF ( ( ( ( is .EQ. P_QNWFA ) .OR. ( is .EQ. P_QNIFA ) .OR. ( is .EQ. P_QNBCA ) ) .AND. &
2906 ( config_flags%aer_init_opt .EQ. 0 ) ) &
2907 .OR. &
2908 ( ( .NOT. ( ( is .EQ. P_QNWFA ) .OR. ( is .EQ. P_QNIFA ) .OR. ( is .EQ. P_QNBCA ) ) ) .AND. &
2909 ( .NOT. config_flags%have_bcs_scalar ) ) ) THEN
2911 ! A = ( is .EQ. P_QNWFA ) .OR. ( is .EQ. P_QNIFA ) .OR. ( is .EQ. P_QNBCA )
2912 ! B = config_flags%aer_init_opt .GT. 0
2913 ! C = config_glags%have_bcs_scalar
2915 ! Test| A | B | C | ( A AND NOT B ) OR ( NOT A AND NOT C )
2916 ! ----+----+----+---+-----------------------------------------------
2917 ! 1 | T | T | T | F = DO NOT CALL flow_dep_bdy
2918 ! 2 | T | T | F | F = DO NOT CALL flow_dep_bdy
2919 ! 3 | T | F | T | T = CALL flow_dep_bdy
2920 ! 4 | T | F | F | T = CALL flow_dep_bdy
2921 ! 5 | F | T | T | F = DO NOT CALL flow_dep_bdy
2922 ! 6 | F | T | F | T = CALL flow_dep_bdy
2923 ! 7 | F | F | T | F = DO NOT CALL flow_dep_bdy
2924 ! 8 | F | F | F | T = CALL flow_dep_bdy
2925 ! ----+----+----+---+-----------------------------------------------
2927 ! If this is the special friendly fields AND are to use the aero icbc, then NO calls to flow dep: tests 1 and 2
2928 ! If this is the special friendly fields AND do not use the aero icbc, then call flow dep: tests 3 and 4
2929 ! If this is not the special friendly fields AND:
2930 ! If we have bcs for scalars, do not call flow dep: tests 5 and 7
2931 ! If we do not have bcs for scalars, call flow dep: tests 6 and 8
2933 CALL flow_dep_bdy ( scalar(ims,kms,jms,is), &
2934 grid%ru_m, grid%rv_m, config_flags, &
2935 grid%spec_zone, &
2936 ids,ide, jds,jde, kds,kde, & ! domain dims
2937 ims,ime, jms,jme, kms,kme, & ! memory dims
2938 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2939 grid%i_start(ij), grid%i_end(ij), &
2940 grid%j_start(ij), grid%j_end(ij), &
2941 k_start, k_end )
2942 ENDIF
2944 ENDIF
2946 ENDDO scalar_tile_loop_2
2947 !$OMP END PARALLEL DO
2949 ENDDO scalar_variable_loop
2951 ENDIF other_scalar_advance
2953 ! update the pressure and density at the new time level
2955 !$OMP PARALLEL DO &
2956 !$OMP PRIVATE ( ij )
2957 DO ij = 1 , grid%num_tiles
2959 BENCH_START(calc_p_rho_tim)
2961 CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, &
2962 grid%al, grid%alb, grid%mu_2, grid%muts, &
2963 grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
2964 grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, &
2965 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
2966 grid%rdn, config_flags%non_hydrostatic,config_flags%use_theta_m, &
2967 ids, ide, jds, jde, kds, kde, &
2968 ims, ime, jms, jme, kms, kme, &
2969 grid%i_start(ij), grid%i_end(ij), &
2970 grid%j_start(ij), grid%j_end(ij), &
2971 k_start , k_end )
2973 BENCH_END(calc_p_rho_tim)
2975 ENDDO
2976 !$OMP END PARALLEL DO
2978 ! Reset the boundary conditions if there is another corrector step.
2979 ! (rk_step < rk_order), else we'll handle it at the end of everything
2980 ! (after the split physics, before exiting the timestep).
2982 rk_step_1_check: IF ( rk_step < rk_order ) THEN
2984 !-----------------------------------------------------------
2985 ! rk3 substep polar filter for scalars (moist,chem,scalar)
2986 !-----------------------------------------------------------
2988 IF (config_flags%polar) THEN
2989 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2990 CALL wrf_debug ( 200 , ' call filter moist ' )
2991 DO im = PARAM_FIRST_SCALAR, num_3d_m
2992 IF ( config_flags%coupled_filtering ) THEN
2993 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2994 ,MU=grid%mu_2 , MUB=grid%mub &
2995 ,C1=grid%c1h , C2=grid%c2h &
2996 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2997 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2998 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2999 END IF
3000 CALL pxft ( grid=grid &
3001 ,lineno=__LINE__ &
3002 ,flag_uv = 0 &
3003 ,flag_rurv = 0 &
3004 ,flag_wph = 0 &
3005 ,flag_ww = 0 &
3006 ,flag_t = 0 &
3007 ,flag_mu = 0 &
3008 ,flag_mut = 0 &
3009 ,flag_moist = im &
3010 ,flag_chem = 0 &
3011 ,flag_scalar = 0 &
3012 ,flag_tracer = 0 &
3013 ,actual_distance_average=config_flags%actual_distance_average&
3014 ,pos_def = config_flags%pos_def &
3015 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3016 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3017 ,fft_filter_lat = config_flags%fft_filter_lat &
3018 ,dclat = dclat &
3019 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3020 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3021 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3022 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3023 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3024 IF ( config_flags%coupled_filtering ) THEN
3025 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
3026 ,MU=grid%mu_2 , MUB=grid%mub &
3027 ,C1=grid%c1h , C2=grid%c2h &
3028 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3029 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3030 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3031 END IF
3032 END DO
3033 END IF
3035 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
3036 CALL wrf_debug ( 200 , ' call filter chem ' )
3037 DO im = PARAM_FIRST_SCALAR, num_3d_c
3038 IF ( config_flags%coupled_filtering ) THEN
3039 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
3040 ,MU=grid%mu_2 , MUB=grid%mub &
3041 ,C1=grid%c1h , C2=grid%c2h &
3042 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3043 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3044 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3045 END IF
3046 CALL pxft ( grid=grid &
3047 ,lineno=__LINE__ &
3048 ,flag_uv = 0 &
3049 ,flag_rurv = 0 &
3050 ,flag_wph = 0 &
3051 ,flag_ww = 0 &
3052 ,flag_t = 0 &
3053 ,flag_mu = 0 &
3054 ,flag_mut = 0 &
3055 ,flag_moist = 0 &
3056 ,flag_chem = im &
3057 ,flag_tracer = 0 &
3058 ,flag_scalar = 0 &
3059 ,actual_distance_average=config_flags%actual_distance_average&
3060 ,pos_def = config_flags%pos_def &
3061 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3062 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3063 ,fft_filter_lat = config_flags%fft_filter_lat &
3064 ,dclat = dclat &
3065 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3066 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3067 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3068 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3069 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3070 IF ( config_flags%coupled_filtering ) THEN
3071 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
3072 ,MU=grid%mu_2 , MUB=grid%mub &
3073 ,C1=grid%c1h , C2=grid%c2h &
3074 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3075 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3076 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3077 END IF
3078 END DO
3079 END IF
3080 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3081 CALL wrf_debug ( 200 , ' call filter tracer ' )
3082 DO im = PARAM_FIRST_SCALAR, num_tracer
3083 IF ( config_flags%coupled_filtering ) THEN
3084 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
3085 ,MU=grid%mu_2 , MUB=grid%mub &
3086 ,C1=grid%c1h , C2=grid%c2h &
3087 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3088 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3089 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3090 END IF
3091 CALL pxft ( grid=grid &
3092 ,lineno=__LINE__ &
3093 ,flag_uv = 0 &
3094 ,flag_rurv = 0 &
3095 ,flag_wph = 0 &
3096 ,flag_ww = 0 &
3097 ,flag_t = 0 &
3098 ,flag_mu = 0 &
3099 ,flag_mut = 0 &
3100 ,flag_moist = 0 &
3101 ,flag_chem = 0 &
3102 ,flag_tracer = im &
3103 ,flag_scalar = 0 &
3104 ,actual_distance_average=config_flags%actual_distance_average&
3105 ,pos_def = config_flags%pos_def &
3106 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3107 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3108 ,fft_filter_lat = config_flags%fft_filter_lat &
3109 ,dclat = dclat &
3110 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3111 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3112 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3113 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3114 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3115 IF ( config_flags%coupled_filtering ) THEN
3116 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
3117 ,MU=grid%mu_2 , MUB=grid%mub &
3118 ,C1=grid%c1h , C2=grid%c2h &
3119 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3120 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3121 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3122 END IF
3123 END DO
3124 END IF
3126 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
3127 CALL wrf_debug ( 200 , ' call filter scalar ' )
3128 DO im = PARAM_FIRST_SCALAR, num_3d_s
3129 IF ( config_flags%coupled_filtering ) THEN
3130 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3131 ,MU=grid%mu_2 , MUB=grid%mub &
3132 ,C1=grid%c1h , C2=grid%c2h &
3133 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3134 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3135 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3136 END IF
3137 CALL pxft ( grid=grid &
3138 ,lineno=__LINE__ &
3139 ,flag_uv = 0 &
3140 ,flag_rurv = 0 &
3141 ,flag_wph = 0 &
3142 ,flag_ww = 0 &
3143 ,flag_t = 0 &
3144 ,flag_mu = 0 &
3145 ,flag_mut = 0 &
3146 ,flag_moist = 0 &
3147 ,flag_chem = 0 &
3148 ,flag_tracer = 0 &
3149 ,flag_scalar = im &
3150 ,actual_distance_average=config_flags%actual_distance_average&
3151 ,pos_def = config_flags%pos_def &
3152 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3153 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3154 ,fft_filter_lat = config_flags%fft_filter_lat &
3155 ,dclat = dclat &
3156 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3157 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3158 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3159 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3160 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3161 IF ( config_flags%coupled_filtering ) THEN
3162 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3163 ,MU=grid%mu_2 , MUB=grid%mub &
3164 ,C1=grid%c1h , C2=grid%c2h &
3165 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3166 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3167 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3168 END IF
3169 END DO
3170 END IF
3171 END IF ! polar filter test
3173 !-----------------------------------------------------------
3174 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
3175 !-----------------------------------------------------------
3177 !-----------------------------------------------------------
3178 ! Stencils for patch communications (WCS, 29 June 2001)
3179 !
3180 ! here's where we need a wide comm stencil - these are the
3181 ! uncoupled variables so are used for high order calc in
3182 ! advection and mixong routines.
3183 !
3184 !
3185 ! * * * * * * *
3186 ! * * * * * * * * * * * *
3187 ! * * * * * * * * * * * * *
3188 ! * + * * * + * * * * * + * * *
3189 ! * * * * * * * * * * * * *
3190 ! * * * * * * * * * * * *
3191 ! * * * * * * *
3192 !
3193 ! al x
3194 !
3195 ! 2D variable
3196 ! mu_2 x
3197 !
3198 ! (adv order <=4)
3199 ! u_2 x
3200 ! v_2 x
3201 ! w_2 x
3202 ! t_2 x
3203 ! ph_2 x
3204 !
3205 ! (adv order <=6)
3206 ! u_2 x
3207 ! v_2 x
3208 ! w_2 x
3209 ! t_2 x
3210 ! ph_2 x
3211 !
3212 ! 4D variable
3213 ! moist x
3214 ! chem x
3215 ! scalar x
3217 #ifdef DM_PARALLEL
3218 IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN
3219 # include "HALO_EM_D2_3.inc"
3220 ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN
3221 # include "HALO_EM_D2_5.inc"
3222 ELSE
3223 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', &
3224 config_flags%h_mom_adv_order, config_flags%h_sca_adv_order
3225 CALL wrf_error_fatal(TRIM(wrf_err_message))
3226 ENDIF
3227 # include "PERIOD_BDY_EM_D.inc"
3228 # include "PERIOD_BDY_EM_MOIST2.inc"
3229 # include "PERIOD_BDY_EM_CHEM2.inc"
3230 # include "PERIOD_BDY_EM_TRACER2.inc"
3231 # include "PERIOD_BDY_EM_SCALAR2.inc"
3232 # include "PERIOD_BDY_EM_TKE.inc"
3233 #endif
3235 BENCH_START(bc_end_tim)
3236 !$OMP PARALLEL DO &
3237 !$OMP PRIVATE ( ij )
3238 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
3239 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
3241 CALL rk_phys_bc_dry_2( config_flags, &
3242 grid%u_2, grid%v_2, grid%w_2, &
3243 grid%t_2, grid%ph_2, grid%mu_2, &
3244 ids, ide, jds, jde, kds, kde, &
3245 ims, ime, jms, jme, kms, kme, &
3246 ips, ipe, jps, jpe, kps, kpe, &
3247 grid%i_start(ij), grid%i_end(ij), &
3248 grid%j_start(ij), grid%j_end(ij), &
3249 k_start , k_end )
3251 BENCH_START(diag_w_tim)
3252 IF (.not. config_flags%non_hydrostatic) THEN
3253 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, &
3254 grid%c1f, grid%c2f, dt_rk, &
3255 grid%u_2, grid%v_2, grid%ht, &
3256 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3257 ids, ide, jds, jde, kds, kde, &
3258 ims, ime, jms, jme, kms, kme, &
3259 grid%i_start(ij), grid%i_end(ij), &
3260 grid%j_start(ij), grid%j_end(ij), &
3261 k_start , k_end )
3262 ENDIF
3263 BENCH_END(diag_w_tim)
3265 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
3267 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3269 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
3270 ids, ide, jds, jde, kds, kde, &
3271 ims, ime, jms, jme, kms, kme, &
3272 ips, ipe, jps, jpe, kps, kpe, &
3273 grid%i_start(ij), grid%i_end(ij), &
3274 grid%j_start(ij), grid%j_end(ij), &
3275 k_start , k_end )
3276 END DO moisture_loop_bdy_1
3278 ENDIF
3280 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
3282 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3284 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
3285 ids, ide, jds, jde, kds, kde, &
3286 ims, ime, jms, jme, kms, kme, &
3287 ips, ipe, jps, jpe, kps, kpe, &
3288 grid%i_start(ij), grid%i_end(ij), &
3289 grid%j_start(ij), grid%j_end(ij), &
3290 k_start , k_end-1 )
3292 END DO chem_species_bdy_loop_1
3294 END IF
3296 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
3298 tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
3300 CALL set_physical_bc3d( tracer(ims,kms,jms,ic), 'p', config_flags, &
3301 ids, ide, jds, jde, kds, kde, &
3302 ims, ime, jms, jme, kms, kme, &
3303 ips, ipe, jps, jpe, kps, kpe, &
3304 grid%i_start(ij), grid%i_end(ij), &
3305 grid%j_start(ij), grid%j_end(ij), &
3306 k_start , k_end-1 )
3308 END DO tracer_species_bdy_loop_1
3310 END IF
3312 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
3314 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3316 CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags, &
3317 ids, ide, jds, jde, kds, kde, &
3318 ims, ime, jms, jme, kms, kme, &
3319 ips, ipe, jps, jpe, kps, kpe, &
3320 grid%i_start(ij), grid%i_end(ij), &
3321 grid%j_start(ij), grid%j_end(ij), &
3322 k_start , k_end-1 )
3324 END DO scalar_species_bdy_loop_1
3326 END IF
3328 IF (config_flags%km_opt .eq. 2) THEN
3330 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
3331 ids, ide, jds, jde, kds, kde, &
3332 ims, ime, jms, jme, kms, kme, &
3333 ips, ipe, jps, jpe, kps, kpe, &
3334 grid%i_start(ij), grid%i_end(ij), &
3335 grid%j_start(ij), grid%j_end(ij), &
3336 k_start , k_end )
3337 END IF
3339 END DO tile_bc_loop_1
3340 !$OMP END PARALLEL DO
3341 BENCH_END(bc_end_tim)
3344 #ifdef DM_PARALLEL
3346 ! * * * * *
3347 ! * * * * * * * * *
3348 ! * + * * + * * * + * *
3349 ! * * * * * * * * *
3350 ! * * * * *
3352 ! moist, chem, scalar, tke x
3355 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3356 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3357 # include "HALO_EM_TKE_5.inc"
3358 ELSE
3359 # include "HALO_EM_TKE_3.inc"
3360 ENDIF
3361 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3362 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3363 # include "HALO_EM_TKE_7.inc"
3364 ELSE
3365 # include "HALO_EM_TKE_5.inc"
3366 ENDIF
3367 ELSE
3368 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3369 CALL wrf_error_fatal(TRIM(wrf_err_message))
3370 ENDIF
3372 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
3373 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3374 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3375 # include "HALO_EM_MOIST_E_5.inc"
3376 ELSE
3377 # include "HALO_EM_MOIST_E_3.inc"
3378 END IF
3379 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3380 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3381 # include "HALO_EM_MOIST_E_7.inc"
3382 ELSE
3383 # include "HALO_EM_MOIST_E_5.inc"
3384 END IF
3385 ELSE
3386 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3387 CALL wrf_error_fatal(TRIM(wrf_err_message))
3388 ENDIF
3389 ENDIF
3390 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3391 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3392 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3393 # include "HALO_EM_CHEM_E_5.inc"
3394 ELSE
3395 # include "HALO_EM_CHEM_E_3.inc"
3396 ENDIF
3397 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3398 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3399 # include "HALO_EM_CHEM_E_7.inc"
3400 ELSE
3401 # include "HALO_EM_CHEM_E_5.inc"
3402 ENDIF
3403 ELSE
3404 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3405 CALL wrf_error_fatal(TRIM(wrf_err_message))
3406 ENDIF
3407 ENDIF
3408 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3409 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3410 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3411 # include "HALO_EM_TRACER_E_5.inc"
3412 ELSE
3413 # include "HALO_EM_TRACER_E_3.inc"
3414 ENDIF
3415 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3416 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3417 # include "HALO_EM_TRACER_E_7.inc"
3418 ELSE
3419 # include "HALO_EM_TRACER_E_5.inc"
3420 ENDIF
3421 ELSE
3422 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3423 CALL wrf_error_fatal(TRIM(wrf_err_message))
3424 ENDIF
3425 ENDIF
3426 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3427 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3428 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3429 # include "HALO_EM_SCALAR_E_5.inc"
3430 ELSE
3431 # include "HALO_EM_SCALAR_E_3.inc"
3432 ENDIF
3433 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3434 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3435 # include "HALO_EM_SCALAR_E_7.inc"
3436 ELSE
3437 # include "HALO_EM_SCALAR_E_5.inc"
3438 ENDIF
3439 ELSE
3440 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3441 CALL wrf_error_fatal(TRIM(wrf_err_message))
3442 ENDIF
3443 ENDIF
3444 #endif
3446 ENDIF rk_step_1_check
3449 !**********************************************************
3450 !
3451 ! end of RK predictor-corrector loop
3452 !
3453 !**********************************************************
3455 END DO Runge_Kutta_loop
3456 ! grid%dmudt=grid%mu_2 - grid%mu_1
3458 #if ( WRFPLUS != 1 )
3459 IF ( config_flags%traj_opt .EQ. UM_TRAJECTORY ) THEN
3460 #ifdef DM_PARALLEL
3461 # include "HALO_EM_F_1.inc"
3462 # include "HALO_EM_D.inc"
3463 # include "HALO_EM_INIT_4.inc"
3464 IF( config_flags%periodic_x ) THEN
3465 # include "PERIOD_EM_DA.inc"
3466 # include "PERIOD_EM_F.inc"
3467 # include "PERIOD_EM_G.inc"
3468 ENDIF
3469 #endif
3470 !$OMP PARALLEL DO &
3471 !$OMP PRIVATE ( ij )
3472 DO ij = 1 , grid%num_tiles
3474 call trajectory (grid,config_flags, &
3475 grid%dt,grid%itimestep,grid%ru_m, grid%rv_m, grid%ww_m,&
3476 grid%muts,grid%muus,grid%muvs, &
3477 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
3478 grid%rdx, grid%rdy, grid%rdn, grid%rdnw,grid%rdzw, &
3479 grid%traj_i,grid%traj_j,grid%traj_k, &
3480 grid%traj_long,grid%traj_lat, &
3481 grid%xlong,grid%xlat, &
3482 grid%msftx,grid%msfux,grid%msfvy, &
3483 ids, ide, jds, jde, kds, kde, &
3484 ims, ime, jms, jme, kms, kme, &
3485 grid%i_start(ij), grid%i_end(ij), &
3486 grid%j_start(ij), grid%j_end(ij), &
3487 k_start , k_end )
3488 ENDDO
3489 !$OMP END PARALLEL DO
3490 ENDIF
3491 #endif
3492 !-----------------------------------------------------------
3494 IF (config_flags%do_avgflx_em .EQ. 1) THEN
3495 ! Reinitialize time-averaged fluxes if history output was written after the previous time step:
3496 CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time)
3497 CALL domain_clock_get ( grid, current_time=CurrTime, &
3498 current_timestr=message2 )
3499 ! use overloaded -, .LT. operator to check whether to initialize avgflx:
3500 ! reinitialize after each history output (detect this here by comparing current time
3501 ! against last history time and time step - this code follows what's done in adapt_timestep_em):
3502 WRITE ( message , FMT = '("solve_em: old_dt =",g15.6,", dt=",g15.6," on domain ",I3)' ) &
3503 & old_dt,grid%dt,grid%id
3504 CALL wrf_debug(200,message)
3505 old_dt=min(old_dt,grid%dt)
3506 num = INT(old_dt * precision)
3507 den = precision
3508 CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3509 IF (CurrTime .lt. temp_time + dtInterval) THEN
3510 WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
3511 & TRIM(message2), grid%id
3512 CALL wrf_message(trim(message))
3513 grid%avgflx_count = 0
3514 !tile-loop for zero_avgflx
3515 !$OMP PARALLEL DO &
3516 !$OMP PRIVATE ( ij )
3518 DO ij = 1 , grid%num_tiles
3519 CALL wrf_debug(200,'In solve_em, before zero_avgflx call')
3520 CALL zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3521 & ids, ide, jds, jde, kds, kde, &
3522 & ims, ime, jms, jme, kms, kme, &
3523 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3524 & k_start , k_end, f_flux, &
3525 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3526 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3527 CALL wrf_debug(200,'In solve_em, after zero_avgflx call')
3528 ENDDO
3529 !$OMP END PARALLEL DO
3530 ENDIF
3532 ! Update avgflx quantities
3533 !tile-loop for upd_avgflx
3534 !$OMP PARALLEL DO &
3535 !$OMP PRIVATE ( ij )
3537 DO ij = 1 , grid%num_tiles
3538 CALL wrf_debug(200,'In solve_em, before upd_avgflx call')
3539 CALL upd_avgflx(grid%avgflx_count,grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3540 & grid%ru_m, grid%rv_m, grid%ww_m, &
3541 & ids, ide, jds, jde, kds, kde, &
3542 & ims, ime, jms, jme, kms, kme, &
3543 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3544 & k_start , k_end, f_flux, &
3545 & grid%cfu1,grid%cfd1,grid%dfu1,grid%efu1,grid%dfd1,grid%efd1, &
3546 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3547 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3548 CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
3550 ENDDO
3551 !$OMP END PARALLEL DO
3552 grid%avgflx_count = grid%avgflx_count + 1
3553 ENDIF
3554 !
3555 !$OMP PARALLEL DO &
3556 !$OMP PRIVATE ( ij )
3557 DO ij = 1 , grid%num_tiles
3559 BENCH_START(advance_ppt_tim)
3560 CALL wrf_debug ( 200 , ' call advance_ppt' )
3561 CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
3562 grid%cldfra_cup, & !BSINGH - Added for CuP scheme
3563 grid%rqicuten,grid%rqscuten, &
3564 grid%rainc,grid%raincv,grid%rainsh,grid%pratec,grid%pratesh, &
3565 grid%nca,grid%htop,grid%hbot,grid%cutop,grid%cubot, &
3566 grid%cuppt, grid%dt, config_flags, &
3567 ids,ide, jds,jde, kds,kde, &
3568 ims,ime, jms,jme, kms,kme, &
3569 grid%i_start(ij), grid%i_end(ij), &
3570 grid%j_start(ij), grid%j_end(ij), &
3571 k_start , k_end )
3572 BENCH_END(advance_ppt_tim)
3574 ENDDO
3575 !$OMP END PARALLEL DO
3577 !$OMP PARALLEL DO &
3578 !$OMP PRIVATE ( ij )
3579 DO ij = 1 , grid%num_tiles
3580 CALL wrf_debug ( 200 , ' call phy_prep_part2' )
3581 CALL phy_prep_part2 ( config_flags, &
3582 grid%muts, grid%muus, grid%muvs, &
3583 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
3584 grid%rthraten, &
3585 grid%rthblten, grid%rublten, grid%rvblten, &
3586 grid%rqvblten, grid%rqcblten, grid%rqiblten, &
3587 grid%rucuten, grid%rvcuten, grid%rthcuten, &
3588 grid%rqvcuten, grid%rqccuten, grid%rqrcuten, &
3589 grid%rqicuten, grid%rqscuten, &
3590 grid%rushten, grid%rvshten, grid%rthshten, &
3591 grid%rqvshten, grid%rqcshten, grid%rqrshten, &
3592 grid%rqishten, grid%rqsshten, grid%rqgshten, &
3593 grid%rthften, grid%rqvften, &
3594 grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN, &
3595 grid%RPHNDGDTEN,grid%RQVNDGDTEN, grid%RMUNDGDTEN,&
3596 grid%t_2, th_phy, moist(ims,kms,jms,P_QV), &
3597 ids, ide, jds, jde, kds, kde, &
3598 ims, ime, jms, jme, kms, kme, &
3599 grid%i_start(ij), grid%i_end(ij), &
3600 grid%j_start(ij), grid%j_end(ij), &
3601 k_start, k_end )
3602 ENDDO
3603 !$OMP END PARALLEL DO
3605 !<DESCRIPTION>
3606 !<pre>
3607 ! (5) time-split physics.
3608 !
3609 ! Microphysics are the only time split physics in the WRF model
3610 ! at this time. Split-physics begins with the calculation of
3611 ! needed diagnostic quantities (pressure, temperature, etc.)
3612 ! followed by a call to the microphysics driver,
3613 ! and finishes with a clean-up, storing off of a diabatic tendency
3614 ! from the moist physics, and a re-calulation of the diagnostic
3615 ! quantities pressure and density.
3616 !</pre>
3617 !</DESCRIPTION>
3619 IF( config_flags%specified .or. config_flags%nested ) THEN
3620 sz = grid%spec_zone
3621 ELSE
3622 sz = 0
3623 ENDIF
3625 IF (config_flags%mp_physics /= 0) then
3627 !$OMP PARALLEL DO &
3628 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3630 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3632 IF ( config_flags%periodic_x ) THEN
3633 its = max(grid%i_start(ij),ids)
3634 ite = min(grid%i_end(ij),ide-1)
3635 ELSE
3636 its = max(grid%i_start(ij),ids+sz)
3637 ite = min(grid%i_end(ij),ide-1-sz)
3638 ENDIF
3639 jts = max(grid%j_start(ij),jds+sz)
3640 jte = min(grid%j_end(ij),jde-1-sz)
3642 if (config_flags%madwrf_opt == 2) then
3643 CALL wrf_debug ( 200 , ' call cloud_tracer_nudge' )
3645 CALL cloud_tracer_nudge( dtm, config_flags%madwrf_dt_relax, &
3646 config_flags%madwrf_dt_nudge, &
3647 grid%xtime, &
3648 moist(ims,kms,jms,P_QC), &
3649 moist(ims,kms,jms,P_QI), &
3650 moist(ims,kms,jms,P_QS), &
3651 tracer(ims,kms,jms,P_tr_qc), &
3652 tracer(ims,kms,jms,P_tr_qi), &
3653 tracer(ims,kms,jms,P_tr_qs), &
3654 ids, ide, jds, jde, kds, kde, &
3655 ims, ime, jms, jme, kms, kme, &
3656 its, ite, jts, jte, &
3657 k_start , k_end )
3658 end if
3660 CALL wrf_debug ( 200 , ' call moist_physics_prep' )
3661 BENCH_START(moist_physics_prep_tim)
3662 CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, grid%rho, &
3663 grid%al, grid%alb, grid%p, p8w, p0, grid%pb, &
3664 grid%ph_2, grid%phb, th_phy, pi_phy , p_phy, &
3665 grid%z, grid%z_at_w, dz8w, &
3666 dtm, grid%h_diabatic, &
3667 moist(ims,kms,jms,P_QV),grid%qv_diabatic, &
3668 moist(ims,kms,jms,P_QC),grid%qc_diabatic, &
3669 config_flags,grid%fnm, grid%fnp, &
3670 ids, ide, jds, jde, kds, kde, &
3671 ims, ime, jms, jme, kms, kme, &
3672 its, ite, jts, jte, &
3673 k_start , k_end )
3675 IF (config_flags%dust_emis.eq.1 .AND. config_flags%mp_physics.eq.thompsonaero) then
3676 CALL wrf_debug ( 200 , ' call bulk_dust_emis' )
3677 CALL bulk_dust_emis (grid%itimestep,dtm,config_flags%num_soil_layers &
3678 ,grid%u_phy,grid%v_phy,grid%rho,grid%alt &
3679 ,grid%u10,grid%v10,p8w,dz8w,grid%smois,grid%erod &
3680 ,grid%ivgtyp,grid%isltyp,grid%vegfra,grid%albbck,grid%xland &
3681 ,grid%dx, g, grid%qnifa2d, ids,ide, jds,jde, kds,kde &
3682 ,ims,ime, jms,jme, kms,kme &
3683 ,its,ite, jts,jte, k_start,k_end )
3684 ENDIF
3686 BENCH_END(moist_physics_prep_tim)
3687 END DO scalar_tile_loop_1a
3688 !$OMP END PARALLEL DO
3690 CALL wrf_debug ( 200 , ' call microphysics_driver' )
3692 grid%sr = 0.
3693 specified_bdy = config_flags%specified .OR. config_flags%nested
3694 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3696 BENCH_START(micro_driver_tim)
3698 !
3699 ! WRFU_AlarmIsRinging always returned false, so using an alternate method to find out if it is time
3700 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
3701 !
3702 ! diagflag = .false.
3703 ! CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time,RingInterval=intervaltime)
3704 ! CALL WRFU_ALARMGET(grid%alarms( RESTART_ALARM ),prevringtime=restart_time,RingInterval=restartinterval)
3705 ! CALL domain_clock_get ( grid, current_time=CurrTime )
3706 ! old_dt=min(old_dt,grid%dt)
3707 ! num = INT(old_dt * precision)
3708 ! den = precision
3709 ! CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3710 ! IF (CurrTime .ge. temp_time + intervaltime - dtInterval .or. &
3711 ! CurrTime .ge. restart_time + restartinterval - dtInterval ) THEN
3712 ! diagflag = .true.
3713 ! ENDIF
3714 ! WRITE(wrf_err_message,*)'diag_flag=',diag_flag
3715 ! CALL wrf_debug ( 0 , wrf_err_message )
3716 #ifdef DM_PARALLEL
3717 # include "HALO_EM_SBM.inc"
3718 #endif
3721 CALL microphysics_driver( &
3722 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3723 & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy &
3724 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3725 & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
3726 & ,RHO=grid%rho ,SPEC_ZONE=grid%spec_zone &
3727 & ,SR=grid%sr ,TH=th_phy &
3728 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
3729 & ,vmi3d=grid%vmi3d & ! for P3
3730 & ,di3d=grid%di3d & ! for P3
3731 & ,rhopo3d=grid%rhopo3d & ! for P3
3732 & ,phii3d=grid%phii3d & ! for Jensen ISHMAEL
3733 & ,vmi3d_2=grid%vmi3d_2 & ! for P3
3734 & ,di3d_2=grid%di3d_2 & ! for P3
3735 & ,rhopo3d_2=grid%rhopo3d_2 & ! for P3
3736 & ,phii3d_2=grid%phii3d_2 & ! for Jensen ISHMAEL
3737 & ,vmi3d_3=grid%vmi3d_3 & ! for Jensen ISHMAEL
3738 & ,di3d_3=grid%di3d_3 & ! for Jensen ISHMAEL
3739 & ,rhopo3d_3=grid%rhopo3d_3 & ! for Jensen ISHMAEL
3740 & ,phii3d_3=grid%phii3d_3 & ! for Jensen ISHMAEL
3741 & ,itype=grid%itype & ! for Jensen ISHMAEL
3742 & ,itype_2=grid%itype_2 & ! for Jensen ISHMAEL
3743 & ,itype_3=grid%itype_3 & ! for Jensen ISHMAEL
3744 & ,WARM_RAIN=grid%warm_rain &
3745 & ,T8W=t8w &
3746 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3747 & ,NSOURCE=grid%qndropsource &
3748 #if (WRF_CHEM == 1)
3749 & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
3750 & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
3751 & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
3752 !======================
3753 ! Variables required for CAMMGMP Scheme when run with WRF_CHEM
3754 & ,CHEM=chem &
3755 & ,QME3D=grid%qme3d,PRAIN3D=grid%prain3d &
3756 & ,NEVAPR3D=grid%nevapr3d &
3757 & ,RATE1ORD_CW2PR_ST3D=grid%rate1ord_cw2pr_st3d &
3758 & ,DGNUM4D=grid%dgnum4d,DGNUMWET4D=grid%dgnumwet4d &
3759 !======================
3760 #endif
3761 & ,XLAND=grid%xland,SNOWH=grid%SNOW & !PMA
3762 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3763 & ,F_RAIN_PHY=grid%f_rain_phy &
3764 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3765 & ,MP_PHYSICS=config_flags%mp_physics &
3766 & ,ID=grid%id &
3767 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3768 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3769 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3770 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3771 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3772 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3773 & ,NUM_TILES=grid%num_tiles &
3774 & ,NAER=grid%naer &
3775 !===================== IRRIGATION =========================
3776 & ,IRRIGATION=grid%irrigation &
3777 & ,SF_SURF_IRR_SCHEME=config_flags%sf_surf_irr_scheme &
3778 & ,IRR_DAILY_AMOUNT=config_flags%irr_daily_amount &
3779 & ,IRR_START_HOUR=config_flags%irr_start_hour &
3780 & ,IRR_NUM_HOURS=config_flags%irr_num_hours &
3781 & ,JULIAN_IN=grid%julian &
3782 & ,IRR_START_JULIANDAY=config_flags%irr_start_julianday &
3783 & ,IRR_END_JULIANDAY=config_flags%irr_end_julianday &
3784 & ,IRR_FREQ=config_flags%irr_freq,IRR_PH=config_flags%irr_ph &
3785 & ,IRR_RAND_FIELD=grid%irr_rand_field &
3786 & ,GMT=grid%gmt,XTIME=grid%xtime &
3787 !======================
3788 ! Variables required for CAMMGMP Scheme
3789 & ,DLF=grid%dlf,DLF2=grid%dlf2,T_PHY=grid%t_phy,P_HYD=grid%p_hyd &
3790 & ,P8W_HYD=grid%p_hyd_w,TKE_PBL=grid%tke_pbl,PBLH=grid%PBLH &
3791 & ,Z_AT_MASS=grid%z,Z_AT_W=grid%z_at_w &
3792 & ,QFX=grid%qfx,RLIQ=grid%rliq &
3793 & ,TURBTYPE3D=grid%turbtype3d,SMAW3D=grid%smaw3d &
3794 & ,WSEDL3D=grid%wsedl3d,CLDFRA_OLD_MP=grid%cldfra_old_mp &
3795 & ,CLDFRA_MP=grid%cldfra_mp,CLDFRA_MP_ALL=grid%cldfra_mp_ALL &
3796 & ,LRADIUS=grid%LRADIUS, IRADIUS=grid%IRADIUS & !BSINGH(01/20/2014): Added for RRTMG<->CAMMGMP
3797 & ,CLDFRAI=grid%cldfrai &
3798 & ,CLDFRAL=grid%cldfral,CLDFRA_CONV=grid%CLDFRA_CONV &
3799 & ,ALT=grid%alt &
3800 & ,ACCUM_MODE=config_flags%accum_mode &
3801 & ,AITKEN_MODE=config_flags%aitken_mode &
3802 & ,COARSE_MODE=config_flags%coarse_mode &
3803 & ,ICWMRSH3D=grid%icwmrsh,ICWMRDP3D=grid%icwmrdp3d &
3804 & ,SHFRC3D=grid%shfrc3d,CMFMC3D=grid%cmfmc &
3805 & ,CMFMC2_3D=grid%cmfmc2,CONFIG_FLAGS=config_flags &
3806 & ,FNM=grid%fnm,FNP=grid%fnp,RH_OLD_MP=grid%rh_old_mp &
3807 & ,LCD_OLD_MP=grid%lcd_old_mp &
3808 !======================
3809 ! Optional
3810 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3811 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3812 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
3813 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
3814 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
3815 & , MP_RESTART_STATE=grid%mp_restart_state &
3816 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3817 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3818 & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
3819 & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
3820 & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
3821 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
3822 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
3823 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
3824 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
3825 & , QIC_CURR=moist(ims,kms,jms,P_QIC), F_QIC=F_QIC &
3826 & , QIP_CURR=moist(ims,kms,jms,P_QIP), F_QIP=F_QIP &
3827 & , QID_CURR=moist(ims,kms,jms,P_QID), F_QID=F_QID &
3828 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3829 #if (WRF_CHEM == 1)
3830 & , RAINPROD=wetscav_frcing(ims,kms,jms,p_rainprod) &
3831 & , EVAPPROD=wetscav_frcing(ims,kms,jms,p_evapprod) &
3832 & , QV_B4MP=grid%qv_b4mp,QC_B4MP=grid%qc_b4mp &
3833 & , QI_B4MP=grid%qi_b4mp, QS_B4MP=grid%qs_b4mp &
3834 #endif
3835 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3836 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
3837 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3838 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
3839 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3840 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3841 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3842 & , QNWFA_CURR=scalar(ims,kms,jms,P_QNWFA), F_QNWFA=F_QNWFA & ! for Thompson water-friendly aerosol
3843 & , QNIFA_CURR=scalar(ims,kms,jms,P_QNIFA), F_QNIFA=F_QNIFA & ! for Thompson ice-friendly aerosol
3844 & , QNBCA_CURR=scalar(ims,kms,jms,P_QNBCA), F_QNBCA=F_QNBCA & ! for Thompson black carbon aerosol
3845 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom and nssl_2mom
3846 & , QNIC_CURR=scalar(ims,kms,jms,P_QNIC), F_QNIC=F_QNIC &
3847 & , QNIP_CURR=scalar(ims,kms,jms,P_QNIP), F_QNIP=F_QNIP &
3848 & , QNID_CURR=scalar(ims,kms,jms,P_QNID), F_QNID=F_QNID &
3849 & , QIR_CURR=scalar(ims,kms,jms,P_QIR), F_QIR=F_QIR & ! for P3
3850 & , QIB_CURR=scalar(ims,kms,jms,P_QIB), F_QIB=F_QIB & ! for P3
3851 & , QVOLI_CURR=scalar(ims,kms,jms,P_QVOLI), F_QVOLI=F_QVOLI & ! for Jensen ISHMAEL
3852 & , QAOLI_CURR=scalar(ims,kms,jms,P_QAOLI), F_QAOLI=F_QAOLI & ! for Jensen ISHMAEL
3853 & , QI2_CURR=moist(ims,kms,jms,P_QI2), F_QI2=F_QI2 & ! for P3
3854 & , QNI2_CURR=scalar(ims,kms,jms,P_QNI2), F_QNI2=F_QNI2 & ! for P3
3855 & , QIR2_CURR=scalar(ims,kms,jms,P_QIR2), F_QIR2=F_QIR2 & ! for P3
3856 & , QIB2_CURR=scalar(ims,kms,jms,P_QIB2), F_QIB2=F_QIB2 & ! for P3
3857 & , QVOLI2_CURR=scalar(ims,kms,jms,P_QVOLI2), F_QVOLI2=F_QVOLI2 & ! for Jensen ISHMAEL
3858 & , QAOLI2_CURR=scalar(ims,kms,jms,P_QAOLI2), F_QAOLI2=F_QAOLI2 & ! for Jensen ISHMAEL
3859 & , QI3_CURR=moist(ims,kms,jms,P_QI3), F_QI3=F_QI3 & ! for Jensen ISHMAEL
3860 & , QNI3_CURR=scalar(ims,kms,jms,P_QNI3), F_QNI3=F_QNI3 & ! for Jensen ISHMAEL
3861 & , QVOLI3_CURR=scalar(ims,kms,jms,P_QVOLI3), F_QVOLI3=F_QVOLI3 & ! for Jensen ISHMAEL
3862 & , QAOLI3_CURR=scalar(ims,kms,jms,P_QAOLI3), F_QAOLI3=F_QAOLI3 & ! for Jensen ISHMAEL
3863 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
3864 & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! for 3-moment P3
3865 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
3866 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
3867 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
3868 & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom
3869 & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom
3870 & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m
3871 & , QTCN_CURR=scalar(ims,kms,jms,P_QTCN), F_QTCN=F_QTCN & ! for ntu3m
3872 & , QCCN_CURR=scalar(ims,kms,jms,P_QCCN), F_QCCN=F_QCCN & ! for ntu3m
3873 & , QRCN_CURR=scalar(ims,kms,jms,P_QRCN), F_QRCN=F_QRCN & ! for ntu3m
3874 & , QNIN_CURR=scalar(ims,kms,jms,P_QNIN), F_QNIN=F_QNIN & ! for ntu3m
3875 & , FI_CURR=scalar(ims,kms,jms,P_FI), F_FI=F_FI & ! for ntu3m
3876 & , FS_CURR=scalar(ims,kms,jms,P_FS), F_FS=F_FS & ! for ntu3m
3877 & , VI_CURR=scalar(ims,kms,jms,P_VI), F_VI=F_VI & ! for ntu3m
3878 & , VS_CURR=scalar(ims,kms,jms,P_VS), F_VS=F_VS & ! for ntu3m
3879 & , VG_CURR=scalar(ims,kms,jms,P_VG), F_VG=F_VG & ! for ntu3m
3880 & , AI_CURR=scalar(ims,kms,jms,P_AI), F_AI=F_AI & ! for ntu3m
3881 & , AS_CURR=scalar(ims,kms,jms,P_AS), F_AS=F_AS & ! for ntu3m
3882 & , AG_CURR=scalar(ims,kms,jms,P_AG), F_AG=F_AG & ! for ntu3m
3883 & , AH_CURR=scalar(ims,kms,jms,P_AH), F_AH=F_AH & ! for ntu3m
3884 & , I3M_CURR=scalar(ims,kms,jms,P_I3M), F_I3M=F_I3m & ! for ntu3m
3885 & , cu_used=config_flags%cu_used &
3886 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3887 & , qicuten=grid%rqicuten, qccuten=grid%rqccuten &
3888 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
3889 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
3890 & , PHYS_TOT=grid%phys_tot & ! for gsfcgce
3891 & , PHYSC=grid%physc & ! for gsfcgce
3892 & , PHYSE=grid%physe & ! for gsfcgce
3893 & , PHYSD=grid%physd & ! for gsfcgce
3894 & , PHYSS=grid%physs & ! for gsfcgce
3895 & , PHYSM=grid%physm & ! for gsfcgce
3896 & , PHYSF=grid%physf & ! for gsfcgce
3898 & , ACPHYS_TOT=grid%acphys_tot & ! for gsfcgce
3899 & , ACPHYSC=grid%acphysc & ! for gsfcgce
3900 & , ACPHYSE=grid%acphyse & ! for gsfcgce
3901 & , ACPHYSD=grid%acphysd & ! for gsfcgce
3902 & , ACPHYSS=grid%acphyss & ! for gsfcgce
3903 & , ACPHYSM=grid%acphysm & ! for gsfcgce
3904 & , ACPHYSF=grid%acphysf & ! for gsfcgce
3906 & , RE_CLOUD_GSFC=grid%re_cloud_gsfc & ! for gsfcgce
3907 & , RE_RAIN_GSFC=grid%re_rain_gsfc & ! for gsfcgce
3908 & , RE_ICE_GSFC=grid%re_ice_gsfc & ! for gsfcgce
3909 & , RE_SNOW_GSFC=grid%re_snow_gsfc & ! for gsfcgce
3910 & , RE_GRAUPEL_GSFC=grid%re_graupel_gsfc & ! for gsfcgce
3911 & , RE_HAIL_GSFC=grid%re_hail_gsfc & ! for gsfcgce
3912 & , PRECR3D=grid%precr3d, PRECI3D=grid%preci3d, PRECS3D=grid%precs3d &
3913 & , PRECG3D=grid%precg3d, PRECH3D=grid%prech3d &
3914 #if ( WRF_CHEM == 1)
3915 & , GSFCGCE_GOCART_COUPLING=config_flags%gsfcgce_gocart_coupling &
3916 & , ICN_DIAG=grid%icn_diag & ! inline gocart
3917 & , NC_DIAG=grid%nc_diag & ! inline gocart
3918 #endif
3919 !NUWRF JJS 20110525 ^^^^^
3920 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
3921 ! YLIN
3922 ! RI_CURR INPUT
3923 & , RI_CURR=grid%rimi &
3924 & , re_cloud=grid%re_cloud, re_ice=grid%re_ice, re_snow=grid%re_snow & ! G. Thompson
3925 & , has_reqc=grid%has_reqc, has_reqi=grid%has_reqi, has_reqs=grid%has_reqs & ! G. Thompson
3926 & , qnwfa2d=grid%qnwfa2d, qnifa2d=grid%qnifa2d, qnbca2d=grid%qnbca2d & ! G. Thompson
3927 & , qnocbb2d=grid%qnocbb2d, qnbcbb2d=grid%qnbcbb2d & ! for biomass burning emissions
3928 & , diagflag=diag_flag, do_radar_ref=config_flags%do_radar_ref &
3929 & , ke_diag=ke_diag &
3930 & ,u=grid%u_phy,v=grid%v_phy &
3931 & ,scalar=scalar,num_scalar=num_scalar &
3932 & ,TH_OLD=grid%th_old &
3933 & ,QV_OLD=grid%qv_old &
3934 & ,xlat=grid%xlat,xlong=grid%xlong,IVGTYP=grid%ivgtyp &
3935 & , EFFR_CURR=scalar(ims,kms,jms,P_EFFR), F_EFFR=F_EFFR & ! for SBM
3936 & , ICE_EFFR_CURR=scalar(ims,kms,jms,P_ICE_EFFR), F_ICE_EFFR=F_ICE_EFFR & ! for SBM
3937 & , TOT_EFFR_CURR=scalar(ims,kms,jms,P_TOT_EFFR), F_TOT_EFFR=F_TOT_EFFR & ! for SBM
3938 & , QIC_EFFR_CURR=scalar(ims,kms,jms,P_QIC_EFFR), F_QIC_EFFR=F_QIC_EFFR & ! for SBM
3939 & , QIP_EFFR_CURR=scalar(ims,kms,jms,P_QIP_EFFR), F_QIP_EFFR=F_QIP_EFFR & ! for SBM
3940 & , QID_EFFR_CURR=scalar(ims,kms,jms,P_QID_EFFR), F_QID_EFFR=F_QID_EFFR & ! for SBM
3941 & ,kext_ql=grid%kext_ql &
3942 & ,kext_qs=grid%kext_qs &
3943 & ,kext_qg=grid%kext_qg &
3944 & ,kext_qh=grid%kext_qh &
3945 & ,kext_qa=grid%kext_qa &
3946 & ,kext_qic=grid%kext_qic &
3947 & ,kext_qip=grid%kext_qip &
3948 & ,kext_qid=grid%kext_qid &
3949 & ,kext_ft_qic=grid%kext_ft_qic &
3950 & ,kext_ft_qip=grid%kext_ft_qip &
3951 & ,kext_ft_qid=grid%kext_ft_qid &
3952 & ,kext_ft_qs=grid%kext_ft_qs &
3953 & ,kext_ft_qg=grid%kext_ft_qg &
3954 & ,height=grid%height &
3955 & ,tempc=grid%tempc &
3956 & ,ccn_conc=grid%ccn_conc & ! RAS
3957 & ,sbmradar=sbmradar,num_sbmradar=num_sbmradar & ! for SBM
3958 & ,sbm_diagnostics=config_flags%sbm_diagnostics & ! for SBM
3959 & ,aerocu=aerocu &
3960 & ,aercu_fct=config_flags%aercu_fct &
3961 & ,aercu_opt=config_flags%aercu_opt &
3962 & ,no_src_types_cu=grid%no_src_types_cu &
3963 & ,PBL=grid%bl_pbl_physics,EFCG=grid%EFCG,EFIG=grid%EFIG,EFSG=grid%EFSG &
3964 & ,WACT=grid%WACT,CCN1_GS=grid%CCN1_GS,CCN2_GS=grid%CCN2_GS,CCN3_GS=grid%CCN3_GS &
3965 & ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
3966 & ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
3967 & ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm &
3968 ! WRF-Solar EPS
3969 & ,multi_perturb=config_flags%multi_perturb &
3970 & ,pert_thom=config_flags%pert_thom &
3971 & ,perts_qvapor=grid%pert3d(:,:,:,P_PQVAPOR) &
3972 & ,perts_qcloud=grid%pert3d(:,:,:,P_PQCLOUD) &
3973 & ,perts_qice=grid%pert3d(:,:,:,P_PQICE) &
3974 & ,perts_qsnow=grid%pert3d(:,:,:,P_PQSNOW) &
3975 & ,perts_ni=grid%pert3d(:,:,:,P_PNI) &
3976 & ,pert_thom_qv=config_flags%pert_thom_qv &
3977 & ,pert_thom_qc=config_flags%pert_thom_qc &
3978 & ,pert_thom_qi=config_flags%pert_thom_qi &
3979 & ,pert_thom_qs=config_flags%pert_thom_qs &
3980 & ,pert_thom_ni=config_flags%pert_thom_ni )
3982 BENCH_END(micro_driver_tim)
3984 #if 0
3985 BENCH_START(microswap_2)
3986 ! for load balancing; communication to redistribute the points
3987 IF ( config_flags%mp_physics .EQ. ETAMPNEW .OR. &
3988 & config_flags%mp_physics .EQ. FER_MP_HIRES) THEN
3989 #include "SWAP_ETAMP_NEW.inc"
3990 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
3991 #include "SWAP_WSM3.inc"
3992 ENDIF
3993 BENCH_END(microswap_2)
3994 #endif
3996 CALL wrf_debug ( 200 , ' call moist_physics_finish' )
3997 BENCH_START(moist_phys_end_tim)
3999 !$OMP PARALLEL DO &
4000 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
4002 DO ij = 1 , grid%num_tiles
4004 its = max(grid%i_start(ij),ids)
4005 ite = min(grid%i_end(ij),ide-1)
4006 jts = max(grid%j_start(ij),jds)
4007 jte = min(grid%j_end(ij),jde-1)
4009 CALL microphysics_zero_outb ( &
4010 moist , num_moist , config_flags , &
4011 ids, ide, jds, jde, kds, kde, &
4012 ims, ime, jms, jme, kms, kme, &
4013 its, ite, jts, jte, &
4014 k_start , k_end )
4016 CALL microphysics_zero_outb ( &
4017 scalar , num_scalar , config_flags , &
4018 ids, ide, jds, jde, kds, kde, &
4019 ims, ime, jms, jme, kms, kme, &
4020 its, ite, jts, jte, &
4021 k_start , k_end )
4023 CALL microphysics_zero_outb ( &
4024 chem , num_chem , config_flags , &
4025 ids, ide, jds, jde, kds, kde, &
4026 ims, ime, jms, jme, kms, kme, &
4027 its, ite, jts, jte, &
4028 k_start , k_end )
4029 CALL microphysics_zero_outb ( &
4030 tracer , num_tracer , config_flags , &
4031 ids, ide, jds, jde, kds, kde, &
4032 ims, ime, jms, jme, kms, kme, &
4033 its, ite, jts, jte, &
4034 k_start , k_end )
4036 IF ( config_flags%periodic_x ) THEN
4037 its = max(grid%i_start(ij),ids)
4038 ite = min(grid%i_end(ij),ide-1)
4039 ELSE
4040 its = max(grid%i_start(ij),ids+sz)
4041 ite = min(grid%i_end(ij),ide-1-sz)
4042 ENDIF
4043 jts = max(grid%j_start(ij),jds+sz)
4044 jte = min(grid%j_end(ij),jde-1-sz)
4046 CALL microphysics_zero_outa ( &
4047 moist , num_moist , config_flags , &
4048 ids, ide, jds, jde, kds, kde, &
4049 ims, ime, jms, jme, kms, kme, &
4050 its, ite, jts, jte, &
4051 k_start , k_end )
4053 CALL microphysics_zero_outa ( &
4054 scalar , num_scalar , config_flags , &
4055 ids, ide, jds, jde, kds, kde, &
4056 ims, ime, jms, jme, kms, kme, &
4057 its, ite, jts, jte, &
4058 k_start , k_end )
4060 CALL microphysics_zero_outa ( &
4061 chem , num_chem , config_flags , &
4062 ids, ide, jds, jde, kds, kde, &
4063 ims, ime, jms, jme, kms, kme, &
4064 its, ite, jts, jte, &
4065 k_start , k_end )
4067 CALL microphysics_zero_outa ( &
4068 tracer , num_tracer , config_flags , &
4069 ids, ide, jds, jde, kds, kde, &
4070 ims, ime, jms, jme, kms, kme, &
4071 its, ite, jts, jte, &
4072 k_start , k_end )
4074 CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, &
4075 grid%h_diabatic, dtm, &
4076 moist(ims,kms,jms,P_QV),grid%qv_diabatic, &
4077 moist(ims,kms,jms,P_QC),grid%qc_diabatic, &
4078 grid%th_phy_m_t0, &
4079 config_flags, &
4080 #if ( WRF_DFI_RADAR == 1 )
4081 grid%dfi_tten_rad,grid%dfi_stage, &
4082 #endif
4083 ids, ide, jds, jde, kds, kde, &
4084 ims, ime, jms, jme, kms, kme, &
4085 its, ite, jts, jte, &
4086 k_start , k_end )
4088 END DO
4089 !$OMP END PARALLEL DO
4091 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
4092 # include "HALO_EM_THETAM.inc"
4093 # include "PERIOD_EM_THETAM.inc"
4094 #endif
4095 its=ips ; ite = ipe
4096 jts=jps ; jte = jpe
4097 CALL set_physical_bc3d( grid%h_diabatic, 'p', config_flags, &
4098 ids, ide, jds, jde, kds, kde, &
4099 ims, ime, jms, jme, kms, kme, &
4100 ips, ipe, jps, jpe, kps, kpe, &
4101 its, ite, jts, jte, &
4102 k_start , k_end )
4103 ENDIF ! microphysics test
4105 !-----------------------------------------------------------
4106 ! filter for moist variables post-microphysics and end of timestep
4107 !-----------------------------------------------------------
4109 IF (config_flags%polar) THEN
4110 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
4111 CALL wrf_debug ( 200 , ' call filter moist' )
4112 DO im = PARAM_FIRST_SCALAR, num_3d_m
4113 IF ( config_flags%coupled_filtering ) THEN
4114 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
4115 ,MU=grid%mu_2 , MUB=grid%mub &
4116 ,C1=grid%c1h , C2=grid%c2h &
4117 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4118 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4119 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4120 END IF
4122 CALL pxft ( grid=grid &
4123 ,lineno=__LINE__ &
4124 ,flag_uv = 0 &
4125 ,flag_rurv = 0 &
4126 ,flag_wph = 0 &
4127 ,flag_ww = 0 &
4128 ,flag_t = 0 &
4129 ,flag_mu = 0 &
4130 ,flag_mut = 0 &
4131 ,flag_moist = im &
4132 ,flag_chem = 0 &
4133 ,flag_tracer = 0 &
4134 ,flag_scalar = 0 &
4135 ,actual_distance_average=config_flags%actual_distance_average&
4136 ,pos_def = config_flags%pos_def &
4137 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4138 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4139 ,fft_filter_lat = config_flags%fft_filter_lat &
4140 ,dclat = dclat &
4141 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4142 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4143 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4144 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4145 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4147 IF ( config_flags%coupled_filtering ) THEN
4148 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
4149 ,MU=grid%mu_2 , MUB=grid%mub &
4150 ,C1=grid%c1h , C2=grid%c2h &
4151 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4152 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4153 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4154 END IF
4155 ENDDO
4156 ENDIF
4157 ENDIF
4159 !-----------------------------------------------------------
4160 ! end filter for moist variables post-microphysics and end of timestep
4161 !-----------------------------------------------------------
4164 !$OMP PARALLEL DO &
4165 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
4166 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
4168 IF ( config_flags%periodic_x ) THEN
4169 its = max(grid%i_start(ij),ids)
4170 ite = min(grid%i_end(ij),ide-1)
4171 ELSE
4172 its = max(grid%i_start(ij),ids+sz)
4173 ite = min(grid%i_end(ij),ide-1-sz)
4174 ENDIF
4175 jts = max(grid%j_start(ij),jds+sz)
4176 jte = min(grid%j_end(ij),jde-1-sz)
4178 CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, &
4179 grid%al, grid%alb, grid%mu_2, grid%muts, &
4180 grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
4181 grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, &
4182 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
4183 grid%rdn, config_flags%non_hydrostatic,config_flags%use_theta_m, &
4184 ids, ide, jds, jde, kds, kde, &
4185 ims, ime, jms, jme, kms, kme, &
4186 its, ite, jts, jte, &
4187 k_start , k_end )
4189 END DO scalar_tile_loop_1ba
4190 !$OMP END PARALLEL DO
4191 BENCH_END(moist_phys_end_tim)
4193 IF (.not. config_flags%non_hydrostatic) THEN
4194 #ifdef DM_PARALLEL
4195 # include "HALO_EM_HYDRO_UV.inc"
4196 # include "PERIOD_EM_HYDRO_UV.inc"
4197 #endif
4198 !$OMP PARALLEL DO &
4199 !$OMP PRIVATE ( ij )
4200 DO ij = 1 , grid%num_tiles
4201 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, &
4202 grid%c1f, grid%c2f, dt_rk, &
4203 grid%u_2, grid%v_2, grid%ht, &
4204 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
4205 ids, ide, jds, jde, kds, kde, &
4206 ims, ime, jms, jme, kms, kme, &
4207 grid%i_start(ij), grid%i_end(ij), &
4208 grid%j_start(ij), grid%j_end(ij), &
4209 k_start , k_end )
4211 END DO
4212 !$OMP END PARALLEL DO
4214 END IF
4216 CALL wrf_debug ( 200 , ' call chem polar filter ' )
4218 !-----------------------------------------------------------
4219 ! filter for chem and scalar variables at end of timestep
4220 !-----------------------------------------------------------
4222 IF (config_flags%polar) THEN
4224 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
4225 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
4226 IF ( config_flags%coupled_filtering ) THEN
4227 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
4228 ,MU=grid%mu_2 , MUB=grid%mub &
4229 ,C1=grid%c1h , C2=grid%c2h &
4230 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4231 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4232 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4233 END IF
4235 CALL pxft ( grid=grid &
4236 ,lineno=__LINE__ &
4237 ,flag_uv = 0 &
4238 ,flag_rurv = 0 &
4239 ,flag_wph = 0 &
4240 ,flag_ww = 0 &
4241 ,flag_t = 0 &
4242 ,flag_mu = 0 &
4243 ,flag_mut = 0 &
4244 ,flag_moist = 0 &
4245 ,flag_chem = im &
4246 ,flag_tracer = 0 &
4247 ,flag_scalar = 0 &
4248 ,actual_distance_average=config_flags%actual_distance_average&
4249 ,pos_def = config_flags%pos_def &
4250 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4251 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4252 ,fft_filter_lat = config_flags%fft_filter_lat &
4253 ,dclat = dclat &
4254 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4255 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4256 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4257 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4258 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4260 IF ( config_flags%coupled_filtering ) THEN
4261 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
4262 ,MU=grid%mu_2 , MUB=grid%mub &
4263 ,C1=grid%c1h , C2=grid%c2h &
4264 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4265 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4266 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4267 END IF
4268 ENDDO chem_filter_loop
4269 ENDIF
4270 IF ( num_tracer >= PARAM_FIRST_SCALAR ) then
4271 tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer
4272 IF ( config_flags%coupled_filtering ) THEN
4273 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
4274 ,MU=grid%mu_2 , MUB=grid%mub &
4275 ,C1=grid%c1h , C2=grid%c2h &
4276 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4277 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4278 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4279 END IF
4281 CALL pxft ( grid=grid &
4282 ,lineno=__LINE__ &
4283 ,flag_uv = 0 &
4284 ,flag_rurv = 0 &
4285 ,flag_wph = 0 &
4286 ,flag_ww = 0 &
4287 ,flag_t = 0 &
4288 ,flag_mu = 0 &
4289 ,flag_mut = 0 &
4290 ,flag_moist = 0 &
4291 ,flag_chem = 0 &
4292 ,flag_tracer = im &
4293 ,flag_scalar = 0 &
4294 ,actual_distance_average=config_flags%actual_distance_average&
4295 ,pos_def = config_flags%pos_def &
4296 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4297 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4298 ,fft_filter_lat = config_flags%fft_filter_lat &
4299 ,dclat = dclat &
4300 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4301 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4302 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4303 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4304 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4306 IF ( config_flags%coupled_filtering ) THEN
4307 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
4308 ,MU=grid%mu_2 , MUB=grid%mub &
4309 ,C1=grid%c1h , C2=grid%c2h &
4310 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4311 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4312 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4313 END IF
4314 ENDDO tracer_filter_loop
4315 ENDIF
4317 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
4318 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
4319 IF ( config_flags%coupled_filtering ) THEN
4320 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
4321 ,MU=grid%mu_2 , MUB=grid%mub &
4322 ,C1=grid%c1h , C2=grid%c2h &
4323 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4324 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4325 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4326 END IF
4328 CALL pxft ( grid=grid &
4329 ,lineno=__LINE__ &
4330 ,flag_uv = 0 &
4331 ,flag_rurv = 0 &
4332 ,flag_wph = 0 &
4333 ,flag_ww = 0 &
4334 ,flag_t = 0 &
4335 ,flag_mu = 0 &
4336 ,flag_mut = 0 &
4337 ,flag_moist = 0 &
4338 ,flag_chem = 0 &
4339 ,flag_tracer = 0 &
4340 ,flag_scalar = im &
4341 ,actual_distance_average=config_flags%actual_distance_average&
4342 ,pos_def = config_flags%pos_def &
4343 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4344 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4345 ,fft_filter_lat = config_flags%fft_filter_lat &
4346 ,dclat = dclat &
4347 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4348 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4349 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4350 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4351 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4353 IF ( config_flags%coupled_filtering ) THEN
4354 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
4355 ,MU=grid%mu_2 , MUB=grid%mub &
4356 ,C1=grid%c1h , C2=grid%c2h &
4357 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4358 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4359 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4360 END IF
4361 ENDDO scalar_filter_loop
4362 ENDIF
4363 ENDIF
4365 !-----------------------------------------------------------
4366 ! end filter for chem and scalar variables at end of timestep
4367 !-----------------------------------------------------------
4369 ! We're finished except for boundary condition (and patch) update
4371 ! Boundary condition time (or communication time). At this time, we have
4372 ! implemented periodic and symmetric physical boundary conditions.
4374 ! b.c. routine for data within patch.
4376 ! we need to do both time levels of
4377 ! data because the time filter only works in the physical solution space.
4379 ! First, do patch communications for boundary conditions (periodicity)
4381 !-----------------------------------------------------------
4382 ! Stencils for patch communications (WCS, 29 June 2001)
4383 !
4384 ! here's where we need a wide comm stencil - these are the
4385 ! uncoupled variables so are used for high order calc in
4386 ! advection and mixong routines.
4387 !
4388 ! * * * * *
4389 ! * * * * * * * * *
4390 ! * + * * + * * * + * *
4391 ! * * * * * * * * *
4392 ! * * * * *
4393 !
4394 ! grid%u_1 x
4395 ! grid%u_2 x
4396 ! grid%v_1 x
4397 ! grid%v_2 x
4398 ! grid%w_1 x
4399 ! grid%w_2 x
4400 ! grid%t_1 x
4401 ! grid%t_2 x
4402 ! grid%ph_1 x
4403 ! grid%ph_2 x
4404 ! grid%tke_1 x
4405 ! grid%tke_2 x
4406 !
4407 ! 2D variables
4408 ! grid%mu_1 x
4409 ! grid%mu_2 x
4410 !
4411 ! 4D variables
4412 ! moist x
4413 ! chem x
4414 ! scalar x
4415 !----------------------------------------------------------
4418 #ifdef DM_PARALLEL
4419 IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN
4420 # include "HALO_EM_D3_3.inc"
4421 ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN
4422 # include "HALO_EM_D3_5.inc"
4423 ELSE
4424 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', &
4425 config_flags%h_mom_adv_order, config_flags%h_sca_adv_order
4426 CALL wrf_error_fatal(TRIM(wrf_err_message))
4427 ENDIF
4428 # include "PERIOD_BDY_EM_D3.inc"
4429 # include "PERIOD_BDY_EM_MOIST.inc"
4430 # include "PERIOD_BDY_EM_CHEM.inc"
4431 # include "PERIOD_BDY_EM_TRACER.inc"
4432 # include "PERIOD_BDY_EM_SCALAR.inc"
4433 #endif
4435 ! now set physical b.c on a patch
4437 BENCH_START(bc_2d_tim)
4438 !$OMP PARALLEL DO &
4439 !$OMP PRIVATE ( ij )
4440 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
4442 CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
4444 CALL set_phys_bc_dry_2( config_flags, &
4445 grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2, &
4446 grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2, &
4447 ids, ide, jds, jde, kds, kde, &
4448 ims, ime, jms, jme, kms, kme, &
4449 ips, ipe, jps, jpe, kps, kpe, &
4450 grid%i_start(ij), grid%i_end(ij), &
4451 grid%j_start(ij), grid%j_end(ij), &
4452 k_start , k_end )
4454 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
4455 ids, ide, jds, jde, kds, kde, &
4456 ims, ime, jms, jme, kms, kme, &
4457 ips, ipe, jps, jpe, kps, kpe, &
4458 grid%i_start(ij), grid%i_end(ij), &
4459 grid%j_start(ij), grid%j_end(ij), &
4460 k_start , k_end-1 )
4462 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
4463 ids, ide, jds, jde, kds, kde, &
4464 ims, ime, jms, jme, kms, kme, &
4465 ips, ipe, jps, jpe, kps, kpe, &
4466 grid%i_start(ij), grid%i_end(ij), &
4467 grid%j_start(ij), grid%j_end(ij), &
4468 k_start , k_end )
4470 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4472 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
4473 config_flags, &
4474 ids, ide, jds, jde, kds, kde, &
4475 ims, ime, jms, jme, kms, kme, &
4476 ips, ipe, jps, jpe, kps, kpe, &
4477 grid%i_start(ij), grid%i_end(ij), &
4478 grid%j_start(ij), grid%j_end(ij), &
4479 k_start , k_end )
4481 END DO moisture_loop_bdy_2
4483 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4485 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
4486 ids, ide, jds, jde, kds, kde, &
4487 ims, ime, jms, jme, kms, kme, &
4488 ips, ipe, jps, jpe, kps, kpe, &
4489 grid%i_start(ij), grid%i_end(ij), &
4490 grid%j_start(ij), grid%j_end(ij), &
4491 k_start , k_end )
4493 END DO chem_species_bdy_loop_2
4495 tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
4497 CALL set_physical_bc3d( tracer(ims,kms,jms,ic) , 'p', config_flags, &
4498 ids, ide, jds, jde, kds, kde, &
4499 ims, ime, jms, jme, kms, kme, &
4500 ips, ipe, jps, jpe, kps, kpe, &
4501 grid%i_start(ij), grid%i_end(ij), &
4502 grid%j_start(ij), grid%j_end(ij), &
4503 k_start , k_end )
4505 END DO tracer_species_bdy_loop_2
4507 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4509 CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags, &
4510 ids, ide, jds, jde, kds, kde, &
4511 ims, ime, jms, jme, kms, kme, &
4512 ips, ipe, jps, jpe, kps, kpe, &
4513 grid%i_start(ij), grid%i_end(ij), &
4514 grid%j_start(ij), grid%j_end(ij), &
4515 k_start , k_end )
4517 END DO scalar_species_bdy_loop_2
4519 END DO tile_bc_loop_2
4520 !$OMP END PARALLEL DO
4521 BENCH_END(bc_2d_tim)
4523 ! this code forces boundary values to specified values to avoid drift
4525 IF( config_flags%specified .or. config_flags%nested ) THEN
4526 !$OMP PARALLEL DO &
4527 !$OMP PRIVATE ( ij )
4528 tile_bc_loop_3: DO ij = 1 , grid%num_tiles
4530 CALL wrf_debug ( 200 , ' call spec_bdy_final' )
4532 CALL spec_bdy_final ( grid%u_2, grid%muus, grid%c1h, grid%c2h, grid%msfuy, &
4533 grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
4534 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
4535 'u', config_flags, &
4536 config_flags%spec_bdy_width, grid%spec_zone, &
4537 grid%dtbc, &
4538 ids,ide, jds,jde, kds,kde, & ! domain dims
4539 ims,ime, jms,jme, kms,kme, & ! memory dims
4540 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4541 grid%i_start(ij), grid%i_end(ij), &
4542 grid%j_start(ij), grid%j_end(ij), &
4543 k_start , k_end )
4545 CALL spec_bdy_final ( grid%v_2, grid%muvs, grid%c1h, grid%c2h, grid%msfvx, &
4546 grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
4547 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
4548 'v', config_flags, &
4549 config_flags%spec_bdy_width, grid%spec_zone, &
4550 grid%dtbc, &
4551 ids,ide, jds,jde, kds,kde, & ! domain dims
4552 ims,ime, jms,jme, kms,kme, & ! memory dims
4553 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4554 grid%i_start(ij), grid%i_end(ij), &
4555 grid%j_start(ij), grid%j_end(ij), &
4556 k_start , k_end )
4558 IF( config_flags%nested) THEN
4559 CALL spec_bdy_final ( grid%w_2, grid%muts, grid%c1f, grid%c2f, grid%msfty, &
4560 grid%w_bxs, grid%w_bxe, grid%w_bys, grid%w_bye, &
4561 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
4562 'w', config_flags, &
4563 config_flags%spec_bdy_width, grid%spec_zone, &
4564 grid%dtbc, &
4565 ids,ide, jds,jde, kds,kde, & ! domain dims
4566 ims,ime, jms,jme, kms,kme, & ! memory dims
4567 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4568 grid%i_start(ij), grid%i_end(ij), &
4569 grid%j_start(ij), grid%j_end(ij), &
4570 k_start , k_end )
4571 ENDIF
4573 CALL spec_bdy_final ( grid%t_2, grid%muts, grid%c1h, grid%c2h, grid%msfty,&
4574 grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
4575 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
4576 't', config_flags, &
4577 config_flags%spec_bdy_width, grid%spec_zone, &
4578 grid%dtbc, &
4579 ids,ide, jds,jde, kds,kde, & ! domain dims
4580 ims,ime, jms,jme, kms,kme, & ! memory dims
4581 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4582 grid%i_start(ij), grid%i_end(ij), &
4583 grid%j_start(ij), grid%j_end(ij), &
4584 k_start , k_end )
4586 CALL spec_bdy_final ( grid%ph_2, grid%muts, grid%c1f, grid%c2f, grid%msfty, &
4587 grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
4588 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
4589 'h', config_flags, &
4590 config_flags%spec_bdy_width, grid%spec_zone, &
4591 grid%dtbc, &
4592 ids,ide, jds,jde, kds,kde, & ! domain dims
4593 ims,ime, jms,jme, kms,kme, & ! memory dims
4594 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4595 grid%i_start(ij), grid%i_end(ij), &
4596 grid%j_start(ij), grid%j_end(ij), &
4597 k_start , k_end )
4599 CALL spec_bdy_final ( grid%mu_2, grid%muts, grid%c1h, grid%c2h, grid%msfty, &
4600 grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
4601 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
4602 'm', config_flags, &
4603 config_flags%spec_bdy_width, grid%spec_zone, &
4604 grid%dtbc, &
4605 ids,ide, jds,jde, 1, 1, & ! domain dims
4606 ims,ime, jms,jme, 1, 1, & ! memory dims
4607 ips,ipe, jps,jpe, 1, 1, & ! patch dims
4608 grid%i_start(ij), grid%i_end(ij), &
4609 grid%j_start(ij), grid%j_end(ij), &
4610 1 , 1 )
4612 moisture_loop_bdy_3 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4614 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
4615 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
4616 CALL spec_bdy_final ( moist(ims,kms,jms,im), grid%muts, &
4617 grid%c1h, grid%c2h, grid%msfty, &
4618 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
4619 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
4620 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
4621 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
4622 't', config_flags, &
4623 config_flags%spec_bdy_width, grid%spec_zone, &
4624 grid%dtbc, &
4625 ids,ide, jds,jde, kds,kde, & ! domain dims
4626 ims,ime, jms,jme, kms,kme, & ! memory dims
4627 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4628 grid%i_start(ij), grid%i_end(ij), &
4629 grid%j_start(ij), grid%j_end(ij), &
4630 k_start , k_end )
4631 ENDIF
4633 END DO moisture_loop_bdy_3
4635 #if (WRF_CHEM == 1)
4636 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
4637 chem_species_bdy_loop_3 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4639 IF( ( config_flags%nested ) ) THEN
4640 CALL spec_bdy_final ( chem(ims,kms,jms,ic), grid%muts, &
4641 grid%c1h, grid%c2h, grid%msfty, &
4642 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
4643 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
4644 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
4645 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
4646 't', config_flags, &
4647 config_flags%spec_bdy_width, grid%spec_zone, &
4648 grid%dtbc, &
4649 ids,ide, jds,jde, kds,kde, & ! domain dims
4650 ims,ime, jms,jme, kms,kme, & ! memory dims
4651 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4652 grid%i_start(ij), grid%i_end(ij), &
4653 grid%j_start(ij), grid%j_end(ij), &
4654 k_start , k_end )
4655 ENDIF
4657 END DO chem_species_bdy_loop_3
4658 ENDIF
4659 #endif
4661 tracer_species_bdy_loop_3 : DO im = PARAM_FIRST_SCALAR , num_tracer
4663 IF( ( config_flags%nested ) ) THEN
4664 CALL spec_bdy_final ( tracer(ims,kms,jms,im), grid%muts, &
4665 grid%c1h, grid%c2h, grid%msfty, &
4666 tracer_bxs(jms,kms,1,im),tracer_bxe(jms,kms,1,im), &
4667 tracer_bys(ims,kms,1,im),tracer_bye(ims,kms,1,im), &
4668 tracer_btxs(jms,kms,1,im),tracer_btxe(jms,kms,1,im), &
4669 tracer_btys(ims,kms,1,im),tracer_btye(ims,kms,1,im), &
4670 't', config_flags, &
4671 config_flags%spec_bdy_width, grid%spec_zone, &
4672 grid%dtbc, &
4673 ids,ide, jds,jde, kds,kde, & ! domain dims
4674 ims,ime, jms,jme, kms,kme, & ! memory dims
4675 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4676 grid%i_start(ij), grid%i_end(ij), &
4677 grid%j_start(ij), grid%j_end(ij), &
4678 k_start , k_end )
4679 ENDIF
4681 END DO tracer_species_bdy_loop_3
4683 scalar_species_bdy_loop_3 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4685 IF( ( config_flags%nested ) ) THEN
4686 CALL spec_bdy_final ( scalar(ims,kms,jms,is), grid%muts, &
4687 grid%c1h, grid%c2h, grid%msfty, &
4688 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
4689 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
4690 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
4691 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
4692 't', config_flags, &
4693 config_flags%spec_bdy_width, grid%spec_zone, &
4694 grid%dtbc, &
4695 ids,ide, jds,jde, kds,kde, & ! domain dims
4696 ims,ime, jms,jme, kms,kme, & ! memory dims
4697 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4698 grid%i_start(ij), grid%i_end(ij), &
4699 grid%j_start(ij), grid%j_end(ij), &
4700 k_start , k_end )
4701 ENDIF
4703 END DO scalar_species_bdy_loop_3
4705 END DO tile_bc_loop_3
4706 !$OMP END PARALLEL DO
4708 ENDIF
4710 ! reset surface w for consistency
4712 #ifdef DM_PARALLEL
4713 # include "HALO_EM_C.inc"
4714 # include "PERIOD_BDY_EM_E.inc"
4715 #endif
4717 CALL wrf_debug ( 10 , ' call set_w_surface' )
4718 fill_w_flag = .false.
4720 !$OMP PARALLEL DO &
4721 !$OMP PRIVATE ( ij )
4722 DO ij = 1 , grid%num_tiles
4723 CALL set_w_surface( config_flags, grid%znw, fill_w_flag, &
4724 grid%w_2, grid%ht, grid%u_2, grid%v_2, &
4725 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
4726 grid%msftx, grid%msfty, &
4727 ids, ide, jds, jde, kds, kde, &
4728 ims, ime, jms, jme, kms, kme, &
4729 grid%i_start(ij), grid%i_end(ij), &
4730 grid%j_start(ij), grid%j_end(ij), &
4731 k_start, k_end )
4732 ! its, ite, jts, jte, k_start, min(k_end,kde-1), &
4734 END DO
4735 !$OMP END PARALLEL DO
4737 !-----------------------------------------------------------
4738 ! After all of the RK steps, after the microphysics, after p-rho-phi,
4739 ! after w, after filtering, we have data ready to use.
4740 !-----------------------------------------------------------
4742 CALL after_all_rk_steps ( grid, config_flags, &
4743 moist, chem, tracer, scalar, &
4744 th_phy, pi_phy, p_phy, &
4745 p8w, t8w, dz8w, &
4746 REAL(curr_secs,8), curr_secs2, &
4747 diag_flag, &
4748 ids, ide, jds, jde, kds, kde, &
4749 ims, ime, jms, jme, kms, kme, &
4750 ips, ipe, jps, jpe, kps, kpe, &
4751 imsx, imex, jmsx, jmex, kmsx, kmex, &
4752 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
4753 imsy, imey, jmsy, jmey, kmsy, kmey, &
4754 ipsy, ipey, jpsy, jpey, kpsy, kpey )
4758 #ifdef DM_PARALLEL
4759 !-----------------------------------------------------------------------
4760 ! see above
4761 !--------------------------------------------------------------
4762 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
4763 IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN
4764 # include "HALO_EM_E_3.inc"
4765 ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN
4766 # include "HALO_EM_E_5.inc"
4767 ELSE
4768 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', &
4769 config_flags%h_mom_adv_order, config_flags%h_sca_adv_order
4770 CALL wrf_error_fatal(TRIM(wrf_err_message))
4771 ENDIF
4772 #endif
4774 #ifdef DM_PARALLEL
4775 IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
4776 !-----------------------------------------------------------------------
4777 ! see above
4778 !--------------------------------------------------------------
4779 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
4780 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
4781 # include "HALO_EM_MOIST_E_3.inc"
4782 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
4783 # include "HALO_EM_MOIST_E_5.inc"
4784 ELSE
4785 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
4786 CALL wrf_error_fatal(TRIM(wrf_err_message))
4787 ENDIF
4788 ENDIF
4789 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
4790 !-----------------------------------------------------------------------
4791 ! see above
4792 !--------------------------------------------------------------
4793 CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
4794 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
4795 # include "HALO_EM_CHEM_E_3.inc"
4796 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
4797 # include "HALO_EM_CHEM_E_5.inc"
4798 ELSE
4799 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
4800 CALL wrf_error_fatal(TRIM(wrf_err_message))
4801 ENDIF
4802 ENDIF
4803 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
4804 !-----------------------------------------------------------------------
4805 ! see above
4806 !--------------------------------------------------------------
4807 CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' )
4808 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
4809 # include "HALO_EM_TRACER_E_3.inc"
4810 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
4811 # include "HALO_EM_TRACER_E_5.inc"
4812 ELSE
4813 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
4814 CALL wrf_error_fatal(TRIM(wrf_err_message))
4815 ENDIF
4816 ENDIF
4817 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
4818 !-----------------------------------------------------------------------
4819 ! see above
4820 !--------------------------------------------------------------
4821 CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
4822 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
4823 # include "HALO_EM_SCALAR_E_3.inc"
4824 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
4825 # include "HALO_EM_SCALAR_E_5.inc"
4826 ELSE
4827 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
4828 CALL wrf_error_fatal(TRIM(wrf_err_message))
4829 ENDIF
4830 ENDIF
4831 #endif
4834 !-----------------------------------------------------------------------
4835 ! firebrand spotting (passive Lagrangian particle transport,
4836 ! tracks firebrand physics properties)
4837 !-----------------------------------------------------------------------
4839 IF(config_flags%ifire == 2 .AND. &
4840 ! Check if spotting is on
4841 config_flags%fs_firebrand_gen_lim > 0 .AND. &
4842 ! Check if this is the inner most grid
4843 config_flags%max_dom == grid%id) THEN
4845 #ifdef DM_PARALLEL
4846 CALL wrf_debug ( 200 , ' call HALO_FIREBRAND_SPOTTING' )
4847 # include "HALO_FIREBRAND_SPOTTING_5.inc"
4848 #endif
4850 CALL wrf_debug ( 3 , 'solve: calling firebrand_spotting_em_driver...' )
4851 CALL firebrand_spotting_em_driver ( &
4852 cf = config_flags, &
4853 grid = grid, &
4854 fs_p_id = grid%fs_p_id, &
4855 fs_p_dt = grid%fs_p_dt, &
4856 fs_p_x = grid%fs_p_x, &
4857 fs_p_y = grid%fs_p_y, &
4858 fs_p_z = grid%fs_p_z, &
4859 fs_gen_inst = grid%fs_gen_inst, &
4860 fs_p_mass = grid%fs_p_mass, &
4861 fs_p_diam = grid%fs_p_diam, &
4862 fs_p_effd = grid%fs_p_effd, &
4863 fs_p_temp = grid%fs_p_temp, &
4864 fs_p_tvel = grid%fs_p_tvel, &
4865 fs_last_gen_dt= grid%fs_last_gen_dt, &
4866 fs_gen_idmax = grid%fs_gen_idmax, &
4867 fs_fire_ROSdt = grid%fs_fire_ROSdt, &
4868 fs_fire_area = grid%fs_fire_area, &
4869 fs_count_landed_all = grid%fs_count_landed_all, &
4870 fs_count_landed_hist = grid%fs_count_landed_hist, &
4871 fs_landing_mask = grid%fs_landing_mask, &
4872 fs_spotting_lkhd = grid%fs_spotting_lkhd, &
4873 fs_frac_landed = grid%fs_frac_landed, &
4874 fs_fuel_spotting_risk = grid%fs_fuel_spotting_risk, &
4875 fs_count_reset = grid%fs_count_reset)
4877 ENDIF
4878 ! end of firebrand spotting
4879 !-----------------------------------------------------------------------
4881 ! Max values of CFL for adaptive time step scheme
4883 DEALLOCATE(max_vert_cfl_tmp)
4884 DEALLOCATE(max_horiz_cfl_tmp)
4886 CALL wrf_debug ( 200 , ' call end of solve_em' )
4888 ! Are we about to read SST input from the wrflowinput file? That data is saved
4889 ! for use in fractional merging of external/coupled SST and input SST.
4890 IF ( coupler_on ) grid%just_read_auxinput4 = Is_alarm_tstep(grid%domain_clock, grid%alarms(AUXINPUT4_ALARM))
4892 ! Are we about to read the lateral boundary file? This is a domain one action only.
4893 IF ( grid%id .EQ. 1 ) grid%just_read_boundary = Is_alarm_tstep(grid%domain_clock, grid%alarms(BOUNDARY_ALARM))
4895 ! Finish timers if compiled with -DBENCH.
4896 #include "bench_solve_em_end.h"
4898 #if (WRF_CMAQ == 1)
4899 if (firstime) then
4900 CALL nl_get_wrf_cmaq_option ( 1, wrf_cmaq_option )
4901 CALL nl_get_wrf_cmaq_freq ( 1, wrf_cmaq_freq )
4902 CALL nl_get_direct_sw_feedback ( .false., direct_sw_feedback )
4903 CALL nl_get_met_file_tstep ( 1, met_file_tstep )
4905 cmaq_wrf_feedback = direct_sw_feedback
4907 if (wrf_cmaq_option .gt. 0) then
4908 cmaq_nstep = ((grid%run_days * 24 + grid%run_hours) * 3600 + grid%run_minutes * 60 + grid%run_seconds) / &
4909 (grid%time_step * WRF_CMAQ_FREQ)
4911 wrf_end_step = cmaq_nstep * WRF_CMAQ_FREQ - 1
4912 end if
4913 end if
4915 if (wrf_cmaq_option .gt. 0) then
4916 COUNTER = COUNTER + 1
4918 if ( .not. cmaq_wrf_feedback .and. firstime) then
4919 grid%prev_rainnc = 0.0
4920 grid%prev_rainc = 0.0
4921 end if
4923 CMAQ_STEP = (mod(COUNTER, WRF_CMAQ_FREQ) .EQ. 0)
4925 if (CMAQ_STEP) then
4926 CALL aqprep (grid, config_flags, grid%t_phy, p_phy, &
4927 grid%rho, grid%z_at_w, dz8w, p8w, t8w, &
4928 model_config_rec%num_land_cat, 'V4.1.1', &
4929 wrf_cmaq_option, wrf_cmaq_freq, &
4930 ids, ide, jds, jde, kds, kde, &
4931 ims, ime, jms, jme, kms, kme, &
4932 ips, ipe, jps, jpe, kps, kpe, &
4933 moist(:,:,:,p_qv), & ! optional
4934 moist(:,:,:,p_qc), & ! optional
4935 moist(:,:,:,p_qr), & ! optional
4936 moist(:,:,:,p_qi), & ! optional
4937 moist(:,:,:,p_qs), & ! optional
4938 moist(:,:,:,p_qg) & ! optional
4939 )
4940 grid%prev_rainnc = grid%rainnc
4941 grid%prev_rainc = grid%rainc
4942 end if
4944 if ((counter >= 1) .and. (CMAQ_STEP) .and. (wrf_cmaq_option .gt. 1)) then
4946 CALL CMAQ_DRIVER (cmaq_sdate, cmaq_stime, grid%time_step*WRF_CMAQ_FREQ, &
4947 twoway_jdate, twoway_jtime, .false.)
4949 if (direct_sw_feedback) then
4950 CALL FEEDBACK_READ (grid, twoway_jdate, twoway_jtime)
4951 feedback_is_ready = .true.
4952 end if
4954 end if
4956 ! call aqprep and cmaq one last time before the entire twoway model ends
4957 if (wrf_end_step == counter) then
4958 CALL aqprep (grid, config_flags, grid%t_phy, p_phy, &
4959 grid%rho, grid%z_at_w, dz8w, p8w, t8w, &
4960 model_config_rec%num_land_cat, 'V4.1.1', &
4961 wrf_cmaq_option, wrf_cmaq_freq, &
4962 ids, ide, jds, jde, kds, kde, &
4963 ims, ime, jms, jme, kms, kme, &
4964 ips, ipe, jps, jpe, kps, kpe, &
4965 moist(:,:,:,p_qv), & ! optional
4966 moist(:,:,:,p_qc), & ! optional
4967 moist(:,:,:,p_qr), & ! optional
4968 moist(:,:,:,p_qi), & ! optional
4969 moist(:,:,:,p_qs), & ! optional
4970 moist(:,:,:,p_qg) & ! optional
4971 )
4973 if (wrf_cmaq_option .gt. 1) then
4975 CALL CMAQ_DRIVER (cmaq_sdate, cmaq_stime, grid%time_step*WRF_CMAQ_FREQ, &
4976 twoway_jdate, twoway_jtime, .true.)
4977 end if
4979 end if
4981 end if
4982 firstime = .false.
4983 #endif
4985 RETURN
4987 END SUBROUTINE solve_em