Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

solve_em.F @ 3094

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

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

Download in other formats:

Original Format