Context Navigation

solve_em.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 156.1 KB

Line
1	!WRF:MEDIATION_LAYER:SOLVER
2
3	SUBROUTINE solve_em ( grid , config_flags &
4	! Arguments generated from Registry
5	#include "dummy_new_args.inc"
6	!
7	)
8	! Driver layer modules
9	USE module_state_description
10	USE module_domain, ONLY : domain, get_ijk_from_grid, get_ijk_from_subgrid, domain_get_current_time, domain_get_start_time
11	USE module_configure, ONLY : grid_config_rec_type
12	USE module_driver_constants
13	USE module_machine
14	USE module_tiles, ONLY : set_tiles
15	#ifdef DM_PARALLEL
16	USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, wrf_dm_maxval
17	#else
18	USE module_dm
19	#endif
20	USE module_comm_dm
21	USE module_utility
22	! Mediation layer modules
23	! Model layer modules
24	USE module_model_constants
25	USE module_small_step_em
26	USE module_em
27	USE module_big_step_utilities_em
28	USE module_bc
29	USE module_bc_em
30	USE module_solvedebug_em
31	USE module_physics_addtendc
32	USE module_diffusion_em
33	USE module_polarfft
34	USE module_microphysics_driver
35	USE module_microphysics_zero_out
36	USE module_fddaobs_driver
37	USE module_diagnostics
38	#ifdef WRF_CHEM
39	USE module_input_chem_data
40	USE module_chem_utilities
41	#endif
42	USE module_first_rk_step_part1
43	USE module_first_rk_step_part2
44	USE module_llxy, ONLY : proj_cassini
45
46	IMPLICIT NONE
47
48	! Input data.
49
50	TYPE(domain) , TARGET :: grid
51
52	! Definitions of dummy arguments to this routine (generated from Registry).
53	#include "dummy_new_decl.inc"
54
55	! Structure that contains run-time configuration (namelist) data for domain
56	TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
57
58	! Local data
59
60	INTEGER :: k_start , k_end, its, ite, jts, jte
61	INTEGER :: ids , ide , jds , jde , kds , kde , &
62	ims , ime , jms , jme , kms , kme , &
63	ips , ipe , jps , jpe , kps , kpe
64
65	INTEGER :: sids , side , sjds , sjde , skds , skde , &
66	sims , sime , sjms , sjme , skms , skme , &
67	sips , sipe , sjps , sjpe , skps , skpe
68
69
70	INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
71	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
72	imsy, imey, jmsy, jmey, kmsy, kmey, &
73	ipsy, ipey, jpsy, jpey, kpsy, kpey
74
75	INTEGER :: ij , iteration
76	INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s
77	INTEGER :: loop
78	INTEGER :: sz
79	INTEGER :: iswater
80
81	LOGICAL :: specified_bdy, channel_bdy
82
83	REAL :: t_new
84
85	! storage for tendencies and decoupled state (generated from Registry)
86
87	#include <i1_decl.inc>
88	! Previous time level of tracer arrays now defined as i1 variables;
89	! the state 4d arrays now redefined as 1-time level arrays in Registry.
90	! Benefit: save memory in nested runs, since only 1 domain is active at a
91	! time. Potential problem on stack-limited architectures: increases
92	! amount of data on program stack by making these automatic arrays.
93
94	INTEGER :: rc
95	INTEGER :: number_of_small_timesteps, rk_step
96	INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
97	INTEGER :: idum1, idum2, dynamics_option
98
99	INTEGER :: rk_order, iwmax, jwmax, kwmax
100	REAL :: dt_rk, dts_rk, dts, dtm, wmax
101	REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp
102	LOGICAL :: leapfrog
103	INTEGER :: l,kte,kk
104	REAL :: curr_secs
105	INTEGER :: num_sound_steps
106	INTEGER :: idex, jdex
107	REAL :: max_msft
108	REAL :: spacing
109
110	INTEGER :: ii, jj !kk is above after l,kte
111	REAL :: dclat
112	INTEGER :: debug_level
113
114	! urban related variables
115	INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban
116
117	TYPE(WRFU_TimeInterval) :: tmpTimeInterval
118	REAL :: real_time
119	LOGICAL :: adapt_step_flag
120
121	! Define benchmarking timers if -DBENCH is compiled
122	#include <bench_solve_em_def.h>
123
124	!----------------------
125	! Executable statements
126	!----------------------
127
128	!<DESCRIPTION>
129	!<pre>
130	! solve_em is the main driver for advancing a grid a single timestep.
131	! It is a mediation-layer routine -> DM and SM calls are made where
132	! needed for parallel processing.
133	!
134	! solve_em can integrate the equations using 3 time-integration methods
135	!
136	! - 3rd order Runge-Kutta time integration (recommended)
137	!
138	! - 2nd order Runge-Kutta time integration
139	!
140	! The main sections of solve_em are
141	!
142	! (1) Runge-Kutta (RK) loop
143	!
144	! (2) Non-timesplit physics (i.e., tendencies computed for updating
145	! model state variables during the first RK sub-step (loop)
146	!
147	! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
148	!
149	! (4) scalar advance for moist and chem scalar variables (and TKE)
150	! within the RK sub-steps.
151	!
152	! (5) time-split physics (after the RK step), currently this includes
153	! only microphyics
154	!
155	! A more detailed description of these sections follows.
156	!</pre>
157	!</DESCRIPTION>
158
159	! Initialize timers if compiled with -DBENCH
160	#include <bench_solve_em_init.h>
161
162	! set runge-kutta solver (2nd or 3rd order)
163
164	dynamics_option = config_flags%rk_ord
165
166	! Obtain dimension information stored in the grid data structure.
167
168	CALL get_ijk_from_grid ( grid , &
169	ids, ide, jds, jde, kds, kde, &
170	ims, ime, jms, jme, kms, kme, &
171	ips, ipe, jps, jpe, kps, kpe, &
172	imsx, imex, jmsx, jmex, kmsx, kmex, &
173	ipsx, ipex, jpsx, jpex, kpsx, kpex, &
174	imsy, imey, jmsy, jmey, kmsy, kmey, &
175	ipsy, ipey, jpsy, jpey, kpsy, kpey )
176
177	CALL get_ijk_from_subgrid ( grid , &
178	sids, side, sjds, sjde, skds, skde, &
179	sims, sime, sjms, sjme, skms, skme, &
180	sips, sipe, sjps, sjpe, skps, skpe )
181	k_start = kps
182	k_end = kpe
183
184	num_3d_m = num_moist
185	num_3d_c = num_chem
186	num_3d_s = num_scalar
187
188
189	! Compute these starting and stopping locations for each tile and number of tiles.
190	! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles
191	CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
192
193	! Max values of CFL for adaptive time step scheme
194
195	ALLOCATE (max_vert_cfl_tmp(grid%num_tiles))
196	ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles))
197
198	grid%itimestep = grid%itimestep + 1
199
200	IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny)
201
202	!**********************************************************************
203	!
204	! LET US BEGIN.......
205	!
206	!<DESCRIPTION>
207	!<pre>
208	! (1) RK integration loop is named the "Runge_Kutta_loop:"
209	!
210	! Predictor-corrector type time integration.
211	! Advection terms are evaluated at time t for the predictor step,
212	! and advection is re-evaluated with the latest predicted value for
213	! each succeeding time corrector step
214	!
215	! 2nd order Runge Kutta (rk_order = 2):
216	! Step 1 is taken to the midpoint predictor, step 2 is the full step.
217	!
218	! 3rd order Runge Kutta (rk_order = 3):
219	! Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
220	! and step 3 is from t to dt.
221	!
222	! non-timesplit physics are evaluated during first RK step and
223	! these physics tendencies are stored for use in each RK pass.
224	!</pre>
225	!</DESCRIPTION>
226	!**********************************************************************
227
228	#ifdef WRF_CHEM
229	!
230	! prepare chem aerosols for advection before communication
231	!
232
233	kte=min(k_end,kde-1)
234	# ifdef DM_PARALLEL
235	if ( num_chem >= PARAM_FIRST_SCALAR ) then
236	!-----------------------------------------------------------------------
237	! see matching halo calls below for stencils
238	!--------------------------------------------------------------
239	CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
240	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
241	# include "HALO_EM_CHEM_E_3.inc"
242	IF( config_flags%progn > 0 ) THEN
243	# include "HALO_EM_SCALAR_E_3.inc"
244	ENDIF
245	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
246	# include "HALO_EM_CHEM_E_5.inc"
247	IF( config_flags%progn > 0 ) THEN
248	# include "HALO_EM_SCALAR_E_5.inc"
249	ENDIF
250	ELSE
251	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
252	CALL wrf_error_fatal(TRIM(wrf_err_message))
253	ENDIF
254	ENDIF
255	# endif
256	!--------------------------------------------------------------
257	#endif
258
259	rk_order = config_flags%rk_ord
260
261
262	!
263	! Calculate current time in seconds since beginning of model run.
264	! Unfortunately, ESMF does not seem to have a way to return
265	! floating point seconds based on a TimeInterval. So, we will
266	! calculate it here--but, this is not clean!!
267	!
268	tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_start_time ( grid )
269	curr_secs = real_time(tmpTimeInterval)
270
271	!-----------------------------------------------------------------------------
272	! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07
273	! In this call, we do the time-step adaptation and set time-dependent lateral
274	! boundary condition nudging weights.
275	!
276	IF (config_flags%use_adaptive_time_step) THEN
277	CALL adapt_timestep(grid, config_flags)
278	adapt_step_flag = .TRUE.
279	ELSE
280	adapt_step_flag = .FALSE.
281	ENDIF
282	! End of adaptive time step modifications
283	!-----------------------------------------------------------------------------
284
285	IF ( grid%time_step_sound == 0 ) THEN
286	! This function will give 4 for 6dx and 6 for 10dx and returns even numbers only
287	spacing = min(grid%dx, grid%dy)
288	IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN
289	max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , &
290	1.0/COS(config_flags%fft_filter_lat*degrad) )
291	num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
292	ELSE IF ( config_flags%use_adaptive_time_step ) THEN
293	max_msft= MAX(grid%max_msftx, grid%max_msfty)
294	num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 )
295	ELSE
296	num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 )
297	END IF
298	WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps
299	CALL wrf_debug ( 50 , wrf_err_message )
300	ELSE
301	num_sound_steps = grid%time_step_sound
302	ENDIF
303
304	IF (config_flags%use_adaptive_time_step) THEN
305
306	CALL get_wrf_debug_level( debug_level )
307	IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
308	#ifdef DM_PARALLEL
309	CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex)
310	#endif
311	WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',&
312	grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl
313	CALL wrf_debug ( 0 , wrf_err_message )
314	ENDIF
315
316	grid%max_cfl_val = 0
317	grid%max_horiz_cfl = 0
318	grid%max_vert_cfl = 0
319	ENDIF
320
321	dts = grid%dt/float(num_sound_steps)
322
323	Runge_Kutta_loop: DO rk_step = 1, rk_order
324
325	! Set the step size and number of small timesteps for
326	! each part of the timestep
327
328	dtm = grid%dt
329	IF ( rk_order == 1 ) THEN
330
331	write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
332	CALL wrf_error_fatal( wrf_err_message )
333
334	ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep
335
336	IF ( rk_step == 1) THEN
337	dt_rk = 0.5*grid%dt
338	dts_rk = dts
339	number_of_small_timesteps = num_sound_steps/2
340	ELSE
341	dt_rk = grid%dt
342	dts_rk = dts
343	number_of_small_timesteps = num_sound_steps
344	ENDIF
345
346	ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta
347
348	IF ( rk_step == 1) THEN
349	dt_rk = grid%dt/3.
350	dts_rk = dt_rk
351	number_of_small_timesteps = 1
352	ELSE IF (rk_step == 2) THEN
353	dt_rk = 0.5*grid%dt
354	dts_rk = dts
355	number_of_small_timesteps = num_sound_steps/2
356	ELSE
357	dt_rk = grid%dt
358	dts_rk = dts
359	number_of_small_timesteps = num_sound_steps
360	ENDIF
361
362	ELSE
363
364	write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option
365	CALL wrf_error_fatal( wrf_err_message )
366
367	END IF
368
369	! Ensure that polar meridional velocity is zero
370	IF (config_flags%polar) THEN
371	!$OMP PARALLEL DO &
372	!$OMP PRIVATE ( ij )
373	DO ij = 1 , grid%num_tiles
374	CALL zero_pole ( grid%v_1, &
375	ids, ide, jds, jde, kds, kde, &
376	ims, ime, jms, jme, kms, kme, &
377	grid%i_start(ij), grid%i_end(ij), &
378	grid%j_start(ij), grid%j_end(ij), &
379	k_start, k_end )
380	CALL zero_pole ( grid%v_2, &
381	ids, ide, jds, jde, kds, kde, &
382	ims, ime, jms, jme, kms, kme, &
383	grid%i_start(ij), grid%i_end(ij), &
384	grid%j_start(ij), grid%j_end(ij), &
385	k_start, k_end )
386	END DO
387	!$OMP END PARALLEL DO
388	END IF
389	!
390	! Time level t is in the *_2 variable in the first part
391	! of the step, and in the *_1 variable after the predictor.
392	! the latest predicted values are stored in the *_2 variables.
393	!
394	CALL wrf_debug ( 200 , ' call rk_step_prep ' )
395
396	BENCH_START(step_prep_tim)
397	!$OMP PARALLEL DO &
398	!$OMP PRIVATE ( ij )
399
400	DO ij = 1 , grid%num_tiles
401
402	CALL rk_step_prep ( config_flags, rk_step, &
403	grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, &
404	moist, &
405	grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, &
406	grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, &
407	cqu, cqv, cqw, &
408	grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, &
409	grid%msfvy, grid%msftx, grid%msfty, &
410	grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, &
411	num_3d_m, &
412	ids, ide, jds, jde, kds, kde, &
413	ims, ime, jms, jme, kms, kme, &
414	grid%i_start(ij), grid%i_end(ij), &
415	grid%j_start(ij), grid%j_end(ij), &
416	k_start, k_end )
417
418	END DO
419	!$OMP END PARALLEL DO
420	BENCH_END(step_prep_tim)
421
422	#ifdef DM_PARALLEL
423	!-----------------------------------------------------------------------
424	! Stencils for patch communications (WCS, 29 June 2001)
425	! Note: the small size of this halo exchange reflects the
426	! fact that we are carrying the uncoupled variables
427	! as state variables in the mass coordinate model, as
428	! opposed to the coupled variables as in the height
429	! coordinate model.
430	!
431	! * * * * *
432	! * * * * * * * * *
433	! * + * * + * * * + * *
434	! * * * * * * * * *
435	! * * * * *
436	!
437	! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z)
438	!
439	! ru x
440	! rv x
441	! ww x
442	! php x
443	! alt x
444	! ph_2 x
445	! phb x
446	!
447	! the following are 2D (xy) variables
448	!
449	! muu x
450	! muv x
451	! mut x
452	!--------------------------------------------------------------
453	# include "HALO_EM_A.inc"
454	#endif
455
456	! set boundary conditions on variables
457	! from big_step_prep for use in big_step_proc
458
459	#ifdef DM_PARALLEL
460	# include "PERIOD_BDY_EM_A.inc"
461	#endif
462
463	BENCH_START(set_phys_bc_tim)
464	!$OMP PARALLEL DO &
465	!$OMP PRIVATE ( ij, ii, jj, kk )
466
467	DO ij = 1 , grid%num_tiles
468
469	CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
470
471	CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, &
472	grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, &
473	ids, ide, jds, jde, kds, kde, &
474	ims, ime, jms, jme, kms, kme, &
475	ips, ipe, jps, jpe, kps, kpe, &
476	grid%i_start(ij), grid%i_end(ij), &
477	grid%j_start(ij), grid%j_end(ij), &
478	k_start, k_end )
479	CALL set_physical_bc3d( grid%al, 'p', config_flags, &
480	ids, ide, jds, jde, kds, kde, &
481	ims, ime, jms, jme, kms, kme, &
482	ips, ipe, jps, jpe, kps, kpe, &
483	grid%i_start(ij), grid%i_end(ij), &
484	grid%j_start(ij), grid%j_end(ij), &
485	k_start , k_end )
486	CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
487	ids, ide, jds, jde, kds, kde, &
488	ims, ime, jms, jme, kms, kme, &
489	ips, ipe, jps, jpe, kps, kpe, &
490	grid%i_start(ij), grid%i_end(ij), &
491	grid%j_start(ij), grid%j_end(ij), &
492	k_start, k_end )
493
494	IF (config_flags%polar) THEN
495
496	!-------------------------------------------------------
497	! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
498	!-------------------------------------------------------
499
500	CALL pole_point_bc ( grid%v_1, &
501	ids, ide, jds, jde, kds, kde, &
502	ims, ime, jms, jme, kms, kme, &
503	grid%i_start(ij), grid%i_end(ij), &
504	grid%j_start(ij), grid%j_end(ij), &
505	k_start, k_end )
506
507	CALL pole_point_bc ( grid%v_2, &
508	ids, ide, jds, jde, kds, kde, &
509	ims, ime, jms, jme, kms, kme, &
510	grid%i_start(ij), grid%i_end(ij), &
511	grid%j_start(ij), grid%j_end(ij), &
512	k_start, k_end )
513
514	!-------------------------------------------------------
515	! end lat-lon grid pole-point (v) specification
516	!-------------------------------------------------------
517
518	ENDIF
519	END DO
520	!$OMP END PARALLEL DO
521	BENCH_END(set_phys_bc_tim)
522
523	rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies
524
525	!<DESCRIPTION>
526	!<pre>
527	!(2) The non-timesplit physics begins with a call to "phy_prep"
528	! (which computes some diagnostic variables such as temperature,
529	! pressure, u and v at p points, etc). This is followed by
530	! calls to the physics drivers:
531	!
532	! radiation,
533	! surface,
534	! pbl,
535	! cumulus,
536	! fddagd,
537	! 3D TKE and mixing.
538	!<pre>
539	!</DESCRIPTION>
540
541	CALL first_rk_step_part1 ( grid, config_flags &
542	, moist , moist_tend &
543	, chem , chem_tend &
544	, scalar , scalar_tend &
545	, fdda3d, fdda2d &
546	, ru_tendf, rv_tendf &
547	, rw_tendf, t_tendf &
548	, ph_tendf, mu_tendf &
549	, tke_tend &
550	, adapt_step_flag , curr_secs &
551	, psim , psih , wspd , gz1oz0 &
552	, br , chklowq &
553	, cu_act_flag , hol , th_phy &
554	, pi_phy , p_phy , t_phy &
555	, u_phy , v_phy &
556	, dz8w , p8w , t8w , rho_phy , rho &
557	, z_at_w , mu_3d &
558	, ids, ide, jds, jde, kds, kde &
559	, ims, ime, jms, jme, kms, kme &
560	, ips, ipe, jps, jpe, kps, kpe &
561	, k_start , k_end &
562	)
563
564	CALL first_rk_step_part2 ( grid, config_flags &
565	, moist , moist_tend &
566	, chem , chem_tend &
567	, scalar , scalar_tend &
568	, fdda3d, fdda2d &
569	, ru_tendf, rv_tendf &
570	, rw_tendf, t_tendf &
571	, ph_tendf, mu_tendf &
572	, tke_tend &
573	, adapt_step_flag , curr_secs &
574	, psim , psih , wspd , gz1oz0 &
575	, br , chklowq &
576	, cu_act_flag , hol , th_phy &
577	, pi_phy , p_phy , t_phy &
578	, u_phy , v_phy &
579	, dz8w , p8w , t8w , rho_phy , rho &
580	, z_at_w , mu_3d &
581	, ids, ide, jds, jde, kds, kde &
582	, ims, ime, jms, jme, kms, kme &
583	, ips, ipe, jps, jpe, kps, kpe &
584	, k_start , k_end &
585	)
586
587	END IF rk_step_is_one
588
589	BENCH_START(rk_tend_tim)
590	!$OMP PARALLEL DO &
591	!$OMP PRIVATE ( ij )
592	DO ij = 1 , grid%num_tiles
593
594	CALL wrf_debug ( 200 , ' call rk_tendency' )
595	CALL rk_tendency ( config_flags, rk_step &
596	,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend &
597	,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf &
598	,mu_tend, grid%u_save, grid%v_save, w_save, ph_save &
599	,grid%t_save, mu_save, grid%rthften &
600	,grid%ru, grid%rv, grid%rw, grid%ww &
601	,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2 &
602	,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1 &
603	,grid%h_diabatic, grid%phb, grid%t_init &
604	,grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub &
605	,grid%al, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw &
606	,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base &
607	,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv &
608	,grid%msfvy, grid%msftx,grid%msfty, grid%xlat, grid%f, grid%e, grid%sina, grid%cosa &
609	,grid%fnm, grid%fnp, grid%rdn, grid%rdnw &
610	,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh &
611	,grid%diff_6th_opt, grid%diff_6th_factor &
612	,grid%dampcoef,grid%zdamp,config_flags%damp_opt &
613	,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m &
614	,config_flags%non_hydrostatic, config_flags%top_lid &
615	,grid%u_frame, grid%v_frame &
616	,ids, ide, jds, jde, kds, kde &
617	,ims, ime, jms, jme, kms, kme &
618	,grid%i_start(ij), grid%i_end(ij) &
619	,grid%j_start(ij), grid%j_end(ij) &
620	,k_start, k_end &
621	,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij) )
622	END DO
623	!$OMP END PARALLEL DO
624	BENCH_END(rk_tend_tim)
625
626	IF (config_flags%use_adaptive_time_step) THEN
627	DO ij = 1 , grid%num_tiles
628	IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
629	grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
630	ENDIF
631	IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
632	grid%max_vert_cfl = max_vert_cfl_tmp(ij)
633	ENDIF
634	END DO
635
636	IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
637	grid%max_cfl_val = grid%max_horiz_cfl
638	ENDIF
639	IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
640	grid%max_cfl_val = grid%max_vert_cfl
641	ENDIF
642	ENDIF
643
644	BENCH_START(relax_bdy_dry_tim)
645	!$OMP PARALLEL DO &
646	!$OMP PRIVATE ( ij )
647	DO ij = 1 , grid%num_tiles
648
649	IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN
650
651	CALL relax_bdy_dry ( config_flags, &
652	grid%u_save, grid%v_save, ph_save, grid%t_save, &
653	w_save, mu_tend, &
654	grid%ru, grid%rv, grid%ph_2, grid%t_2, &
655	grid%w_2, grid%mu_2, grid%mut, &
656	grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
657	grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
658	grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
659	grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
660	grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
661	grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
662	grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
663	grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
664	grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
665	grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
666	grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
667	grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
668	config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
669	grid%dtbc, grid%fcx, grid%gcx, &
670	ids,ide, jds,jde, kds,kde, &
671	ims,ime, jms,jme, kms,kme, &
672	ips,ipe, jps,jpe, kps,kpe, &
673	grid%i_start(ij), grid%i_end(ij), &
674	grid%j_start(ij), grid%j_end(ij), &
675	k_start, k_end )
676
677	ENDIF
678
679	CALL rk_addtend_dry( grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend, &
680	ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
681	grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
682	mu_tend, mu_tendf, rk_step, &
683	grid%h_diabatic, grid%mut, grid%msftx, &
684	grid%msfty, grid%msfux,grid%msfuy, &
685	grid%msfvx, grid%msfvx_inv, grid%msfvy, &
686	ids,ide, jds,jde, kds,kde, &
687	ims,ime, jms,jme, kms,kme, &
688	ips,ipe, jps,jpe, kps,kpe, &
689	grid%i_start(ij), grid%i_end(ij), &
690	grid%j_start(ij), grid%j_end(ij), &
691	k_start, k_end )
692
693	IF( config_flags%specified .or. config_flags%nested ) THEN
694	CALL spec_bdy_dry ( config_flags, &
695	grid%ru_tend, grid%rv_tend, ph_tend, t_tend, &
696	rw_tend, mu_tend, &
697	grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
698	grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
699	grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
700	grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
701	grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
702	grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
703	grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
704	grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
705	grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
706	grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
707	grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
708	grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
709	config_flags%spec_bdy_width, grid%spec_zone, &
710	ids,ide, jds,jde, kds,kde, & ! domain dims
711	ims,ime, jms,jme, kms,kme, & ! memory dims
712	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
713	grid%i_start(ij), grid%i_end(ij), &
714	grid%j_start(ij), grid%j_end(ij), &
715	k_start, k_end )
716
717	ENDIF
718
719	END DO
720	!$OMP END PARALLEL DO
721	BENCH_END(relax_bdy_dry_tim)
722
723	!<DESCRIPTION>
724	!<pre>
725	! (3) Small (acoustic,sound) steps.
726	!
727	! Several acoustic steps are taken each RK pass. A small step
728	! sequence begins with calculating perturbation variables
729	! and coupling them to the column dry-air-mass mu
730	! (call to small_step_prep). This is followed by computing
731	! coefficients for the vertically implicit part of the
732	! small timestep (call to calc_coef_w).
733	!
734	! The small steps are taken
735	! in the named loop "small_steps:". In the small_steps loop, first
736	! the horizontal momentum (u and v) are advanced (call to advance_uv),
737	! next mu and theta are advanced (call to advance_mu_t) followed by
738	! advancing w and the geopotential (call to advance_w). Diagnostic
739	! values for pressure and inverse density are updated at the end of
740	! each small_step.
741	!
742	! The small-step section ends with the change of the perturbation variables
743	! back to full variables (call to small_step_finish).
744	!</pre>
745	!</DESCRIPTION>
746
747	BENCH_START(small_step_prep_tim)
748	!$OMP PARALLEL DO &
749	!$OMP PRIVATE ( ij )
750	DO ij = 1 , grid%num_tiles
751
752	! Calculate coefficients for the vertically implicit acoustic/gravity wave
753	! integration. We only need calculate these for the first pass through -
754	! the predictor step. They are reused as is for the corrector step.
755	! For third-order RK, we need to recompute these after the first
756	! predictor because we may have changed the small timestep -> grid%dts.
757
758	CALL wrf_debug ( 200 , ' call small_step_prep ' )
759
760	CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2, &
761	grid%t_1,grid%t_2,grid%ph_1,grid%ph_2, &
762	grid%mub, grid%mu_1, grid%mu_2, &
763	grid%muu, muus, grid%muv, muvs, &
764	grid%mut, grid%muts, grid%mudf, &
765	grid%u_save, grid%v_save, w_save, &
766	grid%t_save, ph_save, mu_save, &
767	grid%ww, ww1, &
768	grid%dnw, c2a, grid%pb, grid%p, grid%alt, &
769	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
770	grid%msfvy, grid%msftx,grid%msfty, &
771	grid%rdx, grid%rdy, rk_step, &
772	ids, ide, jds, jde, kds, kde, &
773	ims, ime, jms, jme, kms, kme, &
774	grid%i_start(ij), grid%i_end(ij), &
775	grid%j_start(ij), grid%j_end(ij), &
776	k_start , k_end )
777
778	CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
779	grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
780	grid%mu_2, grid%muts, grid%znu, t0, &
781	grid%rdnw, grid%dnw, grid%smdiv, &
782	config_flags%non_hydrostatic, 0, &
783	ids, ide, jds, jde, kds, kde, &
784	ims, ime, jms, jme, kms, kme, &
785	grid%i_start(ij), grid%i_end(ij), &
786	grid%j_start(ij), grid%j_end(ij), &
787	k_start , k_end )
788
789	IF (config_flags%non_hydrostatic) THEN
790	CALL calc_coef_w( a,alpha,gamma, &
791	grid%mut, cqw, &
792	grid%rdn, grid%rdnw, c2a, &
793	dts_rk, g, grid%epssm, &
794	config_flags%top_lid, &
795	ids, ide, jds, jde, kds, kde, &
796	ims, ime, jms, jme, kms, kme, &
797	grid%i_start(ij), grid%i_end(ij), &
798	grid%j_start(ij), grid%j_end(ij), &
799	k_start , k_end )
800	ENDIF
801
802	ENDDO
803	!$OMP END PARALLEL DO
804	BENCH_END(small_step_prep_tim)
805
806	#ifdef DM_PARALLEL
807	!-----------------------------------------------------------------------
808	! Stencils for patch communications (WCS, 29 June 2001)
809	! Note: the small size of this halo exchange reflects the
810	! fact that we are carrying the uncoupled variables
811	! as state variables in the mass coordinate model, as
812	! opposed to the coupled variables as in the height
813	! coordinate model.
814	!
815	! * * * * *
816	! * * * * * * * * *
817	! * + * * + * * * + * *
818	! * * * * * * * * *
819	! * * * * *
820	!
821	! 3D variables - note staggering! ph_2(Z), u_save(X), v_save(Y)
822	!
823	! ph_2 x
824	! al x
825	! p x
826	! t_1 x
827	! t_save x
828	! u_save x
829	! v_save x
830	!
831	! the following are 2D (xy) variables
832	!
833	! mu_1 x
834	! mu_2 x
835	! mudf x
836	! php x
837	! alt x
838	! pb x
839	!--------------------------------------------------------------
840	# include "HALO_EM_B.inc"
841	# include "PERIOD_BDY_EM_B.inc"
842	#endif
843
844	BENCH_START(set_phys_bc2_tim)
845	!$OMP PARALLEL DO &
846	!$OMP PRIVATE ( ij )
847
848	DO ij = 1 , grid%num_tiles
849
850	CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags, &
851	ids, ide, jds, jde, kds, kde, &
852	ims, ime, jms, jme, kms, kme, &
853	ips, ipe, jps, jpe, kps, kpe, &
854	grid%i_start(ij), grid%i_end(ij), &
855	grid%j_start(ij), grid%j_end(ij), &
856	k_start , k_end )
857
858	CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags, &
859	ids, ide, jds, jde, kds, kde, &
860	ims, ime, jms, jme, kms, kme, &
861	ips, ipe, jps, jpe, kps, kpe, &
862	grid%i_start(ij), grid%i_end(ij), &
863	grid%j_start(ij), grid%j_end(ij), &
864	k_start , k_end )
865
866	CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
867	ids, ide, jds, jde, kds, kde, &
868	ims, ime, jms, jme, kms, kme, &
869	ips, ipe, jps, jpe, kps, kpe, &
870	grid%i_start(ij), grid%i_end(ij), &
871	grid%j_start(ij), grid%j_end(ij), &
872	k_start , k_end )
873
874	CALL set_physical_bc3d( grid%al, 'p', config_flags, &
875	ids, ide, jds, jde, kds, kde, &
876	ims, ime, jms, jme, kms, kme, &
877	ips, ipe, jps, jpe, kps, kpe, &
878	grid%i_start(ij), grid%i_end(ij), &
879	grid%j_start(ij), grid%j_end(ij), &
880	k_start , k_end )
881
882	CALL set_physical_bc3d( grid%p, 'p', config_flags, &
883	ids, ide, jds, jde, kds, kde, &
884	ims, ime, jms, jme, kms, kme, &
885	ips, ipe, jps, jpe, kps, kpe, &
886	grid%i_start(ij), grid%i_end(ij), &
887	grid%j_start(ij), grid%j_end(ij), &
888	k_start , k_end )
889
890	CALL set_physical_bc3d( grid%t_1, 'p', config_flags, &
891	ids, ide, jds, jde, kds, kde, &
892	ims, ime, jms, jme, kms, kme, &
893	ips, ipe, jps, jpe, kps, kpe, &
894	grid%i_start(ij), grid%i_end(ij), &
895	grid%j_start(ij), grid%j_end(ij), &
896	k_start , k_end )
897
898	CALL set_physical_bc3d( grid%t_save, 't', config_flags, &
899	ids, ide, jds, jde, kds, kde, &
900	ims, ime, jms, jme, kms, kme, &
901	ips, ipe, jps, jpe, kps, kpe, &
902	grid%i_start(ij), grid%i_end(ij), &
903	grid%j_start(ij), grid%j_end(ij), &
904	k_start , k_end )
905
906	CALL set_physical_bc2d( grid%mu_1, 't', config_flags, &
907	ids, ide, jds, jde, &
908	ims, ime, jms, jme, &
909	ips, ipe, jps, jpe, &
910	grid%i_start(ij), grid%i_end(ij), &
911	grid%j_start(ij), grid%j_end(ij) )
912
913	CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
914	ids, ide, jds, jde, &
915	ims, ime, jms, jme, &
916	ips, ipe, jps, jpe, &
917	grid%i_start(ij), grid%i_end(ij), &
918	grid%j_start(ij), grid%j_end(ij) )
919
920	CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
921	ids, ide, jds, jde, &
922	ims, ime, jms, jme, &
923	ips, ipe, jps, jpe, &
924	grid%i_start(ij), grid%i_end(ij), &
925	grid%j_start(ij), grid%j_end(ij) )
926
927	END DO
928	!$OMP END PARALLEL DO
929	BENCH_END(set_phys_bc2_tim)
930	small_steps : DO iteration = 1 , number_of_small_timesteps
931
932	! Boundary condition time (or communication time).
933	#ifdef DM_PARALLEL
934	# include "PERIOD_BDY_EM_B.inc"
935	#endif
936
937	!$OMP PARALLEL DO &
938	!$OMP PRIVATE ( ij )
939
940	DO ij = 1 , grid%num_tiles
941
942	BENCH_START(advance_uv_tim)
943	CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend, &
944	grid%p, grid%pb, &
945	grid%ph_2, grid%php, grid%alt, grid%al, &
946	grid%mu_2, &
947	grid%muu, cqu, grid%muv, cqv, grid%mudf, &
948	grid%msfux, grid%msfuy, grid%msfvx, &
949	grid%msfvx_inv, grid%msfvy, &
950	grid%rdx, grid%rdy, dts_rk, &
951	grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp, &
952	grid%emdiv, &
953	grid%rdnw, config_flags,grid%spec_zone, &
954	config_flags%non_hydrostatic, config_flags%top_lid, &
955	ids, ide, jds, jde, kds, kde, &
956	ims, ime, jms, jme, kms, kme, &
957	grid%i_start(ij), grid%i_end(ij), &
958	grid%j_start(ij), grid%j_end(ij), &
959	k_start , k_end )
960	BENCH_END(advance_uv_tim)
961
962	END DO
963	!$OMP END PARALLEL DO
964
965	!-----------------------------------------------------------
966	! acoustic integration polar filter for smallstep u, v
967	!-----------------------------------------------------------
968
969	IF (config_flags%polar) THEN
970
971	CALL pxft ( grid=grid &
972	,lineno=__LINE__ &
973	,flag_uv = 1 &
974	,flag_rurv = 0 &
975	,flag_wph = 0 &
976	,flag_ww = 0 &
977	,flag_t = 0 &
978	,flag_mu = 0 &
979	,flag_mut = 0 &
980	,flag_moist = 0 &
981	,flag_chem = 0 &
982	,flag_scalar = 0 &
983	,positive_definite = .FALSE. &
984	,moist=moist,chem=chem,scalar=scalar &
985	,fft_filter_lat = config_flags%fft_filter_lat &
986	,dclat = dclat &
987	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
988	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
989	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
990	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
991	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
992
993	END IF
994
995	!-----------------------------------------------------------
996	! end acoustic integration polar filter for smallstep u, v
997	!-----------------------------------------------------------
998
999	!$OMP PARALLEL DO &
1000	!$OMP PRIVATE ( ij )
1001	DO ij = 1 , grid%num_tiles
1002
1003	BENCH_START(spec_bdy_uv_tim)
1004	IF( config_flags%specified .or. config_flags%nested ) THEN
1005	CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk, &
1006	'u' , config_flags, &
1007	grid%spec_zone, &
1008	ids,ide, jds,jde, kds,kde, & ! domain dims
1009	ims,ime, jms,jme, kms,kme, & ! memory dims
1010	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1011	grid%i_start(ij), grid%i_end(ij), &
1012	grid%j_start(ij), grid%j_end(ij), &
1013	k_start , k_end )
1014
1015	CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk, &
1016	'v' , config_flags, &
1017	grid%spec_zone, &
1018	ids,ide, jds,jde, kds,kde, & ! domain dims
1019	ims,ime, jms,jme, kms,kme, & ! memory dims
1020	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1021	grid%i_start(ij), grid%i_end(ij), &
1022	grid%j_start(ij), grid%j_end(ij), &
1023	k_start , k_end )
1024
1025	ENDIF
1026	BENCH_END(spec_bdy_uv_tim)
1027
1028	END DO
1029	!$OMP END PARALLEL DO
1030
1031	#ifdef DM_PARALLEL
1032	!
1033	! Stencils for patch communications (WCS, 29 June 2001)
1034	!
1035	! * *
1036	! * + * * + * +
1037	! * *
1038	!
1039	! u_2 x
1040	! v_2 x
1041	!
1042	# include "HALO_EM_C.inc"
1043	#endif
1044
1045	!$OMP PARALLEL DO &
1046	!$OMP PRIVATE ( ij )
1047	DO ij = 1 , grid%num_tiles
1048
1049	! advance the mass in the column, theta, and calculate ww
1050
1051	BENCH_START(advance_mu_t_tim)
1052	CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
1053	grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv, &
1054	grid%mudf, grid%ru_m, grid%rv_m, grid%ww_m, &
1055	grid%t_2, grid%t_save, t_2save, t_tend, &
1056	mu_tend, &
1057	grid%rdx, grid%rdy, dts_rk, grid%epssm, &
1058	grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1059	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1060	grid%msfvy, grid%msftx,grid%msfty, &
1061	iteration, config_flags, &
1062	ids, ide, jds, jde, kds, kde, &
1063	ims, ime, jms, jme, kms, kme, &
1064	grid%i_start(ij), grid%i_end(ij), &
1065	grid%j_start(ij), grid%j_end(ij), &
1066	k_start , k_end )
1067	BENCH_END(advance_mu_t_tim)
1068	ENDDO
1069	!$OMP END PARALLEL DO
1070
1071	!-----------------------------------------------------------
1072	! acoustic integration polar filter for smallstep mu, t
1073	!-----------------------------------------------------------
1074
1075	IF ( (config_flags%polar) ) THEN
1076
1077	CALL pxft ( grid=grid &
1078	,lineno=__LINE__ &
1079	,flag_uv = 0 &
1080	,flag_rurv = 0 &
1081	,flag_wph = 0 &
1082	,flag_ww = 0 &
1083	,flag_t = 1 &
1084	,flag_mu = 1 &
1085	,flag_mut = 0 &
1086	,flag_moist = 0 &
1087	,flag_chem = 0 &
1088	,flag_scalar = 0 &
1089	,positive_definite = .FALSE. &
1090	,moist=moist,chem=chem,scalar=scalar &
1091	,fft_filter_lat = config_flags%fft_filter_lat &
1092	,dclat = dclat &
1093	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1094	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1095	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1096	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1097	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1098
1099	grid%muts = grid%mut + grid%mu_2 ! reset muts using filtered mu_2
1100
1101	END IF
1102
1103	!-----------------------------------------------------------
1104	! end acoustic integration polar filter for smallstep mu, t
1105	!-----------------------------------------------------------
1106
1107	BENCH_START(spec_bdy_t_tim)
1108
1109	!$OMP PARALLEL DO &
1110	!$OMP PRIVATE ( ij )
1111	DO ij = 1 , grid%num_tiles
1112
1113	IF( config_flags%specified .or. config_flags%nested ) THEN
1114
1115	CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk, &
1116	't' , config_flags, &
1117	grid%spec_zone, &
1118	ids,ide, jds,jde, kds,kde, &
1119	ims,ime, jms,jme, kms,kme, &
1120	ips,ipe, jps,jpe, kps,kpe, &
1121	grid%i_start(ij), grid%i_end(ij),&
1122	grid%j_start(ij), grid%j_end(ij),&
1123	k_start , k_end )
1124
1125	CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk, &
1126	'm' , config_flags, &
1127	grid%spec_zone, &
1128	ids,ide, jds,jde, 1 ,1 , &
1129	ims,ime, jms,jme, 1 ,1 , &
1130	ips,ipe, jps,jpe, 1 ,1 , &
1131	grid%i_start(ij), grid%i_end(ij),&
1132	grid%j_start(ij), grid%j_end(ij),&
1133	1 , 1 )
1134
1135	CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk, &
1136	'm' , config_flags, &
1137	grid%spec_zone, &
1138	ids,ide, jds,jde, 1 ,1 , & ! domain dims
1139	ims,ime, jms,jme, 1 ,1 , & ! memory dims
1140	ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
1141	grid%i_start(ij), grid%i_end(ij), &
1142	grid%j_start(ij), grid%j_end(ij), &
1143	1 , 1 )
1144	ENDIF
1145	BENCH_END(spec_bdy_t_tim)
1146
1147	! small (acoustic) step for the vertical momentum,
1148	! density and coupled potential temperature.
1149
1150
1151	BENCH_START(advance_w_tim)
1152	IF ( config_flags%non_hydrostatic ) THEN
1153	CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save, &
1154	grid%u_2, grid%v_2, &
1155	grid%mu_2, grid%mut, muave, grid%muts, &
1156	t_2save, grid%t_2, grid%t_save, &
1157	grid%ph_2, ph_save, grid%phb, ph_tend, &
1158	grid%ht, c2a, cqw, grid%alt, grid%alb, &
1159	a, alpha, gamma, &
1160	grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
1161	grid%dnw, grid%fnm, grid%fnp, grid%rdnw, &
1162	grid%rdn, grid%cf1, grid%cf2, grid%cf3, &
1163	grid%msftx, grid%msfty, &
1164	config_flags, config_flags%top_lid, &
1165	ids,ide, jds,jde, kds,kde, &
1166	ims,ime, jms,jme, kms,kme, &
1167	grid%i_start(ij), grid%i_end(ij), &
1168	grid%j_start(ij), grid%j_end(ij), &
1169	k_start , k_end )
1170	ENDIF
1171	BENCH_END(advance_w_tim)
1172
1173	ENDDO
1174	!$OMP END PARALLEL DO
1175
1176	!-----------------------------------------------------------
1177	! acoustic integration polar filter for smallstep w, geopotential
1178	!-----------------------------------------------------------
1179
1180	IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
1181
1182	CALL pxft ( grid=grid &
1183	,lineno=__LINE__ &
1184	,flag_uv = 0 &
1185	,flag_rurv = 0 &
1186	,flag_wph = 1 &
1187	,flag_ww = 0 &
1188	,flag_t = 0 &
1189	,flag_mu = 0 &
1190	,flag_mut = 0 &
1191	,flag_moist = 0 &
1192	,flag_chem = 0 &
1193	,flag_scalar = 0 &
1194	,positive_definite = .FALSE. &
1195	,moist=moist,chem=chem,scalar=scalar &
1196	,fft_filter_lat = config_flags%fft_filter_lat &
1197	,dclat = dclat &
1198	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1199	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1200	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1201	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1202	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1203
1204	END IF
1205
1206	!-----------------------------------------------------------
1207	! end acoustic integration polar filter for smallstep w, geopotential
1208	!-----------------------------------------------------------
1209
1210	!$OMP PARALLEL DO &
1211	!$OMP PRIVATE ( ij )
1212	DO ij = 1 , grid%num_tiles
1213
1214	BENCH_START(sumflux_tim)
1215	CALL sumflux ( grid%u_2, grid%v_2, grid%ww, &
1216	grid%u_save, grid%v_save, ww1, &
1217	grid%muu, grid%muv, &
1218	grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm, &
1219	grid%msfux, grid% msfuy, grid%msfvx, &
1220	grid%msfvx_inv, grid%msfvy, &
1221	iteration, number_of_small_timesteps, &
1222	ids, ide, jds, jde, kds, kde, &
1223	ims, ime, jms, jme, kms, kme, &
1224	grid%i_start(ij), grid%i_end(ij), &
1225	grid%j_start(ij), grid%j_end(ij), &
1226	k_start , k_end )
1227	BENCH_END(sumflux_tim)
1228
1229	IF( config_flags%specified .or. config_flags%nested ) THEN
1230
1231	BENCH_START(spec_bdynhyd_tim)
1232	IF (config_flags%non_hydrostatic) THEN
1233	CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend, &
1234	mu_tend, grid%muts, dts_rk, &
1235	'h' , config_flags, &
1236	grid%spec_zone, &
1237	ids,ide, jds,jde, kds,kde, &
1238	ims,ime, jms,jme, kms,kme, &
1239	ips,ipe, jps,jpe, kps,kpe, &
1240	grid%i_start(ij), grid%i_end(ij),&
1241	grid%j_start(ij), grid%j_end(ij),&
1242	k_start , k_end )
1243	IF( config_flags%specified ) THEN
1244	CALL zero_grad_bdy ( grid%w_2, &
1245	'w' , config_flags, &
1246	grid%spec_zone, &
1247	ids,ide, jds,jde, kds,kde, &
1248	ims,ime, jms,jme, kms,kme, &
1249	ips,ipe, jps,jpe, kps,kpe, &
1250	grid%i_start(ij), grid%i_end(ij), &
1251	grid%j_start(ij), grid%j_end(ij), &
1252	k_start , k_end )
1253	ELSE
1254	CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk, &
1255	'h' , config_flags, &
1256	grid%spec_zone, &
1257	ids,ide, jds,jde, kds,kde, &
1258	ims,ime, jms,jme, kms,kme, &
1259	ips,ipe, jps,jpe, kps,kpe, &
1260	grid%i_start(ij), grid%i_end(ij),&
1261	grid%j_start(ij), grid%j_end(ij),&
1262	k_start , k_end )
1263	ENDIF
1264	ENDIF
1265	BENCH_END(spec_bdynhyd_tim)
1266	ENDIF
1267
1268	BENCH_START(cald_p_rho_tim)
1269	CALL calc_p_rho( grid%al, grid%p, grid%ph_2, &
1270	grid%alt, grid%t_2, grid%t_save, c2a, pm1, &
1271	grid%mu_2, grid%muts, grid%znu, t0, &
1272	grid%rdnw, grid%dnw, grid%smdiv, &
1273	config_flags%non_hydrostatic, iteration, &
1274	ids, ide, jds, jde, kds, kde, &
1275	ims, ime, jms, jme, kms, kme, &
1276	grid%i_start(ij), grid%i_end(ij), &
1277	grid%j_start(ij), grid%j_end(ij), &
1278	k_start , k_end )
1279	BENCH_END(cald_p_rho_tim)
1280
1281	ENDDO
1282	!$OMP END PARALLEL DO
1283
1284	#ifdef DM_PARALLEL
1285	!
1286	! Stencils for patch communications (WCS, 29 June 2001)
1287	!
1288	! * *
1289	! * + * * + * +
1290	! * *
1291	!
1292	! ph_2 x
1293	! al x
1294	! p x
1295	!
1296	! 2D variables (x,y)
1297	!
1298	! mu_2 x
1299	! muts x
1300	! mudf x
1301
1302	# include "HALO_EM_C2.inc"
1303	# include "PERIOD_BDY_EM_B3.inc"
1304	#endif
1305
1306	BENCH_START(phys_bc_tim)
1307	!$OMP PARALLEL DO &
1308	!$OMP PRIVATE ( ij )
1309	DO ij = 1 , grid%num_tiles
1310
1311	! boundary condition set for next small timestep
1312
1313	CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, &
1314	ids, ide, jds, jde, kds, kde, &
1315	ims, ime, jms, jme, kms, kme, &
1316	ips, ipe, jps, jpe, kps, kpe, &
1317	grid%i_start(ij), grid%i_end(ij), &
1318	grid%j_start(ij), grid%j_end(ij), &
1319	k_start , k_end )
1320
1321	CALL set_physical_bc3d( grid%al, 'p', config_flags, &
1322	ids, ide, jds, jde, kds, kde, &
1323	ims, ime, jms, jme, kms, kme, &
1324	ips, ipe, jps, jpe, kps, kpe, &
1325	grid%i_start(ij), grid%i_end(ij), &
1326	grid%j_start(ij), grid%j_end(ij), &
1327	k_start , k_end )
1328
1329	CALL set_physical_bc3d( grid%p, 'p', config_flags, &
1330	ids, ide, jds, jde, kds, kde, &
1331	ims, ime, jms, jme, kms, kme, &
1332	ips, ipe, jps, jpe, kps, kpe, &
1333	grid%i_start(ij), grid%i_end(ij), &
1334	grid%j_start(ij), grid%j_end(ij), &
1335	k_start , k_end )
1336
1337	CALL set_physical_bc2d( grid%muts, 't', config_flags, &
1338	ids, ide, jds, jde, &
1339	ims, ime, jms, jme, &
1340	ips, ipe, jps, jpe, &
1341	grid%i_start(ij), grid%i_end(ij), &
1342	grid%j_start(ij), grid%j_end(ij) )
1343
1344	CALL set_physical_bc2d( grid%mu_2, 't', config_flags, &
1345	ids, ide, jds, jde, &
1346	ims, ime, jms, jme, &
1347	ips, ipe, jps, jpe, &
1348	grid%i_start(ij), grid%i_end(ij), &
1349	grid%j_start(ij), grid%j_end(ij) )
1350
1351	CALL set_physical_bc2d( grid%mudf, 't', config_flags, &
1352	ids, ide, jds, jde, &
1353	ims, ime, jms, jme, &
1354	ips, ipe, jps, jpe, &
1355	grid%i_start(ij), grid%i_end(ij), &
1356	grid%j_start(ij), grid%j_end(ij) )
1357
1358	END DO
1359	!$OMP END PARALLEL DO
1360	BENCH_END(phys_bc_tim)
1361
1362	END DO small_steps
1363
1364	!$OMP PARALLEL DO &
1365	!$OMP PRIVATE ( ij )
1366	DO ij = 1 , grid%num_tiles
1367
1368	CALL wrf_debug ( 200 , ' call rk_small_finish' )
1369
1370	! change time-perturbation variables back to
1371	! full perturbation variables.
1372	! first get updated mu at u and v points
1373
1374	BENCH_START(calc_mu_uv_tim)
1375	CALL calc_mu_uv_1 ( config_flags, &
1376	grid%muts, muus, muvs, &
1377	ids, ide, jds, jde, kds, kde, &
1378	ims, ime, jms, jme, kms, kme, &
1379	grid%i_start(ij), grid%i_end(ij), &
1380	grid%j_start(ij), grid%j_end(ij), &
1381	k_start , k_end )
1382	BENCH_END(calc_mu_uv_tim)
1383	BENCH_START(small_step_finish_tim)
1384	CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1, &
1385	grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1, &
1386	grid%mu_2, grid%mu_1, &
1387	grid%mut, grid%muts, grid%muu, muus, grid%muv, muvs, &
1388	grid%u_save, grid%v_save, w_save, &
1389	grid%t_save, ph_save, mu_save, &
1390	grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
1391	grid%h_diabatic, &
1392	number_of_small_timesteps,dts_rk, &
1393	rk_step, rk_order, &
1394	ids, ide, jds, jde, kds, kde, &
1395	ims, ime, jms, jme, kms, kme, &
1396	grid%i_start(ij), grid%i_end(ij), &
1397	grid%j_start(ij), grid%j_end(ij), &
1398	k_start , k_end )
1399	! call to set ru_m, rv_m and ww_m b.c's for PD advection
1400
1401	IF (rk_step == rk_order) THEN
1402
1403	CALL set_physical_bc3d( grid%ru_m, 'u', config_flags, &
1404	ids, ide, jds, jde, kds, kde, &
1405	ims, ime, jms, jme, kms, kme, &
1406	ips, ipe, jps, jpe, kps, kpe, &
1407	grid%i_start(ij), grid%i_end(ij), &
1408	grid%j_start(ij), grid%j_end(ij), &
1409	k_start , k_end )
1410
1411	CALL set_physical_bc3d( grid%rv_m, 'v', config_flags, &
1412	ids, ide, jds, jde, kds, kde, &
1413	ims, ime, jms, jme, kms, kme, &
1414	ips, ipe, jps, jpe, kps, kpe, &
1415	grid%i_start(ij), grid%i_end(ij), &
1416	grid%j_start(ij), grid%j_end(ij), &
1417	k_start , k_end )
1418
1419	CALL set_physical_bc3d( grid%ww_m, 'w', config_flags, &
1420	ids, ide, jds, jde, kds, kde, &
1421	ims, ime, jms, jme, kms, kme, &
1422	ips, ipe, jps, jpe, kps, kpe, &
1423	grid%i_start(ij), grid%i_end(ij), &
1424	grid%j_start(ij), grid%j_end(ij), &
1425	k_start , k_end )
1426
1427	CALL set_physical_bc2d( grid%mut, 't', config_flags, &
1428	ids, ide, jds, jde, &
1429	ims, ime, jms, jme, &
1430	ips, ipe, jps, jpe, &
1431	grid%i_start(ij), grid%i_end(ij), &
1432	grid%j_start(ij), grid%j_end(ij) )
1433
1434	END IF
1435
1436	BENCH_END(small_step_finish_tim)
1437
1438	END DO
1439	!$OMP END PARALLEL DO
1440
1441	!-----------------------------------------------------------
1442	! polar filter for full dynamics variables and time-averaged mass fluxes
1443	!-----------------------------------------------------------
1444
1445	IF (config_flags%polar) THEN
1446
1447	CALL pxft ( grid=grid &
1448	,lineno=__LINE__ &
1449	,flag_uv = 1 &
1450	,flag_rurv = 1 &
1451	,flag_wph = 1 &
1452	,flag_ww = 1 &
1453	,flag_t = 1 &
1454	,flag_mu = 1 &
1455	,flag_mut = 1 &
1456	,flag_moist = 0 &
1457	,flag_chem = 0 &
1458	,flag_scalar = 0 &
1459	,positive_definite = .FALSE. &
1460	,moist=moist,chem=chem,scalar=scalar &
1461	,fft_filter_lat = config_flags%fft_filter_lat &
1462	,dclat = dclat &
1463	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
1464	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
1465	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
1466	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
1467	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
1468
1469	END IF
1470
1471	!-----------------------------------------------------------
1472	! end polar filter for full dynamics variables and time-averaged mass fluxes
1473	!-----------------------------------------------------------
1474
1475	!-----------------------------------------------------------------------
1476	! add in physics tendency first if positive definite advection is used.
1477	! pd advection applies advective flux limiter on last runge-kutta step
1478	!-----------------------------------------------------------------------
1479	! first moisture
1480
1481	IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
1482
1483	!$OMP PARALLEL DO &
1484	!$OMP PRIVATE ( ij )
1485	DO ij = 1 , grid%num_tiles
1486	CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1487	DO im = PARAM_FIRST_SCALAR, num_3d_m
1488	CALL rk_update_scalar_pd( im, im, &
1489	moist_old(ims,kms,jms,im), &
1490	moist_tend(ims,kms,jms,im), &
1491	grid%mu_1, grid%mu_1, grid%mub, &
1492	rk_step, dt_rk, grid%spec_zone, &
1493	config_flags, &
1494	ids, ide, jds, jde, kds, kde, &
1495	ims, ime, jms, jme, kms, kme, &
1496	grid%i_start(ij), grid%i_end(ij), &
1497	grid%j_start(ij), grid%j_end(ij), &
1498	k_start , k_end )
1499	ENDDO
1500	END DO
1501	!$OMP END PARALLEL DO
1502
1503	!---------------------- positive definite bc call
1504	#ifdef DM_PARALLEL
1505	IF (config_flags%pd_moist) THEN
1506	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1507	# include "HALO_EM_MOIST_OLD_E_5.inc"
1508	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1509	# include "HALO_EM_MOIST_OLD_E_7.inc"
1510	ELSE
1511	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1512	CALL wrf_error_fatal(TRIM(wrf_err_message))
1513	ENDIF
1514	ENDIF
1515	#endif
1516
1517	#ifdef DM_PARALLEL
1518	# include "PERIOD_BDY_EM_MOIST_OLD.inc"
1519	#endif
1520
1521	!$OMP PARALLEL DO &
1522	!$OMP PRIVATE ( ij )
1523	DO ij = 1 , grid%num_tiles
1524	IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1525	DO im = PARAM_FIRST_SCALAR , num_3d_m
1526	CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags, &
1527	ids, ide, jds, jde, kds, kde, &
1528	ims, ime, jms, jme, kms, kme, &
1529	ips, ipe, jps, jpe, kps, kpe, &
1530	grid%i_start(ij), grid%i_end(ij), &
1531	grid%j_start(ij), grid%j_end(ij), &
1532	k_start , k_end )
1533	END DO
1534	ENDIF
1535	END DO
1536	!$OMP END PARALLEL DO
1537
1538	END IF ! end if for pd_moist
1539
1540	! scalars
1541
1542	IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
1543
1544	!$OMP PARALLEL DO &
1545	!$OMP PRIVATE ( ij )
1546	DO ij = 1 , grid%num_tiles
1547	CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1548	DO im = PARAM_FIRST_SCALAR, num_3d_s
1549	CALL rk_update_scalar_pd( im, im, &
1550	scalar_old(ims,kms,jms,im), &
1551	scalar_tend(ims,kms,jms,im), &
1552	grid%mu_1, grid%mu_1, grid%mub, &
1553	rk_step, dt_rk, grid%spec_zone, &
1554	config_flags, &
1555	ids, ide, jds, jde, kds, kde, &
1556	ims, ime, jms, jme, kms, kme, &
1557	grid%i_start(ij), grid%i_end(ij), &
1558	grid%j_start(ij), grid%j_end(ij), &
1559	k_start , k_end )
1560	ENDDO
1561	ENDDO
1562	!$OMP END PARALLEL DO
1563
1564	!---------------------- positive definite bc call
1565	#ifdef DM_PARALLEL
1566	IF (config_flags%pd_scalar) THEN
1567	#ifndef RSL
1568	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1569	# include "HALO_EM_SCALAR_OLD_E_5.inc"
1570	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1571	# include "HALO_EM_SCALAR_OLD_E_7.inc"
1572	ELSE
1573	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1574	CALL wrf_error_fatal(TRIM(wrf_err_message))
1575	ENDIF
1576	#else
1577	WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
1578	CALL wrf_error_fatal(TRIM(wrf_err_message))
1579	#endif
1580	endif
1581	#endif
1582
1583	#ifdef DM_PARALLEL
1584	# include "PERIOD_BDY_EM_SCALAR_OLD.inc"
1585	#endif
1586	!$OMP PARALLEL DO &
1587	!$OMP PRIVATE ( ij )
1588
1589	DO ij = 1 , grid%num_tiles
1590	IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1591	DO im = PARAM_FIRST_SCALAR , num_3d_s
1592	CALL set_physical_bc3d( scalar_old(ims,kms,jms,im), 'p', config_flags, &
1593	ids, ide, jds, jde, kds, kde, &
1594	ims, ime, jms, jme, kms, kme, &
1595	ips, ipe, jps, jpe, kps, kpe, &
1596	grid%i_start(ij), grid%i_end(ij), &
1597	grid%j_start(ij), grid%j_end(ij), &
1598	k_start , k_end )
1599	END DO
1600	ENDIF
1601	END DO
1602	!$OMP END PARALLEL DO
1603
1604	END IF ! end if for pd_scalar
1605
1606	! chem
1607
1608	IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
1609
1610	!$OMP PARALLEL DO &
1611	!$OMP PRIVATE ( ij )
1612	DO ij = 1 , grid%num_tiles
1613	CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1614	DO im = PARAM_FIRST_SCALAR, num_3d_c
1615	CALL rk_update_scalar_pd( im, im, &
1616	chem_old(ims,kms,jms,im), &
1617	chem_tend(ims,kms,jms,im), &
1618	grid%mu_1, grid%mu_1, grid%mub, &
1619	rk_step, dt_rk, grid%spec_zone, &
1620	config_flags, &
1621	ids, ide, jds, jde, kds, kde, &
1622	ims, ime, jms, jme, kms, kme, &
1623	grid%i_start(ij), grid%i_end(ij), &
1624	grid%j_start(ij), grid%j_end(ij), &
1625	k_start , k_end )
1626	ENDDO
1627	END DO
1628	!$OMP END PARALLEL DO
1629
1630	!---------------------- positive definite bc call
1631	#ifdef DM_PARALLEL
1632	IF (config_flags%pd_chem) THEN
1633	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1634	# include "HALO_EM_CHEM_OLD_E_5.inc"
1635	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1636	# include "HALO_EM_CHEM_OLD_E_7.inc"
1637	ELSE
1638	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1639	CALL wrf_error_fatal(TRIM(wrf_err_message))
1640	ENDIF
1641	ENDIF
1642	#endif
1643
1644	#ifdef DM_PARALLEL
1645	# include "PERIOD_BDY_EM_CHEM_OLD.inc"
1646	#endif
1647
1648	!$OMP PARALLEL DO &
1649	!$OMP PRIVATE ( ij )
1650	DO ij = 1 , grid%num_tiles
1651	IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
1652	DO im = PARAM_FIRST_SCALAR , num_3d_c
1653	CALL set_physical_bc3d( chem_old(ims,kms,jms,im), 'p', config_flags, &
1654	ids, ide, jds, jde, kds, kde, &
1655	ims, ime, jms, jme, kms, kme, &
1656	ips, ipe, jps, jpe, kps, kpe, &
1657	grid%i_start(ij), grid%i_end(ij), &
1658	grid%j_start(ij), grid%j_end(ij), &
1659	k_start , k_end )
1660	END DO
1661	ENDIF
1662	END DO
1663	!$OMP END PARALLEL DO
1664
1665	ENDIF ! end if for pd_chem
1666
1667	! tke
1668
1669	IF (config_flags%pd_tke .and. (rk_step == rk_order) &
1670	.and. (config_flags%km_opt .eq. 2) ) THEN
1671
1672	!$OMP PARALLEL DO &
1673	!$OMP PRIVATE ( ij )
1674	DO ij = 1 , grid%num_tiles
1675	CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
1676	CALL rk_update_scalar_pd( 1, 1, &
1677	grid%tke_1, &
1678	tke_tend(ims,kms,jms), &
1679	grid%mu_1, grid%mu_1, grid%mub, &
1680	rk_step, dt_rk, grid%spec_zone, &
1681	config_flags, &
1682	ids, ide, jds, jde, kds, kde, &
1683	ims, ime, jms, jme, kms, kme, &
1684	grid%i_start(ij), grid%i_end(ij), &
1685	grid%j_start(ij), grid%j_end(ij), &
1686	k_start , k_end )
1687	ENDDO
1688	!$OMP END PARALLEL DO
1689
1690	!---------------------- positive definite bc call
1691	#ifdef DM_PARALLEL
1692	IF (config_flags%pd_tke) THEN
1693	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
1694	# include "HALO_EM_TKE_OLD_E_5.inc"
1695	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
1696	# include "HALO_EM_TKE_OLD_E_7.inc"
1697	ELSE
1698	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
1699	CALL wrf_error_fatal(TRIM(wrf_err_message))
1700	ENDIF
1701	ENDIF
1702	#endif
1703
1704	#ifdef DM_PARALLEL
1705	# include "PERIOD_BDY_EM_TKE_OLD.inc"
1706	#endif
1707
1708	!$OMP PARALLEL DO &
1709	!$OMP PRIVATE ( ij )
1710	DO ij = 1 , grid%num_tiles
1711	CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
1712	ids, ide, jds, jde, kds, kde, &
1713	ims, ime, jms, jme, kms, kme, &
1714	ips, ipe, jps, jpe, kps, kpe, &
1715	grid%i_start(ij), grid%i_end(ij), &
1716	grid%j_start(ij), grid%j_end(ij), &
1717	k_start , k_end )
1718	END DO
1719	!$OMP END PARALLEL DO
1720
1721	!--- end of positive definite physics tendency update
1722
1723	END IF ! end if for pd_tke
1724
1725	#ifdef DM_PARALLEL
1726	!
1727	! Stencils for patch communications (WCS, 29 June 2001)
1728	!
1729	! * * * * *
1730	! * * * * *
1731	! * * + * *
1732	! * * * * *
1733	! * * * * *
1734	!
1735	! ru_m x
1736	! rv_m x
1737	! ww_m x
1738	! mut x
1739	!
1740	!--------------------------------------------------------------
1741
1742	# include "HALO_EM_D.inc"
1743	#endif
1744
1745	!<DESCRIPTION>
1746	!<pre>
1747	! (4) Still within the RK loop, the scalar variables are advanced.
1748	!
1749	! For the moist and chem variables, each one is advanced
1750	! individually, using named loops "moist_variable_loop:"
1751	! and "chem_variable_loop:". Each RK substep begins by
1752	! calculating the advective tendency, and, for the first RK step,
1753	! 3D mixing (calling rk_scalar_tend) followed by an update
1754	! of the scalar (calling rk_scalar_update).
1755	!</pre>
1756	!</DESCRIPTION>
1757
1758
1759	moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR ) THEN
1760
1761	moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
1762
1763	! adv_moist_cond is set in module_physics_init based on mp_physics choice
1764	! true except for Ferrier scheme
1765
1766	IF (grid%adv_moist_cond .or. im==p_qv ) THEN
1767
1768	!$OMP PARALLEL DO &
1769	!$OMP PRIVATE ( ij )
1770	moist_tile_loop_1: DO ij = 1 , grid%num_tiles
1771
1772	CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
1773
1774	BENCH_START(rk_scalar_tend_tim)
1775	CALL rk_scalar_tend ( im, im, config_flags, &
1776	rk_step, dt_rk, &
1777	grid%ru_m, grid%rv_m, grid%ww_m, &
1778	grid%mut, grid%mub, grid%mu_1, &
1779	grid%alt, &
1780	moist_old(ims,kms,jms,im), &
1781	moist(ims,kms,jms,im), &
1782	moist_tend(ims,kms,jms,im), &
1783	advect_tend,grid%rqvften, &
1784	grid%qv_base, .true., grid%fnm, grid%fnp, &
1785	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
1786	grid%msfvy, grid%msftx,grid%msfty, &
1787	grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
1788	grid%kvdif, grid%xkhh, &
1789	grid%diff_6th_opt, grid%diff_6th_factor, &
1790	config_flags%pd_moist, &
1791	ids, ide, jds, jde, kds, kde, &
1792	ims, ime, jms, jme, kms, kme, &
1793	grid%i_start(ij), grid%i_end(ij), &
1794	grid%j_start(ij), grid%j_end(ij), &
1795	k_start , k_end )
1796
1797	BENCH_END(rk_scalar_tend_tim)
1798
1799	BENCH_START(rlx_bdy_scalar_tim)
1800	IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
1801	IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
1802	CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), &
1803	moist(ims,kms,jms,im), grid%mut, &
1804	moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
1805	moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
1806	moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
1807	moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
1808	config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
1809	grid%dtbc, grid%fcx, grid%gcx, &
1810	config_flags, &
1811	ids,ide, jds,jde, kds,kde, & ! domain dims
1812	ims,ime, jms,jme, kms,kme, & ! memory dims
1813	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1814	grid%i_start(ij), grid%i_end(ij), &
1815	grid%j_start(ij), grid%j_end(ij), &
1816	k_start, k_end )
1817
1818	CALL spec_bdy_scalar ( moist_tend(ims,kms,jms,im), &
1819	moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
1820	moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
1821	moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
1822	moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
1823	config_flags%spec_bdy_width, grid%spec_zone, &
1824	config_flags, &
1825	ids,ide, jds,jde, kds,kde, & ! domain dims
1826	ims,ime, jms,jme, kms,kme, & ! memory dims
1827	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1828	grid%i_start(ij), grid%i_end(ij), &
1829	grid%j_start(ij), grid%j_end(ij), &
1830	k_start, k_end )
1831	ENDIF
1832	ENDIF
1833	BENCH_END(rlx_bdy_scalar_tim)
1834
1835	ENDDO moist_tile_loop_1
1836	!$OMP END PARALLEL DO
1837
1838	!$OMP PARALLEL DO &
1839	!$OMP PRIVATE ( ij )
1840	moist_tile_loop_2: DO ij = 1 , grid%num_tiles
1841
1842	CALL wrf_debug ( 200 , ' call rk_update_scalar' )
1843
1844	BENCH_START(update_scal_tim)
1845	CALL rk_update_scalar( im, im, &
1846	moist_old(ims,kms,jms,im), &
1847	moist(ims,kms,jms,im), &
1848	moist_tend(ims,kms,jms,im), &
1849	advect_tend, grid%msftx,grid%msfty, &
1850	grid%mu_1, grid%mu_2, grid%mub, &
1851	rk_step, dt_rk, grid%spec_zone, &
1852	config_flags, &
1853	ids, ide, jds, jde, kds, kde, &
1854	ims, ime, jms, jme, kms, kme, &
1855	grid%i_start(ij), grid%i_end(ij), &
1856	grid%j_start(ij), grid%j_end(ij), &
1857	k_start , k_end )
1858	BENCH_END(update_scal_tim)
1859
1860	BENCH_START(flow_depbdy_tim)
1861	IF( config_flags%specified ) THEN
1862	IF(im .ne. P_QV)THEN
1863	CALL flow_dep_bdy ( moist(ims,kms,jms,im), &
1864	grid%ru_m, grid%rv_m, config_flags, &
1865	grid%spec_zone, &
1866	ids,ide, jds,jde, kds,kde, &
1867	ims,ime, jms,jme, kms,kme, &
1868	ips,ipe, jps,jpe, kps,kpe, &
1869	grid%i_start(ij), grid%i_end(ij), &
1870	grid%j_start(ij), grid%j_end(ij), &
1871	k_start, k_end )
1872	ENDIF
1873	ENDIF
1874	BENCH_END(flow_depbdy_tim)
1875
1876	ENDDO moist_tile_loop_2
1877	!$OMP END PARALLEL DO
1878
1879	ENDIF !-- if (grid%adv_moist_cond .or. im==p_qv ) then
1880
1881	ENDDO moist_variable_loop
1882
1883	ENDIF moist_scalar_advance
1884
1885	BENCH_START(tke_adv_tim)
1886	TKE_advance: IF (config_flags%km_opt .eq. 2) then
1887	#ifdef DM_PARALLEL
1888	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
1889	# include "HALO_EM_TKE_ADVECT_3.inc"
1890	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
1891	# include "HALO_EM_TKE_ADVECT_5.inc"
1892	ELSE
1893	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
1894	CALL wrf_error_fatal(TRIM(wrf_err_message))
1895	ENDIF
1896	#endif
1897	!$OMP PARALLEL DO &
1898	!$OMP PRIVATE ( ij )
1899	tke_tile_loop_1: DO ij = 1 , grid%num_tiles
1900
1901	CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
1902	CALL rk_scalar_tend ( 1, 1, config_flags, &
1903	rk_step, dt_rk, &
1904	grid%ru_m, grid%rv_m, grid%ww_m, &
1905	grid%mut, grid%mub, grid%mu_1, &
1906	grid%alt, &
1907	grid%tke_1, &
1908	grid%tke_2, &
1909	tke_tend(ims,kms,jms), &
1910	advect_tend,grid%rqvften, &
1911	grid%qv_base, .false., grid%fnm, grid%fnp, &
1912	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1913	grid%msfvy, grid%msftx,grid%msfty, &
1914	grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
1915	grid%kvdif, grid%xkhh, &
1916	grid%diff_6th_opt, grid%diff_6th_factor, &
1917	config_flags%pd_tke, &
1918	ids, ide, jds, jde, kds, kde, &
1919	ims, ime, jms, jme, kms, kme, &
1920	grid%i_start(ij), grid%i_end(ij), &
1921	grid%j_start(ij), grid%j_end(ij), &
1922	k_start , k_end )
1923
1924	ENDDO tke_tile_loop_1
1925	!$OMP END PARALLEL DO
1926
1927	!$OMP PARALLEL DO &
1928	!$OMP PRIVATE ( ij )
1929	tke_tile_loop_2: DO ij = 1 , grid%num_tiles
1930
1931	CALL wrf_debug ( 200 , ' call rk_update_scalar' )
1932	CALL rk_update_scalar( 1, 1, &
1933	grid%tke_1, &
1934	grid%tke_2, &
1935	tke_tend(ims,kms,jms), &
1936	advect_tend,grid%msftx,grid%msfty, &
1937	grid%mu_1, grid%mu_2, grid%mub, &
1938	rk_step, dt_rk, grid%spec_zone, &
1939	config_flags, &
1940	ids, ide, jds, jde, kds, kde, &
1941	ims, ime, jms, jme, kms, kme, &
1942	grid%i_start(ij), grid%i_end(ij), &
1943	grid%j_start(ij), grid%j_end(ij), &
1944	k_start , k_end )
1945
1946	! bound the tke (greater than 0, less than tke_upper_bound)
1947
1948	CALL bound_tke( grid%tke_2, grid%tke_upper_bound, &
1949	ids, ide, jds, jde, kds, kde, &
1950	ims, ime, jms, jme, kms, kme, &
1951	grid%i_start(ij), grid%i_end(ij), &
1952	grid%j_start(ij), grid%j_end(ij), &
1953	k_start , k_end )
1954
1955	IF( config_flags%specified .or. config_flags%nested ) THEN
1956	CALL flow_dep_bdy ( grid%tke_2, &
1957	grid%ru_m, grid%rv_m, config_flags, &
1958	grid%spec_zone, &
1959	ids,ide, jds,jde, kds,kde, & ! domain dims
1960	ims,ime, jms,jme, kms,kme, & ! memory dims
1961	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1962	grid%i_start(ij), grid%i_end(ij), &
1963	grid%j_start(ij), grid%j_end(ij), &
1964	k_start, k_end )
1965	ENDIF
1966	ENDDO tke_tile_loop_2
1967	!$OMP END PARALLEL DO
1968
1969	ENDIF TKE_advance
1970	BENCH_END(tke_adv_tim)
1971
1972	#ifdef WRF_CHEM
1973	! next the chemical species
1974	BENCH_START(chem_adv_tim)
1975	chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
1976
1977	chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
1978
1979	!$OMP PARALLEL DO &
1980	!$OMP PRIVATE ( ij )
1981	chem_tile_loop_1: DO ij = 1 , grid%num_tiles
1982
1983	CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
1984	CALL rk_scalar_tend ( ic, ic, config_flags, &
1985	rk_step, dt_rk, &
1986	grid%ru_m, grid%rv_m, grid%ww_m, &
1987	grid%mut, grid%mub, grid%mu_1, &
1988	grid%alt, &
1989	chem_old(ims,kms,jms,ic), &
1990	chem(ims,kms,jms,ic), &
1991	chem_tend(ims,kms,jms,ic), &
1992	advect_tend,grid%rqvften, &
1993	grid%qv_base, .false., grid%fnm, grid%fnp, &
1994	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
1995	grid%msfvy, grid%msftx,grid%msfty, &
1996	grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
1997	grid%khdif, grid%kvdif, grid%xkhh, &
1998	grid%diff_6th_opt, grid%diff_6th_factor, &
1999	config_flags%pd_chem, &
2000	ids, ide, jds, jde, kds, kde, &
2001	ims, ime, jms, jme, kms, kme, &
2002	grid%i_start(ij), grid%i_end(ij), &
2003	grid%j_start(ij), grid%j_end(ij), &
2004	k_start , k_end )
2005	!
2006	! Currently, chemistry species with specified boundaries (i.e. the mother
2007	! domain) are being over written by flow_dep_bdy_chem. So, relax_bdy and
2008	! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
2009	! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
2010	!
2011	IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
2012	IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
2013	CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2014	chem(ims,kms,jms,ic), grid%mut, &
2015	chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2016	chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2017	chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2018	chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2019	config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2020	grid%dtbc, grid%fcx, grid%gcx, &
2021	config_flags, &
2022	ids,ide, jds,jde, kds,kde, &
2023	ims,ime, jms,jme, kms,kme, &
2024	ips,ipe, jps,jpe, kps,kpe, &
2025	grid%i_start(ij), grid%i_end(ij), &
2026	grid%j_start(ij), grid%j_end(ij), &
2027	k_start, k_end )
2028	CALL spec_bdy_scalar ( chem_tend(ims,kms,jms,ic), &
2029	chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic), &
2030	chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic), &
2031	chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic), &
2032	chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic), &
2033	config_flags%spec_bdy_width, grid%spec_zone, &
2034	config_flags, &
2035	ids,ide, jds,jde, kds,kde, &
2036	ims,ime, jms,jme, kms,kme, &
2037	ips,ipe, jps,jpe, kps,kpe, &
2038	grid%i_start(ij), grid%i_end(ij), &
2039	grid%j_start(ij), grid%j_end(ij), &
2040	k_start, k_end )
2041	ENDIF
2042
2043	ENDDO chem_tile_loop_1
2044	!$OMP END PARALLEL DO
2045
2046	!$OMP PARALLEL DO &
2047	!$OMP PRIVATE ( ij )
2048
2049	chem_tile_loop_2: DO ij = 1 , grid%num_tiles
2050
2051	CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2052	CALL rk_update_scalar( ic, ic, &
2053	chem_old(ims,kms,jms,ic), & ! was chem_1
2054	chem(ims,kms,jms,ic), &
2055	chem_tend(ims,kms,jms,ic), &
2056	advect_tend, grid%msftx, grid%msfty, &
2057	grid%mu_1, grid%mu_2, grid%mub, &
2058	rk_step, dt_rk, grid%spec_zone, &
2059	config_flags, &
2060	ids, ide, jds, jde, kds, kde, &
2061	ims, ime, jms, jme, kms, kme, &
2062	grid%i_start(ij), grid%i_end(ij), &
2063	grid%j_start(ij), grid%j_end(ij), &
2064	k_start , k_end )
2065
2066	IF( config_flags%specified ) THEN
2067	CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic), &
2068	chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic), &
2069	chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic), &
2070	chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic), &
2071	chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic), &
2072	dt_rk+grid%dtbc, &
2073	config_flags%spec_bdy_width,grid%z, &
2074	grid%have_bcs_chem, &
2075	grid%ru_m, grid%rv_m, config_flags,grid%alt, &
2076	grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
2077	grid%spec_zone,ic, &
2078	ids,ide, jds,jde, kds,kde, & ! domain dims
2079	ims,ime, jms,jme, kms,kme, & ! memory dims
2080	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2081	grid%i_start(ij), grid%i_end(ij), &
2082	grid%j_start(ij), grid%j_end(ij), &
2083	k_start, k_end )
2084	ENDIF
2085	ENDDO chem_tile_loop_2
2086	!$OMP END PARALLEL DO
2087
2088	ENDDO chem_variable_loop
2089	ENDIF chem_scalar_advance
2090	BENCH_END(chem_adv_tim)
2091	#endif
2092
2093	! next the other scalar species
2094	other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2095
2096	scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
2097	!$OMP PARALLEL DO &
2098	!$OMP PRIVATE ( ij )
2099	scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
2100
2101	CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
2102	CALL rk_scalar_tend ( is, is, config_flags, &
2103	rk_step, dt_rk, &
2104	grid%ru_m, grid%rv_m, grid%ww_m, &
2105	grid%mut, grid%mub, grid%mu_1, &
2106	grid%alt, &
2107	scalar_old(ims,kms,jms,is), &
2108	scalar(ims,kms,jms,is), &
2109	scalar_tend(ims,kms,jms,is), &
2110	advect_tend,grid%rqvften, &
2111	grid%qv_base, .false., grid%fnm, grid%fnp, &
2112	grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
2113	grid%msfvy, grid%msftx,grid%msfty, &
2114	grid%rdx, grid%rdy, grid%rdn, grid%rdnw, &
2115	grid%khdif, grid%kvdif, grid%xkhh, &
2116	grid%diff_6th_opt, grid%diff_6th_factor, &
2117	config_flags%pd_scalar, &
2118	ids, ide, jds, jde, kds, kde, &
2119	ims, ime, jms, jme, kms, kme, &
2120	grid%i_start(ij), grid%i_end(ij), &
2121	grid%j_start(ij), grid%j_end(ij), &
2122	k_start , k_end )
2123
2124	IF( config_flags%nested .and. (rk_step == 1) ) THEN
2125
2126	IF (is .EQ. P_QNDROP .OR. is .EQ. P_QNI &
2127	.OR. is .EQ. P_QNS &
2128	.OR. is .EQ. P_QNR &
2129	.OR. is .EQ. P_QNG) THEN
2130
2131	CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2132	scalar(ims,kms,jms,is), grid%mut, &
2133	scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2134	scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2135	scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2136	scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2137	config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
2138	grid%dtbc, grid%fcx, grid%gcx, &
2139	config_flags, &
2140	ids,ide, jds,jde, kds,kde, &
2141	ims,ime, jms,jme, kms,kme, &
2142	ips,ipe, jps,jpe, kps,kpe, &
2143	grid%i_start(ij), grid%i_end(ij), &
2144	grid%j_start(ij), grid%j_end(ij), &
2145	k_start, k_end )
2146
2147	CALL spec_bdy_scalar ( scalar_tend(ims,kms,jms,is), &
2148	scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is), &
2149	scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is), &
2150	scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is), &
2151	scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is), &
2152	config_flags%spec_bdy_width, grid%spec_zone, &
2153	config_flags, &
2154	ids,ide, jds,jde, kds,kde, &
2155	ims,ime, jms,jme, kms,kme, &
2156	ips,ipe, jps,jpe, kps,kpe, &
2157	grid%i_start(ij), grid%i_end(ij), &
2158	grid%j_start(ij), grid%j_end(ij), &
2159	k_start, k_end )
2160
2161	ENDIF
2162
2163	ENDIF ! b.c test for chem nested boundary condition
2164
2165	ENDDO scalar_tile_loop_1
2166	!$OMP END PARALLEL DO
2167
2168	!$OMP PARALLEL DO &
2169	!$OMP PRIVATE ( ij )
2170	scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
2171
2172	CALL wrf_debug ( 200 , ' call rk_update_scalar' )
2173	CALL rk_update_scalar( is, is, &
2174	scalar_old(ims,kms,jms,is), & ! was scalar_1
2175	scalar(ims,kms,jms,is), &
2176	scalar_tend(ims,kms,jms,is), &
2177	advect_tend, grid%msftx, grid%msfty, &
2178	grid%mu_1, grid%mu_2, grid%mub, &
2179	rk_step, dt_rk, grid%spec_zone, &
2180	config_flags, &
2181	ids, ide, jds, jde, kds, kde, &
2182	ims, ime, jms, jme, kms, kme, &
2183	grid%i_start(ij), grid%i_end(ij), &
2184	grid%j_start(ij), grid%j_end(ij), &
2185	k_start , k_end )
2186
2187
2188	IF( config_flags%specified ) THEN
2189	CALL flow_dep_bdy ( scalar(ims,kms,jms,is), &
2190	grid%ru_m, grid%rv_m, config_flags, &
2191	grid%spec_zone, &
2192	ids,ide, jds,jde, kds,kde, & ! domain dims
2193	ims,ime, jms,jme, kms,kme, & ! memory dims
2194	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
2195	grid%i_start(ij), grid%i_end(ij), &
2196	grid%j_start(ij), grid%j_end(ij), &
2197	k_start, k_end )
2198	ENDIF
2199
2200	ENDDO scalar_tile_loop_2
2201	!$OMP END PARALLEL DO
2202
2203	ENDDO scalar_variable_loop
2204
2205	ENDIF other_scalar_advance
2206
2207	! update the pressure and density at the new time level
2208
2209	!$OMP PARALLEL DO &
2210	!$OMP PRIVATE ( ij )
2211	DO ij = 1 , grid%num_tiles
2212
2213	BENCH_START(calc_p_rho_tim)
2214
2215	CALL calc_p_rho_phi( moist, num_3d_m, &
2216	grid%al, grid%alb, grid%mu_2, grid%muts, &
2217	grid%ph_2, grid%p, grid%pb, grid%t_2, &
2218	p0, t0, grid%znu, grid%dnw, grid%rdnw, &
2219	grid%rdn, config_flags%non_hydrostatic, &
2220	ids, ide, jds, jde, kds, kde, &
2221	ims, ime, jms, jme, kms, kme, &
2222	grid%i_start(ij), grid%i_end(ij), &
2223	grid%j_start(ij), grid%j_end(ij), &
2224	k_start , k_end )
2225
2226	BENCH_END(calc_p_rho_tim)
2227
2228	ENDDO
2229	!$OMP END PARALLEL DO
2230
2231	! Reset the boundary conditions if there is another corrector step.
2232	! (rk_step < rk_order), else we'll handle it at the end of everything
2233	! (after the split physics, before exiting the timestep).
2234
2235	rk_step_1_check: IF ( rk_step < rk_order ) THEN
2236
2237	!-----------------------------------------------------------
2238	! rk3 substep polar filter for scalars (moist,chem,scalar)
2239	!-----------------------------------------------------------
2240
2241	IF (config_flags%polar) THEN
2242	IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2243	CALL wrf_debug ( 200 , ' call filter moist ' )
2244	DO im = PARAM_FIRST_SCALAR, num_3d_m
2245	CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2246	,MU=grid%mu_2 , MUB=grid%mub &
2247	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2248	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2249	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2250	CALL pxft ( grid=grid &
2251	,lineno=__LINE__ &
2252	,flag_uv = 0 &
2253	,flag_rurv = 0 &
2254	,flag_wph = 0 &
2255	,flag_ww = 0 &
2256	,flag_t = 0 &
2257	,flag_mu = 0 &
2258	,flag_mut = 0 &
2259	,flag_moist = im &
2260	,flag_chem = 0 &
2261	,flag_scalar = 0 &
2262	,positive_definite=.FALSE. &
2263	,moist=moist,chem=chem,scalar=scalar &
2264	,fft_filter_lat = config_flags%fft_filter_lat &
2265	,dclat = dclat &
2266	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2267	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2268	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2269	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2270	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2271	CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) &
2272	,MU=grid%mu_2 , MUB=grid%mub &
2273	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2274	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2275	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2276	END DO
2277	END IF
2278
2279	IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
2280	CALL wrf_debug ( 200 , ' call filter chem ' )
2281	DO im = PARAM_FIRST_SCALAR, num_3d_c
2282	CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2283	,MU=grid%mu_2 , MUB=grid%mub &
2284	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2285	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2286	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2287	CALL pxft ( grid=grid &
2288	,lineno=__LINE__ &
2289	,flag_uv = 0 &
2290	,flag_rurv = 0 &
2291	,flag_wph = 0 &
2292	,flag_ww = 0 &
2293	,flag_t = 0 &
2294	,flag_mu = 0 &
2295	,flag_mut = 0 &
2296	,flag_moist = 0 &
2297	,flag_chem = im &
2298	,flag_scalar = 0 &
2299	,positive_definite=.FALSE. &
2300	,moist=moist,chem=chem,scalar=scalar &
2301	,fft_filter_lat = config_flags%fft_filter_lat &
2302	,dclat = dclat &
2303	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2304	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2305	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2306	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2307	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2308	CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) &
2309	,MU=grid%mu_2 , MUB=grid%mub &
2310	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2311	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2312	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2313	END DO
2314	END IF
2315
2316	IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
2317	CALL wrf_debug ( 200 , ' call filter scalar ' )
2318	DO im = PARAM_FIRST_SCALAR, num_3d_s
2319	CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2320	,MU=grid%mu_2 , MUB=grid%mub &
2321	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2322	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2323	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2324	CALL pxft ( grid=grid &
2325	,lineno=__LINE__ &
2326	,flag_uv = 0 &
2327	,flag_rurv = 0 &
2328	,flag_wph = 0 &
2329	,flag_ww = 0 &
2330	,flag_t = 0 &
2331	,flag_mu = 0 &
2332	,flag_mut = 0 &
2333	,flag_moist = 0 &
2334	,flag_chem = 0 &
2335	,flag_scalar = im &
2336	,positive_definite=.FALSE. &
2337	,moist=moist,chem=chem,scalar=scalar &
2338	,fft_filter_lat = config_flags%fft_filter_lat &
2339	,dclat = dclat &
2340	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2341	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2342	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2343	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2344	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2345	CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) &
2346	,MU=grid%mu_2 , MUB=grid%mub &
2347	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2348	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2349	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe )
2350	END DO
2351	END IF
2352	END IF ! polar filter test
2353
2354	!-----------------------------------------------------------
2355	! END rk3 substep polar filter for scalars (moist,chem,scalar)
2356	!-----------------------------------------------------------
2357
2358	!-----------------------------------------------------------
2359	! Stencils for patch communications (WCS, 29 June 2001)
2360	!
2361	! here's where we need a wide comm stencil - these are the
2362	! uncoupled variables so are used for high order calc in
2363	! advection and mixong routines.
2364	!
2365	!
2366	! * * * * * * *
2367	! * * * * * * * * * * * *
2368	! * * * * * * * * * * * * *
2369	! * + * * * + * * * * * + * * *
2370	! * * * * * * * * * * * * *
2371	! * * * * * * * * * * * *
2372	! * * * * * * *
2373	!
2374	! al x
2375	!
2376	! 2D variable
2377	! mu_2 x
2378	!
2379	! (adv order <=4)
2380	! u_2 x
2381	! v_2 x
2382	! w_2 x
2383	! t_2 x
2384	! ph_2 x
2385	!
2386	! (adv order <=6)
2387	! u_2 x
2388	! v_2 x
2389	! w_2 x
2390	! t_2 x
2391	! ph_2 x
2392	!
2393	! 4D variable
2394	! moist x
2395	! chem x
2396	! scalar x
2397
2398	#ifdef DM_PARALLEL
2399	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2400	# include "HALO_EM_D2_3.inc"
2401	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2402	# include "HALO_EM_D2_5.inc"
2403	ELSE
2404	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
2405	CALL wrf_error_fatal(TRIM(wrf_err_message))
2406	ENDIF
2407	# include "PERIOD_BDY_EM_D.inc"
2408	# include "PERIOD_BDY_EM_MOIST2.inc"
2409	# include "PERIOD_BDY_EM_CHEM2.inc"
2410	# include "PERIOD_BDY_EM_SCALAR2.inc"
2411	#endif
2412
2413	BENCH_START(bc_end_tim)
2414	!$OMP PARALLEL DO &
2415	!$OMP PRIVATE ( ij )
2416	tile_bc_loop_1: DO ij = 1 , grid%num_tiles
2417	CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
2418
2419	CALL rk_phys_bc_dry_2( config_flags, &
2420	grid%u_2, grid%v_2, grid%w_2, &
2421	grid%t_2, grid%ph_2, grid%mu_2, &
2422	ids, ide, jds, jde, kds, kde, &
2423	ims, ime, jms, jme, kms, kme, &
2424	ips, ipe, jps, jpe, kps, kpe, &
2425	grid%i_start(ij), grid%i_end(ij), &
2426	grid%j_start(ij), grid%j_end(ij), &
2427	k_start , k_end )
2428
2429	BENCH_START(diag_w_tim)
2430	IF (.not. config_flags%non_hydrostatic) THEN
2431	CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk, &
2432	grid%u_2, grid%v_2, grid%ht, &
2433	grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
2434	ids, ide, jds, jde, kds, kde, &
2435	ims, ime, jms, jme, kms, kme, &
2436	grid%i_start(ij), grid%i_end(ij), &
2437	grid%j_start(ij), grid%j_end(ij), &
2438	k_start , k_end )
2439	ENDIF
2440	BENCH_END(diag_w_tim)
2441
2442	IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
2443
2444	moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
2445
2446	CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags, &
2447	ids, ide, jds, jde, kds, kde, &
2448	ims, ime, jms, jme, kms, kme, &
2449	ips, ipe, jps, jpe, kps, kpe, &
2450	grid%i_start(ij), grid%i_end(ij), &
2451	grid%j_start(ij), grid%j_end(ij), &
2452	k_start , k_end )
2453	END DO moisture_loop_bdy_1
2454
2455	ENDIF
2456
2457	IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
2458
2459	chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
2460
2461	CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags, &
2462	ids, ide, jds, jde, kds, kde, &
2463	ims, ime, jms, jme, kms, kme, &
2464	ips, ipe, jps, jpe, kps, kpe, &
2465	grid%i_start(ij), grid%i_end(ij), &
2466	grid%j_start(ij), grid%j_end(ij), &
2467	k_start , k_end-1 )
2468
2469	END DO chem_species_bdy_loop_1
2470
2471	END IF
2472
2473	IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
2474
2475	scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
2476
2477	CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags, &
2478	ids, ide, jds, jde, kds, kde, &
2479	ims, ime, jms, jme, kms, kme, &
2480	ips, ipe, jps, jpe, kps, kpe, &
2481	grid%i_start(ij), grid%i_end(ij), &
2482	grid%j_start(ij), grid%j_end(ij), &
2483	k_start , k_end-1 )
2484
2485	END DO scalar_species_bdy_loop_1
2486
2487	END IF
2488
2489	IF (config_flags%km_opt .eq. 2) THEN
2490
2491	CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
2492	ids, ide, jds, jde, kds, kde, &
2493	ims, ime, jms, jme, kms, kme, &
2494	ips, ipe, jps, jpe, kps, kpe, &
2495	grid%i_start(ij), grid%i_end(ij), &
2496	grid%j_start(ij), grid%j_end(ij), &
2497	k_start , k_end )
2498	END IF
2499
2500	END DO tile_bc_loop_1
2501	!$OMP END PARALLEL DO
2502	BENCH_END(bc_end_tim)
2503
2504
2505	#ifdef DM_PARALLEL
2506
2507	! * * * * *
2508	! * * * * * * * * *
2509	! * + * * + * * * + * *
2510	! * * * * * * * * *
2511	! * * * * *
2512
2513	! moist, chem, scalar, tke x
2514
2515
2516	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
2517	IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
2518	# include "HALO_EM_TKE_5.inc"
2519	ELSE
2520	# include "HALO_EM_TKE_3.inc"
2521	ENDIF
2522	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
2523	IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
2524	# include "HALO_EM_TKE_7.inc"
2525	ELSE
2526	# include "HALO_EM_TKE_5.inc"
2527	ENDIF
2528	ELSE
2529	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2530	CALL wrf_error_fatal(TRIM(wrf_err_message))
2531	ENDIF
2532
2533	IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
2534	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2535	IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
2536	# include "HALO_EM_MOIST_E_5.inc"
2537	ELSE
2538	# include "HALO_EM_MOIST_E_3.inc"
2539	END IF
2540	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2541	IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
2542	# include "HALO_EM_MOIST_E_7.inc"
2543	ELSE
2544	# include "HALO_EM_MOIST_E_5.inc"
2545	END IF
2546	ELSE
2547	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2548	CALL wrf_error_fatal(TRIM(wrf_err_message))
2549	ENDIF
2550	ENDIF
2551	IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
2552	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2553	IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
2554	# include "HALO_EM_CHEM_E_5.inc"
2555	ELSE
2556	# include "HALO_EM_CHEM_E_3.inc"
2557	ENDIF
2558	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2559	IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
2560	# include "HALO_EM_CHEM_E_7.inc"
2561	ELSE
2562	# include "HALO_EM_CHEM_E_5.inc"
2563	ENDIF
2564	ELSE
2565	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2566	CALL wrf_error_fatal(TRIM(wrf_err_message))
2567	ENDIF
2568	ENDIF
2569	IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
2570	IF ( config_flags%h_sca_adv_order <= 4 ) THEN
2571	IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
2572	# include "HALO_EM_SCALAR_E_5.inc"
2573	ELSE
2574	# include "HALO_EM_SCALAR_E_3.inc"
2575	ENDIF
2576	ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
2577	IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
2578	# include "HALO_EM_SCALAR_E_7.inc"
2579	ELSE
2580	# include "HALO_EM_SCALAR_E_5.inc"
2581	ENDIF
2582	ELSE
2583	WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
2584	CALL wrf_error_fatal(TRIM(wrf_err_message))
2585	ENDIF
2586	ENDIF
2587	#endif
2588
2589	ENDIF rk_step_1_check
2590
2591
2592	!**********************************************************
2593	!
2594	! end of RK predictor-corrector loop
2595	!
2596	!**********************************************************
2597
2598	END DO Runge_Kutta_loop
2599
2600	!$OMP PARALLEL DO &
2601	!$OMP PRIVATE ( ij )
2602	DO ij = 1 , grid%num_tiles
2603
2604	BENCH_START(advance_ppt_tim)
2605	CALL wrf_debug ( 200 , ' call advance_ppt' )
2606	CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
2607	grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%pratec, grid%nca, &
2608	grid%htop,grid%hbot,grid%cutop,grid%cubot, &
2609	grid%cuppt, grid%dt, config_flags, &
2610	ids,ide, jds,jde, kds,kde, &
2611	ims,ime, jms,jme, kms,kme, &
2612	grid%i_start(ij), grid%i_end(ij), &
2613	grid%j_start(ij), grid%j_end(ij), &
2614	k_start , k_end )
2615	BENCH_END(advance_ppt_tim)
2616
2617	ENDDO
2618	!$OMP END PARALLEL DO
2619
2620	!<DESCRIPTION>
2621	!<pre>
2622	! (5) time-split physics.
2623	!
2624	! Microphysics are the only time split physics in the WRF model
2625	! at this time. Split-physics begins with the calculation of
2626	! needed diagnostic quantities (pressure, temperature, etc.)
2627	! followed by a call to the microphysics driver,
2628	! and finishes with a clean-up, storing off of a diabatic tendency
2629	! from the moist physics, and a re-calulation of the diagnostic
2630	! quantities pressure and density.
2631	!</pre>
2632	!</DESCRIPTION>
2633
2634	IF( config_flags%specified .or. config_flags%nested ) THEN
2635	sz = grid%spec_zone
2636	ELSE
2637	sz = 0
2638	ENDIF
2639
2640	IF (config_flags%mp_physics /= 0) then
2641
2642	!$OMP PARALLEL DO &
2643	!$OMP PRIVATE ( ij, its, ite, jts, jte )
2644
2645	scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
2646
2647	IF ( config_flags%periodic_x ) THEN
2648	its = max(grid%i_start(ij),ids)
2649	ite = min(grid%i_end(ij),ide-1)
2650	ELSE
2651	its = max(grid%i_start(ij),ids+sz)
2652	ite = min(grid%i_end(ij),ide-1-sz)
2653	ENDIF
2654	jts = max(grid%j_start(ij),jds+sz)
2655	jte = min(grid%j_end(ij),jde-1-sz)
2656
2657	CALL wrf_debug ( 200 , ' call moist_physics_prep' )
2658	BENCH_START(moist_physics_prep_tim)
2659	CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho, &
2660	grid%al, grid%alb, grid%p, p8w, p0, grid%pb, &
2661	grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
2662	grid%z, z_at_w, dz8w, &
2663	dtm, grid%h_diabatic, &
2664	config_flags,grid%fnm, grid%fnp, &
2665	ids, ide, jds, jde, kds, kde, &
2666	ims, ime, jms, jme, kms, kme, &
2667	its, ite, jts, jte, &
2668	k_start , k_end )
2669	BENCH_END(moist_physics_prep_tim)
2670	END DO scalar_tile_loop_1a
2671	!$OMP END PARALLEL DO
2672
2673	CALL wrf_debug ( 200 , ' call microphysics_driver' )
2674
2675	grid%sr = 0.
2676	specified_bdy = config_flags%specified .OR. config_flags%nested
2677	channel_bdy = config_flags%specified .AND. config_flags%periodic_x
2678
2679	BENCH_START(micro_driver_tim)
2680
2681	CALL microphysics_driver( &
2682	& DT=dtm ,DX=grid%dx ,DY=grid%dy &
2683	& ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy &
2684	& ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr &
2685	& ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy &
2686	& ,RHO=rho ,SPEC_ZONE=grid%spec_zone &
2687	& ,SR=grid%sr ,TH=th_phy &
2688	& ,WARM_RAIN=grid%warm_rain &
2689	& ,T8W=t8w &
2690	& ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
2691	& ,NSOURCE=grid%qndropsource &
2692	#ifdef WRF_CHEM
2693	& ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old &
2694	& ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
2695	& ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn &
2696	#endif
2697	& ,XLAND=grid%xland &
2698	& ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy &
2699	& ,F_RAIN_PHY=grid%f_rain_phy &
2700	& ,F_RIMEF_PHY=grid%f_rimef_phy &
2701	& ,MP_PHYSICS=config_flags%mp_physics &
2702	& ,ID=grid%id &
2703	& ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
2704	& ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
2705	#ifdef RUN_ON_GPU
2706	& ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
2707	#endif
2708	& ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
2709	& ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
2710	& ,KTS=k_start, KTE=min(k_end,kde-1) &
2711	& ,NUM_TILES=grid%num_tiles &
2712	& ,NAER=grid%naer &
2713	! Optional
2714	& , RAINNC=grid%rainnc, RAINNCV=grid%rainncv &
2715	& , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv &
2716	& , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv &
2717	& , W=grid%w_2, Z=grid%z, HT=grid%ht &
2718	& , MP_RESTART_STATE=grid%mp_restart_state &
2719	& , TBPVS_STATE=grid%tbpvs_state & ! etampnew
2720	& , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew
2721	& , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV &
2722	& , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC &
2723	& , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR &
2724	& , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI &
2725	& , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS &
2726	& , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG &
2727	& , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
2728	& , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI &
2729	& , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT &
2730	& , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS &
2731	& , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR &
2732	& , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG &
2733	& , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten &
2734	& , qicuten=grid%rqicuten,mu=grid%mut &
2735	& , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce
2736	& , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce
2737	)
2738	BENCH_END(micro_driver_tim)
2739
2740	#if 0
2741	BENCH_START(microswap_2)
2742	! for load balancing; communication to redistribute the points
2743	IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
2744	#include "SWAP_ETAMP_NEW.inc"
2745	ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
2746	#include "SWAP_WSM3.inc"
2747	ENDIF
2748	BENCH_END(microswap_2)
2749	#endif
2750
2751	CALL wrf_debug ( 200 , ' call moist_physics_finish' )
2752	BENCH_START(moist_phys_end_tim)
2753
2754	!$OMP PARALLEL DO &
2755	!$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
2756
2757	DO ij = 1 , grid%num_tiles
2758
2759	IF ( config_flags%periodic_x ) THEN
2760	its = max(grid%i_start(ij),ids)
2761	ite = min(grid%i_end(ij),ide-1)
2762	ELSE
2763	its = max(grid%i_start(ij),ids+sz)
2764	ite = min(grid%i_end(ij),ide-1-sz)
2765	ENDIF
2766	jts = max(grid%j_start(ij),jds+sz)
2767	jte = min(grid%j_end(ij),jde-1-sz)
2768
2769	CALL microphysics_zero_out ( &
2770	moist , num_moist , config_flags , &
2771	ids, ide, jds, jde, kds, kde, &
2772	ims, ime, jms, jme, kms, kme, &
2773	its, ite, jts, jte, &
2774	k_start , k_end )
2775
2776
2777	CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, &
2778	grid%h_diabatic, dtm, config_flags, &
2779	ids, ide, jds, jde, kds, kde, &
2780	ims, ime, jms, jme, kms, kme, &
2781	its, ite, jts, jte, &
2782	k_start , k_end )
2783
2784	END DO
2785	!$OMP END PARALLEL DO
2786
2787	ENDIF ! microphysics test
2788
2789	!-----------------------------------------------------------
2790	! filter for moist variables post-microphysics and end of timestep
2791	!-----------------------------------------------------------
2792
2793	IF (config_flags%polar) THEN
2794	IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
2795	CALL wrf_debug ( 200 , ' call filter moist' )
2796	DO im = PARAM_FIRST_SCALAR, num_3d_m
2797	DO jj = jps, MIN(jpe,jde-1)
2798	DO kk = kps, MIN(kpe,kde-1)
2799	DO ii = ips, MIN(ipe,ide-1)
2800	moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2801	ENDDO
2802	ENDDO
2803	ENDDO
2804
2805	CALL pxft ( grid=grid &
2806	,lineno=__LINE__ &
2807	,flag_uv = 0 &
2808	,flag_rurv = 0 &
2809	,flag_wph = 0 &
2810	,flag_ww = 0 &
2811	,flag_t = 0 &
2812	,flag_mu = 0 &
2813	,flag_mut = 0 &
2814	,flag_moist = im &
2815	,flag_chem = 0 &
2816	,flag_scalar = 0 &
2817	,positive_definite=.FALSE. &
2818	,moist=moist,chem=chem,scalar=scalar &
2819	,fft_filter_lat = config_flags%fft_filter_lat &
2820	,dclat = dclat &
2821	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2822	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2823	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2824	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2825	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2826
2827	DO jj = jps, MIN(jpe,jde-1)
2828	DO kk = kps, MIN(kpe,kde-1)
2829	DO ii = ips, MIN(ipe,ide-1)
2830	moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2831	ENDDO
2832	ENDDO
2833	ENDDO
2834	ENDDO
2835	ENDIF
2836	ENDIF
2837
2838	!-----------------------------------------------------------
2839	! end filter for moist variables post-microphysics and end of timestep
2840	!-----------------------------------------------------------
2841
2842	!$OMP PARALLEL DO &
2843	!$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
2844	scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
2845
2846	IF ( config_flags%periodic_x ) THEN
2847	its = max(grid%i_start(ij),ids)
2848	ite = min(grid%i_end(ij),ide-1)
2849	ELSE
2850	its = max(grid%i_start(ij),ids+sz)
2851	ite = min(grid%i_end(ij),ide-1-sz)
2852	ENDIF
2853	jts = max(grid%j_start(ij),jds+sz)
2854	jte = min(grid%j_end(ij),jde-1-sz)
2855
2856	CALL calc_p_rho_phi( moist, num_3d_m, &
2857	grid%al, grid%alb, grid%mu_2, grid%muts, &
2858	grid%ph_2, grid%p, grid%pb, grid%t_2, &
2859	p0, t0, grid%znu, grid%dnw, grid%rdnw, &
2860	grid%rdn, config_flags%non_hydrostatic, &
2861	ids, ide, jds, jde, kds, kde, &
2862	ims, ime, jms, jme, kms, kme, &
2863	its, ite, jts, jte, &
2864	k_start , k_end )
2865
2866	END DO scalar_tile_loop_1ba
2867	!$OMP END PARALLEL DO
2868	BENCH_END(moist_phys_end_tim)
2869
2870	IF (.not. config_flags%non_hydrostatic) THEN
2871	#ifdef DM_PARALLEL
2872	# include "HALO_EM_HYDRO_UV.inc"
2873	# include "PERIOD_EM_HYDRO_UV.inc"
2874	#endif
2875	!$OMP PARALLEL DO &
2876	!$OMP PRIVATE ( ij )
2877	DO ij = 1 , grid%num_tiles
2878	CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk, &
2879	grid%u_2, grid%v_2, grid%ht, &
2880	grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
2881	ids, ide, jds, jde, kds, kde, &
2882	ims, ime, jms, jme, kms, kme, &
2883	grid%i_start(ij), grid%i_end(ij), &
2884	grid%j_start(ij), grid%j_end(ij), &
2885	k_start , k_end )
2886
2887	END DO
2888	!$OMP END PARALLEL DO
2889
2890	END IF
2891
2892	CALL wrf_debug ( 200 , ' call chem polar filter ' )
2893
2894	!-----------------------------------------------------------
2895	! filter for chem and scalar variables at end of timestep
2896	!-----------------------------------------------------------
2897
2898	IF (config_flags%polar) THEN
2899
2900	IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
2901	chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
2902	DO jj = jps, MIN(jpe,jde-1)
2903	DO kk = kps, MIN(kpe,kde-1)
2904	DO ii = ips, MIN(ipe,ide-1)
2905	chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2906	ENDDO
2907	ENDDO
2908	ENDDO
2909
2910	CALL pxft ( grid=grid &
2911	,lineno=__LINE__ &
2912	,flag_uv = 0 &
2913	,flag_rurv = 0 &
2914	,flag_wph = 0 &
2915	,flag_ww = 0 &
2916	,flag_t = 0 &
2917	,flag_mu = 0 &
2918	,flag_mut = 0 &
2919	,flag_moist = 0 &
2920	,flag_chem = im &
2921	,flag_scalar = 0 &
2922	,positive_definite=.FALSE. &
2923	,moist=moist,chem=chem,scalar=scalar &
2924	,fft_filter_lat = config_flags%fft_filter_lat &
2925	,dclat = dclat &
2926	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2927	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2928	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2929	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2930	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2931
2932	DO jj = jps, MIN(jpe,jde-1)
2933	DO kk = kps, MIN(kpe,kde-1)
2934	DO ii = ips, MIN(ipe,ide-1)
2935	chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2936	ENDDO
2937	ENDDO
2938	ENDDO
2939	ENDDO chem_filter_loop
2940	ENDIF
2941
2942	IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
2943	scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
2944	DO jj = jps, MIN(jpe,jde-1)
2945	DO kk = kps, MIN(kpe,kde-1)
2946	DO ii = ips, MIN(ipe,ide-1)
2947	scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2948	ENDDO
2949	ENDDO
2950	ENDDO
2951
2952	CALL pxft ( grid=grid &
2953	,lineno=__LINE__ &
2954	,flag_uv = 0 &
2955	,flag_rurv = 0 &
2956	,flag_wph = 0 &
2957	,flag_ww = 0 &
2958	,flag_t = 0 &
2959	,flag_mu = 0 &
2960	,flag_mut = 0 &
2961	,flag_moist = 0 &
2962	,flag_chem = 0 &
2963	,flag_scalar = im &
2964	,positive_definite=.FALSE. &
2965	,moist=moist,chem=chem,scalar=scalar &
2966	,fft_filter_lat = config_flags%fft_filter_lat &
2967	,dclat = dclat &
2968	,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde &
2969	,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme &
2970	,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe &
2971	,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
2972	,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
2973
2974	DO jj = jps, MIN(jpe,jde-1)
2975	DO kk = kps, MIN(kpe,kde-1)
2976	DO ii = ips, MIN(ipe,ide-1)
2977	scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
2978	ENDDO
2979	ENDDO
2980	ENDDO
2981	ENDDO scalar_filter_loop
2982	ENDIF
2983	ENDIF
2984
2985	!-----------------------------------------------------------
2986	! end filter for chem and scalar variables at end of timestep
2987	!-----------------------------------------------------------
2988
2989	! We're finished except for boundary condition (and patch) update
2990
2991	! Boundary condition time (or communication time). At this time, we have
2992	! implemented periodic and symmetric physical boundary conditions.
2993
2994	! b.c. routine for data within patch.
2995
2996	! we need to do both time levels of
2997	! data because the time filter only works in the physical solution space.
2998
2999	! First, do patch communications for boundary conditions (periodicity)
3000
3001	!-----------------------------------------------------------
3002	! Stencils for patch communications (WCS, 29 June 2001)
3003	!
3004	! here's where we need a wide comm stencil - these are the
3005	! uncoupled variables so are used for high order calc in
3006	! advection and mixong routines.
3007	!
3008	! * * * * *
3009	! * * * * * * * * *
3010	! * + * * + * * * + * *
3011	! * * * * * * * * *
3012	! * * * * *
3013	!
3014	! grid%u_1 x
3015	! grid%u_2 x
3016	! grid%v_1 x
3017	! grid%v_2 x
3018	! grid%w_1 x
3019	! grid%w_2 x
3020	! grid%t_1 x
3021	! grid%t_2 x
3022	! grid%ph_1 x
3023	! grid%ph_2 x
3024	! grid%tke_1 x
3025	! grid%tke_2 x
3026	!
3027	! 2D variables
3028	! grid%mu_1 x
3029	! grid%mu_2 x
3030	!
3031	! 4D variables
3032	! moist x
3033	! chem x
3034	! scalar x
3035	!----------------------------------------------------------
3036
3037
3038	#ifdef DM_PARALLEL
3039	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3040	# include "HALO_EM_D3_3.inc"
3041	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3042	# include "HALO_EM_D3_5.inc"
3043	ELSE
3044	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3045	CALL wrf_error_fatal(TRIM(wrf_err_message))
3046	ENDIF
3047	# include "PERIOD_BDY_EM_D3.inc"
3048	# include "PERIOD_BDY_EM_MOIST.inc"
3049	# include "PERIOD_BDY_EM_CHEM.inc"
3050	# include "PERIOD_BDY_EM_SCALAR.inc"
3051	#endif
3052
3053	! now set physical b.c on a patch
3054
3055	BENCH_START(bc_2d_tim)
3056	!$OMP PARALLEL DO &
3057	!$OMP PRIVATE ( ij )
3058	tile_bc_loop_2: DO ij = 1 , grid%num_tiles
3059
3060	CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
3061
3062	CALL set_phys_bc_dry_2( config_flags, &
3063	grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2, &
3064	grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2, &
3065	ids, ide, jds, jde, kds, kde, &
3066	ims, ime, jms, jme, kms, kme, &
3067	ips, ipe, jps, jpe, kps, kpe, &
3068	grid%i_start(ij), grid%i_end(ij), &
3069	grid%j_start(ij), grid%j_end(ij), &
3070	k_start , k_end )
3071
3072	CALL set_physical_bc3d( grid%tke_1, 'p', config_flags, &
3073	ids, ide, jds, jde, kds, kde, &
3074	ims, ime, jms, jme, kms, kme, &
3075	ips, ipe, jps, jpe, kps, kpe, &
3076	grid%i_start(ij), grid%i_end(ij), &
3077	grid%j_start(ij), grid%j_end(ij), &
3078	k_start , k_end-1 )
3079
3080	CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags, &
3081	ids, ide, jds, jde, kds, kde, &
3082	ims, ime, jms, jme, kms, kme, &
3083	ips, ipe, jps, jpe, kps, kpe, &
3084	grid%i_start(ij), grid%i_end(ij), &
3085	grid%j_start(ij), grid%j_end(ij), &
3086	k_start , k_end )
3087
3088	moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
3089
3090	CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', &
3091	config_flags, &
3092	ids, ide, jds, jde, kds, kde, &
3093	ims, ime, jms, jme, kms, kme, &
3094	ips, ipe, jps, jpe, kps, kpe, &
3095	grid%i_start(ij), grid%i_end(ij), &
3096	grid%j_start(ij), grid%j_end(ij), &
3097	k_start , k_end )
3098
3099	END DO moisture_loop_bdy_2
3100
3101	chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
3102
3103	CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags, &
3104	ids, ide, jds, jde, kds, kde, &
3105	ims, ime, jms, jme, kms, kme, &
3106	ips, ipe, jps, jpe, kps, kpe, &
3107	grid%i_start(ij), grid%i_end(ij), &
3108	grid%j_start(ij), grid%j_end(ij), &
3109	k_start , k_end )
3110
3111	END DO chem_species_bdy_loop_2
3112
3113	scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
3114
3115	CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags, &
3116	ids, ide, jds, jde, kds, kde, &
3117	ims, ime, jms, jme, kms, kme, &
3118	ips, ipe, jps, jpe, kps, kpe, &
3119	grid%i_start(ij), grid%i_end(ij), &
3120	grid%j_start(ij), grid%j_end(ij), &
3121	k_start , k_end )
3122
3123	END DO scalar_species_bdy_loop_2
3124
3125	END DO tile_bc_loop_2
3126	!$OMP END PARALLEL DO
3127	BENCH_END(bc_2d_tim)
3128
3129	IF( config_flags%specified .or. config_flags%nested ) THEN
3130	grid%dtbc = grid%dtbc + grid%dt
3131	ENDIF
3132
3133	! calculate some model diagnostics.
3134
3135	CALL wrf_debug ( 200 , ' call diagnostic_driver' )
3136
3137	CALL diagnostic_output_calc( &
3138	& DPSDT=grid%dpsdt ,DMUDT=grid%dmudt &
3139	& ,P8W=p8w ,PK1M=grid%pk1m &
3140	& ,MU_2=grid%mu_2 ,MU_2M=grid%mu_2m &
3141	& ,U=grid%u_2 ,V=grid%v_2 &
3142	& ,RAINCV=grid%raincv ,RAINNCV=grid%rainncv &
3143	& ,RAINC=grid%rainc ,RAINNC=grid%rainnc &
3144	& ,HFX=grid%hfx ,SFCEVP=grid%sfcevp ,LH=grid%lh &
3145	& ,DT=grid%dt ,SBW=config_flags%spec_bdy_width &
3146	& ,XTIME=grid%xtime &
3147	! Selection flag
3148	& ,DIAG_PRINT=config_flags%diag_print &
3149	! Dimension arguments
3150	& ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
3151	& ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
3152	& ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe &
3153	& ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) &
3154	& ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) &
3155	& ,KTS=k_start, KTE=min(k_end,kde-1) &
3156	& ,NUM_TILES=grid%num_tiles &
3157	& )
3158
3159	#ifdef DM_PARALLEL
3160	!-----------------------------------------------------------------------
3161	! see above
3162	!--------------------------------------------------------------
3163	CALL wrf_debug ( 200 , ' call HALO_RK_E' )
3164	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3165	# include "HALO_EM_E_3.inc"
3166	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3167	# include "HALO_EM_E_5.inc"
3168	ELSE
3169	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3170	CALL wrf_error_fatal(TRIM(wrf_err_message))
3171	ENDIF
3172	#endif
3173
3174	#ifdef DM_PARALLEL
3175	IF ( num_moist >= PARAM_FIRST_SCALAR ) THEN
3176	!-----------------------------------------------------------------------
3177	! see above
3178	!--------------------------------------------------------------
3179	CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
3180	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3181	# include "HALO_EM_MOIST_E_3.inc"
3182	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3183	# include "HALO_EM_MOIST_E_5.inc"
3184	ELSE
3185	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3186	CALL wrf_error_fatal(TRIM(wrf_err_message))
3187	ENDIF
3188	ENDIF
3189	IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
3190	!-----------------------------------------------------------------------
3191	! see above
3192	!--------------------------------------------------------------
3193	CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
3194	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3195	# include "HALO_EM_CHEM_E_3.inc"
3196	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3197	# include "HALO_EM_CHEM_E_5.inc"
3198	ELSE
3199	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3200	CALL wrf_error_fatal(TRIM(wrf_err_message))
3201	ENDIF
3202	ENDIF
3203	IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
3204	!-----------------------------------------------------------------------
3205	! see above
3206	!--------------------------------------------------------------
3207	CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
3208	IF ( config_flags%h_mom_adv_order <= 4 ) THEN
3209	# include "HALO_EM_SCALAR_E_3.inc"
3210	ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
3211	# include "HALO_EM_SCALAR_E_5.inc"
3212	ELSE
3213	WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
3214	CALL wrf_error_fatal(TRIM(wrf_err_message))
3215	ENDIF
3216	ENDIF
3217	#endif
3218
3219	! Max values of CFL for adaptive time step scheme
3220
3221	DEALLOCATE(max_vert_cfl_tmp)
3222	DEALLOCATE(max_horiz_cfl_tmp)
3223
3224	CALL wrf_debug ( 200 , ' call end of solve_em' )
3225
3226	! Finish timers if compiled with -DBENCH.
3227	#include <bench_solve_em_end.h>
3228
3229	RETURN
3230
3231	END SUBROUTINE solve_em

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format