Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
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

Rev	Line
[17]	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
[94]	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
[17]	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
[94]	2642	!!!!****MARS MARS
	2643	!!!!****MARS MARS
[17]	2644
[94]	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
[17]	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
[94]	3138	!!!!****MARS MARS
	3139	!!!!****MARS MARS
[17]	3140
[94]	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	! & )
[17]	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