| blob | c2ec4f5eedb97588dc8659cfdbbcd85cea1010b7 |
1 !WRF+/AD:MEDIATION_LAYER:SOLVER FOR AD
2 !Created by Xin Zhang and Ning Pan, 2010-08
4 SUBROUTINE solve_em_ad ( grid , config_flags &
5 ! Arguments generated from Registry
6 #include "dummy_new_args.inc"
7 !
8 )
9 ! Driver layer modules
10 USE module_state_description
11 USE module_domain, ONLY : &
12 domain, get_ijk_from_grid, get_ijk_from_subgrid &
13 ,domain_get_current_time, domain_get_start_time &
14 ,domain_get_sim_start_time, domain_clock_get,is_alarm_tstep
15 USE module_domain_type, ONLY : history_alarm, restart_alarm
16 USE module_configure, ONLY : grid_config_rec_type
17 USE module_driver_constants
18 USE module_machine
19 USE module_tiles, ONLY : set_tiles
20 #ifdef DM_PARALLEL
21 USE module_dm, ONLY : &
22 local_communicator, mytask, ntasks, ntasks_x, ntasks_y &
23 ,local_communicator_periodic, wrf_dm_maxval
24 USE module_comm_dm, ONLY : &
25 halo_em_a_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_ad_sub &
37 ,halo_em_tracer_e_3_sub,halo_em_tracer_e_5_sub &
38 ,halo_em_tracer_e_7_ad_sub,halo_em_tracer_old_e_5_ad_sub &
39 ,halo_em_tracer_e_7_sub,halo_em_tracer_old_e_5_sub &
40 ,halo_em_tracer_old_e_7_sub,halo_em_tracer_e_5_ad_sub &
41 ,halo_em_tracer_old_e_7_ad_sub,period_bdy_em_a_sub &
42 ,period_bdy_em_b3_sub,period_bdy_em_b_sub,period_bdy_em_chem2_sub &
43 ,period_bdy_em_chem_old_sub,period_bdy_em_chem_sub,period_bdy_em_d3_sub &
44 ,period_bdy_em_d_sub,period_bdy_em_e_sub,period_bdy_em_moist2_sub &
45 ,period_bdy_em_moist_old_sub,period_bdy_em_moist_sub &
46 ,period_bdy_em_scalar2_sub,period_bdy_em_scalar_old_sub &
47 ,period_bdy_em_scalar_sub,period_bdy_em_tke_old_sub,period_bdy_em_tke_sub &
48 ,period_bdy_em_tracer2_sub,period_bdy_em_tracer_old_sub &
49 ,period_bdy_em_tracer_sub,period_em_da_sub,period_em_hydro_uv_sub &
50 ,halo_em_a_ad_sub,halo_em_d2_3_ad_sub,halo_em_d2_5_ad_sub &
51 ,halo_em_e_3_ad_sub,halo_em_e_5_ad_sub,halo_em_moist_e_3_ad_sub &
52 ,halo_em_moist_e_5_ad_sub,halo_em_bdy_ad_sub,halo_em_b_ad_sub &
53 ,halo_em_c_ad_sub,halo_em_c2_ad_sub,halo_em_d_ad_sub &
54 ,halo_em_moist_old_e_5_ad_sub,halo_em_moist_old_e_7_ad_sub &
55 ,halo_em_moist_e_7_ad_sub,halo_em_tke_advect_3_ad_sub &
56 ,halo_em_tke_advect_5_ad_sub,halo_em_tke_old_e_5_ad_sub &
57 ,halo_em_tke_old_e_7_ad_sub,halo_em_tke_3_ad_sub,halo_em_tke_5_ad_sub &
58 ,halo_em_tke_7_ad_sub,halo_em_hydro_uv_ad_sub,halo_em_d3_3_ad_sub &
59 ,halo_em_d3_5_ad_sub,halo_em_sbm_sub,halo_em_sbm_ad_sub
60 #endif
61 USE module_utility
62 ! Mediation layer modules
63 ! Model layer modules
64 USE module_model_constants
65 USE module_small_step_em
66 USE module_em
67 USE module_big_step_utilities_em
68 USE module_bc
69 USE module_bc_em
70 USE module_solvedebug_em
71 USE module_physics_addtendc
72 USE a_module_physics_addtendc
73 USE module_diffusion_em
74 USE module_polarfft
75 USE module_microphysics_driver
76 USE a_module_microphysics_driver
77 USE module_microphysics_zero_out
78 USE a_module_microphysics_zero_out
79 USE module_fddaobs_driver
80 ! USE module_diagnostics
81 #if (WRF_CHEM==1)
82 USE module_input_chem_data
83 USE module_input_tracer
84 USE module_chem_utilities
85 #endif
86 USE module_first_rk_step_part1
87 USE module_first_rk_step_part2
88 ! USE module_after_all_rk_steps
89 USE module_llxy, ONLY : proj_cassini
90 USE module_avgflx_em, ONLY : zero_avgflx, upd_avgflx
92 USE a_module_small_step_em
93 USE a_module_em
94 USE a_module_big_step_utilities_em
95 USE a_module_bc
96 USE a_module_bc_em
97 USE a_module_first_rk_step_part1
98 USE a_module_first_rk_step_part2
99 USE module_linked_list2
102 IMPLICIT NONE
104 ! Input data.
106 TYPE(domain) , TARGET :: grid
108 ! Definitions of dummy arguments to this routine (generated from Registry).
109 #include "dummy_new_decl.inc"
111 ! Structure that contains run-time configuration (namelist) data for domain
112 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
114 ! Local data
116 INTEGER :: k_start , k_end, its, ite, jts, jte
117 INTEGER :: ids , ide , jds , jde , kds , kde , &
118 ims , ime , jms , jme , kms , kme , &
119 ips , ipe , jps , jpe , kps , kpe
121 INTEGER :: sids , side , sjds , sjde , skds , skde , &
122 sims , sime , sjms , sjme , skms , skme , &
123 sips , sipe , sjps , sjpe , skps , skpe
126 INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
127 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
128 imsy, imey, jmsy, jmey, kmsy, kmey, &
129 ipsy, ipey, jpsy, jpey, kpsy, kpey
131 INTEGER :: ij , iteration
132 INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
133 INTEGER :: loop
134 INTEGER :: sz
135 INTEGER :: iswater
137 LOGICAL :: specified_bdy, channel_bdy
139 REAL :: t_new
141 LOGICAL :: feedback_is_ready ! CMAQ
143 ! Changes in tendency at this timestep
144 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
145 z_tendency
146 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_h_tendency, &
147 a_z_tendency
149 ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
150 LOGICAL :: tenddec
152 ! Flag for producing diagnostic fields (e.g., radar reflectivity)
153 LOGICAL :: diag_flag
154 LOGICAL :: restart_flag ! tells if it is a restart timestep to write restart files
156 #if (WRF_CHEM==1)
157 ! Index cross-referencing array for tendency accumulation
158 INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
159 #endif
161 ! storage for tendencies and decoupled state (generated from Registry)
163 #include "i1_decl.inc"
164 ! Previous time level of tracer arrays now defined as i1 variables;
165 ! the state 4d arrays now redefined as 1-time level arrays in Registry.
166 ! Benefit: save memory in nested runs, since only 1 domain is active at a
167 ! time. Potential problem on stack-limited architectures: increases
168 ! amount of data on program stack by making these automatic arrays.
170 INTEGER :: rc
171 INTEGER :: number_of_small_timesteps, rk_step
172 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
173 INTEGER :: idum1, idum2, dynamics_option
175 INTEGER :: rk_order, iwmax, jwmax, kwmax
176 REAL :: dt_rk, dts_rk, dts, dtm, wmax
177 REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp
178 LOGICAL :: leapfrog
179 INTEGER :: l,kte,kk
180 LOGICAL :: f_flux ! flag for computing averaged fluxes in cu_gd
181 REAL :: curr_secs
182 INTEGER :: num_sound_steps
183 INTEGER :: idex, jdex
184 REAL :: max_msft
185 REAL :: spacing
187 INTEGER :: ii, jj !kk is above after l,kte
188 REAL :: dclat
189 INTEGER :: debug_level
191 ! urban related variables
192 INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
194 TYPE(WRFU_TimeInterval) :: tmpTimeInterval
195 REAL :: real_time
196 LOGICAL :: adapt_step_flag
197 LOGICAL :: fill_w_flag
199 ! variables for flux-averaging code 20091223
200 CHARACTER*256 :: message, message2
201 REAL :: old_dt
202 TYPE(WRFU_Time) :: temp_time, CurrTime, restart_time
203 INTEGER, PARAMETER :: precision = 100
204 INTEGER :: num, den
205 TYPE(WRFU_TimeInterval) :: dtInterval, intervaltime,restartinterval
207 ! Define benchmarking timers if -DBENCH is compiled
208 #include "bench_solve_em_def.h"
210 !----------------------
211 ! Executable statements
212 !----------------------
214 !<DESCRIPTION>
215 !<pre>
216 ! solve_em is the main driver for advancing a grid a single timestep.
217 ! It is a mediation-layer routine -> DM and SM calls are made where
218 ! needed for parallel processing.
219 !
220 ! solve_em can integrate the equations using 3 time-integration methods
221 !
222 ! - 3rd order Runge-Kutta time integration (recommended)
223 !
224 ! - 2nd order Runge-Kutta time integration
225 !
226 ! The main sections of solve_em are
227 !
228 ! (1) Runge-Kutta (RK) loop
229 !
230 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
231 ! model state variables during the first RK sub-step (loop)
232 !
233 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
234 !
235 ! (4) scalar advance for moist and chem scalar variables (and TKE)
236 ! within the RK sub-steps.
237 !
238 ! (5) time-split physics (after the RK step), currently this includes
239 ! only microphyics
240 !
241 ! A more detailed description of these sections follows.
242 !</pre>
243 !</DESCRIPTION>
245 ! Initialize timers if compiled with -DBENCH
246 #include "bench_solve_em_init.h"
248 ! dtbc will be read from basic state at every time step, so it doesn't need to be updated here.
249 ! IF( config_flags%specified .or. config_flags%nested ) THEN
250 ! grid%dtbc = grid%dtbc - grid%dt
251 ! ENDIF
253 ! Initialize linkedlist
254 !CALL linkedlist_initialize
256 feedback_is_ready = .false.
257 ! set runge-kutta solver (2nd or 3rd order)
259 dynamics_option = config_flags%rk_ord
261 ! Obtain dimension information stored in the grid data structure.
263 CALL get_ijk_from_grid ( grid , &
264 ids, ide, jds, jde, kds, kde, &
265 ims, ime, jms, jme, kms, kme, &
266 ips, ipe, jps, jpe, kps, kpe, &
267 imsx, imex, jmsx, jmex, kmsx, kmex, &
268 ipsx, ipex, jpsx, jpex, kpsx, kpex, &
269 imsy, imey, jmsy, jmey, kmsy, kmey, &
270 ipsy, ipey, jpsy, jpey, kpsy, kpey )
272 CALL get_ijk_from_subgrid ( grid , &
273 sids, side, sjds, sjde, skds, skde, &
274 sims, sime, sjms, sjme, skms, skme, &
275 sips, sipe, sjps, sjpe, skps, skpe )
276 k_start = kps
277 k_end = kpe
279 num_3d_m = num_moist
280 num_3d_c = num_chem
281 num_3d_s = num_scalar
283 f_flux = config_flags%do_avgflx_cugd .EQ. 1
285 ! Compute these starting and stopping locations for each tile and number of tiles.
286 ! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
287 CALL set_tiles ( ZONE_SOLVE_EM, grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
288 ! CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
290 ! Max values of CFL for adaptive time step scheme
292 ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
293 ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
295 !
296 ! Calculate current time in seconds since beginning of model run.
297 ! Unfortunately, ESMF does not seem to have a way to return
298 ! floating point seconds based on a TimeInterval. So, we will
299 ! calculate it here--but, this is not clean!!
300 !
301 tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_sim_start_time ( grid )
302 curr_secs = real_time(tmpTimeInterval)
304 old_dt = grid%dt ! store old time step for flux averaging code at end of RK loop
305 !-----------------------------------------------------------------------------
306 ! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07
307 ! In this call, we do the time-step adaptation and set time-dependent lateral
308 ! boundary condition nudging weights.
309 !
310 IF ( (config_flags%use_adaptive_time_step) .and. &
311 ( (.not. grid%nested) .or. &
312 ( (grid%nested) .and. (abs(grid%dtbc) < 0.0001) ) ) )THEN
313 CALL adapt_timestep(grid, config_flags)
314 adapt_step_flag = .TRUE.
315 ELSE
316 adapt_step_flag = .FALSE.
317 ENDIF
318 ! End of adaptive time step modifications
319 !-----------------------------------------------------------------------------
320 !
321 ! Set restart flag value history output time
322 !-----------------------------------------------------------------------------
323 restart_flag = .false.
324 if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(restart_alarm)) ) then
325 restart_flag = .true.
326 endif
327 !
328 ! Set diagnostic flag value history output time
329 !-----------------------------------------------------------------------------
330 ! if ( Is_alarm_tstep(grid_clock, grid_alarms(HISTORY_ALARM)) ) then
331 diag_flag = .false.
332 if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(HISTORY_ALARM)) ) then
333 diag_flag = .true.
334 endif
336 IF (config_flags%enable_identity) THEN
337 grid%itimestep = grid%itimestep - 1
338 RETURN
339 ENDIF
341 IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
343 rk_order = config_flags%rk_ord
345 IF ( grid%time_step_sound == 0 ) THEN
346 ! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only
347 spacing = min(grid%dx, grid%dy)
348 IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
349 max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
350 1.0/COS(config_flags%fft_filter_lat*degrad) )
351 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
352 ELSE IF ( config_flags%use_adaptive_time_step ) THEN
353 max_msft= MAX(grid%max_msftx, grid%max_msfty)
354 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
355 ELSE
356 num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 )
357 END IF
358 WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
359 CALL wrf_debug ( 50 , wrf_err_message )
360 ELSE
361 num_sound_steps = grid%time_step_sound
362 ENDIF
364 dts = grid%dt/float(num_sound_steps)
366 IF (config_flags%use_adaptive_time_step) THEN
368 CALL get_wrf_debug_level( debug_level )
369 IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
370 #ifdef DM_PARALLEL
371 CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
372 #endif
373 WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
374 grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
375 CALL wrf_debug ( 0 , wrf_err_message )
376 ENDIF
378 grid%max_cfl_val = 0
379 grid%max_horiz_cfl = 0
380 grid%max_vert_cfl = 0
381 ENDIF
383 ! setting bdy tendencies to zero for DFI if constant_bc = true
385 !$OMP PARALLEL DO &
386 !$OMP PRIVATE ( ij )
387 DO ij = 1 , grid%num_tiles
389 ! IF( config_flags%specified .AND. grid%dfi_opt .NE. DFI_NODFI &
390 ! .AND. config_flags%constant_bc .AND. (grid%dfi_stage .EQ. DFI_BCK .OR. grid%dfi_stage .EQ. DFI_FWD) ) THEN
391 IF( config_flags%specified .AND. config_flags%constant_bc ) THEN
393 CALL zero_bdytend (grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
394 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
395 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
396 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
397 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
398 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
399 moist_btxs,moist_btxe, &
400 moist_btys,moist_btye, &
401 scalar_btxs,scalar_btxe, &
402 scalar_btys,scalar_btye, &
403 grid%spec_bdy_width,num_3d_m,num_3d_s, &
404 ids,ide, jds,jde, kds,kde, &
405 ims,ime, jms,jme, kms,kme, &
406 ips,ipe, jps,jpe, kps,kpe, &
407 grid%i_start(ij), grid%i_end(ij), &
408 grid%j_start(ij), grid%j_end(ij), &
409 k_start, k_end )
411 ENDIF
412 ENDDO
413 !$OMP END PARALLEL DO
415 !**********************************************************************
416 !
417 ! LET US BEGIN.......
418 !
419 !<DESCRIPTION>
420 !<pre>
421 ! (1) RK integration loop is named the "Runge_Kutta_loop:"
422 !
423 ! Predictor-corrector type time integration.
424 ! Advection terms are evaluated at time t for the predictor step,
425 ! and advection is re-evaluated with the latest predicted value for
426 ! each succeeding time corrector step
427 !
428 ! 2nd order Runge Kutta (rk_order = 2):
429 ! Step 1 is taken to the midpoint predictor, step 2 is the full step.
430 !
431 ! 3rd order Runge Kutta (rk_order = 3):
432 ! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
433 ! and step 3 is from t to dt.
434 !
435 ! non-timesplit physics are evaluated during first RK step and
436 ! these physics tendencies are stored for use in each RK pass.
437 !</pre>
438 !</DESCRIPTION>
439 !**********************************************************************
441 Runge_Kutta_loop: DO rk_step = 1, rk_order
443 ! Set the step size and number of small timesteps for
444 ! each part of the timestep
446 dtm = grid%dt
447 IF ( rk_order == 1 ) THEN
449 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
450 CALL wrf_error_fatal( wrf_err_message )
452 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
454 IF ( rk_step == 1) THEN
455 dt_rk = 0.5*grid%dt
456 dts_rk = dts
457 number_of_small_timesteps = num_sound_steps/2
458 ELSE
459 dt_rk = grid%dt
460 dts_rk = dts
461 number_of_small_timesteps = num_sound_steps
462 ENDIF
464 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
466 IF ( rk_step == 1) THEN
467 dt_rk = grid%dt/3.
468 dts_rk = dt_rk
469 number_of_small_timesteps = 1
470 ELSE IF (rk_step == 2) THEN
471 dt_rk = 0.5*grid%dt
472 dts_rk = dts
473 number_of_small_timesteps = num_sound_steps/2
474 ELSE
475 dt_rk = grid%dt
476 dts_rk = dts
477 number_of_small_timesteps = num_sound_steps
478 ENDIF
480 ELSE
482 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
483 CALL wrf_error_fatal( wrf_err_message )
485 END IF
487 ! Ensure that polar meridional velocity is zero
488 IF (config_flags%polar) THEN
489 !$OMP PARALLEL DO &
490 !$OMP PRIVATE ( ij )
491 DO ij = 1 , grid%num_tiles
492 CALL zero_pole ( grid%v_1, &
493 ids, ide, jds, jde, kds, kde, &
494 ims, ime, jms, jme, kms, kme, &
495 grid%i_start(ij), grid%i_end(ij), &
496 grid%j_start(ij), grid%j_end(ij), &
497 k_start, k_end )
498 CALL zero_pole ( grid%v_2, &
499 ids, ide, jds, jde, kds, kde, &
500 ims, ime, jms, jme, kms, kme, &
501 grid%i_start(ij), grid%i_end(ij), &
502 grid%j_start(ij), grid%j_end(ij), &
503 k_start, k_end )
504 END DO
505 !$OMP END PARALLEL DO
506 END IF
507 !
508 ! Time level t is in the *_2 variable in the first part
509 ! of the step, and in the *_1 variable after the predictor.
510 ! the latest predicted values are stored in the *_2 variables.
511 !
512 CALL wrf_debug ( 200 , ' call rk_step_prep ' )
514 BENCH_START(step_prep_tim)
515 !CALL push4backup (grid%mu_2, "mu")
516 !CALL push4backup (grid%u_2,grid%v_2,grid%w_2, "u,v,w")
517 !CALL push4backup (moist, "moist")
519 !$OMP PARALLEL DO &
520 !$OMP PRIVATE ( ij )
522 DO ij = 1 , grid%num_tiles
524 CALL rk_step_prep ( config_flags, rk_step, &
525 grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, &
526 grid%c1h, grid%c2h, grid%c1f, grid%c2f, moist, &
527 grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, &
528 grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, &
529 cqu, cqv, cqw, &
530 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
531 grid%msfvy, grid%msftx, grid%msfty, &
532 grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
533 num_3d_m, &
534 ids, ide, jds, jde, kds, kde, &
535 ims, ime, jms, jme, kms, kme, &
536 grid%i_start(ij), grid%i_end(ij), &
537 grid%j_start(ij), grid%j_end(ij), &
538 k_start, k_end )
540 END DO
541 !$OMP END PARALLEL DO
542 BENCH_END(step_prep_tim)
544 #ifdef DM_PARALLEL
545 !-----------------------------------------------------------------------
546 ! Stencils for patch communications (WCS, 29 June 2001)
547 ! Note: the small size of this halo exchange reflects the
548 ! fact that we are carrying the uncoupled variables
549 ! as state variables in the mass coordinate model, as
550 ! opposed to the coupled variables as in the height
551 ! coordinate model.
552 !
553 ! * * * * *
554 ! * * * * * * * * *
555 ! * + * * + * * * + * *
556 ! * * * * * * * * *
557 ! * * * * *
558 !
559 ! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
560 !
561 ! ru x
562 ! rv x
563 ! ww x
564 ! php x
565 ! alt x
566 ! ph_2 x
567 ! phb x
568 !
569 ! the following are 2D (xy) variables
570 !
571 ! muu x
572 ! muv x
573 ! mut x
574 !--------------------------------------------------------------
575 # include "HALO_EM_A.inc"
576 #endif
578 ! set boundary conditions on variables
579 ! from big_step_prep for use in big_step_proc
581 #ifdef DM_PARALLEL
582 # include "PERIOD_BDY_EM_A.inc"
583 #endif
585 BENCH_START(set_phys_bc_tim)
586 !$OMP PARALLEL DO &
587 !$OMP PRIVATE ( ij, ii, jj, kk )
589 DO ij = 1 , grid%num_tiles
591 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
593 CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, &
594 grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, &
595 ids, ide, jds, jde, kds, kde, &
596 ims, ime, jms, jme, kms, kme, &
597 ips, ipe, jps, jpe, kps, kpe, &
598 grid%i_start(ij), grid%i_end(ij), &
599 grid%j_start(ij), grid%j_end(ij), &
600 k_start, k_end )
601 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
602 ids, ide, jds, jde, kds, kde, &
603 ims, ime, jms, jme, kms, kme, &
604 ips, ipe, jps, jpe, kps, kpe, &
605 grid%i_start(ij), grid%i_end(ij), &
606 grid%j_start(ij), grid%j_end(ij), &
607 k_start , k_end )
608 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
609 ids, ide, jds, jde, kds, kde, &
610 ims, ime, jms, jme, kms, kme, &
611 ips, ipe, jps, jpe, kps, kpe, &
612 grid%i_start(ij), grid%i_end(ij), &
613 grid%j_start(ij), grid%j_end(ij), &
614 k_start, k_end )
616 IF (config_flags%polar) THEN
618 !-------------------------------------------------------
619 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
620 !-------------------------------------------------------
622 CALL pole_point_bc ( grid%v_1, &
623 ids, ide, jds, jde, kds, kde, &
624 ims, ime, jms, jme, kms, kme, &
625 grid%i_start(ij), grid%i_end(ij), &
626 grid%j_start(ij), grid%j_end(ij), &
627 k_start, k_end )
629 CALL pole_point_bc ( grid%v_2, &
630 ids, ide, jds, jde, kds, kde, &
631 ims, ime, jms, jme, kms, kme, &
632 grid%i_start(ij), grid%i_end(ij), &
633 grid%j_start(ij), grid%j_end(ij), &
634 k_start, k_end )
636 !-------------------------------------------------------
637 ! end lat-lon grid pole-point (v) specification
638 !-------------------------------------------------------
640 ENDIF
641 END DO
642 !$OMP END PARALLEL DO
643 BENCH_END(set_phys_bc_tim)
645 rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
647 !<DESCRIPTION>
648 !<pre>
649 !(2) The non-timesplit physics begins with a call to "phy_prep"
650 ! (which computes some diagnostic variables such as temperature,
651 ! pressure, u and v at p points, etc). This is followed by
652 ! calls to the physics drivers:
653 !
654 ! radiation,
655 ! surface,
656 ! pbl,
657 ! cumulus,
658 ! fddagd,
659 ! 3D TKE and mixing.
660 !<pre>
661 !</DESCRIPTION>
663 CALL first_rk_step_part1 ( grid, config_flags &
664 , moist , moist_tend &
665 , chem , chem_tend &
666 , tracer, tracer_tend &
667 , scalar , scalar_tend &
668 , fdda3d, fdda2d &
669 , aerod &
670 , ru_tendf, rv_tendf &
671 , rw_tendf, t_tendf &
672 , ph_tendf, mu_tendf &
673 , tke_tend &
674 , config_flags%use_adaptive_time_step &
675 , curr_secs &
676 , psim , psih , gz1oz0 &
677 , chklowq &
678 , cu_act_flag , hol , th_phy &
679 , pi_phy , p_phy , grid%t_phy &
680 , dz8w , p8w , t8w &
681 , ids, ide, jds, jde, kds, kde &
682 , ims, ime, jms, jme, kms, kme &
683 , ips, ipe, jps, jpe, kps, kpe &
684 , imsx, imex, jmsx, jmex, kmsx, kmex &
685 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
686 , imsy, imey, jmsy, jmey, kmsy, kmey &
687 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
688 , k_start , k_end &
689 , f_flux=f_flux &
690 , feedback_is_ready=feedback_is_ready &
691 )
693 #ifdef DM_PARALLEL
694 IF ( config_flags%bl_pbl_physics == MYNNPBLSCHEME ) THEN
695 # include "HALO_EM_SCALAR_E_5.inc"
696 ENDIF
697 #endif
699 !CALL push4backup (grid%rublten,grid%rvblten,grid%rthblten,grid%rqvblten,grid%rthcuten,grid%rqvcuten,&
700 ! "rublten,rvblten,rthblten,rqvblten,rthcuten,rqvcuten")
701 CALL PUSHREAL8ARRAY ( grid%rublten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
702 CALL PUSHREAL8ARRAY ( grid%rvblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
703 CALL PUSHREAL8ARRAY ( grid%rthblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
704 CALL PUSHREAL8ARRAY ( grid%rqvblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
705 if ( config_flags%cu_physics .gt. 0 ) then
706 CALL PUSHREAL8ARRAY ( grid%rthcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
707 CALL PUSHREAL8ARRAY ( grid%rqvcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
708 end if
710 CALL first_rk_step_part2 ( grid, config_flags &
711 , moist , moist_old, moist_tend &
712 , chem , chem_tend &
713 , tracer, tracer_tend &
714 , scalar , scalar_tend &
715 , fdda3d, fdda2d &
716 , ru_tendf, rv_tendf &
717 , rw_tendf, t_tendf &
718 , ph_tendf, mu_tendf &
719 , tke_tend &
720 , adapt_step_flag , curr_secs &
721 , psim , psih , gz1oz0 &
722 , chklowq &
723 , cu_act_flag , hol , th_phy &
724 , pi_phy , p_phy , grid%t_phy &
725 , dz8w , p8w , t8w &
726 , nba_mij, num_nba_mij & !JDM
727 , nba_rij, num_nba_rij & !JDM
728 , ids, ide, jds, jde, kds, kde &
729 , ims, ime, jms, jme, kms, kme &
730 , ips, ipe, jps, jpe, kps, kpe &
731 , imsx, imex, jmsx, jmex, kmsx, kmex &
732 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
733 , imsy, imey, jmsy, jmey, kmsy, kmey &
734 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
735 , k_start , k_end &
736 )
738 END IF rk_step_is_one
740 BENCH_START(rk_tend_tim)
742 !CALL push4backup (grid%mu_2,grid%muu,grid%muv,grid%mut, "mu,muu,muv,mut")
743 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
744 CALL PUSHREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
745 CALL PUSHREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
746 CALL PUSHREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
747 !CALL push4backup (grid%ru,grid%rv,grid%rw,grid%ww, "ru,rv,rw,ww")
748 CALL PUSHREAL8ARRAY ( grid%ru, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
749 CALL PUSHREAL8ARRAY ( grid%rv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
750 CALL PUSHREAL8ARRAY ( grid%rw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
751 CALL PUSHREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
752 !CALL push4backup (grid%u_2,grid%v_2,grid%w_2,grid%t_2,grid%ph_2, "u,v,w,t,ph")
753 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
754 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
755 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
756 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
757 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
758 !CALL push4backup (grid%al,grid%alt,grid%p,grid%php,cqu,cqv,cqw, &
759 ! "al,alt,p,php,cqu,cqv,cqw")
760 CALL PUSHREAL8ARRAY ( grid%al, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
761 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
762 CALL PUSHREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
763 CALL PUSHREAL8ARRAY ( grid%php, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
764 CALL PUSHREAL8ARRAY ( cqu, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
765 CALL PUSHREAL8ARRAY ( cqv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
766 CALL PUSHREAL8ARRAY ( cqw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
767 !CALL push4backup (grid%xkmh,grid%xkhh, "xkmh,xkhh")
769 !$OMP PARALLEL DO &
770 !$OMP PRIVATE ( ij )
771 DO ij = 1 , grid%num_tiles
773 CALL wrf_debug ( 200 , ' call rk_tendency' )
774 CALL rk_tendency ( config_flags, rk_step &
775 ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend &
776 ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf &
777 ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save &
778 ,grid%t_save, mu_save, grid%rthften &
779 ,grid%ru, grid%rv, grid%rw, grid%ww, wwE, wwI &
780 ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2 &
781 ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1 &
782 ,grid%h_diabatic, grid%phb, grid%t_init &
783 ,grid%mu_1, grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub &
784 ,grid%c1h, grid%c2h, grid%c1f, grid%c2f &
785 ,grid%al, grid%ht, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw &
786 ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base &
787 ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv &
788 ,grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa &
789 ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw &
790 ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh &
791 ,grid%diff_6th_opt, grid%diff_6th_factor &
792 ,config_flags%momentum_adv_opt &
793 ,grid%dampcoef,grid%zdamp,config_flags%damp_opt,config_flags%rad_nudge &
794 ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m &
795 ,config_flags%non_hydrostatic, config_flags%top_lid &
796 ,grid%u_frame, grid%v_frame &
797 ,ids, ide, jds, jde, kds, kde &
798 ,ims, ime, jms, jme, kms, kme &
799 ,grid%i_start(ij), grid%i_end(ij) &
800 ,grid%j_start(ij), grid%j_end(ij) &
801 ,k_start, k_end &
802 ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
803 END DO
804 !$OMP END PARALLEL DO
805 BENCH_END(rk_tend_tim)
807 IF (config_flags%use_adaptive_time_step) THEN
808 DO ij = 1 , grid%num_tiles
809 IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
810 grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
811 ENDIF
812 IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
813 grid%max_vert_cfl = max_vert_cfl_tmp(ij)
814 ENDIF
815 END DO
817 IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
818 grid%max_cfl_val = grid%max_horiz_cfl
819 ENDIF
820 IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
821 grid%max_cfl_val = grid%max_vert_cfl
822 ENDIF
823 ENDIF
825 BENCH_START(relax_bdy_dry_tim)
826 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
827 !CALL push4backup (grid%mut, "mut")
828 !CALL push4backup (grid%ph_2,grid%t_2,grid%w_2, "ph,t,w")
829 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
830 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
831 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
832 ENDIF
834 !$OMP PARALLEL DO &
835 !$OMP PRIVATE (ij)
836 DO ij = 1 , grid%num_tiles
838 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
840 CALL relax_bdy_dry ( config_flags, &
841 grid%u_save, grid%v_save, ph_save, grid%t_save, &
842 w_save, mu_tend, &
843 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
844 grid%ru, grid%rv, grid%ph_2, grid%t_2, &
845 grid%w_2, grid%mu_2, grid%mut, &
846 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
847 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
848 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
849 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
850 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
851 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
852 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
853 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
854 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
855 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
856 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
857 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
858 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
859 grid%dtbc, grid%fcx, grid%gcx, &
860 ids,ide, jds,jde, kds,kde, &
861 ims,ime, jms,jme, kms,kme, &
862 ips,ipe, jps,jpe, kps,kpe, &
863 grid%i_start(ij), grid%i_end(ij), &
864 grid%j_start(ij), grid%j_end(ij), &
865 k_start, k_end )
867 ENDIF
869 !CALL push4backup (grid%mut, "mut")
870 !CALL push4backup (grid%h_diabatic, "h_diabatic")
872 CALL rk_addtend_dry( grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend, &
873 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
874 grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
875 mu_tend, mu_tendf, rk_step, &
876 grid%c1h, grid%c2h, &
877 grid%h_diabatic, grid%mut, grid%msftx, &
878 grid%msfty, grid%msfux,grid%msfuy, &
879 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
880 ids,ide, jds,jde, kds,kde, &
881 ims,ime, jms,jme, kms,kme, &
882 ips,ipe, jps,jpe, kps,kpe, &
883 grid%i_start(ij), grid%i_end(ij), &
884 grid%j_start(ij), grid%j_end(ij), &
885 k_start, k_end )
887 IF( config_flags%specified .or. config_flags%nested ) THEN
889 CALL spec_bdy_dry ( config_flags, &
890 grid%ru_tend, grid%rv_tend, ph_tend, t_tend, &
891 rw_tend, mu_tend, &
892 grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
893 grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
894 grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
895 grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
896 grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
897 grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
898 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
899 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
900 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
901 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
902 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
903 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
904 config_flags%spec_bdy_width, grid%spec_zone, &
905 ids,ide, jds,jde, kds,kde, & ! domain dims
906 ims,ime, jms,jme, kms,kme, & ! memory dims
907 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
908 grid%i_start(ij), grid%i_end(ij), &
909 grid%j_start(ij), grid%j_end(ij), &
910 k_start, k_end )
912 ENDIF
914 END DO
915 !$OMP END PARALLEL DO
916 BENCH_END(relax_bdy_dry_tim)
918 !<DESCRIPTION>
919 !<pre>
920 ! (3) Small (acoustic,sound) steps.
921 !
922 ! Several acoustic steps are taken each RK pass. A small step
923 ! sequence begins with calculating perturbation variables
924 ! and coupling them to the column dry-air-mass mu
925 ! (call to small_step_prep). This is followed by computing
926 ! coefficients for the vertically implicit part of the
927 ! small timestep (call to calc_coef_w).
928 !
929 ! The small steps are taken
930 ! in the named loop "small_steps:". In the small_steps loop, first
931 ! the horizontal momentum (u and v) are advanced (call to advance_uv),
932 ! next mu and theta are advanced (call to advance_mu_t) followed by
933 ! advancing w and the geopotential (call to advance_w). Diagnostic
934 ! values for pressure and inverse density are updated at the end of
935 ! each small_step.
936 !
937 ! The small-step section ends with the change of the perturbation variables
938 ! back to full variables (call to small_step_finish).
939 !</pre>
940 !</DESCRIPTION>
942 BENCH_START(small_step_prep_tim)
943 !CALL push4backup (grid%muu,grid%muv,grid%mut, "muu,muv,mut")
944 IF ( rk_step == 1 ) THEN
945 !CALL push4backup (grid%mu_2, "mu_2")
946 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
947 !CALL push4backup (grid%u_2,grid%v_2,grid%t_2,grid%w_2,grid%p,grid%alt, &
948 ! "u_2,v_2,t_2,w_2,p,alt")
949 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
950 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
951 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
952 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
953 CALL PUSHREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
954 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
955 ELSE
956 !CALL push4backup (grid%mu_1, "mu_1")
957 CALL PUSHREAL8ARRAY ( grid%mu_1, (ime-ims+1)*(jme-jms+1) )
958 !CALL push4backup (grid%u_1,grid%v_1,grid%t_1,grid%w_1, &
959 ! grid%u_2,grid%v_2,grid%t_2,grid%w_2,grid%p,grid%alt, &
960 ! "u_1,v_1,t_1,w_1,u_2,v_2,t_2,w_2,p,alt")
961 CALL PUSHREAL8ARRAY ( grid%u_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
962 CALL PUSHREAL8ARRAY ( grid%v_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
963 CALL PUSHREAL8ARRAY ( grid%t_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
964 CALL PUSHREAL8ARRAY ( grid%w_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
965 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
966 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
967 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
968 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
969 CALL PUSHREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
970 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
971 END IF
973 !$OMP PARALLEL DO &
974 !$OMP PRIVATE ( ij )
975 DO ij = 1 , grid%num_tiles
977 ! Calculate coefficients for the vertically implicit acoustic/gravity wave
978 ! integration. We only need calculate these for the first pass through -
979 ! the predictor step. They are reused as is for the corrector step.
980 ! For third-order RK, we need to recompute these after the first
981 ! predictor because we may have changed the small timestep -> grid%dts.
983 CALL wrf_debug ( 200 , ' call small_step_prep ' )
985 CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2, &
986 grid%t_1,grid%t_2,grid%ph_1,grid%ph_2, &
987 grid%mub, grid%mu_1, grid%mu_2, &
988 grid%muu, grid%muus, grid%muv, grid%muvs, &
989 grid%mut, grid%muts, grid%mudf, &
990 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
991 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
992 grid%u_save, grid%v_save, w_save, &
993 grid%t_save, ph_save, mu_save, &
994 grid%ww, ww1, &
995 c2a, grid%pb, grid%p, grid%alt, &
996 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
997 grid%msfvy, grid%msftx,grid%msfty, &
998 grid%rdx, grid%rdy, rk_step, &
999 ids, ide, jds, jde, kds, kde, &
1000 ims, ime, jms, jme, kms, kme, &
1001 grid%i_start(ij), grid%i_end(ij), &
1002 grid%j_start(ij), grid%j_end(ij), &
1003 k_start , k_end )
1005 !CALL push4backup (grid%mu_2,grid%muts, "mu,muts")
1006 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
1007 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
1008 !CALL push4backup (grid%alt,grid%ph_2,grid%t_2,grid%t_save,c2a, "alt,ph,t_2,t_1,c2a")
1009 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1010 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1011 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1012 CALL PUSHREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1013 CALL PUSHREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1015 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1016 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1017 grid%mu_2, grid%muts, &
1018 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1019 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1020 grid%znu, t0, &
1021 grid%rdnw, grid%dnw, grid%smdiv, &
1022 config_flags%non_hydrostatic, 0, &
1023 ids, ide, jds, jde, kds, kde, &
1024 ims, ime, jms, jme, kms, kme, &
1025 grid%i_start(ij), grid%i_end(ij), &
1026 grid%j_start(ij), grid%j_end(ij), &
1027 k_start , k_end )
1029 IF (config_flags%non_hydrostatic) THEN
1031 !CALL push4backup (c2a,cqw, "c2a,cqw")
1032 !CALL push4backup (grid%mut, "mut")
1033 CALL PUSHREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
1035 CALL calc_coef_w( a,alpha,gamma, &
1036 grid%mut, &
1037 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1038 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1039 cqw, &
1040 grid%rdn, grid%rdnw, c2a, &
1041 dts_rk, g, grid%epssm, &
1042 config_flags%top_lid, &
1043 ids, ide, jds, jde, kds, kde, &
1044 ims, ime, jms, jme, kms, kme, &
1045 grid%i_start(ij), grid%i_end(ij), &
1046 grid%j_start(ij), grid%j_end(ij), &
1047 k_start , k_end )
1049 ENDIF
1051 ENDDO
1052 !$OMP END PARALLEL DO
1054 BENCH_END(small_step_prep_tim)
1056 #ifdef DM_PARALLEL
1057 !-----------------------------------------------------------------------
1058 ! Stencils for patch communications (WCS, 29 June 2001)
1059 ! Note: the small size of this halo exchange reflects the
1060 ! fact that we are carrying the uncoupled variables
1061 ! as state variables in the mass coordinate model, as
1062 ! opposed to the coupled variables as in the height
1063 ! coordinate model.
1064 !
1065 ! * * * * *
1066 ! * * * * * * * * *
1067 ! * + * * + * * * + * *
1068 ! * * * * * * * * *
1069 ! * * * * *
1070 !
1071 ! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
1072 !
1073 ! ph_2 x
1074 ! al x
1075 ! p x
1076 ! t_1 x
1077 ! t_save x
1078 ! u_save x
1079 ! v_save x
1080 !
1081 ! the following are 2D (xy) variables
1082 !
1083 ! mu_1 x
1084 ! mu_2 x
1085 ! mudf x
1086 ! php x
1087 ! alt x
1088 ! pb x
1089 !--------------------------------------------------------------
1090 # include "HALO_EM_B.inc"
1091 # include "PERIOD_BDY_EM_B.inc"
1092 #endif
1094 BENCH_START(set_phys_bc2_tim)
1097 !$OMP PARALLEL DO &
1098 !$OMP PRIVATE ( ij )
1100 DO ij = 1 , grid%num_tiles
1102 CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags, &
1103 ids, ide, jds, jde, kds, kde, &
1104 ims, ime, jms, jme, kms, kme, &
1105 ips, ipe, jps, jpe, kps, kpe, &
1106 grid%i_start(ij), grid%i_end(ij), &
1107 grid%j_start(ij), grid%j_end(ij), &
1108 k_start , k_end )
1110 CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags, &
1111 ids, ide, jds, jde, kds, kde, &
1112 ims, ime, jms, jme, kms, kme, &
1113 ips, ipe, jps, jpe, kps, kpe, &
1114 grid%i_start(ij), grid%i_end(ij), &
1115 grid%j_start(ij), grid%j_end(ij), &
1116 k_start , k_end )
1118 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1119 ids, ide, jds, jde, kds, kde, &
1120 ims, ime, jms, jme, kms, kme, &
1121 ips, ipe, jps, jpe, kps, kpe, &
1122 grid%i_start(ij), grid%i_end(ij), &
1123 grid%j_start(ij), grid%j_end(ij), &
1124 k_start , k_end )
1126 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1127 ids, ide, jds, jde, kds, kde, &
1128 ims, ime, jms, jme, kms, kme, &
1129 ips, ipe, jps, jpe, kps, kpe, &
1130 grid%i_start(ij), grid%i_end(ij), &
1131 grid%j_start(ij), grid%j_end(ij), &
1132 k_start , k_end )
1134 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1135 ids, ide, jds, jde, kds, kde, &
1136 ims, ime, jms, jme, kms, kme, &
1137 ips, ipe, jps, jpe, kps, kpe, &
1138 grid%i_start(ij), grid%i_end(ij), &
1139 grid%j_start(ij), grid%j_end(ij), &
1140 k_start , k_end )
1142 CALL set_physical_bc3d( grid%t_1, 'p', config_flags, &
1143 ids, ide, jds, jde, kds, kde, &
1144 ims, ime, jms, jme, kms, kme, &
1145 ips, ipe, jps, jpe, kps, kpe, &
1146 grid%i_start(ij), grid%i_end(ij), &
1147 grid%j_start(ij), grid%j_end(ij), &
1148 k_start , k_end )
1150 CALL set_physical_bc3d( grid%t_save, 't', config_flags, &
1151 ids, ide, jds, jde, kds, kde, &
1152 ims, ime, jms, jme, kms, kme, &
1153 ips, ipe, jps, jpe, kps, kpe, &
1154 grid%i_start(ij), grid%i_end(ij), &
1155 grid%j_start(ij), grid%j_end(ij), &
1156 k_start , k_end )
1158 CALL set_physical_bc2d( grid%mu_1, 't', config_flags, &
1159 ids, ide, jds, jde, &
1160 ims, ime, jms, jme, &
1161 ips, ipe, jps, jpe, &
1162 grid%i_start(ij), grid%i_end(ij), &
1163 grid%j_start(ij), grid%j_end(ij) )
1165 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1166 ids, ide, jds, jde, &
1167 ims, ime, jms, jme, &
1168 ips, ipe, jps, jpe, &
1169 grid%i_start(ij), grid%i_end(ij), &
1170 grid%j_start(ij), grid%j_end(ij) )
1172 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1173 ids, ide, jds, jde, &
1174 ims, ime, jms, jme, &
1175 ips, ipe, jps, jpe, &
1176 grid%i_start(ij), grid%i_end(ij), &
1177 grid%j_start(ij), grid%j_end(ij) )
1179 END DO
1180 !$OMP END PARALLEL DO
1182 BENCH_END(set_phys_bc2_tim)
1184 small_steps : DO iteration = 1 , number_of_small_timesteps
1186 ! Boundary condition time (or communication time).
1187 #ifdef DM_PARALLEL
1188 # include "PERIOD_BDY_EM_B.inc"
1189 #endif
1191 !CALL push4backup (grid%mu_2,grid%muu,grid%muv, "mu,muu,muv")
1192 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
1193 CALL PUSHREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
1194 CALL PUSHREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
1195 !CALL push4backup (grid%ph_2,grid%alt,grid%p,grid%al,grid%php,cqu,cqv, "ph,alt,p,al,php,cqu,cqv")
1196 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1197 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1198 CALL PUSHREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1199 CALL PUSHREAL8ARRAY ( grid%al, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1200 CALL PUSHREAL8ARRAY ( grid%php, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1201 CALL PUSHREAL8ARRAY ( cqu, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1202 CALL PUSHREAL8ARRAY ( cqv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1204 !$OMP PARALLEL DO &
1205 !$OMP PRIVATE ( ij )
1207 DO ij = 1 , grid%num_tiles
1209 BENCH_START(advance_uv_tim)
1211 CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend, &
1212 grid%p, grid%pb, &
1213 grid%ph_2, grid%php, grid%alt, grid%al, &
1214 grid%mu_2, &
1215 grid%muu, cqu, grid%muv, cqv, grid%mudf, &
1216 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1217 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1218 grid%msfux, grid%msfuy, grid%msfvx, &
1219 grid%msfvx_inv, grid%msfvy, &
1220 grid%rdx, grid%rdy, dts_rk, &
1221 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
1222 grid%emdiv, &
1223 grid%rdnw, config_flags,grid%spec_zone, &
1224 config_flags%non_hydrostatic, config_flags%top_lid, &
1225 ids, ide, jds, jde, kds, kde, &
1226 ims, ime, jms, jme, kms, kme, &
1227 grid%i_start(ij), grid%i_end(ij), &
1228 grid%j_start(ij), grid%j_end(ij), &
1229 k_start , k_end )
1231 BENCH_END(advance_uv_tim)
1233 END DO
1234 !$OMP END PARALLEL DO
1236 !-----------------------------------------------------------
1237 ! acoustic integration polar filter for smallstep u, v
1238 !-----------------------------------------------------------
1240 IF (config_flags%polar) THEN
1242 CALL pxft ( grid=grid &
1243 ,lineno=__LINE__ &
1244 ,flag_uv = 1 &
1245 ,flag_rurv = 0 &
1246 ,flag_wph = 0 &
1247 ,flag_ww = 0 &
1248 ,flag_t = 0 &
1249 ,flag_mu = 0 &
1250 ,flag_mut = 0 &
1251 ,flag_moist = 0 &
1252 ,flag_chem = 0 &
1253 ,flag_tracer = 0 &
1254 ,flag_scalar = 0 &
1255 ,actual_distance_average = .FALSE. &
1256 ,pos_def = .FALSE. &
1257 ,swap_pole_with_next_j = .FALSE. &
1258 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1259 ,fft_filter_lat = config_flags%fft_filter_lat &
1260 ,dclat = dclat &
1261 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1262 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1263 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1264 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1265 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1267 END IF
1269 !-----------------------------------------------------------
1270 ! end acoustic integration polar filter for smallstep u, v
1271 !-----------------------------------------------------------
1273 !$OMP PARALLEL DO &
1274 !$OMP PRIVATE ( ij )
1275 DO ij = 1 , grid%num_tiles
1277 BENCH_START(spec_bdy_uv_tim)
1278 IF( config_flags%specified .or. config_flags%nested ) THEN
1280 CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk, &
1281 'u' , config_flags, &
1282 grid%spec_zone, &
1283 ids,ide, jds,jde, kds,kde, & ! domain dims
1284 ims,ime, jms,jme, kms,kme, & ! memory dims
1285 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1286 grid%i_start(ij), grid%i_end(ij), &
1287 grid%j_start(ij), grid%j_end(ij), &
1288 k_start , k_end )
1290 CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk, &
1291 'v' , config_flags, &
1292 grid%spec_zone, &
1293 ids,ide, jds,jde, kds,kde, & ! domain dims
1294 ims,ime, jms,jme, kms,kme, & ! memory dims
1295 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1296 grid%i_start(ij), grid%i_end(ij), &
1297 grid%j_start(ij), grid%j_end(ij), &
1298 k_start , k_end )
1300 ENDIF
1301 BENCH_END(spec_bdy_uv_tim)
1303 END DO
1304 !$OMP END PARALLEL DO
1306 #ifdef DM_PARALLEL
1307 !
1308 ! Stencils for patch communications (WCS, 29 June 2001)
1309 !
1310 ! * *
1311 ! * + * * + * +
1312 ! * *
1313 !
1314 ! u_2 x
1315 ! v_2 x
1316 !
1317 # include "HALO_EM_C.inc"
1318 #endif
1320 !CALL push4backup (grid%muu,grid%muv,mu_tend, "muu,muv,mu_tend")
1321 !CALL push4backup (grid%ww,ww1,grid%u_2,grid%u_save,grid%v_2,grid%v_save,grid%t_save, &
1322 ! "ww,ww_1,u,u_1,v,v_1,t_1")
1323 CALL PUSHREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1324 CALL PUSHREAL8ARRAY ( ww1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1325 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1326 CALL PUSHREAL8ARRAY ( grid%u_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1327 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1328 CALL PUSHREAL8ARRAY ( grid%v_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1329 CALL PUSHREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1330 !$OMP PARALLEL DO &
1331 !$OMP PRIVATE ( ij )
1332 DO ij = 1 , grid%num_tiles
1334 ! advance the mass in the column, theta, and calculate ww
1336 BENCH_START(advance_mu_t_tim)
1338 CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
1339 grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv, &
1340 grid%mudf, &
1341 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1342 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1343 grid%ru_m, grid%rv_m, grid%ww_m, &
1344 grid%t_2, grid%t_save, t_2save, t_tend, &
1345 mu_tend, &
1346 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1347 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1348 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1349 grid%msfvy, grid%msftx,grid%msfty, &
1350 iteration, config_flags, &
1351 ids, ide, jds, jde, kds, kde, &
1352 ims, ime, jms, jme, kms, kme, &
1353 grid%i_start(ij), grid%i_end(ij), &
1354 grid%j_start(ij), grid%j_end(ij), &
1355 k_start , k_end )
1357 BENCH_END(advance_mu_t_tim)
1358 ENDDO
1359 !$OMP END PARALLEL DO
1361 !-----------------------------------------------------------
1362 ! acoustic integration polar filter for smallstep mu, t
1363 !-----------------------------------------------------------
1365 IF ( (config_flags%polar) ) THEN
1367 CALL pxft ( grid=grid &
1368 ,lineno=__LINE__ &
1369 ,flag_uv = 0 &
1370 ,flag_rurv = 0 &
1371 ,flag_wph = 0 &
1372 ,flag_ww = 0 &
1373 ,flag_t = 1 &
1374 ,flag_mu = 1 &
1375 ,flag_mut = 0 &
1376 ,flag_moist = 0 &
1377 ,flag_chem = 0 &
1378 ,flag_tracer = 0 &
1379 ,flag_scalar = 0 &
1380 ,actual_distance_average = .FALSE. &
1381 ,pos_def = .FALSE. &
1382 ,swap_pole_with_next_j = .FALSE. &
1383 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1384 ,fft_filter_lat = config_flags%fft_filter_lat &
1385 ,dclat = dclat &
1386 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1387 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1388 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1389 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1390 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1392 grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1394 END IF
1396 !-----------------------------------------------------------
1397 ! end acoustic integration polar filter for smallstep mu, t
1398 !-----------------------------------------------------------
1400 BENCH_START(spec_bdy_t_tim)
1402 !$OMP PARALLEL DO &
1403 !$OMP PRIVATE ( ij )
1404 DO ij = 1 , grid%num_tiles
1406 IF( config_flags%specified .or. config_flags%nested ) THEN
1408 CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk, &
1409 't' , config_flags, &
1410 grid%spec_zone, &
1411 ids,ide, jds,jde, kds,kde, &
1412 ims,ime, jms,jme, kms,kme, &
1413 ips,ipe, jps,jpe, kps,kpe, &
1414 grid%i_start(ij), grid%i_end(ij),&
1415 grid%j_start(ij), grid%j_end(ij),&
1416 k_start , k_end )
1418 CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk, &
1419 'm' , config_flags, &
1420 grid%spec_zone, &
1421 ids,ide, jds,jde, 1 ,1 , &
1422 ims,ime, jms,jme, 1 ,1 , &
1423 ips,ipe, jps,jpe, 1 ,1 , &
1424 grid%i_start(ij), grid%i_end(ij),&
1425 grid%j_start(ij), grid%j_end(ij),&
1426 1 , 1 )
1428 CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk,&
1429 'm' , config_flags, &
1430 grid%spec_zone, &
1431 ids,ide, jds,jde, 1 ,1 , & ! domain dims
1432 ims,ime, jms,jme, 1 ,1 , & ! memory dims
1433 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1434 grid%i_start(ij), grid%i_end(ij), &
1435 grid%j_start(ij), grid%j_end(ij), &
1436 1 , 1 )
1437 ENDIF
1439 BENCH_END(spec_bdy_t_tim)
1441 ! small (acoustic) step for the vertical momentum,
1442 ! density and coupled potential temperature.
1445 BENCH_START(advance_w_tim)
1446 IF ( config_flags%non_hydrostatic ) THEN
1448 !CALL push4backup (grid%mut,muave,grid%muts, "mut,muave,muts")
1449 CALL PUSHREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
1450 CALL PUSHREAL8ARRAY ( muave, (ime-ims+1)*(jme-jms+1) )
1451 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
1452 !CALL push4backup (grid%u_2,grid%v_2,grid%w_2,rw_tend,grid%ww,w_save,t_2save,grid%t_2,grid%t_save, &
1453 ! "u,v,w,rw_tend,ww,w_save,t_2ave,t_2,t_1")
1454 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1455 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1456 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1457 CALL PUSHREAL8ARRAY ( rw_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1458 CALL PUSHREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1459 CALL PUSHREAL8ARRAY ( w_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1460 CALL PUSHREAL8ARRAY ( t_2save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1461 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1462 CALL PUSHREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1463 !CALL push4backup (grid%ph_2,ph_save,ph_tend,c2a,cqw,grid%alt,a,alpha,gamma, &
1464 ! "ph,ph_1,ph_tend,c2a,cqw,alt,a,alpha,gamma")
1465 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1466 CALL PUSHREAL8ARRAY ( ph_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1467 CALL PUSHREAL8ARRAY ( ph_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1468 CALL PUSHREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1469 CALL PUSHREAL8ARRAY ( cqw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1470 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1471 CALL PUSHREAL8ARRAY ( a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1472 CALL PUSHREAL8ARRAY ( alpha, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1473 CALL PUSHREAL8ARRAY ( gamma, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1475 CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save, &
1476 grid%u_2, grid%v_2, &
1477 grid%mu_2, grid%mut, muave, grid%muts, &
1478 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1479 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1480 t_2save, grid%t_2, grid%t_save, &
1481 grid%ph_2, ph_save, grid%phb, ph_tend, &
1482 grid%ht, c2a, cqw, grid%alt, grid%alb, &
1483 a, alpha, gamma, &
1484 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1485 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1486 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1487 grid%msftx, grid%msfty, &
1488 config_flags, config_flags%top_lid, &
1489 ids,ide, jds,jde, kds,kde, &
1490 ims,ime, jms,jme, kms,kme, &
1491 grid%i_start(ij), grid%i_end(ij), &
1492 grid%j_start(ij), grid%j_end(ij), &
1493 k_start , k_end )
1495 ENDIF
1497 BENCH_END(advance_w_tim)
1499 ENDDO
1500 !$OMP END PARALLEL DO
1502 !-----------------------------------------------------------
1503 ! acoustic integration polar filter for smallstep w, geopotential
1504 !-----------------------------------------------------------
1506 IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1508 CALL pxft ( grid=grid &
1509 ,lineno=__LINE__ &
1510 ,flag_uv = 0 &
1511 ,flag_rurv = 0 &
1512 ,flag_wph = 1 &
1513 ,flag_ww = 0 &
1514 ,flag_t = 0 &
1515 ,flag_mu = 0 &
1516 ,flag_mut = 0 &
1517 ,flag_moist = 0 &
1518 ,flag_chem = 0 &
1519 ,flag_tracer = 0 &
1520 ,flag_scalar = 0 &
1521 ,actual_distance_average = .FALSE. &
1522 ,pos_def = .FALSE. &
1523 ,swap_pole_with_next_j = .FALSE. &
1524 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1525 ,fft_filter_lat = config_flags%fft_filter_lat &
1526 ,dclat = dclat &
1527 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1528 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1529 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1530 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1531 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1533 END IF
1535 !-----------------------------------------------------------
1536 ! end acoustic integration polar filter for smallstep w, geopotential
1537 !-----------------------------------------------------------
1539 !CALL push4backup (grid%muu,grid%muv, "muu,muv")
1540 !CALL push4backup (grid%u_save,grid%v_save, "u_lin,v_lin")
1542 !$OMP PARALLEL DO &
1543 !$OMP PRIVATE ( ij )
1544 DO ij = 1 , grid%num_tiles
1546 BENCH_START(sumflux_tim)
1547 CALL sumflux ( grid%u_2, grid%v_2, grid%ww, &
1548 grid%u_save, grid%v_save, ww1, &
1549 grid%muu, grid%muv, &
1550 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1551 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1552 grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm, &
1553 grid%msfux, grid% msfuy, grid%msfvx, &
1554 grid%msfvx_inv, grid%msfvy, &
1555 iteration, number_of_small_timesteps, &
1556 ids, ide, jds, jde, kds, kde, &
1557 ims, ime, jms, jme, kms, kme, &
1558 grid%i_start(ij), grid%i_end(ij), &
1559 grid%j_start(ij), grid%j_end(ij), &
1560 k_start , k_end )
1562 BENCH_END(sumflux_tim)
1564 IF( config_flags%specified .or. config_flags%nested ) THEN
1566 BENCH_START(spec_bdynhyd_tim)
1567 IF (config_flags%non_hydrostatic) THEN
1569 !CALL push4backup (ph_save,grid%ph_2,ph_tend, "ph_save,ph,ph_tend")
1570 CALL PUSHREAL8ARRAY ( ph_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1571 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1572 CALL PUSHREAL8ARRAY ( ph_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1573 !CALL push4backup (mu_tend,grid%muts, "mu_tend,muts")
1574 CALL PUSHREAL8ARRAY ( mu_tend, (ime-ims+1)*(jme-jms+1) )
1575 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
1577 CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend, &
1578 mu_tend, grid%muts, &
1579 grid%c1f, grid%c2f, dts_rk, &
1580 'h' , config_flags, &
1581 grid%spec_zone, &
1582 ids,ide, jds,jde, kds,kde, &
1583 ims,ime, jms,jme, kms,kme, &
1584 ips,ipe, jps,jpe, kps,kpe, &
1585 grid%i_start(ij), grid%i_end(ij),&
1586 grid%j_start(ij), grid%j_end(ij),&
1587 k_start , k_end )
1589 IF( config_flags%specified ) THEN
1591 CALL zero_grad_bdy ( grid%w_2, &
1592 'w' , config_flags, &
1593 grid%spec_zone, &
1594 ids,ide, jds,jde, kds,kde, &
1595 ims,ime, jms,jme, kms,kme, &
1596 ips,ipe, jps,jpe, kps,kpe, &
1597 grid%i_start(ij), grid%i_end(ij), &
1598 grid%j_start(ij), grid%j_end(ij), &
1599 k_start , k_end )
1600 ELSE
1602 CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk, &
1603 'h' , config_flags, &
1604 grid%spec_zone, &
1605 ids,ide, jds,jde, kds,kde, &
1606 ims,ime, jms,jme, kms,kme, &
1607 ips,ipe, jps,jpe, kps,kpe, &
1608 grid%i_start(ij), grid%i_end(ij),&
1609 grid%j_start(ij), grid%j_end(ij),&
1610 k_start , k_end )
1612 ENDIF
1613 ENDIF
1614 BENCH_END(spec_bdynhyd_tim)
1615 ENDIF
1617 BENCH_START(cald_p_rho_tim)
1619 !CALL push4backup (grid%mu_2,grid%muts, "mu,muts")
1620 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
1621 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
1622 !CALL push4backup (grid%alt,grid%ph_2,grid%t_2,grid%t_save,c2a, "alt,ph,t_2,t_1,c2a")
1623 CALL PUSHREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1624 CALL PUSHREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1625 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1626 CALL PUSHREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1627 CALL PUSHREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1628 CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1629 grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1630 grid%mu_2, grid%muts, &
1631 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1632 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1633 grid%znu, t0, &
1634 grid%rdnw, grid%dnw, grid%smdiv, &
1635 config_flags%non_hydrostatic, iteration, &
1636 ids, ide, jds, jde, kds, kde, &
1637 ims, ime, jms, jme, kms, kme, &
1638 grid%i_start(ij), grid%i_end(ij), &
1639 grid%j_start(ij), grid%j_end(ij), &
1640 k_start , k_end )
1641 BENCH_END(cald_p_rho_tim)
1643 ENDDO
1644 !$OMP END PARALLEL DO
1646 #ifdef DM_PARALLEL
1647 !
1648 ! Stencils for patch communications (WCS, 29 June 2001)
1649 !
1650 ! * *
1651 ! * + * * + * +
1652 ! * *
1653 !
1654 ! ph_2 x
1655 ! al x
1656 ! p x
1657 !
1658 ! 2D variables (x,y)
1659 !
1660 ! mu_2 x
1661 ! muts x
1662 ! mudf x
1664 # include "HALO_EM_C2.inc"
1665 # include "PERIOD_BDY_EM_B3.inc"
1666 #endif
1668 BENCH_START(phys_bc_tim)
1669 !$OMP PARALLEL DO &
1670 !$OMP PRIVATE ( ij )
1671 DO ij = 1 , grid%num_tiles
1673 ! boundary condition set for next small timestep
1675 CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1676 ids, ide, jds, jde, kds, kde, &
1677 ims, ime, jms, jme, kms, kme, &
1678 ips, ipe, jps, jpe, kps, kpe, &
1679 grid%i_start(ij), grid%i_end(ij), &
1680 grid%j_start(ij), grid%j_end(ij), &
1681 k_start , k_end )
1683 CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1684 ids, ide, jds, jde, kds, kde, &
1685 ims, ime, jms, jme, kms, kme, &
1686 ips, ipe, jps, jpe, kps, kpe, &
1687 grid%i_start(ij), grid%i_end(ij), &
1688 grid%j_start(ij), grid%j_end(ij), &
1689 k_start , k_end )
1691 CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1692 ids, ide, jds, jde, kds, kde, &
1693 ims, ime, jms, jme, kms, kme, &
1694 ips, ipe, jps, jpe, kps, kpe, &
1695 grid%i_start(ij), grid%i_end(ij), &
1696 grid%j_start(ij), grid%j_end(ij), &
1697 k_start , k_end )
1699 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1700 ids, ide, jds, jde, &
1701 ims, ime, jms, jme, &
1702 ips, ipe, jps, jpe, &
1703 grid%i_start(ij), grid%i_end(ij), &
1704 grid%j_start(ij), grid%j_end(ij) )
1706 CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1707 ids, ide, jds, jde, &
1708 ims, ime, jms, jme, &
1709 ips, ipe, jps, jpe, &
1710 grid%i_start(ij), grid%i_end(ij), &
1711 grid%j_start(ij), grid%j_end(ij) )
1713 CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1714 ids, ide, jds, jde, &
1715 ims, ime, jms, jme, &
1716 ips, ipe, jps, jpe, &
1717 grid%i_start(ij), grid%i_end(ij), &
1718 grid%j_start(ij), grid%j_end(ij) )
1720 END DO
1721 !$OMP END PARALLEL DO
1722 BENCH_END(phys_bc_tim)
1724 END DO small_steps
1727 !$OMP PARALLEL DO &
1728 !$OMP PRIVATE ( ij )
1729 DO ij = 1 , grid%num_tiles
1731 CALL wrf_debug ( 200 , ' call rk_small_finish' )
1733 ! change time-perturbation variables back to
1734 ! full perturbation variables.
1735 ! first get updated mu at u and v points
1737 BENCH_START(calc_mu_uv_tim)
1739 CALL calc_mu_uv_1 ( config_flags, &
1740 grid%muts, grid%muus, grid%muvs, &
1741 ids, ide, jds, jde, kds, kde, &
1742 ims, ime, jms, jme, kms, kme, &
1743 grid%i_start(ij), grid%i_end(ij), &
1744 grid%j_start(ij), grid%j_end(ij), &
1745 k_start , k_end )
1747 BENCH_END(calc_mu_uv_tim)
1749 BENCH_START(small_step_finish_tim)
1751 !CALL push4backup (grid%mut,grid%muts,grid%muu,grid%muus,grid%muv,grid%muvs, "mut,muts,muu,muus,muv,muvs")
1752 CALL PUSHREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
1753 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
1754 CALL PUSHREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
1755 CALL PUSHREAL8ARRAY ( grid%muus, (ime-ims+1)*(jme-jms+1) )
1756 CALL PUSHREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
1757 CALL PUSHREAL8ARRAY ( grid%muvs, (ime-ims+1)*(jme-jms+1) )
1758 !CALL push4backup (grid%u_2,grid%u_save,grid%v_2,grid%v_save,grid%w_2,w_save,grid%t_2,grid%t_save, &
1759 ! grid%h_diabatic, "u,u_save,v,v_save,w,w_save,t,t_save,h_diabatic")
1760 CALL PUSHREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1761 CALL PUSHREAL8ARRAY ( grid%u_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1762 CALL PUSHREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1763 CALL PUSHREAL8ARRAY ( grid%v_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1764 CALL PUSHREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1765 CALL PUSHREAL8ARRAY ( w_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1766 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1767 CALL PUSHREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1768 CALL PUSHREAL8ARRAY ( grid%h_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
1770 CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1, &
1771 grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1, &
1772 grid%mu_2, grid%mu_1, &
1773 grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs, &
1774 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
1775 grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
1776 grid%u_save, grid%v_save, w_save, &
1777 grid%t_save, ph_save, mu_save, &
1778 grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
1779 grid%h_diabatic, &
1780 number_of_small_timesteps,dts_rk, &
1781 rk_step, rk_order, &
1782 ids, ide, jds, jde, kds, kde, &
1783 ims, ime, jms, jme, kms, kme, &
1784 grid%i_start(ij), grid%i_end(ij), &
1785 grid%j_start(ij), grid%j_end(ij), &
1786 k_start , k_end )
1788 ! call to set ru_m, rv_m and ww_m b.c's for PD advection
1790 IF (rk_step == rk_order) THEN
1792 CALL set_physical_bc3d( grid%ru_m, 'u', config_flags, &
1793 ids, ide, jds, jde, kds, kde, &
1794 ims, ime, jms, jme, kms, kme, &
1795 ips, ipe, jps, jpe, kps, kpe, &
1796 grid%i_start(ij), grid%i_end(ij), &
1797 grid%j_start(ij), grid%j_end(ij), &
1798 k_start , k_end )
1800 CALL set_physical_bc3d( grid%rv_m, 'v', config_flags, &
1801 ids, ide, jds, jde, kds, kde, &
1802 ims, ime, jms, jme, kms, kme, &
1803 ips, ipe, jps, jpe, kps, kpe, &
1804 grid%i_start(ij), grid%i_end(ij), &
1805 grid%j_start(ij), grid%j_end(ij), &
1806 k_start , k_end )
1808 CALL set_physical_bc3d( grid%ww_m, 'w', config_flags, &
1809 ids, ide, jds, jde, kds, kde, &
1810 ims, ime, jms, jme, kms, kme, &
1811 ips, ipe, jps, jpe, kps, kpe, &
1812 grid%i_start(ij), grid%i_end(ij), &
1813 grid%j_start(ij), grid%j_end(ij), &
1814 k_start , k_end )
1816 CALL set_physical_bc2d( grid%mut, 't', config_flags, &
1817 ids, ide, jds, jde, &
1818 ims, ime, jms, jme, &
1819 ips, ipe, jps, jpe, &
1820 grid%i_start(ij), grid%i_end(ij), &
1821 grid%j_start(ij), grid%j_end(ij) )
1823 CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1824 ids, ide, jds, jde, &
1825 ims, ime, jms, jme, &
1826 ips, ipe, jps, jpe, &
1827 grid%i_start(ij), grid%i_end(ij), &
1828 grid%j_start(ij), grid%j_end(ij) )
1830 END IF
1832 BENCH_END(small_step_finish_tim)
1834 END DO
1835 !$OMP END PARALLEL DO
1837 !-----------------------------------------------------------
1838 ! polar filter for full dynamics variables and time-averaged mass fluxes
1839 !-----------------------------------------------------------
1841 IF (config_flags%polar) THEN
1843 CALL pxft ( grid=grid &
1844 ,lineno=__LINE__ &
1845 ,flag_uv = 1 &
1846 ,flag_rurv = 1 &
1847 ,flag_wph = 1 &
1848 ,flag_ww = 1 &
1849 ,flag_t = 1 &
1850 ,flag_mu = 1 &
1851 ,flag_mut = 1 &
1852 ,flag_moist = 0 &
1853 ,flag_chem = 0 &
1854 ,flag_tracer = 0 &
1855 ,flag_scalar = 0 &
1856 ,actual_distance_average = .FALSE. &
1857 ,pos_def = .FALSE. &
1858 ,swap_pole_with_next_j = .FALSE. &
1859 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
1860 ,fft_filter_lat = config_flags%fft_filter_lat &
1861 ,dclat = dclat &
1862 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1863 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1864 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1865 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1866 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1868 END IF
1870 !-----------------------------------------------------------
1871 ! end polar filter for full dynamics variables and time-averaged mass fluxes
1872 !-----------------------------------------------------------
1874 !-----------------------------------------------------------------------
1875 ! add in physics tendency first if positive definite advection is used.
1876 ! pd advection applies advective flux limiter on last runge-kutta step
1877 !-----------------------------------------------------------------------
1878 ! first moisture
1880 IF ((config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1882 !CALL push4backup (grid%mu_1, "mu_1")
1883 !CALL push4backup (moist_old(:,:,:,:),moist_tend(:,:,:,:), &
1884 ! "moist_old,moist_tend")
1885 CALL PUSHREAL8ARRAY ( moist_old, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
1886 CALL PUSHREAL8ARRAY ( moist_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
1887 !$OMP PARALLEL DO &
1888 !$OMP PRIVATE ( ij )
1889 DO ij = 1 , grid%num_tiles
1890 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1891 DO im = PARAM_FIRST_SCALAR, num_3d_m
1892 CALL rk_update_scalar_pd( im, im, &
1893 moist_old(ims,kms,jms,im), &
1894 moist_tend(ims,kms,jms,im), &
1895 grid%c1h, grid%c2h, &
1896 grid%mu_1, grid%mu_1, grid%mub, &
1897 rk_step, dt_rk, grid%spec_zone, &
1898 config_flags, &
1899 ids, ide, jds, jde, kds, kde, &
1900 ims, ime, jms, jme, kms, kme, &
1901 grid%i_start(ij), grid%i_end(ij), &
1902 grid%j_start(ij), grid%j_end(ij), &
1903 k_start , k_end )
1905 ENDDO
1906 END DO
1907 !$OMP END PARALLEL DO
1909 !---------------------- positive definite bc call
1910 #ifdef DM_PARALLEL
1911 IF (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) THEN
1912 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1913 # include "HALO_EM_MOIST_OLD_E_5.inc"
1914 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1915 # include "HALO_EM_MOIST_OLD_E_7.inc"
1916 ELSE
1917 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1918 CALL wrf_error_fatal(TRIM(wrf_err_message))
1919 ENDIF
1920 ENDIF
1921 #endif
1923 #ifdef DM_PARALLEL
1924 # include "PERIOD_BDY_EM_MOIST_OLD.inc"
1925 #endif
1927 !$OMP PARALLEL DO &
1928 !$OMP PRIVATE ( ij )
1929 DO ij = 1 , grid%num_tiles
1930 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1931 DO im = PARAM_FIRST_SCALAR , num_3d_m
1932 CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
1933 ids, ide, jds, jde, kds, kde, &
1934 ims, ime, jms, jme, kms, kme, &
1935 ips, ipe, jps, jpe, kps, kpe, &
1936 grid%i_start(ij), grid%i_end(ij), &
1937 grid%j_start(ij), grid%j_end(ij), &
1938 k_start , k_end )
1939 END DO
1940 ENDIF
1941 END DO
1942 !$OMP END PARALLEL DO
1944 END IF ! end if for moist_adv_opt
1946 ! scalars
1948 IF ((config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
1950 !CALL push4backup (grid%mu_1, "mu_1")
1951 !CALL push4backup (scalar_old(:,:,:,:),scalar_tend(:,:,:,:), &
1952 ! "scalar_old,scalar_tend")
1953 !$OMP PARALLEL DO &
1954 !$OMP PRIVATE ( ij )
1955 DO ij = 1 , grid%num_tiles
1956 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1957 DO im = PARAM_FIRST_SCALAR, num_3d_s
1958 CALL rk_update_scalar_pd( im, im, &
1959 scalar_old(ims,kms,jms,im), &
1960 scalar_tend(ims,kms,jms,im), &
1961 grid%c1h, grid%c2h, &
1962 grid%mu_1, grid%mu_1, grid%mub, &
1963 rk_step, dt_rk, grid%spec_zone, &
1964 config_flags, &
1965 ids, ide, jds, jde, kds, kde, &
1966 ims, ime, jms, jme, kms, kme, &
1967 grid%i_start(ij), grid%i_end(ij), &
1968 grid%j_start(ij), grid%j_end(ij), &
1969 k_start , k_end )
1970 ENDDO
1971 ENDDO
1972 !$OMP END PARALLEL DO
1974 !---------------------- positive definite bc call
1975 #ifdef DM_PARALLEL
1976 IF (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) THEN
1977 #ifndef RSL
1978 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1979 # include "HALO_EM_SCALAR_OLD_E_5.inc"
1980 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1981 # include "HALO_EM_SCALAR_OLD_E_7.inc"
1982 ELSE
1983 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1984 CALL wrf_error_fatal(TRIM(wrf_err_message))
1985 ENDIF
1986 #else
1987 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1988 CALL wrf_error_fatal(TRIM(wrf_err_message))
1989 #endif
1990 endif
1991 #endif
1993 #ifdef DM_PARALLEL
1994 # include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1995 #endif
1997 !$OMP PARALLEL DO &
1998 !$OMP PRIVATE ( ij )
2000 DO ij = 1 , grid%num_tiles
2001 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2002 DO im = PARAM_FIRST_SCALAR , num_3d_s
2003 CALL set_physical_bc3d( scalar_old(ims,kms,jms,im), 'p', config_flags, &
2004 ids, ide, jds, jde, kds, kde, &
2005 ims, ime, jms, jme, kms, kme, &
2006 ips, ipe, jps, jpe, kps, kpe, &
2007 grid%i_start(ij), grid%i_end(ij), &
2008 grid%j_start(ij), grid%j_end(ij), &
2009 k_start , k_end )
2010 END DO
2011 ENDIF
2012 END DO
2013 !$OMP END PARALLEL DO
2015 END IF ! end if for scalar_adv_opt
2017 ! chem
2019 IF ((config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
2021 !$OMP PARALLEL DO &
2022 !$OMP PRIVATE ( ij )
2023 DO ij = 1 , grid%num_tiles
2024 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2025 DO im = PARAM_FIRST_SCALAR, num_3d_c
2026 CALL rk_update_scalar_pd( im, im, &
2027 chem_old(ims,kms,jms,im), &
2028 chem_tend(ims,kms,jms,im), &
2029 grid%c1h, grid%c2h, &
2030 grid%mu_1, grid%mu_1, grid%mub, &
2031 rk_step, dt_rk, grid%spec_zone, &
2032 config_flags, &
2033 ids, ide, jds, jde, kds, kde, &
2034 ims, ime, jms, jme, kms, kme, &
2035 grid%i_start(ij), grid%i_end(ij), &
2036 grid%j_start(ij), grid%j_end(ij), &
2037 k_start , k_end )
2038 ENDDO
2039 END DO
2040 !$OMP END PARALLEL DO
2042 !---------------------- positive definite bc call
2043 #ifdef DM_PARALLEL
2044 IF (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) THEN
2045 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2046 # include "HALO_EM_CHEM_OLD_E_5.inc"
2047 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2048 # include "HALO_EM_CHEM_OLD_E_7.inc"
2049 ELSE
2050 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2051 CALL wrf_error_fatal(TRIM(wrf_err_message))
2052 ENDIF
2053 ENDIF
2054 #endif
2056 #ifdef DM_PARALLEL
2057 # include "PERIOD_BDY_EM_CHEM_OLD.inc"
2058 #endif
2060 !$OMP PARALLEL DO &
2061 !$OMP PRIVATE ( ij )
2062 DO ij = 1 , grid%num_tiles
2063 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2064 DO im = PARAM_FIRST_SCALAR , num_3d_c
2066 CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
2067 ids, ide, jds, jde, kds, kde, &
2068 ims, ime, jms, jme, kms, kme, &
2069 ips, ipe, jps, jpe, kps, kpe, &
2070 grid%i_start(ij), grid%i_end(ij), &
2071 grid%j_start(ij), grid%j_end(ij), &
2072 k_start , k_end )
2073 END DO
2074 ENDIF
2075 END DO
2076 !$OMP END PARALLEL DO
2078 ENDIF ! end if for chem_adv_opt
2080 ! tracer
2082 IF ((config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
2084 !$OMP PARALLEL DO &
2085 !$OMP PRIVATE ( ij )
2086 DO ij = 1 , grid%num_tiles
2087 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2088 DO im = PARAM_FIRST_SCALAR, num_tracer
2090 CALL PUSHREAL8ARRAY ( tracer_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_tracer )
2091 CALL rk_update_scalar_pd( im, im, &
2092 tracer_old(ims,kms,jms,im), &
2093 tracer_tend(ims,kms,jms,im), &
2094 grid%c1h, grid%c2h, &
2095 grid%mu_1, grid%mu_1, grid%mub, &
2096 rk_step, dt_rk, grid%spec_zone, &
2097 config_flags, &
2098 ids, ide, jds, jde, kds, kde, &
2099 ims, ime, jms, jme, kms, kme, &
2100 grid%i_start(ij), grid%i_end(ij), &
2101 grid%j_start(ij), grid%j_end(ij), &
2102 k_start , k_end )
2104 ENDDO
2105 END DO
2106 !$OMP END PARALLEL DO
2108 !---------------------- positive definite bc call
2109 #ifdef DM_PARALLEL
2110 IF (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) THEN
2111 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2112 # include "HALO_EM_TRACER_OLD_E_5.inc"
2113 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2114 # include "HALO_EM_TRACER_OLD_E_7.inc"
2115 ELSE
2116 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2117 CALL wrf_error_fatal(TRIM(wrf_err_message))
2118 ENDIF
2119 ENDIF
2120 #endif
2122 #ifdef DM_PARALLEL
2123 # include "PERIOD_BDY_EM_TRACER_OLD.inc"
2124 #endif
2126 !$OMP PARALLEL DO &
2127 !$OMP PRIVATE ( ij )
2128 DO ij = 1 , grid%num_tiles
2129 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2130 DO im = PARAM_FIRST_SCALAR , num_tracer
2132 CALL set_physical_bc3d( tracer_old(ims,kms,jms,im), 'p', config_flags, &
2133 ids, ide, jds, jde, kds, kde, &
2134 ims, ime, jms, jme, kms, kme, &
2135 ips, ipe, jps, jpe, kps, kpe, &
2136 grid%i_start(ij), grid%i_end(ij), &
2137 grid%j_start(ij), grid%j_end(ij), &
2138 k_start , k_end )
2139 END DO
2141 ENDIF
2142 END DO
2143 !$OMP END PARALLEL DO
2145 ENDIF ! end if for tracer_adv_opt
2147 ! tke
2149 IF ((config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order) &
2150 .and. (config_flags%km_opt .eq. 2) ) THEN
2152 !CALL push4backup (grid%mu_1, "mu_1")
2153 !CALL push4backup (grid%tke_1,tke_tend, &
2154 ! "tke_1,tke_tend")
2155 !$OMP PARALLEL DO &
2156 !$OMP PRIVATE ( ij )
2157 DO ij = 1 , grid%num_tiles
2158 CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
2159 CALL rk_update_scalar_pd( 1, 1, &
2160 grid%tke_1, &
2161 tke_tend(ims,kms,jms), &
2162 grid%c1h, grid%c2h, &
2163 grid%mu_1, grid%mu_1, grid%mub, &
2164 rk_step, dt_rk, grid%spec_zone, &
2165 config_flags, &
2166 ids, ide, jds, jde, kds, kde, &
2167 ims, ime, jms, jme, kms, kme, &
2168 grid%i_start(ij), grid%i_end(ij), &
2169 grid%j_start(ij), grid%j_end(ij), &
2170 k_start , k_end )
2171 ENDDO
2172 !$OMP END PARALLEL DO
2175 !---------------------- positive definite bc call
2176 #ifdef DM_PARALLEL
2177 IF (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) THEN
2178 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2179 # include "HALO_EM_TKE_OLD_E_5.inc"
2180 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2181 # include "HALO_EM_TKE_OLD_E_7.inc"
2182 ELSE
2183 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2184 CALL wrf_error_fatal(TRIM(wrf_err_message))
2185 ENDIF
2186 ENDIF
2187 #endif
2189 #ifdef DM_PARALLEL
2190 # include "PERIOD_BDY_EM_TKE_OLD.inc"
2191 #endif
2193 !$OMP PARALLEL DO &
2194 !$OMP PRIVATE ( ij )
2195 DO ij = 1 , grid%num_tiles
2196 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
2197 ids, ide, jds, jde, kds, kde, &
2198 ims, ime, jms, jme, kms, kme, &
2199 ips, ipe, jps, jpe, kps, kpe, &
2200 grid%i_start(ij), grid%i_end(ij), &
2201 grid%j_start(ij), grid%j_end(ij), &
2202 k_start , k_end )
2204 END DO
2205 !$OMP END PARALLEL DO
2207 !--- end of positive definite physics tendency update
2209 END IF ! end if for tke_adv_opt
2211 #ifdef DM_PARALLEL
2212 !
2213 ! Stencils for patch communications (WCS, 29 June 2001)
2214 !
2215 ! * * * * *
2216 ! * * * * *
2217 ! * * + * *
2218 ! * * * * *
2219 ! * * * * *
2220 !
2221 ! ru_m x
2222 ! rv_m x
2223 ! ww_m x
2224 ! mut x
2225 !
2226 !--------------------------------------------------------------
2228 # include "HALO_EM_D.inc"
2229 ! WCS addition 11/19/08
2230 # include "PERIOD_EM_DA.inc"
2231 #endif
2233 !<DESCRIPTION>
2234 !<pre>
2235 ! (4) Still within the RK loop, the scalar variables are advanced.
2236 !
2237 ! For the moist and chem variables, each one is advanced
2238 ! individually, using named loops "moist_variable_loop:"
2239 ! and "chem_variable_loop:". Each RK substep begins by
2240 ! calculating the advective tendency, and, for the first RK step,
2241 ! 3D mixing (calling rk_scalar_tend) followed by an update
2242 ! of the scalar (calling rk_update_scalar).
2243 !</pre>
2244 !</DESCRIPTION>
2247 moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2249 moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
2251 ! adv_moist_cond is set in module_physics_init based on mp_physics choice
2252 ! true except for Ferrier scheme
2254 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
2256 IF ( rk_step == 1 ) CALL push4backup (grid%alt,grid%xkhh, "alt,xkhh")
2257 !CALL push4backup (grid%mu_1,grid%muts, "mu_1,muts")
2258 !CALL push4backup (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
2259 CALL PUSHREAL8ARRAY ( grid%ru_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2260 CALL PUSHREAL8ARRAY ( grid%rv_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2261 CALL PUSHREAL8ARRAY ( grid%ww_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2262 !CALL push4backup (moist(:,:,:,im),moist_old(:,:,:,im), &
2263 ! "moist,moist_old")
2264 CALL PUSHREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2265 CALL PUSHREAL8ARRAY ( moist_old(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2266 !IF( rk_step == 1 )THEN
2267 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2268 ! CALL PUSHREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2269 ! END IF
2270 !END IF
2271 !$OMP PARALLEL DO &
2272 !$OMP PRIVATE ( ij, tenddec )
2273 moist_tile_loop_1: DO ij = 1 , grid%num_tiles
2275 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2276 tenddec = .false.
2278 BENCH_START(rk_scalar_tend_tim)
2279 CALL rk_scalar_tend ( im, im, config_flags, tenddec, &
2280 rk_step, dt_rk, &
2281 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2282 grid%u_1, grid%v_1, &
2283 grid%muts, grid%mub, grid%mu_1, &
2284 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2285 grid%alt, &
2286 moist_old(ims,kms,jms,im), &
2287 moist(ims,kms,jms,im), &
2288 moist_tend(ims,kms,jms,im), &
2289 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2290 grid%qv_base, .true., grid%fnm, grid%fnp, &
2291 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
2292 grid%msfvy, grid%msftx,grid%msfty, &
2293 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2294 grid%kvdif, grid%xkhh, &
2295 grid%diff_6th_opt, grid%diff_6th_factor, &
2296 config_flags%moist_adv_opt, &
2297 grid%phb, grid%ph_2, &
2298 config_flags%moist_mix2_off, &
2299 config_flags%moist_mix6_off, &
2300 ids, ide, jds, jde, kds, kde, &
2301 ims, ime, jms, jme, kms, kme, &
2302 grid%i_start(ij), grid%i_end(ij), &
2303 grid%j_start(ij), grid%j_end(ij), &
2304 k_start , k_end )
2306 ! IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
2307 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2308 ! CALL q_diabatic_add ( im, im, &
2309 ! dt_rk, grid%mut, &
2310 ! grid%c1h, grid%c2h, &
2311 ! grid%qv_diabatic, &
2312 ! grid%qc_diabatic, &
2313 ! moist_tend(ims,kms,jms,im), &
2314 ! ids, ide, jds, jde, kds, kde, &
2315 ! ims, ime, jms, jme, kms, kme, &
2316 ! grid%i_start(ij), grid%i_end(ij), &
2317 ! grid%j_start(ij), grid%j_end(ij), &
2318 ! k_start , k_end )
2319 ! ENDIF
2320 ! ENDIF
2322 BENCH_END(rk_scalar_tend_tim)
2324 BENCH_START(rlx_bdy_scalar_tim)
2325 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
2326 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
2328 !CALL push4backup (grid%mut, "mut")
2329 CALL PUSHREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
2330 !CALL push4backup (moist(:,:,:,im), "moist")
2331 CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2332 moist(ims,kms,jms,im), grid%mut, &
2333 grid%c1h, grid%c2h, &
2334 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2335 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2336 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2337 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2338 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2339 grid%dtbc, grid%fcx, grid%gcx, &
2340 config_flags, &
2341 ids,ide, jds,jde, kds,kde, & ! domain dims
2342 ims,ime, jms,jme, kms,kme, & ! memory dims
2343 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2344 grid%i_start(ij), grid%i_end(ij), &
2345 grid%j_start(ij), grid%j_end(ij), &
2346 k_start, k_end )
2348 CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
2349 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
2350 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
2351 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
2352 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
2353 config_flags%spec_bdy_width, grid%spec_zone, &
2354 config_flags, &
2355 ids,ide, jds,jde, kds,kde, & ! domain dims
2356 ims,ime, jms,jme, kms,kme, & ! memory dims
2357 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2358 grid%i_start(ij), grid%i_end(ij), &
2359 grid%j_start(ij), grid%j_end(ij), &
2360 k_start, k_end )
2361 ENDIF
2362 ENDIF
2363 BENCH_END(rlx_bdy_scalar_tim)
2365 ENDDO moist_tile_loop_1
2366 !$OMP END PARALLEL DO
2368 !CALL push4backup ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
2369 IF ( rk_step == 1 ) THEN
2370 !CALL push4backup ( moist(:,:,:,im),moist_tend(:,:,:,im),advect_tend, &
2371 ! "moist,moist_tend,advect_tend" )
2372 CALL PUSHREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2373 CALL PUSHREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2374 CALL PUSHREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2375 ELSE
2376 !IF( rk_step == rk_order )THEN
2377 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2378 ! CALL PUSHREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2379 ! END IF
2380 !END IF
2381 !CALL push4backup ( moist_old(:,:,:,im),moist_tend(:,:,:,im),advect_tend, &
2382 ! "moist_old,moist_tend,advect_tend" )
2383 CALL PUSHREAL8ARRAY ( moist_old(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2384 CALL PUSHREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2385 CALL PUSHREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2386 END IF
2387 !$OMP PARALLEL DO &
2388 !$OMP PRIVATE ( ij, tenddec )
2389 moist_tile_loop_2: DO ij = 1 , grid%num_tiles
2391 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2392 tenddec = .false.
2394 BENCH_START(update_scal_tim)
2396 CALL rk_update_scalar( scs=im, sce=im, &
2397 scalar_1=moist_old(ims,kms,jms,im), &
2398 scalar_2=moist(ims,kms,jms,im), &
2399 sc_tend=moist_tend(ims,kms,jms,im), &
2400 advect_tend=advect_tend, &
2401 h_tendency=h_tendency, z_tendency=z_tendency, &
2402 msftx=grid%msftx,msfty=grid%msfty, &
2403 c1=grid%c1h, c2=grid%c2h, &
2404 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2405 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2406 config_flags=config_flags, tenddec=tenddec, &
2407 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2408 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2409 its=grid%i_start(ij), ite=grid%i_end(ij), &
2410 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2411 kts=k_start , kte=k_end )
2413 ! IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
2414 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
2415 ! CALL q_diabatic_subtr( im, im, &
2416 ! dt_rk, &
2417 ! grid%qv_diabatic, &
2418 ! grid%qc_diabatic, &
2419 ! moist(ims,kms,jms,im), &
2420 ! ids, ide, jds, jde, kds, kde, &
2421 ! ims, ime, jms, jme, kms, kme, &
2422 ! grid%i_start(ij), grid%i_end(ij), &
2423 ! grid%j_start(ij), grid%j_end(ij), &
2424 ! k_start , k_end )
2425 ! ENDIF
2426 ! ENDIF
2428 BENCH_END(update_scal_tim)
2430 BENCH_START(flow_depbdy_tim)
2431 IF( config_flags%specified ) THEN
2432 IF(im .ne. P_QV)THEN
2434 !CALL push4backup ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
2435 CALL PUSHREAL8ARRAY ( grid%ru_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2436 CALL PUSHREAL8ARRAY ( grid%rv_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2437 CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
2438 grid%ru_m, grid%rv_m, config_flags, &
2439 grid%spec_zone, &
2440 ids,ide, jds,jde, kds,kde, &
2441 ims,ime, jms,jme, kms,kme, &
2442 ips,ipe, jps,jpe, kps,kpe, &
2443 grid%i_start(ij), grid%i_end(ij), &
2444 grid%j_start(ij), grid%j_end(ij), &
2445 k_start, k_end )
2447 ENDIF
2448 ENDIF
2449 BENCH_END(flow_depbdy_tim)
2451 ENDDO moist_tile_loop_2
2452 !$OMP END PARALLEL DO
2454 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
2456 ENDDO moist_variable_loop
2458 ENDIF moist_scalar_advance
2460 BENCH_START(tke_adv_tim)
2461 TKE_advance: IF (config_flags%km_opt .eq. 2) then
2462 #ifdef DM_PARALLEL
2463 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2464 # include "HALO_EM_TKE_ADVECT_3.inc"
2465 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2466 # include "HALO_EM_TKE_ADVECT_5.inc"
2467 ELSE
2468 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2469 CALL wrf_error_fatal(TRIM(wrf_err_message))
2470 ENDIF
2471 #endif
2473 !IF ( rk_step == 1 ) CALL push4backup (grid%alt,grid%xkhh, "alt,xkhh")
2474 !CALL push4backup (grid%mu_1,grid%muts, "mu_1,muts")
2475 !CALL push4backup (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
2476 CALL PUSHREAL8ARRAY ( grid%ru_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2477 CALL PUSHREAL8ARRAY ( grid%rv_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2478 CALL PUSHREAL8ARRAY ( grid%ww_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2479 !CALL push4backup (grid%tke_2,grid%tke_1, "tke_2,tke_1")
2480 !$OMP PARALLEL DO &
2481 !$OMP PRIVATE ( ij, tenddec )
2482 tke_tile_loop_1: DO ij = 1 , grid%num_tiles
2484 CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
2485 tenddec = .false.
2486 CALL rk_scalar_tend ( 1, 1, config_flags, tenddec, &
2487 rk_step, dt_rk, &
2488 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2489 grid%u_1, grid%v_1, &
2490 grid%muts, grid%mub, grid%mu_1, &
2491 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2492 grid%alt, &
2493 grid%tke_1, &
2494 grid%tke_2, &
2495 tke_tend(ims,kms,jms), &
2496 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2497 grid%qv_base, .false., grid%fnm, grid%fnp, &
2498 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2499 grid%msfvy, grid%msftx,grid%msfty, &
2500 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
2501 grid%kvdif, grid%xkhh, &
2502 grid%diff_6th_opt, grid%diff_6th_factor, &
2503 config_flags%tke_adv_opt, &
2504 grid%phb, grid%ph_2, &
2505 config_flags%tke_mix2_off, &
2506 config_flags%tke_mix6_off, &
2507 ids, ide, jds, jde, kds, kde, &
2508 ims, ime, jms, jme, kms, kme, &
2509 grid%i_start(ij), grid%i_end(ij), &
2510 grid%j_start(ij), grid%j_end(ij), &
2511 k_start , k_end )
2513 ENDDO tke_tile_loop_1
2514 !$OMP END PARALLEL DO
2517 !CALL push4backup ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
2518 !IF ( rk_step == 1 ) THEN
2519 ! CALL push4backup ( grid%tke_2,tke_tend,advect_tend, &
2520 ! "tke_2,tke_tend,advect_tend" )
2521 !ELSE
2522 ! CALL push4backup ( grid%tke_1,tke_tend,advect_tend, &
2523 ! "tke_1,tke_tend,advect_tend" )
2524 !END IF
2525 !$OMP PARALLEL DO &
2526 !$OMP PRIVATE ( ij, tenddec )
2527 tke_tile_loop_2: DO ij = 1 , grid%num_tiles
2529 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2530 tenddec = .false.
2531 CALL rk_update_scalar( scs=1, sce=1, &
2532 scalar_1=grid%tke_1, &
2533 scalar_2=grid%tke_2, &
2534 sc_tend=tke_tend(ims,kms,jms), &
2535 advect_tend=advect_tend, &
2536 h_tendency=h_tendency, z_tendency=z_tendency, &
2537 msftx=grid%msftx,msfty=grid%msfty, &
2538 c1=grid%c1h, c2=grid%c2h, &
2539 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2540 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2541 config_flags=config_flags, tenddec=tenddec, &
2542 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2543 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2544 its=grid%i_start(ij), ite=grid%i_end(ij), &
2545 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2546 kts=k_start , kte=k_end )
2548 ! bound the tke (greater than 0, less than tke_upper_bound)
2550 !CALL push4backup (grid%tke_2, "tke")
2551 CALL bound_tke( grid%tke_2, grid%tke_upper_bound, &
2552 ids, ide, jds, jde, kds, kde, &
2553 ims, ime, jms, jme, kms, kme, &
2554 grid%i_start(ij), grid%i_end(ij), &
2555 grid%j_start(ij), grid%j_end(ij), &
2556 k_start , k_end )
2558 IF( config_flags%specified .or. config_flags%nested ) THEN
2559 !CALL push4backup ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
2560 CALL flow_dep_bdy ( grid%tke_2, &
2561 grid%ru_m, grid%rv_m, config_flags, &
2562 grid%spec_zone, &
2563 ids,ide, jds,jde, kds,kde, & ! domain dims
2564 ims,ime, jms,jme, kms,kme, & ! memory dims
2565 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2566 grid%i_start(ij), grid%i_end(ij), &
2567 grid%j_start(ij), grid%j_end(ij), &
2568 k_start, k_end )
2569 ENDIF
2570 ENDDO tke_tile_loop_2
2571 !$OMP END PARALLEL DO
2574 ENDIF TKE_advance
2575 BENCH_END(tke_adv_tim)
2577 #if (WRF_CHEM==1)
2578 ! next the chemical species
2579 BENCH_START(chem_adv_tim)
2580 chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2582 chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
2584 !$OMP PARALLEL DO &
2585 !$OMP PRIVATE ( ij, tenddec )
2586 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
2588 CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
2590 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2591 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2592 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2593 rk_step, dt_rk, &
2594 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2595 grid%u_1, grid%v_1, &
2596 grid%muts, grid%mub, grid%mu_1, &
2597 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2598 grid%alt, &
2599 chem_old(ims,kms,jms,ic), &
2600 chem(ims,kms,jms,ic), &
2601 chem_tend(ims,kms,jms,ic), &
2602 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2603 grid%qv_base, .false., grid%fnm, grid%fnp, &
2604 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2605 grid%msfvy, grid%msftx,grid%msfty, &
2606 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2607 grid%khdif, grid%kvdif, grid%xkhh, &
2608 grid%diff_6th_opt, grid%diff_6th_factor, &
2609 config_flags%chem_adv_opt, &
2610 grid%phb, grid%ph_2, &
2611 config_flags%chem_mix2_off, &
2612 config_flags%chem_mix6_off, &
2613 ids, ide, jds, jde, kds, kde, &
2614 ims, ime, jms, jme, kms, kme, &
2615 grid%i_start(ij), grid%i_end(ij), &
2616 grid%j_start(ij), grid%j_end(ij), &
2617 k_start , k_end )
2619 !
2620 ! Currently, chemistry species with specified boundaries (i.e. the mother
2621 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2622 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2623 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2624 !
2625 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2626 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2628 CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2629 chem(ims,kms,jms,ic), grid%mut, &
2630 grid%c1h, grid%c2h, &
2631 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2632 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2633 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2634 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2635 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2636 grid%dtbc, grid%fcx, grid%gcx, &
2637 config_flags, &
2638 ids,ide, jds,jde, kds,kde, &
2639 ims,ime, jms,jme, kms,kme, &
2640 ips,ipe, jps,jpe, kps,kpe, &
2641 grid%i_start(ij), grid%i_end(ij), &
2642 grid%j_start(ij), grid%j_end(ij), &
2643 k_start, k_end )
2645 CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2646 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2647 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2648 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2649 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2650 config_flags%spec_bdy_width, grid%spec_zone, &
2651 config_flags, &
2652 ids,ide, jds,jde, kds,kde, &
2653 ims,ime, jms,jme, kms,kme, &
2654 ips,ipe, jps,jpe, kps,kpe, &
2655 grid%i_start(ij), grid%i_end(ij), &
2656 grid%j_start(ij), grid%j_end(ij), &
2657 k_start, k_end )
2659 ENDIF
2661 ENDDO chem_tile_loop_1
2662 !$OMP END PARALLEL DO
2664 !$OMP PARALLEL DO &
2665 !$OMP PRIVATE ( ij, tenddec )
2667 chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2669 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2671 tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
2672 ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
2673 CALL rk_update_scalar( scs=ic, sce=ic, &
2674 scalar_1=chem_old(ims,kms,jms,ic), &
2675 scalar_2=chem(ims,kms,jms,ic), &
2676 sc_tend=chem_tend(ims,kms,jms,ic), &
2677 advect_tend=advect_tend, &
2678 h_tendency=h_tendency, z_tendency=z_tendency, &
2679 msftx=grid%msftx,msfty=grid%msfty, &
2680 c1=grid%c1h, c2=grid%c2h, &
2681 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2682 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2683 config_flags=config_flags, tenddec=tenddec, &
2684 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2685 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2686 its=grid%i_start(ij), ite=grid%i_end(ij), &
2687 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2688 kts=k_start , kte=k_end )
2690 IF( config_flags%specified ) THEN
2692 CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2693 chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2694 chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2695 chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2696 chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2697 dt_rk+grid%dtbc, &
2698 config_flags%spec_bdy_width,grid%z, &
2699 grid%have_bcs_chem, &
2700 grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2701 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2702 grid%spec_zone,ic, &
2703 ids,ide, jds,jde, kds,kde, & ! domain dims
2704 ims,ime, jms,jme, kms,kme, & ! memory dims
2705 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2706 grid%i_start(ij), grid%i_end(ij), &
2707 grid%j_start(ij), grid%j_end(ij), &
2708 k_start, k_end )
2710 ENDIF
2711 ENDDO chem_tile_loop_2
2712 !$OMP END PARALLEL DO
2714 ENDDO chem_variable_loop
2715 ENDIF chem_scalar_advance
2716 BENCH_END(chem_adv_tim)
2717 #endif
2719 ! next the chemical species
2720 BENCH_START(tracer_adv_tim)
2721 tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
2723 tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
2725 CALL PUSHREAL8ARRAY ( grid%ru_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2726 CALL PUSHREAL8ARRAY ( grid%rv_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2727 CALL PUSHREAL8ARRAY ( grid%ww_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2728 CALL PUSHREAL8ARRAY ( tracer(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2729 !$OMP PARALLEL DO &
2730 !$OMP PRIVATE ( ij, tenddec )
2731 tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
2733 CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
2735 tenddec = .false.
2736 CALL rk_scalar_tend ( ic, ic, config_flags, tenddec, &
2737 rk_step, dt_rk, &
2738 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2739 grid%u_1, grid%v_1, &
2740 grid%muts, grid%mub, grid%mu_1, &
2741 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2742 grid%alt, &
2743 tracer_old(ims,kms,jms,ic), &
2744 tracer(ims,kms,jms,ic), &
2745 tracer_tend(ims,kms,jms,ic), &
2746 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2747 grid%qv_base, .false., grid%fnm, grid%fnp, &
2748 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2749 grid%msfvy, grid%msftx,grid%msfty, &
2750 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2751 grid%khdif, grid%kvdif, grid%xkhh, &
2752 grid%diff_6th_opt, grid%diff_6th_factor, &
2753 config_flags%tracer_adv_opt, &
2754 grid%phb, grid%ph_2, &
2755 config_flags%tracer_mix2_off, &
2756 config_flags%tracer_mix6_off, &
2757 ids, ide, jds, jde, kds, kde, &
2758 ims, ime, jms, jme, kms, kme, &
2759 grid%i_start(ij), grid%i_end(ij), &
2760 grid%j_start(ij), grid%j_end(ij), &
2761 k_start , k_end )
2764 !
2765 ! Currently, chemistry species with specified boundaries (i.e. the mother
2766 ! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2767 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2768 ! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2769 !
2770 IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2771 IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
2773 CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2774 tracer(ims,kms,jms,ic), grid%mut, &
2775 grid%c1h, grid%c2h, &
2776 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2777 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2778 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2779 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2780 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2781 grid%dtbc, grid%fcx, grid%gcx, &
2782 config_flags, &
2783 ids,ide, jds,jde, kds,kde, &
2784 ims,ime, jms,jme, kms,kme, &
2785 ips,ipe, jps,jpe, kps,kpe, &
2786 grid%i_start(ij), grid%i_end(ij), &
2787 grid%j_start(ij), grid%j_end(ij), &
2788 k_start, k_end )
2790 CALL spec_bdy_scalar ( tracer_tend(ims,kms,jms,ic), &
2791 tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), &
2792 tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), &
2793 tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), &
2794 tracer_btys(ims,kms,1,ic),tracer_btye(ims,kms,1,ic), &
2795 config_flags%spec_bdy_width, grid%spec_zone, &
2796 config_flags, &
2797 ids,ide, jds,jde, kds,kde, &
2798 ims,ime, jms,jme, kms,kme, &
2799 ips,ipe, jps,jpe, kps,kpe, &
2800 grid%i_start(ij), grid%i_end(ij), &
2801 grid%j_start(ij), grid%j_end(ij), &
2802 k_start, k_end )
2804 ENDIF
2806 ENDDO tracer_tile_loop_1
2807 !$OMP END PARALLEL DO
2809 !$OMP PARALLEL DO &
2810 !$OMP PRIVATE ( ij, tenddec )
2812 tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
2814 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2816 tenddec = .false.
2817 IF ( rk_step == 1 ) THEN
2818 CALL PUSHREAL8ARRAY ( tracer_tend(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2819 CALL PUSHREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2820 ELSE
2821 CALL PUSHREAL8ARRAY ( tracer_tend(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2822 CALL PUSHREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
2823 END IF
2824 CALL rk_update_scalar( scs=ic, sce=ic, &
2825 scalar_1=tracer_old(ims,kms,jms,ic), &
2826 scalar_2=tracer(ims,kms,jms,ic), &
2827 sc_tend=tracer_tend(ims,kms,jms,ic), &
2828 advect_tend=advect_tend, &
2829 h_tendency=h_tendency, z_tendency=z_tendency, &
2830 msftx=grid%msftx,msfty=grid%msfty, &
2831 c1=grid%c1h, c2=grid%c2h, &
2832 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2833 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2834 config_flags=config_flags, tenddec=tenddec, &
2835 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2836 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2837 its=grid%i_start(ij), ite=grid%i_end(ij), &
2838 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2839 kts=k_start , kte=k_end )
2841 IF( config_flags%specified ) THEN
2842 #if (WRF_CHEM==1)
2844 CALL flow_dep_bdy_tracer( tracer(ims,kms,jms,ic), &
2845 tracer_bxs(jms,kms,1,ic), tracer_btxs(jms,kms,1,ic), &
2846 tracer_bxe(jms,kms,1,ic), tracer_btxe(jms,kms,1,ic), &
2847 tracer_bys(ims,kms,1,ic), tracer_btys(ims,kms,1,ic), &
2848 tracer_bye(ims,kms,1,ic), tracer_btye(ims,kms,1,ic), &
2849 dt_rk+grid%dtbc, &
2850 config_flags%spec_bdy_width,grid%z, &
2851 grid%have_bcs_tracer, &
2852 grid%ru_m, grid%rv_m, config_flags%tracer_opt,grid%alt, &
2853 grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2854 grid%spec_zone,ic, &
2855 ids,ide, jds,jde, kds,kde, & ! domain dims
2856 ims,ime, jms,jme, kms,kme, & ! memory dims
2857 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2858 grid%i_start(ij), grid%i_end(ij), &
2859 grid%j_start(ij), grid%j_end(ij), &
2860 k_start, k_end )
2862 #else
2863 CALL flow_dep_bdy ( tracer(ims,kms,jms,ic), &
2864 grid%ru_m, grid%rv_m, config_flags, &
2865 grid%spec_zone, &
2866 ids,ide, jds,jde, kds,kde, & ! domain dims
2867 ims,ime, jms,jme, kms,kme, & ! memory dims
2868 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2869 grid%i_start(ij), grid%i_end(ij), &
2870 grid%j_start(ij), grid%j_end(ij), &
2871 k_start, k_end )
2872 #endif
2873 ENDIF
2874 ENDDO tracer_tile_loop_2
2875 !$OMP END PARALLEL DO
2877 ENDDO tracer_variable_loop
2878 ENDIF tracer_advance
2879 BENCH_END(tracer_adv_tim)
2881 ! next the other scalar species
2882 other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2884 scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2885 !IF ( rk_step == 1 ) CALL push4backup (grid%alt,grid%xkhh, "alt,xkhh")
2886 !CALL push4backup (grid%mu_1,grid%muts, "mu_1,muts")
2887 !CALL push4backup (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
2888 !CALL push4backup (scalar(:,:,:,is),scalar_old(:,:,:,is), &
2889 ! "scalar,scalar_old")
2890 !OMP PARALLEL DO &
2891 !OMP PRIVATE ( ij, tenddec )
2892 scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2894 CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2896 tenddec = .false.
2897 CALL rk_scalar_tend ( is, is, config_flags, tenddec, &
2898 rk_step, dt_rk, &
2899 grid%ru_m, grid%rv_m, grid%ww_m, wwE, wwI, &
2900 grid%u_1, grid%v_1, &
2901 grid%muts, grid%mub, grid%mu_1, &
2902 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
2903 grid%alt, &
2904 scalar_old(ims,kms,jms,is), &
2905 scalar(ims,kms,jms,is), &
2906 scalar_tend(ims,kms,jms,is), &
2907 advect_tend,h_tendency,z_tendency,grid%rqvften, &
2908 grid%qv_base, .false., grid%fnm, grid%fnp, &
2909 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2910 grid%msfvy, grid%msftx,grid%msfty, &
2911 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2912 grid%khdif, grid%kvdif, grid%xkhh, &
2913 grid%diff_6th_opt, grid%diff_6th_factor, &
2914 config_flags%scalar_adv_opt, &
2915 grid%phb, grid%ph_2, &
2916 config_flags%scalar_mix2_off, &
2917 config_flags%scalar_mix6_off, &
2918 ids, ide, jds, jde, kds, kde, &
2919 ims, ime, jms, jme, kms, kme, &
2920 grid%i_start(ij), grid%i_end(ij), &
2921 grid%j_start(ij), grid%j_end(ij), &
2922 k_start , k_end )
2924 IF( config_flags%nested .and. (rk_step == 1) ) THEN
2926 !CALL push4backup (grid%mut, "mut")
2927 !CALL push4backup (scalar(:,:,:,is), "scalar")
2928 CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2929 scalar(ims,kms,jms,is), grid%mut, &
2930 grid%c1h, grid%c2h, &
2931 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2932 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2933 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2934 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2935 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2936 grid%dtbc, grid%fcx, grid%gcx, &
2937 config_flags, &
2938 ids,ide, jds,jde, kds,kde, &
2939 ims,ime, jms,jme, kms,kme, &
2940 ips,ipe, jps,jpe, kps,kpe, &
2941 grid%i_start(ij), grid%i_end(ij), &
2942 grid%j_start(ij), grid%j_end(ij), &
2943 k_start, k_end )
2945 CALL spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2946 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2947 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2948 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2949 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2950 config_flags%spec_bdy_width, grid%spec_zone, &
2951 config_flags, &
2952 ids,ide, jds,jde, kds,kde, &
2953 ims,ime, jms,jme, kms,kme, &
2954 ips,ipe, jps,jpe, kps,kpe, &
2955 grid%i_start(ij), grid%i_end(ij), &
2956 grid%j_start(ij), grid%j_end(ij), &
2957 k_start, k_end )
2959 ENDIF ! b.c test for chem nested boundary condition
2961 ENDDO scalar_tile_loop_1
2962 !OMP END PARALLEL DO
2964 !CALL push4backup ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
2965 !IF ( rk_step == 1 ) THEN
2966 ! CALL push4backup ( scalar(:,:,:,is),scalar_tend(:,:,:,is),advect_tend, &
2967 ! "scalar,scalar_tend,advect_tend" )
2968 !ELSE
2969 ! CALL push4backup ( scalar_old(:,:,:,is),scalar_tend(:,:,:,is),advect_tend, &
2970 ! "scalar_old,scalar_tend,advect_tend" )
2971 !END IF
2972 !OMP PARALLEL DO &
2973 !OMP PRIVATE ( ij, tenddec )
2974 scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2976 CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2978 tenddec = .false.
2979 CALL rk_update_scalar( scs=is, sce=is, &
2980 scalar_1=scalar_old(ims,kms,jms,is), &
2981 scalar_2=scalar(ims,kms,jms,is), &
2982 sc_tend=scalar_tend(ims,kms,jms,is), &
2983 advect_tend=advect_tend, &
2984 h_tendency=h_tendency, z_tendency=z_tendency, &
2985 msftx=grid%msftx,msfty=grid%msfty, &
2986 c1=grid%c1h, c2=grid%c2h, &
2987 mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, &
2988 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
2989 config_flags=config_flags, tenddec=tenddec, &
2990 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
2991 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
2992 its=grid%i_start(ij), ite=grid%i_end(ij), &
2993 jts=grid%j_start(ij), jte=grid%j_end(ij), &
2994 kts=k_start , kte=k_end )
2996 IF( config_flags%specified ) THEN
2997 IF (is.EQ.P_QDCN.OR.is.EQ.P_QTCN.OR.is.EQ.P_QNIN) THEN ! for ntu3m
2998 CALL flow_dep_bdy_fixed_inflow(scalar(ims,kms,jms,is),&
2999 grid%ru_m,grid%rv_m, &
3000 config_flags,grid%spec_zone,ids,&
3001 ide,jds,jde,kds,kde,ims,ime,jms,&
3002 jme,kms,kme,ips,ipe,jps,jpe,kps,&
3003 kpe,grid%i_start(ij), &
3004 grid%i_end(ij),grid%j_start(ij),&
3005 grid%j_end(ij),k_start,k_end)
3006 ELSEIF (is.EQ.P_QNN) THEN
3007 CALL flow_dep_bdy_qnn(scalar(ims,kms,jms,is), &
3008 grid%ru_m,grid%rv_m, &
3009 config_flags,grid%spec_zone, &
3010 grid%ccn_conc,ids,ide,jds,jde, &
3011 kds,kde,ims,ime,jms,jme,kms,kme,&
3012 ips,ipe,jps,jpe,kps,kpe, &
3013 grid%i_start(ij),grid%i_end(ij),&
3014 grid%j_start(ij),grid%j_end(ij),&
3015 k_start,k_end)
3016 ELSE
3017 CALL flow_dep_bdy(scalar(ims,kms,jms,is),grid%ru_m, &
3018 grid%rv_m,config_flags, &
3019 grid%spec_zone,ids,ide,jds,jde,kds, &
3020 kde,ims,ime,jms,jme,kms,kme,ips,ipe,&
3021 jps,jpe,kps,kpe,grid%i_start(ij), &
3022 grid%i_end(ij),grid%j_start(ij), &
3023 grid%j_end(ij),k_start,k_end) ! for ntu3m
3024 ! IF(is .ne. P_QNN)THEN ! for ntu3m
3025 ! !CALL push4backup ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
3026 ! CALL flow_dep_bdy ( scalar(ims,kms,jms,is), &
3027 ! grid%ru_m, grid%rv_m, config_flags, &
3028 ! grid%spec_zone, &
3029 ! ids,ide, jds,jde, kds,kde, & ! domain dims
3030 ! ims,ime, jms,jme, kms,kme, & ! memory dims
3031 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3032 ! grid%i_start(ij), grid%i_end(ij), &
3033 ! grid%j_start(ij), grid%j_end(ij), &
3034 ! k_start, k_end )
3035 ! ELSE
3036 ! CALL flow_dep_bdy_qnn ( scalar(ims,kms,jms,is), &
3037 ! grid%ru_m, grid%rv_m, config_flags, &
3038 ! grid%spec_zone, &
3039 ! grid%ccn_conc, & ! RAS
3040 ! ids,ide, jds,jde, kds,kde, & ! domain dims
3041 ! ims,ime, jms,jme, kms,kme, & ! memory dims
3042 ! ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3043 ! grid%i_start(ij), grid%i_end(ij), &
3044 ! grid%j_start(ij), grid%j_end(ij), &
3045 ! k_start, k_end ) ! for ntu3m
3046 ENDIF
3048 ENDIF
3050 ENDDO scalar_tile_loop_2
3051 !OMP END PARALLEL DO
3053 ENDDO scalar_variable_loop
3055 ENDIF other_scalar_advance
3057 ! update the pressure and density at the new time level
3060 !CALL push4backup (grid%mu_2,grid%muts, "mu,muts")
3061 CALL PUSHREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
3062 CALL PUSHREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
3063 !CALL push4backup (grid%ph_2,grid%t_2, "ph,t")
3064 !CALL push4backup (moist, "moist")
3065 !$OMP PARALLEL DO &
3066 !$OMP PRIVATE ( ij )
3067 DO ij = 1 , grid%num_tiles
3069 BENCH_START(calc_p_rho_tim)
3071 CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, &
3072 grid%al, grid%alb, grid%mu_2, grid%muts, &
3073 grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
3074 grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, &
3075 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
3076 grid%rdn, config_flags%non_hydrostatic, config_flags%use_theta_m, &
3077 ids, ide, jds, jde, kds, kde, &
3078 ims, ime, jms, jme, kms, kme, &
3079 grid%i_start(ij), grid%i_end(ij), &
3080 grid%j_start(ij), grid%j_end(ij), &
3081 k_start , k_end )
3083 BENCH_END(calc_p_rho_tim)
3085 ENDDO
3086 !$OMP END PARALLEL DO
3088 ! Reset the boundary conditions if there is another corrector step.
3089 ! (rk_step < rk_order), else we'll handle it at the end of everything
3090 ! (after the split physics, before exiting the timestep).
3092 rk_step_1_check: IF ( rk_step < rk_order ) THEN
3094 !-----------------------------------------------------------
3095 ! rk3 substep polar filter for scalars (moist,chem,scalar)
3096 !-----------------------------------------------------------
3098 IF (config_flags%polar) THEN
3099 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
3100 CALL wrf_debug ( 200 , ' call filter moist ' )
3101 DO im = PARAM_FIRST_SCALAR, num_3d_m
3102 IF ( config_flags%coupled_filtering ) THEN
3103 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
3104 ,MU=grid%mu_2 , MUB=grid%mub &
3105 ,C1=grid%c1h , C2=grid%c2h &
3106 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3107 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3108 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3109 END IF
3110 CALL pxft ( grid=grid &
3111 ,lineno=__LINE__ &
3112 ,flag_uv = 0 &
3113 ,flag_rurv = 0 &
3114 ,flag_wph = 0 &
3115 ,flag_ww = 0 &
3116 ,flag_t = 0 &
3117 ,flag_mu = 0 &
3118 ,flag_mut = 0 &
3119 ,flag_moist = im &
3120 ,flag_chem = 0 &
3121 ,flag_scalar = 0 &
3122 ,flag_tracer = 0 &
3123 ,actual_distance_average=config_flags%actual_distance_average&
3124 ,pos_def = config_flags%pos_def &
3125 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3126 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3127 ,fft_filter_lat = config_flags%fft_filter_lat &
3128 ,dclat = dclat &
3129 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3130 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3131 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3132 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3133 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3134 IF ( config_flags%coupled_filtering ) THEN
3135 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
3136 ,MU=grid%mu_2 , MUB=grid%mub &
3137 ,C1=grid%c1h , C2=grid%c2h &
3138 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3139 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3140 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3141 END IF
3142 END DO
3143 END IF
3145 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
3146 CALL wrf_debug ( 200 , ' call filter chem ' )
3147 DO im = PARAM_FIRST_SCALAR, num_3d_c
3148 IF ( config_flags%coupled_filtering ) THEN
3149 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
3150 ,MU=grid%mu_2 , MUB=grid%mub &
3151 ,C1=grid%c1h , C2=grid%c2h &
3152 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3153 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3154 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3155 END IF
3156 CALL pxft ( grid=grid &
3157 ,lineno=__LINE__ &
3158 ,flag_uv = 0 &
3159 ,flag_rurv = 0 &
3160 ,flag_wph = 0 &
3161 ,flag_ww = 0 &
3162 ,flag_t = 0 &
3163 ,flag_mu = 0 &
3164 ,flag_mut = 0 &
3165 ,flag_moist = 0 &
3166 ,flag_chem = im &
3167 ,flag_tracer = 0 &
3168 ,flag_scalar = 0 &
3169 ,actual_distance_average=config_flags%actual_distance_average&
3170 ,pos_def = config_flags%pos_def &
3171 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3172 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3173 ,fft_filter_lat = config_flags%fft_filter_lat &
3174 ,dclat = dclat &
3175 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3176 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3177 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3178 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3179 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3180 IF ( config_flags%coupled_filtering ) THEN
3181 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
3182 ,MU=grid%mu_2 , MUB=grid%mub &
3183 ,C1=grid%c1h , C2=grid%c2h &
3184 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3185 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3186 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3187 END IF
3188 END DO
3189 END IF
3190 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3191 CALL wrf_debug ( 200 , ' call filter tracer ' )
3192 DO im = PARAM_FIRST_SCALAR, num_tracer
3193 IF ( config_flags%coupled_filtering ) THEN
3194 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
3195 ,MU=grid%mu_2 , MUB=grid%mub &
3196 ,C1=grid%c1h , C2=grid%c2h &
3197 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3198 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3199 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3200 END IF
3201 CALL pxft ( grid=grid &
3202 ,lineno=__LINE__ &
3203 ,flag_uv = 0 &
3204 ,flag_rurv = 0 &
3205 ,flag_wph = 0 &
3206 ,flag_ww = 0 &
3207 ,flag_t = 0 &
3208 ,flag_mu = 0 &
3209 ,flag_mut = 0 &
3210 ,flag_moist = 0 &
3211 ,flag_chem = 0 &
3212 ,flag_tracer = im &
3213 ,flag_scalar = 0 &
3214 ,actual_distance_average=config_flags%actual_distance_average&
3215 ,pos_def = config_flags%pos_def &
3216 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3217 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3218 ,fft_filter_lat = config_flags%fft_filter_lat &
3219 ,dclat = dclat &
3220 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3221 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3222 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3223 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3224 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3225 IF ( config_flags%coupled_filtering ) THEN
3226 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
3227 ,MU=grid%mu_2 , MUB=grid%mub &
3228 ,C1=grid%c1h , C2=grid%c2h &
3229 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3230 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3231 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3232 END IF
3233 END DO
3234 END IF
3236 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
3237 CALL wrf_debug ( 200 , ' call filter scalar ' )
3238 DO im = PARAM_FIRST_SCALAR, num_3d_s
3239 IF ( config_flags%coupled_filtering ) THEN
3240 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3241 ,MU=grid%mu_2 , MUB=grid%mub &
3242 ,C1=grid%c1h , C2=grid%c2h &
3243 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3244 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3245 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3246 END IF
3247 CALL pxft ( grid=grid &
3248 ,lineno=__LINE__ &
3249 ,flag_uv = 0 &
3250 ,flag_rurv = 0 &
3251 ,flag_wph = 0 &
3252 ,flag_ww = 0 &
3253 ,flag_t = 0 &
3254 ,flag_mu = 0 &
3255 ,flag_mut = 0 &
3256 ,flag_moist = 0 &
3257 ,flag_chem = 0 &
3258 ,flag_tracer = 0 &
3259 ,flag_scalar = im &
3260 ,actual_distance_average=config_flags%actual_distance_average&
3261 ,pos_def = config_flags%pos_def &
3262 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
3263 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
3264 ,fft_filter_lat = config_flags%fft_filter_lat &
3265 ,dclat = dclat &
3266 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3267 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3268 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
3269 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
3270 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
3271 IF ( config_flags%coupled_filtering ) THEN
3272 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
3273 ,MU=grid%mu_2 , MUB=grid%mub &
3274 ,C1=grid%c1h , C2=grid%c2h &
3275 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
3276 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
3277 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
3278 END IF
3279 END DO
3280 END IF
3281 END IF ! polar filter test
3283 !-----------------------------------------------------------
3284 ! END rk3 substep polar filter for scalars (moist,chem,scalar)
3285 !-----------------------------------------------------------
3287 !-----------------------------------------------------------
3288 ! Stencils for patch communications (WCS, 29 June 2001)
3289 !
3290 ! here's where we need a wide comm stencil - these are the
3291 ! uncoupled variables so are used for high order calc in
3292 ! advection and mixong routines.
3293 !
3294 !
3295 ! * * * * * * *
3296 ! * * * * * * * * * * * *
3297 ! * * * * * * * * * * * * *
3298 ! * + * * * + * * * * * + * * *
3299 ! * * * * * * * * * * * * *
3300 ! * * * * * * * * * * * *
3301 ! * * * * * * *
3302 !
3303 ! al x
3304 !
3305 ! 2D variable
3306 ! mu_2 x
3307 !
3308 ! (adv order <=4)
3309 ! u_2 x
3310 ! v_2 x
3311 ! w_2 x
3312 ! t_2 x
3313 ! ph_2 x
3314 !
3315 ! (adv order <=6)
3316 ! u_2 x
3317 ! v_2 x
3318 ! w_2 x
3319 ! t_2 x
3320 ! ph_2 x
3321 !
3322 ! 4D variable
3323 ! moist x
3324 ! chem x
3325 ! scalar x
3327 #ifdef DM_PARALLEL
3328 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3329 # include "HALO_EM_D2_3.inc"
3330 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3331 # include "HALO_EM_D2_5.inc"
3332 ELSE
3333 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3334 CALL wrf_error_fatal(TRIM(wrf_err_message))
3335 ENDIF
3336 # include "PERIOD_BDY_EM_D.inc"
3337 # include "PERIOD_BDY_EM_MOIST2.inc"
3338 # include "PERIOD_BDY_EM_CHEM2.inc"
3339 # include "PERIOD_BDY_EM_TRACER2.inc"
3340 # include "PERIOD_BDY_EM_SCALAR2.inc"
3341 # include "PERIOD_BDY_EM_TKE.inc"
3342 #endif
3344 BENCH_START(bc_end_tim)
3345 !$OMP PARALLEL DO &
3346 !$OMP PRIVATE ( ij )
3347 tile_bc_loop_1: DO ij = 1 , grid%num_tiles
3348 CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
3350 CALL rk_phys_bc_dry_2( config_flags, &
3351 grid%u_2, grid%v_2, grid%w_2, &
3352 grid%t_2, grid%ph_2, grid%mu_2, &
3353 ids, ide, jds, jde, kds, kde, &
3354 ims, ime, jms, jme, kms, kme, &
3355 ips, ipe, jps, jpe, kps, kpe, &
3356 grid%i_start(ij), grid%i_end(ij), &
3357 grid%j_start(ij), grid%j_end(ij), &
3358 k_start , k_end )
3360 BENCH_START(diag_w_tim)
3361 IF (.not. config_flags%non_hydrostatic) THEN
3363 !CALL push4backup (grid%muts, "muts")
3364 !CALL push4backup (ph_tend, "ph_tend")
3365 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, &
3366 grid%c1f, grid%c2f, dt_rk, &
3367 grid%u_2, grid%v_2, grid%ht, &
3368 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
3369 ids, ide, jds, jde, kds, kde, &
3370 ims, ime, jms, jme, kms, kme, &
3371 grid%i_start(ij), grid%i_end(ij), &
3372 grid%j_start(ij), grid%j_end(ij), &
3373 k_start , k_end )
3375 ENDIF
3376 BENCH_END(diag_w_tim)
3378 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
3380 moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3382 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
3383 ids, ide, jds, jde, kds, kde, &
3384 ims, ime, jms, jme, kms, kme, &
3385 ips, ipe, jps, jpe, kps, kpe, &
3386 grid%i_start(ij), grid%i_end(ij), &
3387 grid%j_start(ij), grid%j_end(ij), &
3388 k_start , k_end )
3390 END DO moisture_loop_bdy_1
3392 ENDIF
3394 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
3396 chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3398 CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
3399 ids, ide, jds, jde, kds, kde, &
3400 ims, ime, jms, jme, kms, kme, &
3401 ips, ipe, jps, jpe, kps, kpe, &
3402 grid%i_start(ij), grid%i_end(ij), &
3403 grid%j_start(ij), grid%j_end(ij), &
3404 k_start , k_end-1 )
3406 END DO chem_species_bdy_loop_1
3408 END IF
3410 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
3412 tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
3414 CALL set_physical_bc3d( tracer(ims,kms,jms,ic), 'p', config_flags, &
3415 ids, ide, jds, jde, kds, kde, &
3416 ims, ime, jms, jme, kms, kme, &
3417 ips, ipe, jps, jpe, kps, kpe, &
3418 grid%i_start(ij), grid%i_end(ij), &
3419 grid%j_start(ij), grid%j_end(ij), &
3420 k_start , k_end-1 )
3422 END DO tracer_species_bdy_loop_1
3424 END IF
3426 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
3428 scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3430 CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags, &
3431 ids, ide, jds, jde, kds, kde, &
3432 ims, ime, jms, jme, kms, kme, &
3433 ips, ipe, jps, jpe, kps, kpe, &
3434 grid%i_start(ij), grid%i_end(ij), &
3435 grid%j_start(ij), grid%j_end(ij), &
3436 k_start , k_end-1 )
3438 END DO scalar_species_bdy_loop_1
3440 END IF
3442 IF (config_flags%km_opt .eq. 2) THEN
3444 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
3445 ids, ide, jds, jde, kds, kde, &
3446 ims, ime, jms, jme, kms, kme, &
3447 ips, ipe, jps, jpe, kps, kpe, &
3448 grid%i_start(ij), grid%i_end(ij), &
3449 grid%j_start(ij), grid%j_end(ij), &
3450 k_start , k_end )
3452 END IF
3454 END DO tile_bc_loop_1
3455 !$OMP END PARALLEL DO
3456 BENCH_END(bc_end_tim)
3459 #ifdef DM_PARALLEL
3461 ! * * * * *
3462 ! * * * * * * * * *
3463 ! * + * * + * * * + * *
3464 ! * * * * * * * * *
3465 ! * * * * *
3467 ! moist, chem, scalar, tke x
3470 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3471 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3472 # include "HALO_EM_TKE_5.inc"
3473 ELSE
3474 # include "HALO_EM_TKE_3.inc"
3475 ENDIF
3476 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3477 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3478 # include "HALO_EM_TKE_7.inc"
3479 ELSE
3480 # include "HALO_EM_TKE_5.inc"
3481 ENDIF
3482 ELSE
3483 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3484 CALL wrf_error_fatal(TRIM(wrf_err_message))
3485 ENDIF
3487 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
3488 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3489 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3490 # include "HALO_EM_MOIST_E_5.inc"
3491 ELSE
3492 # include "HALO_EM_MOIST_E_3.inc"
3493 END IF
3494 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3495 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3496 # include "HALO_EM_MOIST_E_7.inc"
3497 ELSE
3498 # include "HALO_EM_MOIST_E_5.inc"
3499 END IF
3500 ELSE
3501 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3502 CALL wrf_error_fatal(TRIM(wrf_err_message))
3503 ENDIF
3504 ENDIF
3505 IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3506 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3507 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3508 # include "HALO_EM_CHEM_E_5.inc"
3509 ELSE
3510 # include "HALO_EM_CHEM_E_3.inc"
3511 ENDIF
3512 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3513 IF ( (config_flags%chem_adv_opt /= ORIGINAL .and. config_flags%chem_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3514 # include "HALO_EM_CHEM_E_7.inc"
3515 ELSE
3516 # include "HALO_EM_CHEM_E_5.inc"
3517 ENDIF
3518 ELSE
3519 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3520 CALL wrf_error_fatal(TRIM(wrf_err_message))
3521 ENDIF
3522 ENDIF
3523 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
3524 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3525 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3526 # include "HALO_EM_TRACER_E_5.inc"
3527 ELSE
3528 # include "HALO_EM_TRACER_E_3.inc"
3529 ENDIF
3530 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3531 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3532 # include "HALO_EM_TRACER_E_7.inc"
3533 ELSE
3534 # include "HALO_EM_TRACER_E_5.inc"
3535 ENDIF
3536 ELSE
3537 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3538 CALL wrf_error_fatal(TRIM(wrf_err_message))
3539 ENDIF
3540 ENDIF
3541 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3542 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
3543 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3544 # include "HALO_EM_SCALAR_E_5.inc"
3545 ELSE
3546 # include "HALO_EM_SCALAR_E_3.inc"
3547 ENDIF
3548 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
3549 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
3550 # include "HALO_EM_SCALAR_E_7.inc"
3551 ELSE
3552 # include "HALO_EM_SCALAR_E_5.inc"
3553 ENDIF
3554 ELSE
3555 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
3556 CALL wrf_error_fatal(TRIM(wrf_err_message))
3557 ENDIF
3558 ENDIF
3559 #endif
3561 ENDIF rk_step_1_check
3564 !**********************************************************
3565 !
3566 ! end of RK predictor-corrector loop
3567 !
3568 !**********************************************************
3570 END DO Runge_Kutta_loop
3572 IF (config_flags%do_avgflx_em .EQ. 1) THEN
3573 ! Reinitialize time-averaged fluxes if history output was written after the previous time step:
3575 CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM ),prevringtime=temp_time)
3577 CALL domain_clock_get ( grid, current_time=CurrTime, &
3578 current_timestr=message2 )
3580 ! use overloaded -, .LT. operator to check whether to initialize avgflx:
3581 ! reinitialize after each history output (detect this here by comparing current time
3582 ! against last history time and time step - this code follows what's done in adapt_timestep_em):
3583 WRITE ( message , FMT = '("solve_em: old_dt =",g15.6,", dt=",g15.6," on domain ",I3)' ) &
3584 & old_dt,grid%dt,grid%id
3585 CALL wrf_debug(200,message)
3586 old_dt=min(old_dt,grid%dt)
3587 num = INT(old_dt * precision)
3588 den = precision
3590 CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3592 IF (CurrTime .lt. temp_time + dtInterval) THEN
3593 WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
3594 & TRIM(message2), grid%id
3595 CALL wrf_message(trim(message))
3596 grid%avgflx_count = 0
3597 !tile-loop for zero_avgflx
3598 !$OMP PARALLEL DO &
3599 !$OMP PRIVATE ( ij )
3600 DO ij = 1 , grid%num_tiles
3601 CALL wrf_debug(200,'In solve_em, before zero_avgflx call')
3603 CALL zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3604 & ids, ide, jds, jde, kds, kde, &
3605 & ims, ime, jms, jme, kms, kme, &
3606 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3607 & k_start , k_end, f_flux, &
3608 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3609 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3611 CALL wrf_debug(200,'In solve_em, after zero_avgflx call')
3612 ENDDO
3613 !$OMP END PARALLEL DO
3614 ENDIF
3616 ! Update avgflx quantities
3617 !tile-loop for upd_avgflx
3618 !$OMP PARALLEL DO &
3619 !$OMP PRIVATE ( ij )
3620 DO ij = 1 , grid%num_tiles
3621 CALL wrf_debug(200,'In solve_em, before upd_avgflx call')
3623 CALL upd_avgflx(grid%avgflx_count,grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
3624 & grid%ru_m, grid%rv_m, grid%ww_m, &
3625 & ids, ide, jds, jde, kds, kde, &
3626 & ims, ime, jms, jme, kms, kme, &
3627 & grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
3628 & k_start , k_end, f_flux, &
3629 & grid%cfu1,grid%cfd1,grid%dfu1,grid%efu1,grid%dfd1,grid%efd1, &
3630 & grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
3631 & grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
3633 CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
3635 ENDDO
3636 !$OMP END PARALLEL DO
3637 grid%avgflx_count = grid%avgflx_count + 1
3638 ENDIF
3639 !
3640 !$OMP PARALLEL DO &
3641 !$OMP PRIVATE ( ij )
3642 DO ij = 1 , grid%num_tiles
3644 BENCH_START(advance_ppt_tim)
3645 CALL wrf_debug ( 200 , ' call advance_ppt' )
3647 CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
3648 grid%cldfra_cup, & !BSINGH - Added for CuP scheme
3649 grid%rqicuten,grid%rqscuten, &
3650 grid%rainc,grid%raincv,grid%rainsh,grid%pratec,grid%pratesh, &
3651 grid%nca,grid%htop,grid%hbot,grid%cutop,grid%cubot, &
3652 grid%cuppt, grid%dt, config_flags, &
3653 ids,ide, jds,jde, kds,kde, &
3654 ims,ime, jms,jme, kms,kme, &
3655 grid%i_start(ij), grid%i_end(ij), &
3656 grid%j_start(ij), grid%j_end(ij), &
3657 k_start , k_end )
3659 BENCH_END(advance_ppt_tim)
3661 ENDDO
3662 !$OMP END PARALLEL DO
3664 if ( config_flags%cu_physics .gt. 0 ) then
3665 CALL PUSHREAL8ARRAY ( grid%rthcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
3666 CALL PUSHREAL8ARRAY ( grid%rqvcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
3667 end if
3668 !$OMP PARALLEL DO &
3669 !$OMP PRIVATE ( ij )
3670 DO ij = 1 , grid%num_tiles
3671 CALL wrf_debug ( 200 , ' call phy_prep_part2' )
3672 CALL phy_prep_part2 ( config_flags, &
3673 grid%muts, grid%muus, grid%muvs, &
3674 grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
3675 grid%rthraten, &
3676 grid%rthblten, grid%rublten, grid%rvblten, &
3677 grid%rqvblten, grid%rqcblten, grid%rqiblten, &
3678 grid%rucuten, grid%rvcuten, grid%rthcuten, &
3679 grid%rqvcuten, grid%rqccuten, grid%rqrcuten, &
3680 grid%rqicuten, grid%rqscuten, &
3681 grid%rushten, grid%rvshten, grid%rthshten, &
3682 grid%rqvshten, grid%rqcshten, grid%rqrshten, &
3683 grid%rqishten, grid%rqsshten, grid%rqgshten, &
3684 grid%rthften, grid%rqvften, &
3685 grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN, &
3686 grid%RPHNDGDTEN,grid%RQVNDGDTEN, grid%RMUNDGDTEN,&
3687 grid%t_2, th_phy, moist(ims,kms,jms,P_QV), &
3688 ids, ide, jds, jde, kds, kde, &
3689 ims, ime, jms, jme, kms, kme, &
3690 grid%i_start(ij), grid%i_end(ij), &
3691 grid%j_start(ij), grid%j_end(ij), &
3692 k_start, k_end )
3693 ENDDO
3694 !$OMP END PARALLEL DO
3696 !<DESCRIPTION>
3697 !<pre>
3698 ! (5) time-split physics.
3699 !
3700 ! Microphysics are the only time split physics in the WRF model
3701 ! at this time. Split-physics begins with the calculation of
3702 ! needed diagnostic quantities (pressure, temperature, etc.)
3703 ! followed by a call to the microphysics driver,
3704 ! and finishes with a clean-up, storing off of a diabatic tendency
3705 ! from the moist physics, and a re-calulation of the diagnostic
3706 ! quantities pressure and density.
3707 !</pre>
3708 !</DESCRIPTION>
3710 IF( config_flags%specified .or. config_flags%nested ) THEN
3711 sz = grid%spec_zone
3712 ELSE
3713 sz = 0
3714 ENDIF
3716 IF (config_flags%mp_physics /= 0) then
3718 !CALL push4backup (grid%h_diabatic,"h_diabatic")
3719 !CALL push4backup (grid%z_at_w,"z_at_w")
3720 !CALL push4backup (grid%z,"z")
3721 !CALL push4backup (th_phy,"th_phy")
3722 !CALL push4backup (p_phy,"p_phy")
3723 !CALL push4backup (pi_phy,"pi_phy")
3724 !CALL push4backup (grid%ph_2,"ph_2")
3725 !CALL push4backup (dz8w,"dz8w")
3726 !CALL push4backup (grid%p,"p")
3727 !CALL push4backup (grid%al,"al")
3728 !CALL push4backup (grid%t_2,"t")
3729 !CALL push4backup (grid%rho,"rho")
3730 CALL PUSHREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
3731 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
3733 !$OMP PARALLEL DO &
3734 !$OMP PRIVATE ( ij, its, ite, jts, jte )
3736 scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
3738 IF ( config_flags%periodic_x ) THEN
3739 its = max(grid%i_start(ij),ids)
3740 ite = min(grid%i_end(ij),ide-1)
3741 ELSE
3742 its = max(grid%i_start(ij),ids+sz)
3743 ite = min(grid%i_end(ij),ide-1-sz)
3744 ENDIF
3745 jts = max(grid%j_start(ij),jds+sz)
3746 jte = min(grid%j_end(ij),jde-1-sz)
3748 CALL wrf_debug ( 200 , ' call moist_physics_prep' )
3749 BENCH_START(moist_physics_prep_tim)
3751 CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, grid%rho, &
3752 grid%al, grid%alb, grid%p, p8w, p0, grid%pb, &
3753 grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
3754 grid%z, grid%z_at_w, dz8w, &
3755 dtm, grid%h_diabatic, &
3756 moist(ims,kms,jms,P_QV),grid%qv_diabatic, &
3757 moist(ims,kms,jms,P_QC),grid%qc_diabatic, &
3758 config_flags,grid%fnm, grid%fnp, &
3759 ids, ide, jds, jde, kds, kde, &
3760 ims, ime, jms, jme, kms, kme, &
3761 its, ite, jts, jte, &
3762 k_start , k_end )
3764 BENCH_END(moist_physics_prep_tim)
3765 END DO scalar_tile_loop_1a
3766 !$OMP END PARALLEL DO
3768 CALL wrf_debug ( 200 , ' call microphysics_driver' )
3770 grid%sr = 0.
3771 specified_bdy = config_flags%specified .OR. config_flags%nested
3772 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
3774 BENCH_START(micro_driver_tim)
3776 !
3777 ! WRFU_AlarmIsRinging always returned false, so using an alternate method to find out if it is time
3778 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
3779 !
3780 ! diagflag = .false.
3781 ! CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM
3782 ! ),prevringtime=temp_time,RingInterval=intervaltime)
3783 ! CALL WRFU_ALARMGET(grid%alarms( RESTART_ALARM
3784 ! ),prevringtime=restart_time,RingInterval=restartinterval)
3785 ! CALL domain_clock_get ( grid, current_time=CurrTime )
3786 ! old_dt=min(old_dt,grid%dt)
3787 ! num = INT(old_dt * precision)
3788 ! den = precision
3789 ! CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
3790 ! IF (CurrTime .ge. temp_time + intervaltime - dtInterval .or. &
3791 ! CurrTime .ge. restart_time + restartinterval - dtInterval ) THEN
3792 ! diagflag = .true.
3793 ! ENDIF
3794 ! WRITE(wrf_err_message,*)'diag_flag=',diag_flag
3795 ! CALL wrf_debug ( 0 , wrf_err_message )
3797 #ifdef DM_PARALLEL
3798 # include "HALO_EM_SBM.inc"
3799 #endif
3801 !CALL push4backup (moist,"moist")
3802 !CALL push4backup (pi_phy,"pi_phy")
3803 !CALL push4backup (dz8w,"dz8w")
3804 !CALL push4backup (p8w,"p8w")
3805 !CALL push4backup (grid%rho,"rho")
3806 !CALL push4backup (th_phy,"th_phy")
3807 !CALL push4backup (p_phy,"p_phy")
3808 CALL PUSHREAL8ARRAY ( moist, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
3809 CALL PUSHREAL8ARRAY ( th_phy, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
3811 CALL microphysics_driver( &
3812 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
3813 & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy &
3814 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
3815 & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
3816 & ,RHO=grid%rho ,SPEC_ZONE=grid%spec_zone &
3817 & ,SR=grid%sr ,TH=th_phy &
3818 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
3819 & ,WARM_RAIN=grid%warm_rain &
3820 & ,T8W=t8w &
3821 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
3822 & ,NSOURCE=grid%qndropsource &
3823 #if (WRF_CHEM==1)
3824 & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
3825 & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
3826 & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
3827 !======================
3828 ! Variables required for CAMMGMP Scheme when run with WRF_CHEM
3829 & ,CHEM=chem &
3830 & ,QME3D=grid%qme3d,PRAIN3D=grid%prain3d &
3831 & ,NEVAPR3D=grid%nevapr3d &
3832 & ,RATE1ORD_CW2PR_ST3D=grid%rate1ord_cw2pr_st3d &
3833 & ,DGNUM4D=grid%dgnum4d,DGNUMWET4D=grid%dgnumwet4d &
3834 !======================
3835 #endif
3836 & ,XLAND=grid%xland,SNOWH=grid%SNOW &
3837 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
3838 & ,F_RAIN_PHY=grid%f_rain_phy &
3839 & ,F_RIMEF_PHY=grid%f_rimef_phy &
3840 & ,MP_PHYSICS=config_flags%mp_physics &
3841 & ,ID=grid%id &
3842 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3843 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3844 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3845 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3846 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3847 & ,KTS=k_start, KTE=min(k_end,kde-1) &
3848 & ,NUM_TILES=grid%num_tiles &
3849 & ,NAER=grid%naer &
3850 !===================== IRRIGATION =========================
3851 & ,IRRIGATION=grid%irrigation &
3852 & ,SF_SURF_IRR_SCHEME=config_flags%sf_surf_irr_scheme &
3853 & ,IRR_DAILY_AMOUNT=config_flags%irr_daily_amount &
3854 & ,IRR_START_HOUR=config_flags%irr_start_hour &
3855 & ,IRR_NUM_HOURS=config_flags%irr_num_hours &
3856 & ,JULIAN_IN=grid%julian &
3857 & ,IRR_START_JULIANDAY=config_flags%irr_start_julianday &
3858 & ,IRR_END_JULIANDAY=config_flags%irr_end_julianday &
3859 & ,IRR_FREQ=config_flags%irr_freq,IRR_PH=config_flags%irr_ph &
3860 & ,IRR_RAND_FIELD=grid%irr_rand_field &
3861 & ,GMT=grid%gmt,XTIME=grid%xtime &
3862 !======================
3863 ! Variables required for CAMMGMP Scheme
3864 & ,DLF=grid%dlf,DLF2=grid%dlf2,T_PHY=grid%t_phy,P_HYD=grid%p_hyd &
3865 & ,P8W_HYD=grid%p_hyd_w,TKE_PBL=grid%tke_pbl &
3866 & ,Z_AT_W=grid%z_at_w,QFX=grid%qfx,RLIQ=grid%rliq &
3867 & ,TURBTYPE3D=grid%turbtype3d,SMAW3D=grid%smaw3d &
3868 & ,WSEDL3D=grid%wsedl3d,CLDFRA_OLD_MP=grid%cldfra_old_mp &
3869 & ,CLDFRA_MP=grid%cldfra_mp,CLDFRA_MP_ALL=grid%cldfra_mp_ALL &
3870 & ,CLDFRAI=grid%cldfrai &
3871 & ,CLDFRAL=grid%cldfral,CLDFRA_CONV=grid%CLDFRA_CONV &
3872 & ,ALT=grid%alt &
3873 & ,ACCUM_MODE=config_flags%accum_mode &
3874 & ,AITKEN_MODE=config_flags%aitken_mode &
3875 & ,COARSE_MODE=config_flags%coarse_mode &
3876 & ,ICWMRSH3D=grid%icwmrsh,ICWMRDP3D=grid%icwmrdp3d &
3877 & ,SHFRC3D=grid%shfrc3d,CMFMC3D=grid%cmfmc &
3878 & ,CMFMC2_3D=grid%cmfmc2,CONFIG_FLAGS=config_flags &
3879 & ,FNM=grid%fnm,FNP=grid%fnp,RH_OLD_MP=grid%rh_old_mp &
3880 & ,LCD_OLD_MP=grid%lcd_old_mp &
3881 !======================
3882 ! Optional
3883 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
3884 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
3885 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
3886 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
3887 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
3888 & , MP_RESTART_STATE=grid%mp_restart_state &
3889 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
3890 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
3891 & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
3892 & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
3893 & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
3894 & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
3895 & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
3896 & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
3897 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
3898 & , QIC_CURR=moist(ims,kms,jms,P_QIC), F_QIC=F_QIC &
3899 & , QIP_CURR=moist(ims,kms,jms,P_QIP), F_QIP=F_QIP &
3900 & , QID_CURR=moist(ims,kms,jms,P_QID), F_QID=F_QID &
3901 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
3902 #if (WRF_CHEM==1)
3903 & , RAINPROD=grid%rainprod, EVAPPROD=grid%evapprod &
3904 & , QV_B4MP=grid%qv_b4mp,QC_B4MP=grid%qc_b4mp &
3905 & , QI_B4MP=grid%qi_b4mp, QS_B4MP=grid%qs_b4mp &
3906 #endif
3907 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
3908 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
3909 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
3910 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
3911 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
3912 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
3913 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
3914 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom and nssl_2mom
3915 & , QNIC_CURR=scalar(ims,kms,jms,P_QNIC), F_QNIC=F_QNIC &
3916 & , QNIP_CURR=scalar(ims,kms,jms,P_QNIP), F_QNIP=F_QNIP &
3917 & , QNID_CURR=scalar(ims,kms,jms,P_QNID), F_QNID=F_QNID &
3918 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
3919 ! & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! "
3920 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
3921 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
3922 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
3923 & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom
3924 & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom
3925 & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m
3926 & , QTCN_CURR=scalar(ims,kms,jms,P_QTCN), F_QTCN=F_QTCN & ! for ntu3m
3927 & , QCCN_CURR=scalar(ims,kms,jms,P_QCCN), F_QCCN=F_QCCN & ! for ntu3m
3928 & , QRCN_CURR=scalar(ims,kms,jms,P_QRCN), F_QRCN=F_QRCN & ! for ntu3m
3929 & , QNIN_CURR=scalar(ims,kms,jms,P_QNIN), F_QNIN=F_QNIN & ! for ntu3m
3930 & , FI_CURR=scalar(ims,kms,jms,P_FI), F_FI=F_FI & ! for ntu3m
3931 & , FS_CURR=scalar(ims,kms,jms,P_FS), F_FS=F_FS & ! for ntu3m
3932 & , VI_CURR=scalar(ims,kms,jms,P_VI), F_VI=F_VI & ! for ntu3m
3933 & , VS_CURR=scalar(ims,kms,jms,P_VS), F_VS=F_VS & ! for ntu3m
3934 & , VG_CURR=scalar(ims,kms,jms,P_VG), F_VG=F_VG & ! for ntu3m
3935 & , AI_CURR=scalar(ims,kms,jms,P_AI), F_AI=F_AI & ! for ntu3m
3936 & , AS_CURR=scalar(ims,kms,jms,P_AS), F_AS=F_AS & ! for ntu3m
3937 & , AG_CURR=scalar(ims,kms,jms,P_AG), F_AG=F_AG & ! for ntu3m
3938 & , AH_CURR=scalar(ims,kms,jms,P_AH), F_AH=F_AH & ! for ntu3m
3939 & , I3M_CURR=scalar(ims,kms,jms,P_I3M), F_I3M=F_I3m & ! for ntu3m
3940 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
3941 & , qicuten=grid%rqicuten, qccuten=grid%rqccuten &
3942 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
3943 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
3944 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
3945 ! YLIN
3946 ! RI_CURR INPUT
3947 & , RI_CURR=grid%rimi &
3948 & , re_cloud=grid%re_cloud, re_ice=grid%re_ice, re_snow=grid%re_snow & ! G. Thompson
3949 & , has_reqc=grid%has_reqc, has_reqi=grid%has_reqi, has_reqs=grid%has_reqs & ! G. Thompson
3950 & , diagflag=diag_flag, do_radar_ref=config_flags%do_radar_ref &
3951 & ,u=grid%u_phy,v=grid%v_phy &
3952 & ,scalar=scalar,num_scalar=num_scalar &
3953 & ,TH_OLD=grid%th_old &
3954 & ,QV_OLD=grid%qv_old &
3955 & ,xlat=grid%xlat,xlong=grid%xlong,IVGTYP=grid%ivgtyp &
3956 & , EFFR_CURR=scalar(ims,kms,jms,P_EFFR), F_EFFR=F_EFFR & ! for SBM
3957 & , ICE_EFFR_CURR=scalar(ims,kms,jms,P_ICE_EFFR), F_ICE_EFFR=F_ICE_EFFR & ! for SBM
3958 & , TOT_EFFR_CURR=scalar(ims,kms,jms,P_TOT_EFFR), F_TOT_EFFR=F_TOT_EFFR & ! for SBM
3959 & , QIC_EFFR_CURR=scalar(ims,kms,jms,P_QIC_EFFR), F_QIC_EFFR=F_QIC_EFFR & ! for SBM
3960 & , QIP_EFFR_CURR=scalar(ims,kms,jms,P_QIP_EFFR), F_QIP_EFFR=F_QIP_EFFR & ! for SBM
3961 & , QID_EFFR_CURR=scalar(ims,kms,jms,P_QID_EFFR), F_QID_EFFR=F_QID_EFFR & ! for SBM
3962 & ,kext_ql=grid%kext_ql &
3963 & ,kext_qs=grid%kext_qs &
3964 & ,kext_qg=grid%kext_qg &
3965 & ,kext_qh=grid%kext_qh &
3966 & ,kext_qa=grid%kext_qa &
3967 & ,kext_qic=grid%kext_qic &
3968 & ,kext_qip=grid%kext_qip &
3969 & ,kext_qid=grid%kext_qid &
3970 & ,kext_ft_qic=grid%kext_ft_qic &
3971 & ,kext_ft_qip=grid%kext_ft_qip &
3972 & ,kext_ft_qid=grid%kext_ft_qid &
3973 & ,kext_ft_qs=grid%kext_ft_qs &
3974 & ,kext_ft_qg=grid%kext_ft_qg &
3975 & ,height=grid%height &
3976 & ,tempc=grid%tempc &
3977 & ,ccn_conc=grid%ccn_conc & ! RAS
3978 & ,sbmradar=sbmradar,num_sbmradar=num_sbmradar & ! for SBM
3979 & ,sbm_diagnostics=config_flags%sbm_diagnostics & ! for SBM
3980 & ,aerocu=aerocu &
3981 & ,aercu_fct=config_flags%aercu_fct &
3982 & ,aercu_opt=config_flags%aercu_opt &
3983 & ,no_src_types_cu=grid%no_src_types_cu &
3984 )
3985 ! & ,PBL=grid%bl_pbl_physics,EFCG=grid%EFCG,EFIG=grid%EFIG,EFSG=grid%EFSG &
3986 ! & ,WACT=grid%WACT,CCN1_GS=grid%CCN1_GS,CCN2_GS=grid%CCN2_GS,CCN3_GS=grid%CCN3_GS &
3987 ! & ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
3988 ! & ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
3989 ! & ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm)
3991 BENCH_END(micro_driver_tim)
3993 #if 0
3994 BENCH_START(microswap_2)
3995 ! for load balancing; communication to redistribute the points
3996 IF ( config_flags%mp_physics .EQ. ETAMPNEW .OR. &
3997 & config_flags%mp_physics .EQ. FER_MP_HIRES) THEN
3998 #include "SWAP_ETAMP_NEW.inc"
3999 ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
4000 #include "SWAP_WSM3.inc"
4001 ENDIF
4002 BENCH_END(microswap_2)
4003 #endif
4005 CALL wrf_debug ( 200 , ' call moist_physics_finish' )
4006 BENCH_START(moist_phys_end_tim)
4008 !$OMP PARALLEL DO &
4009 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
4011 DO ij = 1 , grid%num_tiles
4013 its = max(grid%i_start(ij),ids)
4014 ite = min(grid%i_end(ij),ide-1)
4015 jts = max(grid%j_start(ij),jds)
4016 jte = min(grid%j_end(ij),jde-1)
4018 CALL microphysics_zero_outb ( &
4019 moist , num_moist , config_flags , &
4020 ids, ide, jds, jde, kds, kde, &
4021 ims, ime, jms, jme, kms, kme, &
4022 its, ite, jts, jte, &
4023 k_start , k_end )
4025 CALL microphysics_zero_outb ( &
4026 scalar , num_scalar , config_flags , &
4027 ids, ide, jds, jde, kds, kde, &
4028 ims, ime, jms, jme, kms, kme, &
4029 its, ite, jts, jte, &
4030 k_start , k_end )
4032 CALL microphysics_zero_outb ( &
4033 chem , num_chem , config_flags , &
4034 ids, ide, jds, jde, kds, kde, &
4035 ims, ime, jms, jme, kms, kme, &
4036 its, ite, jts, jte, &
4037 k_start , k_end )
4039 CALL microphysics_zero_outb ( &
4040 tracer , num_tracer , config_flags , &
4041 ids, ide, jds, jde, kds, kde, &
4042 ims, ime, jms, jme, kms, kme, &
4043 its, ite, jts, jte, &
4044 k_start , k_end )
4046 IF ( config_flags%periodic_x ) THEN
4047 its = max(grid%i_start(ij),ids)
4048 ite = min(grid%i_end(ij),ide-1)
4049 ELSE
4050 its = max(grid%i_start(ij),ids+sz)
4051 ite = min(grid%i_end(ij),ide-1-sz)
4052 ENDIF
4053 jts = max(grid%j_start(ij),jds+sz)
4054 jte = min(grid%j_end(ij),jde-1-sz)
4056 CALL PUSHREAL8ARRAY ( moist, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
4057 CALL microphysics_zero_outa ( &
4058 moist , num_moist , config_flags , &
4059 ids, ide, jds, jde, kds, kde, &
4060 ims, ime, jms, jme, kms, kme, &
4061 its, ite, jts, jte, &
4062 k_start , k_end )
4064 CALL microphysics_zero_outa ( &
4065 scalar , num_scalar , config_flags , &
4066 ids, ide, jds, jde, kds, kde, &
4067 ims, ime, jms, jme, kms, kme, &
4068 its, ite, jts, jte, &
4069 k_start , k_end )
4071 CALL microphysics_zero_outa ( &
4072 chem , num_chem , config_flags , &
4073 ids, ide, jds, jde, kds, kde, &
4074 ims, ime, jms, jme, kms, kme, &
4075 its, ite, jts, jte, &
4076 k_start , k_end )
4078 CALL microphysics_zero_outa ( &
4079 tracer , num_tracer , config_flags , &
4080 ids, ide, jds, jde, kds, kde, &
4081 ims, ime, jms, jme, kms, kme, &
4082 its, ite, jts, jte, &
4083 k_start , k_end )
4085 CALL PUSHREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
4086 CALL PUSHREAL8ARRAY ( grid%h_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
4087 !CALL PUSHREAL8ARRAY ( grid%qv_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
4088 !CALL PUSHREAL8ARRAY ( grid%qc_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
4089 CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, &
4090 grid%h_diabatic, dtm, &
4091 moist(ims,kms,jms,P_QV),grid%qv_diabatic, &
4092 moist(ims,kms,jms,P_QC),grid%qc_diabatic, &
4093 grid%th_phy_m_t0, &
4094 config_flags, &
4095 #if ( WRF_DFI_RADAR == 1 )
4096 grid%dfi_tten_rad,grid%dfi_stage, &
4097 #endif
4098 ids, ide, jds, jde, kds, kde, &
4099 ims, ime, jms, jme, kms, kme, &
4100 its, ite, jts, jte, &
4101 k_start , k_end )
4103 END DO
4104 !$OMP END PARALLEL DO
4106 ENDIF ! microphysics test
4108 #if 0
4109 ! below is not used in adjoint
4110 !-----------------------------------------------------------
4111 ! filter for moist variables post-microphysics and end of timestep
4112 !-----------------------------------------------------------
4114 IF (config_flags%polar) THEN
4115 IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
4116 CALL wrf_debug ( 200 , ' call filter moist' )
4117 DO im = PARAM_FIRST_SCALAR, num_3d_m
4118 IF ( config_flags%coupled_filtering ) THEN
4119 CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
4120 ,MU=grid%mu_2 , MUB=grid%mub &
4121 ,C1=grid%c1h , C2=grid%c2h &
4122 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4123 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4124 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4125 END IF
4127 CALL pxft ( grid=grid &
4128 ,lineno=__LINE__ &
4129 ,flag_uv = 0 &
4130 ,flag_rurv = 0 &
4131 ,flag_wph = 0 &
4132 ,flag_ww = 0 &
4133 ,flag_t = 0 &
4134 ,flag_mu = 0 &
4135 ,flag_mut = 0 &
4136 ,flag_moist = im &
4137 ,flag_chem = 0 &
4138 ,flag_tracer = 0 &
4139 ,flag_scalar = 0 &
4140 ,actual_distance_average=config_flags%actual_distance_average&
4141 ,pos_def = config_flags%pos_def &
4142 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4143 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4144 ,fft_filter_lat = config_flags%fft_filter_lat &
4145 ,dclat = dclat &
4146 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4147 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4148 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4149 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4150 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4152 IF ( config_flags%coupled_filtering ) THEN
4153 CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
4154 ,MU=grid%mu_2 , MUB=grid%mub &
4155 ,C1=grid%c1h , C2=grid%c2h &
4156 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4157 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4158 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4159 END IF
4160 ENDDO
4161 ENDIF
4162 ENDIF
4164 !-----------------------------------------------------------
4165 ! end filter for moist variables post-microphysics and end of timestep
4166 !-----------------------------------------------------------
4168 !CALL push4backup (grid%mu_2,grid%muts, "mu,muts")
4169 !CALL push4backup (grid%ph_2,grid%t_2, "ph,t")
4170 !CALL push4backup (moist, "moist")
4171 !$OMP PARALLEL DO &
4172 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
4173 scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
4175 IF ( config_flags%periodic_x ) THEN
4176 its = max(grid%i_start(ij),ids)
4177 ite = min(grid%i_end(ij),ide-1)
4178 ELSE
4179 its = max(grid%i_start(ij),ids+sz)
4180 ite = min(grid%i_end(ij),ide-1-sz)
4181 ENDIF
4182 jts = max(grid%j_start(ij),jds+sz)
4183 jte = min(grid%j_end(ij),jde-1-sz)
4186 CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, &
4187 grid%al, grid%alb, grid%mu_2, grid%muts, &
4188 grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
4189 grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, &
4190 p0, t0, grid%p_top,grid%znu, grid%znw, grid%dnw, grid%rdnw, &
4191 grid%rdn, config_flags%non_hydrostatic, config_flags%use_theta_m, &
4192 ids, ide, jds, jde, kds, kde, &
4193 ims, ime, jms, jme, kms, kme, &
4194 its, ite, jts, jte, &
4195 k_start , k_end )
4197 END DO scalar_tile_loop_1ba
4198 !$OMP END PARALLEL DO
4199 BENCH_END(moist_phys_end_tim)
4201 IF (.not. config_flags%non_hydrostatic) THEN
4202 #ifdef DM_PARALLEL
4203 # include "HALO_EM_HYDRO_UV.inc"
4204 # include "PERIOD_EM_HYDRO_UV.inc"
4205 #endif
4207 !CALL push4backup (grid%muts, "muts")
4208 !CALL push4backup (ph_tend, "ph_tend")
4209 !$OMP PARALLEL DO &
4210 !$OMP PRIVATE ( ij )
4211 DO ij = 1 , grid%num_tiles
4212 CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, &
4213 grid%c1f, grid%c2f, dt_rk, &
4214 grid%u_2, grid%v_2, grid%ht, &
4215 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
4216 ids, ide, jds, jde, kds, kde, &
4217 ims, ime, jms, jme, kms, kme, &
4218 grid%i_start(ij), grid%i_end(ij), &
4219 grid%j_start(ij), grid%j_end(ij), &
4220 k_start , k_end )
4222 END DO
4223 !$OMP END PARALLEL DO
4225 END IF
4227 CALL wrf_debug ( 200 , ' call chem polar filter ' )
4229 !-----------------------------------------------------------
4230 ! filter for chem and scalar variables at end of timestep
4231 !-----------------------------------------------------------
4233 IF (config_flags%polar) THEN
4235 IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
4236 chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
4237 IF ( config_flags%coupled_filtering ) THEN
4238 CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
4239 ,MU=grid%mu_2 , MUB=grid%mub &
4240 ,C1=grid%c1h , C2=grid%c2h &
4241 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4242 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4243 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4244 END IF
4246 CALL pxft ( grid=grid &
4247 ,lineno=__LINE__ &
4248 ,flag_uv = 0 &
4249 ,flag_rurv = 0 &
4250 ,flag_wph = 0 &
4251 ,flag_ww = 0 &
4252 ,flag_t = 0 &
4253 ,flag_mu = 0 &
4254 ,flag_mut = 0 &
4255 ,flag_moist = 0 &
4256 ,flag_chem = im &
4257 ,flag_tracer = 0 &
4258 ,flag_scalar = 0 &
4259 ,actual_distance_average=config_flags%actual_distance_average&
4260 ,pos_def = config_flags%pos_def &
4261 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4262 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4263 ,fft_filter_lat = config_flags%fft_filter_lat &
4264 ,dclat = dclat &
4265 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4266 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4267 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4268 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4269 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4271 IF ( config_flags%coupled_filtering ) THEN
4272 CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
4273 ,MU=grid%mu_2 , MUB=grid%mub &
4274 ,C1=grid%c1h , C2=grid%c2h &
4275 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4276 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4277 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4278 END IF
4279 ENDDO chem_filter_loop
4280 ENDIF
4281 IF ( num_tracer >= PARAM_FIRST_SCALAR ) then
4282 tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer
4283 IF ( config_flags%coupled_filtering ) THEN
4284 CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
4285 ,MU=grid%mu_2 , MUB=grid%mub &
4286 ,C1=grid%c1h , C2=grid%c2h &
4287 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4288 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4289 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4290 END IF
4292 CALL pxft ( grid=grid &
4293 ,lineno=__LINE__ &
4294 ,flag_uv = 0 &
4295 ,flag_rurv = 0 &
4296 ,flag_wph = 0 &
4297 ,flag_ww = 0 &
4298 ,flag_t = 0 &
4299 ,flag_mu = 0 &
4300 ,flag_mut = 0 &
4301 ,flag_moist = 0 &
4302 ,flag_chem = 0 &
4303 ,flag_tracer = im &
4304 ,flag_scalar = 0 &
4305 ,actual_distance_average=config_flags%actual_distance_average&
4306 ,pos_def = config_flags%pos_def &
4307 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4308 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4309 ,fft_filter_lat = config_flags%fft_filter_lat &
4310 ,dclat = dclat &
4311 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4312 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4313 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4314 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4315 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4317 IF ( config_flags%coupled_filtering ) THEN
4318 CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) &
4319 ,MU=grid%mu_2 , MUB=grid%mub &
4320 ,C1=grid%c1h , C2=grid%c2h &
4321 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4322 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4323 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4324 END IF
4325 ENDDO tracer_filter_loop
4326 ENDIF
4328 IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
4329 scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
4330 IF ( config_flags%coupled_filtering ) THEN
4331 CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
4332 ,MU=grid%mu_2 , MUB=grid%mub &
4333 ,C1=grid%c1h , C2=grid%c2h &
4334 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4335 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4336 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4337 END IF
4339 CALL pxft ( grid=grid &
4340 ,lineno=__LINE__ &
4341 ,flag_uv = 0 &
4342 ,flag_rurv = 0 &
4343 ,flag_wph = 0 &
4344 ,flag_ww = 0 &
4345 ,flag_t = 0 &
4346 ,flag_mu = 0 &
4347 ,flag_mut = 0 &
4348 ,flag_moist = 0 &
4349 ,flag_chem = 0 &
4350 ,flag_tracer = 0 &
4351 ,flag_scalar = im &
4352 ,actual_distance_average=config_flags%actual_distance_average&
4353 ,pos_def = config_flags%pos_def &
4354 ,swap_pole_with_next_j = config_flags%swap_pole_with_next_j &
4355 ,moist=moist,chem=chem,tracer=tracer,scalar=scalar &
4356 ,fft_filter_lat = config_flags%fft_filter_lat &
4357 ,dclat = dclat &
4358 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4359 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4360 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
4361 ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
4362 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
4364 IF ( config_flags%coupled_filtering ) THEN
4365 CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
4366 ,MU=grid%mu_2 , MUB=grid%mub &
4367 ,C1=grid%c1h , C2=grid%c2h &
4368 ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
4369 ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
4370 ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
4371 END IF
4372 ENDDO scalar_filter_loop
4373 ENDIF
4374 ENDIF
4376 !-----------------------------------------------------------
4377 ! end filter for chem and scalar variables at end of timestep
4378 !-----------------------------------------------------------
4380 ! We're finished except for boundary condition (and patch) update
4382 ! Boundary condition time (or communication time). At this time, we have
4383 ! implemented periodic and symmetric physical boundary conditions.
4385 ! b.c. routine for data within patch.
4387 ! we need to do both time levels of
4388 ! data because the time filter only works in the physical solution space.
4390 ! First, do patch communications for boundary conditions (periodicity)
4392 !-----------------------------------------------------------
4393 ! Stencils for patch communications (WCS, 29 June 2001)
4394 !
4395 ! here's where we need a wide comm stencil - these are the
4396 ! uncoupled variables so are used for high order calc in
4397 ! advection and mixong routines.
4398 !
4399 ! * * * * *
4400 ! * * * * * * * * *
4401 ! * + * * + * * * + * *
4402 ! * * * * * * * * *
4403 ! * * * * *
4404 !
4405 ! grid%u_1 x
4406 ! grid%u_2 x
4407 ! grid%v_1 x
4408 ! grid%v_2 x
4409 ! grid%w_1 x
4410 ! grid%w_2 x
4411 ! grid%t_1 x
4412 ! grid%t_2 x
4413 ! grid%ph_1 x
4414 ! grid%ph_2 x
4415 ! grid%tke_1 x
4416 ! grid%tke_2 x
4417 !
4418 ! 2D variables
4419 ! grid%mu_1 x
4420 ! grid%mu_2 x
4421 !
4422 ! 4D variables
4423 ! moist x
4424 ! chem x
4425 ! scalar x
4426 !----------------------------------------------------------
4429 #ifdef DM_PARALLEL
4430 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4431 # include "HALO_EM_D3_3.inc"
4432 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4433 # include "HALO_EM_D3_5.inc"
4434 ELSE
4435 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4436 CALL wrf_error_fatal(TRIM(wrf_err_message))
4437 ENDIF
4438 # include "PERIOD_BDY_EM_D3.inc"
4439 # include "PERIOD_BDY_EM_MOIST.inc"
4440 # include "PERIOD_BDY_EM_CHEM.inc"
4441 # include "PERIOD_BDY_EM_TRACER.inc"
4442 # include "PERIOD_BDY_EM_SCALAR.inc"
4443 #endif
4445 ! now set physical b.c on a patch
4447 BENCH_START(bc_2d_tim)
4449 !CALL push4backup (grid%u_2,grid%v_2,grid%w_2, grid%t_2, "u, v, w,t ")
4450 !CALL push4backup (grid%ph_2, "ph")
4451 !CALL push4backup (grid%mu_2, "mu")
4453 !$OMP PARALLEL DO &
4454 !$OMP PRIVATE ( ij )
4455 tile_bc_loop_2: DO ij = 1 , grid%num_tiles
4457 CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
4459 CALL set_phys_bc_dry_2( config_flags, &
4460 grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2, &
4461 grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2, &
4462 ids, ide, jds, jde, kds, kde, &
4463 ims, ime, jms, jme, kms, kme, &
4464 ips, ipe, jps, jpe, kps, kpe, &
4465 grid%i_start(ij), grid%i_end(ij), &
4466 grid%j_start(ij), grid%j_end(ij), &
4467 k_start , k_end )
4469 CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
4470 ids, ide, jds, jde, kds, kde, &
4471 ims, ime, jms, jme, kms, kme, &
4472 ips, ipe, jps, jpe, kps, kpe, &
4473 grid%i_start(ij), grid%i_end(ij), &
4474 grid%j_start(ij), grid%j_end(ij), &
4475 k_start , k_end-1 )
4477 CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
4478 ids, ide, jds, jde, kds, kde, &
4479 ims, ime, jms, jme, kms, kme, &
4480 ips, ipe, jps, jpe, kps, kpe, &
4481 grid%i_start(ij), grid%i_end(ij), &
4482 grid%j_start(ij), grid%j_end(ij), &
4483 k_start , k_end )
4485 moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4487 CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
4488 config_flags, &
4489 ids, ide, jds, jde, kds, kde, &
4490 ims, ime, jms, jme, kms, kme, &
4491 ips, ipe, jps, jpe, kps, kpe, &
4492 grid%i_start(ij), grid%i_end(ij), &
4493 grid%j_start(ij), grid%j_end(ij), &
4494 k_start , k_end )
4496 END DO moisture_loop_bdy_2
4498 chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4500 CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
4501 ids, ide, jds, jde, kds, kde, &
4502 ims, ime, jms, jme, kms, kme, &
4503 ips, ipe, jps, jpe, kps, kpe, &
4504 grid%i_start(ij), grid%i_end(ij), &
4505 grid%j_start(ij), grid%j_end(ij), &
4506 k_start , k_end )
4508 END DO chem_species_bdy_loop_2
4510 tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
4512 CALL set_physical_bc3d( tracer(ims,kms,jms,ic) , 'p', config_flags, &
4513 ids, ide, jds, jde, kds, kde, &
4514 ims, ime, jms, jme, kms, kme, &
4515 ips, ipe, jps, jpe, kps, kpe, &
4516 grid%i_start(ij), grid%i_end(ij), &
4517 grid%j_start(ij), grid%j_end(ij), &
4518 k_start , k_end )
4520 END DO tracer_species_bdy_loop_2
4522 scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4524 CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags, &
4525 ids, ide, jds, jde, kds, kde, &
4526 ims, ime, jms, jme, kms, kme, &
4527 ips, ipe, jps, jpe, kps, kpe, &
4528 grid%i_start(ij), grid%i_end(ij), &
4529 grid%j_start(ij), grid%j_end(ij), &
4530 k_start , k_end )
4532 END DO scalar_species_bdy_loop_2
4534 END DO tile_bc_loop_2
4535 !$OMP END PARALLEL DO
4536 BENCH_END(bc_2d_tim)
4538 IF( config_flags%specified .or. config_flags%nested ) THEN
4540 ! this code forces boundary values to specified values to avoid drift
4542 !$OMP PARALLEL DO &
4543 !$OMP PRIVATE ( ij )
4544 tile_bc_loop_3: DO ij = 1 , grid%num_tiles
4546 CALL wrf_debug ( 200 , ' call spec_bdy_final' )
4548 CALL spec_bdy_final ( grid%u_2, grid%muus, grid%c1h, grid%c2h, grid%msfuy,&
4549 grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, &
4550 grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
4551 'u', config_flags, &
4552 config_flags%spec_bdy_width, grid%spec_zone, &
4553 grid%dtbc, &
4554 ids,ide, jds,jde, kds,kde, & ! domain dims
4555 ims,ime, jms,jme, kms,kme, & ! memory dims
4556 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4557 grid%i_start(ij), grid%i_end(ij), &
4558 grid%j_start(ij), grid%j_end(ij), &
4559 k_start , k_end )
4561 CALL spec_bdy_final ( grid%v_2, grid%muvs, grid%c1h, grid%c2h, grid%msfvx,&
4562 grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, &
4563 grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
4564 'v', config_flags, &
4565 config_flags%spec_bdy_width, grid%spec_zone, &
4566 grid%dtbc, &
4567 ids,ide, jds,jde, kds,kde, & ! domain dims
4568 ims,ime, jms,jme, kms,kme, & ! memory dims
4569 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4570 grid%i_start(ij), grid%i_end(ij), &
4571 grid%j_start(ij), grid%j_end(ij), &
4572 k_start , k_end )
4574 IF( config_flags%nested) THEN
4575 CALL spec_bdy_final ( grid%w_2, grid%muts, grid%c1h, grid%c2h, grid%msfty, &
4576 grid%w_bxs, grid%w_bxe, grid%w_bys, grid%w_bye, &
4577 grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
4578 'w', config_flags, &
4579 config_flags%spec_bdy_width, grid%spec_zone, &
4580 grid%dtbc, &
4581 ids,ide, jds,jde, kds,kde, & ! domain dims
4582 ims,ime, jms,jme, kms,kme, & ! memory dims
4583 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4584 grid%i_start(ij), grid%i_end(ij), &
4585 grid%j_start(ij), grid%j_end(ij), &
4586 k_start , k_end )
4587 ENDIF
4589 CALL spec_bdy_final ( grid%t_2, grid%muts, grid%c1h, grid%c2h, grid%msfty,&
4590 grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, &
4591 grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
4592 't', config_flags, &
4593 config_flags%spec_bdy_width, grid%spec_zone, &
4594 grid%dtbc, &
4595 ids,ide, jds,jde, kds,kde, & ! domain dims
4596 ims,ime, jms,jme, kms,kme, & ! memory dims
4597 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4598 grid%i_start(ij), grid%i_end(ij), &
4599 grid%j_start(ij), grid%j_end(ij), &
4600 k_start , k_end )
4602 CALL spec_bdy_final ( grid%ph_2, grid%muts, grid%c1h, grid%c2h, grid%msfty, &
4603 grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, &
4604 grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
4605 'h', config_flags, &
4606 config_flags%spec_bdy_width, grid%spec_zone, &
4607 grid%dtbc, &
4608 ids,ide, jds,jde, kds,kde, & ! domain dims
4609 ims,ime, jms,jme, kms,kme, & ! memory dims
4610 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4611 grid%i_start(ij), grid%i_end(ij), &
4612 grid%j_start(ij), grid%j_end(ij), &
4613 k_start , k_end )
4615 CALL spec_bdy_final ( grid%mu_2, grid%muts, grid%c1h, grid%c2h, grid%msfty, &
4616 grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, &
4617 grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
4618 'm', config_flags, &
4619 config_flags%spec_bdy_width, grid%spec_zone, &
4620 grid%dtbc, &
4621 ids,ide, jds,jde, 1, 1, & ! domain dims
4622 ims,ime, jms,jme, 1, 1, & ! memory dims
4623 ips,ipe, jps,jpe, 1, 1, & ! patch dims
4624 grid%i_start(ij), grid%i_end(ij), &
4625 grid%j_start(ij), grid%j_end(ij), &
4626 1 , 1 )
4628 moisture_loop_bdy_3 : DO im = PARAM_FIRST_SCALAR , num_3d_m
4630 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
4631 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
4632 CALL spec_bdy_final ( moist(ims,kms,jms,im), grid%muts, &
4633 grid%c1h, grid%c2h, grid%msfty, &
4634 moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
4635 moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
4636 moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
4637 moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
4638 't', config_flags, &
4639 config_flags%spec_bdy_width, grid%spec_zone, &
4640 grid%dtbc, &
4641 ids,ide, jds,jde, kds,kde, & ! domain dims
4642 ims,ime, jms,jme, kms,kme, & ! memory dims
4643 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4644 grid%i_start(ij), grid%i_end(ij), &
4645 grid%j_start(ij), grid%j_end(ij), &
4646 k_start , k_end )
4647 ENDIF
4649 END DO moisture_loop_bdy_3
4651 #if (WRF_CHEM == 1)
4652 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
4653 chem_species_bdy_loop_3 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
4655 IF( ( config_flags%nested ) ) THEN
4656 CALL spec_bdy_final ( chem(ims,kms,jms,ic), grid%muts, &
4657 grid%c1h, grid%c2h, grid%msfty, &
4658 chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
4659 chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
4660 chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
4661 chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
4662 't', config_flags, &
4663 config_flags%spec_bdy_width, grid%spec_zone, &
4664 grid%dtbc, &
4665 ids,ide, jds,jde, kds,kde, & ! domain dims
4666 ims,ime, jms,jme, kms,kme, & ! memory dims
4667 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4668 grid%i_start(ij), grid%i_end(ij), &
4669 grid%j_start(ij), grid%j_end(ij), &
4670 k_start , k_end )
4671 ENDIF
4673 END DO chem_species_bdy_loop_3
4674 ENDIF
4675 #endif
4677 tracer_species_bdy_loop_3 : DO im = PARAM_FIRST_SCALAR , num_tracer
4679 IF( ( config_flags%nested ) ) THEN
4680 CALL spec_bdy_final ( tracer(ims,kms,jms,im), grid%muts, &
4681 grid%c1h, grid%c2h, grid%msfty, &
4682 tracer_bxs(jms,kms,1,im),tracer_bxe(jms,kms,1,im), &
4683 tracer_bys(ims,kms,1,im),tracer_bye(ims,kms,1,im), &
4684 tracer_btxs(jms,kms,1,im),tracer_btxe(jms,kms,1,im), &
4685 tracer_btys(ims,kms,1,im),tracer_btye(ims,kms,1,im), &
4686 't', config_flags, &
4687 config_flags%spec_bdy_width, grid%spec_zone, &
4688 grid%dtbc, &
4689 ids,ide, jds,jde, kds,kde, & ! domain dims
4690 ims,ime, jms,jme, kms,kme, & ! memory dims
4691 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4692 grid%i_start(ij), grid%i_end(ij), &
4693 grid%j_start(ij), grid%j_end(ij), &
4694 k_start , k_end )
4695 ENDIF
4697 END DO tracer_species_bdy_loop_3
4699 scalar_species_bdy_loop_3 : DO is = PARAM_FIRST_SCALAR , num_3d_s
4701 IF( ( config_flags%nested ) ) THEN
4702 CALL spec_bdy_final ( scalar(ims,kms,jms,is), grid%muts, &
4703 grid%c1h, grid%c2h, grid%msfty, &
4704 scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
4705 scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
4706 scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
4707 scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
4708 't', config_flags, &
4709 config_flags%spec_bdy_width, grid%spec_zone, &
4710 grid%dtbc, &
4711 ids,ide, jds,jde, kds,kde, & ! domain dims
4712 ims,ime, jms,jme, kms,kme, & ! memory dims
4713 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4714 grid%i_start(ij), grid%i_end(ij), &
4715 grid%j_start(ij), grid%j_end(ij), &
4716 k_start , k_end )
4717 ENDIF
4719 END DO scalar_species_bdy_loop_3
4721 END DO tile_bc_loop_3
4722 !$OMP END PARALLEL DO
4724 ENDIF
4726 ! Move to the end of subroutine
4727 ! IF( config_flags%specified .or. config_flags%nested ) THEN
4728 ! grid%dtbc = grid%dtbc + grid%dt
4729 ! ENDIF
4731 ! reset surface w for consistency
4733 #ifdef DM_PARALLEL
4734 # include "HALO_EM_C.inc"
4735 # include "PERIOD_BDY_EM_E.inc"
4736 #endif
4738 CALL wrf_debug ( 10 , ' call set_w_surface' )
4739 fill_w_flag = .false.
4741 !$OMP PARALLEL DO &
4742 !$OMP PRIVATE ( ij )
4743 DO ij = 1 , grid%num_tiles
4744 CALL set_w_surface( config_flags, grid%znw, fill_w_flag, &
4745 grid%w_2, grid%ht, grid%u_2, grid%v_2, &
4746 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
4747 grid%msftx, grid%msfty, &
4748 ids, ide, jds, jde, kds, kde, &
4749 ims, ime, jms, jme, kms, kme, &
4750 grid%i_start(ij), grid%i_end(ij), &
4751 grid%j_start(ij), grid%j_end(ij), &
4752 k_start, k_end )
4754 END DO
4755 !$OMP END PARALLEL DO
4757 !-----------------------------------------------------------
4758 ! After all of the RK steps, after the microphysics, after p-rho-phi,
4759 ! after w, after filtering, we have data ready to use.
4760 !-----------------------------------------------------------
4762 ! CALL after_all_rk_steps ( grid, config_flags, &
4763 ! moist, chem, tracer, scalar, &
4764 ! th_phy, pi_phy, p_phy, &
4765 ! p8w, t8w, dz8w, &
4766 ! curr_secs, &
4767 ! diag_flag, &
4768 ! ids, ide, jds, jde, kds, kde, &
4769 ! ims, ime, jms, jme, kms, kme, &
4770 ! ips, ipe, jps, jpe, kps, kpe, &
4771 ! imsx, imex, jmsx, jmex, kmsx, kmex, &
4772 ! ipsx, ipex, jpsx, jpex, kpsx, kpex, &
4773 ! imsy, imey, jmsy, jmey, kmsy, kmey, &
4774 ! ipsy, ipey, jpsy, jpey, kpsy, kpey )
4776 CALL wrf_debug ( 200 , ' call end of solve_em' )
4778 ! not used in adjoint
4779 #endif
4780 ! Finish timers if compiled with -DBENCH.
4781 #include "bench_solve_em_end.h"
4783 !----------------------------------------
4784 ! Start adjoint computations
4785 !----------------------------------------
4786 ! Reset local adjoint variables
4787 a_cqu = 0.
4788 a_cqv = 0.
4789 a_cqw = 0.
4791 a_ru_tendf = 0.
4792 a_rv_tendf = 0.
4793 a_rw_tendf = 0.
4794 a_ph_tendf = 0.
4795 a_t_tendf = 0.
4796 a_mu_tendf = 0.
4798 a_ph_tend = 0.
4799 a_rw_tend = 0.
4800 a_mu_tend = 0.
4801 a_t_tend = 0.
4802 a_moist_tend = 0.
4803 a_tracer_tend = 0.
4804 a_scalar_tend = 0.
4805 a_tke_tend = 0.
4806 a_advect_tend = 0.
4807 a_h_tendency = 0.
4808 a_z_tendency = 0.
4810 a_th_phy = 0.
4811 a_p_phy = 0.
4812 a_pi_phy = 0.
4813 grid%a_t_phy = 0.
4814 grid%a_u_phy = 0.
4815 grid%a_v_phy = 0.
4816 grid%a_rho = 0.
4817 a_dz8w = 0.
4818 a_p8w = 0.
4819 a_t8w = 0.
4821 a_w_save = 0.
4822 a_ph_save = 0.
4823 a_mu_save = 0.
4824 a_t_2save = 0.
4825 a_ww1 = 0.
4826 a_moist_old = 0.
4827 a_tracer_old = 0.
4828 a_scalar_old = 0.
4830 grid%a_muus = 0.
4831 grid%a_muvs = 0.
4832 a_muave = 0.
4833 a_c2a = 0.
4834 a_pm1 = 0.
4835 a_a = 0.
4836 a_alpha = 0.
4837 a_gamma = 0.
4839 ! [1] Adjoint of the part after Runge Kutta loop
4841 #ifdef DM_PARALLEL
4842 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
4843 !-----------------------------------------------------------------------
4844 ! see above
4845 !--------------------------------------------------------------
4846 CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' )
4847 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4848 # include "HALO_EM_TRACER_E_3_AD.inc"
4849 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4850 # include "HALO_EM_TRACER_E_5_AD.inc"
4851 ELSE
4852 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4853 CALL wrf_error_fatal(TRIM(wrf_err_message))
4854 ENDIF
4855 ENDIF
4856 #endif
4858 #ifdef DM_PARALLEL
4859 !-----------------------------------------------------------------------
4860 ! see above
4861 !--------------------------------------------------------------
4862 CALL wrf_debug ( 200 , ' call HALO_RK_E' )
4863 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4864 # include "HALO_EM_E_3_AD.inc"
4865 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4866 # include "HALO_EM_E_5_AD.inc"
4867 ELSE
4868 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4869 CALL wrf_error_fatal(TRIM(wrf_err_message))
4870 ENDIF
4871 #endif
4873 #ifdef DM_PARALLEL
4874 IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
4875 !-----------------------------------------------------------------------
4876 ! see above
4877 !--------------------------------------------------------------
4878 CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
4879 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
4880 # include "HALO_EM_MOIST_E_3_AD.inc"
4881 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
4882 # include "HALO_EM_MOIST_E_5_AD.inc"
4883 ELSE
4884 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
4885 CALL wrf_error_fatal(TRIM(wrf_err_message))
4886 ENDIF
4887 ENDIF
4888 #endif
4890 ! Adjoint of resetting surface w for consistency
4892 CALL wrf_debug ( 10 , ' call a_set_w_surface' )
4893 fill_w_flag = .false.
4895 !$OMP PARALLEL DO &
4896 !$OMP PRIVATE ( ij )
4897 DO ij = grid%num_tiles,1,-1
4898 CALL a_set_w_surface( config_flags, grid%znw, fill_w_flag, &
4899 grid%w_2,grid%a_w_2, grid%ht, &
4900 grid%u_2,grid%a_u_2, grid%v_2,grid%a_v_2, &
4901 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy,&
4902 grid%msftx, grid%msfty, &
4903 ids, ide, jds, jde, kds, kde, &
4904 ims, ime, jms, jme, kms, kme, &
4905 grid%i_start(ij), grid%i_end(ij), &
4906 grid%j_start(ij), grid%j_end(ij), &
4907 k_start, k_end )
4908 END DO
4909 !$OMP END PARALLEL DO
4911 IF( config_flags%specified .or. config_flags%nested ) THEN
4913 !$OMP PARALLEL DO &
4914 !$OMP PRIVATE ( ij )
4915 adj_tile_bc_loop_3: DO ij = grid%num_tiles, 1, -1
4917 CALL wrf_debug ( 200 , ' call a_spec_bdy_final' )
4919 adj_scalar_species_bdy_loop_3 : DO is = num_3d_s, PARAM_FIRST_SCALAR , -1
4921 IF( ( config_flags%nested ) ) THEN
4922 CALL a_spec_bdy_final ( scalar(ims,kms,jms,is), a_scalar(ims,kms,jms,is), &
4923 grid%muts, grid%a_muts, grid%msfty, &
4924 scalar_bxs(jms,kms,1,is), a_scalar_bxs(jms,kms,1,is), &
4925 scalar_bxe(jms,kms,1,is), a_scalar_bxe(jms,kms,1,is), &
4926 scalar_bys(ims,kms,1,is), a_scalar_bys(ims,kms,1,is), &
4927 scalar_bye(ims,kms,1,is), a_scalar_bye(ims,kms,1,is), &
4928 scalar_btxs(jms,kms,1,is), a_scalar_btxs(jms,kms,1,is), &
4929 scalar_btxe(jms,kms,1,is), a_scalar_btxe(jms,kms,1,is), &
4930 scalar_btys(ims,kms,1,is), a_scalar_btys(ims,kms,1,is), &
4931 scalar_btye(ims,kms,1,is), a_scalar_btye(ims,kms,1,is), &
4932 't', config_flags, &
4933 config_flags%spec_bdy_width, grid%spec_zone, &
4934 grid%dtbc, &
4935 ids,ide, jds,jde, kds,kde, & ! domain dims
4936 ims,ime, jms,jme, kms,kme, & ! memory dims
4937 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4938 grid%i_start(ij), grid%i_end(ij), &
4939 grid%j_start(ij), grid%j_end(ij), &
4940 k_start , k_end )
4941 ENDIF
4943 END DO adj_scalar_species_bdy_loop_3
4945 adj_tracer_species_bdy_loop_3 : DO im = num_tracer, PARAM_FIRST_SCALAR , -1
4947 IF( ( config_flags%nested ) ) THEN
4948 CALL a_spec_bdy_final ( tracer(ims,kms,jms,im), a_tracer(ims,kms,jms,im), &
4949 grid%muts, grid%a_muts, grid%msfty, &
4950 tracer_bxs(jms,kms,1,im), a_tracer_bxs(jms,kms,1,im), &
4951 tracer_bxe(jms,kms,1,im), a_tracer_bxe(jms,kms,1,im), &
4952 tracer_bys(ims,kms,1,im), a_tracer_bys(ims,kms,1,im), &
4953 tracer_bye(ims,kms,1,im), a_tracer_bye(ims,kms,1,im), &
4954 tracer_btxs(jms,kms,1,im), a_tracer_btxs(jms,kms,1,im), &
4955 tracer_btxe(jms,kms,1,im), a_tracer_btxe(jms,kms,1,im), &
4956 tracer_btys(ims,kms,1,im), a_tracer_btys(ims,kms,1,im), &
4957 tracer_btye(ims,kms,1,im), a_tracer_btye(ims,kms,1,im), &
4958 't', config_flags, &
4959 config_flags%spec_bdy_width, grid%spec_zone, &
4960 grid%dtbc, &
4961 ids,ide, jds,jde, kds,kde, & ! domain dims
4962 ims,ime, jms,jme, kms,kme, & ! memory dims
4963 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4964 grid%i_start(ij), grid%i_end(ij), &
4965 grid%j_start(ij), grid%j_end(ij), &
4966 k_start , k_end )
4967 ENDIF
4969 END DO adj_tracer_species_bdy_loop_3
4971 #if (WRF_CHEM == 1)
4972 IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
4973 adj_chem_species_bdy_loop_3 : DO ic = num_3d_c, PARAM_FIRST_SCALAR , -1
4975 IF( ( config_flags%nested ) ) THEN
4976 ! CALL a_spec_bdy_final ( chem(ims,kms,jms,ic), a_chem(ims,kms,jms,ic), &
4977 ! grid%muts, grid%a_muts, grid%msfty, &
4978 ! chem_bxs(jms,kms,1,ic), a_chem_bxs(jms,kms,1,ic), &
4979 ! chem_bxe(jms,kms,1,ic), a_chem_bxe(jms,kms,1,ic), &
4980 ! chem_bys(ims,kms,1,ic), a_chem_bys(ims,kms,1,ic), &
4981 ! chem_bye(ims,kms,1,ic), a_chem_bye(ims,kms,1,ic), &
4982 ! chem_btxs(jms,kms,1,ic), a_chem_btxs(jms,kms,1,ic), &
4983 ! chem_btxe(jms,kms,1,ic), a_chem_btxe(jms,kms,1,ic), &
4984 ! chem_btys(ims,kms,1,ic), a_chem_btys(ims,kms,1,ic), &
4985 ! chem_btye(ims,kms,1,ic), a_chem_btye(ims,kms,1,ic), &
4986 !hcl-beg no a_chem for now
4987 CALL a_spec_bdy_final ( chem(ims,kms,jms,ic), chem(ims,kms,jms,ic), &
4988 grid%muts, grid%a_muts, grid%msfty, &
4989 chem_bxs(jms,kms,1,ic), chem_bxs(jms,kms,1,ic), &
4990 chem_bxe(jms,kms,1,ic), chem_bxe(jms,kms,1,ic), &
4991 chem_bys(ims,kms,1,ic), chem_bys(ims,kms,1,ic), &
4992 chem_bye(ims,kms,1,ic), chem_bye(ims,kms,1,ic), &
4993 chem_btxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
4994 chem_btxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
4995 chem_btys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
4996 chem_btye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
4997 !hcl-end no a_chem for now
4998 't', config_flags, &
4999 config_flags%spec_bdy_width, grid%spec_zone, &
5000 grid%dtbc, &
5001 ids,ide, jds,jde, kds,kde, & ! domain dims
5002 ims,ime, jms,jme, kms,kme, & ! memory dims
5003 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5004 grid%i_start(ij), grid%i_end(ij), &
5005 grid%j_start(ij), grid%j_end(ij), &
5006 k_start , k_end )
5007 ENDIF
5009 END DO adj_chem_species_bdy_loop_3
5010 ENDIF
5011 #endif
5013 adj_moisture_loop_bdy_3 : DO im = num_3d_m, PARAM_FIRST_SCALAR , -1
5015 IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
5016 ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
5017 CALL a_spec_bdy_final ( moist(ims,kms,jms,im), a_moist(ims,kms,jms,im), &
5018 grid%muts, grid%a_muts, grid%msfty, &
5019 moist_bxs(jms,kms,1,im), a_moist_bxs(jms,kms,1,im), &
5020 moist_bxe(jms,kms,1,im), a_moist_bxe(jms,kms,1,im), &
5021 moist_bys(ims,kms,1,im), a_moist_bys(ims,kms,1,im), &
5022 moist_bye(ims,kms,1,im), a_moist_bye(ims,kms,1,im), &
5023 moist_btxs(jms,kms,1,im), a_moist_btxs(jms,kms,1,im), &
5024 moist_btxe(jms,kms,1,im), a_moist_btxe(jms,kms,1,im), &
5025 moist_btys(ims,kms,1,im), a_moist_btys(ims,kms,1,im), &
5026 moist_btye(ims,kms,1,im), a_moist_btye(ims,kms,1,im), &
5027 't', config_flags, &
5028 config_flags%spec_bdy_width, grid%spec_zone, &
5029 grid%dtbc, &
5030 ids,ide, jds,jde, kds,kde, & ! domain dims
5031 ims,ime, jms,jme, kms,kme, & ! memory dims
5032 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5033 grid%i_start(ij), grid%i_end(ij), &
5034 grid%j_start(ij), grid%j_end(ij), &
5035 k_start , k_end )
5036 ENDIF
5038 END DO adj_moisture_loop_bdy_3
5040 CALL a_spec_bdy_final ( grid%mu_2, grid%a_mu_2, grid%muts, grid%a_muts, grid%msfty, &
5041 grid%mu_bxs, grid%a_mu_bxs, grid%mu_bxe, grid%a_mu_bxe, &
5042 grid%mu_bys, grid%a_mu_bys, grid%mu_bye, grid%a_mu_bye, &
5043 grid%mu_btxs,grid%a_mu_btxs,grid%mu_btxe,grid%a_mu_btxe, &
5044 grid%mu_btys,grid%a_mu_btys,grid%mu_btye,grid%a_mu_btye, &
5045 'm', config_flags, &
5046 config_flags%spec_bdy_width, grid%spec_zone, &
5047 grid%dtbc, &
5048 ids,ide, jds,jde, 1, 1, & ! domain dims
5049 ims,ime, jms,jme, 1, 1, & ! memory dims
5050 ips,ipe, jps,jpe, 1, 1, & ! patch dims
5051 grid%i_start(ij), grid%i_end(ij), &
5052 grid%j_start(ij), grid%j_end(ij), &
5053 1 , 1 )
5055 CALL a_spec_bdy_final ( grid%ph_2, grid%a_ph_2, grid%muts, grid%a_muts, grid%msfty, &
5056 grid%ph_bxs, grid%a_ph_bxs, grid%ph_bxe, grid%a_ph_bxe, &
5057 grid%ph_bys, grid%a_ph_bys, grid%ph_bye, grid%a_ph_bye, &
5058 grid%ph_btxs,grid%a_ph_btxs,grid%ph_btxe,grid%a_ph_btxe, &
5059 grid%ph_btys,grid%a_ph_btys,grid%ph_btye,grid%a_ph_btye, &
5060 'h', config_flags, &
5061 config_flags%spec_bdy_width, grid%spec_zone, &
5062 grid%dtbc, &
5063 ids,ide, jds,jde, kds,kde, & ! domain dims
5064 ims,ime, jms,jme, kms,kme, & ! memory dims
5065 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5066 grid%i_start(ij), grid%i_end(ij), &
5067 grid%j_start(ij), grid%j_end(ij), &
5068 k_start , k_end )
5070 CALL a_spec_bdy_final ( grid%t_2, grid%a_t_2, grid%muts, grid%a_muts, grid%msfty, &
5071 grid%t_bxs, grid%a_t_bxs, grid%t_bxe, grid%a_t_bxe, &
5072 grid%t_bys, grid%a_t_bys, grid%t_bye, grid%a_t_bye, &
5073 grid%t_btxs,grid%a_t_btxs,grid%t_btxe,grid%a_t_btxe, &
5074 grid%t_btys,grid%a_t_btys,grid%t_btye,grid%a_t_btye, &
5075 't', config_flags, &
5076 config_flags%spec_bdy_width, grid%spec_zone, &
5077 grid%dtbc, &
5078 ids,ide, jds,jde, kds,kde, & ! domain dims
5079 ims,ime, jms,jme, kms,kme, & ! memory dims
5080 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5081 grid%i_start(ij), grid%i_end(ij), &
5082 grid%j_start(ij), grid%j_end(ij), &
5083 k_start , k_end )
5085 IF( config_flags%nested) THEN
5086 CALL a_spec_bdy_final ( grid%w_2, grid%a_w_2, grid%muts, grid%a_muts, grid%msfty, &
5087 grid%w_bxs, grid%a_w_bxs, grid%w_bxe, grid%a_w_bxe, &
5088 grid%w_bys, grid%a_w_bys, grid%w_bye, grid%a_w_bye, &
5089 grid%w_btxs,grid%a_w_btxs,grid%w_btxe,grid%a_w_btxe, &
5090 grid%w_btys,grid%a_w_btys,grid%w_btye,grid%a_w_btye, &
5091 'w', config_flags, &
5092 config_flags%spec_bdy_width, grid%spec_zone, &
5093 grid%dtbc, &
5094 ids,ide, jds,jde, kds,kde, & ! domain dims
5095 ims,ime, jms,jme, kms,kme, & ! memory dims
5096 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5097 grid%i_start(ij), grid%i_end(ij), &
5098 grid%j_start(ij), grid%j_end(ij), &
5099 k_start , k_end )
5100 ENDIF
5102 CALL a_spec_bdy_final ( grid%v_2, grid%a_v_2, grid%muvs, grid%a_muvs, grid%msfvx, &
5103 grid%v_bxs, grid%a_v_bxs, grid%v_bxe, grid%a_v_bxe, &
5104 grid%v_bys, grid%a_v_bys, grid%v_bye, grid%a_v_bye, &
5105 grid%v_btxs,grid%a_v_btxs,grid%v_btxe,grid%a_v_btxe, &
5106 grid%v_btys,grid%a_v_btys,grid%v_btye,grid%a_v_btye, &
5107 'v', config_flags, &
5108 config_flags%spec_bdy_width, grid%spec_zone, &
5109 grid%dtbc, &
5110 ids,ide, jds,jde, kds,kde, & ! domain dims
5111 ims,ime, jms,jme, kms,kme, & ! memory dims
5112 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5113 grid%i_start(ij), grid%i_end(ij), &
5114 grid%j_start(ij), grid%j_end(ij), &
5115 k_start , k_end )
5117 CALL a_spec_bdy_final ( grid%u_2, grid%a_u_2, grid%muus, grid%a_muus, grid%msfuy, &
5118 grid%u_bxs, grid%a_u_bxs, grid%u_bxe, grid%a_u_bxe, &
5119 grid%u_bys, grid%a_u_bys, grid%u_bye, grid%a_u_bye, &
5120 grid%u_btxs,grid%a_u_btxs,grid%u_btxe,grid%a_u_btxe, &
5121 grid%u_btys,grid%a_u_btys,grid%u_btye,grid%a_u_btye, &
5122 'u', config_flags, &
5123 config_flags%spec_bdy_width, grid%spec_zone, &
5124 grid%dtbc, &
5125 ids,ide, jds,jde, kds,kde, & ! domain dims
5126 ims,ime, jms,jme, kms,kme, & ! memory dims
5127 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5128 grid%i_start(ij), grid%i_end(ij), &
5129 grid%j_start(ij), grid%j_end(ij), &
5130 k_start , k_end )
5132 END DO adj_tile_bc_loop_3
5133 !$OMP END PARALLEL DO
5135 ENDIF
5137 BENCH_START(adj_bc_2d_tim)
5139 !$OMP PARALLEL DO &
5140 !$OMP PRIVATE ( ij )
5141 adj_tile_bc_loop_2: DO ij = grid%num_tiles,1,-1
5143 CALL wrf_debug ( 200 , ' call a_set_phys_bc_dry_2' )
5145 adj_scalar_species_bdy_loop_2 : DO is = num_3d_s,PARAM_FIRST_SCALAR,-1
5147 CALL a_set_physical_bc3d( a_scalar(ims,kms,jms,is) , 'p', config_flags, &
5148 ids, ide, jds, jde, kds, kde, &
5149 ims, ime, jms, jme, kms, kme, &
5150 ips, ipe, jps, jpe, kps, kpe, &
5151 grid%i_start(ij), grid%i_end(ij), &
5152 grid%j_start(ij), grid%j_end(ij), &
5153 k_start , k_end )
5155 END DO adj_scalar_species_bdy_loop_2
5157 adj_tracer_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_tracer
5159 CALL a_set_physical_bc3d( a_tracer(ims,kms,jms,ic), 'p', config_flags, &
5160 ids, ide, jds, jde, kds, kde, &
5161 ims, ime, jms, jme, kms, kme, &
5162 ips, ipe, jps, jpe, kps, kpe, &
5163 grid%i_start(ij), grid%i_end(ij), &
5164 grid%j_start(ij), grid%j_end(ij), &
5165 k_start , k_end )
5167 END DO adj_tracer_species_bdy_loop_2
5169 adj_moisture_loop_bdy_2 : DO im = num_3d_m,PARAM_FIRST_SCALAR,-1
5171 CALL a_set_physical_bc3d( a_moist(ims,kms,jms,im), 'p', &
5172 config_flags, &
5173 ids, ide, jds, jde, kds, kde, &
5174 ims, ime, jms, jme, kms, kme, &
5175 ips, ipe, jps, jpe, kps, kpe, &
5176 grid%i_start(ij), grid%i_end(ij), &
5177 grid%j_start(ij), grid%j_end(ij), &
5178 k_start , k_end )
5180 END DO adj_moisture_loop_bdy_2
5182 CALL a_set_physical_bc3d( grid%a_tke_2 , 'p', config_flags, &
5183 ids, ide, jds, jde, kds, kde, &
5184 ims, ime, jms, jme, kms, kme, &
5185 ips, ipe, jps, jpe, kps, kpe, &
5186 grid%i_start(ij), grid%i_end(ij), &
5187 grid%j_start(ij), grid%j_end(ij), &
5188 k_start , k_end )
5190 CALL a_set_physical_bc3d( grid%a_tke_1, 'p', config_flags, &
5191 ids, ide, jds, jde, kds, kde, &
5192 ims, ime, jms, jme, kms, kme, &
5193 ips, ipe, jps, jpe, kps, kpe, &
5194 grid%i_start(ij), grid%i_end(ij), &
5195 grid%j_start(ij), grid%j_end(ij), &
5196 k_start , k_end-1 )
5198 !CALL pop2restore (grid%mu_2, "mu")
5199 !CALL pop2restore (grid%ph_2, "ph")
5200 !CALL pop2restore (grid%u_2,grid%v_2,grid%w_2, grid%t_2, "u, v, w,t ")
5201 CALL a_set_phys_bc_dry_2( config_flags, &
5202 grid%u_1,grid%a_u_1, grid%u_2,grid%a_u_2, &
5203 grid%v_1,grid%a_v_1, grid%v_2,grid%a_v_2, &
5204 grid%w_1,grid%a_w_1, grid%w_2,grid%a_w_2, &
5205 grid%t_1,grid%a_t_1, grid%t_2,grid%a_t_2, &
5206 grid%ph_1,grid%a_ph_1, grid%ph_2,grid%a_ph_2, &
5207 grid%mu_1,grid%a_mu_1, grid%mu_2,grid%a_mu_2, &
5208 ids, ide, jds, jde, kds, kde, &
5209 ims, ime, jms, jme, kms, kme, &
5210 ips, ipe, jps, jpe, kps, kpe, &
5211 grid%i_start(ij), grid%i_end(ij), &
5212 grid%j_start(ij), grid%j_end(ij), &
5213 k_start , k_end )
5215 END DO adj_tile_bc_loop_2
5216 !$OMP END PARALLEL DO
5218 BENCH_END(adj_bc_2d_tim)
5220 #ifdef DM_PARALLEL
5221 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
5222 # include "HALO_EM_D3_3_AD.inc"
5223 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
5224 # include "HALO_EM_D3_5_AD.inc"
5225 ELSE
5226 WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
5227 CALL wrf_error_fatal(TRIM(wrf_err_message))
5228 ENDIF
5229 #endif
5231 IF (.not. config_flags%non_hydrostatic) THEN
5233 !CALL pop2restore (ph_tend, "ph_tend")
5234 !CALL pop2restore (grid%muts, "muts")
5235 !$OMP PARALLEL DO &
5236 !$OMP PRIVATE ( ij )
5237 DO ij = grid%num_tiles,1,-1
5238 CALL a_diagnose_w( ph_tend,a_ph_tend, grid%ph_2,grid%a_ph_2, grid%ph_1,grid%a_ph_1, &
5239 grid%w_2,grid%a_w_2, grid%muts,grid%a_muts, dt_rk, &
5240 grid%u_2,grid%a_u_2, grid%v_2,grid%a_v_2, grid%ht, &
5241 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
5242 ids, ide, jds, jde, kds, kde, &
5243 ims, ime, jms, jme, kms, kme, &
5244 grid%i_start(ij), grid%i_end(ij), &
5245 grid%j_start(ij), grid%j_end(ij), &
5246 k_start , k_end )
5247 END DO
5248 !$OMP END PARALLEL DO
5250 #ifdef DM_PARALLEL
5251 # include "HALO_EM_HYDRO_UV_AD.inc"
5252 #endif
5253 END IF
5255 ! Adjoint of time-split physics
5257 BENCH_START(adj_moist_phys_end_tim)
5259 !CALL pop2restore (moist, "moist")
5260 !CALL pop2restore (grid%ph_2,grid%t_2, "ph,t")
5261 !CALL pop2restore (grid%mu_2,grid%muts, "mu,muts")
5262 !$OMP PARALLEL DO &
5263 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
5265 adj_scalar_tile_loop_1ba: DO ij = grid%num_tiles,1,-1
5267 IF ( config_flags%periodic_x ) THEN
5268 its = max(grid%i_start(ij),ids)
5269 ite = min(grid%i_end(ij),ide-1)
5270 ELSE
5271 its = max(grid%i_start(ij),ids+sz)
5272 ite = min(grid%i_end(ij),ide-1-sz)
5273 ENDIF
5274 jts = max(grid%j_start(ij),jds+sz)
5275 jte = min(grid%j_end(ij),jde-1-sz)
5278 CALL a_calc_p_rho_phi( moist,a_moist, num_3d_m, config_flags%hypsometric_opt, &
5279 grid%al,grid%a_al, grid%alb, grid%mu_2,grid%a_mu_2, grid%muts,grid%a_muts, &
5280 grid%ph_2,grid%a_ph_2, grid%phb,grid%p,grid%a_p, grid%pb, grid%t_2,grid%a_t_2, &
5281 p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, &
5282 grid%rdn, config_flags%non_hydrostatic, &
5283 ids, ide, jds, jde, kds, kde, &
5284 ims, ime, jms, jme, kms, kme, &
5285 its, ite, jts, jte, &
5286 k_start , k_end )
5287 END DO adj_scalar_tile_loop_1ba
5288 !$OMP END PARALLEL DO
5290 IF (config_flags%mp_physics /= 0) then
5292 CALL wrf_debug ( 200 , ' call a_moist_physics_finish' )
5294 !$OMP PARALLEL DO &
5295 !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
5297 DO ij = grid%num_tiles,1,-1
5299 !======[P4.2.5.3_adj]=====================================================
5300 IF ( config_flags%periodic_x ) THEN
5301 its = max(grid%i_start(ij),ids)
5302 ite = min(grid%i_end(ij),ide-1)
5303 ELSE
5304 its = max(grid%i_start(ij),ids+sz)
5305 ite = min(grid%i_end(ij),ide-1-sz)
5306 ENDIF
5307 jts = max(grid%j_start(ij),jds+sz)
5308 jte = min(grid%j_end(ij),jde-1-sz)
5310 !CALL POPREAL8ARRAY ( grid%qc_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5311 !CALL POPREAL8ARRAY ( grid%qv_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5312 CALL POPREAL8ARRAY ( grid%h_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5313 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5314 CALL a_moist_physics_finish_em( grid%t_2, grid%a_t_2, grid%t_1, &
5315 t0, grid%muts, &
5316 th_phy, a_th_phy, &
5317 grid%h_diabatic,grid%a_h_diabatic, &
5318 moist(ims,kms,jms,P_QV),a_moist(ims,kms,jms,P_QV), &
5319 grid%qv_diabatic, grid%a_qv_diabatic, &
5320 moist(ims,kms,jms,P_QC),a_moist(ims,kms,jms,P_QC), &
5321 grid%qc_diabatic, grid%a_qc_diabatic, &
5322 dtm, config_flags, &
5323 #if ( WRF_DFI_RADAR == 1 )
5324 grid%dfi_tten_rad, a_grid%dfi_tten_rad, &
5325 grid%dfi_stage, &
5326 #endif
5327 ids, ide, jds, jde, kds, kde, &
5328 ims, ime, jms, jme, kms, kme, &
5329 its, ite, jts, jte, &
5330 k_start , k_end )
5332 !Remove codes on chem from [P4.2.5.4]
5334 CALL a_microphysics_zero_outa ( &
5335 tracer , a_tracer, num_tracer , config_flags , &
5336 ids, ide, jds, jde, kds, kde, &
5337 ims, ime, jms, jme, kms, kme, &
5338 its, ite, jts, jte, &
5339 k_start , k_end )
5341 CALL a_microphysics_zero_outa ( &
5342 scalar ,a_scalar, num_scalar , config_flags , &
5343 ids, ide, jds, jde, kds, kde, &
5344 ims, ime, jms, jme, kms, kme, &
5345 its, ite, jts, jte, &
5346 k_start , k_end )
5348 CALL POPREAL8ARRAY ( moist, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
5349 CALL a_microphysics_zero_outa ( &
5350 moist , a_moist, num_moist , config_flags , &
5351 ids, ide, jds, jde, kds, kde, &
5352 ims, ime, jms, jme, kms, kme, &
5353 its, ite, jts, jte, &
5354 k_start , k_end )
5356 its = max(grid%i_start(ij),ids)
5357 ite = min(grid%i_end(ij),ide-1)
5358 jts = max(grid%j_start(ij),jds)
5359 jte = min(grid%j_end(ij),jde-1)
5361 ! Remove codes on chem from [P4.2.5.2]
5363 CALL a_microphysics_zero_outb ( &
5364 tracer , a_tracer, num_tracer , config_flags , &
5365 ids, ide, jds, jde, kds, kde, &
5366 ims, ime, jms, jme, kms, kme, &
5367 its, ite, jts, jte, &
5368 k_start , k_end )
5370 CALL a_microphysics_zero_outb ( &
5371 scalar , a_scalar, num_scalar , config_flags , &
5372 ids, ide, jds, jde, kds, kde, &
5373 ims, ime, jms, jme, kms, kme, &
5374 its, ite, jts, jte, &
5375 k_start , k_end )
5377 CALL a_microphysics_zero_outb ( &
5378 moist , a_moist, num_moist , config_flags , &
5379 ids, ide, jds, jde, kds, kde, &
5380 ims, ime, jms, jme, kms, kme, &
5381 its, ite, jts, jte, &
5382 k_start , k_end )
5384 END DO
5385 !$OMP END PARALLEL DO
5386 BENCH_END(adj_moist_phys_end_tim)
5388 CALL wrf_debug ( 200 , ' call a_microphysics_driver' )
5390 grid%sr = 0.
5391 specified_bdy = config_flags%specified .OR. config_flags%nested
5392 channel_bdy = config_flags%specified .AND. config_flags%periodic_x
5394 BENCH_START(adj_micro_driver_tim)
5396 !Variables need to be saved: th, p, qv_curr, rho, pi_phy, dz8w, rainnc, rainncv
5397 !!!! Need to replace the variables marked as "!zzma" if other scheme will be added in the furture. (comments from zzma 01/10/2011)
5399 ! Consider diaflag when coding the adjoint of nssl_2mom_driver
5400 !
5401 ! WRFU_AlarmIsRinging always returned false, so using an alternate method to find out if it is time
5402 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
5403 !
5404 ! diagflag = .false.
5405 ! CALL WRFU_ALARMGET(grid%alarms( HISTORY_ALARM
5406 ! ),prevringtime=temp_time,RingInterval=intervaltime)
5407 ! CALL WRFU_ALARMGET(grid%alarms( RESTART_ALARM
5408 ! ),prevringtime=restart_time,RingInterval=restartinterval)
5409 ! CALL domain_clock_get ( grid, current_time=CurrTime )
5410 ! old_dt=min(old_dt,grid%dt)
5411 ! num = INT(old_dt * precision)
5412 ! den = precision
5413 ! CALL WRFU_TimeIntervalSet(dtInterval, Sn=num, Sd=den)
5414 ! IF (CurrTime .ge. temp_time + intervaltime - dtInterval .or. &
5415 ! CurrTime .ge. restart_time + restartinterval - dtInterval ) THEN
5416 ! diagflag = .true.
5417 ! ENDIF
5418 ! WRITE(wrf_err_message,*)'diag_flag=',diag_flag
5419 ! CALL wrf_debug ( 0 , wrf_err_message )
5421 CALL POPREAL8ARRAY ( th_phy, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5422 CALL POPREAL8ARRAY ( moist, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
5423 !CALL pop2restore (p_phy,"p_phy")
5424 !CALL pop2restore (th_phy,"th_phy")
5425 !CALL pop2restore (grid%rho,"rho")
5426 !CALL pop2restore (p8w,"p8w")
5427 !CALL pop2restore (dz8w,"dz8w")
5428 !CALL pop2restore (pi_phy,"pi_phy")
5429 !CALL pop2restore (moist,"moist")
5430 CALL a_microphysics_driver( &
5431 & DT=dtm ,DX=grid%dx ,DY=grid%dy &
5432 & ,DZ8W=dz8w ,DZ8WB=a_dz8w, F_ICE_PHY=grid%f_ice_phy &
5433 & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
5434 & ,P8W=p8w ,P=p_phy ,PB=a_p_phy &
5435 & ,PI_PHY=pi_phy,PI_PHYB=a_pi_phy &
5436 & ,RHO=grid%rho ,RHOB=grid%a_rho, SPEC_ZONE=grid%spec_zone &
5437 & ,SR=grid%sr ,TH=th_phy,THB=a_th_phy &
5438 & ,refl_10cm=grid%refl_10cm & ! hm, 9/22/09 for refl
5439 & ,WARM_RAIN=grid%warm_rain &
5440 & ,T8W=t8w &
5441 & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
5442 & ,NSOURCE=grid%qndropsource &
5443 #if (WRF_CHEM==1)
5444 & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
5445 & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
5446 & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
5447 #endif
5448 & ,XLAND=grid%xland &
5449 & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
5450 & ,F_RAIN_PHY=grid%f_rain_phy &
5451 & ,F_RIMEF_PHY=grid%f_rimef_phy &
5452 & ,MP_PHYSICS=config_flags%mp_physics &
5453 & ,ID=grid%id &
5454 & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
5455 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
5456 & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
5457 & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
5458 & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
5459 & ,KTS=k_start, KTE=min(k_end,kde-1) &
5460 & ,NUM_TILES=grid%num_tiles &
5461 & ,NAER=grid%naer &
5462 ! Optional
5463 & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
5464 & , RAINNCB=grid%a_rainnc, RAINNCVB=grid%a_rainncv &
5465 & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
5466 & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ! for milbrandt2mom
5467 & , HAILNC=grid%hailnc, HAILNCV=grid%hailncv &
5468 & , W=grid%w_2, Z=grid%z, HT=grid%ht &
5469 & , MP_RESTART_STATE=grid%mp_restart_state &
5470 & , TBPVS_STATE=grid%tbpvs_state & ! etampnew
5471 & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
5472 & , QV_CURR=moist(ims,kms,jms,P_QV),QV_CURRB=a_moist(ims,kms,jms,P_QV), F_QV=F_QV &
5473 & , QC_CURR=moist(ims,kms,jms,P_QC),QC_CURRB=a_moist(ims,kms,jms,P_QC), F_QC=F_QC &
5474 & , QR_CURR=moist(ims,kms,jms,P_QR),QR_CURRB=a_moist(ims,kms,jms,P_QR), F_QR=F_QR &
5475 & , QI_CURR=moist(ims,kms,jms,P_QI),QI_CURRB=a_moist(ims,kms,jms,P_QI), F_QI=F_QI &
5476 & , QS_CURR=moist(ims,kms,jms,P_QS),QS_CURRB=a_moist(ims,kms,jms,P_QS), F_QS=F_QS &
5477 & , QG_CURR=moist(ims,kms,jms,P_QG),QG_CURRB=a_moist(ims,kms,jms,P_QG), F_QG=F_QG &
5478 & , QH_CURR=moist(ims,kms,jms,P_QH), F_QH=F_QH & ! for milbrandt2mom
5479 & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
5480 #if (WRF_CHEM==1)
5481 & , RAINPROD=grid%rainprod, EVAPPROD=grid%evapprod &
5482 & , QV_B4MP=grid%qv_b4mp,QC_B4MP=grid%qc_b4mp &
5483 & , QI_B4MP=grid%qi_b4mp, QS_B4MP=grid%qs_b4mp &
5484 #endif
5485 & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
5486 & , QNN_CURR=scalar(ims,kms,jms,P_QNN), F_QNN=F_QNN &
5487 & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
5488 & , QNC_CURR=scalar(ims,kms,jms,P_QNC), F_QNC=F_QNC &
5489 & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
5490 & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
5491 & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
5492 & , QNH_CURR=scalar(ims,kms,jms,P_QNH), F_QNH=F_QNH & ! for milbrandt2mom and nssl_2mom
5493 ! & , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR & ! for milbrandt3mom
5494 ! & , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI & ! "
5495 ! & , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS & ! "
5496 ! & , QZG_CURR=scalar(ims,kms,jms,P_QZG), F_QZG=F_QZG & ! "
5497 ! & , QZH_CURR=scalar(ims,kms,jms,P_QZH), F_QZH=F_QZH & ! "
5498 & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom
5499 & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom
5500 & , QDCN_CURR=scalar(ims,kms,jms,P_QDCN), F_QDCN=F_QDCN & ! for ntu3m
5501 & , QTCN_CURR=scalar(ims,kms,jms,P_QTCN), F_QTCN=F_QTCN & ! for ntu3m
5502 & , QCCN_CURR=scalar(ims,kms,jms,P_QCCN), F_QCCN=F_QCCN & ! for ntu3m
5503 & , QRCN_CURR=scalar(ims,kms,jms,P_QRCN), F_QRCN=F_QRCN & ! for ntu3m
5504 & , QNIN_CURR=scalar(ims,kms,jms,P_QNIN), F_QNIN=F_QNIN & ! for ntu3m
5505 & , FI_CURR=scalar(ims,kms,jms,P_FI), F_FI=F_FI & ! for ntu3m
5506 & , FS_CURR=scalar(ims,kms,jms,P_FS), F_FS=F_FS & ! for ntu3m
5507 & , VI_CURR=scalar(ims,kms,jms,P_VI), F_VI=F_VI & ! for ntu3m
5508 & , VS_CURR=scalar(ims,kms,jms,P_VS), F_VS=F_VS & ! for ntu3m
5509 & , VG_CURR=scalar(ims,kms,jms,P_VG), F_VG=F_VG & ! for ntu3m
5510 & , AI_CURR=scalar(ims,kms,jms,P_AI), F_AI=F_AI & ! for ntu3m
5511 & , AS_CURR=scalar(ims,kms,jms,P_AS), F_AS=F_AS & ! for ntu3m
5512 & , AG_CURR=scalar(ims,kms,jms,P_AG), F_AG=F_AG & ! for ntu3m
5513 & , AH_CURR=scalar(ims,kms,jms,P_AH), F_AH=F_AH & ! for ntu3m
5514 & , I3M_CURR=scalar(ims,kms,jms,P_I3M), F_I3M=F_I3m & ! for ntu3m
5515 & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
5516 & , qicuten=grid%rqicuten &
5517 & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
5518 & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
5519 ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom)
5520 ! YLIN
5521 ! RI_CURR INPUT
5522 & , RI_CURR=grid%rimi &
5523 & , diagflag=diag_flag, do_radar_ref=config_flags%do_radar_ref &
5524 )
5525 BENCH_END(adj_micro_driver_tim)
5527 #ifdef DM_PARALLEL
5528 # include "HALO_EM_SBM_AD.inc"
5529 #endif
5531 grid%a_sr = 0.
5533 !CALL pop2restore (grid%rho,"rho")
5534 !CALL pop2restore (grid%t_2,"t")
5535 !CALL pop2restore (grid%al,"al")
5536 !CALL pop2restore (grid%p,"p")
5537 !CALL pop2restore (dz8w,"dz8w")
5538 !CALL pop2restore (grid%ph_2,"ph_2")
5539 !CALL pop2restore (pi_phy,"pi_phy")
5540 !CALL pop2restore (p_phy,"p_phy")
5541 !CALL pop2restore (th_phy,"th_phy")
5542 !CALL pop2restore (grid%z,"z")
5543 !CALL pop2restore (grid%z_at_w,"z_at_w")
5544 !CALL pop2restore (grid%h_diabatic,"h_diabatic")
5545 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5546 CALL POPREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5548 !$OMP PARALLEL DO &
5549 !$OMP PRIVATE ( ij, its, ite, jts, jte )
5551 adj_scalar_tile_loop_1a: DO ij = grid%num_tiles,1,-1
5553 IF ( config_flags%periodic_x ) THEN
5554 its = max(grid%i_start(ij),ids)
5555 ite = min(grid%i_end(ij),ide-1)
5556 ELSE
5557 its = max(grid%i_start(ij),ids+sz)
5558 ite = min(grid%i_end(ij),ide-1-sz)
5559 ENDIF
5560 jts = max(grid%j_start(ij),jds+sz)
5561 jte = min(grid%j_end(ij),jde-1-sz)
5563 CALL wrf_debug ( 200 , ' call a_moist_physics_prep' )
5564 BENCH_START(adj_moist_physics_prep_tim)
5566 CALL a_moist_physics_prep_em( grid%t_2,grid%a_t_2, grid%t_1, &
5567 t0, grid%rho,grid%a_rho, &
5568 grid%al,grid%a_al, grid%alb, &
5569 grid%p,grid%a_p, p8w,a_p8w, &
5570 p0, grid%pb, &
5571 grid%ph_2,grid%a_ph_2, grid%phb, &
5572 th_phy, a_th_phy, pi_phy, a_pi_phy, &
5573 p_phy, a_p_phy, &
5574 grid%z, grid%a_z, grid%z_at_w, grid%a_z_at_w, &
5575 dz8w, a_dz8w, &
5576 dtm, grid%h_diabatic, grid%a_h_diabatic, &
5577 moist(ims,kms,jms,P_QV),a_moist(ims,kms,jms,P_QV), &
5578 grid%qv_diabatic, grid%a_qv_diabatic, &
5579 moist(ims,kms,jms,P_QC),a_moist(ims,kms,jms,P_QC), &
5580 grid%qc_diabatic, grid%a_qc_diabatic, &
5581 config_flags,grid%fnm, grid%fnp, &
5582 ids, ide, jds, jde, kds, kde, &
5583 ims, ime, jms, jme, kms, kme, &
5584 its, ite, jts, jte, &
5585 k_start , k_end )
5587 BENCH_END(adj_moist_physics_prep_tim)
5588 END DO adj_scalar_tile_loop_1a
5589 !$OMP END PARALLEL DO
5591 ENDIF ! adj microphysics test
5593 if ( config_flags%cu_physics .gt. 0 ) then
5594 CALL POPREAL8ARRAY ( grid%rqvcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5595 CALL POPREAL8ARRAY ( grid%rthcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
5596 end if
5597 !$OMP PARALLEL DO &
5598 !$OMP PRIVATE ( ij )
5599 DO ij = 1 , grid%num_tiles
5601 CALL wrf_debug ( 200 , ' call a_phy_prep_part2' )
5602 CALL a_phy_prep_part2 ( config_flags, &
5603 grid%mut,grid%a_mut, grid%muu, grid%a_muu, grid%muv, grid%a_muv, &
5604 grid%rthraten, grid%a_rthraten, &
5605 grid%rthblten, grid%a_rthblten, &
5606 grid%rublten, grid%a_rublten, grid%rvblten, grid%a_rvblten, &
5607 grid%rqvblten, grid%a_rqvblten, grid%rqcblten, grid%a_rqcblten, grid%rqiblten, grid%a_rqiblten, &
5608 grid%rucuten, grid%a_rucuten , grid%rvcuten, grid%a_rvcuten, grid%rthcuten, grid%a_rthcuten, &
5609 grid%rqvcuten, grid%a_rqvcuten, grid%rqccuten, grid%a_rqccuten, grid%rqrcuten, grid%a_rqrcuten, &
5610 grid%rqicuten, grid%a_rqicuten, grid%rqscuten, grid%a_rqscuten, &
5611 grid%rushten, grid%a_rushten, grid%rvshten, grid%a_rvshten, grid%rthshten, grid%a_rthshten, &
5612 grid%rqvshten, grid%a_rqvshten, grid%rqcshten, grid%a_rqcshten, grid%rqrshten, grid%a_rqrshten, &
5613 grid%rqishten, grid%g_rqishten, grid%rqsshten, grid%a_rqsshten, grid%rqgshten, grid%a_rqgshten, &
5614 grid%rthften, grid%a_rthften, grid%rqvften, grid%a_rqvften, &
5615 grid%RUNDGDTEN, grid%a_RUNDGDTEN, grid%RVNDGDTEN, grid%a_RVNDGDTEN, grid%RTHNDGDTEN, grid%a_RTHNDGDTEN, &
5616 grid%RPHNDGDTEN,grid%a_RPHNDGDTEN,grid%RQVNDGDTEN, grid%a_RQVNDGDTEN,grid%RMUNDGDTEN,&
5617 ids, ide, jds, jde, kds, kde, &
5618 ims, ime, jms, jme, kms, kme, &
5619 grid%i_start(ij), grid%i_end(ij), &
5620 grid%j_start(ij), grid%j_end(ij), &
5621 k_start, k_end )
5622 ENDDO
5623 !$OMP END PARALLEL DO
5625 !$OMP PARALLEL DO &
5626 !$OMP PRIVATE ( ij )
5627 DO ij = grid%num_tiles,1,-1
5629 BENCH_START(adj_advance_ppt_tim)
5630 CALL wrf_debug ( 200 , ' call a_advance_ppt' )
5632 CALL a_advance_ppt(grid%rthcuten,grid%a_rthcuten,grid%rqvcuten,grid%a_rqvcuten, &
5633 grid%rqccuten,grid%a_rqccuten,grid%rqrcuten,grid%a_rqrcuten, &
5634 grid%rqicuten,grid%a_rqicuten,grid%rqscuten,grid%a_rqscuten, &
5635 grid%rainc,grid%a_rainc,grid%raincv,grid%rainsh,grid%a_rainsh,&
5636 grid%pratec,grid%a_pratec,grid%pratesh,grid%a_pratesh, &
5637 grid%nca,grid%a_nca,grid%htop,grid%a_htop,grid%hbot,grid%a_hbot,&
5638 grid%cutop,grid%a_cutop,grid%cubot,grid%a_cubot, &
5639 grid%cuppt, grid%a_cuppt, grid%dt, config_flags, &
5640 ids,ide, jds,jde, kds,kde, &
5641 ims,ime, jms,jme, kms,kme, &
5642 grid%i_start(ij), grid%i_end(ij), &
5643 grid%j_start(ij), grid%j_end(ij), &
5644 k_start , k_end )
5646 BENCH_END(adj_advance_ppt_tim)
5648 ENDDO
5649 !$OMP END PARALLEL DO
5651 ! [2] Adjoint of Runge Kutta loop
5652 adj_Runge_Kutta_loop: DO rk_step = rk_order, 1, -1
5654 ! Set the step size and number of small timesteps for
5655 ! each part of the timestep
5657 dtm = grid%dt
5658 IF ( rk_order == 1 ) THEN
5660 write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
5661 CALL wrf_error_fatal( wrf_err_message )
5663 ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
5665 IF ( rk_step == 1) THEN
5666 dt_rk = 0.5*grid%dt
5667 dts_rk = dts
5668 number_of_small_timesteps = num_sound_steps/2
5669 ELSE
5670 dt_rk = grid%dt
5671 dts_rk = dts
5672 number_of_small_timesteps = num_sound_steps
5673 ENDIF
5675 ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
5677 IF ( rk_step == 1) THEN
5678 dt_rk = grid%dt/3.
5679 dts_rk = dt_rk
5680 number_of_small_timesteps = 1
5681 ELSE IF (rk_step == 2) THEN
5682 dt_rk = 0.5*grid%dt
5683 dts_rk = dts
5684 number_of_small_timesteps = num_sound_steps/2
5685 ELSE
5686 dt_rk = grid%dt
5687 dts_rk = dts
5688 number_of_small_timesteps = num_sound_steps
5689 ENDIF
5691 ELSE
5693 write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
5694 CALL wrf_error_fatal( wrf_err_message )
5696 END IF
5698 ! Adjoint of resetting the boundary conditions
5700 adj_rk_step_1_check: IF ( rk_step < rk_order ) THEN
5702 #ifdef DM_PARALLEL
5704 ! * * * * *
5705 ! * * * * * * * * *
5706 ! * + * * + * * * + * *
5707 ! * * * * * * * * *
5708 ! * * * * *
5710 ! moist, chem, scalar, tke x
5712 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
5713 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5714 # include "HALO_EM_TKE_5_AD.inc"
5715 ELSE
5716 # include "HALO_EM_TKE_3_AD.inc"
5717 ENDIF
5718 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
5719 IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5720 # include "HALO_EM_TKE_7_AD.inc"
5721 ELSE
5722 # include "HALO_EM_TKE_5_AD.inc"
5723 ENDIF
5724 ELSE
5725 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
5726 CALL wrf_error_fatal(TRIM(wrf_err_message))
5727 ENDIF
5729 IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
5730 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
5731 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5732 # include "HALO_EM_MOIST_E_5_AD.inc"
5733 ELSE
5734 # include "HALO_EM_MOIST_E_3_AD.inc"
5735 END IF
5736 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
5737 IF ( (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5738 # include "HALO_EM_MOIST_E_7_AD.inc"
5739 ELSE
5740 # include "HALO_EM_MOIST_E_5_AD.inc"
5741 END IF
5742 ELSE
5743 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
5744 CALL wrf_error_fatal(TRIM(wrf_err_message))
5745 ENDIF
5746 ENDIF
5747 IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
5748 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
5749 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5750 !# include "HALO_EM_SCALAR_E_5.inc"
5751 ELSE
5752 !# include "HALO_EM_SCALAR_E_3.inc"
5753 ENDIF
5754 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
5755 IF ( (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5756 !# include "HALO_EM_SCALAR_E_7.inc"
5757 ELSE
5758 !# include "HALO_EM_SCALAR_E_5.inc"
5759 ENDIF
5760 ELSE
5761 WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
5762 CALL wrf_error_fatal(TRIM(wrf_err_message))
5763 ENDIF
5764 ENDIF
5765 IF ( num_tracer >= PARAM_FIRST_SCALAR ) THEN
5766 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
5767 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5768 # include "HALO_EM_TRACER_E_5_AD.inc"
5769 ELSE
5770 # include "HALO_EM_TRACER_E_3_AD.inc"
5771 ENDIF
5772 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
5773 IF ( (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN
5774 # include "HALO_EM_TRACER_E_7_AD.inc"
5775 ELSE
5776 # include "HALO_EM_TRACER_E_5_AD.inc"
5777 ENDIF
5778 ELSE
5779 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
5780 CALL wrf_error_fatal(TRIM(wrf_err_message))
5781 ENDIF
5782 ENDIF
5783 #endif
5785 BENCH_START(adj_bc_end_tim)
5786 !$OMP PARALLEL DO &
5787 !$OMP PRIVATE ( ij )
5788 DO ij = grid%num_tiles,1,-1
5790 IF (config_flags%km_opt .eq. 2) THEN
5792 CALL a_set_physical_bc3d( grid%a_tke_2 , 'p', config_flags, &
5793 ids, ide, jds, jde, kds, kde, &
5794 ims, ime, jms, jme, kms, kme, &
5795 ips, ipe, jps, jpe, kps, kpe, &
5796 grid%i_start(ij), grid%i_end(ij), &
5797 grid%j_start(ij), grid%j_end(ij), &
5798 k_start , k_end )
5800 END IF
5802 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
5804 adj_scalar_species_bdy_loop_1 : DO is = num_3d_s,PARAM_FIRST_SCALAR,-1
5806 CALL a_set_physical_bc3d( a_scalar(ims,kms,jms,is), 'p', config_flags, &
5807 ids, ide, jds, jde, kds, kde, &
5808 ims, ime, jms, jme, kms, kme, &
5809 ips, ipe, jps, jpe, kps, kpe, &
5810 grid%i_start(ij), grid%i_end(ij), &
5811 grid%j_start(ij), grid%j_end(ij), &
5812 k_start , k_end-1 )
5814 END DO adj_scalar_species_bdy_loop_1
5816 END IF
5818 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
5820 adj_tracer_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_tracer
5822 CALL a_set_physical_bc3d( a_tracer(ims,kms,jms,ic), 'p', config_flags, &
5823 ids, ide, jds, jde, kds, kde, &
5824 ims, ime, jms, jme, kms, kme, &
5825 ips, ipe, jps, jpe, kps, kpe, &
5826 grid%i_start(ij), grid%i_end(ij), &
5827 grid%j_start(ij), grid%j_end(ij), &
5828 k_start , k_end-1 )
5830 END DO adj_tracer_species_bdy_loop_1
5832 END IF
5834 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
5836 adj_moisture_loop_bdy_1 : DO im = num_3d_m,PARAM_FIRST_SCALAR,-1
5838 CALL a_set_physical_bc3d( a_moist(ims,kms,jms,im), 'p', config_flags, &
5839 ids, ide, jds, jde, kds, kde, &
5840 ims, ime, jms, jme, kms, kme, &
5841 ips, ipe, jps, jpe, kps, kpe, &
5842 grid%i_start(ij), grid%i_end(ij), &
5843 grid%j_start(ij), grid%j_end(ij), &
5844 k_start , k_end )
5846 END DO adj_moisture_loop_bdy_1
5848 ENDIF
5850 BENCH_START(adj_diag_w_tim)
5851 IF (.not. config_flags%non_hydrostatic) THEN
5853 !CALL pop2restore (ph_tend, "ph_tend")
5854 !CALL pop2restore (grid%muts, "muts")
5855 CALL a_diagnose_w( ph_tend,a_ph_tend, grid%ph_2,grid%a_ph_2, grid%ph_1,grid%a_ph_1, &
5856 grid%w_2,grid%a_w_2, grid%muts,grid%a_muts, dt_rk, &
5857 grid%u_2,grid%a_u_2, grid%v_2,grid%a_v_2, grid%ht, &
5858 grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
5859 ids, ide, jds, jde, kds, kde, &
5860 ims, ime, jms, jme, kms, kme, &
5861 grid%i_start(ij), grid%i_end(ij), &
5862 grid%j_start(ij), grid%j_end(ij), &
5863 k_start , k_end )
5865 ENDIF
5866 BENCH_END(adj_diag_w_tim)
5868 CALL a_rk_phys_bc_dry_2( config_flags, &
5869 grid%a_u_2, grid%a_v_2, grid%a_w_2, &
5870 grid%a_t_2, grid%a_ph_2, grid%a_mu_2, &
5871 ids, ide, jds, jde, kds, kde, &
5872 ims, ime, jms, jme, kms, kme, &
5873 ips, ipe, jps, jpe, kps, kpe, &
5874 grid%i_start(ij), grid%i_end(ij), &
5875 grid%j_start(ij), grid%j_end(ij), &
5876 k_start , k_end )
5877 END DO
5878 !$OMP END PARALLEL DO
5880 BENCH_END(adj_bc_end_tim)
5882 #ifdef DM_PARALLEL
5883 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
5884 # include "HALO_EM_D2_3_AD.inc"
5885 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
5886 # include "HALO_EM_D2_5_AD.inc"
5887 ELSE
5888 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
5889 CALL wrf_error_fatal(TRIM(wrf_err_message))
5890 ENDIF
5891 #endif
5894 ENDIF adj_rk_step_1_check
5896 ! Adjoint of updating the pressure and density at the new time level
5898 !CALL pop2restore (moist, "moist")
5899 !CALL pop2restore (grid%ph_2,grid%t_2, "ph,t")
5900 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
5901 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
5902 !CALL pop2restore (grid%mu_2,grid%muts, "mu,muts")
5903 !$OMP PARALLEL DO &
5904 !$OMP PRIVATE ( ij )
5905 DO ij = grid%num_tiles,1,-1
5907 BENCH_START(adj_calc_p_rho_tim)
5909 CALL a_calc_p_rho_phi( moist,a_moist, num_3d_m, config_flags%hypsometric_opt, &
5910 grid%al,grid%a_al, grid%alb, grid%mu_2,grid%a_mu_2, grid%muts,grid%a_muts, &
5911 grid%ph_2,grid%a_ph_2, grid%phb,grid%p,grid%a_p, grid%pb, grid%t_2,grid%a_t_2, &
5912 p0, t0, grid%p_top,grid%znu, grid%znw,grid%dnw, grid%rdnw, &
5913 grid%rdn, config_flags%non_hydrostatic, &
5914 ids, ide, jds, jde, kds, kde, &
5915 ims, ime, jms, jme, kms, kme, &
5916 grid%i_start(ij), grid%i_end(ij), &
5917 grid%j_start(ij), grid%j_end(ij), &
5918 k_start , k_end )
5920 BENCH_END(adj_calc_p_rho_tim)
5922 ENDDO
5923 !$OMP END PARALLEL DO
5925 ! next the other scalar species
5926 adj_other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
5928 adj_scalar_variable_loop: do is = num_3d_s,PARAM_FIRST_SCALAR,-1
5930 !$OMP PARALLEL DO &
5931 !$OMP PRIVATE ( ij )
5932 adj_scalar_tile_loop_2: DO ij = grid%num_tiles,1,-1
5934 IF( config_flags%specified ) THEN
5936 IF(is .ne. P_QNN)THEN
5937 !CALL pop2restore ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
5938 CALL a_flow_dep_bdy ( a_scalar(ims,kms,jms,is), &
5939 grid%ru_m, grid%rv_m, config_flags, &
5940 grid%spec_zone, &
5941 ids,ide, jds,jde, kds,kde, & ! domain dims
5942 ims,ime, jms,jme, kms,kme, & ! memory dims
5943 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5944 grid%i_start(ij), grid%i_end(ij), &
5945 grid%j_start(ij), grid%j_end(ij), &
5946 k_start, k_end )
5947 ELSE
5948 CALL a_flow_dep_bdy_qnn ( scalar(ims,kms,jms,is), &
5949 a_scalar(ims,kms,jms,is), &
5950 grid%ru_m, grid%rv_m, config_flags, &
5951 grid%spec_zone, &
5952 ids,ide, jds,jde, kds,kde, & ! domain dims
5953 ims,ime, jms,jme, kms,kme, & ! memory dims
5954 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
5955 grid%i_start(ij), grid%i_end(ij), &
5956 grid%j_start(ij), grid%j_end(ij), &
5957 k_start, k_end )
5958 ENDIF
5960 ENDIF
5962 CALL wrf_debug ( 200 , ' call a_rk_update_scalar scalar ' )
5964 !IF ( rk_step == 1 ) THEN
5965 ! CALL pop2restore ( scalar(:,:,:,is),scalar_tend(:,:,:,is),advect_tend, &
5966 ! "scalar,scalar_tend,advect_tend" )
5967 !ELSE
5968 ! CALL pop2restore ( scalar_old(:,:,:,is),scalar_tend(:,:,:,is),advect_tend,&
5969 ! "scalar_old,scalar_tend,advect_tend" )
5970 !END IF
5971 !CALL pop2restore ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
5972 tenddec = .false.
5973 CALL a_rk_update_scalar( scs=is, sce=is, &
5974 scalar_1=scalar_old(ims,kms,jms,is), &
5975 a_scalar_1=a_scalar_old(ims,kms,jms,is), &
5976 scalar_2=scalar(ims,kms,jms,is), &
5977 a_scalar_2=a_scalar(ims,kms,jms,is), &
5978 sc_tend=scalar_tend(ims,kms,jms,is), &
5979 a_sc_tend=a_scalar_tend(ims,kms,jms,is), &
5980 advect_tend=advect_tend,a_advect_tend=a_advect_tend, &
5981 h_tendency=h_tendency, a_h_tendency=a_h_tendency, &
5982 z_tendency=z_tendency, a_z_tendency=a_z_tendency, &
5983 msftx=grid%msftx,msfty=grid%msfty, &
5984 mu_old=grid%mu_1, a_mu_old=grid%a_mu_1, &
5985 mu_new=grid%mu_2,a_mu_new=grid%a_mu_2,mu_base=grid%mub, &
5986 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
5987 config_flags=config_flags, tenddec=tenddec, &
5988 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
5989 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
5990 its=grid%i_start(ij), ite=grid%i_end(ij), &
5991 jts=grid%j_start(ij), jte=grid%j_end(ij), &
5992 kts=k_start , kte=k_end )
5993 ENDDO adj_scalar_tile_loop_2
5994 !$OMP END PARALLEL DO
5996 !$OMP PARALLEL DO &
5997 !$OMP PRIVATE ( ij, its, ite, jts, jte )
5998 adj_scalar_tile_loop_1: DO ij = grid%num_tiles,1,-1
6000 IF( config_flags%nested .and. (rk_step == 1) ) THEN
6002 CALL a_spec_bdy_scalar ( a_scalar_tend(ims,kms,jms,is), &
6003 a_scalar_btxs(jms,kms,1,is),a_scalar_btxe(jms,kms,1,is),&
6004 a_scalar_btys(ims,kms,1,is),a_scalar_btye(ims,kms,1,is),&
6005 config_flags%spec_bdy_width, grid%spec_zone, &
6006 config_flags, &
6007 ids,ide, jds,jde, kds,kde, &
6008 ims,ime, jms,jme, kms,kme, &
6009 ips,ipe, jps,jpe, kps,kpe, &
6010 grid%i_start(ij), grid%i_end(ij), &
6011 grid%j_start(ij), grid%j_end(ij), &
6012 k_start, k_end )
6014 !CALL pop2restore (scalar(:,:,:,is), "scalar")
6015 !CALL pop2restore (grid%mut, "mut")
6016 CALL a_relax_bdy_scalar ( a_scalar_tend(ims,kms,jms,is), &
6017 scalar(ims,kms,jms,is),a_scalar(ims,kms,jms,is), &
6018 grid%mut,grid%a_mut, &
6019 a_scalar_bxs(jms,kms,1,is),a_scalar_bxe(jms,kms,1,is), &
6020 a_scalar_bys(ims,kms,1,is),a_scalar_bye(ims,kms,1,is), &
6021 a_scalar_btxs(jms,kms,1,is),a_scalar_btxe(jms,kms,1,is),&
6022 a_scalar_btys(ims,kms,1,is),a_scalar_btye(ims,kms,1,is),&
6023 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
6024 grid%dtbc, grid%fcx, grid%gcx, &
6025 config_flags, &
6026 ids,ide, jds,jde, kds,kde, &
6027 ims,ime, jms,jme, kms,kme, &
6028 ips,ipe, jps,jpe, kps,kpe, &
6029 grid%i_start(ij), grid%i_end(ij), &
6030 grid%j_start(ij), grid%j_end(ij), &
6031 k_start, k_end )
6033 ENDIF ! b.c test for chem nested boundary condition
6035 CALL wrf_debug ( 200 , ' call a_rk_scalar_tend scalar ' )
6037 !CALL pop2restore (scalar(:,:,:,is),scalar_old(:,:,:,is), &
6038 ! "scalar,scalar_old")
6039 !CALL pop2restore (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
6040 !CALL pop2restore (grid%mu_1,grid%muts, "mu_1,muts")
6041 !IF ( rk_step == 1 ) CALL pop2restore (grid%alt,grid%xkhh, "alt,xkhh")
6043 tenddec = .false.
6044 CALL a_rk_scalar_tend ( is, is, config_flags, tenddec, &
6045 rk_step, dt_rk, &
6046 grid%ru_m, grid%a_ru_m, &
6047 grid%rv_m, grid%a_rv_m, &
6048 grid%ww_m, grid%a_ww_m, &
6049 grid%muts, grid%a_muts, grid%mub, grid%mu_1, grid%a_mu_1, &
6050 grid%alt, grid%a_alt, &
6051 scalar_old(ims,kms,jms,is), a_scalar_old(ims,kms,jms,is), &
6052 scalar(ims,kms,jms,is), a_scalar(ims,kms,jms,is), &
6053 scalar_tend(ims,kms,jms,is), a_scalar_tend(ims,kms,jms,is), &
6054 advect_tend, a_advect_tend, h_tendency,a_h_tendency, &
6055 z_tendency, a_z_tendency, grid%rqvften, grid%a_rqvften, &
6056 grid%qv_base, .false., grid%fnm, grid%fnp, &
6057 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
6058 grid%msfvy, grid%msftx,grid%msfty, &
6059 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
6060 grid%khdif, grid%kvdif, grid%xkhh,grid%a_xkhh, &
6061 grid%diff_6th_opt, grid%diff_6th_factor, &
6062 config_flags%scalar_adv_opt, &
6063 ids, ide, jds, jde, kds, kde, &
6064 ims, ime, jms, jme, kms, kme, &
6065 grid%i_start(ij), grid%i_end(ij), &
6066 grid%j_start(ij), grid%j_end(ij), &
6067 k_start , k_end )
6069 ENDDO adj_scalar_tile_loop_1
6070 !$OMP END PARALLEL DO
6072 ENDDO adj_scalar_variable_loop
6074 ENDIF adj_other_scalar_advance
6076 BENCH_START(a_tracer_adv_tim)
6077 adj_tracer_advance: IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
6079 adj_tracer_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_tracer
6081 !$OMP PARALLEL DO &
6082 !$OMP PRIVATE ( ij )
6083 adj_tracer_tile_loop_2: DO ij = 1 , grid%num_tiles
6085 IF( config_flags%specified ) THEN
6086 CALL a_flow_dep_bdy ( a_tracer(ims,kms,jms,ic), &
6087 grid%ru_m, grid%rv_m, config_flags, &
6088 grid%spec_zone, &
6089 ids,ide, jds,jde, kds,kde, & ! domain dims
6090 ims,ime, jms,jme, kms,kme, & ! memory dims
6091 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
6092 grid%i_start(ij), grid%i_end(ij), &
6093 grid%j_start(ij), grid%j_end(ij), &
6094 k_start, k_end )
6095 ENDIF
6097 CALL wrf_debug ( 200 , ' call a_rk_update_scalar tracer ' )
6099 tenddec = .false.
6101 IF ( rk_step == 1 ) THEN
6102 CALL POPREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6103 CALL POPREAL8ARRAY ( tracer_tend(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6104 ELSE
6105 CALL POPREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6106 CALL POPREAL8ARRAY ( tracer_tend(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6107 END IF
6108 CALL a_rk_update_scalar( scs=ic, sce=ic, &
6109 scalar_1=tracer_old(ims,kms,jms,ic), &
6110 a_scalar_1=a_tracer_old(ims,kms,jms,ic), &
6111 scalar_2=tracer(ims,kms,jms,ic), &
6112 a_scalar_2=a_tracer(ims,kms,jms,ic), &
6113 sc_tend=tracer_tend(ims,kms,jms,ic), &
6114 a_sc_tend=a_tracer_tend(ims,kms,jms,ic), &
6115 advect_tend=advect_tend,a_advect_tend=a_advect_tend, &
6116 h_tendency=h_tendency, a_h_tendency=a_h_tendency, &
6117 z_tendency=z_tendency, a_z_tendency=a_z_tendency, &
6118 msftx=grid%msftx,msfty=grid%msfty, &
6119 mu_old=grid%mu_1, a_mu_old=grid%a_mu_1, &
6120 mu_new=grid%mu_2, a_mu_new=grid%a_mu_2, mu_base=grid%mub, &
6121 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
6122 config_flags=config_flags, tenddec=tenddec, &
6123 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
6124 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
6125 its=grid%i_start(ij), ite=grid%i_end(ij), &
6126 jts=grid%j_start(ij), jte=grid%j_end(ij), &
6127 kts=k_start , kte=k_end )
6129 ENDDO adj_tracer_tile_loop_2
6130 !$OMP END PARALLEL DO
6132 CALL POPREAL8ARRAY ( tracer(:,:,:,ic), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6133 CALL POPREAL8ARRAY ( grid%ww_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6134 CALL POPREAL8ARRAY ( grid%rv_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6135 CALL POPREAL8ARRAY ( grid%ru_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6136 !$OMP PARALLEL DO &
6137 !$OMP PRIVATE ( ij )
6138 adj_tracer_tile_loop_1: DO ij = 1 , grid%num_tiles
6140 CALL wrf_debug ( 15 , ' call a_rk_scalar_tend in adj_tracer_tile_loop_1' )
6142 tenddec = .false.
6143 CALL a_rk_scalar_tend ( ic, ic, config_flags, tenddec, &
6144 rk_step, dt_rk, &
6145 grid%ru_m, grid%a_ru_m, &
6146 grid%rv_m, grid%a_rv_m, &
6147 grid%ww_m, grid%a_ww_m, &
6148 grid%muts, grid%a_muts, grid%mub, grid%mu_1, grid%a_mu_1, &
6149 grid%alt, grid%a_alt, &
6150 tracer_old(ims,kms,jms,ic), a_tracer_old(ims,kms,jms,ic), &
6151 tracer(ims,kms,jms,ic), a_tracer(ims,kms,jms,ic), &
6152 tracer_tend(ims,kms,jms,ic), a_tracer_tend(ims,kms,jms,ic), &
6153 advect_tend, a_advect_tend, h_tendency,a_h_tendency, &
6154 z_tendency, a_z_tendency, grid%rqvften, grid%a_rqvften, &
6155 grid%qv_base, .false., grid%fnm, grid%fnp, &
6156 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
6157 grid%msfvy, grid%msftx,grid%msfty, &
6158 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
6159 grid%khdif, grid%kvdif, grid%xkhh,grid%a_xkhh, &
6160 grid%diff_6th_opt, grid%diff_6th_factor, &
6161 config_flags%tracer_adv_opt, &
6162 ids, ide, jds, jde, kds, kde, &
6163 ims, ime, jms, jme, kms, kme, &
6164 grid%i_start(ij), grid%i_end(ij), &
6165 grid%j_start(ij), grid%j_end(ij), &
6166 k_start , k_end )
6168 ENDDO adj_tracer_tile_loop_1
6169 !$OMP END PARALLEL DO
6171 ENDDO adj_tracer_variable_loop
6172 ENDIF adj_tracer_advance
6173 BENCH_END(a_tracer_adv_tim)
6175 BENCH_START(adj_tke_adv_tim)
6176 adj_TKE_advance: IF (config_flags%km_opt .eq. 2) then
6178 !$OMP PARALLEL DO &
6179 !$OMP PRIVATE ( ij )
6180 adj_tke_tile_loop_2: DO ij = grid%num_tiles,1,-1
6182 IF( config_flags%specified .or. config_flags%nested ) THEN
6184 !CALL pop2restore ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
6185 CALL a_flow_dep_bdy ( grid%a_tke_2, &
6186 grid%ru_m, grid%rv_m, config_flags, &
6187 grid%spec_zone, &
6188 ids,ide, jds,jde, kds,kde, & ! domain dims
6189 ims,ime, jms,jme, kms,kme, & ! memory dims
6190 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
6191 grid%i_start(ij), grid%i_end(ij), &
6192 grid%j_start(ij), grid%j_end(ij), &
6193 k_start, k_end )
6194 ENDIF
6196 !CALL pop2restore (grid%tke_2, "tke")
6197 CALL a_bound_tke( grid%tke_2,grid%a_tke_2, grid%tke_upper_bound, &
6198 ids, ide, jds, jde, kds, kde, &
6199 ims, ime, jms, jme, kms, kme, &
6200 grid%i_start(ij), grid%i_end(ij), &
6201 grid%j_start(ij), grid%j_end(ij), &
6202 k_start , k_end )
6204 CALL wrf_debug ( 200 , ' call a_rk_update_scalar tke' )
6206 !IF ( rk_step == 1 ) THEN
6207 ! CALL pop2restore ( grid%tke_2,tke_tend,advect_tend, &
6208 ! "tke_2,tke_tend,advect_tend" )
6209 !ELSE
6210 ! CALL pop2restore ( grid%tke_1,tke_tend,advect_tend,&
6211 ! "tke_1,tke_tend,advect_tend" )
6212 !END IF
6213 !CALL pop2restore ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
6214 tenddec = .false.
6215 CALL a_rk_update_scalar( scs=1, sce=1, &
6216 scalar_1=grid%tke_1, a_scalar_1=grid%a_tke_1, &
6217 scalar_2=grid%tke_2, a_scalar_2=grid%a_tke_2, &
6218 sc_tend=tke_tend(ims,kms,jms), &
6219 a_sc_tend=a_tke_tend(ims,kms,jms), &
6220 advect_tend=advect_tend,a_advect_tend=a_advect_tend, &
6221 h_tendency=h_tendency, a_h_tendency=a_h_tendency, &
6222 z_tendency=z_tendency, a_z_tendency=a_z_tendency, &
6223 msftx=grid%msftx,msfty=grid%msfty, &
6224 mu_old=grid%mu_1, a_mu_old=grid%a_mu_1, &
6225 mu_new=grid%mu_2,a_mu_new=grid%a_mu_2,mu_base=grid%mub, &
6226 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
6227 config_flags=config_flags, tenddec=tenddec, &
6228 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
6229 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
6230 its=grid%i_start(ij), ite=grid%i_end(ij), &
6231 jts=grid%j_start(ij), jte=grid%j_end(ij), &
6232 kts=k_start , kte=k_end )
6234 ENDDO adj_tke_tile_loop_2
6235 !$OMP END PARALLEL DO
6237 !CALL pop2restore (grid%tke_2,grid%tke_1, "tke_2,tke_1")
6238 CALL POPREAL8ARRAY ( grid%ww_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6239 CALL POPREAL8ARRAY ( grid%rv_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6240 CALL POPREAL8ARRAY ( grid%ru_m , (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6241 !CALL pop2restore (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
6242 !CALL pop2restore (grid%mu_1,grid%muts, "mu_1,muts")
6243 !IF ( rk_step == 1 ) CALL pop2restore (grid%alt,grid%xkhh, "alt,xkhh")
6244 !$OMP PARALLEL DO &
6245 !$OMP PRIVATE ( ij )
6246 adj_tke_tile_loop_1: DO ij = grid%num_tiles,1,-1
6248 CALL wrf_debug ( 200 , ' call a_rk_scalar_tend for tke' )
6249 tenddec = .false.
6250 CALL a_rk_scalar_tend ( 1, 1, config_flags, tenddec, &
6251 rk_step, dt_rk, &
6252 grid%ru_m,grid%a_ru_m, grid%rv_m,grid%a_rv_m, grid%ww_m,grid%a_ww_m, &
6253 grid%muts,grid%a_muts, grid%mub, grid%mu_1,grid%a_mu_1,&
6254 grid%alt,grid%a_alt, &
6255 grid%tke_1,grid%a_tke_1, &
6256 grid%tke_2,grid%a_tke_2, &
6257 tke_tend(ims,kms,jms),a_tke_tend(ims,kms,jms), &
6258 advect_tend,a_advect_tend,h_tendency,a_h_tendency, &
6259 z_tendency, a_z_tendency, grid%rqvften,grid%a_rqvften, &
6260 grid%qv_base, .false., grid%fnm, grid%fnp, &
6261 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
6262 grid%msfvy, grid%msftx,grid%msfty, &
6263 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
6264 grid%kvdif, grid%xkhh,grid%a_xkhh, &
6265 grid%diff_6th_opt, grid%diff_6th_factor, &
6266 config_flags%tke_adv_opt, &
6267 ids, ide, jds, jde, kds, kde, &
6268 ims, ime, jms, jme, kms, kme, &
6269 grid%i_start(ij), grid%i_end(ij), &
6270 grid%j_start(ij), grid%j_end(ij), &
6271 k_start , k_end )
6272 ENDDO adj_tke_tile_loop_1
6273 !$OMP END PARALLEL DO
6275 #ifdef DM_PARALLEL
6276 IF ( config_flags%h_mom_adv_order <= 4 ) THEN
6277 # include "HALO_EM_TKE_ADVECT_3_AD.inc"
6278 ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
6279 # include "HALO_EM_TKE_ADVECT_5_AD.inc"
6280 ELSE
6281 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
6282 CALL wrf_error_fatal(TRIM(wrf_err_message))
6283 ENDIF
6284 #endif
6285 ENDIF adj_TKE_advance
6286 BENCH_END(adj_tke_adv_tim)
6288 ! Adjoint of updating moist of grid points
6290 adj_moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
6292 adj_moist_variable_loop: DO im = num_3d_m, PARAM_FIRST_SCALAR, -1
6294 IF (grid%adv_moist_cond .or. im==p_qv ) THEN
6296 ! Adjoint of updating moist of grid points
6298 ! Adjoint of updating moist of grid points in spec zone
6300 !$OMP PARALLEL DO &
6301 !$OMP PRIVATE ( ij )
6302 adj_moist_tile_loop_2: DO ij = grid%num_tiles,1,-1
6304 BENCH_START(adj_flow_depbdy_tim)
6305 IF( config_flags%specified ) THEN
6306 IF(im .ne. P_QV)THEN
6308 CALL POPREAL8ARRAY ( grid%rv_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6309 CALL POPREAL8ARRAY ( grid%ru_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6310 !CALL pop2restore ( grid%ru_m,grid%rv_m, "ru_m,rv_m" )
6311 CALL a_flow_dep_bdy ( a_moist(ims,kms,jms,im), &
6312 grid%ru_m, grid%rv_m, config_flags, &
6313 grid%spec_zone, &
6314 ids,ide, jds,jde, kds,kde, &
6315 ims,ime, jms,jme, kms,kme, &
6316 ips,ipe, jps,jpe, kps,kpe, &
6317 grid%i_start(ij), grid%i_end(ij), &
6318 grid%j_start(ij), grid%j_end(ij), &
6319 k_start, k_end )
6321 ENDIF
6322 ENDIF
6323 BENCH_END(adj_flow_depbdy_tim)
6325 ! Adjoint of updating moist of grid points except for those in spec zone
6326 CALL wrf_debug ( 200 , ' call a_rk_update_scalar' )
6327 tenddec = .false.
6329 BENCH_START(adj_update_scal_tim)
6331 IF ( rk_step == 1 ) THEN
6332 !CALL pop2restore ( moist(:,:,:,im),moist_tend(:,:,:,im),advect_tend, &
6333 ! "moist,moist_tend,advect_tend" )
6334 CALL POPREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6335 CALL POPREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6336 CALL POPREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6337 ELSE
6338 !CALL pop2restore ( moist_old(:,:,:,im),moist_tend(:,:,:,im),advect_tend, &
6339 ! "moist_old,moist_tend,advect_tend" )
6340 CALL POPREAL8ARRAY ( advect_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6341 CALL POPREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6342 CALL POPREAL8ARRAY ( moist_old(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6343 !IF( rk_step == rk_order )THEN
6344 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
6345 ! CALL POPREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6346 ! END IF
6347 !END IF
6348 END IF
6349 !CALL pop2restore ( grid%mu_1,grid%mu_2, "mu_1,mu_2" )
6351 ! IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
6352 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
6353 ! CALL a_q_diabatic_subtr( im, im, &
6354 ! dt_rk, &
6355 ! grid%qv_diabatic, grid%a_qv_diabatic, &
6356 ! grid%qc_diabatic, grid%a_qc_diabatic, &
6357 ! moist(ims,kms,jms,im), &
6358 ! a_moist(ims,kms,jms,im), &
6359 ! ids, ide, jds, jde, kds, kde, &
6360 ! ims, ime, jms, jme, kms, kme, &
6361 ! grid%i_start(ij), grid%i_end(ij), &
6362 ! grid%j_start(ij), grid%j_end(ij), &
6363 ! k_start , k_end )
6364 ! END IF
6365 ! END IF
6367 CALL a_rk_update_scalar( scs=im, sce=im, &
6368 scalar_1=moist_old(ims,kms,jms,im), &
6369 a_scalar_1=a_moist_old(ims,kms,jms,im), &
6370 scalar_2=moist(ims,kms,jms,im), &
6371 a_scalar_2=a_moist(ims,kms,jms,im), &
6372 sc_tend=moist_tend(ims,kms,jms,im), &
6373 a_sc_tend=a_moist_tend(ims,kms,jms,im), &
6374 advect_tend=advect_tend,a_advect_tend=a_advect_tend, &
6375 h_tendency=h_tendency, a_h_tendency=a_h_tendency, &
6376 z_tendency=z_tendency, a_z_tendency=a_z_tendency, &
6377 msftx=grid%msftx,msfty=grid%msfty, &
6378 mu_old=grid%mu_1, a_mu_old=grid%a_mu_1, &
6379 mu_new=grid%mu_2,a_mu_new=grid%a_mu_2,mu_base=grid%mub, &
6380 rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, &
6381 config_flags=config_flags, tenddec=tenddec, &
6382 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
6383 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
6384 its=grid%i_start(ij), ite=grid%i_end(ij), &
6385 jts=grid%j_start(ij), jte=grid%j_end(ij), &
6386 kts=k_start , kte=k_end )
6388 BENCH_END(adj_update_scal_tim)
6390 ENDDO adj_moist_tile_loop_2
6391 !$OMP END PARALLEL DO
6393 ! Adjoint of calculating moist tendency of grid points
6395 ! Adjoint of calculating moist tendency of grid points in relax zone and spec zone
6397 !$OMP PARALLEL DO &
6398 !$OMP PRIVATE ( ij )
6399 adj_moist_tile_loop_1: DO ij = grid%num_tiles,1,-1
6401 BENCH_START(adj_rlx_bdy_scalar_tim)
6402 IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
6403 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
6406 CALL a_spec_bdy_scalar ( a_moist_tend(ims,kms,jms,im), &
6407 a_moist_btxs(jms,kms,1,im),a_moist_btxe(jms,kms,1,im), &
6408 a_moist_btys(ims,kms,1,im),a_moist_btye(ims,kms,1,im), &
6409 config_flags%spec_bdy_width, grid%spec_zone, &
6410 config_flags, &
6411 ids,ide, jds,jde, kds,kde, & ! domain dims
6412 ims,ime, jms,jme, kms,kme, & ! memory dims
6413 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
6414 grid%i_start(ij), grid%i_end(ij), &
6415 grid%j_start(ij), grid%j_end(ij), &
6416 k_start, k_end )
6418 !CALL pop2restore (moist(:,:,:,im), "moist")
6419 CALL POPREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
6420 !CALL pop2restore (grid%mut, "mut")
6421 CALL a_relax_bdy_scalar ( a_moist_tend(ims,kms,jms,im), &
6422 moist(ims,kms,jms,im), a_moist(ims,kms,jms,im), &
6423 grid%mut, grid%a_mut, &
6424 a_moist_bxs(jms,kms,1,im),a_moist_bxe(jms,kms,1,im), &
6425 a_moist_bys(ims,kms,1,im),a_moist_bye(ims,kms,1,im), &
6426 a_moist_btxs(jms,kms,1,im),a_moist_btxe(jms,kms,1,im), &
6427 a_moist_btys(ims,kms,1,im),a_moist_btye(ims,kms,1,im), &
6428 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
6429 grid%dtbc, grid%fcx, grid%gcx, &
6430 config_flags, &
6431 ids,ide, jds,jde, kds,kde, & ! domain dims
6432 ims,ime, jms,jme, kms,kme, & ! memory dims
6433 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
6434 grid%i_start(ij), grid%i_end(ij), &
6435 grid%j_start(ij), grid%j_end(ij), &
6436 k_start, k_end )
6437 ENDIF
6438 ENDIF
6439 BENCH_END(adj_rlx_bdy_scalar_tim)
6441 ! Adjoint of calculating moist tendency of grid points except for those in spec zone
6442 CALL wrf_debug ( 200 , ' call a_rk_scalar_tend' )
6443 tenddec = .false.
6445 BENCH_START(adj_rk_scalar_tend_tim)
6447 !IF( rk_step == 1 )THEN
6448 ! IF( im.eq.p_qv .or. im.eq.p_qc )THEN
6449 ! CALL POPREAL8ARRAY ( moist_tend(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6450 ! END IF
6451 !END IF
6452 CALL POPREAL8ARRAY ( moist_old(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6453 CALL POPREAL8ARRAY ( moist(:,:,:,im), (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6454 !CALL pop2restore (moist(:,:,:,im),moist_old(:,:,:,im), &
6455 ! "moist,moist_old")
6456 CALL POPREAL8ARRAY ( grid%ww_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6457 CALL POPREAL8ARRAY ( grid%rv_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6458 CALL POPREAL8ARRAY ( grid%ru_m, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6459 !CALL pop2restore (grid%ru_m,grid%rv_m,grid%ww_m, "ru_m,rv_m,ww_m")
6460 !CALL pop2restore (grid%mu_1,grid%muts, "mu_1,muts")
6461 IF ( rk_step == 1 ) CALL pop2restore (grid%alt,grid%xkhh, "alt,xkhh")
6463 ! IF( rk_step == 1 )THEN
6464 ! IF( im.eq.p_qv .or. im.eq.p_qc .AND. config_flags%use_q_diabatic == 1 )THEN
6465 ! CALL a_q_diabatic_add( im, im, &
6466 ! dt_rk, &
6467 ! grid%mut, grid%a_mut, &
6468 ! grid%qv_diabatic, grid%a_qv_diabatic, &
6469 ! grid%qc_diabatic, grid%a_qc_diabatic, &
6470 ! moist_tend(ims,kms,jms,im), &
6471 ! a_moist_tend(ims,kms,jms,im), &
6472 ! ids, ide, jds, jde, kds, kde, &
6473 ! ims, ime, jms, jme, kms, kme, &
6474 ! grid%i_start(ij), grid%i_end(ij), &
6475 ! grid%j_start(ij), grid%j_end(ij), &
6476 ! k_start , k_end )
6477 ! END IF
6478 ! END IF
6480 CALL a_rk_scalar_tend ( im, im, config_flags, tenddec, &
6481 rk_step, dt_rk, &
6482 grid%ru_m, grid%a_ru_m, &
6483 grid%rv_m, grid%a_rv_m, &
6484 grid%ww_m, grid%a_ww_m, &
6485 grid%muts, grid%a_muts, grid%mub, grid%mu_1, grid%a_mu_1, &
6486 grid%alt, grid%a_alt, &
6487 moist_old(ims,kms,jms,im), a_moist_old(ims,kms,jms,im), &
6488 moist(ims,kms,jms,im), a_moist(ims,kms,jms,im), &
6489 moist_tend(ims,kms,jms,im), a_moist_tend(ims,kms,jms,im), &
6490 advect_tend, a_advect_tend, h_tendency, a_h_tendency, &
6491 z_tendency, a_z_tendency, grid%rqvften, grid%a_rqvften, &
6492 grid%qv_base, .true., grid%fnm, grid%fnp, &
6493 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
6494 grid%msfvy, grid%msftx,grid%msfty, &
6495 grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
6496 grid%kvdif, grid%xkhh,grid%a_xkhh, &
6497 grid%diff_6th_opt, grid%diff_6th_factor, &
6498 config_flags%moist_adv_opt, &
6499 ids, ide, jds, jde, kds, kde, &
6500 ims, ime, jms, jme, kms, kme, &
6501 grid%i_start(ij), grid%i_end(ij), &
6502 grid%j_start(ij), grid%j_end(ij), &
6503 k_start , k_end )
6505 BENCH_END(adj_rk_scalar_tend_tim)
6507 ENDDO adj_moist_tile_loop_1
6508 !$OMP END PARALLEL DO
6510 ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
6512 ENDDO adj_moist_variable_loop
6514 ENDIF adj_moist_scalar_advance
6516 #ifdef DM_PARALLEL
6517 # include "HALO_EM_D_AD.inc"
6518 #endif
6520 IF ((config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order) &
6521 .and. (config_flags%km_opt .eq. 2) ) THEN
6523 !$OMP PARALLEL DO &
6524 !$OMP PRIVATE ( ij )
6525 DO ij = grid%num_tiles,1,-1
6526 CALL a_set_physical_bc3d( grid%a_tke_1, 'p', config_flags, &
6527 ids, ide, jds, jde, kds, kde, &
6528 ims, ime, jms, jme, kms, kme, &
6529 ips, ipe, jps, jpe, kps, kpe, &
6530 grid%i_start(ij), grid%i_end(ij), &
6531 grid%j_start(ij), grid%j_end(ij), &
6532 k_start , k_end )
6533 END DO
6534 !$OMP END PARALLEL DO
6536 #ifdef DM_PARALLEL
6537 IF (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) THEN
6538 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
6539 # include "HALO_EM_TKE_OLD_E_5_AD.inc"
6540 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
6541 # include "HALO_EM_TKE_OLD_E_7_AD.inc"
6542 ELSE
6543 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
6544 CALL wrf_error_fatal(TRIM(wrf_err_message))
6545 ENDIF
6546 ENDIF
6547 #endif
6550 !CALL pop2restore (grid%tke_1,tke_tend, &
6551 ! "tke_1,tke_tend")
6552 !CALL pop2restore (grid%mu_1, "mu_1")
6553 !$OMP PARALLEL DO &
6554 !$OMP PRIVATE ( ij )
6555 DO ij = grid%num_tiles,1,-1
6556 CALL wrf_debug ( 200 , ' call a_rk_update_scalar_pd' )
6557 CALL a_rk_update_scalar_pd( 1, 1, &
6558 grid%tke_1,grid%a_tke_1, &
6559 tke_tend(ims,kms,jms),a_tke_tend(ims,kms,jms), &
6560 grid%mu_1,grid%a_mu_1, grid%mu_1,grid%a_mu_1, grid%mub, &
6561 rk_step, dt_rk, grid%spec_zone, &
6562 config_flags, &
6563 ids, ide, jds, jde, kds, kde, &
6564 ims, ime, jms, jme, kms, kme, &
6565 grid%i_start(ij), grid%i_end(ij), &
6566 grid%j_start(ij), grid%j_end(ij), &
6567 k_start , k_end )
6568 ENDDO
6569 !$OMP END PARALLEL DO
6571 END IF ! end if for tke_adv_opt
6573 ! tracer
6575 IF ((config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
6577 !$OMP PARALLEL DO &
6578 !$OMP PRIVATE ( ij )
6579 DO ij = 1 , grid%num_tiles
6580 IF (num_tracer >= PARAM_FIRST_SCALAR) THEN
6581 DO im = PARAM_FIRST_SCALAR , num_tracer
6583 CALL a_set_physical_bc3d( a_tracer_old(ims,kms,jms,im), 'p', config_flags, &
6584 ids, ide, jds, jde, kds, kde, &
6585 ims, ime, jms, jme, kms, kme, &
6586 ips, ipe, jps, jpe, kps, kpe, &
6587 grid%i_start(ij), grid%i_end(ij), &
6588 grid%j_start(ij), grid%j_end(ij), &
6589 k_start , k_end )
6590 END DO
6592 ENDIF
6593 END DO
6594 !$OMP END PARALLEL DO
6596 !---------------------- positive definite bc call
6597 #ifdef DM_PARALLEL
6598 IF (config_flags%tracer_adv_opt /= ORIGINAL .and. config_flags%tracer_adv_opt /= WENO_SCALAR) THEN
6599 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
6600 # include "HALO_EM_TRACER_OLD_E_5_AD.inc"
6601 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
6602 # include "HALO_EM_TRACER_OLD_E_7_AD.inc"
6603 ELSE
6604 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
6605 CALL wrf_error_fatal(TRIM(wrf_err_message))
6606 ENDIF
6607 ENDIF
6608 #endif
6610 !$OMP PARALLEL DO &
6611 !$OMP PRIVATE ( ij )
6612 DO ij = 1 , grid%num_tiles
6613 CALL wrf_debug ( 200 , ' call a_rk_update_scalar_pd tracer' )
6614 DO im = PARAM_FIRST_SCALAR, num_tracer
6616 CALL POPREAL8ARRAY ( tracer_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_tracer )
6617 CALL a_rk_update_scalar_pd( im, im, &
6618 tracer_old(ims,kms,jms,im),a_tracer_old(ims,kms,jms,im), &
6619 tracer_tend(ims,kms,jms,im),a_tracer_tend(ims,kms,jms,im), &
6620 grid%mu_1, grid%a_mu_1, grid%mu_1, grid%a_mu_1, grid%mub, &
6621 rk_step, dt_rk, grid%spec_zone, &
6622 config_flags, &
6623 ids, ide, jds, jde, kds, kde, &
6624 ims, ime, jms, jme, kms, kme, &
6625 grid%i_start(ij), grid%i_end(ij), &
6626 grid%j_start(ij), grid%j_end(ij), &
6627 k_start , k_end )
6630 ENDDO
6631 END DO
6632 !$OMP END PARALLEL DO
6634 ENDIF ! end if for tracer_adv_opt
6636 ! scalars
6638 IF ((config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
6640 !---------------------- positive definite bc call
6641 !$OMP PARALLEL DO &
6642 !$OMP PRIVATE ( ij )
6644 DO ij = grid%num_tiles,1,-1
6645 IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
6646 DO im = num_3d_s,PARAM_FIRST_SCALAR,-1
6648 CALL a_set_physical_bc3d( a_scalar_old(ims,kms,jms,im), 'p', config_flags, &
6649 ids, ide, jds, jde, kds, kde, &
6650 ims, ime, jms, jme, kms, kme, &
6651 ips, ipe, jps, jpe, kps, kpe, &
6652 grid%i_start(ij), grid%i_end(ij), &
6653 grid%j_start(ij), grid%j_end(ij), &
6654 k_start , k_end )
6655 END DO
6656 ENDIF
6657 END DO
6658 !$OMP END PARALLEL DO
6660 #ifdef DM_PARALLEL
6661 IF (config_flags%scalar_adv_opt /= ORIGINAL .and. config_flags%scalar_adv_opt /= WENO_SCALAR) THEN
6662 #ifndef RSL
6663 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
6664 !# include "HALO_EM_SCALAR_OLD_E_5.inc"
6665 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
6666 !# include "HALO_EM_SCALAR_OLD_E_7.inc"
6667 ELSE
6668 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
6669 CALL wrf_error_fatal(TRIM(wrf_err_message))
6670 ENDIF
6671 #else
6672 WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
6673 CALL wrf_error_fatal(TRIM(wrf_err_message))
6674 #endif
6675 endif
6676 #endif
6678 !CALL pop2restore (scalar_old(:,:,:,:),scalar_tend(:,:,:,:), &
6679 ! "scalar_old,scalar_tend")
6680 !CALL pop2restore (grid%mu_1, "mu_1")
6681 !$OMP PARALLEL DO &
6682 !$OMP PRIVATE ( ij )
6683 DO ij = grid%num_tiles,1,-1
6684 CALL wrf_debug ( 200 , ' call a_rk_update_scalar_pd' )
6685 DO im = num_3d_s,PARAM_FIRST_SCALAR,-1
6686 CALL a_rk_update_scalar_pd( im, im, &
6687 scalar_old(ims,kms,jms,im),a_scalar_old(ims,kms,jms,im), &
6688 scalar_tend(ims,kms,jms,im),a_scalar_tend(ims,kms,jms,im), &
6689 grid%mu_1,grid%a_mu_1, grid%mu_1,grid%a_mu_1, grid%mub, &
6690 rk_step, dt_rk, grid%spec_zone, &
6691 config_flags, &
6692 ids, ide, jds, jde, kds, kde, &
6693 ims, ime, jms, jme, kms, kme, &
6694 grid%i_start(ij), grid%i_end(ij), &
6695 grid%j_start(ij), grid%j_end(ij), &
6696 k_start , k_end )
6697 ENDDO
6698 ENDDO
6699 !$OMP END PARALLEL DO
6701 END IF ! end if for scalar_adv_opt
6703 ! first moisture
6705 IF ((config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order)) THEN
6707 !$OMP PARALLEL DO &
6708 !$OMP PRIVATE ( ij )
6709 DO ij = grid%num_tiles,1,-1
6710 IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
6711 DO im = num_3d_m,PARAM_FIRST_SCALAR,-1
6713 CALL a_set_physical_bc3d( a_moist_old(ims,kms,jms,im), 'p', config_flags, &
6714 ids, ide, jds, jde, kds, kde, &
6715 ims, ime, jms, jme, kms, kme, &
6716 ips, ipe, jps, jpe, kps, kpe, &
6717 grid%i_start(ij), grid%i_end(ij), &
6718 grid%j_start(ij), grid%j_end(ij), &
6719 k_start , k_end )
6720 END DO
6721 ENDIF
6722 END DO
6723 !$OMP END PARALLEL DO
6725 #ifdef DM_PARALLEL
6726 IF (config_flags%moist_adv_opt /= ORIGINAL .and. config_flags%moist_adv_opt /= WENO_SCALAR) THEN
6727 IF ( config_flags%h_sca_adv_order <= 4 ) THEN
6728 # include "HALO_EM_MOIST_OLD_E_5_AD.inc"
6729 ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
6730 # include "HALO_EM_MOIST_OLD_E_7_AD.inc"
6731 ELSE
6732 WRITE(wrf_err_message,*)'solve_em_ad: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
6733 CALL wrf_error_fatal(TRIM(wrf_err_message))
6734 ENDIF
6735 ENDIF
6736 #endif
6738 !CALL pop2restore (moist_old(:,:,:,:),moist_tend(:,:,:,:), &
6739 ! "moist_old,moist_tend")
6740 CALL POPREAL8ARRAY ( moist_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
6741 CALL POPREAL8ARRAY ( moist_old, (ime-ims+1)*(kme-kms+1)*(jme-jms+1)*num_moist )
6742 !CALL pop2restore (grid%mu_1, "mu_1")
6743 !$OMP PARALLEL DO &
6744 !$OMP PRIVATE ( ij )
6745 DO ij = grid%num_tiles,1,-1
6746 CALL wrf_debug ( 200 , ' call a_rk_update_scalar_pd' )
6747 DO im = num_3d_m,PARAM_FIRST_SCALAR,-1
6748 CALL a_rk_update_scalar_pd( im, im, &
6749 moist_old(ims,kms,jms,im),a_moist_old(ims,kms,jms,im), &
6750 moist_tend(ims,kms,jms,im),a_moist_tend(ims,kms,jms,im), &
6751 grid%mu_1,grid%a_mu_1, grid%mu_1,grid%a_mu_1, grid%mub, &
6752 rk_step, dt_rk, grid%spec_zone, &
6753 config_flags, &
6754 ids, ide, jds, jde, kds, kde, &
6755 ims, ime, jms, jme, kms, kme, &
6756 grid%i_start(ij), grid%i_end(ij), &
6757 grid%j_start(ij), grid%j_end(ij), &
6758 k_start , k_end )
6759 ENDDO
6760 END DO
6761 !$OMP END PARALLEL DO
6763 END IF ! end if for moist_adv_opt
6766 !$OMP PARALLEL DO &
6767 !$OMP PRIVATE ( ij )
6768 DO ij = grid%num_tiles,1,-1
6770 CALL wrf_debug ( 200 , ' call a_rk_small_finish' )
6772 BENCH_START(adj_small_step_finish_tim)
6773 IF (rk_step == rk_order) THEN
6775 CALL a_set_physical_bc3d( grid%a_ru_m, 'u', config_flags, &
6776 ids, ide, jds, jde, kds, kde, &
6777 ims, ime, jms, jme, kms, kme, &
6778 ips, ipe, jps, jpe, kps, kpe, &
6779 grid%i_start(ij), grid%i_end(ij), &
6780 grid%j_start(ij), grid%j_end(ij), &
6781 k_start , k_end )
6783 CALL a_set_physical_bc3d( grid%a_rv_m, 'v', config_flags, &
6784 ids, ide, jds, jde, kds, kde, &
6785 ims, ime, jms, jme, kms, kme, &
6786 ips, ipe, jps, jpe, kps, kpe, &
6787 grid%i_start(ij), grid%i_end(ij), &
6788 grid%j_start(ij), grid%j_end(ij), &
6789 k_start , k_end )
6791 CALL a_set_physical_bc3d( grid%a_ww_m, 'w', config_flags, &
6792 ids, ide, jds, jde, kds, kde, &
6793 ims, ime, jms, jme, kms, kme, &
6794 ips, ipe, jps, jpe, kps, kpe, &
6795 grid%i_start(ij), grid%i_end(ij), &
6796 grid%j_start(ij), grid%j_end(ij), &
6797 k_start , k_end )
6799 CALL a_set_physical_bc2d( grid%a_mut, 't', config_flags, &
6800 ids, ide, jds, jde, &
6801 ims, ime, jms, jme, &
6802 ips, ipe, jps, jpe, &
6803 grid%i_start(ij), grid%i_end(ij), &
6804 grid%j_start(ij), grid%j_end(ij) )
6806 CALL a_set_physical_bc2d( grid%a_muts, 't', config_flags, &
6807 ids, ide, jds, jde, &
6808 ims, ime, jms, jme, &
6809 ips, ipe, jps, jpe, &
6810 grid%i_start(ij), grid%i_end(ij), &
6811 grid%j_start(ij), grid%j_end(ij) )
6813 END IF
6816 CALL POPREAL8ARRAY ( grid%h_diabatic, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6817 CALL POPREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6818 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6819 CALL POPREAL8ARRAY ( w_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6820 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6821 CALL POPREAL8ARRAY ( grid%v_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6822 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6823 CALL POPREAL8ARRAY ( grid%u_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6824 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6825 !CALL pop2restore (grid%u_2,grid%u_save,grid%v_2,grid%v_save,grid%w_2,w_save,grid%t_2,grid%t_save, &
6826 ! grid%h_diabatic, "u,u_save,v,v_save,w,w_save,t,t_save,h_diabatic")
6827 CALL POPREAL8ARRAY ( grid%muvs, (ime-ims+1)*(jme-jms+1) )
6828 CALL POPREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
6829 CALL POPREAL8ARRAY ( grid%muus, (ime-ims+1)*(jme-jms+1) )
6830 CALL POPREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
6831 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
6832 CALL POPREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
6833 !CALL pop2restore (grid%mut,grid%muts,grid%muu,grid%muus,grid%muv,grid%muvs, "mut,muts,muu,muus,muv,muvs")
6834 CALL a_small_step_finish( grid%u_2, grid%a_u_2, grid%u_1, &
6835 grid%v_2, grid%a_v_2, grid%v_1, &
6836 grid%w_2, grid%a_w_2, grid%w_1, &
6837 grid%t_2, grid%a_t_2, grid%t_1, &
6838 grid%ph_2, grid%a_ph_2, grid%ph_1, &
6839 grid%ww, grid%a_ww, ww1, a_ww1, &
6840 grid%mu_2, grid%a_mu_2, grid%mu_1, &
6841 grid%mut, grid%a_mut, grid%muts, grid%a_muts, &
6842 grid%muu, grid%a_muu, grid%muus, grid%a_muus, &
6843 grid%muv, grid%a_muv, grid%muvs, grid%a_muvs, &
6844 grid%u_save, grid%a_u_save, grid%v_save, grid%a_v_save, w_save, a_w_save, &
6845 grid%t_save, grid%a_t_save, ph_save, a_ph_save, mu_save, a_mu_save, &
6846 grid%msfux,grid%msfuy,grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, &
6847 grid%h_diabatic, grid%a_h_diabatic, &
6848 number_of_small_timesteps,dts_rk, &
6849 rk_step, rk_order, &
6850 ids, ide, jds, jde, kds, kde, &
6851 ims, ime, jms, jme, kms, kme, &
6852 grid%i_start(ij), grid%i_end(ij), &
6853 grid%j_start(ij), grid%j_end(ij), &
6854 k_start, k_end )
6855 BENCH_END(adj_small_step_finish_tim)
6857 BENCH_START(adj_calc_mu_uv_tim)
6859 CALL a_calc_mu_uv_1 ( config_flags, &
6860 grid%muts, grid%a_muts, grid%muus,&
6861 grid%a_muus, grid%muvs, grid%a_muvs, &
6862 ids, ide, jds, jde, kds, kde, &
6863 ims, ime, jms, jme, kms, kme, &
6864 grid%i_start(ij), grid%i_end(ij), &
6865 grid%j_start(ij), grid%j_end(ij), &
6866 k_start, k_end )
6868 BENCH_END(adj_calc_mu_uv_tim)
6870 END DO
6871 !$OMP END PARALLEL DO
6874 adj_small_steps : DO iteration = number_of_small_timesteps, 1 , -1
6877 BENCH_START(adj_phys_bc_tim)
6878 !$OMP PARALLEL DO &
6879 !$OMP PRIVATE ( ij )
6880 DO ij = grid%num_tiles,1,-1
6882 ! boundary condition set for next small timestep
6884 CALL a_set_physical_bc3d( grid%a_ph_2, 'w', config_flags, &
6885 ids, ide, jds, jde, kds, kde, &
6886 ims, ime, jms, jme, kms, kme, &
6887 ips, ipe, jps, jpe, kps, kpe, &
6888 grid%i_start(ij), grid%i_end(ij), &
6889 grid%j_start(ij), grid%j_end(ij), &
6890 k_start , k_end )
6892 CALL a_set_physical_bc3d( grid%a_al, 'p', config_flags, &
6893 ids, ide, jds, jde, kds, kde, &
6894 ims, ime, jms, jme, kms, kme, &
6895 ips, ipe, jps, jpe, kps, kpe, &
6896 grid%i_start(ij), grid%i_end(ij), &
6897 grid%j_start(ij), grid%j_end(ij), &
6898 k_start , k_end )
6900 CALL a_set_physical_bc3d( grid%a_p, 'p', config_flags, &
6901 ids, ide, jds, jde, kds, kde, &
6902 ims, ime, jms, jme, kms, kme, &
6903 ips, ipe, jps, jpe, kps, kpe, &
6904 grid%i_start(ij), grid%i_end(ij), &
6905 grid%j_start(ij), grid%j_end(ij), &
6906 k_start , k_end )
6908 CALL a_set_physical_bc2d( grid%a_muts, 't', config_flags, &
6909 ids, ide, jds, jde, &
6910 ims, ime, jms, jme, &
6911 ips, ipe, jps, jpe, &
6912 grid%i_start(ij), grid%i_end(ij), &
6913 grid%j_start(ij), grid%j_end(ij) )
6915 CALL a_set_physical_bc2d( grid%a_mu_2, 't', config_flags, &
6916 ids, ide, jds, jde, &
6917 ims, ime, jms, jme, &
6918 ips, ipe, jps, jpe, &
6919 grid%i_start(ij), grid%i_end(ij), &
6920 grid%j_start(ij), grid%j_end(ij) )
6922 CALL a_set_physical_bc2d( grid%a_mudf, 't', config_flags, &
6923 ids, ide, jds, jde, &
6924 ims, ime, jms, jme, &
6925 ips, ipe, jps, jpe, &
6926 grid%i_start(ij), grid%i_end(ij), &
6927 grid%j_start(ij), grid%j_end(ij) )
6929 END DO
6930 !$OMP END PARALLEL DO
6931 BENCH_END(adj_phys_bc_tim)
6933 #ifdef DM_PARALLEL
6934 # include "HALO_EM_C2_AD.inc"
6935 #endif
6937 !$OMP PARALLEL DO &
6938 !$OMP PRIVATE ( ij )
6939 DO ij = grid%num_tiles,1,-1
6941 BENCH_START(adj_cald_p_rho_tim)
6942 CALL POPREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6943 CALL POPREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6944 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6945 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6946 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
6947 !CALL pop2restore (grid%alt,grid%ph_2,grid%t_2,grid%t_save,c2a, "alt,ph,t_2,t_1,c2a")
6948 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
6949 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
6950 !CALL pop2restore (grid%mu_2,grid%muts, "mu,muts")
6951 CALL a_calc_p_rho( grid%al, grid%a_al, grid%p, grid%a_p, grid%ph_2, grid%a_ph_2, &
6952 grid%alt, grid%a_alt, grid%t_2, grid%a_t_2, grid%t_save, grid%a_t_save, &
6953 c2a, a_c2a, pm1, a_pm1, &
6954 grid%mu_2, grid%a_mu_2, grid%muts, grid%a_muts, grid%znu, t0, &
6955 grid%rdnw, grid%dnw, grid%smdiv, &
6956 config_flags%non_hydrostatic, iteration, &
6957 ids, ide, jds, jde, kds, kde, &
6958 ims, ime, jms, jme, kms, kme, &
6959 grid%i_start(ij), grid%i_end(ij), &
6960 grid%j_start(ij), grid%j_end(ij), &
6961 k_start, k_end )
6962 BENCH_END(adj_cald_p_rho_tim)
6964 ! Adjoint of updating model variables of grid points in spec zone: ph,w
6966 IF( config_flags%specified .or. config_flags%nested ) THEN
6968 BENCH_START(adj_spec_bdynhyd_tim)
6969 IF (config_flags%non_hydrostatic) THEN
6971 IF( config_flags%specified ) THEN
6973 CALL a_zero_grad_bdy ( grid%a_w_2, &
6974 'w' , config_flags, &
6975 grid%spec_zone, &
6976 ids,ide, jds,jde, kds,kde, &
6977 ims,ime, jms,jme, kms,kme, &
6978 ips,ipe, jps,jpe, kps,kpe, &
6979 grid%i_start(ij), grid%i_end(ij), &
6980 grid%j_start(ij), grid%j_end(ij), &
6981 k_start, k_end )
6982 ELSE
6984 CALL a_spec_bdyupdate ( grid%a_w_2, &
6985 a_rw_tend, dts_rk, &
6986 'h' , config_flags, &
6987 grid%spec_zone, &
6988 ids,ide, jds,jde, kds,kde, & ! domain dims
6989 ims,ime, jms,jme, kms,kme, & ! memory dims
6990 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
6991 grid%i_start(ij), grid%i_end(ij), &
6992 grid%j_start(ij), grid%j_end(ij), &
6993 k_start, k_end )
6995 ENDIF
6997 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
6998 CALL POPREAL8ARRAY ( mu_tend, (ime-ims+1)*(jme-jms+1) )
6999 !CALL pop2restore (mu_tend,grid%muts, "mu_tend,muts")
7000 CALL POPREAL8ARRAY ( ph_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7001 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7002 CALL POPREAL8ARRAY ( ph_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7003 !CALL pop2restore (ph_save,grid%ph_2,ph_tend, "ph_save,ph,ph_tend")
7004 CALL a_spec_bdyupdate_ph( ph_save, a_ph_save, grid%ph_2, grid%a_ph_2, &
7005 ph_tend, a_ph_tend, &
7006 mu_tend, a_mu_tend, grid%muts, grid%a_muts, dts_rk, &
7007 'h' , config_flags, &
7008 grid%spec_zone, &
7009 ids,ide, jds,jde, kds,kde, &
7010 ims,ime, jms,jme, kms,kme, &
7011 ips,ipe, jps,jpe, kps,kpe, &
7012 grid%i_start(ij), grid%i_end(ij),&
7013 grid%j_start(ij), grid%j_end(ij),&
7014 k_start, k_end )
7015 ENDIF
7017 BENCH_END(adj_spec_bdynhyd_tim)
7018 ENDIF
7020 BENCH_START(adj_sumflux_tim)
7021 !CALL pop2restore (grid%u_save,grid%v_save, "u_lin,v_lin")
7022 !CALL pop2restore (grid%muu,grid%muv, "muu,muv")
7023 CALL a_sumflux ( grid%u_2,grid%a_u_2, grid%v_2,grid%a_v_2, grid%ww,grid%a_ww, &
7024 grid%u_save, grid%a_u_save, grid%v_save, grid%a_v_save, ww1, a_ww1, &
7025 grid%muu, grid%a_muu, grid%muv, grid%a_muv, &
7026 grid%ru_m, grid%a_ru_m, grid%rv_m, grid%a_rv_m, grid%ww_m, grid%a_ww_m, &
7027 grid%epssm, &
7028 grid%msfux, grid% msfuy, grid%msfvx, &
7029 grid%msfvx_inv, grid%msfvy, &
7030 iteration, number_of_small_timesteps, &
7031 ids, ide, jds, jde, kds, kde, &
7032 ims, ime, jms, jme, kms, kme, &
7033 grid%i_start(ij), grid%i_end(ij), &
7034 grid%j_start(ij), grid%j_end(ij), &
7035 k_start, k_end )
7037 BENCH_END(adj_sumflux_tim)
7039 ENDDO
7040 !$OMP END PARALLEL DO
7042 ! Adjoint of updating model variables of grid points except for those in spec zone: w
7044 !$OMP PARALLEL DO &
7045 !$OMP PRIVATE ( ij )
7046 DO ij = grid%num_tiles,1,-1
7048 BENCH_START(adj_advance_w_tim)
7049 IF ( config_flags%non_hydrostatic ) THEN
7051 CALL POPREAL8ARRAY ( gamma, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7052 CALL POPREAL8ARRAY ( alpha, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7053 CALL POPREAL8ARRAY ( a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7054 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7055 CALL POPREAL8ARRAY ( cqw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7056 CALL POPREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7057 CALL POPREAL8ARRAY ( ph_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7058 CALL POPREAL8ARRAY ( ph_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7059 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7060 !CALL pop2restore (grid%ph_2,ph_save,ph_tend,c2a,cqw,grid%alt,a,alpha,gamma, &
7061 ! "ph,ph_1,ph_tend,c2a,cqw,alt,a,alpha,gamma")
7062 CALL POPREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7063 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7064 CALL POPREAL8ARRAY ( t_2save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7065 CALL POPREAL8ARRAY ( w_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7066 CALL POPREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7067 CALL POPREAL8ARRAY ( rw_tend, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7068 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7069 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7070 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7071 !CALL pop2restore (grid%u_2,grid%v_2,grid%w_2,rw_tend,grid%ww,w_save,t_2save,grid%t_2,grid%t_save, &
7072 ! "u,v,w,rw_tend,ww,w_save,t_2ave,t_2,t_1")
7073 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
7074 CALL POPREAL8ARRAY ( muave, (ime-ims+1)*(jme-jms+1) )
7075 CALL POPREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
7076 !CALL pop2restore (grid%mut,muave,grid%muts, "mut,muave,muts")
7077 CALL a_advance_w( grid%w_2,grid%a_w_2, rw_tend,a_rw_tend, grid%ww,grid%a_ww, w_save,a_w_save, &
7078 grid%u_2,grid%a_u_2, grid%v_2,grid%a_v_2, &
7079 grid%mu_2,grid%a_mu_2, grid%mut,grid%a_mut, &
7080 muave,a_muave, grid%muts,grid%a_muts, &
7081 t_2save,a_t_2save, grid%t_2,grid%a_t_2, grid%t_save,grid%a_t_save, &
7082 grid%ph_2,grid%a_ph_2, ph_save,a_ph_save, grid%phb, ph_tend,a_ph_tend, &
7083 grid%ht, c2a,a_c2a, cqw,a_cqw, grid%alt,grid%a_alt, grid%alb, &
7084 a,a_a, alpha,a_alpha, gamma,a_gamma, &
7085 grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
7086 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
7087 grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
7088 grid%msftx, grid%msfty, &
7089 config_flags, config_flags%top_lid, &
7090 ids,ide, jds,jde, kds,kde, &
7091 ims,ime, jms,jme, kms,kme, &
7092 grid%i_start(ij), grid%i_end(ij), &
7093 grid%j_start(ij), grid%j_end(ij), &
7094 k_start, k_end )
7096 ENDIF
7097 BENCH_END(adj_advance_w_tim)
7099 ! Adjoint of updating model variables of grid points in spec zone: mu,t
7101 BENCH_START(adj_spec_bdy_t_tim)
7102 IF( config_flags%specified .or. config_flags%nested ) THEN
7104 CALL a_spec_bdyupdate ( grid%a_muts, &
7105 a_mu_tend, dts_rk, &
7106 'm' , config_flags, &
7107 grid%spec_zone, &
7108 ids,ide, jds,jde, 1 ,1 , &
7109 ims,ime, jms,jme, 1 ,1 , &
7110 ips,ipe, jps,jpe, 1 ,1 , &
7111 grid%i_start(ij), grid%i_end(ij), &
7112 grid%j_start(ij), grid%j_end(ij), &
7113 1, 1 )
7115 CALL a_spec_bdyupdate ( grid%a_mu_2, &
7116 a_mu_tend, dts_rk, &
7117 'm' , config_flags, &
7118 grid%spec_zone, &
7119 ids,ide, jds,jde, 1 ,1 , &
7120 ims,ime, jms,jme, 1 ,1 , &
7121 ips,ipe, jps,jpe, 1 ,1 , &
7122 grid%i_start(ij), grid%i_end(ij), &
7123 grid%j_start(ij), grid%j_end(ij), &
7124 1, 1 )
7126 CALL a_spec_bdyupdate ( grid%a_t_2, &
7127 a_t_tend, dts_rk, &
7128 't' , config_flags, &
7129 grid%spec_zone, &
7130 ids,ide, jds,jde, kds,kde, & ! domain dims
7131 ims,ime, jms,jme, kms,kme, & ! memory dims
7132 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
7133 grid%i_start(ij), grid%i_end(ij), &
7134 grid%j_start(ij), grid%j_end(ij), &
7135 k_start, k_end )
7137 ENDIF
7138 BENCH_END(adj_spec_bdy_t_tim)
7140 ENDDO
7141 !$OMP END PARALLEL DO
7144 ! Adjoint of updating model variables of grid points except for those in spec zone: mu,t
7146 CALL POPREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7147 CALL POPREAL8ARRAY ( grid%v_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7148 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7149 CALL POPREAL8ARRAY ( grid%u_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7150 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7151 CALL POPREAL8ARRAY ( ww1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7152 CALL POPREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7153 !CALL pop2restore (grid%ww,ww1,grid%u_2,grid%u_save,grid%v_2,grid%v_save,grid%t_save, &
7154 ! "ww,ww_1,u,u_1,v,v_1,t_1")
7155 !CALL pop2restore (grid%muu,grid%muv,mu_tend, "muu,muv,mu_tend")
7156 !$OMP PARALLEL DO &
7157 !$OMP PRIVATE ( ij )
7158 DO ij = grid%num_tiles,1,-1
7160 BENCH_START(adj_advance_mu_t_tim)
7162 CALL a_advance_mu_t( grid%ww,grid%a_ww, ww1,a_ww1, &
7163 grid%u_2,grid%a_u_2, grid%u_save,grid%a_u_save, &
7164 grid%v_2,grid%a_v_2, grid%v_save,grid%a_v_save, &
7165 grid%mu_2,grid%a_mu_2, grid%mut,grid%a_mut, &
7166 muave,a_muave, grid%muts,grid%a_muts, &
7167 grid%muu,grid%a_muu, grid%muv,grid%a_muv, grid%mudf,grid%a_mudf, &
7168 grid%ru_m,grid%a_ru_m, grid%rv_m,grid%a_rv_m, grid%ww_m,grid%a_ww_m, &
7169 grid%t_2,grid%a_t_2, grid%t_save,grid%a_t_save, &
7170 t_2save,a_t_2save, t_tend,a_t_tend, &
7171 mu_tend,a_mu_tend, &
7172 grid%rdx, grid%rdy, dts_rk, grid%epssm, &
7173 grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
7174 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
7175 grid%msfvy, grid%msftx,grid%msfty, &
7176 iteration, config_flags, &
7177 ids, ide, jds, jde, kds, kde, &
7178 ims, ime, jms, jme, kms, kme, &
7179 grid%i_start(ij), grid%i_end(ij), &
7180 grid%j_start(ij), grid%j_end(ij), &
7181 k_start, k_end )
7183 BENCH_END(adj_advance_mu_t_tim)
7184 ENDDO
7185 !$OMP END PARALLEL DO
7187 #ifdef DM_PARALLEL
7188 # include "HALO_EM_C_AD.inc"
7189 #endif
7191 ! Adjoint of updating model variables of grid points in spec zone: u,v
7192 !$OMP PARALLEL DO &
7193 !$OMP PRIVATE ( ij )
7194 DO ij = grid%num_tiles,1,-1
7196 BENCH_START(adj_spec_bdy_uv_tim)
7197 IF( config_flags%specified .or. config_flags%nested ) THEN
7199 CALL a_spec_bdyupdate ( grid%a_v_2, &
7200 grid%a_rv_tend, dts_rk, &
7201 'v' , config_flags, &
7202 grid%spec_zone, &
7203 ids,ide, jds,jde, kds,kde, & ! domain dims
7204 ims,ime, jms,jme, kms,kme, & ! memory dims
7205 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
7206 grid%i_start(ij), grid%i_end(ij), &
7207 grid%j_start(ij), grid%j_end(ij), &
7208 k_start, k_end )
7210 CALL a_spec_bdyupdate ( grid%a_u_2, &
7211 grid%a_ru_tend, dts_rk, &
7212 'u' , config_flags, &
7213 grid%spec_zone, &
7214 ids,ide, jds,jde, kds,kde, & ! domain dims
7215 ims,ime, jms,jme, kms,kme, & ! memory dims
7216 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
7217 grid%i_start(ij), grid%i_end(ij), &
7218 grid%j_start(ij), grid%j_end(ij), &
7219 k_start, k_end )
7221 ENDIF
7222 BENCH_END(adj_spec_bdy_uv_tim)
7224 END DO
7225 !$OMP END PARALLEL DO
7227 !======[adj_P1.11.1]======================================================
7228 ! Adjoint of updating model variables of grid points except for those in spec zone: u,v
7230 CALL POPREAL8ARRAY ( cqv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7231 CALL POPREAL8ARRAY ( cqu, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7232 CALL POPREAL8ARRAY ( grid%php, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7233 CALL POPREAL8ARRAY ( grid%al, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7234 CALL POPREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7235 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7236 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7237 !CALL pop2restore (grid%ph_2,grid%alt,grid%p,grid%al,grid%php,cqu,cqv, "ph,alt,p,al,php,cqu,cqv")
7238 CALL POPREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
7239 CALL POPREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
7240 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
7241 !CALL pop2restore (grid%mu_2,grid%muu,grid%muv, "mu,muu,muv")
7242 !$OMP PARALLEL DO &
7243 !$OMP PRIVATE ( ij )
7245 DO ij = grid%num_tiles,1,-1
7247 BENCH_START(adj_advance_uv_tim)
7249 CALL a_advance_uv( grid%u_2,grid%a_u_2, grid%ru_tend,grid%a_ru_tend, &
7250 grid%v_2,grid%a_v_2, grid%rv_tend,grid%a_rv_tend, &
7251 grid%p,grid%a_p, grid%pb, &
7252 grid%ph_2,grid%a_ph_2, grid%php,grid%a_php, &
7253 grid%alt,grid%a_alt, grid%al,grid%a_al, &
7254 grid%mu_2,grid%a_mu_2, &
7255 grid%muu,grid%a_muu, cqu,a_cqu, grid%muv,grid%a_muv, cqv,a_cqv, &
7256 grid%mudf,grid%a_mudf, &
7257 grid%msfux, grid%msfuy, grid%msfvx, &
7258 grid%msfvx_inv, grid%msfvy, &
7259 grid%rdx, grid%rdy, dts_rk, &
7260 grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
7261 grid%emdiv, &
7262 grid%rdnw, config_flags,grid%spec_zone, &
7263 config_flags%non_hydrostatic, config_flags%top_lid, &
7264 ids, ide, jds, jde, kds, kde, &
7265 ims, ime, jms, jme, kms, kme, &
7266 grid%i_start(ij), grid%i_end(ij), &
7267 grid%j_start(ij), grid%j_end(ij), &
7268 k_start, k_end )
7270 BENCH_END(adj_advance_uv_tim)
7272 END DO
7273 !$OMP END PARALLEL DO
7275 END DO adj_small_steps
7278 BENCH_START(adj_set_phys_bc2_tim)
7280 !$OMP PARALLEL DO &
7281 !$OMP PRIVATE ( ij )
7283 DO ij = grid%num_tiles,1,-1
7285 CALL a_set_physical_bc3d( grid%a_ru_tend, 'u', config_flags, &
7286 ids, ide, jds, jde, kds, kde, &
7287 ims, ime, jms, jme, kms, kme, &
7288 ips, ipe, jps, jpe, kps, kpe, &
7289 grid%i_start(ij), grid%i_end(ij), &
7290 grid%j_start(ij), grid%j_end(ij), &
7291 k_start , k_end )
7293 CALL a_set_physical_bc3d( grid%a_rv_tend, 'v', config_flags, &
7294 ids, ide, jds, jde, kds, kde, &
7295 ims, ime, jms, jme, kms, kme, &
7296 ips, ipe, jps, jpe, kps, kpe, &
7297 grid%i_start(ij), grid%i_end(ij), &
7298 grid%j_start(ij), grid%j_end(ij), &
7299 k_start , k_end )
7301 CALL a_set_physical_bc3d( grid%a_ph_2, 'w', config_flags, &
7302 ids, ide, jds, jde, kds, kde, &
7303 ims, ime, jms, jme, kms, kme, &
7304 ips, ipe, jps, jpe, kps, kpe, &
7305 grid%i_start(ij), grid%i_end(ij), &
7306 grid%j_start(ij), grid%j_end(ij), &
7307 k_start , k_end )
7309 CALL a_set_physical_bc3d( grid%a_al, 'p', config_flags, &
7310 ids, ide, jds, jde, kds, kde, &
7311 ims, ime, jms, jme, kms, kme, &
7312 ips, ipe, jps, jpe, kps, kpe, &
7313 grid%i_start(ij), grid%i_end(ij), &
7314 grid%j_start(ij), grid%j_end(ij), &
7315 k_start , k_end )
7317 CALL a_set_physical_bc3d( grid%a_p, 'p', config_flags, &
7318 ids, ide, jds, jde, kds, kde, &
7319 ims, ime, jms, jme, kms, kme, &
7320 ips, ipe, jps, jpe, kps, kpe, &
7321 grid%i_start(ij), grid%i_end(ij), &
7322 grid%j_start(ij), grid%j_end(ij), &
7323 k_start , k_end )
7325 CALL a_set_physical_bc3d( grid%a_t_1, 'p', config_flags, &
7326 ids, ide, jds, jde, kds, kde, &
7327 ims, ime, jms, jme, kms, kme, &
7328 ips, ipe, jps, jpe, kps, kpe, &
7329 grid%i_start(ij), grid%i_end(ij), &
7330 grid%j_start(ij), grid%j_end(ij), &
7331 k_start , k_end )
7333 CALL a_set_physical_bc3d( grid%a_t_save, 't', config_flags, &
7334 ids, ide, jds, jde, kds, kde, &
7335 ims, ime, jms, jme, kms, kme, &
7336 ips, ipe, jps, jpe, kps, kpe, &
7337 grid%i_start(ij), grid%i_end(ij), &
7338 grid%j_start(ij), grid%j_end(ij), &
7339 k_start , k_end )
7341 CALL a_set_physical_bc2d( grid%a_mu_1, 't', config_flags, &
7342 ids, ide, jds, jde, &
7343 ims, ime, jms, jme, &
7344 ips, ipe, jps, jpe, &
7345 grid%i_start(ij), grid%i_end(ij), &
7346 grid%j_start(ij), grid%j_end(ij) )
7348 CALL a_set_physical_bc2d( grid%a_mu_2, 't', config_flags, &
7349 ids, ide, jds, jde, &
7350 ims, ime, jms, jme, &
7351 ips, ipe, jps, jpe, &
7352 grid%i_start(ij), grid%i_end(ij), &
7353 grid%j_start(ij), grid%j_end(ij) )
7355 CALL a_set_physical_bc2d( grid%a_mudf, 't', config_flags, &
7356 ids, ide, jds, jde, &
7357 ims, ime, jms, jme, &
7358 ips, ipe, jps, jpe, &
7359 grid%i_start(ij), grid%i_end(ij), &
7360 grid%j_start(ij), grid%j_end(ij) )
7361 END DO
7362 !$OMP END PARALLEL DO
7364 BENCH_END(adj_set_phys_bc2_tim)
7366 #ifdef DM_PARALLEL
7367 # include "HALO_EM_B_AD.inc"
7368 #endif
7370 BENCH_START(adj_small_step_prep_tim)
7371 !$OMP PARALLEL DO &
7372 !$OMP PRIVATE ( ij )
7373 DO ij = grid%num_tiles,1,-1
7375 IF (config_flags%non_hydrostatic) THEN
7377 CALL POPREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
7378 !CALL pop2restore (grid%mut, "mut")
7379 !CALL pop2restore (c2a,cqw, "c2a,cqw")
7380 CALL a_calc_coef_w( a,a_a,alpha,a_alpha,gamma,a_gamma, &
7381 grid%mut,grid%a_mut, cqw,a_cqw, &
7382 grid%rdn, grid%rdnw, c2a,a_c2a, &
7383 dts_rk, g, grid%epssm, &
7384 config_flags%top_lid, &
7385 ids, ide, jds, jde, kds, kde, &
7386 ims, ime, jms, jme, kms, kme, &
7387 grid%i_start(ij), grid%i_end(ij), &
7388 grid%j_start(ij), grid%j_end(ij), &
7389 k_start, k_end )
7391 ENDIF
7393 CALL POPREAL8ARRAY ( c2a, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7394 CALL POPREAL8ARRAY ( grid%t_save, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7395 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7396 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7397 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7398 !CALL pop2restore (grid%alt,grid%ph_2,grid%t_2,grid%t_save,c2a, "alt,ph,t_2,t_1,c2a")
7399 CALL POPREAL8ARRAY ( grid%muts, (ime-ims+1)*(jme-jms+1) )
7400 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
7401 !CALL pop2restore (grid%mu_2,grid%muts, "mu,muts")
7402 CALL a_calc_p_rho( grid%al,grid%a_al, grid%p,grid%a_p, grid%ph_2,grid%a_ph_2, &
7403 grid%alt,grid%a_alt, grid%t_2,grid%a_t_2, &
7404 grid%t_save,grid%a_t_save, c2a,a_c2a, pm1,a_pm1, &
7405 grid%mu_2,grid%a_mu_2, grid%muts,grid%a_muts, grid%znu, t0, &
7406 grid%rdnw, grid%dnw, grid%smdiv, &
7407 config_flags%non_hydrostatic, 0, &
7408 ids, ide, jds, jde, kds, kde, &
7409 ims, ime, jms, jme, kms, kme, &
7410 grid%i_start(ij), grid%i_end(ij), &
7411 grid%j_start(ij), grid%j_end(ij), &
7412 k_start, k_end )
7414 CALL wrf_debug ( 200 , ' call a_small_step_prep ' )
7416 IF ( rk_step == 1 ) THEN
7417 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7418 CALL POPREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7419 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7420 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7421 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7422 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7423 !CALL pop2restore (grid%u_2,grid%v_2,grid%t_2,grid%w_2,grid%p,grid%alt, &
7424 ! "u_2,v_2,t_2,w_2,p,alt")
7425 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
7426 !CALL pop2restore (grid%mu_2, "mu_2")
7427 ELSE
7428 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7429 CALL POPREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7430 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7431 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7432 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7433 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7434 CALL POPREAL8ARRAY ( grid%w_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7435 CALL POPREAL8ARRAY ( grid%t_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7436 CALL POPREAL8ARRAY ( grid%v_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7437 CALL POPREAL8ARRAY ( grid%u_1, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7438 !CALL pop2restore (grid%u_1,grid%v_1,grid%t_1,grid%w_1, &
7439 ! grid%u_2,grid%v_2,grid%t_2,grid%w_2,grid%p,grid%alt, &
7440 ! "u_1,v_1,t_1,w_1,u_2,v_2,t_2,w_2,p,alt")
7441 CALL POPREAL8ARRAY ( grid%mu_1, (ime-ims+1)*(jme-jms+1) )
7442 !CALL pop2restore (grid%mu_1, "mu_1")
7443 END IF
7444 !CALL pop2restore (grid%muu,grid%muv,grid%mut, "muu,muv,mut")
7445 CALL a_small_step_prep( grid%u_1,grid%a_u_1,grid%u_2,grid%a_u_2, &
7446 grid%v_1,grid%a_v_1,grid%v_2,grid%a_v_2, &
7447 grid%w_1,grid%a_w_1,grid%w_2,grid%a_w_2, &
7448 grid%t_1,grid%a_t_1,grid%t_2,grid%a_t_2, &
7449 grid%ph_1,grid%a_ph_1,grid%ph_2,grid%a_ph_2, &
7450 grid%mub, grid%mu_1,grid%a_mu_1, grid%mu_2,grid%a_mu_2, &
7451 grid%muu,grid%a_muu, grid%muus,grid%a_muus, &
7452 grid%muv,grid%a_muv, grid%muvs,grid%a_muvs, &
7453 grid%mut,grid%a_mut, grid%muts,grid%a_muts, grid%mudf,grid%a_mudf, &
7454 grid%u_save,grid%a_u_save, grid%v_save,grid%a_v_save, w_save,a_w_save, &
7455 grid%t_save,grid%a_t_save, ph_save,a_ph_save, mu_save,a_mu_save, &
7456 grid%ww,grid%a_ww, ww1,a_ww1, &
7457 c2a,a_c2a, grid%pb, grid%p,grid%a_p, grid%alt,grid%a_alt,&
7458 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
7459 grid%msfvy, grid%msftx,grid%msfty, &
7460 grid%rdx, grid%rdy, rk_step, &
7461 ids, ide, jds, jde, kds, kde, &
7462 ims, ime, jms, jme, kms, kme, &
7463 grid%i_start(ij), grid%i_end(ij), &
7464 grid%j_start(ij), grid%j_end(ij), &
7465 k_start, k_end )
7467 ENDDO
7468 !$OMP END PARALLEL DO
7470 BENCH_END(adj_small_step_prep_tim)
7472 ! Adjoint of calculating tendencies of grid points
7474 BENCH_START(adj_relax_bdy_dry_tim)
7475 !$OMP PARALLEL DO &
7476 !$OMP PRIVATE ( ij )
7477 DO ij = grid%num_tiles,1,-1
7479 IF( config_flags%specified .or. config_flags%nested ) THEN
7481 CALL a_spec_bdy_dry ( config_flags, &
7482 grid%a_ru_tend, grid%a_rv_tend, &
7483 a_ph_tend, a_t_tend, &
7484 a_rw_tend, a_mu_tend, &
7485 grid%a_u_btxs, grid%a_u_btxe, grid%a_u_btys, grid%a_u_btye, &
7486 grid%a_v_btxs, grid%a_v_btxe, grid%a_v_btys, grid%a_v_btye, &
7487 grid%a_ph_btxs, grid%a_ph_btxe, grid%a_ph_btys, grid%a_ph_btye, &
7488 grid%a_t_btxs, grid%a_t_btxe, grid%a_t_btys, grid%a_t_btye, &
7489 grid%a_w_btxs, grid%a_w_btxe, grid%a_w_btys, grid%a_w_btye, &
7490 grid%a_mu_btxs, grid%a_mu_btxe, grid%a_mu_btys, grid%a_mu_btye, &
7491 config_flags%spec_bdy_width, grid%spec_zone, &
7492 ids,ide, jds,jde, kds,kde, & ! domain dims
7493 ims,ime, jms,jme, kms,kme, & ! memory dims
7494 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
7495 grid%i_start(ij), grid%i_end(ij), &
7496 grid%j_start(ij), grid%j_end(ij), &
7497 k_start, k_end )
7499 ENDIF
7501 !CALL pop2restore (grid%h_diabatic, "h_diabatic")
7502 !CALL pop2restore (grid%mut, "mut")
7503 CALL a_rk_addtend_dry ( grid%ru_tend, grid%a_ru_tend, &
7504 grid%rv_tend, grid%a_rv_tend, &
7505 rw_tend, a_rw_tend, ph_tend, a_ph_tend, t_tend, a_t_tend, &
7506 ru_tendf, a_ru_tendf, rv_tendf, a_rv_tendf, rw_tendf, a_rw_tendf, &
7507 ph_tendf, a_ph_tendf, t_tendf, a_t_tendf, &
7508 grid%u_save, grid%a_u_save, grid%v_save, grid%a_v_save, &
7509 w_save, a_w_save, ph_save, a_ph_save, grid%t_save, grid%a_t_save, &
7510 mu_tend, a_mu_tend, mu_tendf, a_mu_tendf, rk_step, &
7511 grid%h_diabatic, grid%a_h_diabatic, grid%mut, grid%a_mut, &
7512 grid%msftx, grid%msfty, grid%msfux, grid%msfuy, &
7513 grid%msfvx, grid%msfvx_inv, grid%msfvy, &
7514 ids,ide, jds,jde, kds,kde, &
7515 ims,ime, jms,jme, kms,kme, &
7516 ips,ipe, jps,jpe, kps,kpe, &
7517 grid%i_start(ij), grid%i_end(ij), &
7518 grid%j_start(ij), grid%j_end(ij), &
7519 k_start, k_end )
7521 IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
7523 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7524 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7525 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7526 !CALL pop2restore (grid%ph_2,grid%t_2,grid%w_2, "ph,t,w")
7527 !CALL pop2restore (grid%mut, "mut")
7528 CALL a_relax_bdy_dry ( config_flags, &
7529 grid%a_u_save, grid%a_v_save, &
7530 a_ph_save, grid%a_t_save, &
7531 a_w_save, a_mu_tend, &
7532 grid%a_ru, grid%a_rv, &
7533 grid%ph_2, grid%a_ph_2, grid%t_2, grid%a_t_2, &
7534 grid%w_2, grid%a_w_2, grid%a_mu_2, grid%mut, grid%a_mut, &
7535 grid%a_u_bxs, grid%a_u_bxe, &
7536 grid%a_u_bys, grid%a_u_bye, &
7537 grid%a_v_bxs, grid%a_v_bxe, &
7538 grid%a_v_bys, grid%a_v_bye, &
7539 grid%a_ph_bxs,grid%a_ph_bxe, &
7540 grid%a_ph_bys,grid%a_ph_bye, &
7541 grid%a_t_bxs, grid%a_t_bxe, &
7542 grid%a_t_bys, grid%a_t_bye, &
7543 grid%a_w_bxs, grid%a_w_bxe, &
7544 grid%a_w_bys, grid%a_w_bye, &
7545 grid%a_mu_bxs,grid%a_mu_bxe, &
7546 grid%a_mu_bys,grid%a_mu_bye, &
7547 grid%a_u_btxs, grid%a_u_btxe, &
7548 grid%a_u_btys, grid%a_u_btye, &
7549 grid%a_v_btxs, grid%a_v_btxe, &
7550 grid%a_v_btys, grid%a_v_btye, &
7551 grid%a_ph_btxs,grid%a_ph_btxe, &
7552 grid%a_ph_btys,grid%a_ph_btye, &
7553 grid%a_t_btxs, grid%a_t_btxe, &
7554 grid%a_t_btys, grid%a_t_btye, &
7555 grid%a_w_btxs, grid%a_w_btxe, &
7556 grid%a_w_btys, grid%a_w_btye, &
7557 grid%a_mu_btxs,grid%a_mu_btxe, &
7558 grid%a_mu_btys,grid%a_mu_btye, &
7559 config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
7560 grid%dtbc, grid%fcx, grid%gcx, &
7561 ids,ide, jds,jde, kds,kde, &
7562 ims,ime, jms,jme, kms,kme, &
7563 ips,ipe, jps,jpe, kps,kpe, &
7564 grid%i_start(ij), grid%i_end(ij), &
7565 grid%j_start(ij), grid%j_end(ij), &
7566 k_start, k_end )
7568 ENDIF
7570 END DO
7571 !$OMP END PARALLEL DO
7572 BENCH_END(adj_relax_bdy_dry_tim)
7575 BENCH_START(adj_rk_tend_tim)
7577 !CALL pop2restore (grid%xkmh,grid%xkhh, "xkmh,xkhh")
7578 CALL POPREAL8ARRAY ( cqw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7579 CALL POPREAL8ARRAY ( cqv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7580 CALL POPREAL8ARRAY ( cqu, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7581 CALL POPREAL8ARRAY ( grid%php, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7582 CALL POPREAL8ARRAY ( grid%p, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7583 CALL POPREAL8ARRAY ( grid%alt, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7584 CALL POPREAL8ARRAY ( grid%al, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7585 !CALL pop2restore (grid%al,grid%alt,grid%p,grid%php,cqu,cqv,cqw, &
7586 ! "al,alt,p,php,cqu,cqv,cqw")
7587 CALL POPREAL8ARRAY ( grid%ph_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7588 CALL POPREAL8ARRAY ( grid%t_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7589 CALL POPREAL8ARRAY ( grid%w_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7590 CALL POPREAL8ARRAY ( grid%v_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7591 CALL POPREAL8ARRAY ( grid%u_2, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7592 !CALL pop2restore (grid%u_2,grid%v_2,grid%w_2,grid%t_2,grid%ph_2, "u,v,w,t,ph")
7593 CALL POPREAL8ARRAY ( grid%ww, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7594 CALL POPREAL8ARRAY ( grid%rw, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7595 CALL POPREAL8ARRAY ( grid%rv, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7596 CALL POPREAL8ARRAY ( grid%ru, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7597 !CALL pop2restore (grid%ru,grid%rv,grid%rw,grid%ww, "ru,rv,rw,ww")
7598 CALL POPREAL8ARRAY ( grid%mut, (ime-ims+1)*(jme-jms+1) )
7599 CALL POPREAL8ARRAY ( grid%muv, (ime-ims+1)*(jme-jms+1) )
7600 CALL POPREAL8ARRAY ( grid%muu, (ime-ims+1)*(jme-jms+1) )
7601 CALL POPREAL8ARRAY ( grid%mu_2, (ime-ims+1)*(jme-jms+1) )
7602 !CALL pop2restore (grid%mu_2,grid%muu,grid%muv,grid%mut, "mu,muu,muv,mut")
7603 !$OMP PARALLEL DO &
7604 !$OMP PRIVATE ( ij )
7605 DO ij = grid%num_tiles,1,-1
7607 CALL wrf_debug ( 200 , ' call a_rk_tendency' )
7608 CALL a_rk_tendency ( config_flags, rk_step, &
7609 grid%ru_tend, grid%a_ru_tend, grid%rv_tend, grid%a_rv_tend, &
7610 rw_tend, a_rw_tend, ph_tend, a_ph_tend, t_tend, a_t_tend, &
7611 ru_tendf, a_ru_tendf, rv_tendf, a_rv_tendf, &
7612 rw_tendf, a_rw_tendf, ph_tendf, a_ph_tendf, t_tendf, a_t_tendf, &
7613 mu_tend, a_mu_tend, &
7614 grid%u_save, grid%a_u_save, grid%v_save, grid%a_v_save, &
7615 w_save, a_w_save, ph_save, a_ph_save, &
7616 grid%t_save, grid%a_t_save, mu_save, a_mu_save, &
7617 grid%rthften, grid%a_rthften, &
7618 grid%ru, grid%a_ru, grid%rv, grid%a_rv, grid%rw, grid%a_rw, grid%ww, grid%a_ww, &
7619 grid%u_2, grid%a_u_2, grid%v_2, grid%a_v_2, grid%w_2, grid%a_w_2, &
7620 grid%t_2, grid%a_t_2, grid%ph_2, grid%a_ph_2, &
7621 grid%u_1, grid%a_u_1, grid%v_1, grid%a_v_1, grid%w_1, grid%a_w_1, &
7622 grid%t_1, grid%a_t_1, grid%ph_1, grid%a_ph_1, &
7623 grid%h_diabatic, grid%a_h_diabatic, grid%phb, grid%t_init, &
7624 grid%mu_2, grid%a_mu_2, grid%mut, grid%a_mut, grid%muu, grid%a_muu, &
7625 grid%muv, grid%a_muv, grid%mub, &
7626 grid%al, grid%a_al, grid%alt, grid%a_alt, grid%p, grid%a_p, grid%pb, &
7627 grid%php, grid%a_php, cqu, a_cqu, cqv, a_cqv, cqw, a_cqw, &
7628 grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base, &
7629 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
7630 grid%msfvy, grid%msftx,grid%msfty, grid%clat, grid%f, grid%e, grid%sina, grid%cosa, &
7631 grid%fnm, grid%fnp, grid%rdn, grid%rdnw, &
7632 grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, &
7633 grid%xkmh,grid%a_xkmh, grid%xkhh,grid%a_xkhh, &
7634 grid%diff_6th_opt, grid%diff_6th_factor, &
7635 config_flags%momentum_adv_opt, &
7636 grid%dampcoef,grid%zdamp,config_flags%damp_opt,config_flags%rad_nudge, &
7637 grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m, &
7638 config_flags%non_hydrostatic, config_flags%top_lid, &
7639 grid%u_frame, grid%v_frame, &
7640 ids, ide, jds, jde, kds, kde, &
7641 ims, ime, jms, jme, kms, kme, &
7642 grid%i_start(ij), grid%i_end(ij), &
7643 grid%j_start(ij), grid%j_end(ij), &
7644 k_start, k_end, &
7645 max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
7646 END DO
7647 !$OMP END PARALLEL DO
7649 BENCH_END(adj_rk_tend_tim)
7651 adj_rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
7653 if ( config_flags%cu_physics .gt. 0 ) then
7654 CALL POPREAL8ARRAY ( grid%rqvcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7655 CALL POPREAL8ARRAY ( grid%rthcuten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7656 end if
7657 CALL POPREAL8ARRAY ( grid%rqvblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7658 CALL POPREAL8ARRAY ( grid%rthblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7659 CALL POPREAL8ARRAY ( grid%rvblten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7660 CALL POPREAL8ARRAY ( grid%rublten, (ime-ims+1)*(kme-kms+1)*(jme-jms+1) )
7661 !CALL pop2restore (grid%rublten,grid%rvblten,grid%rthblten,grid%rqvblten,grid%rthcuten,grid%rqvcuten,&
7662 ! "rublten,rvblten,rthblten,rqvblten,rthcuten,rqvcuten")
7663 CALL a_first_rk_step_part2 ( grid , config_flags &
7664 , moist ,a_moist , moist_tend ,a_moist_tend &
7665 !!!!! USE THE STATEMENTS REMARKED WHEN chem and tracer ARE NEEDED. Ning Pan, 2010-08-20
7666 , chem , chem , chem_tend , chem_tend &
7667 , tracer, a_tracer, tracer_tend, a_tracer_tend &
7668 , scalar,a_scalar, scalar_tend,a_scalar_tend &
7669 !!!!! USE THE STATEMENT REMARKED WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
7670 ! , fdda3d,a_fdda3d, fdda2d, a_fdda2d &
7671 !!!!! REMOVE THE FOLLOWING STATEMENT WHEN fdda3d and fdda2d ARE NEEDED. Ning Pan, 2010-08-20
7672 , fdda3d, fdda3d, fdda2d, fdda2d &
7673 , ru_tendf,a_ru_tendf, rv_tendf,a_rv_tendf &
7674 , rw_tendf,a_rw_tendf, t_tendf ,a_t_tendf &
7675 , ph_tendf,a_ph_tendf, mu_tendf,a_mu_tendf &
7676 , tke_tend,a_tke_tend &
7677 , adapt_step_flag , curr_secs &
7678 !!!!! USE THE STATEMENTS REMARKED WHEN CODING AD OF PHYSICS. Ning Pan, 2010-08-20
7679 ! , psim ,a_psim , psih ,a_psih , wspd ,a_wspd , &
7680 ! gz1oz0 ,a_gz1oz0 , br ,a_br , chklowq,a_chklowq &
7681 ! , cu_act_flag , hol ,a_hol, th_phy,a_th_phy &
7682 !!!!! REMOVE THE FOLLOWING 3 STATEMENTS WHEN CODING AD OF PHYSICS. Ning Pan, 2010-08-20
7683 , psim , psim , psih , psih , &
7684 !201602 gz1oz0 , gz1oz0 , br , br , chklowq, chklowq &
7685 !201602: br became a state variable and was removed from the argument
7686 gz1oz0 , gz1oz0 , chklowq, chklowq &
7687 , cu_act_flag , hol , hol, th_phy,a_th_phy &
7688 , pi_phy ,a_pi_phy, p_phy ,a_p_phy , grid%t_phy ,grid%a_t_phy &
7689 , dz8w ,a_dz8w , p8w ,a_p8w , t8w ,a_t8w &
7690 , nba_mij,a_nba_mij, num_nba_mij &
7691 , nba_rij,a_nba_rij, num_nba_rij &
7692 , ids, ide, jds, jde, kds, kde &
7693 , ims, ime, jms, jme, kms, kme &
7694 , ips, ipe, jps, jpe, kps, kpe &
7695 , imsx, imex, jmsx, jmex, kmsx, kmex &
7696 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
7697 , imsy, imey, jmsy, jmey, kmsy, kmey &
7698 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
7699 , k_start , k_end &
7700 )
7702 CALL a_first_rk_step_part1 ( grid, config_flags &
7703 , moist , a_moist, moist_tend, a_moist_tend &
7704 , chem , chem_tend &
7705 , tracer, a_tracer, tracer_tend, a_tracer_tend &
7706 , scalar , a_scalar, scalar_tend , a_scalar_tend &
7707 , fdda3d, fdda2d &
7708 , aerod &
7709 , ru_tendf, a_ru_tendf, rv_tendf , a_rv_tendf &
7710 , rw_tendf, a_rw_tendf, t_tendf , a_t_tendf &
7711 , ph_tendf, a_ph_tendf, mu_tendf , a_mu_tendf &
7712 , tke_tend, a_tke_tend &
7713 , config_flags%use_adaptive_time_step &
7714 , curr_secs &
7715 , psim , psih , gz1oz0 &
7716 , chklowq &
7717 , cu_act_flag , hol , th_phy , a_th_phy &
7718 , pi_phy , a_pi_phy, p_phy , a_p_phy, grid%t_phy , grid%a_t_phy &
7719 , dz8w , a_dz8w, p8w , a_p8w, t8w , a_t8w &
7720 , ids, ide, jds, jde, kds, kde &
7721 , ims, ime, jms, jme, kms, kme &
7722 , ips, ipe, jps, jpe, kps, kpe &
7723 , imsx, imex, jmsx, jmex, kmsx, kmex &
7724 , ipsx, ipex, jpsx, jpex, kpsx, kpex &
7725 , imsy, imey, jmsy, jmey, kmsy, kmey &
7726 , ipsy, ipey, jpsy, jpey, kpsy, kpey &
7727 , k_start , k_end &
7728 , f_flux &
7729 )
7731 END IF adj_rk_step_is_one
7733 BENCH_START(adj_set_phys_bc_tim)
7734 !$OMP PARALLEL DO &
7735 !$OMP PRIVATE ( ij )
7737 DO ij = grid%num_tiles,1,-1
7739 CALL wrf_debug ( 200 , ' call a_rk_phys_bc_dry_1' )
7741 CALL a_set_physical_bc3d( grid%a_ph_2, 'w', config_flags, &
7742 ids, ide, jds, jde, kds, kde, &
7743 ims, ime, jms, jme, kms, kme, &
7744 ips, ipe, jps, jpe, kps, kpe, &
7745 grid%i_start(ij), grid%i_end(ij), &
7746 grid%j_start(ij), grid%j_end(ij), &
7747 k_start, k_end )
7749 CALL a_set_physical_bc3d( grid%a_al, 'p', config_flags, &
7750 ids, ide, jds, jde, kds, kde, &
7751 ims, ime, jms, jme, kms, kme, &
7752 ips, ipe, jps, jpe, kps, kpe, &
7753 grid%i_start(ij), grid%i_end(ij), &
7754 grid%j_start(ij), grid%j_end(ij), &
7755 k_start , k_end )
7757 CALL a_rk_phys_bc_dry_1( config_flags, grid%ru,grid%a_ru, grid%rv,grid%a_rv, &
7758 grid%rw,grid%a_rw, grid%ww,grid%a_ww, &
7759 grid%muu,grid%a_muu, grid%muv,grid%a_muv, grid%mut,grid%a_mut, &
7760 grid%php,grid%a_php, grid%alt,grid%a_alt, grid%p,grid%a_p, &
7761 ids, ide, jds, jde, kds, kde, &
7762 ims, ime, jms, jme, kms, kme, &
7763 ips, ipe, jps, jpe, kps, kpe, &
7764 grid%i_start(ij), grid%i_end(ij), &
7765 grid%j_start(ij), grid%j_end(ij), &
7766 k_start, k_end )
7767 END DO
7768 !$OMP END PARALLEL DO
7769 BENCH_END(adj_set_phys_bc_tim)
7771 #ifdef DM_PARALLEL
7772 # include "HALO_EM_A_AD.inc"
7773 #endif
7775 CALL wrf_debug ( 200 , ' call a_rk_step_prep ' )
7777 BENCH_START(adj_step_prep_tim)
7779 !CALL pop2restore (moist, "moist")
7780 !CALL pop2restore (grid%u_2,grid%v_2,grid%w_2, "u,v,w")
7781 !CALL pop2restore (grid%mu_2, "mu")
7782 !$OMP PARALLEL DO &
7783 !$OMP PRIVATE ( ij )
7785 DO ij = grid%num_tiles,1,-1
7787 CALL a_rk_step_prep ( config_flags, rk_step, &
7788 grid%u_2, grid%a_u_2, grid%v_2, grid%a_v_2, &
7789 grid%w_2, grid%a_w_2, grid%t_2, grid%a_t_2, &
7790 grid%ph_2, grid%a_ph_2, grid%mu_2, grid%a_mu_2, &
7791 moist, a_moist, &
7792 grid%ru, grid%a_ru, grid%rv, grid%a_rv, grid%rw, grid%a_rw, &
7793 grid%ww, grid%a_ww, grid%php, grid%a_php, grid%alt, grid%a_alt, &
7794 grid%muu, grid%a_muu, grid%muv, grid%a_muv, &
7795 grid%mub, grid%mut, grid%a_mut, &
7796 grid%phb, grid%pb, grid%p, grid%a_p, grid%al, grid%a_al, grid%alb, &
7797 cqu, a_cqu, cqv, a_cqv, cqw, a_cqw, &
7798 grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
7799 grid%msfvy, grid%msftx, grid%msfty, &
7800 grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
7801 num_3d_m, &
7802 ids, ide, jds, jde, kds, kde, &
7803 ims, ime, jms, jme, kms, kme, &
7804 grid%i_start(ij), grid%i_end(ij), &
7805 grid%j_start(ij), grid%j_end(ij), &
7806 k_start, k_end )
7807 END DO
7808 !$OMP END PARALLEL DO
7809 BENCH_END(adj_step_prep_tim)
7811 END DO adj_Runge_Kutta_loop
7813 ! Adjoint of setting bdy tendencies to zero for DFI if constant_bc = true
7815 !$OMP PARALLEL DO &
7816 !$OMP PRIVATE ( ij )
7817 DO ij = grid%num_tiles,1,-1
7819 IF( config_flags%specified .AND. config_flags%constant_bc ) THEN
7821 CALL a_zero_bdytend (grid%u_btxs,grid%a_u_btxs,grid%u_btxe,grid%a_u_btxe, &
7822 grid%u_btys,grid%a_u_btys,grid%u_btye,grid%a_u_btye, &
7823 grid%v_btxs,grid%a_v_btxs,grid%v_btxe,grid%a_v_btxe, &
7824 grid%v_btys,grid%a_v_btys,grid%v_btye,grid%a_v_btye, &
7825 grid%ph_btxs,grid%a_ph_btxs,grid%ph_btxe,grid%a_ph_btxe, &
7826 grid%ph_btys,grid%a_ph_btys,grid%ph_btye,grid%a_ph_btye, &
7827 grid%t_btxs,grid%a_t_btxs,grid%t_btxe,grid%a_t_btxe, &
7828 grid%t_btys,grid%a_t_btys,grid%t_btye,grid%a_t_btye, &
7829 grid%w_btxs,grid%a_w_btxs,grid%w_btxe,grid%a_w_btxe, &
7830 grid%w_btys,grid%a_w_btys,grid%w_btye,grid%a_w_btye, &
7831 grid%mu_btxs,grid%a_mu_btxs,grid%mu_btxe,grid%a_mu_btxe, &
7832 grid%mu_btys,grid%a_mu_btys,grid%mu_btye,grid%a_mu_btye, &
7833 moist_btxs,a_moist_btxs,moist_btxe,a_moist_btxe, &
7834 moist_btys,a_moist_btys,moist_btye,a_moist_btye, &
7835 scalar_btxs,a_scalar_btxs,scalar_btxe,a_scalar_btxe, &
7836 scalar_btys,a_scalar_btys,scalar_btye,a_scalar_btye, &
7837 grid%spec_bdy_width,num_3d_m,num_3d_s, &
7838 ids,ide, jds,jde, kds,kde, &
7839 ims,ime, jms,jme, kms,kme, &
7840 ips,ipe, jps,jpe, kps,kpe, &
7841 grid%i_start(ij), grid%i_end(ij), &
7842 grid%j_start(ij), grid%j_end(ij), &
7843 k_start, k_end )
7845 ENDIF
7846 ENDDO
7847 !$OMP END PARALLEL DO
7849 #ifdef DM_PARALLEL
7850 ! Use a_u_1, a_v_1 etc as temporary buffers to do the halo exchange for bdy fields
7852 ! X-direction pack
7854 !$OMP PARALLEL DO &
7855 !$OMP PRIVATE ( ij )
7856 DO ij = grid%num_tiles,1,-1
7857 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7858 grid%a_tke_1, 0, 0, grid%spec_bdy_width , &
7859 grid%a_u_bxs, grid%a_u_bxe, grid%a_u_bys, grid%a_u_bye, &
7860 grid%a_v_bxs, grid%a_v_bxe, grid%a_v_bys, grid%a_v_bye, &
7861 grid%a_t_bxs, grid%a_t_bxe, grid%a_t_bys, grid%a_t_bye, &
7862 grid%a_ph_bxs, grid%a_ph_bxe, grid%a_ph_bys, grid%a_ph_bye, &
7863 grid%a_mu_bxs, grid%a_mu_bxe, grid%a_mu_bys, grid%a_mu_bye, &
7864 a_moist_bxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_bxe(:,:,:,PARAM_FIRST_SCALAR), &
7865 a_moist_bys(:,:,:,PARAM_FIRST_SCALAR), a_moist_bye(:,:,:,PARAM_FIRST_SCALAR), &
7866 ids, ide, jds, jde, kds, kde, &
7867 ims, ime, jms, jme, kms, kme, &
7868 grid%i_start(ij), grid%i_end(ij), &
7869 grid%j_start(ij), grid%j_end(ij), &
7870 k_start, k_end )
7871 ENDDO
7872 !$OMP END PARALLEL DO
7874 # include "HALO_EM_BDY_AD.inc"
7876 ! X-direction unpack
7878 !$OMP PARALLEL DO &
7879 !$OMP PRIVATE ( ij )
7880 DO ij = grid%num_tiles,1,-1
7881 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7882 grid%a_tke_1, 1, 0, grid%spec_bdy_width , &
7883 grid%a_u_bxs, grid%a_u_bxe, grid%a_u_bys, grid%a_u_bye, &
7884 grid%a_v_bxs, grid%a_v_bxe, grid%a_v_bys, grid%a_v_bye, &
7885 grid%a_t_bxs, grid%a_t_bxe, grid%a_t_bys, grid%a_t_bye, &
7886 grid%a_ph_bxs, grid%a_ph_bxe, grid%a_ph_bys, grid%a_ph_bye, &
7887 grid%a_mu_bxs, grid%a_mu_bxe, grid%a_mu_bys, grid%a_mu_bye, &
7888 a_moist_bxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_bxe(:,:,:,PARAM_FIRST_SCALAR), &
7889 a_moist_bys(:,:,:,PARAM_FIRST_SCALAR), a_moist_bye(:,:,:,PARAM_FIRST_SCALAR), &
7890 ids, ide, jds, jde, kds, kde, &
7891 ims, ime, jms, jme, kms, kme, &
7892 grid%i_start(ij), grid%i_end(ij), &
7893 grid%j_start(ij), grid%j_end(ij), &
7894 k_start, k_end )
7895 ENDDO
7896 !$OMP END PARALLEL DO
7898 grid%a_u_1 = 0.0
7899 grid%a_v_1 = 0.0
7900 grid%a_t_1 = 0.0
7901 grid%a_ph_1 = 0.0
7902 grid%a_mu_1 = 0.0
7903 grid%a_tke_1 = 0.0
7905 ! X-direction pack
7907 !$OMP PARALLEL DO &
7908 !$OMP PRIVATE ( ij )
7909 DO ij = grid%num_tiles,1,-1
7910 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7911 grid%a_tke_1, 0, 0, grid%spec_bdy_width , &
7912 grid%a_u_btxs, grid%a_u_btxe, grid%a_u_btys, grid%a_u_btye, &
7913 grid%a_v_btxs, grid%a_v_btxe, grid%a_v_btys, grid%a_v_btye, &
7914 grid%a_t_btxs, grid%a_t_btxe, grid%a_t_btys, grid%a_t_btye, &
7915 grid%a_ph_btxs, grid%a_ph_btxe, grid%a_ph_btys, grid%a_ph_btye, &
7916 grid%a_mu_btxs, grid%a_mu_btxe, grid%a_mu_btys, grid%a_mu_btye, &
7917 a_moist_btxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_btxe(:,:,:,PARAM_FIRST_SCALAR), &
7918 a_moist_btys(:,:,:,PARAM_FIRST_SCALAR), a_moist_btye(:,:,:,PARAM_FIRST_SCALAR), &
7919 ids, ide, jds, jde, kds, kde, &
7920 ims, ime, jms, jme, kms, kme, &
7921 grid%i_start(ij), grid%i_end(ij), &
7922 grid%j_start(ij), grid%j_end(ij), &
7923 k_start, k_end )
7924 ENDDO
7925 !$OMP END PARALLEL DO
7927 # include "HALO_EM_BDY_AD.inc"
7929 ! X-direction unpack
7931 !$OMP PARALLEL DO &
7932 !$OMP PRIVATE ( ij )
7933 DO ij = grid%num_tiles,1,-1
7934 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7935 grid%a_tke_1, 1, 0, grid%spec_bdy_width , &
7936 grid%a_u_btxs, grid%a_u_btxe, grid%a_u_btys, grid%a_u_btye, &
7937 grid%a_v_btxs, grid%a_v_btxe, grid%a_v_btys, grid%a_v_btye, &
7938 grid%a_t_btxs, grid%a_t_btxe, grid%a_t_btys, grid%a_t_btye, &
7939 grid%a_ph_btxs, grid%a_ph_btxe, grid%a_ph_btys, grid%a_ph_btye, &
7940 grid%a_mu_btxs, grid%a_mu_btxe, grid%a_mu_btys, grid%a_mu_btye, &
7941 a_moist_btxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_btxe(:,:,:,PARAM_FIRST_SCALAR), &
7942 a_moist_btys(:,:,:,PARAM_FIRST_SCALAR), a_moist_btye(:,:,:,PARAM_FIRST_SCALAR), &
7943 ids, ide, jds, jde, kds, kde, &
7944 ims, ime, jms, jme, kms, kme, &
7945 grid%i_start(ij), grid%i_end(ij), &
7946 grid%j_start(ij), grid%j_end(ij), &
7947 k_start, k_end )
7948 ENDDO
7949 !$OMP END PARALLEL DO
7951 grid%a_u_1 = 0.0
7952 grid%a_v_1 = 0.0
7953 grid%a_t_1 = 0.0
7954 grid%a_ph_1 = 0.0
7955 grid%a_mu_1 = 0.0
7956 grid%a_tke_1 = 0.0
7958 ! Y-direction pack
7960 !$OMP PARALLEL DO &
7961 !$OMP PRIVATE ( ij )
7962 DO ij = grid%num_tiles,1,-1
7963 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7964 grid%a_tke_1, 0, 1, grid%spec_bdy_width , &
7965 grid%a_u_bxs, grid%a_u_bxe, grid%a_u_bys, grid%a_u_bye, &
7966 grid%a_v_bxs, grid%a_v_bxe, grid%a_v_bys, grid%a_v_bye, &
7967 grid%a_t_bxs, grid%a_t_bxe, grid%a_t_bys, grid%a_t_bye, &
7968 grid%a_ph_bxs, grid%a_ph_bxe, grid%a_ph_bys, grid%a_ph_bye, &
7969 grid%a_mu_bxs, grid%a_mu_bxe, grid%a_mu_bys, grid%a_mu_bye, &
7970 a_moist_bxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_bxe(:,:,:,PARAM_FIRST_SCALAR), &
7971 a_moist_bys(:,:,:,PARAM_FIRST_SCALAR), a_moist_bye(:,:,:,PARAM_FIRST_SCALAR), &
7972 ids, ide, jds, jde, kds, kde, &
7973 ims, ime, jms, jme, kms, kme, &
7974 grid%i_start(ij), grid%i_end(ij), &
7975 grid%j_start(ij), grid%j_end(ij), &
7976 k_start, k_end )
7977 ENDDO
7978 !$OMP END PARALLEL DO
7980 # include "HALO_EM_BDY_AD.inc"
7982 ! Y-direction pack
7984 !$OMP PARALLEL DO &
7985 !$OMP PRIVATE ( ij )
7986 DO ij = grid%num_tiles,1,-1
7987 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
7988 grid%a_tke_1, 1, 1, grid%spec_bdy_width , &
7989 grid%a_u_bxs, grid%a_u_bxe, grid%a_u_bys, grid%a_u_bye, &
7990 grid%a_v_bxs, grid%a_v_bxe, grid%a_v_bys, grid%a_v_bye, &
7991 grid%a_t_bxs, grid%a_t_bxe, grid%a_t_bys, grid%a_t_bye, &
7992 grid%a_ph_bxs, grid%a_ph_bxe, grid%a_ph_bys, grid%a_ph_bye, &
7993 grid%a_mu_bxs, grid%a_mu_bxe, grid%a_mu_bys, grid%a_mu_bye, &
7994 a_moist_bxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_bxe(:,:,:,PARAM_FIRST_SCALAR), &
7995 a_moist_bys(:,:,:,PARAM_FIRST_SCALAR), a_moist_bye(:,:,:,PARAM_FIRST_SCALAR), &
7996 ids, ide, jds, jde, kds, kde, &
7997 ims, ime, jms, jme, kms, kme, &
7998 grid%i_start(ij), grid%i_end(ij), &
7999 grid%j_start(ij), grid%j_end(ij), &
8000 k_start, k_end )
8001 ENDDO
8002 !$OMP END PARALLEL DO
8004 grid%a_u_1 = 0.0
8005 grid%a_v_1 = 0.0
8006 grid%a_t_1 = 0.0
8007 grid%a_ph_1 = 0.0
8008 grid%a_mu_1 = 0.0
8009 grid%a_tke_1 = 0.0
8011 ! Y-direction pack
8013 !$OMP PARALLEL DO &
8014 !$OMP PRIVATE ( ij )
8015 DO ij = grid%num_tiles,1,-1
8016 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
8017 grid%a_tke_1, 0, 1, grid%spec_bdy_width , &
8018 grid%a_u_btxs, grid%a_u_btxe, grid%a_u_btys, grid%a_u_btye, &
8019 grid%a_v_btxs, grid%a_v_btxe, grid%a_v_btys, grid%a_v_btye, &
8020 grid%a_t_btxs, grid%a_t_btxe, grid%a_t_btys, grid%a_t_btye, &
8021 grid%a_ph_btxs, grid%a_ph_btxe, grid%a_ph_btys, grid%a_ph_btye, &
8022 grid%a_mu_btxs, grid%a_mu_btxe, grid%a_mu_btys, grid%a_mu_btye, &
8023 a_moist_btxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_btxe(:,:,:,PARAM_FIRST_SCALAR), &
8024 a_moist_btys(:,:,:,PARAM_FIRST_SCALAR), a_moist_btye(:,:,:,PARAM_FIRST_SCALAR), &
8025 ids, ide, jds, jde, kds, kde, &
8026 ims, ime, jms, jme, kms, kme, &
8027 grid%i_start(ij), grid%i_end(ij), &
8028 grid%j_start(ij), grid%j_end(ij), &
8029 k_start, k_end )
8030 ENDDO
8031 !$OMP END PARALLEL DO
8033 # include "HALO_EM_BDY_AD.inc"
8035 ! Y-direction unpack
8037 !$OMP PARALLEL DO &
8038 !$OMP PRIVATE ( ij )
8039 DO ij = grid%num_tiles,1,-1
8040 CALL bdy_fields_halo ( grid%a_u_1 , grid%a_v_1, grid%a_t_1, grid%a_ph_1, grid%a_mu_1, &
8041 grid%a_tke_1, 1, 1, grid%spec_bdy_width , &
8042 grid%a_u_btxs, grid%a_u_btxe, grid%a_u_btys, grid%a_u_btye, &
8043 grid%a_v_btxs, grid%a_v_btxe, grid%a_v_btys, grid%a_v_btye, &
8044 grid%a_t_btxs, grid%a_t_btxe, grid%a_t_btys, grid%a_t_btye, &
8045 grid%a_ph_btxs, grid%a_ph_btxe, grid%a_ph_btys, grid%a_ph_btye, &
8046 grid%a_mu_btxs, grid%a_mu_btxe, grid%a_mu_btys, grid%a_mu_btye, &
8047 a_moist_btxs(:,:,:,PARAM_FIRST_SCALAR), a_moist_btxe(:,:,:,PARAM_FIRST_SCALAR), &
8048 a_moist_btys(:,:,:,PARAM_FIRST_SCALAR), a_moist_btye(:,:,:,PARAM_FIRST_SCALAR), &
8049 ids, ide, jds, jde, kds, kde, &
8050 ims, ime, jms, jme, kms, kme, &
8051 grid%i_start(ij), grid%i_end(ij), &
8052 grid%j_start(ij), grid%j_end(ij), &
8053 k_start, k_end )
8054 ENDDO
8055 !$OMP END PARALLEL DO
8057 grid%a_u_1 = 0.0
8058 grid%a_v_1 = 0.0
8059 grid%a_t_1 = 0.0
8060 grid%a_ph_1 = 0.0
8061 grid%a_mu_1 = 0.0
8062 grid%a_tke_1 = 0.0
8063 #endif
8065 ! Max values of CFL for adaptive time step scheme
8067 grid%itimestep = grid%itimestep - 1
8069 DEALLOCATE(max_vert_cfl_tmp)
8070 DEALLOCATE(max_horiz_cfl_tmp)
8072 RETURN
8074 END SUBROUTINE solve_em_ad