Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_advect_em.F @ 3094

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

Rev	Line
[2759]	1	!WRF:MODEL_LAYER:DYNAMICS
	2	!
	3	MODULE module_advect_em
	4
	5	USE module_bc
	6	USE module_model_constants
	7	USE module_wrf_error
	8
	9	CONTAINS
	10
	11
	12	SUBROUTINE mass_flux_divergence ( field, field_old, tendency, &
	13	ru, rv, rom, &
	14	mut, config_flags, &
	15	msfux, msfuy, msfvx, msfvy, &
	16	msftx, msfty, &
	17	fzm, fzp, &
	18	rdx, rdy, rdzw, &
	19	ids, ide, jds, jde, kds, kde, &
	20	ims, ime, jms, jme, kms, kme, &
	21	its, ite, jts, jte, kts, kte )
	22
	23	IMPLICIT NONE
	24
	25	! Input data
	26
	27	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	28
	29	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	30	ims, ime, jms, jme, kms, kme, &
	31	its, ite, jts, jte, kts, kte
	32
	33	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, &
	34	field_old, &
	35	ru, &
	36	rv, &
	37	rom
	38
	39	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
	40	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	41
	42	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	43	msfuy, &
	44	msfvx, &
	45	msfvy, &
	46	msftx, &
	47	msfty
	48
	49	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	50	fzp, &
	51	rdzw
	52
	53	REAL , INTENT(IN ) :: rdx, &
	54	rdy
	55
	56	! Local data
	57
	58	INTEGER :: i, j, k, itf, jtf, ktf
	59	INTEGER :: i_start, i_end, j_start, j_end
	60	INTEGER :: imin, imax, jmin, jmax
	61
	62	REAL :: mrdx, mrdy, ub, vb, uw, vw
	63	REAL , DIMENSION(its:ite,kts:kte) :: vflux
	64
	65	LOGICAL :: specified
	66
	67	!--------------- horizontal flux
	68
	69	specified = .false.
	70	if(config_flags%specified .or. config_flags%nested) specified = .true.
	71
	72	ktf=MIN(kte,kde-1)
	73	i_start = its
	74	i_end = MIN(ite,ide-1)
	75	j_start = jts
	76	j_end = MIN(jte,jde-1)
	77
	78	DO j = j_start, j_end
	79	DO k = kts, ktf
	80	DO i = i_start, i_end
	81	mrdx=msftx(i,j)*rdx
	82	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
	83	(ru(i+1,k,j)(field(i+1,k,j)+field(i ,k,j)) &
	84	-ru(i ,k,j)*(field(i ,k,j)+field(i-1,k,j)))
	85	ENDDO
	86	ENDDO
	87	ENDDO
	88
	89	DO j = j_start, j_end
	90	DO k = kts, ktf
	91	DO i = i_start, i_end
	92	mrdy=msfty(i,j)*rdy
	93	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
	94	(rv(i,k,j+1)(field(i,k,j+1)+field(i,k,j )) &
	95	-rv(i,k,j )*(field(i,k,j )+field(i,k,j-1)))
	96	ENDDO
	97	ENDDO
	98	ENDDO
	99
	100	!---------------- vertical flux divergence
	101
	102
	103	DO i = i_start, i_end
	104	vflux(i,kts)=0.
	105	vflux(i,kte)=0.
	106	ENDDO
	107
	108	DO j = j_start, j_end
	109
	110	DO k = kts+1, ktf
	111	DO i = i_start, i_end
	112	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	113	ENDDO
	114	ENDDO
	115
	116	DO k = kts, ktf
	117	DO i = i_start, i_end
	118	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	119	ENDDO
	120	ENDDO
	121
	122	ENDDO
	123
	124	END SUBROUTINE mass_flux_divergence
	125
	126	!-------------------------------------------------------------------------------
	127
	128	SUBROUTINE advect_u ( u, u_old, tendency, &
	129	ru, rv, rom, &
	130	mut, time_step, config_flags, &
	131	msfux, msfuy, msfvx, msfvy, &
	132	msftx, msfty, &
	133	fzm, fzp, &
	134	rdx, rdy, rdzw, &
	135	ids, ide, jds, jde, kds, kde, &
	136	ims, ime, jms, jme, kms, kme, &
	137	its, ite, jts, jte, kts, kte )
	138
	139	IMPLICIT NONE
	140
	141	! Input data
	142
	143	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	144
	145	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	146	ims, ime, jms, jme, kms, kme, &
	147	its, ite, jts, jte, kts, kte
	148
	149	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: u, &
	150	u_old, &
	151	ru, &
	152	rv, &
	153	rom
	154
	155	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
	156	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	157
	158	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	159	msfuy, &
	160	msfvx, &
	161	msfvy, &
	162	msftx, &
	163	msfty
	164
	165	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	166	fzp, &
	167	rdzw
	168
	169	REAL , INTENT(IN ) :: rdx, &
	170	rdy
	171	INTEGER , INTENT(IN ) :: time_step
	172
	173	! Local data
	174
	175	INTEGER :: i, j, k, itf, jtf, ktf
	176	INTEGER :: i_start, i_end, j_start, j_end
	177	INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
	178	INTEGER :: jmin, jmax, jp, jm, imin, imax, im, ip
	179	INTEGER :: jp1, jp0, jtmp
	180
	181	INTEGER :: horz_order, vert_order
	182
	183	REAL :: mrdx, mrdy, ub, vb, uw, vw, dvm, dvp
	184	REAL , DIMENSION(its:ite, kts:kte) :: vflux
	185
	186
	187	REAL, DIMENSION( its-1:ite+1, kts:kte ) :: fqx
	188	REAL, DIMENSION( its:ite, kts:kte, 2) :: fqy
	189
	190	LOGICAL :: degrade_xs, degrade_ys
	191	LOGICAL :: degrade_xe, degrade_ye
	192
	193	! definition of flux operators, 3rd, 4th, 5th or 6th order
	194
	195	REAL :: flux3, flux4, flux5, flux6
	196	REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
	197
	198	flux4(q_im2, q_im1, q_i, q_ip1, ua) = &
	199	( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
	200
	201	flux3(q_im2, q_im1, q_i, q_ip1, ua) = &
	202	flux4(q_im2, q_im1, q_i, q_ip1, ua) + &
	203	sign(1,time_step)sign(1.,ua)((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
	204
	205	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	206	( 37.(q_i+q_im1) - 8.(q_ip1+q_im2) &
	207	+(q_ip2+q_im3) )/60.0
	208
	209	flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	210	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) &
	211	-sign(1,time_step)sign(1.,ua)( &
	212	(q_ip2-q_im3)-5.(q_ip1-q_im2)+10.(q_i-q_im1) )/60.0
	213
	214
	215	LOGICAL :: specified
	216
	217	specified = .false.
	218	if(config_flags%specified .or. config_flags%nested) specified = .true.
	219
	220	! set order for vertical and horzontal flux operators
	221
	222	horz_order = config_flags%h_mom_adv_order
	223	vert_order = config_flags%v_mom_adv_order
	224
	225	ktf=MIN(kte,kde-1)
	226
	227	! begin with horizontal flux divergence
	228
	229	horizontal_order_test : IF( horz_order == 6 ) THEN
	230
	231	! determine boundary mods for flux operators
	232	! We degrade the flux operators from 3rd/4th order
	233	! to second order one gridpoint in from the boundaries for
	234	! all boundary conditions except periodic and symmetry - these
	235	! conditions have boundary zone data fill for correct application
	236	! of the higher order flux stencils
	237
	238	degrade_xs = .true.
	239	degrade_xe = .true.
	240	degrade_ys = .true.
	241	degrade_ye = .true.
	242
	243	IF( config_flags%periodic_x .or. &
	244	config_flags%symmetric_xs .or. &
	245	(its > ids+2) ) degrade_xs = .false.
	246	IF( config_flags%periodic_x .or. &
	247	config_flags%symmetric_xe .or. &
	248	(ite < ide-2) ) degrade_xe = .false.
	249	IF( config_flags%periodic_y .or. &
	250	config_flags%symmetric_ys .or. &
	251	(jts > jds+2) ) degrade_ys = .false.
	252	IF( config_flags%periodic_y .or. &
	253	config_flags%symmetric_ye .or. &
	254	(jte < jde-3) ) degrade_ye = .false.
	255
	256	!--------------- y - advection first
	257
	258	i_start = its
	259	i_end = ite
	260	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	261	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite)
	262	IF ( config_flags%periodic_x ) i_start = its
	263	IF ( config_flags%periodic_x ) i_end = ite
	264
	265	j_start = jts
	266	j_end = MIN(jte,jde-1)
	267
	268	! higher order flux has a 5 or 7 point stencil, so compute
	269	! bounds so we can switch to second order flux close to the boundary
	270
	271	j_start_f = j_start
	272	j_end_f = j_end+1
	273
	274	IF(degrade_ys) then
	275	j_start = MAX(jts,jds+1)
	276	j_start_f = jds+3
	277	ENDIF
	278
	279	IF(degrade_ye) then
	280	j_end = MIN(jte,jde-2)
	281	j_end_f = jde-3
	282	ENDIF
	283
	284	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	285
	286	! compute fluxes, 5th or 6th order
	287
	288	jp1 = 2
	289	jp0 = 1
	290
	291	j_loop_y_flux_6 : DO j = j_start, j_end+1
	292
	293	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	294
	295	DO k=kts,ktf
	296	DO i = i_start, i_end
	297	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	298	fqy( i, k, jp1 ) = vel*flux6( &
	299	u(i,k,j-3), u(i,k,j-2), u(i,k,j-1), &
	300	u(i,k,j ), u(i,k,j+1), u(i,k,j+2), vel )
	301	ENDDO
	302	ENDDO
	303
	304	! we must be close to some boundary where we need to reduce the order of the stencil
	305
	306	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	307
	308	DO k=kts,ktf
	309	DO i = i_start, i_end
	310	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	311	*(u(i,k,j)+u(i,k,j-1))
	312	ENDDO
	313	ENDDO
	314
	315	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	316
	317	DO k=kts,ktf
	318	DO i = i_start, i_end
	319	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	320	fqy( i, k, jp1 ) = vel*flux4( &
	321	u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
	322	ENDDO
	323	ENDDO
	324
	325	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	326
	327	DO k=kts,ktf
	328	DO i = i_start, i_end
	329	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	330	*(u(i,k,j)+u(i,k,j-1))
	331	ENDDO
	332	ENDDO
	333
	334	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	335
	336	DO k=kts,ktf
	337	DO i = i_start, i_end
	338	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	339	fqy( i, k, jp1 ) = vel*flux4( &
	340	u(i,k,j-2),u(i,k,j-1), &
	341	u(i,k,j),u(i,k,j+1),vel )
	342	ENDDO
	343	ENDDO
	344
	345	END IF
	346
	347	!stopped
	348
	349	! y flux-divergence into tendency
	350
	351	! Comments for polar boundary condition
	352	! Flow is only from one side for points next to poles
	353	! S. pole at j=jds, N. pole at j=jde for v-stagger points
	354	! Tendencies affected are held at j=jds and j=jde-1 (non-stagger)
	355	! jp0 will always hold the flux from the south, and
	356	! jp1 will hold the flux from the north.
	357	!
	358	! When j=jds+1 we are 1 in from S. pole, and jp1 contains fqy(jds+1), jp0 has fqy(jds)
	359	! tendency(j-1) = - mx/dy * (u rho v (jds+1)/mx - u rho v (jds)/mx)
	360	! v(jds) = 0
	361	! tendency(j-1) = - mx/dy * (u rho v (jds+1)/mx) = - mx/dy * fqy(jp1)
	362	!
	363	! When j=jde-1 we are 1 in from N. pole, and jp1 contains fqy(jde-1), jp0 has fqy(jde-2)
	364	! tendency(j-1) = - mx/dy * (u rho v (jde)/mx - u rho v (jde-1)/mx)
	365	! v(jde) = 0
	366	! tendency(j-1) = + mx/dy * (u rho v (jde-1)/mx) = + mx/dy * fqy(jp0)
	367
	368	! (j > j_start) will miss the u(,,jds) tendency
	369	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	370	DO k=kts,ktf
	371	DO i = i_start, i_end
	372	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	373	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	374	END DO
	375	END DO
	376	! This would be seen by (j > j_start) but we need to zero out the NP tendency
	377	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	378	DO k=kts,ktf
	379	DO i = i_start, i_end
	380	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	381	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	382	END DO
	383	END DO
	384	ELSE ! normal code
	385
	386	IF(j > j_start) THEN
	387
	388	DO k=kts,ktf
	389	DO i = i_start, i_end
	390	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	391	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	392	ENDDO
	393	ENDDO
	394
	395	ENDIF
	396
	397	END IF
	398
	399
	400	jtmp = jp1
	401	jp1 = jp0
	402	jp0 = jtmp
	403
	404	ENDDO j_loop_y_flux_6
	405
	406	! next, x - flux divergence
	407
	408	i_start = its
	409	i_end = ite
	410
	411	j_start = jts
	412	j_end = MIN(jte,jde-1)
	413
	414	! higher order flux has a 5 or 7 point stencil, so compute
	415	! bounds so we can switch to second order flux close to the boundary
	416
	417	i_start_f = i_start
	418	i_end_f = i_end+1
	419
	420	IF(degrade_xs) then
	421	i_start = MAX(ids+1,its)
	422	i_start_f = ids+3
	423	ENDIF
	424
	425	IF(degrade_xe) then
	426	i_end = MIN(ide-1,ite)
	427	i_end_f = ide-2
	428	ENDIF
	429
	430	! compute fluxes
	431
	432	DO j = j_start, j_end
	433
	434	! 5th or 6th order flux
	435
	436	DO k=kts,ktf
	437	DO i = i_start_f, i_end_f
	438	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	439	fqx( i,k ) = vel*flux6( u(i-3,k,j), u(i-2,k,j), &
	440	u(i-1,k,j), u(i ,k,j), &
	441	u(i+1,k,j), u(i+2,k,j), &
	442	vel )
	443	ENDDO
	444	ENDDO
	445
	446	! lower order fluxes close to boundaries (if not periodic or symmetric)
	447	! specified uses upstream normal wind at boundaries
	448
	449	IF( degrade_xs ) THEN
	450
	451	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	452	i = ids+1
	453	DO k=kts,ktf
	454	ub = u(i-1,k,j)
	455	IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
	456	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	457	*(u(i,k,j)+ub)
	458	ENDDO
	459	END IF
	460
	461	i = ids+2
	462	DO k=kts,ktf
	463	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	464	fqx( i, k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j), &
	465	u(i ,k,j), u(i+1,k,j), &
	466	vel )
	467	ENDDO
	468
	469	ENDIF
	470
	471	IF( degrade_xe ) THEN
	472
	473	IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
	474	i = ide
	475	DO k=kts,ktf
	476	ub = u(i,k,j)
	477	IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
	478	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	479	*(u(i-1,k,j)+ub)
	480	ENDDO
	481	ENDIF
	482
	483	DO k=kts,ktf
	484	i = ide-1
	485	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	486	fqx( i,k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j), &
	487	u(i ,k,j), u(i+1,k,j), &
	488	vel )
	489	ENDDO
	490
	491	ENDIF
	492
	493	! x flux-divergence into tendency
	494
	495	DO k=kts,ktf
	496	DO i = i_start, i_end
	497	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	498	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	499	ENDDO
	500	ENDDO
	501
	502	ENDDO
	503
	504	ELSE IF( horz_order == 5 ) THEN
	505
	506	! 5th order horizontal flux calculation
	507	! This code is EXACTLY the same as the 6th order code
	508	! EXCEPT the 5th order and 3rd operators are used in
	509	! place of the 6th and 4th order operators
	510
	511	! determine boundary mods for flux operators
	512	! We degrade the flux operators from 3rd/4th order
	513	! to second order one gridpoint in from the boundaries for
	514	! all boundary conditions except periodic and symmetry - these
	515	! conditions have boundary zone data fill for correct application
	516	! of the higher order flux stencils
	517
	518	degrade_xs = .true.
	519	degrade_xe = .true.
	520	degrade_ys = .true.
	521	degrade_ye = .true.
	522
	523	IF( config_flags%periodic_x .or. &
	524	config_flags%symmetric_xs .or. &
	525	(its > ids+2) ) degrade_xs = .false.
	526	IF( config_flags%periodic_x .or. &
	527	config_flags%symmetric_xe .or. &
	528	(ite < ide-2) ) degrade_xe = .false.
	529	IF( config_flags%periodic_y .or. &
	530	config_flags%symmetric_ys .or. &
	531	(jts > jds+2) ) degrade_ys = .false.
	532	IF( config_flags%periodic_y .or. &
	533	config_flags%symmetric_ye .or. &
	534	(jte < jde-3) ) degrade_ye = .false.
	535
	536	!--------------- y - advection first
	537
	538	i_start = its
	539	i_end = ite
	540	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	541	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite)
	542	IF ( config_flags%periodic_x ) i_start = its
	543	IF ( config_flags%periodic_x ) i_end = ite
	544
	545	j_start = jts
	546	j_end = MIN(jte,jde-1)
	547
	548	! higher order flux has a 5 or 7 point stencil, so compute
	549	! bounds so we can switch to second order flux close to the boundary
	550
	551	j_start_f = j_start
	552	j_end_f = j_end+1
	553
	554	IF(degrade_ys) then
	555	j_start = MAX(jts,jds+1)
	556	j_start_f = jds+3
	557	ENDIF
	558
	559	IF(degrade_ye) then
	560	j_end = MIN(jte,jde-2)
	561	j_end_f = jde-3
	562	ENDIF
	563
	564	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	565
	566	! compute fluxes, 5th or 6th order
	567
	568	jp1 = 2
	569	jp0 = 1
	570
	571	j_loop_y_flux_5 : DO j = j_start, j_end+1
	572
	573	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	574
	575	DO k=kts,ktf
	576	DO i = i_start, i_end
	577	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	578	fqy( i, k, jp1 ) = vel*flux5( &
	579	u(i,k,j-3), u(i,k,j-2), u(i,k,j-1), &
	580	u(i,k,j ), u(i,k,j+1), u(i,k,j+2), vel )
	581	ENDDO
	582	ENDDO
	583
	584	! we must be close to some boundary where we need to reduce the order of the stencil
	585
	586	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	587
	588	DO k=kts,ktf
	589	DO i = i_start, i_end
	590	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	591	*(u(i,k,j)+u(i,k,j-1))
	592	ENDDO
	593	ENDDO
	594
	595	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	596
	597	DO k=kts,ktf
	598	DO i = i_start, i_end
	599	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	600	fqy( i, k, jp1 ) = vel*flux3( &
	601	u(i,k,j-2),u(i,k,j-1), u(i,k,j),u(i,k,j+1),vel )
	602	ENDDO
	603	ENDDO
	604
	605	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	606
	607	DO k=kts,ktf
	608	DO i = i_start, i_end
	609	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	610	*(u(i,k,j)+u(i,k,j-1))
	611	ENDDO
	612	ENDDO
	613
	614	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	615
	616	DO k=kts,ktf
	617	DO i = i_start, i_end
	618	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	619	fqy( i, k, jp1 ) = vel*flux3( &
	620	u(i,k,j-2),u(i,k,j-1), &
	621	u(i,k,j),u(i,k,j+1),vel )
	622	ENDDO
	623	ENDDO
	624
	625	END IF
	626
	627	! y flux-divergence into tendency
	628
	629	! (j > j_start) will miss the u(,,jds) tendency
	630	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	631	DO k=kts,ktf
	632	DO i = i_start, i_end
	633	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	634	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	635	END DO
	636	END DO
	637	! This would be seen by (j > j_start) but we need to zero out the NP tendency
	638	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	639	DO k=kts,ktf
	640	DO i = i_start, i_end
	641	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	642	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	643	END DO
	644	END DO
	645	ELSE ! normal code
	646
	647	IF(j > j_start) THEN
	648
	649	DO k=kts,ktf
	650	DO i = i_start, i_end
	651	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	652	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	653	ENDDO
	654	ENDDO
	655
	656	ENDIF
	657
	658	END IF
	659
	660
	661	jtmp = jp1
	662	jp1 = jp0
	663	jp0 = jtmp
	664
	665	ENDDO j_loop_y_flux_5
	666
	667	! next, x - flux divergence
	668
	669	i_start = its
	670	i_end = ite
	671
	672	j_start = jts
	673	j_end = MIN(jte,jde-1)
	674
	675	! higher order flux has a 5 or 7 point stencil, so compute
	676	! bounds so we can switch to second order flux close to the boundary
	677
	678	i_start_f = i_start
	679	i_end_f = i_end+1
	680
	681	IF(degrade_xs) then
	682	i_start = MAX(ids+1,its)
	683	i_start_f = ids+3
	684	ENDIF
	685
	686	IF(degrade_xe) then
	687	i_end = MIN(ide-1,ite)
	688	i_end_f = ide-2
	689	ENDIF
	690
	691	! compute fluxes
	692
	693	DO j = j_start, j_end
	694
	695	! 5th or 6th order flux
	696
	697	DO k=kts,ktf
	698	DO i = i_start_f, i_end_f
	699	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	700	fqx( i,k ) = vel*flux5( u(i-3,k,j), u(i-2,k,j), &
	701	u(i-1,k,j), u(i ,k,j), &
	702	u(i+1,k,j), u(i+2,k,j), &
	703	vel )
	704	ENDDO
	705	ENDDO
	706
	707	! lower order fluxes close to boundaries (if not periodic or symmetric)
	708	! specified uses upstream normal wind at boundaries
	709
	710	IF( degrade_xs ) THEN
	711
	712	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	713	i = ids+1
	714	DO k=kts,ktf
	715	ub = u(i-1,k,j)
	716	IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
	717	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	718	*(u(i,k,j)+ub)
	719	ENDDO
	720	END IF
	721
	722	i = ids+2
	723	DO k=kts,ktf
	724	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	725	fqx( i, k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j), &
	726	u(i ,k,j), u(i+1,k,j), &
	727	vel )
	728	ENDDO
	729
	730	ENDIF
	731
	732	IF( degrade_xe ) THEN
	733
	734	IF( i_end == ide-1 ) THEN ! second order flux next to the boundary
	735	i = ide
	736	DO k=kts,ktf
	737	ub = u(i,k,j)
	738	IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
	739	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	740	*(u(i-1,k,j)+ub)
	741	ENDDO
	742	ENDIF
	743
	744	DO k=kts,ktf
	745	i = ide-1
	746	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	747	fqx( i,k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j), &
	748	u(i ,k,j), u(i+1,k,j), &
	749	vel )
	750	ENDDO
	751
	752	ENDIF
	753
	754	! x flux-divergence into tendency
	755
	756	DO k=kts,ktf
	757	DO i = i_start, i_end
	758	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	759	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	760	ENDDO
	761	ENDDO
	762
	763	ENDDO
	764
	765	ELSE IF( horz_order == 4 ) THEN
	766
	767	! determine boundary mods for flux operators
	768	! We degrade the flux operators from 3rd/4th order
	769	! to second order one gridpoint in from the boundaries for
	770	! all boundary conditions except periodic and symmetry - these
	771	! conditions have boundary zone data fill for correct application
	772	! of the higher order flux stencils
	773
	774	degrade_xs = .true.
	775	degrade_xe = .true.
	776	degrade_ys = .true.
	777	degrade_ye = .true.
	778
	779	IF( config_flags%periodic_x .or. &
	780	config_flags%symmetric_xs .or. &
	781	(its > ids+1) ) degrade_xs = .false.
	782	IF( config_flags%periodic_x .or. &
	783	config_flags%symmetric_xe .or. &
	784	(ite < ide-1) ) degrade_xe = .false.
	785	IF( config_flags%periodic_y .or. &
	786	config_flags%symmetric_ys .or. &
	787	(jts > jds+1) ) degrade_ys = .false.
	788	IF( config_flags%periodic_y .or. &
	789	config_flags%symmetric_ye .or. &
	790	(jte < jde-2) ) degrade_ye = .false.
	791
	792	!--------------- x - advection first
	793
	794	i_start = its
	795	i_end = ite
	796	j_start = jts
	797	j_end = MIN(jte,jde-1)
	798
	799	! 3rd or 4th order flux has a 5 point stencil, so compute
	800	! bounds so we can switch to second order flux close to the boundary
	801
	802	i_start_f = i_start
	803	i_end_f = i_end+1
	804
	805	IF(degrade_xs) then
	806	i_start = ids+1
	807	i_start_f = i_start+1
	808	ENDIF
	809
	810	IF(degrade_xe) then
	811	i_end = ide-1
	812	i_end_f = ide-1
	813	ENDIF
	814
	815	! compute fluxes
	816
	817	DO j = j_start, j_end
	818
	819	DO k=kts,ktf
	820	DO i = i_start_f, i_end_f
	821	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	822	fqx( i, k ) = vel*flux4( u(i-2,k,j), u(i-1,k,j), &
	823	u(i ,k,j), u(i+1,k,j), vel )
	824	ENDDO
	825	ENDDO
	826
	827	! second order flux close to boundaries (if not periodic or symmetric)
	828	! specified uses upstream normal wind at boundaries
	829
	830	IF( degrade_xs ) THEN
	831	i = i_start
	832	DO k=kts,ktf
	833	ub = u(i-1,k,j)
	834	IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
	835	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	836	*(u(i,k,j)+ub)
	837	ENDDO
	838	ENDIF
	839
	840	IF( degrade_xe ) THEN
	841	i = i_end+1
	842	DO k=kts,ktf
	843	ub = u(i,k,j)
	844	IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
	845	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	846	*(u(i-1,k,j)+ub)
	847	ENDDO
	848	ENDIF
	849
	850	! x flux-divergence into tendency
	851
	852	DO k=kts,ktf
	853	DO i = i_start, i_end
	854	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	855	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	856	ENDDO
	857	ENDDO
	858
	859	ENDDO
	860
	861	! y flux divergence
	862
	863	i_start = its
	864	i_end = ite
	865	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	866	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite)
	867	IF ( config_flags%periodic_x ) i_start = its
	868	IF ( config_flags%periodic_x ) i_end = ite
	869
	870	j_start = jts
	871	j_end = MIN(jte,jde-1)
	872
	873	! 3rd or 4th order flux has a 5 point stencil, so compute
	874	! bounds so we can switch to second order flux close to the boundary
	875
	876	j_start_f = j_start
	877	j_end_f = j_end+1
	878
	879	!CJM these may not work with tiling because they define j_start and end in terms of domain dim
	880	IF(degrade_ys) then
	881	j_start = jds+1
	882	j_start_f = j_start+1
	883	ENDIF
	884
	885	IF(degrade_ye) then
	886	j_end = jde-2
	887	j_end_f = jde-2
	888	ENDIF
	889
	890	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	891
	892	! j flux loop for v flux of u momentum
	893
	894	jp1 = 2
	895	jp0 = 1
	896
	897	DO j = j_start, j_end+1
	898
	899	IF ( (j < j_start_f) .and. degrade_ys) THEN
	900	DO k = kts, ktf
	901	DO i = i_start, i_end
	902	fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start)) &
	903	*(u(i,k,j_start)+u(i,k,j_start-1))
	904	ENDDO
	905	ENDDO
	906	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	907	DO k = kts, ktf
	908	DO i = i_start, i_end
	909	! Assumes j>j_end_f is ONLY j_end+1 ...
	910	! fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1)) &
	911	! *(u(i,k,j_end+1)+u(i,k,j_end))
	912	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	913	*(u(i,k,j)+u(i,k,j-1))
	914	ENDDO
	915	ENDDO
	916	ELSE
	917	! 3rd or 4th order flux
	918	DO k = kts, ktf
	919	DO i = i_start, i_end
	920	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	921	fqy( i, k, jp1 ) = vel*flux4( u(i,k,j-2), u(i,k,j-1), &
	922	u(i,k,j ), u(i,k,j+1), &
	923	vel )
	924	ENDDO
	925	ENDDO
	926
	927	END IF
	928
	929	! y flux-divergence into tendency
	930
	931	! (j > j_start) will miss the u(,,jds) tendency
	932	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	933	DO k=kts,ktf
	934	DO i = i_start, i_end
	935	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	936	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	937	END DO
	938	END DO
	939	! This would be seen by (j > j_start) but we need to zero out the NP tendency
	940	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	941	DO k=kts,ktf
	942	DO i = i_start, i_end
	943	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	944	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	945	END DO
	946	END DO
	947	ELSE ! normal code
	948
	949	IF (j > j_start) THEN
	950
	951	DO k=kts,ktf
	952	DO i = i_start, i_end
	953	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	954	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	955	ENDDO
	956	ENDDO
	957
	958	END IF
	959
	960	END IF
	961
	962	jtmp = jp1
	963	jp1 = jp0
	964	jp0 = jtmp
	965
	966	ENDDO
	967
	968	ELSE IF ( horz_order == 3 ) THEN
	969
	970	! As with the 5th and 6th order flux chioces, the 3rd and 4th order
	971	! code is EXACTLY the same EXCEPT for the flux operator.
	972
	973	! determine boundary mods for flux operators
	974	! We degrade the flux operators from 3rd/4th order
	975	! to second order one gridpoint in from the boundaries for
	976	! all boundary conditions except periodic and symmetry - these
	977	! conditions have boundary zone data fill for correct application
	978	! of the higher order flux stencils
	979
	980	degrade_xs = .true.
	981	degrade_xe = .true.
	982	degrade_ys = .true.
	983	degrade_ye = .true.
	984
	985	IF( config_flags%periodic_x .or. &
	986	config_flags%symmetric_xs .or. &
	987	(its > ids+1) ) degrade_xs = .false.
	988	IF( config_flags%periodic_x .or. &
	989	config_flags%symmetric_xe .or. &
	990	(ite < ide-1) ) degrade_xe = .false.
	991	IF( config_flags%periodic_y .or. &
	992	config_flags%symmetric_ys .or. &
	993	(jts > jds+1) ) degrade_ys = .false.
	994	IF( config_flags%periodic_y .or. &
	995	config_flags%symmetric_ye .or. &
	996	(jte < jde-2) ) degrade_ye = .false.
	997
	998	!--------------- x - advection first
	999
	1000	i_start = its
	1001	i_end = ite
	1002	j_start = jts
	1003	j_end = MIN(jte,jde-1)
	1004
	1005	! 3rd or 4th order flux has a 5 point stencil, so compute
	1006	! bounds so we can switch to second order flux close to the boundary
	1007
	1008	i_start_f = i_start
	1009	i_end_f = i_end+1
	1010
	1011	IF(degrade_xs) then
	1012	i_start = ids+1
	1013	i_start_f = i_start+1
	1014	ENDIF
	1015
	1016	IF(degrade_xe) then
	1017	i_end = ide-1
	1018	i_end_f = ide-1
	1019	ENDIF
	1020
	1021	! compute fluxes
	1022
	1023	DO j = j_start, j_end
	1024
	1025	DO k=kts,ktf
	1026	DO i = i_start_f, i_end_f
	1027	vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
	1028	fqx( i, k ) = vel*flux3( u(i-2,k,j), u(i-1,k,j), &
	1029	u(i ,k,j), u(i+1,k,j), vel )
	1030	ENDDO
	1031	ENDDO
	1032
	1033	! second order flux close to boundaries (if not periodic or symmetric)
	1034	! specified uses upstream normal wind at boundaries
	1035
	1036	IF( degrade_xs ) THEN
	1037	i = i_start
	1038	DO k=kts,ktf
	1039	ub = u(i-1,k,j)
	1040	IF (specified .AND. u(i,k,j) .LT. 0.)ub = u(i,k,j)
	1041	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	1042	*(u(i,k,j)+ub)
	1043	ENDDO
	1044	ENDIF
	1045
	1046	IF( degrade_xe ) THEN
	1047	i = i_end+1
	1048	DO k=kts,ktf
	1049	ub = u(i,k,j)
	1050	IF (specified .AND. u(i-1,k,j) .GT. 0.)ub = u(i-1,k,j)
	1051	fqx(i, k) = 0.25*(ru(i,k,j)+ru(i-1,k,j)) &
	1052	*(u(i-1,k,j)+ub)
	1053	ENDDO
	1054	ENDIF
	1055
	1056	! x flux-divergence into tendency
	1057
	1058	DO k=kts,ktf
	1059	DO i = i_start, i_end
	1060	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	1061	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	1062	ENDDO
	1063	ENDDO
	1064	ENDDO
	1065
	1066	! y flux divergence
	1067
	1068	i_start = its
	1069	i_end = ite
	1070	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	1071	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite)
	1072	IF ( config_flags%periodic_x ) i_start = its
	1073	IF ( config_flags%periodic_x ) i_end = ite
	1074
	1075	j_start = jts
	1076	j_end = MIN(jte,jde-1)
	1077
	1078	! 3rd or 4th order flux has a 5 point stencil, so compute
	1079	! bounds so we can switch to second order flux close to the boundary
	1080
	1081	j_start_f = j_start
	1082	j_end_f = j_end+1
	1083
	1084	!CJM these may not work with tiling because they define j_start and end in terms of domain dim
	1085	IF(degrade_ys) then
	1086	j_start = jds+1
	1087	j_start_f = j_start+1
	1088	ENDIF
	1089
	1090	IF(degrade_ye) then
	1091	j_end = jde-2
	1092	j_end_f = jde-2
	1093	ENDIF
	1094
	1095	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	1096
	1097	! j flux loop for v flux of u momentum
	1098
	1099	jp1 = 2
	1100	jp0 = 1
	1101
	1102	DO j = j_start, j_end+1
	1103
	1104	IF ( (j < j_start_f) .and. degrade_ys) THEN
	1105	DO k = kts, ktf
	1106	DO i = i_start, i_end
	1107	fqy(i, k, jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start)) &
	1108	*(u(i,k,j_start)+u(i,k,j_start-1))
	1109	ENDDO
	1110	ENDDO
	1111	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	1112	DO k = kts, ktf
	1113	DO i = i_start, i_end
	1114	! Assumes j>j_end_f is ONLY j_end+1 ...
	1115	! fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1)) &
	1116	! *(u(i,k,j_end+1)+u(i,k,j_end))
	1117	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j)) &
	1118	*(u(i,k,j)+u(i,k,j-1))
	1119	ENDDO
	1120	ENDDO
	1121	ELSE
	1122	! 3rd or 4th order flux
	1123	DO k = kts, ktf
	1124	DO i = i_start, i_end
	1125	vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
	1126	fqy( i, k, jp1 ) = vel*flux3( u(i,k,j-2), u(i,k,j-1), &
	1127	u(i,k,j ), u(i,k,j+1), &
	1128	vel )
	1129	ENDDO
	1130	ENDDO
	1131
	1132	END IF
	1133
	1134	! y flux-divergence into tendency
	1135
	1136	! (j > j_start) will miss the u(,,jds) tendency
	1137	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	1138	DO k=kts,ktf
	1139	DO i = i_start, i_end
	1140	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	1141	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	1142	END DO
	1143	END DO
	1144	! This would be seen by (j > j_start) but we need to zero out the NP tendency
	1145	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	1146	DO k=kts,ktf
	1147	DO i = i_start, i_end
	1148	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	1149	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	1150	END DO
	1151	END DO
	1152	ELSE ! normal code
	1153
	1154	IF (j > j_start) THEN
	1155
	1156	DO k=kts,ktf
	1157	DO i = i_start, i_end
	1158	mrdy=msfux(i,j-1)*rdy ! ADT eqn 44, 2nd term on RHS
	1159	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	1160	ENDDO
	1161	ENDDO
	1162
	1163	END IF
	1164
	1165	END IF
	1166
	1167	jtmp = jp1
	1168	jp1 = jp0
	1169	jp0 = jtmp
	1170
	1171	ENDDO
	1172
	1173	ELSE IF ( horz_order == 2 ) THEN
	1174
	1175	i_start = its
	1176	i_end = ite
	1177	j_start = jts
	1178	j_end = MIN(jte,jde-1)
	1179
	1180	IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
	1181	IF ( config_flags%open_xe ) i_end = MIN(ide-1,ite)
	1182	IF ( specified ) i_start = MAX(ids+2,its)
	1183	IF ( specified ) i_end = MIN(ide-2,ite)
	1184	IF ( config_flags%periodic_x ) i_start = its
	1185	IF ( config_flags%periodic_x ) i_end = ite
	1186
	1187	DO j = j_start, j_end
	1188	DO k=kts,ktf
	1189	DO i = i_start, i_end
	1190	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	1191	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
	1192	((ru(i+1,k,j)+ru(i,k,j))(u(i+1,k,j)+u(i,k,j)) &
	1193	-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
	1194	ENDDO
	1195	ENDDO
	1196	ENDDO
	1197
	1198	IF ( specified .AND. its .LE. ids+1 .AND. .NOT. config_flags%periodic_x ) THEN
	1199	DO j = j_start, j_end
	1200	DO k=kts,ktf
	1201	i = ids+1
	1202	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	1203	ub = u(i-1,k,j)
	1204	IF (u(i,k,j) .LT. 0.) ub = u(i,k,j)
	1205	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
	1206	((ru(i+1,k,j)+ru(i,k,j))(u(i+1,k,j)+u(i,k,j)) &
	1207	-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub))
	1208	ENDDO
	1209	ENDDO
	1210	ENDIF
	1211	IF ( specified .AND. ite .GE. ide-1 .AND. .NOT. config_flags%periodic_x ) THEN
	1212	DO j = j_start, j_end
	1213	DO k=kts,ktf
	1214	i = ide-1
	1215	mrdx=msfux(i,j)*rdx ! ADT eqn 44, 1st term on RHS
	1216	ub = u(i+1,k,j)
	1217	IF (u(i,k,j) .GT. 0.) ub = u(i,k,j)
	1218	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
	1219	((ru(i+1,k,j)+ru(i,k,j))(ub+u(i,k,j)) &
	1220	-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,k,j)))
	1221	ENDDO
	1222	ENDDO
	1223	ENDIF
	1224
	1225	IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)
	1226	IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte)
	1227
	1228	DO j = j_start, j_end
	1229	DO k=kts,ktf
	1230	DO i = i_start, i_end
	1231	mrdy=msfux(i,j)*rdy ! ADT eqn 44, 1st term on RHS
	1232	! Comments for polar boundary condition
	1233	! Flow is only from one side for points next to poles
	1234	IF ( (config_flags%polar) .AND. (j == jds) ) THEN
	1235	tendency(i,k,j)=tendency(i,k,j)-mrdy*0.25 &
	1236	(rv(i,k,j+1)+rv(i-1,k,j+1))(u(i,k,j+1)+u(i,k,j))
	1237	ELSE IF ( (config_flags%polar) .AND. (j == jde-1) ) THEN
	1238	tendency(i,k,j)=tendency(i,k,j)+mrdy*0.25 &
	1239	(rv(i,k,j)+rv(i-1,k,j))(u(i,k,j)+u(i,k,j-1))
	1240	ELSE ! Normal code
	1241	tendency(i,k,j)=tendency(i,k,j)-mrdy*0.25 &
	1242	((rv(i,k,j+1)+rv(i-1,k,j+1))(u(i,k,j+1)+u(i,k,j)) &
	1243	-(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1)))
	1244	ENDIF
	1245	ENDDO
	1246	ENDDO
	1247	ENDDO
	1248
	1249	ELSE IF ( horz_order == 0 ) THEN
	1250
	1251	! Just in case we want to turn horizontal advection off, we can do it
	1252
	1253	ELSE
	1254
	1255	WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a: h_order not known ',horz_order
	1256	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	1257
	1258	ENDIF horizontal_order_test
	1259
	1260	! radiative lateral boundary condition in x for normal velocity (u)
	1261
	1262	IF ( (config_flags%open_xs) .and. its == ids ) THEN
	1263
	1264	j_start = jts
	1265	j_end = MIN(jte,jde-1)
	1266
	1267	DO j = j_start, j_end
	1268	DO k = kts, ktf
	1269	ub = MIN(ru(its,k,j)-cb*mut(its,j), 0.)
	1270	tendency(its,k,j) = tendency(its,k,j) &
	1271	- rdxub(u_old(its+1,k,j) - u_old(its,k,j))
	1272	ENDDO
	1273	ENDDO
	1274
	1275	ENDIF
	1276
	1277	IF ( (config_flags%open_xe) .and. ite == ide ) THEN
	1278
	1279	j_start = jts
	1280	j_end = MIN(jte,jde-1)
	1281
	1282	DO j = j_start, j_end
	1283	DO k = kts, ktf
	1284	ub = MAX(ru(ite,k,j)+cb*mut(ite-1,j), 0.)
	1285	tendency(ite,k,j) = tendency(ite,k,j) &
	1286	- rdxub(u_old(ite,k,j) - u_old(ite-1,k,j))
	1287	ENDDO
	1288	ENDDO
	1289
	1290	ENDIF
	1291
	1292	! pick up the rest of the horizontal radiation boundary conditions.
	1293	! (these are the computations that don't require 'cb')
	1294	! first, set to index ranges
	1295
	1296	i_start = its
	1297	i_end = MIN(ite,ide)
	1298	imin = ids
	1299	imax = ide-1
	1300
	1301	IF (config_flags%open_xs) THEN
	1302	i_start = MAX(ids+1, its)
	1303	imin = ids
	1304	ENDIF
	1305	IF (config_flags%open_xe) THEN
	1306	i_end = MIN(ite,ide-1)
	1307	imax = ide-1
	1308	ENDIF
	1309
	1310	IF( (config_flags%open_ys) .and. (jts == jds)) THEN
	1311
	1312	DO i = i_start, i_end
	1313
	1314	mrdy=msfux(i,jts)*rdy ! ADT eqn 44, 2nd term on RHS
	1315	ip = MIN( imax, i )
	1316	im = MAX( imin, i-1 )
	1317
	1318	DO k=kts,ktf
	1319
	1320	vw = 0.5*(rv(ip,k,jts)+rv(im,k,jts))
	1321	vb = MIN( vw, 0. )
	1322	dvm = rv(ip,k,jts+1)-rv(ip,k,jts)
	1323	dvp = rv(im,k,jts+1)-rv(im,k,jts)
	1324	tendency(i,k,jts)=tendency(i,k,jts)-mrdy*( &
	1325	vb*(u_old(i,k,jts+1)-u_old(i,k,jts)) &
	1326	+0.5u(i,k,jts)(dvm+dvp))
	1327	ENDDO
	1328	ENDDO
	1329
	1330	ENDIF
	1331
	1332	IF( (config_flags%open_ye) .and. (jte == jde)) THEN
	1333
	1334	DO i = i_start, i_end
	1335
	1336	mrdy=msfux(i,jte-1)*rdy ! ADT eqn 44, 2nd term on RHS
	1337	ip = MIN( imax, i )
	1338	im = MAX( imin, i-1 )
	1339
	1340	DO k=kts,ktf
	1341
	1342	vw = 0.5*(rv(ip,k,jte)+rv(im,k,jte))
	1343	vb = MAX( vw, 0. )
	1344	dvm = rv(ip,k,jte)-rv(ip,k,jte-1)
	1345	dvp = rv(im,k,jte)-rv(im,k,jte-1)
	1346	tendency(i,k,jte-1)=tendency(i,k,jte-1)-mrdy*( &
	1347	vb*(u_old(i,k,jte-1)-u_old(i,k,jte-2)) &
	1348	+0.5u(i,k,jte-1)(dvm+dvp))
	1349	ENDDO
	1350	ENDDO
	1351
	1352	ENDIF
	1353
	1354	!-------------------- vertical advection
	1355	! ADT eqn 44 has 3rd term on RHS = -(1/my) partial d/dz (rho u w)
	1356	! Here we have: - partial d/dz (u*rom) = - partial d/dz (u rho w / my)
	1357	! Since 'my' (map scale factor in y-direction) isn't a function of z,
	1358	! this is what we need, so leave unchanged in advect_u
	1359
	1360	i_start = its
	1361	i_end = ite
	1362	j_start = jts
	1363	j_end = min(jte,jde-1)
	1364
	1365	! IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
	1366	! IF ( config_flags%open_xe ) i_end = MIN(ide-1,ite)
	1367
	1368	IF ( config_flags%open_ys .or. specified ) i_start = MAX(ids+1,its)
	1369	IF ( config_flags%open_ye .or. specified ) i_end = MIN(ide-1,ite)
	1370	IF ( config_flags%periodic_x ) i_start = its
	1371	IF ( config_flags%periodic_x ) i_end = ite
	1372
	1373	DO i = i_start, i_end
	1374	vflux(i,kts)=0.
	1375	vflux(i,kte)=0.
	1376	ENDDO
	1377
	1378	vert_order_test : IF (vert_order == 6) THEN
	1379
	1380	DO j = j_start, j_end
	1381
	1382	DO k=kts+3,ktf-2
	1383	DO i = i_start, i_end
	1384	vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
	1385	vflux(i,k) = vel*flux6( &
	1386	u(i,k-3,j), u(i,k-2,j), u(i,k-1,j), &
	1387	u(i,k ,j), u(i,k+1,j), u(i,k+2,j), -vel )
	1388	ENDDO
	1389	ENDDO
	1390
	1391	DO i = i_start, i_end
	1392
	1393	k=kts+1
	1394	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1395	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1396	k = kts+2
	1397	vel=0.5*(rom(i,k,j)+rom(i-1,k,j))
	1398	vflux(i,k) = vel*flux4( &
	1399	u(i,k-2,j), u(i,k-1,j), &
	1400	u(i,k ,j), u(i,k+1,j), -vel )
	1401	k = ktf-1
	1402	vel=0.5*(rom(i,k,j)+rom(i-1,k,j))
	1403	vflux(i,k) = vel*flux4( &
	1404	u(i,k-2,j), u(i,k-1,j), &
	1405	u(i,k ,j), u(i,k+1,j), -vel )
	1406	k=ktf
	1407	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1408	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1409
	1410	ENDDO
	1411	DO k=kts,ktf
	1412	DO i = i_start, i_end
	1413	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	1414	ENDDO
	1415	ENDDO
	1416	ENDDO
	1417
	1418	ELSE IF (vert_order == 5) THEN
	1419
	1420	DO j = j_start, j_end
	1421
	1422	DO k=kts+3,ktf-2
	1423	DO i = i_start, i_end
	1424	vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
	1425	vflux(i,k) = vel*flux5( &
	1426	u(i,k-3,j), u(i,k-2,j), u(i,k-1,j), &
	1427	u(i,k ,j), u(i,k+1,j), u(i,k+2,j), -vel )
	1428	ENDDO
	1429	ENDDO
	1430
	1431	DO i = i_start, i_end
	1432
	1433	k=kts+1
	1434	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1435	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1436	k = kts+2
	1437	vel=0.5*(rom(i,k,j)+rom(i-1,k,j))
	1438	vflux(i,k) = vel*flux3( &
	1439	u(i,k-2,j), u(i,k-1,j), &
	1440	u(i,k ,j), u(i,k+1,j), -vel )
	1441	k = ktf-1
	1442	vel=0.5*(rom(i,k,j)+rom(i-1,k,j))
	1443	vflux(i,k) = vel*flux3( &
	1444	u(i,k-2,j), u(i,k-1,j), &
	1445	u(i,k ,j), u(i,k+1,j), -vel )
	1446	k=ktf
	1447	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1448	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1449
	1450	ENDDO
	1451	DO k=kts,ktf
	1452	DO i = i_start, i_end
	1453	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	1454	ENDDO
	1455	ENDDO
	1456	ENDDO
	1457
	1458	ELSE IF (vert_order == 4) THEN
	1459
	1460	DO j = j_start, j_end
	1461
	1462	DO k=kts+2,ktf-1
	1463	DO i = i_start, i_end
	1464	vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
	1465	vflux(i,k) = vel*flux4( &
	1466	u(i,k-2,j), u(i,k-1,j), &
	1467	u(i,k ,j), u(i,k+1,j), -vel )
	1468	ENDDO
	1469	ENDDO
	1470
	1471	DO i = i_start, i_end
	1472
	1473	k=kts+1
	1474	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1475	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1476	k=ktf
	1477	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1478	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1479
	1480	ENDDO
	1481	DO k=kts,ktf
	1482	DO i = i_start, i_end
	1483	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	1484	ENDDO
	1485	ENDDO
	1486	ENDDO
	1487
	1488	ELSE IF (vert_order == 3) THEN
	1489
	1490	DO j = j_start, j_end
	1491
	1492	DO k=kts+2,ktf-1
	1493	DO i = i_start, i_end
	1494	vel=0.5*(rom(i-1,k,j)+rom(i,k,j))
	1495	vflux(i,k) = vel*flux3( &
	1496	u(i,k-2,j), u(i,k-1,j), &
	1497	u(i,k ,j), u(i,k+1,j), -vel )
	1498	ENDDO
	1499	ENDDO
	1500
	1501	DO i = i_start, i_end
	1502
	1503	k=kts+1
	1504	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1505	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1506	k=ktf
	1507	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1508	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1509
	1510	ENDDO
	1511	DO k=kts,ktf
	1512	DO i = i_start, i_end
	1513	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	1514	ENDDO
	1515	ENDDO
	1516	ENDDO
	1517
	1518	ELSE IF (vert_order == 2) THEN
	1519
	1520	DO j = j_start, j_end
	1521	DO k=kts+1,ktf
	1522	DO i = i_start, i_end
	1523	vflux(i,k)=0.5*(rom(i,k,j)+rom(i-1,k,j)) &
	1524	(fzm(k)u(i,k,j)+fzp(k)*u(i,k-1,j))
	1525	ENDDO
	1526	ENDDO
	1527
	1528
	1529	DO k=kts,ktf
	1530	DO i = i_start, i_end
	1531	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	1532	ENDDO
	1533	ENDDO
	1534
	1535	ENDDO
	1536
	1537	ELSE
	1538
	1539	WRITE ( wrf_err_message , * ) 'module_advect: advect_u_6a: v_order not known ',vert_order
	1540	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	1541
	1542	ENDIF vert_order_test
	1543
	1544	END SUBROUTINE advect_u
	1545
	1546	!-------------------------------------------------------------------------------
	1547
	1548	SUBROUTINE advect_v ( v, v_old, tendency, &
	1549	ru, rv, rom, &
	1550	mut, time_step, config_flags, &
	1551	msfux, msfuy, msfvx, msfvy, &
	1552	msftx, msfty, &
	1553	fzm, fzp, &
	1554	rdx, rdy, rdzw, &
	1555	ids, ide, jds, jde, kds, kde, &
	1556	ims, ime, jms, jme, kms, kme, &
	1557	its, ite, jts, jte, kts, kte )
	1558
	1559	IMPLICIT NONE
	1560
	1561	! Input data
	1562
	1563	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	1564
	1565	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	1566	ims, ime, jms, jme, kms, kme, &
	1567	its, ite, jts, jte, kts, kte
	1568
	1569	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: v, &
	1570	v_old, &
	1571	ru, &
	1572	rv, &
	1573	rom
	1574
	1575	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
	1576	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	1577
	1578	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	1579	msfuy, &
	1580	msfvx, &
	1581	msfvy, &
	1582	msftx, &
	1583	msfty
	1584
	1585	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	1586	fzp, &
	1587	rdzw
	1588
	1589	REAL , INTENT(IN ) :: rdx, &
	1590	rdy
	1591	INTEGER , INTENT(IN ) :: time_step
	1592
	1593
	1594	! Local data
	1595
	1596	INTEGER :: i, j, k, itf, jtf, ktf
	1597	INTEGER :: i_start, i_end, j_start, j_end
	1598	INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
	1599	INTEGER :: jmin, jmax, jp, jm, imin, imax
	1600
	1601	REAL :: mrdx, mrdy, ub, vb, uw, vw, dup, dum
	1602	REAL , DIMENSION(its:ite, kts:kte) :: vflux
	1603
	1604
	1605	REAL, DIMENSION( its:ite+1, kts:kte ) :: fqx
	1606	REAL, DIMENSION( its:ite, kts:kte, 2 ) :: fqy
	1607
	1608	INTEGER :: horz_order
	1609	INTEGER :: vert_order
	1610
	1611	LOGICAL :: degrade_xs, degrade_ys
	1612	LOGICAL :: degrade_xe, degrade_ye
	1613
	1614	INTEGER :: jp1, jp0, jtmp
	1615
	1616
	1617	! definition of flux operators, 3rd, 4th, 5th or 6th order
	1618
	1619	REAL :: flux3, flux4, flux5, flux6
	1620	REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
	1621
	1622	flux4(q_im2, q_im1, q_i, q_ip1, ua) = &
	1623	( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
	1624
	1625	flux3(q_im2, q_im1, q_i, q_ip1, ua) = &
	1626	flux4(q_im2, q_im1, q_i, q_ip1, ua) + &
	1627	sign(1,time_step)sign(1.,ua)((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
	1628
	1629	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	1630	( 37.(q_i+q_im1) - 8.(q_ip1+q_im2) &
	1631	+(q_ip2+q_im3) )/60.0
	1632
	1633	flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	1634	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) &
	1635	-sign(1,time_step)sign(1.,ua)( &
	1636	(q_ip2-q_im3)-5.(q_ip1-q_im2)+10.(q_i-q_im1) )/60.0
	1637
	1638
	1639
	1640	LOGICAL :: specified
	1641
	1642	specified = .false.
	1643	if(config_flags%specified .or. config_flags%nested) specified = .true.
	1644
	1645	! set order for the advection schemes
	1646
	1647	ktf=MIN(kte,kde-1)
	1648	horz_order = config_flags%h_mom_adv_order
	1649	vert_order = config_flags%v_mom_adv_order
	1650
	1651
	1652	! here is the choice of flux operators
	1653
	1654
	1655	horizontal_order_test : IF( horz_order == 6 ) THEN
	1656
	1657	! determine boundary mods for flux operators
	1658	! We degrade the flux operators from 3rd/4th order
	1659	! to second order one gridpoint in from the boundaries for
	1660	! all boundary conditions except periodic and symmetry - these
	1661	! conditions have boundary zone data fill for correct application
	1662	! of the higher order flux stencils
	1663
	1664	degrade_xs = .true.
	1665	degrade_xe = .true.
	1666	degrade_ys = .true.
	1667	degrade_ye = .true.
	1668
	1669	IF( config_flags%periodic_x .or. &
	1670	config_flags%symmetric_xs .or. &
	1671	(its > ids+2) ) degrade_xs = .false.
	1672	IF( config_flags%periodic_x .or. &
	1673	config_flags%symmetric_xe .or. &
	1674	(ite < ide-3) ) degrade_xe = .false.
	1675	IF( config_flags%periodic_y .or. &
	1676	config_flags%symmetric_ys .or. &
	1677	(jts > jds+2) ) degrade_ys = .false.
	1678	IF( config_flags%periodic_y .or. &
	1679	config_flags%symmetric_ye .or. &
	1680	(jte < jde-2) ) degrade_ye = .false.
	1681
	1682	!--------------- y - advection first
	1683
	1684	ktf=MIN(kte,kde-1)
	1685
	1686	i_start = its
	1687	i_end = MIN(ite,ide-1)
	1688	j_start = jts
	1689	j_end = jte
	1690
	1691	! higher order flux has a 5 or 7 point stencil, so compute
	1692	! bounds so we can switch to second order flux close to the boundary
	1693
	1694	j_start_f = j_start
	1695	j_end_f = j_end+1
	1696
	1697	IF(degrade_ys) then
	1698	j_start = MAX(jts,jds+1)
	1699	j_start_f = jds+3
	1700	ENDIF
	1701
	1702	IF(degrade_ye) then
	1703	j_end = MIN(jte,jde-1)
	1704	j_end_f = jde-2
	1705	ENDIF
	1706
	1707	! compute fluxes, 5th or 6th order
	1708
	1709	jp1 = 2
	1710	jp0 = 1
	1711
	1712	j_loop_y_flux_6 : DO j = j_start, j_end+1
	1713
	1714	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
	1715
	1716	DO k=kts,ktf
	1717	DO i = i_start, i_end
	1718	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	1719	fqy( i, k, jp1 ) = vel*flux6( &
	1720	v(i,k,j-3), v(i,k,j-2), v(i,k,j-1), &
	1721	v(i,k,j ), v(i,k,j+1), v(i,k,j+2), vel )
	1722	ENDDO
	1723	ENDDO
	1724
	1725	! we must be close to some boundary where we need to reduce the order of the stencil
	1726	! specified uses upstream normal wind at boundaries
	1727
	1728	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	1729
	1730	DO k=kts,ktf
	1731	DO i = i_start, i_end
	1732	vb = v(i,k,j-1)
	1733	IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
	1734	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	1735	*(v(i,k,j)+vb)
	1736	ENDDO
	1737	ENDDO
	1738
	1739	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	1740
	1741	DO k=kts,ktf
	1742	DO i = i_start, i_end
	1743	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	1744	fqy( i, k, jp1 ) = vel*flux4( &
	1745	v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
	1746	ENDDO
	1747	ENDDO
	1748
	1749
	1750	ELSE IF ( j == jde ) THEN ! 2nd order flux next to north boundary
	1751
	1752	DO k=kts,ktf
	1753	DO i = i_start, i_end
	1754	vb = v(i,k,j)
	1755	IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
	1756	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	1757	*(vb+v(i,k,j-1))
	1758	ENDDO
	1759	ENDDO
	1760
	1761	ELSE IF ( j == jde-1 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	1762
	1763	DO k=kts,ktf
	1764	DO i = i_start, i_end
	1765	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	1766	fqy( i, k, jp1 ) = vel*flux4( &
	1767	v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
	1768	ENDDO
	1769	ENDDO
	1770
	1771	END IF
	1772
	1773	! y flux-divergence into tendency
	1774
	1775	! Comments on polar boundary conditions
	1776	! No advection over the poles means tendencies (held from jds [S. pole]
	1777	! to jde [N pole], i.e., on v grid) must be zero at poles
	1778	! [tendency(jds) and tendency(jde)=0]
	1779	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	1780	DO k=kts,ktf
	1781	DO i = i_start, i_end
	1782	tendency(i,k,j-1) = 0.
	1783	END DO
	1784	END DO
	1785	! If j_end were set to jde in a special if statement apart from
	1786	! degrade_ye, then we would hit the next conditional. But since
	1787	! we want the tendency to be zero anyway, not looping to jde+1
	1788	! will produce the same effect.
	1789	ELSE IF( config_flags%polar .AND. (j == jde+1) ) THEN
	1790	DO k=kts,ktf
	1791	DO i = i_start, i_end
	1792	tendency(i,k,j-1) = 0.
	1793	END DO
	1794	END DO
	1795	ELSE ! Normal code
	1796
	1797	IF(j > j_start) THEN
	1798
	1799	DO k=kts,ktf
	1800	DO i = i_start, i_end
	1801	mrdy=msfvy(i,j-1)*rdy ! ADT eqn 45, 2nd term on RHS
	1802	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	1803	ENDDO
	1804	ENDDO
	1805
	1806	ENDIF
	1807
	1808	END IF
	1809
	1810	jtmp = jp1
	1811	jp1 = jp0
	1812	jp0 = jtmp
	1813
	1814	ENDDO j_loop_y_flux_6
	1815
	1816	! next, x - flux divergence
	1817
	1818	i_start = its
	1819	i_end = MIN(ite,ide-1)
	1820
	1821	j_start = jts
	1822	j_end = jte
	1823	! Polar boundary conditions are like open or specified
	1824	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	1825	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-1,jte)
	1826
	1827	! higher order flux has a 5 or 7 point stencil, so compute
	1828	! bounds so we can switch to second order flux close to the boundary
	1829
	1830	i_start_f = i_start
	1831	i_end_f = i_end+1
	1832
	1833	IF(degrade_xs) then
	1834	i_start = MAX(ids+1,its)
	1835	i_start_f = i_start+2
	1836	ENDIF
	1837
	1838	IF(degrade_xe) then
	1839	i_end = MIN(ide-2,ite)
	1840	i_end_f = ide-3
	1841	ENDIF
	1842
	1843	! compute fluxes
	1844
	1845	DO j = j_start, j_end
	1846
	1847	! 5th or 6th order flux
	1848
	1849	DO k=kts,ktf
	1850	DO i = i_start_f, i_end_f
	1851	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	1852	fqx( i, k ) = vel*flux6( v(i-3,k,j), v(i-2,k,j), &
	1853	v(i-1,k,j), v(i ,k,j), &
	1854	v(i+1,k,j), v(i+2,k,j), &
	1855	vel )
	1856	ENDDO
	1857	ENDDO
	1858
	1859	! lower order fluxes close to boundaries (if not periodic or symmetric)
	1860
	1861	IF( degrade_xs ) THEN
	1862
	1863	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	1864	i = ids+1
	1865	DO k=kts,ktf
	1866	fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
	1867	*(v(i,k,j)+v(i-1,k,j))
	1868	ENDDO
	1869	ENDIF
	1870
	1871	i = ids+2
	1872	DO k=kts,ktf
	1873	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	1874	fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j), &
	1875	v(i ,k,j), v(i+1,k,j), &
	1876	vel )
	1877	ENDDO
	1878
	1879	ENDIF
	1880
	1881	IF( degrade_xe ) THEN
	1882
	1883	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	1884	i = ide-1
	1885	DO k=kts,ktf
	1886	fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1)) &
	1887	*(v(i_end+1,k,j)+v(i_end,k,j))
	1888	ENDDO
	1889	ENDIF
	1890
	1891	i = ide-2
	1892	DO k=kts,ktf
	1893	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	1894	fqx( i,k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j), &
	1895	v(i ,k,j), v(i+1,k,j), &
	1896	vel )
	1897	ENDDO
	1898
	1899	ENDIF
	1900
	1901	! x flux-divergence into tendency
	1902
	1903	DO k=kts,ktf
	1904	DO i = i_start, i_end
	1905	mrdx=msfvy(i,j)*rdx ! ADT eqn 45, 1st term on RHS
	1906	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	1907	ENDDO
	1908	ENDDO
	1909
	1910	ENDDO
	1911
	1912	ELSE IF( horz_order == 5 ) THEN
	1913
	1914	! 5th order horizontal flux calculation
	1915	! This code is EXACTLY the same as the 6th order code
	1916	! EXCEPT the 5th order and 3rd operators are used in
	1917	! place of the 6th and 4th order operators
	1918
	1919	! determine boundary mods for flux operators
	1920	! We degrade the flux operators from 3rd/4th order
	1921	! to second order one gridpoint in from the boundaries for
	1922	! all boundary conditions except periodic and symmetry - these
	1923	! conditions have boundary zone data fill for correct application
	1924	! of the higher order flux stencils
	1925
	1926	degrade_xs = .true.
	1927	degrade_xe = .true.
	1928	degrade_ys = .true.
	1929	degrade_ye = .true.
	1930
	1931	IF( config_flags%periodic_x .or. &
	1932	config_flags%symmetric_xs .or. &
	1933	(its > ids+2) ) degrade_xs = .false.
	1934	IF( config_flags%periodic_x .or. &
	1935	config_flags%symmetric_xe .or. &
	1936	(ite < ide-3) ) degrade_xe = .false.
	1937	IF( config_flags%periodic_y .or. &
	1938	config_flags%symmetric_ys .or. &
	1939	(jts > jds+2) ) degrade_ys = .false.
	1940	IF( config_flags%periodic_y .or. &
	1941	config_flags%symmetric_ye .or. &
	1942	(jte < jde-2) ) degrade_ye = .false.
	1943
	1944	!--------------- y - advection first
	1945
	1946	i_start = its
	1947	i_end = MIN(ite,ide-1)
	1948	j_start = jts
	1949	j_end = jte
	1950
	1951	! higher order flux has a 5 or 7 point stencil, so compute
	1952	! bounds so we can switch to second order flux close to the boundary
	1953
	1954	j_start_f = j_start
	1955	j_end_f = j_end+1
	1956
	1957	IF(degrade_ys) then
	1958	j_start = MAX(jts,jds+1)
	1959	j_start_f = jds+3
	1960	ENDIF
	1961
	1962	IF(degrade_ye) then
	1963	j_end = MIN(jte,jde-1)
	1964	j_end_f = jde-2
	1965	ENDIF
	1966
	1967	! compute fluxes, 5th or 6th order
	1968
	1969	jp1 = 2
	1970	jp0 = 1
	1971
	1972	j_loop_y_flux_5 : DO j = j_start, j_end+1
	1973
	1974	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
	1975
	1976	DO k=kts,ktf
	1977	DO i = i_start, i_end
	1978	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	1979	fqy( i, k, jp1 ) = vel*flux5( &
	1980	v(i,k,j-3), v(i,k,j-2), v(i,k,j-1), &
	1981	v(i,k,j ), v(i,k,j+1), v(i,k,j+2), vel )
	1982	ENDDO
	1983	ENDDO
	1984
	1985	! we must be close to some boundary where we need to reduce the order of the stencil
	1986	! specified uses upstream normal wind at boundaries
	1987
	1988	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	1989
	1990	DO k=kts,ktf
	1991	DO i = i_start, i_end
	1992	vb = v(i,k,j-1)
	1993	IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
	1994	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	1995	*(v(i,k,j)+vb)
	1996	ENDDO
	1997	ENDDO
	1998
	1999	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	2000
	2001	DO k=kts,ktf
	2002	DO i = i_start, i_end
	2003	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	2004	fqy( i, k, jp1 ) = vel*flux3( &
	2005	v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
	2006	ENDDO
	2007	ENDDO
	2008
	2009
	2010	ELSE IF ( j == jde ) THEN ! 2nd order flux next to north boundary
	2011
	2012	DO k=kts,ktf
	2013	DO i = i_start, i_end
	2014	vb = v(i,k,j)
	2015	IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
	2016	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	2017	*(vb+v(i,k,j-1))
	2018	ENDDO
	2019	ENDDO
	2020
	2021	ELSE IF ( j == jde-1 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	2022
	2023	DO k=kts,ktf
	2024	DO i = i_start, i_end
	2025	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	2026	fqy( i, k, jp1 ) = vel*flux3( &
	2027	v(i,k,j-2),v(i,k,j-1),v(i,k,j),v(i,k,j+1),vel )
	2028	ENDDO
	2029	ENDDO
	2030
	2031	END IF
	2032
	2033	! y flux-divergence into tendency
	2034
	2035	! Comments on polar boundary conditions
	2036	! No advection over the poles means tendencies (held from jds [S. pole]
	2037	! to jde [N pole], i.e., on v grid) must be zero at poles
	2038	! [tendency(jds) and tendency(jde)=0]
	2039	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	2040	DO k=kts,ktf
	2041	DO i = i_start, i_end
	2042	tendency(i,k,j-1) = 0.
	2043	END DO
	2044	END DO
	2045	! If j_end were set to jde in a special if statement apart from
	2046	! degrade_ye, then we would hit the next conditional. But since
	2047	! we want the tendency to be zero anyway, not looping to jde+1
	2048	! will produce the same effect.
	2049	ELSE IF( config_flags%polar .AND. (j == jde+1) ) THEN
	2050	DO k=kts,ktf
	2051	DO i = i_start, i_end
	2052	tendency(i,k,j-1) = 0.
	2053	END DO
	2054	END DO
	2055	ELSE ! Normal code
	2056
	2057	IF(j > j_start) THEN
	2058
	2059	DO k=kts,ktf
	2060	DO i = i_start, i_end
	2061	mrdy=msfvy(i,j-1)*rdy ! ADT eqn 45, 2nd term on RHS
	2062	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	2063	ENDDO
	2064	ENDDO
	2065
	2066	ENDIF
	2067
	2068	END IF
	2069
	2070	jtmp = jp1
	2071	jp1 = jp0
	2072	jp0 = jtmp
	2073
	2074	ENDDO j_loop_y_flux_5
	2075
	2076	! next, x - flux divergence
	2077
	2078	i_start = its
	2079	i_end = MIN(ite,ide-1)
	2080
	2081	j_start = jts
	2082	j_end = jte
	2083	! Polar boundary conditions are like open or specified
	2084	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	2085	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-1,jte)
	2086
	2087	! higher order flux has a 5 or 7 point stencil, so compute
	2088	! bounds so we can switch to second order flux close to the boundary
	2089
	2090	i_start_f = i_start
	2091	i_end_f = i_end+1
	2092
	2093	IF(degrade_xs) then
	2094	i_start = MAX(ids+1,its)
	2095	i_start_f = i_start+2
	2096	ENDIF
	2097
	2098	IF(degrade_xe) then
	2099	i_end = MIN(ide-2,ite)
	2100	i_end_f = ide-3
	2101	ENDIF
	2102
	2103	! compute fluxes
	2104
	2105	DO j = j_start, j_end
	2106
	2107	! 5th or 6th order flux
	2108
	2109	DO k=kts,ktf
	2110	DO i = i_start_f, i_end_f
	2111	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	2112	fqx( i, k ) = vel*flux5( v(i-3,k,j), v(i-2,k,j), &
	2113	v(i-1,k,j), v(i ,k,j), &
	2114	v(i+1,k,j), v(i+2,k,j), &
	2115	vel )
	2116	ENDDO
	2117	ENDDO
	2118
	2119	! lower order fluxes close to boundaries (if not periodic or symmetric)
	2120
	2121	IF( degrade_xs ) THEN
	2122
	2123	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	2124	i = ids+1
	2125	DO k=kts,ktf
	2126	fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1)) &
	2127	*(v(i,k,j)+v(i-1,k,j))
	2128	ENDDO
	2129	ENDIF
	2130
	2131	i = ids+2
	2132	DO k=kts,ktf
	2133	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	2134	fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j), &
	2135	v(i ,k,j), v(i+1,k,j), &
	2136	vel )
	2137	ENDDO
	2138
	2139	ENDIF
	2140
	2141	IF( degrade_xe ) THEN
	2142
	2143	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	2144	i = ide-1
	2145	DO k=kts,ktf
	2146	fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1)) &
	2147	*(v(i_end+1,k,j)+v(i_end,k,j))
	2148	ENDDO
	2149	ENDIF
	2150
	2151	i = ide-2
	2152	DO k=kts,ktf
	2153	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	2154	fqx( i,k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j), &
	2155	v(i ,k,j), v(i+1,k,j), &
	2156	vel )
	2157	ENDDO
	2158
	2159	ENDIF
	2160
	2161	! x flux-divergence into tendency
	2162
	2163	DO k=kts,ktf
	2164	DO i = i_start, i_end
	2165	mrdx=msfvy(i,j)*rdx ! ADT eqn 45, 1st term on RHS
	2166	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	2167	ENDDO
	2168	ENDDO
	2169
	2170	ENDDO
	2171
	2172	ELSE IF( horz_order == 4 ) THEN
	2173
	2174	! determine boundary mods for flux operators
	2175	! We degrade the flux operators from 3rd/4th order
	2176	! to second order one gridpoint in from the boundaries for
	2177	! all boundary conditions except periodic and symmetry - these
	2178	! conditions have boundary zone data fill for correct application
	2179	! of the higher order flux stencils
	2180
	2181	degrade_xs = .true.
	2182	degrade_xe = .true.
	2183	degrade_ys = .true.
	2184	degrade_ye = .true.
	2185
	2186	IF( config_flags%periodic_x .or. &
	2187	config_flags%symmetric_xs .or. &
	2188	(its > ids+1) ) degrade_xs = .false.
	2189	IF( config_flags%periodic_x .or. &
	2190	config_flags%symmetric_xe .or. &
	2191	(ite < ide-2) ) degrade_xe = .false.
	2192	IF( config_flags%periodic_y .or. &
	2193	config_flags%symmetric_ys .or. &
	2194	(jts > jds+1) ) degrade_ys = .false.
	2195	IF( config_flags%periodic_y .or. &
	2196	config_flags%symmetric_ye .or. &
	2197	(jte < jde-1) ) degrade_ye = .false.
	2198
	2199	!--------------- y - advection first
	2200
	2201
	2202	ktf=MIN(kte,kde-1)
	2203
	2204	i_start = its
	2205	i_end = MIN(ite,ide-1)
	2206	j_start = jts
	2207	j_end = jte
	2208
	2209	! 3rd or 4th order flux has a 5 point stencil, so compute
	2210	! bounds so we can switch to second order flux close to the boundary
	2211
	2212	j_start_f = j_start
	2213	j_end_f = j_end+1
	2214
	2215	!CJM May not work with tiling because defined in terms of domain dims
	2216	IF(degrade_ys) then
	2217	j_start = jds+1
	2218	j_start_f = j_start+1
	2219	ENDIF
	2220
	2221	IF(degrade_ye) then
	2222	j_end = jde-1
	2223	j_end_f = jde-1
	2224	ENDIF
	2225
	2226	! compute fluxes
	2227	! specified uses upstream normal wind at boundaries
	2228
	2229	jp0 = 1
	2230	jp1 = 2
	2231
	2232	DO j = j_start, j_end+1
	2233
	2234	IF ((j == j_start) .and. degrade_ys) THEN
	2235	DO k = kts,ktf
	2236	DO i = i_start, i_end
	2237	vb = v(i,k,j-1)
	2238	IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
	2239	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	2240	*(v(i,k,j)+vb)
	2241	ENDDO
	2242	ENDDO
	2243	ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
	2244	DO k = kts, ktf
	2245	DO i = i_start, i_end
	2246	vb = v(i,k,j)
	2247	IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
	2248	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	2249	*(vb+v(i,k,j-1))
	2250	ENDDO
	2251	ENDDO
	2252	ELSE
	2253	DO k = kts, ktf
	2254	DO i = i_start, i_end
	2255	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	2256	fqy( i,k,jp1 ) = vel*flux4( v(i,k,j-2), v(i,k,j-1), &
	2257	v(i,k,j ), v(i,k,j+1), &
	2258	vel )
	2259	ENDDO
	2260	ENDDO
	2261	END IF
	2262
	2263	! Comments on polar boundary conditions
	2264	! No advection over the poles means tendencies (held from jds [S. pole]
	2265	! to jde [N pole], i.e., on v grid) must be zero at poles
	2266	! [tendency(jds) and tendency(jde)=0]
	2267	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	2268	DO k=kts,ktf
	2269	DO i = i_start, i_end
	2270	tendency(i,k,j-1) = 0.
	2271	END DO
	2272	END DO
	2273	! If j_end were set to jde in a special if statement apart from
	2274	! degrade_ye, then we would hit the next conditional. But since
	2275	! we want the tendency to be zero anyway, not looping to jde+1
	2276	! will produce the same effect.
	2277	ELSE IF( config_flags%polar .AND. (j == jde+1) ) THEN
	2278	DO k=kts,ktf
	2279	DO i = i_start, i_end
	2280	tendency(i,k,j-1) = 0.
	2281	END DO
	2282	END DO
	2283	ELSE ! Normal code
	2284
	2285	IF( j > j_start) THEN
	2286	DO k = kts, ktf
	2287	DO i = i_start, i_end
	2288	mrdy=msfvy(i,j-1)*rdy ! ADT eqn 45, 2nd term on RHS
	2289	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	2290	ENDDO
	2291	ENDDO
	2292
	2293	END IF
	2294
	2295	END IF
	2296
	2297	jtmp = jp1
	2298	jp1 = jp0
	2299	jp0 = jtmp
	2300
	2301	ENDDO
	2302
	2303	! next, x - flux divergence
	2304
	2305
	2306	i_start = its
	2307	i_end = MIN(ite,ide-1)
	2308
	2309	j_start = jts
	2310	j_end = jte
	2311	! Polar boundary conditions are like open or specified
	2312	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	2313	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-1,jte)
	2314
	2315	! 3rd or 4th order flux has a 5 point stencil, so compute
	2316	! bounds so we can switch to second order flux close to the boundary
	2317
	2318	i_start_f = i_start
	2319	i_end_f = i_end+1
	2320
	2321	IF(degrade_xs) then
	2322	i_start = ids+1
	2323	i_start_f = i_start+1
	2324	ENDIF
	2325
	2326	IF(degrade_xe) then
	2327	i_end = ide-2
	2328	i_end_f = ide-2
	2329	ENDIF
	2330
	2331	! compute fluxes
	2332
	2333	DO j = j_start, j_end
	2334
	2335	! 3rd or 4th order flux
	2336
	2337	DO k=kts,ktf
	2338	DO i = i_start_f, i_end_f
	2339	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	2340	fqx( i, k ) = vel*flux4( v(i-2,k,j), v(i-1,k,j), &
	2341	v(i ,k,j), v(i+1,k,j), &
	2342	vel )
	2343	ENDDO
	2344	ENDDO
	2345
	2346	! second order flux close to boundaries (if not periodic or symmetric)
	2347
	2348	IF( degrade_xs ) THEN
	2349	DO k=kts,ktf
	2350	fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
	2351	*(v(i_start,k,j)+v(i_start-1,k,j))
	2352	ENDDO
	2353	ENDIF
	2354
	2355	IF( degrade_xe ) THEN
	2356	DO k=kts,ktf
	2357	fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1)) &
	2358	*(v(i_end+1,k,j)+v(i_end,k,j))
	2359	ENDDO
	2360	ENDIF
	2361
	2362	! x flux-divergence into tendency
	2363
	2364	DO k=kts,ktf
	2365	DO i = i_start, i_end
	2366	mrdx=msfvy(i,j)*rdx ! ADT eqn 45, 1st term on RHS
	2367	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	2368	ENDDO
	2369	ENDDO
	2370
	2371	ENDDO
	2372
	2373	ELSE IF( horz_order == 3 ) THEN
	2374
	2375	! determine boundary mods for flux operators
	2376	! We degrade the flux operators from 3rd/4th order
	2377	! to second order one gridpoint in from the boundaries for
	2378	! all boundary conditions except periodic and symmetry - these
	2379	! conditions have boundary zone data fill for correct application
	2380	! of the higher order flux stencils
	2381
	2382	degrade_xs = .true.
	2383	degrade_xe = .true.
	2384	degrade_ys = .true.
	2385	degrade_ye = .true.
	2386
	2387	IF( config_flags%periodic_x .or. &
	2388	config_flags%symmetric_xs .or. &
	2389	(its > ids+1) ) degrade_xs = .false.
	2390	IF( config_flags%periodic_x .or. &
	2391	config_flags%symmetric_xe .or. &
	2392	(ite < ide-2) ) degrade_xe = .false.
	2393	IF( config_flags%periodic_y .or. &
	2394	config_flags%symmetric_ys .or. &
	2395	(jts > jds+1) ) degrade_ys = .false.
	2396	IF( config_flags%periodic_y .or. &
	2397	config_flags%symmetric_ye .or. &
	2398	(jte < jde-1) ) degrade_ye = .false.
	2399
	2400	!--------------- y - advection first
	2401
	2402
	2403	ktf=MIN(kte,kde-1)
	2404
	2405	i_start = its
	2406	i_end = MIN(ite,ide-1)
	2407	j_start = jts
	2408	j_end = jte
	2409
	2410	! 3rd or 4th order flux has a 5 point stencil, so compute
	2411	! bounds so we can switch to second order flux close to the boundary
	2412
	2413	j_start_f = j_start
	2414	j_end_f = j_end+1
	2415
	2416	!CJM May not work with tiling because defined in terms of domain dims
	2417	IF(degrade_ys) then
	2418	j_start = jds+1
	2419	j_start_f = j_start+1
	2420	ENDIF
	2421
	2422	IF(degrade_ye) then
	2423	j_end = jde-1
	2424	j_end_f = jde-1
	2425	ENDIF
	2426
	2427	! compute fluxes
	2428	! specified uses upstream normal wind at boundaries
	2429
	2430	jp0 = 1
	2431	jp1 = 2
	2432
	2433	DO j = j_start, j_end+1
	2434
	2435	IF ((j == j_start) .and. degrade_ys) THEN
	2436	DO k = kts,ktf
	2437	DO i = i_start, i_end
	2438	vb = v(i,k,j-1)
	2439	IF (specified .AND. v(i,k,j) .LT. 0.)vb = v(i,k,j)
	2440	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	2441	*(v(i,k,j)+vb)
	2442	ENDDO
	2443	ENDDO
	2444	ELSE IF ((j == j_end+1) .and. degrade_ye) THEN
	2445	DO k = kts, ktf
	2446	DO i = i_start, i_end
	2447	vb = v(i,k,j)
	2448	IF (specified .AND. v(i,k,j-1) .GT. 0.)vb = v(i,k,j-1)
	2449	fqy(i, k, jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1)) &
	2450	*(vb+v(i,k,j-1))
	2451	ENDDO
	2452	ENDDO
	2453	ELSE
	2454	DO k = kts, ktf
	2455	DO i = i_start, i_end
	2456	vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
	2457	fqy( i,k,jp1 ) = vel*flux3( v(i,k,j-2), v(i,k,j-1), &
	2458	v(i,k,j ), v(i,k,j+1), &
	2459	vel )
	2460	ENDDO
	2461	ENDDO
	2462	END IF
	2463
	2464	! Comments on polar boundary conditions
	2465	! No advection over the poles means tendencies (held from jds [S. pole]
	2466	! to jde [N pole], i.e., on v grid) must be zero at poles
	2467	! [tendency(jds) and tendency(jde)=0]
	2468	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	2469	DO k=kts,ktf
	2470	DO i = i_start, i_end
	2471	tendency(i,k,j-1) = 0.
	2472	END DO
	2473	END DO
	2474	! If j_end were set to jde in a special if statement apart from
	2475	! degrade_ye, then we would hit the next conditional. But since
	2476	! we want the tendency to be zero anyway, not looping to jde+1
	2477	! will produce the same effect.
	2478	ELSE IF( config_flags%polar .AND. (j == jde+1) ) THEN
	2479	DO k=kts,ktf
	2480	DO i = i_start, i_end
	2481	tendency(i,k,j-1) = 0.
	2482	END DO
	2483	END DO
	2484	ELSE ! Normal code
	2485
	2486	IF( j > j_start) THEN
	2487	DO k = kts, ktf
	2488	DO i = i_start, i_end
	2489	mrdy=msfvy(i,j-1)*rdy ! ADT eqn 45, 2nd term on RHS
	2490	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	2491	ENDDO
	2492	ENDDO
	2493
	2494	END IF
	2495
	2496	END IF
	2497
	2498	jtmp = jp1
	2499	jp1 = jp0
	2500	jp0 = jtmp
	2501
	2502	ENDDO
	2503
	2504	! next, x - flux divergence
	2505
	2506
	2507	i_start = its
	2508	i_end = MIN(ite,ide-1)
	2509
	2510	j_start = jts
	2511	j_end = jte
	2512	! Polar boundary conditions are like open or specified
	2513	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	2514	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-1,jte)
	2515
	2516	! 3rd or 4th order flux has a 5 point stencil, so compute
	2517	! bounds so we can switch to second order flux close to the boundary
	2518
	2519	i_start_f = i_start
	2520	i_end_f = i_end+1
	2521
	2522	IF(degrade_xs) then
	2523	i_start = ids+1
	2524	i_start_f = i_start+1
	2525	ENDIF
	2526
	2527	IF(degrade_xe) then
	2528	i_end = ide-2
	2529	i_end_f = ide-2
	2530	ENDIF
	2531
	2532	! compute fluxes
	2533
	2534	DO j = j_start, j_end
	2535
	2536	! 3rd or 4th order flux
	2537
	2538	DO k=kts,ktf
	2539	DO i = i_start_f, i_end_f
	2540	vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
	2541	fqx( i, k ) = vel*flux3( v(i-2,k,j), v(i-1,k,j), &
	2542	v(i ,k,j), v(i+1,k,j), &
	2543	vel )
	2544	ENDDO
	2545	ENDDO
	2546
	2547	! second order flux close to boundaries (if not periodic or symmetric)
	2548
	2549	IF( degrade_xs ) THEN
	2550	DO k=kts,ktf
	2551	fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1)) &
	2552	*(v(i_start,k,j)+v(i_start-1,k,j))
	2553	ENDDO
	2554	ENDIF
	2555
	2556	IF( degrade_xe ) THEN
	2557	DO k=kts,ktf
	2558	fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1)) &
	2559	*(v(i_end+1,k,j)+v(i_end,k,j))
	2560	ENDDO
	2561	ENDIF
	2562
	2563	! x flux-divergence into tendency
	2564
	2565	DO k=kts,ktf
	2566	DO i = i_start, i_end
	2567	mrdx=msfvy(i,j)*rdx ! ADT eqn 45, 1st term on RHS
	2568	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	2569	ENDDO
	2570	ENDDO
	2571
	2572	ENDDO
	2573
	2574	ELSE IF( horz_order == 2 ) THEN
	2575
	2576
	2577	i_start = its
	2578	i_end = MIN(ite,ide-1)
	2579	j_start = jts
	2580	j_end = jte
	2581
	2582	IF ( config_flags%open_ys ) j_start = MAX(jds+1,jts)
	2583	IF ( config_flags%open_ye ) j_end = MIN(jde-1,jte)
	2584	IF ( specified ) j_start = MAX(jds+2,jts)
	2585	IF ( specified ) j_end = MIN(jde-2,jte)
	2586	IF ( config_flags%polar ) j_start = MAX(jds+1,jts)
	2587	IF ( config_flags%polar ) j_end = MIN(jde-1,jte)
	2588
	2589	DO j = j_start, j_end
	2590	DO k=kts,ktf
	2591	DO i = i_start, i_end
	2592
	2593	mrdy=msfvy(i,j)*rdy ! ADT eqn 45, 2nd term on RHS
	2594
	2595	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
	2596	((rv(i,k,j+1)+rv(i,k,j ))(v(i,k,j+1)+v(i,k,j )) &
	2597	-(rv(i,k,j )+rv(i,k,j-1))*(v(i,k,j )+v(i,k,j-1)))
	2598
	2599	ENDDO
	2600	ENDDO
	2601	ENDDO
	2602
	2603	! Comments on polar boundary conditions
	2604	! tendencies = 0 at poles, and polar points do not contribute at points
	2605	! next to poles
	2606	IF (config_flags%polar) THEN
	2607	IF (jts == jds) THEN
	2608	DO k=kts,ktf
	2609	DO i = i_start, i_end
	2610	tendency(i,k,jds) = 0.
	2611	END DO
	2612	END DO
	2613	END IF
	2614	IF (jte == jde) THEN
	2615	DO k=kts,ktf
	2616	DO i = i_start, i_end
	2617	tendency(i,k,jde) = 0.
	2618	END DO
	2619	END DO
	2620	END IF
	2621	END IF
	2622
	2623	! specified uses upstream normal wind at boundaries
	2624
	2625	IF ( specified .AND. jts .LE. jds+1 ) THEN
	2626	j = jds+1
	2627	DO k=kts,ktf
	2628	DO i = i_start, i_end
	2629	mrdy=msfvy(i,j)*rdy ! ADT eqn 45, 2nd term on RHS
	2630	vb = v(i,k,j-1)
	2631	IF (v(i,k,j) .LT. 0.) vb = v(i,k,j)
	2632
	2633	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
	2634	((rv(i,k,j+1)+rv(i,k,j ))(v(i,k,j+1)+v(i,k,j )) &
	2635	-(rv(i,k,j )+rv(i,k,j-1))*(v(i,k,j )+vb))
	2636
	2637	ENDDO
	2638	ENDDO
	2639	ENDIF
	2640
	2641	IF ( specified .AND. jte .GE. jde-1 ) THEN
	2642	j = jde-1
	2643	DO k=kts,ktf
	2644	DO i = i_start, i_end
	2645
	2646	mrdy=msfvy(i,j)*rdy ! ADT eqn 45, 2nd term on RHS
	2647	vb = v(i,k,j+1)
	2648	IF (v(i,k,j) .GT. 0.) vb = v(i,k,j)
	2649
	2650	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.25 &
	2651	((rv(i,k,j+1)+rv(i,k,j ))(vb+v(i,k,j )) &
	2652	-(rv(i,k,j )+rv(i,k,j-1))*(v(i,k,j )+v(i,k,j-1)))
	2653
	2654	ENDDO
	2655	ENDDO
	2656	ENDIF
	2657
	2658	IF ( .NOT. config_flags%periodic_x ) THEN
	2659	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	2660	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite)
	2661	ENDIF
	2662	IF ( config_flags%polar ) j_start = MAX(jds+1,jts)
	2663	IF ( config_flags%polar ) j_end = MIN(jde-1,jte)
	2664
	2665	DO j = j_start, j_end
	2666	DO k=kts,ktf
	2667	DO i = i_start, i_end
	2668
	2669	mrdx=msfvy(i,j)*rdx ! ADT eqn 45, 1st term on RHS
	2670
	2671	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.25 &
	2672	((ru(i+1,k,j)+ru(i+1,k,j-1))(v(i+1,k,j)+v(i ,k,j)) &
	2673	-(ru(i ,k,j)+ru(i ,k,j-1))*(v(i ,k,j)+v(i-1,k,j)))
	2674
	2675	ENDDO
	2676	ENDDO
	2677	ENDDO
	2678
	2679	ELSE IF ( horz_order == 0 ) THEN
	2680
	2681	! Just in case we want to turn horizontal advection off, we can do it
	2682
	2683	ELSE
	2684
	2685
	2686	WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: h_order not known ',horz_order
	2687	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	2688
	2689	ENDIF horizontal_order_test
	2690
	2691	! Comments on polar boundary condition
	2692	! Force tendency=0 at NP and SP
	2693	! We keep setting this everywhere, but it can't hurt...
	2694	IF ( config_flags%polar .AND. (jts == jds) ) THEN
	2695	DO i=its,ite
	2696	DO k=kts,ktf
	2697	tendency(i,k,jts)=0.
	2698	END DO
	2699	END DO
	2700	END IF
	2701	IF ( config_flags%polar .AND. (jte == jde) ) THEN
	2702	DO i=its,ite
	2703	DO k=kts,ktf
	2704	tendency(i,k,jte)=0.
	2705	END DO
	2706	END DO
	2707	END IF
	2708
	2709	! radiative lateral boundary condition in y for normal velocity (v)
	2710
	2711	IF ( (config_flags%open_ys) .and. jts == jds ) THEN
	2712
	2713	i_start = its
	2714	i_end = MIN(ite,ide-1)
	2715
	2716	DO i = i_start, i_end
	2717	DO k = kts, ktf
	2718	vb = MIN(rv(i,k,jts)-cb*mut(i,jts), 0.)
	2719	tendency(i,k,jts) = tendency(i,k,jts) &
	2720	- rdyvb(v_old(i,k,jts+1) - v_old(i,k,jts))
	2721	ENDDO
	2722	ENDDO
	2723
	2724	ENDIF
	2725
	2726	IF ( (config_flags%open_ye) .and. jte == jde ) THEN
	2727
	2728	i_start = its
	2729	i_end = MIN(ite,ide-1)
	2730
	2731	DO i = i_start, i_end
	2732	DO k = kts, ktf
	2733	vb = MAX(rv(i,k,jte)+cb*mut(i,jte-1), 0.)
	2734	tendency(i,k,jte) = tendency(i,k,jte) &
	2735	- rdyvb(v_old(i,k,jte) - v_old(i,k,jte-1))
	2736	ENDDO
	2737	ENDDO
	2738
	2739	ENDIF
	2740
	2741	! pick up the rest of the horizontal radiation boundary conditions.
	2742	! (these are the computations that don't require 'cb'.
	2743	! first, set to index ranges
	2744
	2745	j_start = jts
	2746	j_end = MIN(jte,jde)
	2747
	2748	jmin = jds
	2749	jmax = jde-1
	2750
	2751	IF (config_flags%open_ys) THEN
	2752	j_start = MAX(jds+1, jts)
	2753	jmin = jds
	2754	ENDIF
	2755	IF (config_flags%open_ye) THEN
	2756	j_end = MIN(jte,jde-1)
	2757	jmax = jde-1
	2758	ENDIF
	2759
	2760	! compute x (u) conditions for v, w, or scalar
	2761
	2762	IF( (config_flags%open_xs) .and. (its == ids)) THEN
	2763
	2764	DO j = j_start, j_end
	2765
	2766	mrdx=msfvy(its,j)*rdx ! ADT eqn 45, 1st term on RHS
	2767	jp = MIN( jmax, j )
	2768	jm = MAX( jmin, j-1 )
	2769
	2770	DO k=kts,ktf
	2771
	2772	uw = 0.5*(ru(its,k,jp)+ru(its,k,jm))
	2773	ub = MIN( uw, 0. )
	2774	dup = ru(its+1,k,jp)-ru(its,k,jp)
	2775	dum = ru(its+1,k,jm)-ru(its,k,jm)
	2776	tendency(its,k,j)=tendency(its,k,j)-mrdx*( &
	2777	ub*(v_old(its+1,k,j)-v_old(its,k,j)) &
	2778	+0.5v(its,k,j)(dup+dum))
	2779	ENDDO
	2780	ENDDO
	2781
	2782	ENDIF
	2783
	2784	IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
	2785	DO j = j_start, j_end
	2786
	2787	mrdx=msfvy(ite-1,j)*rdx ! ADT eqn 45, 1st term on RHS
	2788	jp = MIN( jmax, j )
	2789	jm = MAX( jmin, j-1 )
	2790
	2791	DO k=kts,ktf
	2792
	2793	uw = 0.5*(ru(ite,k,jp)+ru(ite,k,jm))
	2794	ub = MAX( uw, 0. )
	2795	dup = ru(ite,k,jp)-ru(ite-1,k,jp)
	2796	dum = ru(ite,k,jm)-ru(ite-1,k,jm)
	2797
	2798	! tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*( &
	2799	! ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j)) &
	2800	! +0.5v(ite-1,k,j) &
	2801	! ( ru(ite,k,jp)-ru(ite-1,k,jp) &
	2802	! +ru(ite,k,jm)-ru(ite-1,k,jm)) )
	2803	tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*( &
	2804	ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j)) &
	2805	+0.5v(ite-1,k,j)(dup+dum))
	2806
	2807	ENDDO
	2808	ENDDO
	2809
	2810	ENDIF
	2811
	2812	!-------------------- vertical advection
	2813	! ADT eqn 45 has 3rd term on RHS = -(1/mx) partial d/dz (rho v w)
	2814	! Here we have: - partial d/dz (v*rom) = - partial d/dz (v rho w / my)
	2815	! We therefore need to make a correction for advect_v
	2816	! since 'my' (map scale factor in y direction) isn't a function of z,
	2817	! we can do this using *(my/mx) (see eqn. 45 for example)
	2818
	2819
	2820	i_start = its
	2821	i_end = MIN(ite,ide-1)
	2822	j_start = jts
	2823	j_end = jte
	2824
	2825	DO i = i_start, i_end
	2826	vflux(i,kts)=0.
	2827	vflux(i,kte)=0.
	2828	ENDDO
	2829
	2830	! Polar boundary conditions are like open or specified
	2831	! We don't want to calculate vertical v tendencies at the N or S pole
	2832	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	2833	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-1,jte)
	2834
	2835	vert_order_test : IF (vert_order == 6) THEN
	2836
	2837	DO j = j_start, j_end
	2838
	2839
	2840	DO k=kts+3,ktf-2
	2841	DO i = i_start, i_end
	2842	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2843	vflux(i,k) = vel*flux6( &
	2844	v(i,k-3,j), v(i,k-2,j), v(i,k-1,j), &
	2845	v(i,k ,j), v(i,k+1,j), v(i,k+2,j), -vel )
	2846	ENDDO
	2847	ENDDO
	2848
	2849	DO i = i_start, i_end
	2850	k=kts+1
	2851	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2852	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2853	k = kts+2
	2854	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2855	vflux(i,k) = vel*flux4( &
	2856	v(i,k-2,j), v(i,k-1,j), &
	2857	v(i,k ,j), v(i,k+1,j), -vel )
	2858	k = ktf-1
	2859	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2860	vflux(i,k) = vel*flux4( &
	2861	v(i,k-2,j), v(i,k-1,j), &
	2862	v(i,k ,j), v(i,k+1,j), -vel )
	2863	k=ktf
	2864	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2865	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2866
	2867	ENDDO
	2868
	2869
	2870	DO k=kts,ktf
	2871	DO i = i_start, i_end
	2872	! We are calculating vertical fluxes on v points,
	2873	! so we must mean msf_v_x/y variables
	2874	tendency(i,k,j)=tendency(i,k,j)-(msfvy(i,j)/msfvx(i,j))rdzw(k)(vflux(i,k+1)-vflux(i,k)) ! ADT eqn 45, 3rd term on RHS
	2875	ENDDO
	2876	ENDDO
	2877
	2878	ENDDO
	2879
	2880	ELSE IF (vert_order == 5) THEN
	2881
	2882	DO j = j_start, j_end
	2883
	2884
	2885	DO k=kts+3,ktf-2
	2886	DO i = i_start, i_end
	2887	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2888	vflux(i,k) = vel*flux5( &
	2889	v(i,k-3,j), v(i,k-2,j), v(i,k-1,j), &
	2890	v(i,k ,j), v(i,k+1,j), v(i,k+2,j), -vel )
	2891	ENDDO
	2892	ENDDO
	2893
	2894	DO i = i_start, i_end
	2895	k=kts+1
	2896	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2897	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2898	k = kts+2
	2899	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2900	vflux(i,k) = vel*flux3( &
	2901	v(i,k-2,j), v(i,k-1,j), &
	2902	v(i,k ,j), v(i,k+1,j), -vel )
	2903	k = ktf-1
	2904	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2905	vflux(i,k) = vel*flux3( &
	2906	v(i,k-2,j), v(i,k-1,j), &
	2907	v(i,k ,j), v(i,k+1,j), -vel )
	2908	k=ktf
	2909	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2910	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2911
	2912	ENDDO
	2913
	2914
	2915	DO k=kts,ktf
	2916	DO i = i_start, i_end
	2917	! We are calculating vertical fluxes on v points,
	2918	! so we must mean msf_v_x/y variables
	2919	tendency(i,k,j)=tendency(i,k,j)-(msfvy(i,j)/msfvx(i,j))rdzw(k)(vflux(i,k+1)-vflux(i,k)) ! ADT eqn 45, 3rd term on RHS
	2920	ENDDO
	2921	ENDDO
	2922
	2923	ENDDO
	2924
	2925	ELSE IF (vert_order == 4) THEN
	2926
	2927	DO j = j_start, j_end
	2928
	2929
	2930	DO k=kts+2,ktf-1
	2931	DO i = i_start, i_end
	2932	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2933	vflux(i,k) = vel*flux4( &
	2934	v(i,k-2,j), v(i,k-1,j), &
	2935	v(i,k ,j), v(i,k+1,j), -vel )
	2936	ENDDO
	2937	ENDDO
	2938
	2939	DO i = i_start, i_end
	2940	k=kts+1
	2941	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2942	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2943	k=ktf
	2944	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2945	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2946
	2947	ENDDO
	2948
	2949
	2950	DO k=kts,ktf
	2951	DO i = i_start, i_end
	2952	! We are calculating vertical fluxes on v points,
	2953	! so we must mean msf_v_x/y variables
	2954	tendency(i,k,j)=tendency(i,k,j)-(msfvy(i,j)/msfvx(i,j))rdzw(k)(vflux(i,k+1)-vflux(i,k)) ! ADT eqn 45, 3rd term on RHS
	2955	ENDDO
	2956	ENDDO
	2957
	2958	ENDDO
	2959
	2960	ELSE IF (vert_order == 3) THEN
	2961
	2962	DO j = j_start, j_end
	2963
	2964
	2965	DO k=kts+2,ktf-1
	2966	DO i = i_start, i_end
	2967	vel=0.5*(rom(i,k,j)+rom(i,k,j-1))
	2968	vflux(i,k) = vel*flux3( &
	2969	v(i,k-2,j), v(i,k-1,j), &
	2970	v(i,k ,j), v(i,k+1,j), -vel )
	2971	ENDDO
	2972	ENDDO
	2973
	2974	DO i = i_start, i_end
	2975	k=kts+1
	2976	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2977	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2978	k=ktf
	2979	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	2980	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	2981
	2982	ENDDO
	2983
	2984
	2985	DO k=kts,ktf
	2986	DO i = i_start, i_end
	2987	! We are calculating vertical fluxes on v points,
	2988	! so we must mean msf_v_x/y variables
	2989	tendency(i,k,j)=tendency(i,k,j)-(msfvy(i,j)/msfvx(i,j))rdzw(k)(vflux(i,k+1)-vflux(i,k)) ! ADT eqn 45, 3rd term on RHS
	2990	ENDDO
	2991	ENDDO
	2992
	2993	ENDDO
	2994
	2995
	2996	ELSE IF (vert_order == 2) THEN
	2997
	2998	DO j = j_start, j_end
	2999	DO k=kts+1,ktf
	3000	DO i = i_start, i_end
	3001
	3002	vflux(i,k)=0.5*(rom(i,k,j)+rom(i,k,j-1)) &
	3003	(fzm(k)v(i,k,j)+fzp(k)*v(i,k-1,j))
	3004	ENDDO
	3005	ENDDO
	3006
	3007	DO k=kts,ktf
	3008	DO i = i_start, i_end
	3009	! We are calculating vertical fluxes on v points,
	3010	! so we must mean msf_v_x/y variables
	3011	tendency(i,k,j)=tendency(i,k,j)-(msfvy(i,j)/msfvx(i,j))rdzw(k)(vflux(i,k+1)-vflux(i,k)) ! ADT eqn 45, 3rd term on RHS
	3012	ENDDO
	3013	ENDDO
	3014	ENDDO
	3015
	3016	ELSE
	3017
	3018	WRITE ( wrf_err_message , * ) 'module_advect: advect_v_6a: v_order not known ',vert_order
	3019	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	3020
	3021	ENDIF vert_order_test
	3022
	3023	END SUBROUTINE advect_v
	3024
	3025	!-------------------------------------------------------------------
	3026
	3027	SUBROUTINE advect_scalar ( field, field_old, tendency, &
	3028	ru, rv, rom, &
	3029	mut, time_step, config_flags, &
	3030	msfux, msfuy, msfvx, msfvy, &
	3031	msftx, msfty, &
	3032	fzm, fzp, &
	3033	rdx, rdy, rdzw, &
	3034	ids, ide, jds, jde, kds, kde, &
	3035	ims, ime, jms, jme, kms, kme, &
	3036	its, ite, jts, jte, kts, kte )
	3037
	3038	IMPLICIT NONE
	3039
	3040	! Input data
	3041
	3042	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	3043
	3044	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	3045	ims, ime, jms, jme, kms, kme, &
	3046	its, ite, jts, jte, kts, kte
	3047
	3048	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, &
	3049	field_old, &
	3050	ru, &
	3051	rv, &
	3052	rom
	3053
	3054	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
	3055	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	3056
	3057	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	3058	msfuy, &
	3059	msfvx, &
	3060	msfvy, &
	3061	msftx, &
	3062	msfty
	3063
	3064	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	3065	fzp, &
	3066	rdzw
	3067
	3068	REAL , INTENT(IN ) :: rdx, &
	3069	rdy
	3070	INTEGER , INTENT(IN ) :: time_step
	3071
	3072
	3073	! Local data
	3074
	3075	INTEGER :: i, j, k, itf, jtf, ktf
	3076	INTEGER :: i_start, i_end, j_start, j_end
	3077	INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
	3078	INTEGER :: jmin, jmax, jp, jm, imin, imax
	3079
	3080	REAL :: mrdx, mrdy, ub, vb, uw, vw
	3081	REAL , DIMENSION(its:ite, kts:kte) :: vflux
	3082
	3083
	3084	REAL, DIMENSION( its:ite+1, kts:kte ) :: fqx
	3085	REAL, DIMENSION( its:ite, kts:kte, 2 ) :: fqy
	3086
	3087	INTEGER :: horz_order, vert_order
	3088
	3089	LOGICAL :: degrade_xs, degrade_ys
	3090	LOGICAL :: degrade_xe, degrade_ye
	3091
	3092	INTEGER :: jp1, jp0, jtmp
	3093
	3094
	3095	! definition of flux operators, 3rd, 4th, 5th or 6th order
	3096
	3097	REAL :: flux3, flux4, flux5, flux6
	3098	REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
	3099
	3100	flux4(q_im2, q_im1, q_i, q_ip1, ua) = &
	3101	( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
	3102
	3103	flux3(q_im2, q_im1, q_i, q_ip1, ua) = &
	3104	flux4(q_im2, q_im1, q_i, q_ip1, ua) + &
	3105	sign(1,time_step)sign(1.,ua)((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
	3106
	3107	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	3108	( 37.(q_i+q_im1) - 8.(q_ip1+q_im2) &
	3109	+(q_ip2+q_im3) )/60.0
	3110
	3111	flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	3112	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) &
	3113	-sign(1,time_step)sign(1.,ua)( &
	3114	(q_ip2-q_im3)-5.(q_ip1-q_im2)+10.(q_i-q_im1) )/60.0
	3115
	3116
	3117	LOGICAL :: specified
	3118
	3119	specified = .false.
	3120	if(config_flags%specified .or. config_flags%nested) specified = .true.
	3121
	3122	! set order for the advection schemes
	3123
	3124	ktf=MIN(kte,kde-1)
	3125	horz_order = config_flags%h_sca_adv_order
	3126	vert_order = config_flags%v_sca_adv_order
	3127
	3128	! begin with horizontal flux divergence
	3129	! here is the choice of flux operators
	3130
	3131
	3132	horizontal_order_test : IF( horz_order == 6 ) THEN
	3133
	3134	! determine boundary mods for flux operators
	3135	! We degrade the flux operators from 3rd/4th order
	3136	! to second order one gridpoint in from the boundaries for
	3137	! all boundary conditions except periodic and symmetry - these
	3138	! conditions have boundary zone data fill for correct application
	3139	! of the higher order flux stencils
	3140
	3141	degrade_xs = .true.
	3142	degrade_xe = .true.
	3143	degrade_ys = .true.
	3144	degrade_ye = .true.
	3145
	3146	IF( config_flags%periodic_x .or. &
	3147	config_flags%symmetric_xs .or. &
	3148	(its > ids+2) ) degrade_xs = .false.
	3149	IF( config_flags%periodic_x .or. &
	3150	config_flags%symmetric_xe .or. &
	3151	(ite < ide-3) ) degrade_xe = .false.
	3152	IF( config_flags%periodic_y .or. &
	3153	config_flags%symmetric_ys .or. &
	3154	(jts > jds+2) ) degrade_ys = .false.
	3155	IF( config_flags%periodic_y .or. &
	3156	config_flags%symmetric_ye .or. &
	3157	(jte < jde-3) ) degrade_ye = .false.
	3158
	3159	!--------------- y - advection first
	3160
	3161	ktf=MIN(kte,kde-1)
	3162	i_start = its
	3163	i_end = MIN(ite,ide-1)
	3164	j_start = jts
	3165	j_end = MIN(jte,jde-1)
	3166
	3167	! higher order flux has a 5 or 7 point stencil, so compute
	3168	! bounds so we can switch to second order flux close to the boundary
	3169
	3170	j_start_f = j_start
	3171	j_end_f = j_end+1
	3172
	3173	IF(degrade_ys) then
	3174	j_start = MAX(jts,jds+1)
	3175	j_start_f = jds+3
	3176	ENDIF
	3177
	3178	IF(degrade_ye) then
	3179	j_end = MIN(jte,jde-2)
	3180	j_end_f = jde-3
	3181	ENDIF
	3182
	3183	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	3184
	3185	! compute fluxes, 5th or 6th order
	3186
	3187	jp1 = 2
	3188	jp0 = 1
	3189
	3190	j_loop_y_flux_6 : DO j = j_start, j_end+1
	3191
	3192	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	3193
	3194	DO k=kts,ktf
	3195	DO i = i_start, i_end
	3196	vel = rv(i,k,j)
	3197	fqy( i, k, jp1 ) = vel*flux6( &
	3198	field(i,k,j-3), field(i,k,j-2), field(i,k,j-1), &
	3199	field(i,k,j ), field(i,k,j+1), field(i,k,j+2), vel )
	3200	ENDDO
	3201	ENDDO
	3202
	3203	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	3204
	3205	DO k=kts,ktf
	3206	DO i = i_start, i_end
	3207	fqy(i,k, jp1) = 0.5rv(i,k,j) &
	3208	(field(i,k,j)+field(i,k,j-1))
	3209
	3210	ENDDO
	3211	ENDDO
	3212
	3213	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	3214
	3215	DO k=kts,ktf
	3216	DO i = i_start, i_end
	3217	vel = rv(i,k,j)
	3218	fqy( i, k, jp1 ) = vel*flux4( &
	3219	field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
	3220	ENDDO
	3221	ENDDO
	3222
	3223	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	3224
	3225	DO k=kts,ktf
	3226	DO i = i_start, i_end
	3227	fqy(i, k, jp1) = 0.5rv(i,k,j) &
	3228	(field(i,k,j)+field(i,k,j-1))
	3229	ENDDO
	3230	ENDDO
	3231
	3232	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	3233
	3234	DO k=kts,ktf
	3235	DO i = i_start, i_end
	3236	vel = rv(i,k,j)
	3237	fqy( i, k, jp1) = vel*flux4( &
	3238	field(i,k,j-2),field(i,k,j-1), &
	3239	field(i,k,j),field(i,k,j+1),vel )
	3240	ENDDO
	3241	ENDDO
	3242
	3243	ENDIF
	3244
	3245	! y flux-divergence into tendency
	3246
	3247	! Comments on polar boundary conditions
	3248	! Same process as for advect_u - tendencies run from jds to jde-1
	3249	! (latitudes are as for u grid, longitudes are displaced)
	3250	! Therefore: flow is only from one side for points next to poles
	3251	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	3252	DO k=kts,ktf
	3253	DO i = i_start, i_end
	3254	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3255	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	3256	END DO
	3257	END DO
	3258	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	3259	DO k=kts,ktf
	3260	DO i = i_start, i_end
	3261	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3262	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	3263	END DO
	3264	END DO
	3265	ELSE ! normal code
	3266
	3267	IF(j > j_start) THEN
	3268
	3269	DO k=kts,ktf
	3270	DO i = i_start, i_end
	3271	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3272	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	3273	ENDDO
	3274	ENDDO
	3275
	3276	ENDIF
	3277
	3278	END IF
	3279
	3280	jtmp = jp1
	3281	jp1 = jp0
	3282	jp0 = jtmp
	3283
	3284	ENDDO j_loop_y_flux_6
	3285
	3286	! next, x - flux divergence
	3287
	3288	i_start = its
	3289	i_end = MIN(ite,ide-1)
	3290
	3291	j_start = jts
	3292	j_end = MIN(jte,jde-1)
	3293
	3294	! higher order flux has a 5 or 7 point stencil, so compute
	3295	! bounds so we can switch to second order flux close to the boundary
	3296
	3297	i_start_f = i_start
	3298	i_end_f = i_end+1
	3299
	3300	IF(degrade_xs) then
	3301	i_start = MAX(ids+1,its)
	3302	i_start_f = i_start+2
	3303	ENDIF
	3304
	3305	IF(degrade_xe) then
	3306	i_end = MIN(ide-2,ite)
	3307	i_end_f = ide-3
	3308	ENDIF
	3309
	3310	! compute fluxes
	3311
	3312	DO j = j_start, j_end
	3313
	3314	! 5th or 6th order flux
	3315
	3316	DO k=kts,ktf
	3317	DO i = i_start_f, i_end_f
	3318	vel = ru(i,k,j)
	3319	fqx( i,k ) = vel*flux6( field(i-3,k,j), field(i-2,k,j), &
	3320	field(i-1,k,j), field(i ,k,j), &
	3321	field(i+1,k,j), field(i+2,k,j), &
	3322	vel )
	3323	ENDDO
	3324	ENDDO
	3325
	3326	! lower order fluxes close to boundaries (if not periodic or symmetric)
	3327
	3328	IF( degrade_xs ) THEN
	3329
	3330	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	3331	i = ids+1
	3332	DO k=kts,ktf
	3333	fqx(i,k) = 0.5*(ru(i,k,j)) &
	3334	*(field(i,k,j)+field(i-1,k,j))
	3335
	3336	ENDDO
	3337	ENDIF
	3338
	3339	i = ids+2
	3340	DO k=kts,ktf
	3341	vel = ru(i,k,j)
	3342	fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
	3343	field(i ,k,j), field(i+1,k,j), &
	3344	vel )
	3345	ENDDO
	3346
	3347	ENDIF
	3348
	3349	IF( degrade_xe ) THEN
	3350
	3351	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	3352	i = ide-1
	3353	DO k=kts,ktf
	3354	fqx(i,k) = 0.5*(ru(i,k,j)) &
	3355	*(field(i,k,j)+field(i-1,k,j))
	3356	ENDDO
	3357	ENDIF
	3358
	3359	i = ide-2
	3360	DO k=kts,ktf
	3361	vel = ru(i,k,j)
	3362	fqx( i,k ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
	3363	field(i ,k,j), field(i+1,k,j), &
	3364	vel )
	3365	ENDDO
	3366
	3367	ENDIF
	3368
	3369	! x flux-divergence into tendency
	3370
	3371	DO k=kts,ktf
	3372	DO i = i_start, i_end
	3373	mrdx=msftx(i,j)rdx ! see ADT eqn 48 [rho->rhoq] dividing by my, 1st term RHS
	3374	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	3375	ENDDO
	3376	ENDDO
	3377
	3378	ENDDO
	3379
	3380	ELSE IF( horz_order == 5 ) THEN
	3381
	3382	! determine boundary mods for flux operators
	3383	! We degrade the flux operators from 3rd/4th order
	3384	! to second order one gridpoint in from the boundaries for
	3385	! all boundary conditions except periodic and symmetry - these
	3386	! conditions have boundary zone data fill for correct application
	3387	! of the higher order flux stencils
	3388
	3389	degrade_xs = .true.
	3390	degrade_xe = .true.
	3391	degrade_ys = .true.
	3392	degrade_ye = .true.
	3393
	3394	IF( config_flags%periodic_x .or. &
	3395	config_flags%symmetric_xs .or. &
	3396	(its > ids+2) ) degrade_xs = .false.
	3397	IF( config_flags%periodic_x .or. &
	3398	config_flags%symmetric_xe .or. &
	3399	(ite < ide-3) ) degrade_xe = .false.
	3400	IF( config_flags%periodic_y .or. &
	3401	config_flags%symmetric_ys .or. &
	3402	(jts > jds+2) ) degrade_ys = .false.
	3403	IF( config_flags%periodic_y .or. &
	3404	config_flags%symmetric_ye .or. &
	3405	(jte < jde-3) ) degrade_ye = .false.
	3406
	3407	!--------------- y - advection first
	3408
	3409	ktf=MIN(kte,kde-1)
	3410	i_start = its
	3411	i_end = MIN(ite,ide-1)
	3412	j_start = jts
	3413	j_end = MIN(jte,jde-1)
	3414
	3415	! higher order flux has a 5 or 7 point stencil, so compute
	3416	! bounds so we can switch to second order flux close to the boundary
	3417
	3418	j_start_f = j_start
	3419	j_end_f = j_end+1
	3420
	3421	IF(degrade_ys) then
	3422	j_start = MAX(jts,jds+1)
	3423	j_start_f = jds+3
	3424	ENDIF
	3425
	3426	IF(degrade_ye) then
	3427	j_end = MIN(jte,jde-2)
	3428	j_end_f = jde-3
	3429	ENDIF
	3430
	3431	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	3432
	3433	! compute fluxes, 5th or 6th order
	3434
	3435	jp1 = 2
	3436	jp0 = 1
	3437
	3438	j_loop_y_flux_5 : DO j = j_start, j_end+1
	3439
	3440	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	3441
	3442	DO k=kts,ktf
	3443	DO i = i_start, i_end
	3444	vel = rv(i,k,j)
	3445	fqy( i, k, jp1 ) = vel*flux5( &
	3446	field(i,k,j-3), field(i,k,j-2), field(i,k,j-1), &
	3447	field(i,k,j ), field(i,k,j+1), field(i,k,j+2), vel )
	3448	ENDDO
	3449	ENDDO
	3450
	3451	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	3452
	3453	DO k=kts,ktf
	3454	DO i = i_start, i_end
	3455	fqy(i,k, jp1) = 0.5rv(i,k,j) &
	3456	(field(i,k,j)+field(i,k,j-1))
	3457
	3458	ENDDO
	3459	ENDDO
	3460
	3461	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	3462
	3463	DO k=kts,ktf
	3464	DO i = i_start, i_end
	3465	vel = rv(i,k,j)
	3466	fqy( i, k, jp1 ) = vel*flux3( &
	3467	field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
	3468	ENDDO
	3469	ENDDO
	3470
	3471	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	3472
	3473	DO k=kts,ktf
	3474	DO i = i_start, i_end
	3475	fqy(i, k, jp1) = 0.5rv(i,k,j) &
	3476	(field(i,k,j)+field(i,k,j-1))
	3477	ENDDO
	3478	ENDDO
	3479
	3480	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	3481
	3482	DO k=kts,ktf
	3483	DO i = i_start, i_end
	3484	vel = rv(i,k,j)
	3485	fqy( i, k, jp1) = vel*flux3( &
	3486	field(i,k,j-2),field(i,k,j-1), &
	3487	field(i,k,j),field(i,k,j+1),vel )
	3488	ENDDO
	3489	ENDDO
	3490
	3491	ENDIF
	3492
	3493	! y flux-divergence into tendency
	3494
	3495	! Comments on polar boundary conditions
	3496	! Same process as for advect_u - tendencies run from jds to jde-1
	3497	! (latitudes are as for u grid, longitudes are displaced)
	3498	! Therefore: flow is only from one side for points next to poles
	3499	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	3500	DO k=kts,ktf
	3501	DO i = i_start, i_end
	3502	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3503	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	3504	END DO
	3505	END DO
	3506	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	3507	DO k=kts,ktf
	3508	DO i = i_start, i_end
	3509	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3510	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	3511	END DO
	3512	END DO
	3513	ELSE ! normal code
	3514
	3515	IF(j > j_start) THEN
	3516
	3517	DO k=kts,ktf
	3518	DO i = i_start, i_end
	3519	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3520	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	3521	ENDDO
	3522	ENDDO
	3523
	3524	ENDIF
	3525
	3526	END IF
	3527
	3528	jtmp = jp1
	3529	jp1 = jp0
	3530	jp0 = jtmp
	3531
	3532	ENDDO j_loop_y_flux_5
	3533
	3534	! next, x - flux divergence
	3535
	3536	i_start = its
	3537	i_end = MIN(ite,ide-1)
	3538
	3539	j_start = jts
	3540	j_end = MIN(jte,jde-1)
	3541
	3542	! higher order flux has a 5 or 7 point stencil, so compute
	3543	! bounds so we can switch to second order flux close to the boundary
	3544
	3545	i_start_f = i_start
	3546	i_end_f = i_end+1
	3547
	3548	IF(degrade_xs) then
	3549	i_start = MAX(ids+1,its)
	3550	i_start_f = i_start+2
	3551	ENDIF
	3552
	3553	IF(degrade_xe) then
	3554	i_end = MIN(ide-2,ite)
	3555	i_end_f = ide-3
	3556	ENDIF
	3557
	3558	! compute fluxes
	3559
	3560	DO j = j_start, j_end
	3561
	3562	! 5th or 6th order flux
	3563
	3564	DO k=kts,ktf
	3565	DO i = i_start_f, i_end_f
	3566	vel = ru(i,k,j)
	3567	fqx( i,k ) = vel*flux5( field(i-3,k,j), field(i-2,k,j), &
	3568	field(i-1,k,j), field(i ,k,j), &
	3569	field(i+1,k,j), field(i+2,k,j), &
	3570	vel )
	3571	ENDDO
	3572	ENDDO
	3573
	3574	! lower order fluxes close to boundaries (if not periodic or symmetric)
	3575
	3576	IF( degrade_xs ) THEN
	3577
	3578	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	3579	i = ids+1
	3580	DO k=kts,ktf
	3581	fqx(i,k) = 0.5*(ru(i,k,j)) &
	3582	*(field(i,k,j)+field(i-1,k,j))
	3583
	3584	ENDDO
	3585	ENDIF
	3586
	3587	i = ids+2
	3588	DO k=kts,ktf
	3589	vel = ru(i,k,j)
	3590	fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
	3591	field(i ,k,j), field(i+1,k,j), &
	3592	vel )
	3593	ENDDO
	3594
	3595	ENDIF
	3596
	3597	IF( degrade_xe ) THEN
	3598
	3599	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	3600	i = ide-1
	3601	DO k=kts,ktf
	3602	fqx(i,k) = 0.5*(ru(i,k,j)) &
	3603	*(field(i,k,j)+field(i-1,k,j))
	3604	ENDDO
	3605	ENDIF
	3606
	3607	i = ide-2
	3608	DO k=kts,ktf
	3609	vel = ru(i,k,j)
	3610	fqx( i,k ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
	3611	field(i ,k,j), field(i+1,k,j), &
	3612	vel )
	3613	ENDDO
	3614
	3615	ENDIF
	3616
	3617	! x flux-divergence into tendency
	3618
	3619	DO k=kts,ktf
	3620	DO i = i_start, i_end
	3621	mrdx=msftx(i,j)rdx ! see ADT eqn 48 [rho->rhoq] dividing by my, 1st term RHS
	3622	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	3623	ENDDO
	3624	ENDDO
	3625
	3626	ENDDO
	3627
	3628
	3629	ELSE IF( horz_order == 4 ) THEN
	3630
	3631	degrade_xs = .true.
	3632	degrade_xe = .true.
	3633	degrade_ys = .true.
	3634	degrade_ye = .true.
	3635
	3636	IF( config_flags%periodic_x .or. &
	3637	config_flags%symmetric_xs .or. &
	3638	(its > ids+1) ) degrade_xs = .false.
	3639	IF( config_flags%periodic_x .or. &
	3640	config_flags%symmetric_xe .or. &
	3641	(ite < ide-2) ) degrade_xe = .false.
	3642	IF( config_flags%periodic_y .or. &
	3643	config_flags%symmetric_ys .or. &
	3644	(jts > jds+1) ) degrade_ys = .false.
	3645	IF( config_flags%periodic_y .or. &
	3646	config_flags%symmetric_ye .or. &
	3647	(jte < jde-2) ) degrade_ye = .false.
	3648
	3649	! begin flux computations
	3650	! start with x flux divergence
	3651
	3652	ktf=MIN(kte,kde-1)
	3653
	3654	i_start = its
	3655	i_end = MIN(ite,ide-1)
	3656	j_start = jts
	3657	j_end = MIN(jte,jde-1)
	3658
	3659	! 3rd or 4th order flux has a 5 point stencil, so compute
	3660	! bounds so we can switch to second order flux close to the boundary
	3661
	3662	i_start_f = i_start
	3663	i_end_f = i_end+1
	3664
	3665	IF(degrade_xs) then
	3666	i_start = ids+1
	3667	i_start_f = i_start+1
	3668	ENDIF
	3669
	3670	IF(degrade_xe) then
	3671	i_end = ide-2
	3672	i_end_f = ide-2
	3673	ENDIF
	3674
	3675	! compute fluxes
	3676
	3677	DO j = j_start, j_end
	3678
	3679	! 3rd or 4th order flux
	3680
	3681	DO k=kts,ktf
	3682	DO i = i_start_f, i_end_f
	3683
	3684	fqx( i, k) = ru(i,k,j)*flux4( field(i-2,k,j), field(i-1,k,j), &
	3685	field(i ,k,j), field(i+1,k,j), &
	3686	ru(i,k,j) )
	3687	ENDDO
	3688	ENDDO
	3689
	3690	! second order flux close to boundaries (if not periodic or symmetric)
	3691
	3692	IF( degrade_xs ) THEN
	3693	DO k=kts,ktf
	3694	fqx(i_start, k) = 0.5*ru(i_start,k,j) &
	3695	*(field(i_start,k,j)+field(i_start-1,k,j))
	3696	ENDDO
	3697	ENDIF
	3698
	3699	IF( degrade_xe ) THEN
	3700	DO k=kts,ktf
	3701	fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j) &
	3702	*(field(i_end+1,k,j)+field(i_end,k,j))
	3703	ENDDO
	3704	ENDIF
	3705
	3706	! x flux-divergence into tendency
	3707
	3708	DO k=kts,ktf
	3709	DO i = i_start, i_end
	3710	mrdx=msftx(i,j)rdx ! see ADT eqn 48 [rho->rhoq] dividing by my, 1st term RHS
	3711	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	3712	ENDDO
	3713	ENDDO
	3714
	3715	ENDDO
	3716
	3717
	3718	! next -> y flux divergence calculation
	3719
	3720	i_start = its
	3721	i_end = MIN(ite,ide-1)
	3722	j_start = jts
	3723	j_end = MIN(jte,jde-1)
	3724
	3725	! 3rd or 4th order flux has a 5 point stencil, so compute
	3726	! bounds so we can switch to second order flux close to the boundary
	3727
	3728	j_start_f = j_start
	3729	j_end_f = j_end+1
	3730
	3731	IF(degrade_ys) then
	3732	j_start = jds+1
	3733	j_start_f = j_start+1
	3734	ENDIF
	3735
	3736	IF(degrade_ye) then
	3737	j_end = jde-2
	3738	j_end_f = jde-2
	3739	ENDIF
	3740
	3741	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	3742
	3743	jp1 = 2
	3744	jp0 = 1
	3745
	3746	DO j = j_start, j_end+1
	3747
	3748	IF ((j < j_start_f) .and. degrade_ys) THEN
	3749	DO k = kts, ktf
	3750	DO i = i_start, i_end
	3751	fqy(i,k,jp1) = 0.5*rv(i,k,j_start) &
	3752	*(field(i,k,j_start)+field(i,k,j_start-1))
	3753	ENDDO
	3754	ENDDO
	3755	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	3756	DO k = kts, ktf
	3757	DO i = i_start, i_end
	3758	! Assumes j>j_end_f is ONLY j_end+1 ...
	3759	! fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1) &
	3760	! *(field(i,k,j_end+1)+field(i,k,j_end))
	3761	fqy(i,k,jp1) = 0.5*rv(i,k,j) &
	3762	*(field(i,k,j)+field(i,k,j-1))
	3763	ENDDO
	3764	ENDDO
	3765	ELSE
	3766	! 3rd or 4th order flux
	3767	DO k = kts, ktf
	3768	DO i = i_start, i_end
	3769	fqy( i, k, jp1 ) = rv(i,k,j)*flux4( field(i,k,j-2), field(i,k,j-1), &
	3770	field(i,k,j ), field(i,k,j+1), &
	3771	rv(i,k,j) )
	3772	ENDDO
	3773	ENDDO
	3774	END IF
	3775
	3776	! y flux-divergence into tendency
	3777
	3778	! Comments on polar boundary conditions
	3779	! Same process as for advect_u - tendencies run from jds to jde-1
	3780	! (latitudes are as for u grid, longitudes are displaced)
	3781	! Therefore: flow is only from one side for points next to poles
	3782	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	3783	DO k=kts,ktf
	3784	DO i = i_start, i_end
	3785	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3786	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	3787	END DO
	3788	END DO
	3789	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	3790	DO k=kts,ktf
	3791	DO i = i_start, i_end
	3792	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3793	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	3794	END DO
	3795	END DO
	3796	ELSE ! normal code
	3797
	3798	IF ( j > j_start ) THEN
	3799
	3800	DO k=kts,ktf
	3801	DO i = i_start, i_end
	3802	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3803	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	3804	ENDDO
	3805	ENDDO
	3806
	3807	END IF
	3808
	3809	END IF
	3810
	3811	jtmp = jp1
	3812	jp1 = jp0
	3813	jp0 = jtmp
	3814
	3815	ENDDO
	3816
	3817
	3818	ELSE IF( horz_order == 3 ) THEN
	3819
	3820	degrade_xs = .true.
	3821	degrade_xe = .true.
	3822	degrade_ys = .true.
	3823	degrade_ye = .true.
	3824
	3825	IF( config_flags%periodic_x .or. &
	3826	config_flags%symmetric_xs .or. &
	3827	(its > ids+1) ) degrade_xs = .false.
	3828	IF( config_flags%periodic_x .or. &
	3829	config_flags%symmetric_xe .or. &
	3830	(ite < ide-2) ) degrade_xe = .false.
	3831	IF( config_flags%periodic_y .or. &
	3832	config_flags%symmetric_ys .or. &
	3833	(jts > jds+1) ) degrade_ys = .false.
	3834	IF( config_flags%periodic_y .or. &
	3835	config_flags%symmetric_ye .or. &
	3836	(jte < jde-2) ) degrade_ye = .false.
	3837
	3838	! begin flux computations
	3839	! start with x flux divergence
	3840
	3841	ktf=MIN(kte,kde-1)
	3842
	3843	i_start = its
	3844	i_end = MIN(ite,ide-1)
	3845	j_start = jts
	3846	j_end = MIN(jte,jde-1)
	3847
	3848	! 3rd or 4th order flux has a 5 point stencil, so compute
	3849	! bounds so we can switch to second order flux close to the boundary
	3850
	3851	i_start_f = i_start
	3852	i_end_f = i_end+1
	3853
	3854	IF(degrade_xs) then
	3855	i_start = ids+1
	3856	i_start_f = i_start+1
	3857	ENDIF
	3858
	3859	IF(degrade_xe) then
	3860	i_end = ide-2
	3861	i_end_f = ide-2
	3862	ENDIF
	3863
	3864	! compute fluxes
	3865
	3866	DO j = j_start, j_end
	3867
	3868	! 3rd or 4th order flux
	3869
	3870	DO k=kts,ktf
	3871	DO i = i_start_f, i_end_f
	3872
	3873	fqx( i, k) = ru(i,k,j)*flux3( field(i-2,k,j), field(i-1,k,j), &
	3874	field(i ,k,j), field(i+1,k,j), &
	3875	ru(i,k,j) )
	3876	ENDDO
	3877	ENDDO
	3878
	3879	! second order flux close to boundaries (if not periodic or symmetric)
	3880
	3881	IF( degrade_xs ) THEN
	3882	DO k=kts,ktf
	3883	fqx(i_start, k) = 0.5*ru(i_start,k,j) &
	3884	*(field(i_start,k,j)+field(i_start-1,k,j))
	3885	ENDDO
	3886	ENDIF
	3887
	3888	IF( degrade_xe ) THEN
	3889	DO k=kts,ktf
	3890	fqx(i_end+1,k ) = 0.5*ru(i_end+1,k,j) &
	3891	*(field(i_end+1,k,j)+field(i_end,k,j))
	3892	ENDDO
	3893	ENDIF
	3894
	3895	! x flux-divergence into tendency
	3896
	3897	DO k=kts,ktf
	3898	DO i = i_start, i_end
	3899	mrdx=msftx(i,j)rdx ! see ADT eqn 48 [rho->rhoq] dividing by my, 1st term RHS
	3900	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	3901	ENDDO
	3902	ENDDO
	3903
	3904	ENDDO
	3905
	3906
	3907	! next -> y flux divergence calculation
	3908
	3909	i_start = its
	3910	i_end = MIN(ite,ide-1)
	3911	j_start = jts
	3912	j_end = MIN(jte,jde-1)
	3913
	3914	! 3rd or 4th order flux has a 5 point stencil, so compute
	3915	! bounds so we can switch to second order flux close to the boundary
	3916
	3917	j_start_f = j_start
	3918	j_end_f = j_end+1
	3919
	3920	IF(degrade_ys) then
	3921	j_start = jds+1
	3922	j_start_f = j_start+1
	3923	ENDIF
	3924
	3925	IF(degrade_ye) then
	3926	j_end = jde-2
	3927	j_end_f = jde-2
	3928	ENDIF
	3929
	3930	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	3931
	3932	jp1 = 2
	3933	jp0 = 1
	3934
	3935	DO j = j_start, j_end+1
	3936
	3937	IF ((j < j_start_f) .and. degrade_ys) THEN
	3938	DO k = kts, ktf
	3939	DO i = i_start, i_end
	3940	fqy(i,k,jp1) = 0.5*rv(i,k,j_start) &
	3941	*(field(i,k,j_start)+field(i,k,j_start-1))
	3942	ENDDO
	3943	ENDDO
	3944	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	3945	DO k = kts, ktf
	3946	DO i = i_start, i_end
	3947	! Assumes j>j_end_f is ONLY j_end+1 ...
	3948	! fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1) &
	3949	! *(field(i,k,j_end+1)+field(i,k,j_end))
	3950	fqy(i,k,jp1) = 0.5*rv(i,k,j) &
	3951	*(field(i,k,j)+field(i,k,j-1))
	3952	ENDDO
	3953	ENDDO
	3954	ELSE
	3955	! 3rd or 4th order flux
	3956	DO k = kts, ktf
	3957	DO i = i_start, i_end
	3958	fqy( i, k, jp1 ) = rv(i,k,j)*flux3( field(i,k,j-2), field(i,k,j-1), &
	3959	field(i,k,j ), field(i,k,j+1), &
	3960	rv(i,k,j) )
	3961	ENDDO
	3962	ENDDO
	3963	END IF
	3964
	3965	! y flux-divergence into tendency
	3966
	3967	! Comments on polar boundary conditions
	3968	! Same process as for advect_u - tendencies run from jds to jde-1
	3969	! (latitudes are as for u grid, longitudes are displaced)
	3970	! Therefore: flow is only from one side for points next to poles
	3971	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	3972	DO k=kts,ktf
	3973	DO i = i_start, i_end
	3974	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3975	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	3976	END DO
	3977	END DO
	3978	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	3979	DO k=kts,ktf
	3980	DO i = i_start, i_end
	3981	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3982	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	3983	END DO
	3984	END DO
	3985	ELSE ! normal code
	3986
	3987	IF ( j > j_start ) THEN
	3988
	3989	DO k=kts,ktf
	3990	DO i = i_start, i_end
	3991	mrdy=msftx(i,j-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	3992	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	3993	ENDDO
	3994	ENDDO
	3995
	3996	END IF
	3997
	3998	END IF
	3999
	4000	jtmp = jp1
	4001	jp1 = jp0
	4002	jp0 = jtmp
	4003
	4004	ENDDO
	4005
	4006	ELSE IF( horz_order == 2 ) THEN
	4007
	4008	i_start = its
	4009	i_end = MIN(ite,ide-1)
	4010	j_start = jts
	4011	j_end = MIN(jte,jde-1)
	4012
	4013	IF ( .NOT. config_flags%periodic_x ) THEN
	4014	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	4015	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite)
	4016	ENDIF
	4017
	4018	DO j = j_start, j_end
	4019	DO k = kts, ktf
	4020	DO i = i_start, i_end
	4021	mrdx=msftx(i,j)rdx ! see ADT eqn 48 [rho->rhoq] dividing by my, 1st term RHS
	4022	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
	4023	(ru(i+1,k,j)(field(i+1,k,j)+field(i ,k,j)) &
	4024	-ru(i ,k,j)*(field(i ,k,j)+field(i-1,k,j)))
	4025	ENDDO
	4026	ENDDO
	4027	ENDDO
	4028
	4029	i_start = its
	4030	i_end = MIN(ite,ide-1)
	4031
	4032	! Polar boundary conditions are like open or specified
	4033	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	4034	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-2,jte)
	4035
	4036	DO j = j_start, j_end
	4037	DO k = kts, ktf
	4038	DO i = i_start, i_end
	4039	mrdy=msftx(i,j)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	4040	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
	4041	(rv(i,k,j+1)(field(i,k,j+1)+field(i,k,j )) &
	4042	-rv(i,k,j )*(field(i,k,j )+field(i,k,j-1)))
	4043	ENDDO
	4044	ENDDO
	4045	ENDDO
	4046
	4047	! Polar boundary condtions
	4048	! These won't be covered in the loop above...
	4049	IF (config_flags%polar) THEN
	4050	IF (jts == jds) THEN
	4051	DO k=kts,ktf
	4052	DO i = i_start, i_end
	4053	mrdy=msftx(i,jds)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	4054	tendency(i,k,jds)=tendency(i,k,jds) -mrdy*0.5 &
	4055	rv(i,k,jds+1)(field(i,k,jds+1)+field(i,k,jds))
	4056	END DO
	4057	END DO
	4058	END IF
	4059	IF (jte == jde) THEN
	4060	DO k=kts,ktf
	4061	DO i = i_start, i_end
	4062	mrdy=msftx(i,jde-1)rdy ! see ADT eqn 48 [rho->rhoq] dividing by my, 2nd term RHS
	4063	tendency(i,k,jde-1)=tendency(i,k,jde-1) +mrdy*0.5 &
	4064	rv(i,k,jde-1)(field(i,k,jde-1)+field(i,k,jde-2))
	4065	END DO
	4066	END DO
	4067	END IF
	4068	END IF
	4069
	4070	ELSE IF ( horz_order == 0 ) THEN
	4071
	4072	! Just in case we want to turn horizontal advection off, we can do it
	4073
	4074	ELSE
	4075
	4076	WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_6a, h_order not known ',horz_order
	4077	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	4078
	4079	ENDIF horizontal_order_test
	4080
	4081	! pick up the rest of the horizontal radiation boundary conditions.
	4082	! (these are the computations that don't require 'cb'.
	4083	! first, set to index ranges
	4084
	4085	i_start = its
	4086	i_end = MIN(ite,ide-1)
	4087	j_start = jts
	4088	j_end = MIN(jte,jde-1)
	4089
	4090	! compute x (u) conditions for v, w, or scalar
	4091
	4092	IF( (config_flags%open_xs) .and. (its == ids) ) THEN
	4093
	4094	DO j = j_start, j_end
	4095	DO k = kts, ktf
	4096	ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
	4097	tendency(its,k,j) = tendency(its,k,j) &
	4098	- rdx*( &
	4099	ub*( field_old(its+1,k,j) &
	4100	- field_old(its ,k,j) ) + &
	4101	field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j)) &
	4102	)
	4103	ENDDO
	4104	ENDDO
	4105
	4106	ENDIF
	4107
	4108	IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
	4109
	4110	DO j = j_start, j_end
	4111	DO k = kts, ktf
	4112	ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
	4113	tendency(i_end,k,j) = tendency(i_end,k,j) &
	4114	- rdx*( &
	4115	ub*( field_old(i_end ,k,j) &
	4116	- field_old(i_end-1,k,j) ) + &
	4117	field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j)) &
	4118	)
	4119	ENDDO
	4120	ENDDO
	4121
	4122	ENDIF
	4123
	4124	IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
	4125
	4126	DO i = i_start, i_end
	4127	DO k = kts, ktf
	4128	vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
	4129	tendency(i,k,jts) = tendency(i,k,jts) &
	4130	- rdy*( &
	4131	vb*( field_old(i,k,jts+1) &
	4132	- field_old(i,k,jts ) ) + &
	4133	field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts)) &
	4134	)
	4135	ENDDO
	4136	ENDDO
	4137
	4138	ENDIF
	4139
	4140	IF( (config_flags%open_ye) .and. (jte == jde)) THEN
	4141
	4142	DO i = i_start, i_end
	4143	DO k = kts, ktf
	4144	vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
	4145	tendency(i,k,j_end) = tendency(i,k,j_end) &
	4146	- rdy*( &
	4147	vb*( field_old(i,k,j_end ) &
	4148	- field_old(i,k,j_end-1) ) + &
	4149	field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1)) &
	4150	)
	4151	ENDDO
	4152	ENDDO
	4153
	4154	ENDIF
	4155
	4156
	4157	!-------------------- vertical advection
	4158	! Scalar equation has 3rd term on RHS = - partial d/dz (q rho w /my)
	4159	! Here we have: - partial d/dz (q*rom) = - partial d/dz (q rho w / my)
	4160	! So we don't need to make a correction for advect_scalar
	4161
	4162	i_start = its
	4163	i_end = MIN(ite,ide-1)
	4164	j_start = jts
	4165	j_end = MIN(jte,jde-1)
	4166
	4167	DO i = i_start, i_end
	4168	vflux(i,kts)=0.
	4169	vflux(i,kte)=0.
	4170	ENDDO
	4171
	4172	vert_order_test : IF (vert_order == 6) THEN
	4173
	4174	DO j = j_start, j_end
	4175
	4176	DO k=kts+3,ktf-2
	4177	DO i = i_start, i_end
	4178	vel=rom(i,k,j)
	4179	vflux(i,k) = vel*flux6( &
	4180	field(i,k-3,j), field(i,k-2,j), field(i,k-1,j), &
	4181	field(i,k ,j), field(i,k+1,j), field(i,k+2,j), -vel )
	4182	ENDDO
	4183	ENDDO
	4184
	4185	DO i = i_start, i_end
	4186
	4187	k=kts+1
	4188	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4189
	4190	k = kts+2
	4191	vel=rom(i,k,j)
	4192	vflux(i,k) = vel*flux4( &
	4193	field(i,k-2,j), field(i,k-1,j), &
	4194	field(i,k ,j), field(i,k+1,j), -vel )
	4195	k = ktf-1
	4196	vel=rom(i,k,j)
	4197	vflux(i,k) = vel*flux4( &
	4198	field(i,k-2,j), field(i,k-1,j), &
	4199	field(i,k ,j), field(i,k+1,j), -vel )
	4200
	4201	k=ktf
	4202	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4203	ENDDO
	4204
	4205	DO k=kts,ktf
	4206	DO i = i_start, i_end
	4207	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	4208	ENDDO
	4209	ENDDO
	4210
	4211	ENDDO
	4212
	4213	ELSE IF (vert_order == 5) THEN
	4214
	4215	DO j = j_start, j_end
	4216
	4217	DO k=kts+3,ktf-2
	4218	DO i = i_start, i_end
	4219	vel=rom(i,k,j)
	4220	vflux(i,k) = vel*flux5( &
	4221	field(i,k-3,j), field(i,k-2,j), field(i,k-1,j), &
	4222	field(i,k ,j), field(i,k+1,j), field(i,k+2,j), -vel )
	4223	ENDDO
	4224	ENDDO
	4225
	4226	DO i = i_start, i_end
	4227
	4228	k=kts+1
	4229	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4230
	4231	k = kts+2
	4232	vel=rom(i,k,j)
	4233	vflux(i,k) = vel*flux3( &
	4234	field(i,k-2,j), field(i,k-1,j), &
	4235	field(i,k ,j), field(i,k+1,j), -vel )
	4236	k = ktf-1
	4237	vel=rom(i,k,j)
	4238	vflux(i,k) = vel*flux3( &
	4239	field(i,k-2,j), field(i,k-1,j), &
	4240	field(i,k ,j), field(i,k+1,j), -vel )
	4241
	4242	k=ktf
	4243	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4244	ENDDO
	4245
	4246	DO k=kts,ktf
	4247	DO i = i_start, i_end
	4248	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	4249	ENDDO
	4250	ENDDO
	4251
	4252	ENDDO
	4253
	4254	ELSE IF (vert_order == 4) THEN
	4255
	4256	DO j = j_start, j_end
	4257
	4258	DO k=kts+2,ktf-1
	4259	DO i = i_start, i_end
	4260	vel=rom(i,k,j)
	4261	vflux(i,k) = vel*flux4( &
	4262	field(i,k-2,j), field(i,k-1,j), &
	4263	field(i,k ,j), field(i,k+1,j), -vel )
	4264	ENDDO
	4265	ENDDO
	4266
	4267	DO i = i_start, i_end
	4268
	4269	k=kts+1
	4270	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4271	k=ktf
	4272	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4273	ENDDO
	4274
	4275	DO k=kts,ktf
	4276	DO i = i_start, i_end
	4277	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	4278	ENDDO
	4279	ENDDO
	4280
	4281	ENDDO
	4282
	4283	ELSE IF (vert_order == 3) THEN
	4284
	4285	DO j = j_start, j_end
	4286
	4287	DO k=kts+2,ktf-1
	4288	DO i = i_start, i_end
	4289	vel=rom(i,k,j)
	4290	vflux(i,k) = vel*flux3( &
	4291	field(i,k-2,j), field(i,k-1,j), &
	4292	field(i,k ,j), field(i,k+1,j), -vel )
	4293	ENDDO
	4294	ENDDO
	4295
	4296	DO i = i_start, i_end
	4297
	4298	k=kts+1
	4299	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4300	k=ktf
	4301	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4302	ENDDO
	4303
	4304	DO k=kts,ktf
	4305	DO i = i_start, i_end
	4306	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	4307	ENDDO
	4308	ENDDO
	4309
	4310	ENDDO
	4311
	4312
	4313	ELSE IF (vert_order == 2) THEN
	4314
	4315	DO j = j_start, j_end
	4316	DO k = kts+1, ktf
	4317	DO i = i_start, i_end
	4318	vflux(i,k)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	4319	ENDDO
	4320	ENDDO
	4321
	4322	DO k = kts, ktf
	4323	DO i = i_start, i_end
	4324	tendency(i,k,j)=tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
	4325	ENDDO
	4326	ENDDO
	4327
	4328	ENDDO
	4329
	4330	ELSE
	4331
	4332	WRITE (wrf_err_message,*) ' advect_scalar_6a, v_order not known ',vert_order
	4333	CALL wrf_error_fatal ( wrf_err_message )
	4334
	4335	ENDIF vert_order_test
	4336
	4337	END SUBROUTINE advect_scalar
	4338
	4339	!---------------------------------------------------------------------------------
	4340
	4341	SUBROUTINE advect_w ( w, w_old, tendency, &
	4342	ru, rv, rom, &
	4343	mut, time_step, config_flags, &
	4344	msfux, msfuy, msfvx, msfvy, &
	4345	msftx, msfty, &
	4346	fzm, fzp, &
	4347	rdx, rdy, rdzu, &
	4348	ids, ide, jds, jde, kds, kde, &
	4349	ims, ime, jms, jme, kms, kme, &
	4350	its, ite, jts, jte, kts, kte )
	4351
	4352	IMPLICIT NONE
	4353
	4354	! Input data
	4355
	4356	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	4357
	4358	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	4359	ims, ime, jms, jme, kms, kme, &
	4360	its, ite, jts, jte, kts, kte
	4361
	4362	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: w, &
	4363	w_old, &
	4364	ru, &
	4365	rv, &
	4366	rom
	4367
	4368	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
	4369	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	4370
	4371	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	4372	msfuy, &
	4373	msfvx, &
	4374	msfvy, &
	4375	msftx, &
	4376	msfty
	4377
	4378	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	4379	fzp, &
	4380	rdzu
	4381
	4382	REAL , INTENT(IN ) :: rdx, &
	4383	rdy
	4384	INTEGER , INTENT(IN ) :: time_step
	4385
	4386
	4387	! Local data
	4388
	4389	INTEGER :: i, j, k, itf, jtf, ktf
	4390	INTEGER :: i_start, i_end, j_start, j_end
	4391	INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
	4392	INTEGER :: jmin, jmax, jp, jm, imin, imax
	4393
	4394	REAL :: mrdx, mrdy, ub, vb, uw, vw
	4395	REAL , DIMENSION(its:ite, kts:kte) :: vflux
	4396
	4397	INTEGER :: horz_order, vert_order
	4398
	4399	REAL, DIMENSION( its:ite+1, kts:kte ) :: fqx
	4400	REAL, DIMENSION( its:ite, kts:kte, 2 ) :: fqy
	4401
	4402	LOGICAL :: degrade_xs, degrade_ys
	4403	LOGICAL :: degrade_xe, degrade_ye
	4404
	4405	INTEGER :: jp1, jp0, jtmp
	4406
	4407	! definition of flux operators, 3rd, 4th, 5th or 6th order
	4408
	4409	REAL :: flux3, flux4, flux5, flux6
	4410	REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
	4411
	4412	flux4(q_im2, q_im1, q_i, q_ip1, ua) = &
	4413	( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
	4414
	4415	flux3(q_im2, q_im1, q_i, q_ip1, ua) = &
	4416	flux4(q_im2, q_im1, q_i, q_ip1, ua) + &
	4417	sign(1,time_step)sign(1.,ua)((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0
	4418
	4419	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	4420	( 37.(q_i+q_im1) - 8.(q_ip1+q_im2) &
	4421	+(q_ip2+q_im3) )/60.0
	4422
	4423	flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	4424	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) &
	4425	-sign(1,time_step)sign(1.,ua)( &
	4426	(q_ip2-q_im3)-5.(q_ip1-q_im2)+10.(q_i-q_im1) )/60.0
	4427
	4428
	4429	LOGICAL :: specified
	4430
	4431	specified = .false.
	4432	if(config_flags%specified .or. config_flags%nested) specified = .true.
	4433
	4434	! set order for the advection scheme
	4435
	4436	ktf=MIN(kte,kde-1)
	4437	horz_order = config_flags%h_sca_adv_order
	4438	vert_order = config_flags%v_sca_adv_order
	4439
	4440	! here is the choice of flux operators
	4441
	4442	! begin with horizontal flux divergence
	4443
	4444	horizontal_order_test : IF( horz_order == 6 ) THEN
	4445
	4446	! determine boundary mods for flux operators
	4447	! We degrade the flux operators from 3rd/4th order
	4448	! to second order one gridpoint in from the boundaries for
	4449	! all boundary conditions except periodic and symmetry - these
	4450	! conditions have boundary zone data fill for correct application
	4451	! of the higher order flux stencils
	4452
	4453	degrade_xs = .true.
	4454	degrade_xe = .true.
	4455	degrade_ys = .true.
	4456	degrade_ye = .true.
	4457
	4458	IF( config_flags%periodic_x .or. &
	4459	config_flags%symmetric_xs .or. &
	4460	(its > ids+2) ) degrade_xs = .false.
	4461	IF( config_flags%periodic_x .or. &
	4462	config_flags%symmetric_xe .or. &
	4463	(ite < ide-3) ) degrade_xe = .false.
	4464	IF( config_flags%periodic_y .or. &
	4465	config_flags%symmetric_ys .or. &
	4466	(jts > jds+2) ) degrade_ys = .false.
	4467	IF( config_flags%periodic_y .or. &
	4468	config_flags%symmetric_ye .or. &
	4469	(jte < jde-3) ) degrade_ye = .false.
	4470
	4471	!--------------- y - advection first
	4472
	4473	i_start = its
	4474	i_end = MIN(ite,ide-1)
	4475	j_start = jts
	4476	j_end = MIN(jte,jde-1)
	4477
	4478	! higher order flux has a 5 or 7 point stencil, so compute
	4479	! bounds so we can switch to second order flux close to the boundary
	4480
	4481	j_start_f = j_start
	4482	j_end_f = j_end+1
	4483
	4484	IF(degrade_ys) then
	4485	j_start = MAX(jts,jds+1)
	4486	j_start_f = jds+3
	4487	ENDIF
	4488
	4489	IF(degrade_ye) then
	4490	j_end = MIN(jte,jde-2)
	4491	j_end_f = jde-3
	4492	ENDIF
	4493
	4494	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	4495
	4496	! compute fluxes, 5th or 6th order
	4497
	4498	jp1 = 2
	4499	jp0 = 1
	4500
	4501	j_loop_y_flux_6 : DO j = j_start, j_end+1
	4502
	4503	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
	4504
	4505	DO k=kts+1,ktf
	4506	DO i = i_start, i_end
	4507	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4508	fqy( i, k, jp1 ) = vel*flux6( &
	4509	w(i,k,j-3), w(i,k,j-2), w(i,k,j-1), &
	4510	w(i,k,j ), w(i,k,j+1), w(i,k,j+2), vel )
	4511	ENDDO
	4512	ENDDO
	4513
	4514	k = ktf+1
	4515	DO i = i_start, i_end
	4516	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4517	fqy( i, k, jp1 ) = vel*flux6( &
	4518	w(i,k,j-3), w(i,k,j-2), w(i,k,j-1), &
	4519	w(i,k,j ), w(i,k,j+1), w(i,k,j+2), vel )
	4520	ENDDO
	4521
	4522	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	4523
	4524	DO k=kts+1,ktf
	4525	DO i = i_start, i_end
	4526	fqy(i, k, jp1) = 0.5(fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)) &
	4527	(w(i,k,j)+w(i,k,j-1))
	4528	ENDDO
	4529	ENDDO
	4530
	4531	k = ktf+1
	4532	DO i = i_start, i_end
	4533	fqy(i, k, jp1) = 0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)) &
	4534	(w(i,k,j)+w(i,k,j-1))
	4535	ENDDO
	4536
	4537	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	4538
	4539	DO k=kts+1,ktf
	4540	DO i = i_start, i_end
	4541	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4542	fqy( i, k, jp1 ) = vel*flux4( &
	4543	w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
	4544	ENDDO
	4545	ENDDO
	4546
	4547	k = ktf+1
	4548	DO i = i_start, i_end
	4549	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4550	fqy( i, k, jp1 ) = vel*flux4( &
	4551	w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
	4552	ENDDO
	4553
	4554	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	4555
	4556	DO k=kts+1,ktf
	4557	DO i = i_start, i_end
	4558	fqy(i, k, jp1) = 0.5(fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)) &
	4559	(w(i,k,j)+w(i,k,j-1))
	4560	ENDDO
	4561	ENDDO
	4562
	4563	k = ktf+1
	4564	DO i = i_start, i_end
	4565	fqy(i, k, jp1) = 0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)) &
	4566	(w(i,k,j)+w(i,k,j-1))
	4567	ENDDO
	4568
	4569	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	4570
	4571	DO k=kts+1,ktf
	4572	DO i = i_start, i_end
	4573	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4574	fqy( i, k, jp1 ) = vel*flux4( &
	4575	w(i,k,j-2),w(i,k,j-1), &
	4576	w(i,k,j),w(i,k,j+1),vel )
	4577	ENDDO
	4578	ENDDO
	4579
	4580	k = ktf+1
	4581	DO i = i_start, i_end
	4582	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4583	fqy( i, k, jp1 ) = vel*flux4( &
	4584	w(i,k,j-2),w(i,k,j-1), &
	4585	w(i,k,j),w(i,k,j+1),vel )
	4586	ENDDO
	4587
	4588	ENDIF
	4589
	4590	! y flux-divergence into tendency
	4591
	4592	! Comments for polar boundary conditions
	4593	! Same process as for advect_u - tendencies run from jds to jde-1
	4594	! (latitudes are as for u grid, longitudes are displaced)
	4595	! Therefore: flow is only from one side for points next to poles
	4596	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	4597	DO k=kts,ktf
	4598	DO i = i_start, i_end
	4599	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4600	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	4601	ENDDO
	4602	ENDDO
	4603	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	4604	DO k=kts,ktf
	4605	DO i = i_start, i_end
	4606	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4607	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	4608	END DO
	4609	END DO
	4610	ELSE ! normal code
	4611
	4612	IF(j > j_start) THEN
	4613
	4614	DO k=kts+1,ktf+1
	4615	DO i = i_start, i_end
	4616	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4617	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	4618	ENDDO
	4619	ENDDO
	4620
	4621	ENDIF
	4622
	4623	ENDIF
	4624
	4625	jtmp = jp1
	4626	jp1 = jp0
	4627	jp0 = jtmp
	4628
	4629	ENDDO j_loop_y_flux_6
	4630
	4631	! next, x - flux divergence
	4632
	4633	i_start = its
	4634	i_end = MIN(ite,ide-1)
	4635
	4636	j_start = jts
	4637	j_end = MIN(jte,jde-1)
	4638
	4639	! higher order flux has a 5 or 7 point stencil, so compute
	4640	! bounds so we can switch to second order flux close to the boundary
	4641
	4642	i_start_f = i_start
	4643	i_end_f = i_end+1
	4644
	4645	IF(degrade_xs) then
	4646	i_start = MAX(ids+1,its)
	4647	i_start_f = i_start+2
	4648	ENDIF
	4649
	4650	IF(degrade_xe) then
	4651	i_end = MIN(ide-2,ite)
	4652	i_end_f = ide-3
	4653	ENDIF
	4654
	4655	! compute fluxes
	4656
	4657	DO j = j_start, j_end
	4658
	4659	! 5th or 6th order flux
	4660
	4661	DO k=kts+1,ktf
	4662	DO i = i_start_f, i_end_f
	4663	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	4664	fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j), &
	4665	w(i-1,k,j), w(i ,k,j), &
	4666	w(i+1,k,j), w(i+2,k,j), &
	4667	vel )
	4668	ENDDO
	4669	ENDDO
	4670
	4671	k = ktf+1
	4672	DO i = i_start_f, i_end_f
	4673	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	4674	fqx( i,k ) = vel*flux6( w(i-3,k,j), w(i-2,k,j), &
	4675	w(i-1,k,j), w(i ,k,j), &
	4676	w(i+1,k,j), w(i+2,k,j), &
	4677	vel )
	4678	ENDDO
	4679
	4680	! lower order fluxes close to boundaries (if not periodic or symmetric)
	4681
	4682	IF( degrade_xs ) THEN
	4683
	4684	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	4685	i = ids+1
	4686	DO k=kts+1,ktf
	4687	fqx(i,k) = 0.5(fzm(k)ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
	4688	*(w(i,k,j)+w(i-1,k,j))
	4689	ENDDO
	4690	k = ktf+1
	4691	fqx(i,k) = 0.5((2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
	4692	*(w(i,k,j)+w(i-1,k,j))
	4693	ENDIF
	4694
	4695	DO k=kts+1,ktf
	4696	i = i_start+1
	4697	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	4698	fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	4699	w(i ,k,j), w(i+1,k,j), &
	4700	vel )
	4701	ENDDO
	4702
	4703	k = ktf+1
	4704	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	4705	fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	4706	w(i ,k,j), w(i+1,k,j), &
	4707	vel )
	4708	ENDIF
	4709
	4710	IF( degrade_xe ) THEN
	4711
	4712	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	4713	i = ide-1
	4714	DO k=kts+1,ktf
	4715	fqx(i,k) = 0.5(fzm(k)ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
	4716	*(w(i,k,j)+w(i-1,k,j))
	4717	ENDDO
	4718	k = ktf+1
	4719	fqx(i,k) = 0.5((2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
	4720	*(w(i,k,j)+w(i-1,k,j))
	4721	ENDIF
	4722
	4723	i = ide-2
	4724	DO k=kts+1,ktf
	4725	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	4726	fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	4727	w(i ,k,j), w(i+1,k,j), &
	4728	vel )
	4729	ENDDO
	4730
	4731	k = ktf+1
	4732	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	4733	fqx( i,k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	4734	w(i ,k,j), w(i+1,k,j), &
	4735	vel )
	4736	ENDIF
	4737
	4738	! x flux-divergence into tendency
	4739
	4740	DO k=kts+1,ktf+1
	4741	DO i = i_start, i_end
	4742	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	4743	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	4744	ENDDO
	4745	ENDDO
	4746
	4747	ENDDO
	4748
	4749
	4750	ELSE IF (horz_order == 5 ) THEN
	4751
	4752	! determine boundary mods for flux operators
	4753	! We degrade the flux operators from 3rd/4th order
	4754	! to second order one gridpoint in from the boundaries for
	4755	! all boundary conditions except periodic and symmetry - these
	4756	! conditions have boundary zone data fill for correct application
	4757	! of the higher order flux stencils
	4758
	4759	degrade_xs = .true.
	4760	degrade_xe = .true.
	4761	degrade_ys = .true.
	4762	degrade_ye = .true.
	4763
	4764	IF( config_flags%periodic_x .or. &
	4765	config_flags%symmetric_xs .or. &
	4766	(its > ids+2) ) degrade_xs = .false.
	4767	IF( config_flags%periodic_x .or. &
	4768	config_flags%symmetric_xe .or. &
	4769	(ite < ide-3) ) degrade_xe = .false.
	4770	IF( config_flags%periodic_y .or. &
	4771	config_flags%symmetric_ys .or. &
	4772	(jts > jds+2) ) degrade_ys = .false.
	4773	IF( config_flags%periodic_y .or. &
	4774	config_flags%symmetric_ye .or. &
	4775	(jte < jde-3) ) degrade_ye = .false.
	4776
	4777	!--------------- y - advection first
	4778
	4779	i_start = its
	4780	i_end = MIN(ite,ide-1)
	4781	j_start = jts
	4782	j_end = MIN(jte,jde-1)
	4783
	4784	! higher order flux has a 5 or 7 point stencil, so compute
	4785	! bounds so we can switch to second order flux close to the boundary
	4786
	4787	j_start_f = j_start
	4788	j_end_f = j_end+1
	4789
	4790	IF(degrade_ys) then
	4791	j_start = MAX(jts,jds+1)
	4792	j_start_f = jds+3
	4793	ENDIF
	4794
	4795	IF(degrade_ye) then
	4796	j_end = MIN(jte,jde-2)
	4797	j_end_f = jde-3
	4798	ENDIF
	4799
	4800	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	4801
	4802	! compute fluxes, 5th or 6th order
	4803
	4804	jp1 = 2
	4805	jp0 = 1
	4806
	4807	j_loop_y_flux_5 : DO j = j_start, j_end+1
	4808
	4809	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN
	4810
	4811	DO k=kts+1,ktf
	4812	DO i = i_start, i_end
	4813	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4814	fqy( i, k, jp1 ) = vel*flux5( &
	4815	w(i,k,j-3), w(i,k,j-2), w(i,k,j-1), &
	4816	w(i,k,j ), w(i,k,j+1), w(i,k,j+2), vel )
	4817	ENDDO
	4818	ENDDO
	4819
	4820	k = ktf+1
	4821	DO i = i_start, i_end
	4822	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4823	fqy( i, k, jp1 ) = vel*flux5( &
	4824	w(i,k,j-3), w(i,k,j-2), w(i,k,j-1), &
	4825	w(i,k,j ), w(i,k,j+1), w(i,k,j+2), vel )
	4826	ENDDO
	4827
	4828	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	4829
	4830	DO k=kts+1,ktf
	4831	DO i = i_start, i_end
	4832	fqy(i, k, jp1) = 0.5(fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)) &
	4833	(w(i,k,j)+w(i,k,j-1))
	4834	ENDDO
	4835	ENDDO
	4836
	4837	k = ktf+1
	4838	DO i = i_start, i_end
	4839	fqy(i, k, jp1) = 0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)) &
	4840	(w(i,k,j)+w(i,k,j-1))
	4841	ENDDO
	4842
	4843	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	4844
	4845	DO k=kts+1,ktf
	4846	DO i = i_start, i_end
	4847	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4848	fqy( i, k, jp1 ) = vel*flux3( &
	4849	w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
	4850	ENDDO
	4851	ENDDO
	4852
	4853	k = ktf+1
	4854	DO i = i_start, i_end
	4855	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4856	fqy( i, k, jp1 ) = vel*flux3( &
	4857	w(i,k,j-2),w(i,k,j-1),w(i,k,j),w(i,k,j+1),vel )
	4858	ENDDO
	4859
	4860	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	4861
	4862	DO k=kts+1,ktf
	4863	DO i = i_start, i_end
	4864	fqy(i, k, jp1) = 0.5(fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)) &
	4865	(w(i,k,j)+w(i,k,j-1))
	4866	ENDDO
	4867	ENDDO
	4868
	4869	k = ktf+1
	4870	DO i = i_start, i_end
	4871	fqy(i, k, jp1) = 0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)) &
	4872	(w(i,k,j)+w(i,k,j-1))
	4873	ENDDO
	4874
	4875	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	4876
	4877	DO k=kts+1,ktf
	4878	DO i = i_start, i_end
	4879	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	4880	fqy( i, k, jp1 ) = vel*flux3( &
	4881	w(i,k,j-2),w(i,k,j-1), &
	4882	w(i,k,j),w(i,k,j+1),vel )
	4883	ENDDO
	4884	ENDDO
	4885
	4886	k = ktf+1
	4887	DO i = i_start, i_end
	4888	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	4889	fqy( i, k, jp1 ) = vel*flux3( &
	4890	w(i,k,j-2),w(i,k,j-1), &
	4891	w(i,k,j),w(i,k,j+1),vel )
	4892	ENDDO
	4893
	4894	ENDIF
	4895
	4896	! y flux-divergence into tendency
	4897
	4898	! Comments for polar boundary conditions
	4899	! Same process as for advect_u - tendencies run from jds to jde-1
	4900	! (latitudes are as for u grid, longitudes are displaced)
	4901	! Therefore: flow is only from one side for points next to poles
	4902	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	4903	DO k=kts,ktf
	4904	DO i = i_start, i_end
	4905	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4906	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	4907	END DO
	4908	END DO
	4909	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	4910	DO k=kts,ktf
	4911	DO i = i_start, i_end
	4912	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4913	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	4914	END DO
	4915	END DO
	4916	ELSE ! normal code
	4917
	4918	IF(j > j_start) THEN
	4919
	4920	DO k=kts+1,ktf+1
	4921	DO i = i_start, i_end
	4922	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	4923	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	4924	ENDDO
	4925	ENDDO
	4926
	4927	ENDIF
	4928
	4929	END IF
	4930
	4931	jtmp = jp1
	4932	jp1 = jp0
	4933	jp0 = jtmp
	4934
	4935	ENDDO j_loop_y_flux_5
	4936
	4937	! next, x - flux divergence
	4938
	4939	i_start = its
	4940	i_end = MIN(ite,ide-1)
	4941
	4942	j_start = jts
	4943	j_end = MIN(jte,jde-1)
	4944
	4945	! higher order flux has a 5 or 7 point stencil, so compute
	4946	! bounds so we can switch to second order flux close to the boundary
	4947
	4948	i_start_f = i_start
	4949	i_end_f = i_end+1
	4950
	4951	IF(degrade_xs) then
	4952	i_start = MAX(ids+1,its)
	4953	i_start_f = i_start+2
	4954	ENDIF
	4955
	4956	IF(degrade_xe) then
	4957	i_end = MIN(ide-2,ite)
	4958	i_end_f = ide-3
	4959	ENDIF
	4960
	4961	! compute fluxes
	4962
	4963	DO j = j_start, j_end
	4964
	4965	! 5th or 6th order flux
	4966
	4967	DO k=kts+1,ktf
	4968	DO i = i_start_f, i_end_f
	4969	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	4970	fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j), &
	4971	w(i-1,k,j), w(i ,k,j), &
	4972	w(i+1,k,j), w(i+2,k,j), &
	4973	vel )
	4974	ENDDO
	4975	ENDDO
	4976
	4977	k = ktf+1
	4978	DO i = i_start_f, i_end_f
	4979	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	4980	fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j), &
	4981	w(i-1,k,j), w(i ,k,j), &
	4982	w(i+1,k,j), w(i+2,k,j), &
	4983	vel )
	4984	ENDDO
	4985
	4986	! lower order fluxes close to boundaries (if not periodic or symmetric)
	4987
	4988	IF( degrade_xs ) THEN
	4989
	4990	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	4991	i = ids+1
	4992	DO k=kts+1,ktf
	4993	fqx(i,k) = 0.5(fzm(k)ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
	4994	*(w(i,k,j)+w(i-1,k,j))
	4995	ENDDO
	4996	k = ktf+1
	4997	fqx(i,k) = 0.5((2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
	4998	*(w(i,k,j)+w(i-1,k,j))
	4999	ENDIF
	5000
	5001	i = i_start+1
	5002	DO k=kts+1,ktf
	5003	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	5004	fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5005	w(i ,k,j), w(i+1,k,j), &
	5006	vel )
	5007	ENDDO
	5008	k = ktf+1
	5009	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	5010	fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5011	w(i ,k,j), w(i+1,k,j), &
	5012	vel )
	5013
	5014	ENDIF
	5015
	5016	IF( degrade_xe ) THEN
	5017
	5018	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	5019	i = ide-1
	5020	DO k=kts+1,ktf
	5021	fqx(i,k) = 0.5(fzm(k)ru(i,k,j)+fzp(k)*ru(i,k-1,j)) &
	5022	*(w(i,k,j)+w(i-1,k,j))
	5023	ENDDO
	5024	k = ktf+1
	5025	fqx(i,k) = 0.5((2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)) &
	5026	*(w(i,k,j)+w(i-1,k,j))
	5027	ENDIF
	5028
	5029	i = ide-2
	5030	DO k=kts+1,ktf
	5031	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	5032	fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5033	w(i ,k,j), w(i+1,k,j), &
	5034	vel )
	5035	ENDDO
	5036	k = ktf+1
	5037	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	5038	fqx( i,k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5039	w(i ,k,j), w(i+1,k,j), &
	5040	vel )
	5041	ENDIF
	5042
	5043	! x flux-divergence into tendency
	5044
	5045	DO k=kts+1,ktf+1
	5046	DO i = i_start, i_end
	5047	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	5048	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	5049	ENDDO
	5050	ENDDO
	5051
	5052	ENDDO
	5053
	5054	ELSE IF ( horz_order == 4 ) THEN
	5055
	5056	degrade_xs = .true.
	5057	degrade_xe = .true.
	5058	degrade_ys = .true.
	5059	degrade_ye = .true.
	5060
	5061	IF( config_flags%periodic_x .or. &
	5062	config_flags%symmetric_xs .or. &
	5063	(its > ids+1) ) degrade_xs = .false.
	5064	IF( config_flags%periodic_x .or. &
	5065	config_flags%symmetric_xe .or. &
	5066	(ite < ide-2) ) degrade_xe = .false.
	5067	IF( config_flags%periodic_y .or. &
	5068	config_flags%symmetric_ys .or. &
	5069	(jts > jds+1) ) degrade_ys = .false.
	5070	IF( config_flags%periodic_y .or. &
	5071	config_flags%symmetric_ye .or. &
	5072	(jte < jde-2) ) degrade_ye = .false.
	5073
	5074	! begin flux computations
	5075	! start with x flux divergence
	5076
	5077	!---------------
	5078
	5079	ktf=MIN(kte,kde-1)
	5080
	5081	i_start = its
	5082	i_end = MIN(ite,ide-1)
	5083	j_start = jts
	5084	j_end = MIN(jte,jde-1)
	5085
	5086	! 3rd or 4th order flux has a 5 point stencil, so compute
	5087	! bounds so we can switch to second order flux close to the boundary
	5088
	5089	i_start_f = i_start
	5090	i_end_f = i_end+1
	5091
	5092	IF(degrade_xs) then
	5093	i_start = ids+1
	5094	i_start_f = i_start+1
	5095	ENDIF
	5096
	5097	IF(degrade_xe) then
	5098	i_end = ide-2
	5099	i_end_f = ide-2
	5100	ENDIF
	5101
	5102	! compute fluxes
	5103
	5104	DO j = j_start, j_end
	5105
	5106	DO k=kts+1,ktf
	5107	DO i = i_start_f, i_end_f
	5108	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	5109	fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	5110	w(i ,k,j), w(i+1,k,j), &
	5111	vel )
	5112	ENDDO
	5113	ENDDO
	5114
	5115	k = ktf+1
	5116	DO i = i_start_f, i_end_f
	5117	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	5118	fqx( i, k ) = vel*flux4( w(i-2,k,j), w(i-1,k,j), &
	5119	w(i ,k,j), w(i+1,k,j), &
	5120	vel )
	5121	ENDDO
	5122	! second order flux close to boundaries (if not periodic or symmetric)
	5123
	5124	IF( degrade_xs ) THEN
	5125	DO k=kts+1,ktf
	5126	fqx(i_start, k) = &
	5127	0.5(fzm(k)ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j)) &
	5128	*(w(i_start,k,j)+w(i_start-1,k,j))
	5129	ENDDO
	5130	k = ktf+1
	5131	fqx(i_start, k) = &
	5132	0.5((2.-fzm(k-1))ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j)) &
	5133	*(w(i_start,k,j)+w(i_start-1,k,j))
	5134	ENDIF
	5135
	5136	IF( degrade_xe ) THEN
	5137	DO k=kts+1,ktf
	5138	fqx(i_end+1, k) = &
	5139	0.5(fzm(k)ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j)) &
	5140	*(w(i_end+1,k,j)+w(i_end,k,j))
	5141	ENDDO
	5142	k = ktf+1
	5143	fqx(i_end+1, k) = &
	5144	0.5((2.-fzm(k-1))ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j)) &
	5145	*(w(i_end+1,k,j)+w(i_end,k,j))
	5146	ENDIF
	5147
	5148	! x flux-divergence into tendency
	5149
	5150	DO k=kts+1,ktf+1
	5151	DO i = i_start, i_end
	5152	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	5153	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	5154	ENDDO
	5155	ENDDO
	5156
	5157	ENDDO
	5158
	5159	! next -> y flux divergence calculation
	5160
	5161	i_start = its
	5162	i_end = MIN(ite,ide-1)
	5163	j_start = jts
	5164	j_end = MIN(jte,jde-1)
	5165
	5166
	5167	! 3rd or 4th order flux has a 5 point stencil, so compute
	5168	! bounds so we can switch to second order flux close to the boundary
	5169
	5170	j_start_f = j_start
	5171	j_end_f = j_end+1
	5172
	5173	IF(degrade_ys) then
	5174	j_start = jds+1
	5175	j_start_f = j_start+1
	5176	ENDIF
	5177
	5178	IF(degrade_ye) then
	5179	j_end = jde-2
	5180	j_end_f = jde-2
	5181	ENDIF
	5182
	5183	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	5184
	5185	jp1 = 2
	5186	jp0 = 1
	5187
	5188	DO j = j_start, j_end+1
	5189
	5190	IF ((j < j_start_f) .and. degrade_ys) THEN
	5191	DO k = kts+1, ktf
	5192	DO i = i_start, i_end
	5193	fqy(i, k, jp1) = &
	5194	0.5(fzm(k)rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start)) &
	5195	*(w(i,k,j_start)+w(i,k,j_start-1))
	5196	ENDDO
	5197	ENDDO
	5198	k = ktf+1
	5199	DO i = i_start, i_end
	5200	fqy(i, k, jp1) = &
	5201	0.5((2.-fzm(k-1))rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start)) &
	5202	*(w(i,k,j_start)+w(i,k,j_start-1))
	5203	ENDDO
	5204	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	5205	DO k = kts+1, ktf
	5206	DO i = i_start, i_end
	5207	! Assumes j>j_end_f is ONLY j_end+1 ...
	5208	! fqy(i, k, jp1) = &
	5209	! 0.5(fzm(k)rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1)) &
	5210	! *(w(i,k,j_end+1)+w(i,k,j_end))
	5211	fqy(i, k, jp1) = &
	5212	0.5(fzm(k)rv(i,k,j)+fzp(k)*rv(i,k-1,j)) &
	5213	*(w(i,k,j)+w(i,k,j-1))
	5214	ENDDO
	5215	ENDDO
	5216	k = ktf+1
	5217	DO i = i_start, i_end
	5218	! Assumes j>j_end_f is ONLY j_end+1 ...
	5219	! fqy(i, k, jp1) = &
	5220	! 0.5((2.-fzm(k-1))rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1)) &
	5221	! *(w(i,k,j_end+1)+w(i,k,j_end))
	5222	fqy(i, k, jp1) = &
	5223	0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)) &
	5224	*(w(i,k,j)+w(i,k,j-1))
	5225	ENDDO
	5226	ELSE
	5227	! 3rd or 4th order flux
	5228	DO k = kts+1, ktf
	5229	DO i = i_start, i_end
	5230	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	5231	fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1), &
	5232	w(i,k,j ), w(i,k,j+1), &
	5233	vel )
	5234	ENDDO
	5235	ENDDO
	5236	k = ktf+1
	5237	DO i = i_start, i_end
	5238	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	5239	fqy( i, k, jp1 ) = vel*flux4( w(i,k,j-2), w(i,k,j-1), &
	5240	w(i,k,j ), w(i,k,j+1), &
	5241	vel )
	5242	ENDDO
	5243	END IF
	5244
	5245	! y flux-divergence into tendency
	5246
	5247	! Comments for polar boundary conditions
	5248	! Same process as for advect_u - tendencies run from jds to jde-1
	5249	! (latitudes are as for u grid, longitudes are displaced)
	5250	! Therefore: flow is only from one side for points next to poles
	5251	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	5252	DO k=kts,ktf
	5253	DO i = i_start, i_end
	5254	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5255	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	5256	END DO
	5257	END DO
	5258	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	5259	DO k=kts,ktf
	5260	DO i = i_start, i_end
	5261	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5262	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	5263	END DO
	5264	END DO
	5265	ELSE ! normal code
	5266
	5267	IF( j > j_start ) THEN
	5268
	5269	DO k = kts+1, ktf+1
	5270	DO i = i_start, i_end
	5271	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5272	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	5273	ENDDO
	5274	ENDDO
	5275
	5276	END IF
	5277
	5278	END IF
	5279
	5280	jtmp = jp1
	5281	jp1 = jp0
	5282	jp0 = jtmp
	5283
	5284	ENDDO
	5285
	5286	ELSE IF ( horz_order == 3 ) THEN
	5287
	5288	degrade_xs = .true.
	5289	degrade_xe = .true.
	5290	degrade_ys = .true.
	5291	degrade_ye = .true.
	5292
	5293	IF( config_flags%periodic_x .or. &
	5294	config_flags%symmetric_xs .or. &
	5295	(its > ids+1) ) degrade_xs = .false.
	5296	IF( config_flags%periodic_x .or. &
	5297	config_flags%symmetric_xe .or. &
	5298	(ite < ide-2) ) degrade_xe = .false.
	5299	IF( config_flags%periodic_y .or. &
	5300	config_flags%symmetric_ys .or. &
	5301	(jts > jds+1) ) degrade_ys = .false.
	5302	IF( config_flags%periodic_y .or. &
	5303	config_flags%symmetric_ye .or. &
	5304	(jte < jde-2) ) degrade_ye = .false.
	5305
	5306	! begin flux computations
	5307	! start with x flux divergence
	5308
	5309	!---------------
	5310
	5311	ktf=MIN(kte,kde-1)
	5312
	5313	i_start = its
	5314	i_end = MIN(ite,ide-1)
	5315	j_start = jts
	5316	j_end = MIN(jte,jde-1)
	5317
	5318	! 3rd or 4th order flux has a 5 point stencil, so compute
	5319	! bounds so we can switch to second order flux close to the boundary
	5320
	5321	i_start_f = i_start
	5322	i_end_f = i_end+1
	5323
	5324	IF(degrade_xs) then
	5325	i_start = ids+1
	5326	i_start_f = i_start+1
	5327	ENDIF
	5328
	5329	IF(degrade_xe) then
	5330	i_end = ide-2
	5331	i_end_f = ide-2
	5332	ENDIF
	5333
	5334	! compute fluxes
	5335
	5336	DO j = j_start, j_end
	5337
	5338	DO k=kts+1,ktf
	5339	DO i = i_start_f, i_end_f
	5340	vel = fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)
	5341	fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5342	w(i ,k,j), w(i+1,k,j), &
	5343	vel )
	5344	ENDDO
	5345	ENDDO
	5346	k = ktf+1
	5347	DO i = i_start_f, i_end_f
	5348	vel = (2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)
	5349	fqx( i, k ) = vel*flux3( w(i-2,k,j), w(i-1,k,j), &
	5350	w(i ,k,j), w(i+1,k,j), &
	5351	vel )
	5352	ENDDO
	5353
	5354	! second order flux close to boundaries (if not periodic or symmetric)
	5355
	5356	IF( degrade_xs ) THEN
	5357	DO k=kts+1,ktf
	5358	fqx(i_start, k) = &
	5359	0.5(fzm(k)ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j)) &
	5360	*(w(i_start,k,j)+w(i_start-1,k,j))
	5361	ENDDO
	5362	k = ktf+1
	5363	fqx(i_start, k) = &
	5364	0.5((2.-fzm(k-1))ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j)) &
	5365	*(w(i_start,k,j)+w(i_start-1,k,j))
	5366	ENDIF
	5367
	5368	IF( degrade_xe ) THEN
	5369	DO k=kts+1,ktf
	5370	fqx(i_end+1, k) = &
	5371	0.5(fzm(k)ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j)) &
	5372	*(w(i_end+1,k,j)+w(i_end,k,j))
	5373	ENDDO
	5374	k = ktf+1
	5375	fqx(i_end+1, k) = &
	5376	0.5((2.-fzm(k-1))ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j)) &
	5377	*(w(i_end+1,k,j)+w(i_end,k,j))
	5378	ENDIF
	5379
	5380	! x flux-divergence into tendency
	5381
	5382	DO k=kts+1,ktf+1
	5383	DO i = i_start, i_end
	5384	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	5385	tendency(i,k,j) = tendency(i,k,j) - mrdx*(fqx(i+1,k)-fqx(i,k))
	5386	ENDDO
	5387	ENDDO
	5388
	5389	ENDDO
	5390
	5391	! next -> y flux divergence calculation
	5392
	5393	i_start = its
	5394	i_end = MIN(ite,ide-1)
	5395	j_start = jts
	5396	j_end = MIN(jte,jde-1)
	5397
	5398
	5399	! 3rd or 4th order flux has a 5 point stencil, so compute
	5400	! bounds so we can switch to second order flux close to the boundary
	5401
	5402	j_start_f = j_start
	5403	j_end_f = j_end+1
	5404
	5405	IF(degrade_ys) then
	5406	j_start = jds+1
	5407	j_start_f = j_start+1
	5408	ENDIF
	5409
	5410	IF(degrade_ye) then
	5411	j_end = jde-2
	5412	j_end_f = jde-2
	5413	ENDIF
	5414
	5415	IF(config_flags%polar) j_end = MIN(jte,jde-1)
	5416
	5417	jp1 = 2
	5418	jp0 = 1
	5419
	5420	DO j = j_start, j_end+1
	5421
	5422	IF ((j < j_start_f) .and. degrade_ys) THEN
	5423	DO k = kts+1, ktf
	5424	DO i = i_start, i_end
	5425	fqy(i, k, jp1) = &
	5426	0.5(fzm(k)rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start)) &
	5427	*(w(i,k,j_start)+w(i,k,j_start-1))
	5428	ENDDO
	5429	ENDDO
	5430	k = ktf+1
	5431	DO i = i_start, i_end
	5432	fqy(i, k, jp1) = &
	5433	0.5((2.-fzm(k-1))rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start)) &
	5434	*(w(i,k,j_start)+w(i,k,j_start-1))
	5435	ENDDO
	5436	ELSE IF ((j > j_end_f) .and. degrade_ye) THEN
	5437	DO k = kts+1, ktf
	5438	DO i = i_start, i_end
	5439	! Assumes j>j_end_f is ONLY j_end+1 ...
	5440	! fqy(i, k, jp1) = &
	5441	! 0.5(fzm(k)rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1)) &
	5442	! *(w(i,k,j_end+1)+w(i,k,j_end))
	5443	fqy(i, k, jp1) = &
	5444	0.5(fzm(k)rv(i,k,j)+fzp(k)*rv(i,k-1,j)) &
	5445	*(w(i,k,j)+w(i,k,j-1))
	5446	ENDDO
	5447	ENDDO
	5448	k = ktf+1
	5449	DO i = i_start, i_end
	5450	! Assumes j>j_end_f is ONLY j_end+1 ...
	5451	! fqy(i, k, jp1) = &
	5452	! 0.5((2.-fzm(k-1))rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1)) &
	5453	! *(w(i,k,j_end+1)+w(i,k,j_end))
	5454	fqy(i, k, jp1) = &
	5455	0.5((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)) &
	5456	*(w(i,k,j)+w(i,k,j-1))
	5457	ENDDO
	5458	ELSE
	5459	! 3rd or 4th order flux
	5460	DO k = kts+1, ktf
	5461	DO i = i_start, i_end
	5462	vel = fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)
	5463	fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1), &
	5464	w(i,k,j ), w(i,k,j+1), &
	5465	vel )
	5466	ENDDO
	5467	ENDDO
	5468	k = ktf+1
	5469	DO i = i_start, i_end
	5470	vel = (2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)
	5471	fqy( i, k, jp1 ) = vel*flux3( w(i,k,j-2), w(i,k,j-1), &
	5472	w(i,k,j ), w(i,k,j+1), &
	5473	vel )
	5474	ENDDO
	5475	END IF
	5476
	5477	! y flux-divergence into tendency
	5478
	5479	! Comments for polar boundary conditions
	5480	! Same process as for advect_u - tendencies run from jds to jde-1
	5481	! (latitudes are as for u grid, longitudes are displaced)
	5482	! Therefore: flow is only from one side for points next to poles
	5483	IF ( config_flags%polar .AND. (j == jds+1) ) THEN
	5484	DO k=kts,ktf
	5485	DO i = i_start, i_end
	5486	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5487	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*fqy(i,k,jp1)
	5488	END DO
	5489	END DO
	5490	ELSE IF( config_flags%polar .AND. (j == jde) ) THEN
	5491	DO k=kts,ktf
	5492	DO i = i_start, i_end
	5493	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5494	tendency(i,k,j-1) = tendency(i,k,j-1) + mrdy*fqy(i,k,jp0)
	5495	END DO
	5496	END DO
	5497	ELSE ! normal code
	5498
	5499	IF( j > j_start ) THEN
	5500
	5501	DO k = kts+1, ktf+1
	5502	DO i = i_start, i_end
	5503	mrdy=msftx(i,j-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5504	tendency(i,k,j-1) = tendency(i,k,j-1) - mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
	5505	ENDDO
	5506	ENDDO
	5507
	5508	END IF
	5509
	5510	END IF
	5511
	5512	jtmp = jp1
	5513	jp1 = jp0
	5514	jp0 = jtmp
	5515
	5516	ENDDO
	5517
	5518	ELSE IF (horz_order == 2 ) THEN
	5519
	5520	i_start = its
	5521	i_end = MIN(ite,ide-1)
	5522	j_start = jts
	5523	j_end = MIN(jte,jde-1)
	5524
	5525	IF ( .NOT. config_flags%periodic_x ) THEN
	5526	IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)
	5527	IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite)
	5528	ENDIF
	5529
	5530	DO j = j_start, j_end
	5531	DO k=kts+1,ktf
	5532	DO i = i_start, i_end
	5533
	5534	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	5535
	5536	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
	5537	((fzm(k)ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j)) &
	5538	*(w(i+1,k,j)+w(i,k,j)) &
	5539	-(fzm(k)ru(i,k,j)+fzp(k)ru(i,k-1,j)) &
	5540	*(w(i,k,j)+w(i-1,k,j)))
	5541
	5542	ENDDO
	5543	ENDDO
	5544
	5545	k = ktf+1
	5546	DO i = i_start, i_end
	5547
	5548	mrdx=msftx(i,j)*rdx ! see ADT eqn 46 dividing by my, 1st term RHS
	5549
	5550	tendency(i,k,j)=tendency(i,k,j)-mrdx*0.5 &
	5551	(((2.-fzm(k-1))ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j)) &
	5552	*(w(i+1,k,j)+w(i,k,j)) &
	5553	-((2.-fzm(k-1))ru(i,k-1,j)-fzp(k-1)ru(i,k-2,j)) &
	5554	*(w(i,k,j)+w(i-1,k,j)))
	5555
	5556	ENDDO
	5557
	5558	ENDDO
	5559
	5560	i_start = its
	5561	i_end = MIN(ite,ide-1)
	5562	! Polar boundary conditions are like open or specified
	5563	IF ( config_flags%open_ys .or. specified .or. config_flags%polar ) j_start = MAX(jds+1,jts)
	5564	IF ( config_flags%open_ye .or. specified .or. config_flags%polar ) j_end = MIN(jde-2,jte)
	5565
	5566	DO j = j_start, j_end
	5567	DO k=kts+1,ktf
	5568	DO i = i_start, i_end
	5569
	5570	mrdy=msftx(i,j)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5571
	5572	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
	5573	((fzm(k)rv(i,k,j+1)+fzp(k)rv(i,k-1,j+1)) &
	5574	(w(i,k,j+1)+w(i,k,j)) &
	5575	-(fzm(k)rv(i,k,j)+fzp(k)rv(i,k-1,j)) &
	5576	*(w(i,k,j)+w(i,k,j-1)))
	5577
	5578	ENDDO
	5579	ENDDO
	5580
	5581	k = ktf+1
	5582	DO i = i_start, i_end
	5583
	5584	mrdy=msftx(i,j)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5585
	5586	tendency(i,k,j)=tendency(i,k,j) -mrdy*0.5 &
	5587	(((2.-fzm(k-1))rv(i,k-1,j+1)-fzp(k-1)rv(i,k-2,j+1)) &
	5588	(w(i,k,j+1)+w(i,k,j)) &
	5589	-((2.-fzm(k-1))rv(i,k-1,j)-fzp(k-1)rv(i,k-2,j)) &
	5590	*(w(i,k,j)+w(i,k,j-1)))
	5591
	5592	ENDDO
	5593
	5594	ENDDO
	5595
	5596	! Polar boundary condition ... not covered in above j-loop
	5597	IF (config_flags%polar) THEN
	5598	IF (jts == jds) THEN
	5599	DO k=kts+1,ktf
	5600	DO i = i_start, i_end
	5601	mrdy=msftx(i,jds)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5602	tendency(i,k,jds)=tendency(i,k,jds) -mrdy*0.5 &
	5603	((fzm(k)rv(i,k,jds+1)+fzp(k)rv(i,k-1,jds+1)) &
	5604	(w(i,k,jds+1)+w(i,k,jds)))
	5605	END DO
	5606	END DO
	5607	k = ktf+1
	5608	DO i = i_start, i_end
	5609	mrdy=msftx(i,jds)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5610	tendency(i,k,jds)=tendency(i,k,jds) -mrdy*0.5 &
	5611	((2.-fzm(k-1))rv(i,k-1,jds+1)-fzp(k-1)rv(i,k-2,jds+1)) &
	5612	(w(i,k,jds+1)+w(i,k,jds))
	5613	ENDDO
	5614	END IF
	5615	IF (jte == jde) THEN
	5616	DO k=kts+1,ktf
	5617	DO i = i_start, i_end
	5618	mrdy=msftx(i,jde-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5619	tendency(i,k,jde-1)=tendency(i,k,jde-1) +mrdy*0.5 &
	5620	((fzm(k)rv(i,k,jde-1)+fzp(k)rv(i,k-1,jde-1)) &
	5621	(w(i,k,jde-1)+w(i,k,jde-2)))
	5622	END DO
	5623	END DO
	5624	k = ktf+1
	5625	DO i = i_start, i_end
	5626	mrdy=msftx(i,jde-1)*rdy ! see ADT eqn 46 dividing by my, 2nd term RHS
	5627	tendency(i,k,jde-1)=tendency(i,k,jde-1) +mrdy*0.5 &
	5628	((2.-fzm(k-1))rv(i,k-1,jde-1)-fzp(k-1)*rv(i,k-2,jde-1)) &
	5629	*(w(i,k,jde-1)+w(i,k,jde-2))
	5630	ENDDO
	5631	END IF
	5632	END IF
	5633
	5634	ELSE IF ( horz_order == 0 ) THEN
	5635
	5636	! Just in case we want to turn horizontal advection off, we can do it
	5637
	5638	ELSE
	5639
	5640	WRITE ( wrf_err_message ,*) ' advect_w_6a, h_order not known ',horz_order
	5641	CALL wrf_error_fatal ( wrf_err_message )
	5642
	5643	ENDIF horizontal_order_test
	5644
	5645
	5646	! pick up the the horizontal radiation boundary conditions.
	5647	! (these are the computations that don't require 'cb'.
	5648	! first, set to index ranges
	5649
	5650
	5651	i_start = its
	5652	i_end = MIN(ite,ide-1)
	5653	j_start = jts
	5654	j_end = MIN(jte,jde-1)
	5655
	5656	IF( (config_flags%open_xs) .and. (its == ids)) THEN
	5657
	5658	DO j = j_start, j_end
	5659	DO k = kts+1, ktf
	5660
	5661	uw = 0.5(fzm(k)(ru(its,k ,j)+ru(its+1,k ,j)) + &
	5662	fzp(k)*(ru(its,k-1,j)+ru(its+1,k-1,j)) )
	5663	ub = MIN( uw, 0. )
	5664
	5665	tendency(its,k,j) = tendency(its,k,j) &
	5666	- rdx*( &
	5667	ub*(w_old(its+1,k,j) - w_old(its,k,j)) + &
	5668	w(its,k,j)*( &
	5669	fzm(k)*(ru(its+1,k ,j)-ru(its,k ,j))+ &
	5670	fzp(k)*(ru(its+1,k-1,j)-ru(its,k-1,j))) &
	5671	)
	5672	ENDDO
	5673	ENDDO
	5674
	5675	k = ktf+1
	5676	DO j = j_start, j_end
	5677
	5678	uw = 0.5( (2.-fzm(k-1))(ru(its,k-1,j)+ru(its+1,k-1,j)) &
	5679	-fzp(k-1)*(ru(its,k-2,j)+ru(its+1,k-2,j)) )
	5680	ub = MIN( uw, 0. )
	5681
	5682	tendency(its,k,j) = tendency(its,k,j) &
	5683	- rdx*( &
	5684	ub*(w_old(its+1,k,j) - w_old(its,k,j)) + &
	5685	w(its,k,j)*( &
	5686	(2.-fzm(k-1))*(ru(its+1,k-1,j)-ru(its,k-1,j))- &
	5687	fzp(k-1)*(ru(its+1,k-2,j)-ru(its,k-2,j))) &
	5688	)
	5689	ENDDO
	5690
	5691	ENDIF
	5692
	5693	IF( (config_flags%open_xe) .and. (ite == ide)) THEN
	5694
	5695	DO j = j_start, j_end
	5696	DO k = kts+1, ktf
	5697
	5698	uw = 0.5(fzm(k)(ru(ite-1,k ,j)+ru(ite,k ,j)) + &
	5699	fzp(k)*(ru(ite-1,k-1,j)+ru(ite,k-1,j)) )
	5700	ub = MAX( uw, 0. )
	5701
	5702	tendency(i_end,k,j) = tendency(i_end,k,j) &
	5703	- rdx*( &
	5704	ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) + &
	5705	w(i_end,k,j)*( &
	5706	fzm(k)*(ru(ite,k ,j)-ru(ite-1,k ,j)) + &
	5707	fzp(k)*(ru(ite,k-1,j)-ru(ite-1,k-1,j))) &
	5708	)
	5709	ENDDO
	5710	ENDDO
	5711
	5712	k = ktf+1
	5713	DO j = j_start, j_end
	5714
	5715	uw = 0.5( (2.-fzm(k-1))(ru(ite-1,k-1,j)+ru(ite,k-1,j)) &
	5716	-fzp(k-1)*(ru(ite-1,k-2,j)+ru(ite,k-2,j)) )
	5717	ub = MAX( uw, 0. )
	5718
	5719	tendency(i_end,k,j) = tendency(i_end,k,j) &
	5720	- rdx*( &
	5721	ub*(w_old(i_end,k,j) - w_old(i_end-1,k,j)) + &
	5722	w(i_end,k,j)*( &
	5723	(2.-fzm(k-1))*(ru(ite,k-1,j)-ru(ite-1,k-1,j)) - &
	5724	fzp(k-1)*(ru(ite,k-2,j)-ru(ite-1,k-2,j))) &
	5725	)
	5726	ENDDO
	5727
	5728	ENDIF
	5729
	5730
	5731	IF( (config_flags%open_ys) .and. (jts == jds)) THEN
	5732
	5733	DO i = i_start, i_end
	5734	DO k = kts+1, ktf
	5735
	5736	vw = 0.5( fzm(k)(rv(i,k ,jts)+rv(i,k ,jts+1)) + &
	5737	fzp(k)*(rv(i,k-1,jts)+rv(i,k-1,jts+1)) )
	5738	vb = MIN( vw, 0. )
	5739
	5740	tendency(i,k,jts) = tendency(i,k,jts) &
	5741	- rdy*( &
	5742	vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) + &
	5743	w(i,k,jts)*( &
	5744	fzm(k)*(rv(i,k ,jts+1)-rv(i,k ,jts))+ &
	5745	fzp(k)*(rv(i,k-1,jts+1)-rv(i,k-1,jts))) &
	5746	)
	5747	ENDDO
	5748	ENDDO
	5749
	5750	k = ktf+1
	5751	DO i = i_start, i_end
	5752	vw = 0.5( (2.-fzm(k-1))(rv(i,k-1,jts)+rv(i,k-1,jts+1)) &
	5753	-fzp(k-1)*(rv(i,k-2,jts)+rv(i,k-2,jts+1)) )
	5754	vb = MIN( vw, 0. )
	5755
	5756	tendency(i,k,jts) = tendency(i,k,jts) &
	5757	- rdy*( &
	5758	vb*(w_old(i,k,jts+1) - w_old(i,k,jts)) + &
	5759	w(i,k,jts)*( &
	5760	(2.-fzm(k-1))*(rv(i,k-1,jts+1)-rv(i,k-1,jts))- &
	5761	fzp(k-1)*(rv(i,k-2,jts+1)-rv(i,k-2,jts))) &
	5762	)
	5763	ENDDO
	5764
	5765	ENDIF
	5766
	5767	IF( (config_flags%open_ye) .and. (jte == jde) ) THEN
	5768
	5769	DO i = i_start, i_end
	5770	DO k = kts+1, ktf
	5771
	5772	vw = 0.5( fzm(k)(rv(i,k ,jte-1)+rv(i,k ,jte)) + &
	5773	fzp(k)*(rv(i,k-1,jte-1)+rv(i,k-1,jte)) )
	5774	vb = MAX( vw, 0. )
	5775
	5776	tendency(i,k,j_end) = tendency(i,k,j_end) &
	5777	- rdy*( &
	5778	vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) + &
	5779	w(i,k,j_end)*( &
	5780	fzm(k)*(rv(i,k ,jte)-rv(i,k ,jte-1))+ &
	5781	fzp(k)*(rv(i,k-1,jte)-rv(i,k-1,jte-1))) &
	5782	)
	5783	ENDDO
	5784	ENDDO
	5785
	5786	k = ktf+1
	5787	DO i = i_start, i_end
	5788
	5789	vw = 0.5( (2.-fzm(k-1))(rv(i,k-1,jte-1)+rv(i,k-1,jte)) &
	5790	-fzp(k-1)*(rv(i,k-2,jte-1)+rv(i,k-2,jte)) )
	5791	vb = MAX( vw, 0. )
	5792
	5793	tendency(i,k,j_end) = tendency(i,k,j_end) &
	5794	- rdy*( &
	5795	vb*(w_old(i,k,j_end) - w_old(i,k,j_end-1)) + &
	5796	w(i,k,j_end)*( &
	5797	(2.-fzm(k-1))*(rv(i,k-1,jte)-rv(i,k-1,jte-1))- &
	5798	fzp(k-1)*(rv(i,k-2,jte)-rv(i,k-2,jte-1))) &
	5799	)
	5800	ENDDO
	5801
	5802	ENDIF
	5803
	5804	!-------------------- vertical advection
	5805	! ADT eqn 46 has 3rd term on RHS (dividing through by my) = - partial d/dz (w rho w /my)
	5806	! Here we have: - partial d/dz (w*rom) = - partial d/dz (w rho w / my)
	5807	! Therefore we don't need to make a correction for advect_w
	5808
	5809	i_start = its
	5810	i_end = MIN(ite,ide-1)
	5811	j_start = jts
	5812	j_end = MIN(jte,jde-1)
	5813
	5814	DO i = i_start, i_end
	5815	vflux(i,kts)=0.
	5816	vflux(i,kte)=0.
	5817	ENDDO
	5818
	5819	vert_order_test : IF (vert_order == 6) THEN
	5820
	5821	DO j = j_start, j_end
	5822
	5823	DO k=kts+3,ktf-1
	5824	DO i = i_start, i_end
	5825	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5826	vflux(i,k) = vel*flux6( &
	5827	w(i,k-3,j), w(i,k-2,j), w(i,k-1,j), &
	5828	w(i,k ,j), w(i,k+1,j), w(i,k+2,j), -vel )
	5829	ENDDO
	5830	ENDDO
	5831
	5832	DO i = i_start, i_end
	5833
	5834	k=kts+1
	5835	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5836
	5837	k = kts+2
	5838	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5839	vflux(i,k) = vel*flux4( &
	5840	w(i,k-2,j), w(i,k-1,j), &
	5841	w(i,k ,j), w(i,k+1,j), -vel )
	5842
	5843	k = ktf
	5844	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5845	vflux(i,k) = vel*flux4( &
	5846	w(i,k-2,j), w(i,k-1,j), &
	5847	w(i,k ,j), w(i,k+1,j), -vel )
	5848
	5849	k=ktf+1
	5850	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5851
	5852	ENDDO
	5853
	5854	DO k=kts+1,ktf
	5855	DO i = i_start, i_end
	5856	tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
	5857	ENDDO
	5858	ENDDO
	5859
	5860	! pick up flux contribution for w at the lid. wcs, 13 march 2004
	5861	k = ktf+1
	5862	DO i = i_start, i_end
	5863	tendency(i,k,j)=tendency(i,k,j)+2.rdzu(k-1)(vflux(i,k))
	5864	ENDDO
	5865
	5866	ENDDO
	5867
	5868	ELSE IF (vert_order == 5) THEN
	5869
	5870	DO j = j_start, j_end
	5871
	5872	DO k=kts+3,ktf-1
	5873	DO i = i_start, i_end
	5874	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5875	vflux(i,k) = vel*flux5( &
	5876	w(i,k-3,j), w(i,k-2,j), w(i,k-1,j), &
	5877	w(i,k ,j), w(i,k+1,j), w(i,k+2,j), -vel )
	5878	ENDDO
	5879	ENDDO
	5880
	5881	DO i = i_start, i_end
	5882
	5883	k=kts+1
	5884	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5885
	5886	k = kts+2
	5887	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5888	vflux(i,k) = vel*flux3( &
	5889	w(i,k-2,j), w(i,k-1,j), &
	5890	w(i,k ,j), w(i,k+1,j), -vel )
	5891	k = ktf
	5892	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5893	vflux(i,k) = vel*flux3( &
	5894	w(i,k-2,j), w(i,k-1,j), &
	5895	w(i,k ,j), w(i,k+1,j), -vel )
	5896
	5897	k=ktf+1
	5898	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5899
	5900	ENDDO
	5901
	5902	DO k=kts+1,ktf
	5903	DO i = i_start, i_end
	5904	tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
	5905	ENDDO
	5906	ENDDO
	5907
	5908	! pick up flux contribution for w at the lid, wcs. 13 march 2004
	5909	k = ktf+1
	5910	DO i = i_start, i_end
	5911	tendency(i,k,j)=tendency(i,k,j)+2.rdzu(k-1)(vflux(i,k))
	5912	ENDDO
	5913
	5914	ENDDO
	5915
	5916	ELSE IF (vert_order == 4) THEN
	5917
	5918	DO j = j_start, j_end
	5919
	5920	DO k=kts+2,ktf
	5921	DO i = i_start, i_end
	5922	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5923	vflux(i,k) = vel*flux4( &
	5924	w(i,k-2,j), w(i,k-1,j), &
	5925	w(i,k ,j), w(i,k+1,j), -vel )
	5926	ENDDO
	5927	ENDDO
	5928
	5929	DO i = i_start, i_end
	5930
	5931	k=kts+1
	5932	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5933	k=ktf+1
	5934	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5935
	5936	ENDDO
	5937
	5938	DO k=kts+1,ktf
	5939	DO i = i_start, i_end
	5940	tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
	5941	ENDDO
	5942	ENDDO
	5943
	5944	! pick up flux contribution for w at the lid, wcs. 13 march 2004
	5945	k = ktf+1
	5946	DO i = i_start, i_end
	5947	tendency(i,k,j)=tendency(i,k,j)+2.rdzu(k-1)(vflux(i,k))
	5948	ENDDO
	5949
	5950	ENDDO
	5951
	5952	ELSE IF (vert_order == 3) THEN
	5953
	5954	DO j = j_start, j_end
	5955
	5956	DO k=kts+2,ktf
	5957	DO i = i_start, i_end
	5958	vel=0.5*(rom(i,k,j)+rom(i,k-1,j))
	5959	vflux(i,k) = vel*flux3( &
	5960	w(i,k-2,j), w(i,k-1,j), &
	5961	w(i,k ,j), w(i,k+1,j), -vel )
	5962	ENDDO
	5963	ENDDO
	5964
	5965	DO i = i_start, i_end
	5966
	5967	k=kts+1
	5968	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5969	k=ktf+1
	5970	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5971
	5972	ENDDO
	5973
	5974	DO k=kts+1,ktf
	5975	DO i = i_start, i_end
	5976	tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
	5977	ENDDO
	5978	ENDDO
	5979
	5980	! pick up flux contribution for w at the lid, wcs. 13 march 2004
	5981	k = ktf+1
	5982	DO i = i_start, i_end
	5983	tendency(i,k,j)=tendency(i,k,j)+2.rdzu(k-1)(vflux(i,k))
	5984	ENDDO
	5985
	5986	ENDDO
	5987
	5988	ELSE IF (vert_order == 2) THEN
	5989
	5990	DO j = j_start, j_end
	5991	DO k=kts+1,ktf+1
	5992	DO i = i_start, i_end
	5993
	5994	vflux(i,k)=0.25(rom(i,k,j)+rom(i,k-1,j))(w(i,k,j)+w(i,k-1,j))
	5995	ENDDO
	5996	ENDDO
	5997	DO k=kts+1,ktf
	5998	DO i = i_start, i_end
	5999	tendency(i,k,j)=tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
	6000
	6001	ENDDO
	6002	ENDDO
	6003
	6004	! pick up flux contribution for w at the lid, wcs. 13 march 2004
	6005	k = ktf+1
	6006	DO i = i_start, i_end
	6007	tendency(i,k,j)=tendency(i,k,j)+2.rdzu(k-1)(vflux(i,k))
	6008	ENDDO
	6009
	6010	ENDDO
	6011
	6012	ELSE
	6013
	6014	WRITE (wrf_err_message ,*) ' advect_w, v_order not known ',vert_order
	6015	CALL wrf_error_fatal ( wrf_err_message )
	6016
	6017	ENDIF vert_order_test
	6018
	6019	END SUBROUTINE advect_w
	6020
	6021	!----------------------------------------------------------------
	6022
	6023	SUBROUTINE advect_scalar_pd ( field, field_old, tendency, &
	6024	ru, rv, rom, &
	6025	mut, mub, mu_old, &
	6026	config_flags, &
	6027	msfux, msfuy, msfvx, msfvy, &
	6028	msftx, msfty, &
	6029	fzm, fzp, &
	6030	rdx, rdy, rdzw, dt, &
	6031	ids, ide, jds, jde, kds, kde, &
	6032	ims, ime, jms, jme, kms, kme, &
	6033	its, ite, jts, jte, kts, kte )
	6034
	6035	! this is a first cut at a positive definite advection option
	6036	! for scalars in WRF. This version is memory intensive ->
	6037	! we save 3d arrays of x, y and z both high and low order fluxes
	6038	! (six in all). Alternatively, we could sweep in a direction
	6039	! and lower the cost considerably.
	6040
	6041	! uses the Smolarkiewicz MWR 1989 approach, with addition of first-order
	6042	! fluxes initially
	6043
	6044	! WCS, 3 December 2002, 24 February 2003
	6045
	6046	IMPLICIT NONE
	6047
	6048	! Input data
	6049
	6050	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	6051
	6052	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	6053	ims, ime, jms, jme, kms, kme, &
	6054	its, ite, jts, jte, kts, kte
	6055
	6056	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, &
	6057	field_old, &
	6058	ru, &
	6059	rv, &
	6060	rom
	6061
	6062	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut, mub, mu_old
	6063	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency
	6064
	6065	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, &
	6066	msfuy, &
	6067	msfvx, &
	6068	msfvy, &
	6069	msftx, &
	6070	msfty
	6071
	6072	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
	6073	fzp, &
	6074	rdzw
	6075
	6076	REAL , INTENT(IN ) :: rdx, &
	6077	rdy, &
	6078	dt
	6079
	6080	! Local data
	6081
	6082	INTEGER :: i, j, k, itf, jtf, ktf
	6083	INTEGER :: i_start, i_end, j_start, j_end
	6084	INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
	6085	INTEGER :: jmin, jmax, jp, jm, imin, imax
	6086
	6087	REAL :: mrdx, mrdy, ub, vb, uw, vw, mu
	6088
	6089	! storage for high and low order fluxes
	6090
	6091	REAL, DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2 ) :: fqx, fqy, fqz
	6092	REAL, DIMENSION( its-1:ite+2, kts:kte, jts-1:jte+2 ) :: fqxl, fqyl, fqzl
	6093
	6094	INTEGER :: horz_order, vert_order
	6095
	6096	LOGICAL :: degrade_xs, degrade_ys
	6097	LOGICAL :: degrade_xe, degrade_ye
	6098
	6099	INTEGER :: jp1, jp0, jtmp
	6100
	6101	REAL :: flux_out, ph_low, scale
	6102	REAL, PARAMETER :: eps=1.e-20
	6103
	6104
	6105	! definition of flux operators, 3rd, 4th, 5th or 6th order
	6106
	6107	REAL :: flux3, flux4, flux5, flux6, flux_upwind
	6108	REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
	6109
	6110	flux4(q_im2, q_im1, q_i, q_ip1, ua) = &
	6111	(7./12.)(q_i + q_im1) - (1./12.)(q_ip1 + q_im2)
	6112
	6113	flux3(q_im2, q_im1, q_i, q_ip1, ua) = &
	6114	flux4(q_im2, q_im1, q_i, q_ip1, ua) + &
	6115	sign(1.,ua)(1./12.)((q_ip1 - q_im2)-3.*(q_i-q_im1))
	6116
	6117	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	6118	(37./60.)(q_i+q_im1) - (2./15.)(q_ip1+q_im2) &
	6119	+(1./60.)*(q_ip2+q_im3)
	6120
	6121	flux5(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) = &
	6122	flux6(q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua) &
	6123	-sign(1.,ua)(1./60.)( &
	6124	(q_ip2-q_im3)-5.(q_ip1-q_im2)+10.(q_i-q_im1) )
	6125
	6126	flux_upwind(q_im1, q_i, cr ) = 0.5min( 1.0,(cr+abs(cr)))q_im1 &
	6127	+0.5max(-1.0,(cr-abs(cr)))q_i
	6128	! flux_upwind(q_im1, q_i, cr ) = 0.
	6129
	6130	REAL :: dx,dy,dz
	6131
	6132	LOGICAL, PARAMETER :: pd_limit = .true.
	6133
	6134	! set order for the advection schemes
	6135
	6136	! write(6,*) ' in pd advection routine '
	6137
	6138	! Empty arrays just in case:
	6139	IF (config_flags%polar) THEN
	6140	fqx(:,:,:) = 0.
	6141	fqy(:,:,:) = 0.
	6142	fqz(:,:,:) = 0.
	6143	fqxl(:,:,:) = 0.
	6144	fqyl(:,:,:) = 0.
	6145	fqzl(:,:,:) = 0.
	6146	END IF
	6147
	6148	ktf=MIN(kte,kde-1)
	6149	horz_order = config_flags%h_sca_adv_order
	6150	vert_order = config_flags%v_sca_adv_order
	6151
	6152	! determine boundary mods for flux operators
	6153	! We degrade the flux operators from 3rd/4th order
	6154	! to second order one gridpoint in from the boundaries for
	6155	! all boundary conditions except periodic and symmetry - these
	6156	! conditions have boundary zone data fill for correct application
	6157	! of the higher order flux stencils
	6158
	6159	degrade_xs = .true.
	6160	degrade_xe = .true.
	6161	degrade_ys = .true.
	6162	degrade_ye = .true.
	6163
	6164	! begin with horizontal flux divergence
	6165	! here is the choice of flux operators
	6166
	6167
	6168	horizontal_order_test : IF( horz_order == 6 ) THEN
	6169
	6170	IF( config_flags%periodic_x .or. &
	6171	config_flags%symmetric_xs .or. &
	6172	(its > ids+2) ) degrade_xs = .false.
	6173	IF( config_flags%periodic_x .or. &
	6174	config_flags%symmetric_xe .or. &
	6175	(ite < ide-3) ) degrade_xe = .false.
	6176	IF( config_flags%periodic_y .or. &
	6177	config_flags%symmetric_ys .or. &
	6178	(jts > jds+2) ) degrade_ys = .false.
	6179	IF( config_flags%periodic_y .or. &
	6180	config_flags%symmetric_ye .or. &
	6181	(jte < jde-3) ) degrade_ye = .false.
	6182
	6183	!--------------- y - advection first
	6184
	6185	!-- y flux compute; these bounds are for periodic and sym b.c.
	6186
	6187	ktf=MIN(kte,kde-1)
	6188	i_start = its-1
	6189	i_end = MIN(ite,ide-1)+1
	6190	j_start = jts-1
	6191	j_end = MIN(jte,jde-1)+1
	6192	j_start_f = j_start
	6193	j_end_f = j_end+1
	6194
	6195	!-- modify loop bounds if open or specified
	6196
	6197	IF(degrade_xs) i_start = its
	6198	IF(degrade_xe) i_end = MIN(ite,ide-1)
	6199
	6200	IF(degrade_ys) then
	6201	j_start = MAX(jts,jds+1)
	6202	j_start_f = jds+3
	6203	ENDIF
	6204
	6205	IF(degrade_ye) then
	6206	j_end = MIN(jte,jde-2)
	6207	j_end_f = jde-3
	6208	ENDIF
	6209
	6210	! compute fluxes, 6th order
	6211
	6212	j_loop_y_flux_6 : DO j = j_start, j_end+1
	6213
	6214	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	6215
	6216	DO k=kts,ktf
	6217	DO i = i_start, i_end
	6218
	6219	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6220	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6221	vel = rv(i,k,j)
	6222	cr = vel*dt/dy/mu
	6223	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6224
	6225	fqy( i, k, j ) = vel*flux6( &
	6226	field(i,k,j-3), field(i,k,j-2), field(i,k,j-1), &
	6227	field(i,k,j ), field(i,k,j+1), field(i,k,j+2), vel )
	6228
	6229	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6230
	6231	ENDDO
	6232	ENDDO
	6233
	6234	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	6235
	6236	DO k=kts,ktf
	6237	DO i = i_start, i_end
	6238
	6239	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6240	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6241	vel = rv(i,k,j)
	6242	cr = vel*dt/dy/mu
	6243	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6244
	6245	fqy(i,k, j) = 0.5rv(i,k,j) &
	6246	(field(i,k,j)+field(i,k,j-1))
	6247
	6248	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6249
	6250	ENDDO
	6251	ENDDO
	6252
	6253	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	6254
	6255	DO k=kts,ktf
	6256	DO i = i_start, i_end
	6257
	6258	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6259	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6260	vel = rv(i,k,j)
	6261	cr = vel*dt/dy/mu
	6262	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6263
	6264	fqy( i, k, j ) = vel*flux4( &
	6265	field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
	6266	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6267
	6268	ENDDO
	6269	ENDDO
	6270
	6271	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	6272
	6273	DO k=kts,ktf
	6274	DO i = i_start, i_end
	6275
	6276	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6277	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6278	vel = rv(i,k,j)
	6279	cr = vel*dt/dy/mu
	6280	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6281
	6282	fqy(i, k, j ) = 0.5rv(i,k,j) &
	6283	(field(i,k,j)+field(i,k,j-1))
	6284	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6285
	6286	ENDDO
	6287	ENDDO
	6288
	6289	ELSE IF ( j == jde-2 ) THEN ! 4th order flux 2 in from north boundary
	6290
	6291	DO k=kts,ktf
	6292	DO i = i_start, i_end
	6293
	6294	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6295	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6296	vel = rv(i,k,j)
	6297	cr = vel*dt/dy/mu
	6298	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6299
	6300	fqy( i, k, j) = vel*flux4( &
	6301	field(i,k,j-2),field(i,k,j-1), &
	6302	field(i,k,j),field(i,k,j+1),vel )
	6303	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6304
	6305	ENDDO
	6306	ENDDO
	6307
	6308	ENDIF
	6309
	6310	ENDDO j_loop_y_flux_6
	6311
	6312	! next, x flux
	6313
	6314	!-- these bounds are for periodic and sym conditions
	6315
	6316	i_start = its-1
	6317	i_end = MIN(ite,ide-1)+1
	6318	i_start_f = i_start
	6319	i_end_f = i_end+1
	6320
	6321	j_start = jts-1
	6322	j_end = MIN(jte,jde-1)+1
	6323
	6324	!-- modify loop bounds for open and specified b.c
	6325
	6326	IF(degrade_ys) j_start = jts
	6327	IF(degrade_ye) j_end = MIN(jte,jde-1)
	6328
	6329	IF(degrade_xs) then
	6330	i_start = MAX(ids+1,its)
	6331	i_start_f = i_start+2
	6332	ENDIF
	6333
	6334	IF(degrade_xe) then
	6335	i_end = MIN(ide-2,ite)
	6336	i_end_f = ide-3
	6337	ENDIF
	6338
	6339	! compute fluxes
	6340
	6341	DO j = j_start, j_end
	6342
	6343	! 6th order flux
	6344
	6345	DO k=kts,ktf
	6346	DO i = i_start_f, i_end_f
	6347
	6348	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6349	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6350	vel = ru(i,k,j)
	6351	cr = vel*dt/dx/mu
	6352	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6353
	6354	fqx( i,k,j ) = vel*flux6( field(i-3,k,j), field(i-2,k,j), &
	6355	field(i-1,k,j), field(i ,k,j), &
	6356	field(i+1,k,j), field(i+2,k,j), &
	6357	vel )
	6358	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6359
	6360	ENDDO
	6361	ENDDO
	6362
	6363	! lower order fluxes close to boundaries (if not periodic or symmetric)
	6364
	6365	IF( degrade_xs ) THEN
	6366
	6367	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	6368	i = ids+1
	6369	DO k=kts,ktf
	6370
	6371	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6372	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6373	vel = ru(i,k,j)/mu
	6374	cr = vel*dt/dx
	6375	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6376
	6377	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6378	*(field(i,k,j)+field(i-1,k,j))
	6379
	6380	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6381
	6382	ENDDO
	6383	ENDIF
	6384
	6385	i = ids+2
	6386	DO k=kts,ktf
	6387	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6388	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6389	vel = ru(i,k,j)
	6390	cr = vel*dt/dx/mu
	6391	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6392	fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
	6393	field(i ,k,j), field(i+1,k,j), &
	6394	vel )
	6395	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6396
	6397	ENDDO
	6398
	6399	ENDIF
	6400
	6401	IF( degrade_xe ) THEN
	6402
	6403	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	6404	i = ide-1
	6405	DO k=kts,ktf
	6406	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6407	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6408	vel = ru(i,k,j)
	6409	cr = vel*dt/dx/mu
	6410	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6411	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6412	*(field(i,k,j)+field(i-1,k,j))
	6413	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6414
	6415	ENDDO
	6416	ENDIF
	6417
	6418	i = ide-2
	6419	DO k=kts,ktf
	6420
	6421	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6422	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6423	vel = ru(i,k,j)
	6424	cr = vel*dt/dx/mu
	6425	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6426	fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
	6427	field(i ,k,j), field(i+1,k,j), &
	6428	vel )
	6429	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6430
	6431	ENDDO
	6432
	6433	ENDIF
	6434
	6435	ENDDO ! enddo for outer J loop
	6436
	6437	!--- end of 6th order horizontal flux calculation
	6438
	6439	ELSE IF( horz_order == 5 ) THEN
	6440
	6441	IF( config_flags%periodic_x .or. &
	6442	config_flags%symmetric_xs .or. &
	6443	(its > ids+2) ) degrade_xs = .false.
	6444	IF( config_flags%periodic_x .or. &
	6445	config_flags%symmetric_xe .or. &
	6446	(ite < ide-3) ) degrade_xe = .false.
	6447	IF( config_flags%periodic_y .or. &
	6448	config_flags%symmetric_ys .or. &
	6449	(jts > jds+2) ) degrade_ys = .false.
	6450	IF( config_flags%periodic_y .or. &
	6451	config_flags%symmetric_ye .or. &
	6452	(jte < jde-3) ) degrade_ye = .false.
	6453
	6454	!--------------- y - advection first
	6455
	6456	!-- y flux compute; these bounds are for periodic and sym b.c.
	6457
	6458	ktf=MIN(kte,kde-1)
	6459	i_start = its-1
	6460	i_end = MIN(ite,ide-1)+1
	6461	j_start = jts-1
	6462	j_end = MIN(jte,jde-1)+1
	6463	j_start_f = j_start
	6464	j_end_f = j_end+1
	6465
	6466	!-- modify loop bounds if open or specified
	6467
	6468	IF(degrade_xs) i_start = its
	6469	IF(degrade_xe) i_end = MIN(ite,ide-1)
	6470
	6471	IF(degrade_ys) then
	6472	j_start = MAX(jts,jds+1)
	6473	j_start_f = jds+3
	6474	ENDIF
	6475
	6476	IF(degrade_ye) then
	6477	j_end = MIN(jte,jde-2)
	6478	j_end_f = jde-3
	6479	ENDIF
	6480
	6481	! compute fluxes, 5th order
	6482
	6483	j_loop_y_flux_5 : DO j = j_start, j_end+1
	6484
	6485	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	6486
	6487	DO k=kts,ktf
	6488	DO i = i_start, i_end
	6489
	6490	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6491	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6492	vel = rv(i,k,j)
	6493	cr = vel*dt/dy/mu
	6494	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6495
	6496	fqy( i, k, j ) = vel*flux5( &
	6497	field(i,k,j-3), field(i,k,j-2), field(i,k,j-1), &
	6498	field(i,k,j ), field(i,k,j+1), field(i,k,j+2), vel )
	6499
	6500	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6501
	6502	ENDDO
	6503	ENDDO
	6504
	6505	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	6506
	6507	DO k=kts,ktf
	6508	DO i = i_start, i_end
	6509
	6510	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6511	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6512	vel = rv(i,k,j)
	6513	cr = vel*dt/dy/mu
	6514	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6515
	6516	fqy(i,k, j) = 0.5rv(i,k,j) &
	6517	(field(i,k,j)+field(i,k,j-1))
	6518
	6519	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6520
	6521	ENDDO
	6522	ENDDO
	6523
	6524	ELSE IF ( j == jds+2 ) THEN ! third of 4th order flux 2 in from south boundary
	6525
	6526	DO k=kts,ktf
	6527	DO i = i_start, i_end
	6528
	6529	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6530	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6531	vel = rv(i,k,j)
	6532	cr = vel*dt/dy/mu
	6533	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6534
	6535	fqy( i, k, j ) = vel*flux3( &
	6536	field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel )
	6537	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6538
	6539	ENDDO
	6540	ENDDO
	6541
	6542	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	6543
	6544	DO k=kts,ktf
	6545	DO i = i_start, i_end
	6546
	6547	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6548	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6549	vel = rv(i,k,j)
	6550	cr = vel*dt/dy/mu
	6551	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6552
	6553	fqy(i, k, j ) = 0.5rv(i,k,j) &
	6554	(field(i,k,j)+field(i,k,j-1))
	6555	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6556
	6557	ENDDO
	6558	ENDDO
	6559
	6560	ELSE IF ( j == jde-2 ) THEN ! 3rd or 4th order flux 2 in from north boundary
	6561
	6562	DO k=kts,ktf
	6563	DO i = i_start, i_end
	6564
	6565	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6566	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6567	vel = rv(i,k,j)
	6568	cr = vel*dt/dy/mu
	6569	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6570
	6571	fqy( i, k, j) = vel*flux3( &
	6572	field(i,k,j-2),field(i,k,j-1), &
	6573	field(i,k,j),field(i,k,j+1),vel )
	6574	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6575
	6576	ENDDO
	6577	ENDDO
	6578
	6579	ENDIF
	6580
	6581	ENDDO j_loop_y_flux_5
	6582
	6583	! next, x flux
	6584
	6585	!-- these bounds are for periodic and sym conditions
	6586
	6587	i_start = its-1
	6588	i_end = MIN(ite,ide-1)+1
	6589	i_start_f = i_start
	6590	i_end_f = i_end+1
	6591
	6592	j_start = jts-1
	6593	j_end = MIN(jte,jde-1)+1
	6594
	6595	!-- modify loop bounds for open and specified b.c
	6596
	6597	IF(degrade_ys) j_start = jts
	6598	IF(degrade_ye) j_end = MIN(jte,jde-1)
	6599
	6600	IF(degrade_xs) then
	6601	i_start = MAX(ids+1,its)
	6602	i_start_f = i_start+2
	6603	ENDIF
	6604
	6605	IF(degrade_xe) then
	6606	i_end = MIN(ide-2,ite)
	6607	i_end_f = ide-3
	6608	ENDIF
	6609
	6610	! compute fluxes
	6611
	6612	DO j = j_start, j_end
	6613
	6614	! 5th order flux
	6615
	6616	DO k=kts,ktf
	6617	DO i = i_start_f, i_end_f
	6618
	6619	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6620	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6621	vel = ru(i,k,j)
	6622	cr = vel*dt/dx/mu
	6623	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6624
	6625	fqx( i,k,j ) = vel*flux5( field(i-3,k,j), field(i-2,k,j), &
	6626	field(i-1,k,j), field(i ,k,j), &
	6627	field(i+1,k,j), field(i+2,k,j), &
	6628	vel )
	6629	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6630
	6631	ENDDO
	6632	ENDDO
	6633
	6634	! lower order fluxes close to boundaries (if not periodic or symmetric)
	6635
	6636	IF( degrade_xs ) THEN
	6637
	6638	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	6639	i = ids+1
	6640	DO k=kts,ktf
	6641
	6642	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6643	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6644	vel = ru(i,k,j)/mu
	6645	cr = vel*dt/dx
	6646	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6647
	6648	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6649	*(field(i,k,j)+field(i-1,k,j))
	6650
	6651	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6652
	6653	ENDDO
	6654	ENDIF
	6655
	6656	i = ids+2
	6657	DO k=kts,ktf
	6658	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6659	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6660	vel = ru(i,k,j)
	6661	cr = vel*dt/dx/mu
	6662	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6663	fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
	6664	field(i ,k,j), field(i+1,k,j), &
	6665	vel )
	6666	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6667
	6668	ENDDO
	6669
	6670	ENDIF
	6671
	6672	IF( degrade_xe ) THEN
	6673
	6674	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	6675	i = ide-1
	6676	DO k=kts,ktf
	6677	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6678	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6679	vel = ru(i,k,j)
	6680	cr = vel*dt/dx/mu
	6681	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6682	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6683	*(field(i,k,j)+field(i-1,k,j))
	6684	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6685
	6686	ENDDO
	6687	ENDIF
	6688
	6689	i = ide-2
	6690	DO k=kts,ktf
	6691
	6692	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6693	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6694	vel = ru(i,k,j)
	6695	cr = vel*dt/dx/mu
	6696	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6697	fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
	6698	field(i ,k,j), field(i+1,k,j), &
	6699	vel )
	6700	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6701
	6702	ENDDO
	6703
	6704	ENDIF
	6705
	6706	ENDDO ! enddo for outer J loop
	6707
	6708	!--- end of 5th order horizontal flux calculation
	6709
	6710	ELSE IF( horz_order == 4 ) THEN
	6711
	6712	IF( config_flags%periodic_x .or. &
	6713	config_flags%symmetric_xs .or. &
	6714	(its > ids+1) ) degrade_xs = .false.
	6715	IF( config_flags%periodic_x .or. &
	6716	config_flags%symmetric_xe .or. &
	6717	(ite < ide-2) ) degrade_xe = .false.
	6718	IF( config_flags%periodic_y .or. &
	6719	config_flags%symmetric_ys .or. &
	6720	(jts > jds+1) ) degrade_ys = .false.
	6721	IF( config_flags%periodic_y .or. &
	6722	config_flags%symmetric_ye .or. &
	6723	(jte < jde-2) ) degrade_ye = .false.
	6724
	6725	!--------------- y - advection first
	6726
	6727	!-- y flux compute; these bounds are for periodic and sym b.c.
	6728
	6729	ktf=MIN(kte,kde-1)
	6730	i_start = its-1
	6731	i_end = MIN(ite,ide-1)+1
	6732	j_start = jts-1
	6733	j_end = MIN(jte,jde-1)+1
	6734	j_start_f = j_start
	6735	j_end_f = j_end+1
	6736
	6737	!-- modify loop bounds if open or specified
	6738
	6739	IF(degrade_xs) i_start = its
	6740	IF(degrade_xe) i_end = MIN(ite,ide-1)
	6741
	6742	IF(degrade_ys) then
	6743	j_start = MAX(jts,jds+1)
	6744	j_start_f = jds+2
	6745	ENDIF
	6746
	6747	IF(degrade_ye) then
	6748	j_end = MIN(jte,jde-2)
	6749	j_end_f = jde-2
	6750	ENDIF
	6751
	6752	! compute fluxes, 4th order
	6753
	6754	j_loop_y_flux_4 : DO j = j_start, j_end+1
	6755
	6756	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	6757
	6758	DO k=kts,ktf
	6759	DO i = i_start, i_end
	6760
	6761	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6762	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6763	vel = rv(i,k,j)
	6764	cr = vel*dt/dy/mu
	6765	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6766
	6767	fqy( i, k, j ) = vel*flux4( field(i,k,j-2), field(i,k,j-1), &
	6768	field(i,k,j ), field(i,k,j+1), vel )
	6769
	6770	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6771
	6772	ENDDO
	6773	ENDDO
	6774
	6775	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	6776
	6777	DO k=kts,ktf
	6778	DO i = i_start, i_end
	6779
	6780	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6781	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6782	vel = rv(i,k,j)
	6783	cr = vel*dt/dy/mu
	6784	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6785
	6786	fqy(i,k, j) = 0.5rv(i,k,j) &
	6787	(field(i,k,j)+field(i,k,j-1))
	6788
	6789	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6790
	6791	ENDDO
	6792	ENDDO
	6793
	6794	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	6795
	6796	DO k=kts,ktf
	6797	DO i = i_start, i_end
	6798
	6799	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6800	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6801	vel = rv(i,k,j)
	6802	cr = vel*dt/dy/mu
	6803	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6804
	6805	fqy(i, k, j ) = 0.5rv(i,k,j) &
	6806	(field(i,k,j)+field(i,k,j-1))
	6807	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6808
	6809	ENDDO
	6810	ENDDO
	6811
	6812	ENDIF
	6813
	6814	ENDDO j_loop_y_flux_4
	6815
	6816	! next, x flux
	6817
	6818	!-- these bounds are for periodic and sym conditions
	6819
	6820	i_start = its-1
	6821	i_end = MIN(ite,ide-1)+1
	6822	i_start_f = i_start
	6823	i_end_f = i_end+1
	6824
	6825	j_start = jts-1
	6826	j_end = MIN(jte,jde-1)+1
	6827
	6828	!-- modify loop bounds for open and specified b.c
	6829
	6830	IF(degrade_ys) j_start = jts
	6831	IF(degrade_ye) j_end = MIN(jte,jde-1)
	6832
	6833	IF(degrade_xs) then
	6834	i_start = MAX(ids+1,its)
	6835	i_start_f = i_start+1
	6836	ENDIF
	6837
	6838	IF(degrade_xe) then
	6839	i_end = MIN(ide-2,ite)
	6840	i_end_f = ide-2
	6841	ENDIF
	6842
	6843	! compute fluxes
	6844
	6845	DO j = j_start, j_end
	6846
	6847	! 4th order flux
	6848
	6849	DO k=kts,ktf
	6850	DO i = i_start_f, i_end_f
	6851
	6852	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6853	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6854	vel = ru(i,k,j)
	6855	cr = vel*dt/dx/mu
	6856	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6857
	6858	fqx( i,k,j ) = vel*flux4( field(i-2,k,j), field(i-1,k,j), &
	6859	field(i ,k,j), field(i+1,k,j), vel )
	6860	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6861
	6862	ENDDO
	6863	ENDDO
	6864
	6865	! lower order fluxes close to boundaries (if not periodic or symmetric)
	6866
	6867	IF( degrade_xs ) THEN
	6868	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	6869	i = ids+1
	6870	DO k=kts,ktf
	6871
	6872	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6873	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6874	vel = ru(i,k,j)/mu
	6875	cr = vel*dt/dx
	6876	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6877
	6878	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6879	*(field(i,k,j)+field(i-1,k,j))
	6880
	6881	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6882
	6883	ENDDO
	6884	ENDIF
	6885	ENDIF
	6886
	6887	IF( degrade_xe ) THEN
	6888	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	6889	i = ide-1
	6890	DO k=kts,ktf
	6891	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	6892	mu = 0.5*(mut(i,j)+mut(i-1,j))
	6893	vel = ru(i,k,j)
	6894	cr = vel*dt/dx/mu
	6895	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	6896	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	6897	*(field(i,k,j)+field(i-1,k,j))
	6898	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	6899
	6900	ENDDO
	6901	ENDIF
	6902	ENDIF
	6903
	6904	ENDDO ! enddo for outer J loop
	6905
	6906	!--- end of 4th order horizontal flux calculation
	6907
	6908	ELSE IF( horz_order == 3 ) THEN
	6909
	6910	IF( config_flags%periodic_x .or. &
	6911	config_flags%symmetric_xs .or. &
	6912	(its > ids+1) ) degrade_xs = .false.
	6913	IF( config_flags%periodic_x .or. &
	6914	config_flags%symmetric_xe .or. &
	6915	(ite < ide-2) ) degrade_xe = .false.
	6916	IF( config_flags%periodic_y .or. &
	6917	config_flags%symmetric_ys .or. &
	6918	(jts > jds+1) ) degrade_ys = .false.
	6919	IF( config_flags%periodic_y .or. &
	6920	config_flags%symmetric_ye .or. &
	6921	(jte < jde-2) ) degrade_ye = .false.
	6922
	6923	!--------------- y - advection first
	6924
	6925	!-- y flux compute; these bounds are for periodic and sym b.c.
	6926
	6927	ktf=MIN(kte,kde-1)
	6928	i_start = its-1
	6929	i_end = MIN(ite,ide-1)+1
	6930	j_start = jts-1
	6931	j_end = MIN(jte,jde-1)+1
	6932	j_start_f = j_start
	6933	j_end_f = j_end+1
	6934
	6935	!-- modify loop bounds if open or specified
	6936
	6937	IF(degrade_xs) i_start = its
	6938	IF(degrade_xe) i_end = MIN(ite,ide-1)
	6939
	6940	IF(degrade_ys) then
	6941	j_start = MAX(jts,jds+1)
	6942	j_start_f = jds+2
	6943	ENDIF
	6944
	6945	IF(degrade_ye) then
	6946	j_end = MIN(jte,jde-2)
	6947	j_end_f = jde-2
	6948	ENDIF
	6949
	6950	! compute fluxes, 3rd order
	6951
	6952	j_loop_y_flux_3 : DO j = j_start, j_end+1
	6953
	6954	IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN ! use full stencil
	6955
	6956	DO k=kts,ktf
	6957	DO i = i_start, i_end
	6958
	6959	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6960	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6961	vel = rv(i,k,j)
	6962	cr = vel*dt/dy/mu
	6963	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6964
	6965	fqy( i, k, j ) = vel*flux3( field(i,k,j-2), field(i,k,j-1), &
	6966	field(i,k,j ), field(i,k,j+1), vel )
	6967
	6968	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6969
	6970	ENDDO
	6971	ENDDO
	6972
	6973	ELSE IF ( j == jds+1 ) THEN ! 2nd order flux next to south boundary
	6974
	6975	DO k=kts,ktf
	6976	DO i = i_start, i_end
	6977
	6978	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6979	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6980	vel = rv(i,k,j)
	6981	cr = vel*dt/dy/mu
	6982	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	6983
	6984	fqy(i,k, j) = 0.5rv(i,k,j) &
	6985	(field(i,k,j)+field(i,k,j-1))
	6986
	6987	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	6988
	6989	ENDDO
	6990	ENDDO
	6991
	6992	ELSE IF ( j == jde-1 ) THEN ! 2nd order flux next to north boundary
	6993
	6994	DO k=kts,ktf
	6995	DO i = i_start, i_end
	6996
	6997	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	6998	mu = 0.5*(mut(i,j)+mut(i,j-1))
	6999	vel = rv(i,k,j)
	7000	cr = vel*dt/dy/mu
	7001	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	7002
	7003	fqy(i, k, j ) = 0.5rv(i,k,j) &
	7004	(field(i,k,j)+field(i,k,j-1))
	7005	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	7006
	7007	ENDDO
	7008	ENDDO
	7009
	7010	ENDIF
	7011
	7012	ENDDO j_loop_y_flux_3
	7013
	7014	! next, x flux
	7015
	7016	!-- these bounds are for periodic and sym conditions
	7017
	7018	i_start = its-1
	7019	i_end = MIN(ite,ide-1)+1
	7020	i_start_f = i_start
	7021	i_end_f = i_end+1
	7022
	7023	j_start = jts-1
	7024	j_end = MIN(jte,jde-1)+1
	7025
	7026	!-- modify loop bounds for open and specified b.c
	7027
	7028	IF(degrade_ys) j_start = jts
	7029	IF(degrade_ye) j_end = MIN(jte,jde-1)
	7030
	7031	IF(degrade_xs) then
	7032	i_start = MAX(ids+1,its)
	7033	i_start_f = i_start+1
	7034	ENDIF
	7035
	7036	IF(degrade_xe) then
	7037	i_end = MIN(ide-2,ite)
	7038	i_end_f = ide-2
	7039	ENDIF
	7040
	7041	! compute fluxes
	7042
	7043	DO j = j_start, j_end
	7044
	7045	! 4th order flux
	7046
	7047	DO k=kts,ktf
	7048	DO i = i_start_f, i_end_f
	7049
	7050	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	7051	mu = 0.5*(mut(i,j)+mut(i-1,j))
	7052	vel = ru(i,k,j)
	7053	cr = vel*dt/dx/mu
	7054	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	7055
	7056	fqx( i,k,j ) = vel*flux3( field(i-2,k,j), field(i-1,k,j), &
	7057	field(i ,k,j), field(i+1,k,j), vel )
	7058	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	7059
	7060	ENDDO
	7061	ENDDO
	7062
	7063	! lower order fluxes close to boundaries (if not periodic or symmetric)
	7064
	7065	IF( degrade_xs ) THEN
	7066
	7067	IF( i_start == ids+1 ) THEN ! second order flux next to the boundary
	7068	i = ids+1
	7069	DO k=kts,ktf
	7070
	7071	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	7072	mu = 0.5*(mut(i,j)+mut(i-1,j))
	7073	vel = ru(i,k,j)/mu
	7074	cr = vel*dt/dx
	7075	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	7076
	7077	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	7078	*(field(i,k,j)+field(i-1,k,j))
	7079
	7080	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	7081
	7082	ENDDO
	7083	ENDIF
	7084	ENDIF
	7085
	7086	IF( degrade_xe ) THEN
	7087	IF( i_end == ide-2 ) THEN ! second order flux next to the boundary
	7088	i = ide-1
	7089	DO k=kts,ktf
	7090	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	7091	mu = 0.5*(mut(i,j)+mut(i-1,j))
	7092	vel = ru(i,k,j)
	7093	cr = vel*dt/dx/mu
	7094	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	7095	fqx(i,k,j) = 0.5*(ru(i,k,j)) &
	7096	*(field(i,k,j)+field(i-1,k,j))
	7097	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	7098
	7099	ENDDO
	7100	ENDIF
	7101	ENDIF
	7102
	7103	ENDDO ! enddo for outer J loop
	7104
	7105	!--- end of 3rd order horizontal flux calculation
	7106
	7107
	7108	ELSE IF( horz_order == 2 ) THEN
	7109
	7110	IF( config_flags%periodic_x .or. &
	7111	config_flags%symmetric_xs .or. &
	7112	(its > ids) ) degrade_xs = .false.
	7113	IF( config_flags%periodic_x .or. &
	7114	config_flags%symmetric_xe .or. &
	7115	(ite < ide-1) ) degrade_xe = .false.
	7116	IF( config_flags%periodic_y .or. &
	7117	config_flags%symmetric_ys .or. &
	7118	(jts > jds) ) degrade_ys = .false.
	7119	IF( config_flags%periodic_y .or. &
	7120	config_flags%symmetric_ye .or. &
	7121	(jte < jde-1) ) degrade_ye = .false.
	7122
	7123	!-- y flux compute; these bounds are for periodic and sym b.c.
	7124
	7125	ktf=MIN(kte,kde-1)
	7126	i_start = its-1
	7127	i_end = MIN(ite,ide-1)+1
	7128	j_start = jts-1
	7129	j_end = MIN(jte,jde-1)+1
	7130
	7131	!-- modify loop bounds if open or specified
	7132
	7133	IF(degrade_xs) i_start = its
	7134	IF(degrade_xe) i_end = MIN(ite,ide-1)
	7135	IF(degrade_ys) j_start = MAX(jts,jds+1)
	7136	IF(degrade_ye) j_end = MIN(jte,jde-2)
	7137
	7138	! compute fluxes, 2nd order, y flux
	7139
	7140	DO j = j_start, j_end+1
	7141	DO k=kts,ktf
	7142	DO i = i_start, i_end
	7143	dy = 2./(msftx(i,j)+msftx(i,j-1))/rdy ! ADT eqn 48 d/dy
	7144	mu = 0.5*(mut(i,j)+mut(i,j-1))
	7145	vel = rv(i,k,j)
	7146	cr = vel*dt/dy/mu
	7147	fqyl(i,k,j) = mu(dy/dt)flux_upwind(field_old(i,k,j-1), field_old(i,k,j ), cr)
	7148
	7149	fqy(i,k, j) = 0.5rv(i,k,j) &
	7150	(field(i,k,j)+field(i,k,j-1))
	7151
	7152	fqy(i,k,j) = fqy(i,k,j) - fqyl(i,k,j)
	7153	ENDDO
	7154	ENDDO
	7155	ENDDO
	7156
	7157	! next, x flux
	7158
	7159	DO j = j_start, j_end
	7160	DO k=kts,ktf
	7161	DO i = i_start, i_end+1
	7162	dx = 2./(msfty(i,j)+msfty(i-1,j))/rdx ! ADT eqn 48 d/dx
	7163	mu = 0.5*(mut(i,j)+mut(i-1,j))
	7164	vel = ru(i,k,j)
	7165	cr = vel*dt/dx/mu
	7166	fqxl(i,k,j) = mu(dx/dt)flux_upwind(field_old(i-1,k,j), field_old(i,k,j ), cr)
	7167	fqx( i,k,j ) = 0.5ru(i,k,j) &
	7168	(field(i,k,j)+field(i-1,k,j))
	7169
	7170	fqx(i,k,j) = fqx(i,k,j) - fqxl(i,k,j)
	7171	ENDDO
	7172	ENDDO
	7173	ENDDO
	7174
	7175	!--- end of 2nd order horizontal flux calculation
	7176
	7177	ELSE
	7178
	7179	WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_pd, h_order not known ',horz_order
	7180	CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
	7181
	7182	ENDIF horizontal_order_test
	7183
	7184	! pick up the rest of the horizontal radiation boundary conditions.
	7185	! (these are the computations that don't require 'cb'.
	7186	! first, set to index ranges
	7187
	7188	i_start = its
	7189	i_end = MIN(ite,ide-1)
	7190	j_start = jts
	7191	j_end = MIN(jte,jde-1)
	7192
	7193	! compute x (u) conditions for v, w, or scalar
	7194
	7195	IF( (config_flags%open_xs) .and. (its == ids) ) THEN
	7196
	7197	DO j = j_start, j_end
	7198	DO k = kts, ktf
	7199	ub = MIN( 0.5*(ru(its,k,j)+ru(its+1,k,j)), 0. )
	7200	tendency(its,k,j) = tendency(its,k,j) &
	7201	- rdx*( &
	7202	ub*( field_old(its+1,k,j) &
	7203	- field_old(its ,k,j) ) + &
	7204	field(its,k,j)*(ru(its+1,k,j)-ru(its,k,j)) &
	7205	)
	7206	ENDDO
	7207	ENDDO
	7208
	7209	ENDIF
	7210
	7211	IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
	7212
	7213	DO j = j_start, j_end
	7214	DO k = kts, ktf
	7215	ub = MAX( 0.5*(ru(ite-1,k,j)+ru(ite,k,j)), 0. )
	7216	tendency(i_end,k,j) = tendency(i_end,k,j) &
	7217	- rdx*( &
	7218	ub*( field_old(i_end ,k,j) &
	7219	- field_old(i_end-1,k,j) ) + &
	7220	field(i_end,k,j)*(ru(ite,k,j)-ru(ite-1,k,j)) &
	7221	)
	7222	ENDDO
	7223	ENDDO
	7224
	7225	ENDIF
	7226
	7227	IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
	7228
	7229	DO i = i_start, i_end
	7230	DO k = kts, ktf
	7231	vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
	7232	tendency(i,k,jts) = tendency(i,k,jts) &
	7233	- rdy*( &
	7234	vb*( field_old(i,k,jts+1) &
	7235	- field_old(i,k,jts ) ) + &
	7236	field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,jts)) &
	7237	)
	7238	ENDDO
	7239	ENDDO
	7240
	7241	ENDIF
	7242
	7243	IF( (config_flags%open_ye) .and. (jte == jde)) THEN
	7244
	7245	DO i = i_start, i_end
	7246	DO k = kts, ktf
	7247	vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
	7248	tendency(i,k,j_end) = tendency(i,k,j_end) &
	7249	- rdy*( &
	7250	vb*( field_old(i,k,j_end ) &
	7251	- field_old(i,k,j_end-1) ) + &
	7252	field(i,k,j_end)*(rv(i,k,jte)-rv(i,k,jte-1)) &
	7253	)
	7254	ENDDO
	7255	ENDDO
	7256
	7257	ENDIF
	7258
	7259	IF( (config_flags%polar) .and. (jts == jds) ) THEN
	7260
	7261	! Assuming rv(i,k,jds) = 0.
	7262	DO i = i_start, i_end
	7263	DO k = kts, ktf
	7264	vb = MIN( 0.5*rv(i,k,jts+1), 0. )
	7265	tendency(i,k,jts) = tendency(i,k,jts) &
	7266	- rdy*( &
	7267	vb*( field_old(i,k,jts+1) &
	7268	- field_old(i,k,jts ) ) + &
	7269	field(i,k,jts)*rv(i,k,jts+1) &
	7270	)
	7271	ENDDO
	7272	ENDDO
	7273
	7274	ENDIF
	7275
	7276	IF( (config_flags%polar) .and. (jte == jde)) THEN
	7277
	7278	! Assuming rv(i,k,jde) = 0.
	7279	DO i = i_start, i_end
	7280	DO k = kts, ktf
	7281	vb = MAX( 0.5*rv(i,k,jte-1), 0. )
	7282	tendency(i,k,j_end) = tendency(i,k,j_end) &
	7283	- rdy*( &
	7284	vb*( field_old(i,k,j_end ) &
	7285	- field_old(i,k,j_end-1) ) + &
	7286	field(i,k,j_end)*(-rv(i,k,jte-1)) &
	7287	)
	7288	ENDDO
	7289	ENDDO
	7290
	7291	ENDIF
	7292
	7293	!-------------------- vertical advection
	7294
	7295	!-- loop bounds for periodic or sym conditions
	7296
	7297	i_start = its-1
	7298	i_end = MIN(ite,ide-1)+1
	7299	j_start = jts-1
	7300	j_end = MIN(jte,jde-1)+1
	7301
	7302	!-- loop bounds for open or specified conditions
	7303
	7304	IF(degrade_xs) i_start = its
	7305	IF(degrade_xe) i_end = MIN(ite,ide-1)
	7306	IF(degrade_ys) j_start = jts
	7307	IF(degrade_ye) j_end = MIN(jte,jde-1)
	7308
	7309	vert_order_test : IF (vert_order == 6) THEN
	7310
	7311	DO j = j_start, j_end
	7312
	7313	DO i = i_start, i_end
	7314	fqz(i,1,j) = 0.
	7315	fqzl(i,1,j) = 0.
	7316	fqz(i,kde,j) = 0.
	7317	fqzl(i,kde,j) = 0.
	7318	ENDDO
	7319
	7320	DO k=kts+3,ktf-2
	7321	DO i = i_start, i_end
	7322	dz = 2./(rdzw(k)+rdzw(k-1))
	7323	mu = 0.5*(mut(i,j)+mut(i,j))
	7324	vel = rom(i,k,j)
	7325	cr = vel*dt/dz/mu
	7326	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7327
	7328	fqz(i,k,j) = vel*flux6( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j), &
	7329	field(i,k ,j), field(i,k+1,j), field(i,k+2,j), -vel )
	7330	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7331	ENDDO
	7332	ENDDO
	7333
	7334	DO i = i_start, i_end
	7335
	7336	k=kts+1
	7337	dz = 2./(rdzw(k)+rdzw(k-1))
	7338	mu = 0.5*(mut(i,j)+mut(i,j))
	7339	vel = rom(i,k,j)
	7340	cr = vel*dt/dz/mu
	7341	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7342	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7343	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7344
	7345	k=kts+2
	7346	dz = 2./(rdzw(k)+rdzw(k-1))
	7347	mu = 0.5*(mut(i,j)+mut(i,j))
	7348	vel = rom(i,k,j)
	7349	cr = vel*dt/dz/mu
	7350	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7351
	7352	fqz(i,k,j) = vel*flux4( &
	7353	field(i,k-2,j), field(i,k-1,j), &
	7354	field(i,k ,j), field(i,k+1,j), -vel )
	7355	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7356
	7357	k=ktf-1
	7358	dz = 2./(rdzw(k)+rdzw(k-1))
	7359	mu = 0.5*(mut(i,j)+mut(i,j))
	7360	vel = rom(i,k,j)
	7361	cr = vel*dt/dz/mu
	7362	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7363
	7364	fqz(i,k,j) = vel*flux4( &
	7365	field(i,k-2,j), field(i,k-1,j), &
	7366	field(i,k ,j), field(i,k+1,j), -vel )
	7367	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7368
	7369	k=ktf
	7370	dz = 2./(rdzw(k)+rdzw(k-1))
	7371	mu = 0.5*(mut(i,j)+mut(i,j))
	7372	vel = rom(i,k,j)
	7373	cr = vel*dt/dz/mu
	7374	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7375	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7376	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7377
	7378	ENDDO
	7379
	7380	ENDDO
	7381
	7382	ELSE IF (vert_order == 5) THEN
	7383
	7384	DO j = j_start, j_end
	7385
	7386	DO i = i_start, i_end
	7387	fqz(i,1,j) = 0.
	7388	fqzl(i,1,j) = 0.
	7389	fqz(i,kde,j) = 0.
	7390	fqzl(i,kde,j) = 0.
	7391	ENDDO
	7392
	7393	DO k=kts+3,ktf-2
	7394	DO i = i_start, i_end
	7395	dz = 2./(rdzw(k)+rdzw(k-1))
	7396	mu = 0.5*(mut(i,j)+mut(i,j))
	7397	vel = rom(i,k,j)
	7398	cr = vel*dt/dz/mu
	7399	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7400
	7401	fqz(i,k,j) = vel*flux5( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j), &
	7402	field(i,k ,j), field(i,k+1,j), field(i,k+2,j), -vel )
	7403	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7404	ENDDO
	7405	ENDDO
	7406
	7407	DO i = i_start, i_end
	7408
	7409	k=kts+1
	7410	dz = 2./(rdzw(k)+rdzw(k-1))
	7411	mu = 0.5*(mut(i,j)+mut(i,j))
	7412	vel = rom(i,k,j)
	7413	cr = vel*dt/dz/mu
	7414	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7415	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7416	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7417
	7418	k=kts+2
	7419	dz = 2./(rdzw(k)+rdzw(k-1))
	7420	mu = 0.5*(mut(i,j)+mut(i,j))
	7421	vel = rom(i,k,j)
	7422	cr = vel*dt/dz/mu
	7423	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7424
	7425	fqz(i,k,j) = vel*flux3( &
	7426	field(i,k-2,j), field(i,k-1,j), &
	7427	field(i,k ,j), field(i,k+1,j), -vel )
	7428	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7429
	7430	k=ktf-1
	7431	dz = 2./(rdzw(k)+rdzw(k-1))
	7432	mu = 0.5*(mut(i,j)+mut(i,j))
	7433	vel = rom(i,k,j)
	7434	cr = vel*dt/dz/mu
	7435	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7436
	7437	fqz(i,k,j) = vel*flux3( &
	7438	field(i,k-2,j), field(i,k-1,j), &
	7439	field(i,k ,j), field(i,k+1,j), -vel )
	7440	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7441
	7442	k=ktf
	7443	dz = 2./(rdzw(k)+rdzw(k-1))
	7444	mu = 0.5*(mut(i,j)+mut(i,j))
	7445	vel = rom(i,k,j)
	7446	cr = vel*dt/dz/mu
	7447	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7448	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7449	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7450
	7451	ENDDO
	7452
	7453	ENDDO
	7454
	7455	ELSE IF (vert_order == 4) THEN
	7456
	7457	DO j = j_start, j_end
	7458
	7459	DO i = i_start, i_end
	7460	fqz(i,1,j) = 0.
	7461	fqzl(i,1,j) = 0.
	7462	fqz(i,kde,j) = 0.
	7463	fqzl(i,kde,j) = 0.
	7464	ENDDO
	7465
	7466	DO k=kts+2,ktf-1
	7467	DO i = i_start, i_end
	7468
	7469	dz = 2./(rdzw(k)+rdzw(k-1))
	7470	mu = 0.5*(mut(i,j)+mut(i,j))
	7471	vel = rom(i,k,j)
	7472	cr = vel*dt/dz/mu
	7473	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7474
	7475	fqz(i,k,j) = vel*flux4( &
	7476	field(i,k-2,j), field(i,k-1,j), &
	7477	field(i,k ,j), field(i,k+1,j), -vel )
	7478	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7479	ENDDO
	7480	ENDDO
	7481
	7482	DO i = i_start, i_end
	7483
	7484	k=kts+1
	7485	dz = 2./(rdzw(k)+rdzw(k-1))
	7486	mu = 0.5*(mut(i,j)+mut(i,j))
	7487	vel = rom(i,k,j)
	7488	cr = vel*dt/dz/mu
	7489	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7490	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7491	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7492
	7493	k=ktf
	7494	dz = 2./(rdzw(k)+rdzw(k-1))
	7495	mu = 0.5*(mut(i,j)+mut(i,j))
	7496	vel = rom(i,k,j)
	7497	cr = vel*dt/dz/mu
	7498	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7499	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7500	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7501
	7502	ENDDO
	7503
	7504	ENDDO
	7505
	7506	ELSE IF (vert_order == 3) THEN
	7507
	7508	DO j = j_start, j_end
	7509
	7510	DO i = i_start, i_end
	7511	fqz(i,1,j) = 0.
	7512	fqzl(i,1,j) = 0.
	7513	fqz(i,kde,j) = 0.
	7514	fqzl(i,kde,j) = 0.
	7515	ENDDO
	7516
	7517	DO k=kts+2,ktf-1
	7518	DO i = i_start, i_end
	7519
	7520	dz = 2./(rdzw(k)+rdzw(k-1))
	7521	mu = 0.5*(mut(i,j)+mut(i,j))
	7522	vel = rom(i,k,j)
	7523	cr = vel*dt/dz/mu
	7524	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7525
	7526	fqz(i,k,j) = vel*flux3( &
	7527	field(i,k-2,j), field(i,k-1,j), &
	7528	field(i,k ,j), field(i,k+1,j), -vel )
	7529	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7530	ENDDO
	7531	ENDDO
	7532
	7533	DO i = i_start, i_end
	7534
	7535	k=kts+1
	7536	dz = 2./(rdzw(k)+rdzw(k-1))
	7537	mu = 0.5*(mut(i,j)+mut(i,j))
	7538	vel = rom(i,k,j)
	7539	cr = vel*dt/dz/mu
	7540	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7541	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7542	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7543
	7544	k=ktf
	7545	dz = 2./(rdzw(k)+rdzw(k-1))
	7546	mu = 0.5*(mut(i,j)+mut(i,j))
	7547	vel = rom(i,k,j)
	7548	cr = vel*dt/dz/mu
	7549	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7550	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7551	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7552
	7553	ENDDO
	7554
	7555	ENDDO
	7556
	7557	ELSE IF (vert_order == 2) THEN
	7558
	7559	DO j = j_start, j_end
	7560
	7561	DO i = i_start, i_end
	7562	fqz(i,1,j) = 0.
	7563	fqzl(i,1,j) = 0.
	7564	fqz(i,kde,j) = 0.
	7565	fqzl(i,kde,j) = 0.
	7566	ENDDO
	7567
	7568	DO k=kts+1,ktf
	7569	DO i = i_start, i_end
	7570
	7571	dz = 2./(rdzw(k)+rdzw(k-1))
	7572	mu = 0.5*(mut(i,j)+mut(i,j))
	7573	vel = rom(i,k,j)
	7574	cr = vel*dt/dz/mu
	7575	fqzl(i,k,j) = mu(dz/dt)flux_upwind(field_old(i,k-1,j), field_old(i,k,j ), cr)
	7576	fqz(i,k,j)=rom(i,k,j)(fzm(k)field(i,k,j)+fzp(k)*field(i,k-1,j))
	7577	fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
	7578
	7579	ENDDO
	7580	ENDDO
	7581
	7582	ENDDO
	7583
	7584	ELSE
	7585
	7586	WRITE (wrf_err_message,*) ' advect_scalar_pd, v_order not known ',vert_order
	7587	CALL wrf_error_fatal ( wrf_err_message )
	7588
	7589	ENDIF vert_order_test
	7590
	7591	IF (pd_limit) THEN
	7592
	7593	! positive definite filter
	7594
	7595	i_start = its-1
	7596	i_end = MIN(ite,ide-1)+1
	7597	j_start = jts-1
	7598	j_end = MIN(jte,jde-1)+1
	7599
	7600	!-- loop bounds for open or specified conditions
	7601
	7602	IF(degrade_xs) i_start = its
	7603	IF(degrade_xe) i_end = MIN(ite,ide-1)
	7604	IF(degrade_ys) j_start = jts
	7605	IF(degrade_ye) j_end = MIN(jte,jde-1)
	7606
	7607	IF(config_flags%specified .or. config_flags%nested) THEN
	7608	IF (degrade_xs) i_start = MAX(its,ids+1)
	7609	IF (degrade_xe) i_end = MIN(ite,ide-2)
	7610	IF (degrade_ys) j_start = MAX(jts,jds+1)
	7611	IF (degrade_ye) j_end = MIN(jte,jde-2)
	7612	END IF
	7613
	7614	IF(config_flags%open_xs) THEN
	7615	IF (degrade_xs) i_start = MAX(its,ids+1)
	7616	END IF
	7617	IF(config_flags%open_xe) THEN
	7618	IF (degrade_xe) i_end = MIN(ite,ide-2)
	7619	END IF
	7620	IF(config_flags%open_ys) THEN
	7621	IF (degrade_ys) j_start = MAX(jts,jds+1)
	7622	END IF
	7623	IF(config_flags%open_ye) THEN
	7624	IF (degrade_ye) j_end = MIN(jte,jde-2)
	7625	END IF
	7626	! ADT note:
	7627	! We don't want to change j_start and j_end
	7628	! for polar BC's since we want to calculate
	7629	! fluxes for directions other than y at the
	7630	! edge
	7631
	7632	!-- here is the limiter...
	7633
	7634	DO j=j_start, j_end
	7635	DO k=kts, ktf
	7636	DO i=i_start, i_end
	7637
	7638	ph_low = (mub(i,j)+mu_old(i,j))*field_old(i,k,j) &
	7639	- dt( msftx(i,j)msfty(i,j)*( &
	7640	rdx*(fqxl(i+1,k,j)-fqxl(i,k,j)) + &
	7641	rdy*(fqyl(i,k,j+1)-fqyl(i,k,j)) ) &
	7642	+msfty(i,j)rdzw(k)(fqzl(i,k+1,j)-fqzl(i,k,j)) )
	7643
	7644	flux_out = dt( (msftx(i,j)msfty(i,j))*( &
	7645	rdx*( max(0.,fqx (i+1,k,j)) &
	7646	-min(0.,fqx (i ,k,j)) ) &
	7647	+rdy*( max(0.,fqy (i,k,j+1)) &
	7648	-min(0.,fqy (i,k,j )) ) ) &
	7649	+msfty(i,j)rdzw(k)( min(0.,fqz (i,k+1,j)) &
	7650	-max(0.,fqz (i,k ,j)) ) )
	7651
	7652	IF( flux_out .gt. ph_low ) THEN
	7653
	7654	scale = max(0.,ph_low/(flux_out+eps))
	7655	IF( fqx (i+1,k,j) .gt. 0.) fqx(i+1,k,j) = scale*fqx(i+1,k,j)
	7656	IF( fqx (i ,k,j) .lt. 0.) fqx(i ,k,j) = scale*fqx(i ,k,j)
	7657	IF( fqy (i,k,j+1) .gt. 0.) fqy(i,k,j+1) = scale*fqy(i,k,j+1)
	7658	IF( fqy (i,k,j ) .lt. 0.) fqy(i,k,j ) = scale*fqy(i,k,j )
	7659	! note: z flux is opposite sign in mass coordinate because
	7660	! vertical coordinate decreases with increasing k
	7661	IF( fqz (i,k+1,j) .lt. 0.) fqz(i,k+1,j) = scale*fqz(i,k+1,j)
	7662	IF( fqz (i,k ,j) .gt. 0.) fqz(i,k ,j) = scale*fqz(i,k ,j)
	7663
	7664	END IF
	7665
	7666	ENDDO
	7667	ENDDO
	7668	ENDDO
	7669
	7670	END IF
	7671
	7672	! add in the pd-limited flux divergence
	7673
	7674	i_start = its
	7675	i_end = MIN(ite,ide-1)
	7676	j_start = jts
	7677	j_end = MIN(jte,jde-1)
	7678
	7679	DO j = j_start, j_end
	7680	DO k = kts, ktf
	7681	DO i = i_start, i_end
	7682
	7683	tendency (i,k,j) = tendency(i,k,j) &
	7684	-rdzw(k)*( fqz (i,k+1,j)-fqz (i,k,j) &
	7685	+fqzl(i,k+1,j)-fqzl(i,k,j))
	7686
	7687	ENDDO
	7688	ENDDO
	7689	ENDDO
	7690
	7691	! x flux divergence
	7692	!
	7693	IF(degrade_xs) i_start = i_start + 1
	7694	IF(degrade_xe) i_end = i_end - 1
	7695
	7696	DO j = j_start, j_end
	7697	DO k = kts, ktf
	7698	DO i = i_start, i_end
	7699
	7700	! Un-"canceled" map scale factor, ADT Eq. 48
	7701	tendency (i,k,j) = tendency(i,k,j) &
	7702	- msftx(i,j)( rdx( fqx (i+1,k,j)-fqx (i,k,j) &
	7703	+fqxl(i+1,k,j)-fqxl(i,k,j)) )
	7704
	7705	ENDDO
	7706	ENDDO
	7707	ENDDO
	7708
	7709	! y flux divergence
	7710	!
	7711	i_start = its
	7712	i_end = MIN(ite,ide-1)
	7713	IF(degrade_ys) j_start = j_start + 1
	7714	IF(degrade_ye) j_end = j_end - 1
	7715
	7716	DO j = j_start, j_end
	7717	DO k = kts, ktf
	7718	DO i = i_start, i_end
	7719
	7720	! Un-"canceled" map scale factor, ADT Eq. 48
	7721	! It is correct to use msftx (and not msfty), per W. Skamarock, 20080606
	7722	tendency (i,k,j) = tendency(i,k,j) &
	7723	- msftx(i,j)( rdy( fqy (i,k,j+1)-fqy (i,k,j) &
	7724	+fqyl(i,k,j+1)-fqyl(i,k,j)) )
	7725
	7726	ENDDO
	7727	ENDDO
	7728	ENDDO
	7729
	7730	END SUBROUTINE advect_scalar_pd
	7731
	7732	!----------------------------------------------------------------
	7733
	7734	END MODULE module_advect_em
	7735

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

Download in other formats:

Original Format