
! ======================================================================================
! This file was generated by the version 5.3.6 of DFT on 07/15/2010. The differentiation
! transforming system(DFT) was jointly developed and sponsored by LASG of IAP(1998-2010)
! and LSEC of ICMSEC, AMSS(2001-2003)
! The copyright of the DFT system was declared by Walls at LASG, 1998-2010
! ======================================================================================

 MODULE g_module_advect_em

 USE module_bc !REVISED BY WALLS
 USE module_model_constants
 USE module_wrf_error

 CONTAINS

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_u in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom u tendency u_old ru rv
!                mut
!   RW status of diff variables: rom:in u:in tendency:in-out u_old:in
!                ru:in rv:in mut:in
SUBROUTINE G_ADVECT_U(u, ud, u_old, u_oldd, tendency, tendencyd, ru, rud&
&  , rv, rvd, rom, romd, mut, mutd, time_step, config_flags, msfux, msfuy&
&  , msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzw, ids, ide, jds&
&  , jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
&  , kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u, u_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ud, u_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax, im, ip
  INTEGER :: jp1, jp0, jtmp
  INTEGER :: horz_order, vert_order
  REAL :: mrdx, mrdy, ub, vb, uw, vw, dvm, dvp
  REAL :: ubd, vbd, vwd, dvmd, dvpd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its - 1:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its-1:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified


  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
!  set order for vertical and horzontal flux operators
  horz_order = config_flags%h_mom_adv_order
  vert_order = config_flags%v_mom_adv_order
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
!  begin with horizontal flux divergence
  IF (horz_order .EQ. 6) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    i_end = ite
    IF (config_flags%open_xs .OR. specified) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
    END IF
    IF (config_flags%open_xe .OR. specified) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_6:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*(37.*(u(i, k, j)+u(i, k, j-1))-8.*(u(&
&              i, k, j+1)+u(i, k, j-2))+(u(i, k, j+2)+u(i, k, j-3)))/60.0&
&              + vel*(37.*(ud(i, k, j)+ud(i, k, j-1))-8.*(ud(i, k, j+1)+&
&              ud(i, k, j-2))+ud(i, k, j+2)+ud(i, k, j-3))/60.0
            fqy(i, k, jp1) = vel*((37.*(u(i, k, j)+u(i, k, j-1))-8.*(u(i&
&              , k, j+1)+u(i, k, j-2))+(u(i, k, j+2)+u(i, k, j-3)))/60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
!  we must be close to some boundary where we need to reduce the order of the stencil
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*(7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k&
&              , j-1))-ud(i, k, j+1)-ud(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*(7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k&
&              , j-1))-ud(i, k, j+1)-ud(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! (j > j_start) will miss the u(,,jds) tendency
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_6
!  next, x - flux divergence
    i_start = its
    i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = ids + 3
    END IF
    IF (degrade_xe) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*(37.*(u(i, k, j)+u(i-1, k, j))-8.*(u(i+1, k&
&            , j)+u(i-2, k, j))+(u(i+2, k, j)+u(i-3, k, j)))/60.0 + vel*(&
&            37.*(ud(i, k, j)+ud(i-1, k, j))-8.*(ud(i+1, k, j)+ud(i-2, k&
&            , j))+ud(i+2, k, j)+ud(i-3, k, j))/60.0
          fqx(i, k) = vel*((37.*(u(i, k, j)+u(i-1, k, j))-8.*(u(i+1, k, &
&            j)+u(i-2, k, j))+(u(i+2, k, j)+u(i-3, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        IF (i_start .EQ. ids + 1) THEN
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            ubd = ud(i-1, k, j)
            ub = u(i-1, k, j)
            IF (specified .AND. u(i, k, j) .LT. 0.) THEN
              ubd = ud(i, k, j)
              ub = u(i, k, j)
            END IF
            fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i, k, j)&
&              +ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)+ubd))
            fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i, k, j)+ub)
          END DO
        END IF
        i = ids + 2
        DO k=kts,ktf
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*(7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+&
&            u(i-2, k, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i-1, k, j))-ud&
&            (i+1, k, j)-ud(i-2, k, j))/12.0
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0)
        END DO
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 1) THEN
! second order flux next to the boundary
          i = ide
          DO k=kts,ktf
            ubd = ud(i, k, j)
            ub = u(i, k, j)
            IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
              ubd = ud(i-1, k, j)
              ub = u(i-1, k, j)
            END IF
            fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i-1, k, &
&              j)+ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i-1, k, j)+ubd))
            fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i-1, k, j)+&
&              ub)
          END DO
        END IF
        DO k=kts,ktf
          i = ide - 1
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*(7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+&
&            u(i-2, k, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i-1, k, j))-ud&
&            (i+1, k, j)-ud(i-2, k, j))/12.0
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0)
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 5) THEN
!  5th order horizontal flux calculation
!  This code is EXACTLY the same as the 6th order code
!  EXCEPT the 5th order and 3rd operators are used in
!  place of the 6th and 4th order operators
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    i_end = ite
    IF (config_flags%open_xs .OR. specified) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
    END IF
    IF (config_flags%open_xe .OR. specified) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*((37.*(u(i, k, j)+u(i, k, j-1))-8.*(u&
&              (i, k, j+1)+u(i, k, j-2))+(u(i, k, j+2)+u(i, k, j-3)))/&
&              60.0-SIGN(1, time_step)*SIGN(1., vel)*(u(i, k, j+2)-u(i, k&
&              , j-3)-5.*(u(i, k, j+1)-u(i, k, j-2))+10.*(u(i, k, j)-u(i&
&              , k, j-1)))/60.0) + vel*((37.*(ud(i, k, j)+ud(i, k, j-1))-&
&              8.*(ud(i, k, j+1)+ud(i, k, j-2))+ud(i, k, j+2)+ud(i, k, j-&
&              3))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(ud(i, k, j+2)-&
&              ud(i, k, j-3)-5.*(ud(i, k, j+1)-ud(i, k, j-2))+10.*(ud(i, &
&              k, j)-ud(i, k, j-1)))/60.0)
            fqy(i, k, jp1) = vel*((37.*(u(i, k, j)+u(i, k, j-1))-8.*(u(i&
&              , k, j+1)+u(i, k, j-2))+(u(i, k, j+2)+u(i, k, j-3)))/60.0-&
&              SIGN(1, time_step)*SIGN(1., vel)*(u(i, k, j+2)-u(i, k, j-3&
&              )-5.*(u(i, k, j+1)-u(i, k, j-2))+10.*(u(i, k, j)-u(i, k, j&
&              -1)))/60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
!  we must be close to some boundary where we need to reduce the order of the stencil
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, &
&              k, j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1&
&              )))/12.0) + vel*((7.*(ud(i, k, j)+ud(i, k, j-1))-ud(i, k, &
&              j+1)-ud(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (ud(i, k, j+1)-ud(i, k, j-2)-3.*(ud(i, k, j)-ud(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, &
&              k, j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1&
&              )))/12.0) + vel*((7.*(ud(i, k, j)+ud(i, k, j-1))-ud(i, k, &
&              j+1)-ud(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (ud(i, k, j+1)-ud(i, k, j-2)-3.*(ud(i, k, j)-ud(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! (j > j_start) will miss the u(,,jds) tendency
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_5
!  next, x - flux divergence
    i_start = its
    i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = ids + 3
    END IF
    IF (degrade_xe) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*((37.*(u(i, k, j)+u(i-1, k, j))-8.*(u(i+1, k&
&            , j)+u(i-2, k, j))+(u(i+2, k, j)+u(i-3, k, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., vel)*(u(i+2, k, j)-u(i-3, k, j)-5.*(u(&
&            i+1, k, j)-u(i-2, k, j))+10.*(u(i, k, j)-u(i-1, k, j)))/60.0&
&            ) + vel*((37.*(ud(i, k, j)+ud(i-1, k, j))-8.*(ud(i+1, k, j)+&
&            ud(i-2, k, j))+ud(i+2, k, j)+ud(i-3, k, j))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(ud(i+2, k, j)-ud(i-3, k, j)-5.*(ud&
&            (i+1, k, j)-ud(i-2, k, j))+10.*(ud(i, k, j)-ud(i-1, k, j)))/&
&            60.0)
          fqx(i, k) = vel*((37.*(u(i, k, j)+u(i-1, k, j))-8.*(u(i+1, k, &
&            j)+u(i-2, k, j))+(u(i+2, k, j)+u(i-3, k, j)))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(u(i+2, k, j)-u(i-3, k, j)-5.*(u(i+&
&            1, k, j)-u(i-2, k, j))+10.*(u(i, k, j)-u(i-1, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        IF (i_start .EQ. ids + 1) THEN
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            ubd = ud(i-1, k, j)
            ub = u(i-1, k, j)
            IF (specified .AND. u(i, k, j) .LT. 0.) THEN
              ubd = ud(i, k, j)
              ub = u(i, k, j)
            END IF
            fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i, k, j)&
&              +ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)+ubd))
            fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i, k, j)+ub)
          END DO
        END IF
        i = ids + 2
        DO k=kts,ktf
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)&
&            +u(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1&
&            , k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0) + &
&            vel*((7.*(ud(i, k, j)+ud(i-1, k, j))-ud(i+1, k, j)-ud(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i+1, k, j)-&
&            ud(i-2, k, j)-3.*(ud(i, k, j)-ud(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, &
&            k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0)
        END DO
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 1) THEN
! second order flux next to the boundary
          i = ide
          DO k=kts,ktf
            ubd = ud(i, k, j)
            ub = u(i, k, j)
            IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
              ubd = ud(i-1, k, j)
              ub = u(i-1, k, j)
            END IF
            fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i-1, k, &
&              j)+ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i-1, k, j)+ubd))
            fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i-1, k, j)+&
&              ub)
          END DO
        END IF
        DO k=kts,ktf
          i = ide - 1
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)&
&            +u(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1&
&            , k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0) + &
&            vel*((7.*(ud(i, k, j)+ud(i-1, k, j))-ud(i+1, k, j)-ud(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i+1, k, j)-&
&            ud(i-2, k, j)-3.*(ud(i, k, j)-ud(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, &
&            k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0)
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 4) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 1) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
!--------------- x - advection first
    i_start = its
    i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 1
      i_end_f = ide - 1
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*(7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+&
&            u(i-2, k, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i-1, k, j))-ud&
&            (i+1, k, j)-ud(i-2, k, j))/12.0
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        i = i_start
        DO k=kts,ktf
          ubd = ud(i-1, k, j)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ubd = ud(i, k, j)
            ub = u(i, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i, k, j)+&
&            ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i, k, j)+ub)
        END DO
      END IF
      IF (degrade_xe) THEN
        i = i_end + 1
        DO k=kts,ktf
          ubd = ud(i, k, j)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ubd = ud(i-1, k, j)
            ub = u(i-1, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i-1, k, j)&
&            +ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i-1, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i-1, k, j)+ub)
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  y flux divergence
    i_start = its
    i_end = ite
    IF (config_flags%open_xs .OR. specified) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
    END IF
    IF (config_flags%open_xe .OR. specified) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
!CJM these may not work with tiling because they define j_start and end in terms of domain dim
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  j flux loop for v flux of u momentum
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j_start)+rvd(i-1, k, &
&              j_start))*(u(i, k, j_start)+u(i, k, j_start-1))+(rv(i, k, &
&              j_start)+rv(i-1, k, j_start))*(ud(i, k, j_start)+ud(i, k, &
&              j_start-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j_start)+rv(i-1, k, j_start)&
&              )*(u(i, k, j_start)+u(i, k, j_start-1))
          END DO
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
!                *(u(i,k,j_end+1)+u(i,k,j_end))
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*(7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k&
&              , j-1))-ud(i, k, j+1)-ud(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! (j > j_start) will miss the u(,,jds) tendency
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 3) THEN
!  As with the 5th and 6th order flux chioces, the 3rd and 4th order
!  code is EXACTLY the same EXCEPT for the flux operator.
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 1) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
!--------------- x - advection first
    i_start = its
    i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 1
      i_end_f = ide - 1
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          fqxd(i, k) = veld*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)&
&            +u(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1&
&            , k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0) + &
&            vel*((7.*(ud(i, k, j)+ud(i-1, k, j))-ud(i+1, k, j)-ud(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i+1, k, j)-&
&            ud(i-2, k, j)-3.*(ud(i, k, j)-ud(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, &
&            k, j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        i = i_start
        DO k=kts,ktf
          ubd = ud(i-1, k, j)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ubd = ud(i, k, j)
            ub = u(i, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i, k, j)+&
&            ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i, k, j)+ub)
        END DO
      END IF
      IF (degrade_xe) THEN
        i = i_end + 1
        DO k=kts,ktf
          ubd = ud(i, k, j)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ubd = ud(i-1, k, j)
            ub = u(i-1, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i-1, k, j)&
&            +ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i-1, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i-1, k, j)+ub)
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  y flux divergence
    i_start = its
    i_end = ite
    IF (config_flags%open_xs .OR. specified) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
    END IF
    IF (config_flags%open_xe .OR. specified) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
!CJM these may not work with tiling because they define j_start and end in terms of domain dim
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  j flux loop for v flux of u momentum
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j_start)+rvd(i-1, k, &
&              j_start))*(u(i, k, j_start)+u(i, k, j_start-1))+(rv(i, k, &
&              j_start)+rv(i-1, k, j_start))*(ud(i, k, j_start)+ud(i, k, &
&              j_start-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j_start)+rv(i-1, k, j_start)&
&              )*(u(i, k, j_start)+u(i, k, j_start-1))
          END DO
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!         fqy(i, k, jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))    &
!                *(u(i,k,j_end+1)+u(i,k,j_end))
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, &
&              k, j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, &
&              j)+ud(i, k, j-1)))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j&
&              )+u(i, k, j-1))
          END DO
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            fqyd(i, k, jp1) = veld*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, &
&              k, j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1&
&              )))/12.0) + vel*((7.*(ud(i, k, j)+ud(i, k, j-1))-ud(i, k, &
&              j+1)-ud(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (ud(i, k, j+1)-ud(i, k, j-2)-3.*(ud(i, k, j)-ud(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&              , j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! (j > j_start) will miss the u(,,jds) tendency
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
            mrdy = msfux(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 2) THEN
    i_start = its
    i_end = ite
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    IF (config_flags%open_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
    END IF
    IF (config_flags%open_xe) THEN
      IF (ide - 1 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 1
      END IF
    END IF
    IF (specified) THEN
      IF (ids + 2 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 2
      END IF
    END IF
    IF (specified) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.25*((rud(i+1&
&            , k, j)+rud(i, k, j))*(u(i+1, k, j)+u(i, k, j))+(ru(i+1, k, &
&            j)+ru(i, k, j))*(ud(i+1, k, j)+ud(i, k, j))-(rud(i, k, j)+&
&            rud(i-1, k, j))*(u(i, k, j)+u(i-1, k, j))-(ru(i, k, j)+ru(i-&
&            1, k, j))*(ud(i, k, j)+ud(i-1, k, j)))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.25*((ru(i+1, k&
&            , j)+ru(i, k, j))*(u(i+1, k, j)+u(i, k, j))-(ru(i, k, j)+ru(&
&            i-1, k, j))*(u(i, k, j)+u(i-1, k, j)))
        END DO
      END DO
    END DO
    IF (specified .AND. its .LE. ids + 1 .AND. (.NOT.config_flags%&
&        periodic_x)) THEN
      DO j=j_start,j_end
        DO k=kts,ktf
          i = ids + 1
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          ubd = ud(i-1, k, j)
          ub = u(i-1, k, j)
          IF (u(i, k, j) .LT. 0.) THEN
            ubd = ud(i, k, j)
            ub = u(i, k, j)
          END IF
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.25*((rud(i+1&
&            , k, j)+rud(i, k, j))*(u(i+1, k, j)+u(i, k, j))+(ru(i+1, k, &
&            j)+ru(i, k, j))*(ud(i+1, k, j)+ud(i, k, j))-(rud(i, k, j)+&
&            rud(i-1, k, j))*(u(i, k, j)+ub)-(ru(i, k, j)+ru(i-1, k, j))*&
&            (ud(i, k, j)+ubd))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.25*((ru(i+1, k&
&            , j)+ru(i, k, j))*(u(i+1, k, j)+u(i, k, j))-(ru(i, k, j)+ru(&
&            i-1, k, j))*(u(i, k, j)+ub))
        END DO
      END DO
    END IF
    IF (specified .AND. ite .GE. ide - 1 .AND. (.NOT.config_flags%&
&        periodic_x)) THEN
      DO j=j_start,j_end
        DO k=kts,ktf
          i = ide - 1
! ADT eqn 44, 1st term on RHS
          mrdx = msfux(i, j)*rdx
          ubd = ud(i+1, k, j)
          ub = u(i+1, k, j)
          IF (u(i, k, j) .GT. 0.) THEN
            ubd = ud(i, k, j)
            ub = u(i, k, j)
          END IF
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.25*((rud(i+1&
&            , k, j)+rud(i, k, j))*(ub+u(i, k, j))+(ru(i+1, k, j)+ru(i, k&
&            , j))*(ubd+ud(i, k, j))-(rud(i, k, j)+rud(i-1, k, j))*(u(i, &
&            k, j)+u(i-1, k, j))-(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)&
&            +ud(i-1, k, j)))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.25*((ru(i+1, k&
&            , j)+ru(i, k, j))*(ub+u(i, k, j))-(ru(i, k, j)+ru(i-1, k, j)&
&            )*(u(i, k, j)+u(i-1, k, j)))
        END DO
      END DO
    END IF
    IF (config_flags%open_ys .OR. specified) THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF (config_flags%open_ye .OR. specified) THEN
      IF (jde - 2 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 2
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
          mrdy = msfux(i, j)*rdy
! Comments for polar boundary condition
! Flow is only from one side for points next to poles
          IF (config_flags%polar .AND. j .EQ. jds) THEN
            tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.25*((rvd(i&
&              , k, j+1)+rvd(i-1, k, j+1))*(u(i, k, j+1)+u(i, k, j))+(rv(&
&              i, k, j+1)+rv(i-1, k, j+1))*(ud(i, k, j+1)+ud(i, k, j)))
            tendency(i, k, j) = tendency(i, k, j) - mrdy*0.25*(rv(i, k, &
&              j+1)+rv(i-1, k, j+1))*(u(i, k, j+1)+u(i, k, j))
          ELSE IF (config_flags%polar .AND. j .EQ. jde - 1) THEN
            tendencyd(i, k, j) = tendencyd(i, k, j) + mrdy*0.25*((rvd(i&
&              , k, j)+rvd(i-1, k, j))*(u(i, k, j)+u(i, k, j-1))+(rv(i, k&
&              , j)+rv(i-1, k, j))*(ud(i, k, j)+ud(i, k, j-1)))
            tendency(i, k, j) = tendency(i, k, j) + mrdy*0.25*(rv(i, k, &
&              j)+rv(i-1, k, j))*(u(i, k, j)+u(i, k, j-1))
          ELSE
! Normal code
            tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.25*((rvd(i&
&              , k, j+1)+rvd(i-1, k, j+1))*(u(i, k, j+1)+u(i, k, j))+(rv(&
&              i, k, j+1)+rv(i-1, k, j+1))*(ud(i, k, j+1)+ud(i, k, j))-(&
&              rvd(i, k, j)+rvd(i-1, k, j))*(u(i, k, j)+u(i, k, j-1))-(rv&
&              (i, k, j)+rv(i-1, k, j))*(ud(i, k, j)+ud(i, k, j-1)))
            tendency(i, k, j) = tendency(i, k, j) - mrdy*0.25*((rv(i, k&
&              , j+1)+rv(i-1, k, j+1))*(u(i, k, j+1)+u(i, k, j))-(rv(i, k&
&              , j)+rv(i-1, k, j))*(u(i, k, j)+u(i, k, j-1)))
          END IF
        END DO
      END DO
    END DO
  ELSE IF (horz_order .NE. 0) THEN
! Just in case we want to turn horizontal advection off, we can do it
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_u_6a:  h_order not known ', horz_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
  END IF
!  radiative lateral boundary condition in x for normal velocity (u)
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ru(its, k, j) - cb*mut(its, j) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = rud(its, k, j) - cb*mutd(its, j)
          ub = ru(its, k, j) - cb*mut(its, j)
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(u_old(&
&          its+1, k, j)-u_old(its, k, j))+ub*(u_oldd(its+1, k, j)-u_oldd(&
&          its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*ub*(u_old(its+1&
&          , k, j)-u_old(its, k, j))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ru(ite, k, j) + cb*mut(ite-1, j) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = rud(ite, k, j) + cb*mutd(ite-1, j)
          ub = ru(ite, k, j) + cb*mut(ite-1, j)
        END IF
        tendencyd(ite, k, j) = tendencyd(ite, k, j) - rdx*(ubd*(u_old(&
&          ite, k, j)-u_old(ite-1, k, j))+ub*(u_oldd(ite, k, j)-u_oldd(&
&          ite-1, k, j)))
        tendency(ite, k, j) = tendency(ite, k, j) - rdx*ub*(u_old(ite, k&
&          , j)-u_old(ite-1, k, j))
      END DO
    END DO
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb')
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide) THEN
    i_end = ide
  ELSE
    i_end = ite
  END IF
  imin = ids
  imax = ide - 1
  IF (config_flags%open_xs) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
    imin = ids
  END IF
  IF (config_flags%open_xe) THEN
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    imax = ide - 1
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jts)*rdy
      IF (imax .GT. i) THEN
        ip = i
      ELSE
        ip = imax
      END IF
      IF (imin .LT. i - 1) THEN
        im = i - 1
      ELSE
        im = imin
      END IF
      DO k=kts,ktf
        vwd = 0.5*(rvd(ip, k, jts)+rvd(im, k, jts))
        vw = 0.5*(rv(ip, k, jts)+rv(im, k, jts))
        IF (vw .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        dvmd = rvd(ip, k, jts+1) - rvd(ip, k, jts)
        dvm = rv(ip, k, jts+1) - rv(ip, k, jts)
        dvpd = rvd(im, k, jts+1) - rvd(im, k, jts)
        dvp = rv(im, k, jts+1) - rv(im, k, jts)
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - mrdy*(vbd*(u_old(i&
&          , k, jts+1)-u_old(i, k, jts))+vb*(u_oldd(i, k, jts+1)-u_oldd(i&
&          , k, jts))+0.5*(ud(i, k, jts)*(dvm+dvp)+u(i, k, jts)*(dvmd+&
&          dvpd)))
        tendency(i, k, jts) = tendency(i, k, jts) - mrdy*(vb*(u_old(i, k&
&          , jts+1)-u_old(i, k, jts))+0.5*u(i, k, jts)*(dvm+dvp))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jte-1)*rdy
      IF (imax .GT. i) THEN
        ip = i
      ELSE
        ip = imax
      END IF
      IF (imin .LT. i - 1) THEN
        im = i - 1
      ELSE
        im = imin
      END IF
      DO k=kts,ktf
        vwd = 0.5*(rvd(ip, k, jte)+rvd(im, k, jte))
        vw = 0.5*(rv(ip, k, jte)+rv(im, k, jte))
        IF (vw .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        dvmd = rvd(ip, k, jte) - rvd(ip, k, jte-1)
        dvm = rv(ip, k, jte) - rv(ip, k, jte-1)
        dvpd = rvd(im, k, jte) - rvd(im, k, jte-1)
        dvp = rv(im, k, jte) - rv(im, k, jte-1)
        tendencyd(i, k, jte-1) = tendencyd(i, k, jte-1) - mrdy*(vbd*(&
&          u_old(i, k, jte-1)-u_old(i, k, jte-2))+vb*(u_oldd(i, k, jte-1)&
&          -u_oldd(i, k, jte-2))+0.5*(ud(i, k, jte-1)*(dvm+dvp)+u(i, k, &
&          jte-1)*(dvmd+dvpd)))
        tendency(i, k, jte-1) = tendency(i, k, jte-1) - mrdy*(vb*(u_old(&
&          i, k, jte-1)-u_old(i, k, jte-2))+0.5*u(i, k, jte-1)*(dvm+dvp))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!  ADT eqn 44 has 3rd term on RHS = -(1/my) partial d/dz (rho u w)
!  Here we have:  - partial d/dz (u*rom) = - partial d/dz (u rho w / my)
!  Since 'my' (map scale factor in y-direction) isn't a function of z,
!  this is what we need, so leave unchanged in advect_u
  i_start = its
  i_end = ite
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!   IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
!   IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
  IF (config_flags%open_ys .OR. specified) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
  END IF
  IF (config_flags%open_ye .OR. specified) THEN
    IF (ide - 1 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 1
    END IF
  END IF
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) i_end = ite
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  IF (vert_order .EQ. 6) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = 0.5*(romd(i-1, k, j)+romd(i, k, j))
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          vfluxd(i, k) = veld*(37.*(u(i, k, j)+u(i, k-1, j))-8.*(u(i, k+&
&            1, j)+u(i, k-2, j))+(u(i, k+2, j)+u(i, k-3, j)))/60.0 + vel*&
&            (37.*(ud(i, k, j)+ud(i, k-1, j))-8.*(ud(i, k+1, j)+ud(i, k-2&
&            , j))+ud(i, k+2, j)+ud(i, k-3, j))/60.0
          vflux(i, k) = vel*((37.*(u(i, k, j)+u(i, k-1, j))-8.*(u(i, k+1&
&            , j)+u(i, k-2, j))+(u(i, k+2, j)+u(i, k-3, j)))/60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        vfluxd(i, k) = veld*(7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+&
&          u(i, k-2, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k-1, j))-ud(i&
&          , k+1, j)-ud(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&          (i, k-2, j)))/12.0)
        k = ktf - 1
        veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        vfluxd(i, k) = veld*(7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+&
&          u(i, k-2, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k-1, j))-ud(i&
&          , k+1, j)-ud(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&          (i, k-2, j)))/12.0)
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = 0.5*(romd(i-1, k, j)+romd(i, k, j))
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          vfluxd(i, k) = veld*((37.*(u(i, k, j)+u(i, k-1, j))-8.*(u(i, k&
&            +1, j)+u(i, k-2, j))+(u(i, k+2, j)+u(i, k-3, j)))/60.0-SIGN(&
&            1, time_step)*SIGN(1., -vel)*(u(i, k+2, j)-u(i, k-3, j)-5.*(&
&            u(i, k+1, j)-u(i, k-2, j))+10.*(u(i, k, j)-u(i, k-1, j)))/&
&            60.0) + vel*((37.*(ud(i, k, j)+ud(i, k-1, j))-8.*(ud(i, k+1&
&            , j)+ud(i, k-2, j))+ud(i, k+2, j)+ud(i, k-3, j))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(ud(i, k+2, j)-ud(i, k-3, j)-5.*&
&            (ud(i, k+1, j)-ud(i, k-2, j))+10.*(ud(i, k, j)-ud(i, k-1, j)&
&            ))/60.0)
          vflux(i, k) = vel*((37.*(u(i, k, j)+u(i, k-1, j))-8.*(u(i, k+1&
&            , j)+u(i, k-2, j))+(u(i, k+2, j)+u(i, k-3, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(u(i, k+2, j)-u(i, k-3, j)-5.*(u&
&            (i, k+1, j)-u(i, k-2, j))+10.*(u(i, k, j)-u(i, k-1, j)))/&
&            60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        vfluxd(i, k) = veld*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)&
&          +u(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k&
&          +1, j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0) + vel*&
&          ((7.*(ud(i, k, j)+ud(i, k-1, j))-ud(i, k+1, j)-ud(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(ud(i, k+1, j)-ud(i, k-&
&          2, j)-3.*(ud(i, k, j)-ud(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1&
&          , j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0)
        k = ktf - 1
        veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        vfluxd(i, k) = veld*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)&
&          +u(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k&
&          +1, j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0) + vel*&
&          ((7.*(ud(i, k, j)+ud(i, k-1, j))-ud(i, k+1, j)-ud(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(ud(i, k+1, j)-ud(i, k-&
&          2, j)-3.*(ud(i, k, j)-ud(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1&
&          , j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0)
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i-1, k, j)+romd(i, k, j))
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          vfluxd(i, k) = veld*(7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j&
&            )+u(i, k-2, j)))/12.0 + vel*(7.*(ud(i, k, j)+ud(i, k-1, j))-&
&            ud(i, k+1, j)-ud(i, k-2, j))/12.0
          vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)&
&            +u(i, k-2, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i-1, k, j)+romd(i, k, j))
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          vfluxd(i, k) = veld*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, &
&            j)+u(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(&
&            i, k+1, j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0) &
&            + vel*((7.*(ud(i, k, j)+ud(i, k-1, j))-ud(i, k+1, j)-ud(i, k&
&            -2, j))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(ud(i, k+1, j&
&            )-ud(i, k-2, j)-3.*(ud(i, k, j)-ud(i, k-1, j)))/12.0)
          vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)&
&            +u(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i&
&            , k+1, j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i&
&          , k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(&
&          fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, &
&          j)+fzp(k)*u(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
          vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(&
&            i, k, j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*&
&            (fzm(k)*ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
          vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k&
&            , j)+fzp(k)*u(i, k-1, j))
        END DO
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_u_6a: v_order not known ', vert_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
  END IF
END SUBROUTINE G_ADVECT_U

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_v in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom tendency v v_old ru rv
!                mut
!   RW status of diff variables: rom:in tendency:in-out v:in v_old:in
!                ru:in rv:in mut:in
SUBROUTINE G_ADVECT_V(v, vd, v_old, v_oldd, tendency, tendencyd, ru, rud&
&  , rv, rvd, rom, romd, mut, mutd, time_step, config_flags, msfux, msfuy&
&  , msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzw, ids, ide, jds&
&  , jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
&  , kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: v, v_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: vd, v_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw, dup, dum
  REAL :: ubd, vbd, uwd, dupd, dumd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  INTEGER :: horz_order
  INTEGER :: vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified
  REAL :: cb


  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_mom_adv_order
  vert_order = config_flags%v_mom_adv_order
!  here is the choice of flux operators
  IF (horz_order .EQ. 6) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 2
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_6:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*(37.*(v(i, k, j)+v(i, k, j-1))-8.*(v(&
&              i, k, j+1)+v(i, k, j-2))+(v(i, k, j+2)+v(i, k, j-3)))/60.0&
&              + vel*(37.*(vd(i, k, j)+vd(i, k, j-1))-8.*(vd(i, k, j+1)+&
&              vd(i, k, j-2))+vd(i, k, j+2)+vd(i, k, j-3))/60.0
            fqy(i, k, jp1) = vel*((37.*(v(i, k, j)+v(i, k, j-1))-8.*(v(i&
&              , k, j+1)+v(i, k, j-2))+(v(i, k, j+2)+v(i, k, j-3)))/60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
!  we must be close to some boundary where we need to reduce the order of the stencil
!  specified uses upstream normal wind at boundaries
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j-1)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vbd = vd(i, k, j)
              vb = v(i, k, j)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(v(i, &
&              k, j)+vb)+(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)+vbd))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(v(i, k, j&
&              )+vb)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*(7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k&
&              , j-1))-vd(i, k, j+1)-vd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vbd = vd(i, k, j-1)
              vb = v(i, k, j-1)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(vb+v(&
&              i, k, j-1))+(rv(i, k, j)+rv(i, k, j-1))*(vbd+vd(i, k, j-1)&
&              ))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(vb+v(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*(7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k&
&              , j-1))-vd(i, k, j+1)-vd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! No advection over the poles means tendencies (held from jds [S. pole]
! to jde [N pole], i.e., on v grid) must be zero at poles
! [tendency(jds) and tendency(jde)=0]
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde + 1) THEN
! If j_end were set to jde in a special if statement apart from
! degrade_ye, then we would hit the next conditional.  But since
! we want the tendency to be zero anyway, not looping to jde+1
! will produce the same effect.
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
            mrdy = msfvy(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_6
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
          vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
          fqxd(i, k) = veld*(37.*(v(i, k, j)+v(i-1, k, j))-8.*(v(i+1, k&
&            , j)+v(i-2, k, j))+(v(i+2, k, j)+v(i-3, k, j)))/60.0 + vel*(&
&            37.*(vd(i, k, j)+vd(i-1, k, j))-8.*(vd(i+1, k, j)+vd(i-2, k&
&            , j))+vd(i+2, k, j)+vd(i-3, k, j))/60.0
          fqx(i, k) = vel*((37.*(v(i, k, j)+v(i-1, k, j))-8.*(v(i+1, k, &
&            j)+v(i-2, k, j))+(v(i+2, k, j)+v(i-3, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i, k, j-1))*(v(i, k, &
&                j)+v(i-1, k, j))+(ru(i, k, j)+ru(i, k, j-1))*(vd(i, k, j&
&                )+vd(i-1, k, j)))
              fqx(i, k) = 0.25*(ru(i, k, j)+ru(i, k, j-1))*(v(i, k, j)+v&
&                (i-1, k, j))
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
              vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
              fqxd(i, k) = veld*(7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k&
&                , j)+v(i-2, k, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i-1, &
&                k, j))-vd(i+1, k, j)-vd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&                j)+v(i-2, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
              fqxd(i, k) = 0.25*((rud(i_end+1, k, j)+rud(i_end+1, k, j-1&
&                ))*(v(i_end+1, k, j)+v(i_end, k, j))+(ru(i_end+1, k, j)+&
&                ru(i_end+1, k, j-1))*(vd(i_end+1, k, j)+vd(i_end, k, j))&
&                )
              fqx(i, k) = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*(&
&                v(i_end+1, k, j)+v(i_end, k, j))
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
              vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
              fqxd(i, k) = veld*(7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k&
&                , j)+v(i-2, k, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i-1, &
&                k, j))-vd(i+1, k, j)-vd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&                j)+v(i-2, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
          mrdx = msfvy(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 5) THEN
!  5th order horizontal flux calculation
!  This code is EXACTLY the same as the 6th order code
!  EXCEPT the 5th order and 3rd operators are used in
!  place of the 6th and 4th order operators
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 2
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*((37.*(v(i, k, j)+v(i, k, j-1))-8.*(v&
&              (i, k, j+1)+v(i, k, j-2))+(v(i, k, j+2)+v(i, k, j-3)))/&
&              60.0-SIGN(1, time_step)*SIGN(1., vel)*(v(i, k, j+2)-v(i, k&
&              , j-3)-5.*(v(i, k, j+1)-v(i, k, j-2))+10.*(v(i, k, j)-v(i&
&              , k, j-1)))/60.0) + vel*((37.*(vd(i, k, j)+vd(i, k, j-1))-&
&              8.*(vd(i, k, j+1)+vd(i, k, j-2))+vd(i, k, j+2)+vd(i, k, j-&
&              3))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(vd(i, k, j+2)-&
&              vd(i, k, j-3)-5.*(vd(i, k, j+1)-vd(i, k, j-2))+10.*(vd(i, &
&              k, j)-vd(i, k, j-1)))/60.0)
            fqy(i, k, jp1) = vel*((37.*(v(i, k, j)+v(i, k, j-1))-8.*(v(i&
&              , k, j+1)+v(i, k, j-2))+(v(i, k, j+2)+v(i, k, j-3)))/60.0-&
&              SIGN(1, time_step)*SIGN(1., vel)*(v(i, k, j+2)-v(i, k, j-3&
&              )-5.*(v(i, k, j+1)-v(i, k, j-2))+10.*(v(i, k, j)-v(i, k, j&
&              -1)))/60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
!  we must be close to some boundary where we need to reduce the order of the stencil
!  specified uses upstream normal wind at boundaries
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j-1)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vbd = vd(i, k, j)
              vb = v(i, k, j)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(v(i, &
&              k, j)+vb)+(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)+vbd))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(v(i, k, j&
&              )+vb)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, &
&              k, j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1&
&              )))/12.0) + vel*((7.*(vd(i, k, j)+vd(i, k, j-1))-vd(i, k, &
&              j+1)-vd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (vd(i, k, j+1)-vd(i, k, j-2)-3.*(vd(i, k, j)-vd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vbd = vd(i, k, j-1)
              vb = v(i, k, j-1)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(vb+v(&
&              i, k, j-1))+(rv(i, k, j)+rv(i, k, j-1))*(vbd+vd(i, k, j-1)&
&              ))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(vb+v(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, &
&              k, j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1&
&              )))/12.0) + vel*((7.*(vd(i, k, j)+vd(i, k, j-1))-vd(i, k, &
&              j+1)-vd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (vd(i, k, j+1)-vd(i, k, j-2)-3.*(vd(i, k, j)-vd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! No advection over the poles means tendencies (held from jds [S. pole]
! to jde [N pole], i.e., on v grid) must be zero at poles
! [tendency(jds) and tendency(jde)=0]
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde + 1) THEN
! If j_end were set to jde in a special if statement apart from
! degrade_ye, then we would hit the next conditional.  But since
! we want the tendency to be zero anyway, not looping to jde+1
! will produce the same effect.
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
            mrdy = msfvy(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_5
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
          vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
          fqxd(i, k) = veld*((37.*(v(i, k, j)+v(i-1, k, j))-8.*(v(i+1, k&
&            , j)+v(i-2, k, j))+(v(i+2, k, j)+v(i-3, k, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., vel)*(v(i+2, k, j)-v(i-3, k, j)-5.*(v(&
&            i+1, k, j)-v(i-2, k, j))+10.*(v(i, k, j)-v(i-1, k, j)))/60.0&
&            ) + vel*((37.*(vd(i, k, j)+vd(i-1, k, j))-8.*(vd(i+1, k, j)+&
&            vd(i-2, k, j))+vd(i+2, k, j)+vd(i-3, k, j))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(vd(i+2, k, j)-vd(i-3, k, j)-5.*(vd&
&            (i+1, k, j)-vd(i-2, k, j))+10.*(vd(i, k, j)-vd(i-1, k, j)))/&
&            60.0)
          fqx(i, k) = vel*((37.*(v(i, k, j)+v(i-1, k, j))-8.*(v(i+1, k, &
&            j)+v(i-2, k, j))+(v(i+2, k, j)+v(i-3, k, j)))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(v(i+2, k, j)-v(i-3, k, j)-5.*(v(i+&
&            1, k, j)-v(i-2, k, j))+10.*(v(i, k, j)-v(i-1, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i, k, j-1))*(v(i, k, &
&                j)+v(i-1, k, j))+(ru(i, k, j)+ru(i, k, j-1))*(vd(i, k, j&
&                )+vd(i-1, k, j)))
              fqx(i, k) = 0.25*(ru(i, k, j)+ru(i, k, j-1))*(v(i, k, j)+v&
&                (i-1, k, j))
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
              vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
              fqxd(i, k) = veld*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k&
&                , j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&                )*(v(i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)&
&                ))/12.0) + vel*((7.*(vd(i, k, j)+vd(i-1, k, j))-vd(i+1, &
&                k, j)-vd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(vd(i+1, k, j)-vd(i-2, k, j)-3.*(vd(i, k, j)-vd(i-1&
&                , k, j)))/12.0)
              fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&                j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&                (v(i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))&
&                /12.0)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
              fqxd(i, k) = 0.25*((rud(i_end+1, k, j)+rud(i_end+1, k, j-1&
&                ))*(v(i_end+1, k, j)+v(i_end, k, j))+(ru(i_end+1, k, j)+&
&                ru(i_end+1, k, j-1))*(vd(i_end+1, k, j)+vd(i_end, k, j))&
&                )
              fqx(i, k) = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*(&
&                v(i_end+1, k, j)+v(i_end, k, j))
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
              vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
              fqxd(i, k) = veld*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k&
&                , j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&                )*(v(i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)&
&                ))/12.0) + vel*((7.*(vd(i, k, j)+vd(i-1, k, j))-vd(i+1, &
&                k, j)-vd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(vd(i+1, k, j)-vd(i-2, k, j)-3.*(vd(i, k, j)-vd(i-1&
&                , k, j)))/12.0)
              fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&                j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&                (v(i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))&
&                /12.0)
            END DO
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
          mrdx = msfvy(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 4) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 2) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
!CJM May not work with tiling because defined in terms of domain dims
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 1
      j_end_f = jde - 1
    END IF
!  compute fluxes
!  specified uses upstream normal wind at boundaries
    jp0 = 1
    jp1 = 2
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .EQ. j_start .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j-1)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vbd = vd(i, k, j)
              vb = v(i, k, j)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(v(i, &
&              k, j)+vb)+(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)+vbd))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(v(i, k, j&
&              )+vb)
          END DO
        END DO
      ELSE IF (j .EQ. j_end + 1 .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vbd = vd(i, k, j-1)
              vb = v(i, k, j-1)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(vb+v(&
&              i, k, j-1))+(rv(i, k, j)+rv(i, k, j-1))*(vbd+vd(i, k, j-1)&
&              ))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(vb+v(i, k&
&              , j-1))
          END DO
        END DO
      ELSE
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*(7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k&
&              , j-1))-vd(i, k, j+1)-vd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
! Comments on polar boundary conditions
! No advection over the poles means tendencies (held from jds [S. pole]
! to jde [N pole], i.e., on v grid) must be zero at poles
! [tendency(jds) and tendency(jde)=0]
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde + 1) THEN
! If j_end were set to jde in a special if statement apart from
! degrade_ye, then we would hit the next conditional.  But since
! we want the tendency to be zero anyway, not looping to jde+1
! will produce the same effect.
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
            mrdy = msfvy(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  3rd or 4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
          vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
          fqxd(i, k) = veld*(7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)+&
&            v(i-2, k, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i-1, k, j))-vd&
&            (i+1, k, j)-vd(i-2, k, j))/12.0
          fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)+v&
&            (i-2, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts,ktf
          fqxd(i_start, k) = 0.25*((rud(i_start, k, j)+rud(i_start, k, j&
&            -1))*(v(i_start, k, j)+v(i_start-1, k, j))+(ru(i_start, k, j&
&            )+ru(i_start, k, j-1))*(vd(i_start, k, j)+vd(i_start-1, k, j&
&            )))
          fqx(i_start, k) = 0.25*(ru(i_start, k, j)+ru(i_start, k, j-1))&
&            *(v(i_start, k, j)+v(i_start-1, k, j))
        END DO
      END IF
      IF (degrade_xe) THEN
        DO k=kts,ktf
          fqxd(i_end+1, k) = 0.25*((rud(i_end+1, k, j)+rud(i_end+1, k, j&
&            -1))*(v(i_end+1, k, j)+v(i_end, k, j))+(ru(i_end+1, k, j)+ru&
&            (i_end+1, k, j-1))*(vd(i_end+1, k, j)+vd(i_end, k, j)))
          fqx(i_end+1, k) = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))&
&            *(v(i_end+1, k, j)+v(i_end, k, j))
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
          mrdx = msfvy(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 3) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 2) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
!CJM May not work with tiling because defined in terms of domain dims
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 1
      j_end_f = jde - 1
    END IF
!  compute fluxes
!  specified uses upstream normal wind at boundaries
    jp0 = 1
    jp1 = 2
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .EQ. j_start .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j-1)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vbd = vd(i, k, j)
              vb = v(i, k, j)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(v(i, &
&              k, j)+vb)+(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)+vbd))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(v(i, k, j&
&              )+vb)
          END DO
        END DO
      ELSE IF (j .EQ. j_end + 1 .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            vbd = vd(i, k, j)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vbd = vd(i, k, j-1)
              vb = v(i, k, j-1)
            END IF
            fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(vb+v(&
&              i, k, j-1))+(rv(i, k, j)+rv(i, k, j-1))*(vbd+vd(i, k, j-1)&
&              ))
            fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(vb+v(i, k&
&              , j-1))
          END DO
        END DO
      ELSE
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            fqyd(i, k, jp1) = veld*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, &
&              k, j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1&
&              )))/12.0) + vel*((7.*(vd(i, k, j)+vd(i, k, j-1))-vd(i, k, &
&              j+1)-vd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (vd(i, k, j+1)-vd(i, k, j-2)-3.*(vd(i, k, j)-vd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&              , j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
      END IF
! Comments on polar boundary conditions
! No advection over the poles means tendencies (held from jds [S. pole]
! to jde [N pole], i.e., on v grid) must be zero at poles
! [tendency(jds) and tendency(jde)=0]
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde + 1) THEN
! If j_end were set to jde in a special if statement apart from
! degrade_ye, then we would hit the next conditional.  But since
! we want the tendency to be zero anyway, not looping to jde+1
! will produce the same effect.
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, j-1) = 0.0
            tendency(i, k, j-1) = 0.
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
            mrdy = msfvy(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  3rd or 4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
          vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
          fqxd(i, k) = veld*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)&
&            +v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(i+1&
&            , k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/12.0) + &
&            vel*((7.*(vd(i, k, j)+vd(i-1, k, j))-vd(i+1, k, j)-vd(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(vd(i+1, k, j)-&
&            vd(i-2, k, j)-3.*(vd(i, k, j)-vd(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)+v&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(i+1, &
&            k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts,ktf
          fqxd(i_start, k) = 0.25*((rud(i_start, k, j)+rud(i_start, k, j&
&            -1))*(v(i_start, k, j)+v(i_start-1, k, j))+(ru(i_start, k, j&
&            )+ru(i_start, k, j-1))*(vd(i_start, k, j)+vd(i_start-1, k, j&
&            )))
          fqx(i_start, k) = 0.25*(ru(i_start, k, j)+ru(i_start, k, j-1))&
&            *(v(i_start, k, j)+v(i_start-1, k, j))
        END DO
      END IF
      IF (degrade_xe) THEN
        DO k=kts,ktf
          fqxd(i_end+1, k) = 0.25*((rud(i_end+1, k, j)+rud(i_end+1, k, j&
&            -1))*(v(i_end+1, k, j)+v(i_end, k, j))+(ru(i_end+1, k, j)+ru&
&            (i_end+1, k, j-1))*(vd(i_end+1, k, j)+vd(i_end, k, j)))
          fqx(i_end+1, k) = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))&
&            *(v(i_end+1, k, j)+v(i_end, k, j))
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
          mrdx = msfvy(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 2) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    j_end = jte
    IF (config_flags%open_ys) THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF (config_flags%open_ye) THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
    IF (specified) THEN
      IF (jds + 2 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 2
      END IF
    END IF
    IF (specified) THEN
      IF (jde - 2 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 2
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
          mrdy = msfvy(i, j)*rdy
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.25*((rvd(i, k&
&            , j+1)+rvd(i, k, j))*(v(i, k, j+1)+v(i, k, j))+(rv(i, k, j+1&
&            )+rv(i, k, j))*(vd(i, k, j+1)+vd(i, k, j))-(rvd(i, k, j)+rvd&
&            (i, k, j-1))*(v(i, k, j)+v(i, k, j-1))-(rv(i, k, j)+rv(i, k&
&            , j-1))*(vd(i, k, j)+vd(i, k, j-1)))
          tendency(i, k, j) = tendency(i, k, j) - mrdy*0.25*((rv(i, k, j&
&            +1)+rv(i, k, j))*(v(i, k, j+1)+v(i, k, j))-(rv(i, k, j)+rv(i&
&            , k, j-1))*(v(i, k, j)+v(i, k, j-1)))
        END DO
      END DO
    END DO
! Comments on polar boundary conditions
! tendencies = 0 at poles, and polar points do not contribute at points
! next to poles
    IF (config_flags%polar) THEN
      IF (jts .EQ. jds) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, jds) = 0.0
            tendency(i, k, jds) = 0.
          END DO
        END DO
      END IF
      IF (jte .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            tendencyd(i, k, jde) = 0.0
            tendency(i, k, jde) = 0.
          END DO
        END DO
      END IF
    END IF
!  specified uses upstream normal wind at boundaries
    IF (specified .AND. jts .LE. jds + 1) THEN
      j = jds + 1
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
          mrdy = msfvy(i, j)*rdy
          vbd = vd(i, k, j-1)
          vb = v(i, k, j-1)
          IF (v(i, k, j) .LT. 0.) THEN
            vbd = vd(i, k, j)
            vb = v(i, k, j)
          END IF
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.25*((rvd(i, k&
&            , j+1)+rvd(i, k, j))*(v(i, k, j+1)+v(i, k, j))+(rv(i, k, j+1&
&            )+rv(i, k, j))*(vd(i, k, j+1)+vd(i, k, j))-(rvd(i, k, j)+rvd&
&            (i, k, j-1))*(v(i, k, j)+vb)-(rv(i, k, j)+rv(i, k, j-1))*(vd&
&            (i, k, j)+vbd))
          tendency(i, k, j) = tendency(i, k, j) - mrdy*0.25*((rv(i, k, j&
&            +1)+rv(i, k, j))*(v(i, k, j+1)+v(i, k, j))-(rv(i, k, j)+rv(i&
&            , k, j-1))*(v(i, k, j)+vb))
        END DO
      END DO
    END IF
    IF (specified .AND. jte .GE. jde - 1) THEN
      j = jde - 1
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
          mrdy = msfvy(i, j)*rdy
          vbd = vd(i, k, j+1)
          vb = v(i, k, j+1)
          IF (v(i, k, j) .GT. 0.) THEN
            vbd = vd(i, k, j)
            vb = v(i, k, j)
          END IF
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.25*((rvd(i, k&
&            , j+1)+rvd(i, k, j))*(vb+v(i, k, j))+(rv(i, k, j+1)+rv(i, k&
&            , j))*(vbd+vd(i, k, j))-(rvd(i, k, j)+rvd(i, k, j-1))*(v(i, &
&            k, j)+v(i, k, j-1))-(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)&
&            +vd(i, k, j-1)))
          tendency(i, k, j) = tendency(i, k, j) - mrdy*0.25*((rv(i, k, j&
&            +1)+rv(i, k, j))*(vb+v(i, k, j))-(rv(i, k, j)+rv(i, k, j-1))&
&            *(v(i, k, j)+v(i, k, j-1)))
        END DO
      END DO
    END IF
    IF (.NOT.config_flags%periodic_x) THEN
      IF (config_flags%open_xs .OR. specified) THEN
        IF (ids + 1 .LT. its) THEN
          i_start = its
        ELSE
          i_start = ids + 1
        END IF
      END IF
      IF (config_flags%open_xe .OR. specified) THEN
        IF (ide - 2 .GT. ite) THEN
          i_end = ite
        ELSE
          i_end = ide - 2
        END IF
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
          mrdx = msfvy(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.25*((rud(i+1&
&            , k, j)+rud(i+1, k, j-1))*(v(i+1, k, j)+v(i, k, j))+(ru(i+1&
&            , k, j)+ru(i+1, k, j-1))*(vd(i+1, k, j)+vd(i, k, j))-(rud(i&
&            , k, j)+rud(i, k, j-1))*(v(i, k, j)+v(i-1, k, j))-(ru(i, k, &
&            j)+ru(i, k, j-1))*(vd(i, k, j)+vd(i-1, k, j)))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.25*((ru(i+1, k&
&            , j)+ru(i+1, k, j-1))*(v(i+1, k, j)+v(i, k, j))-(ru(i, k, j)&
&            +ru(i, k, j-1))*(v(i, k, j)+v(i-1, k, j)))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .NE. 0) THEN
! Just in case we want to turn horizontal advection off, we can do it
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_v_6a: h_order not known ', horz_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
  END IF
!  Comments on polar boundary condition
!  Force tendency=0 at NP and SP
!  We keep setting this everywhere, but it can't hurt...
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
    DO i=its,ite
      DO k=kts,ktf
        tendencyd(i, k, jts) = 0.0
        tendency(i, k, jts) = 0.
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    DO i=its,ite
      DO k=kts,ktf
        tendencyd(i, k, jte) = 0.0
        tendency(i, k, jte) = 0.
      END DO
    END DO
  END IF
!  radiative lateral boundary condition in y for normal velocity (v)
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (rv(i, k, jts) - cb*mut(i, jts) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = rvd(i, k, jts) - cb*mutd(i, jts)
          vb = rv(i, k, jts) - cb*mut(i, jts)
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(v_old(i&
&          , k, jts+1)-v_old(i, k, jts))+vb*(v_oldd(i, k, jts+1)-v_oldd(i&
&          , k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*vb*(v_old(i, k, &
&          jts+1)-v_old(i, k, jts))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (rv(i, k, jte) + cb*mut(i, jte-1) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = rvd(i, k, jte) + cb*mutd(i, jte-1)
          vb = rv(i, k, jte) + cb*mut(i, jte-1)
        END IF
        tendencyd(i, k, jte) = tendencyd(i, k, jte) - rdy*(vbd*(v_old(i&
&          , k, jte)-v_old(i, k, jte-1))+vb*(v_oldd(i, k, jte)-v_oldd(i, &
&          k, jte-1)))
        tendency(i, k, jte) = tendency(i, k, jte) - rdy*vb*(v_old(i, k, &
&          jte)-v_old(i, k, jte-1))
      END DO
    END DO
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  j_start = jts
  IF (jte .GT. jde) THEN
    j_end = jde
  ELSE
    j_end = jte
  END IF
  jmin = jds
  jmax = jde - 1
  IF (config_flags%open_ys) THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
    jmin = jds
  END IF
  IF (config_flags%open_ye) THEN
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    jmax = jde - 1
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(its, j)*rdx
      IF (jmax .GT. j) THEN
        jp = j
      ELSE
        jp = jmax
      END IF
      IF (jmin .LT. j - 1) THEN
        jm = j - 1
      ELSE
        jm = jmin
      END IF
      DO k=kts,ktf
        uwd = 0.5*(rud(its, k, jp)+rud(its, k, jm))
        uw = 0.5*(ru(its, k, jp)+ru(its, k, jm))
        IF (uw .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        dupd = rud(its+1, k, jp) - rud(its, k, jp)
        dup = ru(its+1, k, jp) - ru(its, k, jp)
        dumd = rud(its+1, k, jm) - rud(its, k, jm)
        dum = ru(its+1, k, jm) - ru(its, k, jm)
        tendencyd(its, k, j) = tendencyd(its, k, j) - mrdx*(ubd*(v_old(&
&          its+1, k, j)-v_old(its, k, j))+ub*(v_oldd(its+1, k, j)-v_oldd(&
&          its, k, j))+0.5*(vd(its, k, j)*(dup+dum)+v(its, k, j)*(dupd+&
&          dumd)))
        tendency(its, k, j) = tendency(its, k, j) - mrdx*(ub*(v_old(its+&
&          1, k, j)-v_old(its, k, j))+0.5*v(its, k, j)*(dup+dum))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(ite-1, j)*rdx
      IF (jmax .GT. j) THEN
        jp = j
      ELSE
        jp = jmax
      END IF
      IF (jmin .LT. j - 1) THEN
        jm = j - 1
      ELSE
        jm = jmin
      END IF
      DO k=kts,ktf
        uwd = 0.5*(rud(ite, k, jp)+rud(ite, k, jm))
        uw = 0.5*(ru(ite, k, jp)+ru(ite, k, jm))
        IF (uw .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        dupd = rud(ite, k, jp) - rud(ite-1, k, jp)
        dup = ru(ite, k, jp) - ru(ite-1, k, jp)
        dumd = rud(ite, k, jm) - rud(ite-1, k, jm)
        dum = ru(ite, k, jm) - ru(ite-1, k, jm)
!          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
!                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
!                           +0.5*v(ite-1,k,j)*                         &
!                                  ( ru(ite,k,jp)-ru(ite-1,k,jp)       &
!                                   +ru(ite,k,jm)-ru(ite-1,k,jm))     )
        tendencyd(ite-1, k, j) = tendencyd(ite-1, k, j) - mrdx*(ubd*(&
&          v_old(ite-1, k, j)-v_old(ite-2, k, j))+ub*(v_oldd(ite-1, k, j)&
&          -v_oldd(ite-2, k, j))+0.5*(vd(ite-1, k, j)*(dup+dum)+v(ite-1, &
&          k, j)*(dupd+dumd)))
        tendency(ite-1, k, j) = tendency(ite-1, k, j) - mrdx*(ub*(v_old(&
&          ite-1, k, j)-v_old(ite-2, k, j))+0.5*v(ite-1, k, j)*(dup+dum))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!     ADT eqn 45 has 3rd term on RHS = -(1/mx) partial d/dz (rho v w)
!     Here we have: - partial d/dz (v*rom) = - partial d/dz (v rho w / my)
!     We therefore need to make a correction for advect_v
!     since 'my' (map scale factor in y direction) isn't a function of z,
!     we can do this using *(my/mx) (see eqn. 45 for example)
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  j_end = jte
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
! Polar boundary conditions are like open or specified
! We don't want to calculate vertical v tendencies at the N or S pole
  IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
  END IF
  IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jde - 1 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1
    END IF
  END IF
  IF (vert_order .EQ. 6) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          vfluxd(i, k) = veld*(37.*(v(i, k, j)+v(i, k-1, j))-8.*(v(i, k+&
&            1, j)+v(i, k-2, j))+(v(i, k+2, j)+v(i, k-3, j)))/60.0 + vel*&
&            (37.*(vd(i, k, j)+vd(i, k-1, j))-8.*(vd(i, k+1, j)+vd(i, k-2&
&            , j))+vd(i, k+2, j)+vd(i, k-3, j))/60.0
          vflux(i, k) = vel*((37.*(v(i, k, j)+v(i, k-1, j))-8.*(v(i, k+1&
&            , j)+v(i, k-2, j))+(v(i, k+2, j)+v(i, k-3, j)))/60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        vfluxd(i, k) = veld*(7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+&
&          v(i, k-2, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k-1, j))-vd(i&
&          , k+1, j)-vd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&          (i, k-2, j)))/12.0)
        k = ktf - 1
        veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        vfluxd(i, k) = veld*(7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+&
&          v(i, k-2, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k-1, j))-vd(i&
&          , k+1, j)-vd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&          (i, k-2, j)))/12.0)
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
          tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*&
&            (vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
          tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j&
&            )*rdzw(k)*(vflux(i, k+1)-vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          vfluxd(i, k) = veld*((37.*(v(i, k, j)+v(i, k-1, j))-8.*(v(i, k&
&            +1, j)+v(i, k-2, j))+(v(i, k+2, j)+v(i, k-3, j)))/60.0-SIGN(&
&            1, time_step)*SIGN(1., -vel)*(v(i, k+2, j)-v(i, k-3, j)-5.*(&
&            v(i, k+1, j)-v(i, k-2, j))+10.*(v(i, k, j)-v(i, k-1, j)))/&
&            60.0) + vel*((37.*(vd(i, k, j)+vd(i, k-1, j))-8.*(vd(i, k+1&
&            , j)+vd(i, k-2, j))+vd(i, k+2, j)+vd(i, k-3, j))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(vd(i, k+2, j)-vd(i, k-3, j)-5.*&
&            (vd(i, k+1, j)-vd(i, k-2, j))+10.*(vd(i, k, j)-vd(i, k-1, j)&
&            ))/60.0)
          vflux(i, k) = vel*((37.*(v(i, k, j)+v(i, k-1, j))-8.*(v(i, k+1&
&            , j)+v(i, k-2, j))+(v(i, k+2, j)+v(i, k-3, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(v(i, k+2, j)-v(i, k-3, j)-5.*(v&
&            (i, k+1, j)-v(i, k-2, j))+10.*(v(i, k, j)-v(i, k-1, j)))/&
&            60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        vfluxd(i, k) = veld*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)&
&          +v(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k&
&          +1, j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0) + vel*&
&          ((7.*(vd(i, k, j)+vd(i, k-1, j))-vd(i, k+1, j)-vd(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(vd(i, k+1, j)-vd(i, k-&
&          2, j)-3.*(vd(i, k, j)-vd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1&
&          , j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0)
        k = ktf - 1
        veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        vfluxd(i, k) = veld*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)&
&          +v(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k&
&          +1, j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0) + vel*&
&          ((7.*(vd(i, k, j)+vd(i, k-1, j))-vd(i, k+1, j)-vd(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(vd(i, k+1, j)-vd(i, k-&
&          2, j)-3.*(vd(i, k, j)-vd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1&
&          , j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0)
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
          tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*&
&            (vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
          tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j&
&            )*rdzw(k)*(vflux(i, k+1)-vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          vfluxd(i, k) = veld*(7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j&
&            )+v(i, k-2, j)))/12.0 + vel*(7.*(vd(i, k, j)+vd(i, k-1, j))-&
&            vd(i, k+1, j)-vd(i, k-2, j))/12.0
          vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)&
&            +v(i, k-2, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
          tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*&
&            (vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
          tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j&
&            )*rdzw(k)*(vflux(i, k+1)-vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          vfluxd(i, k) = veld*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, &
&            j)+v(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(&
&            i, k+1, j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0) &
&            + vel*((7.*(vd(i, k, j)+vd(i, k-1, j))-vd(i, k+1, j)-vd(i, k&
&            -2, j))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(vd(i, k+1, j&
&            )-vd(i, k-2, j)-3.*(vd(i, k, j)-vd(i, k-1, j)))/12.0)
          vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)&
&            +v(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i&
&            , k+1, j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
        k = ktf
        vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i&
&          , k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(&
&          fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
        vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, &
&          j)+fzp(k)*v(i, k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
          tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*&
&            (vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
          tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j&
&            )*rdzw(k)*(vflux(i, k+1)-vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
          vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(&
&            i, k, j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*&
&            (fzm(k)*vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
          vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k&
&            , j)+fzp(k)*v(i, k-1, j))
        END DO
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
          tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*&
&            (vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
          tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j&
&            )*rdzw(k)*(vflux(i, k+1)-vflux(i, k))
        END DO
      END DO
    END DO
  ELSE
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_v_6a: v_order not known ', vert_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
  END IF
END SUBROUTINE G_ADVECT_V

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_scalar in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom field tendency ru rv field_old
!   RW status of diff variables: rom:in field:in tendency:in-out
!                ru:in rv:in field_old:in
SUBROUTINE G_ADVECT_SCALAR(field, fieldd, field_old, field_oldd, &
&  tendency, tendencyd, ru, rud, rv, rvd, rom, romd, mut, time_step, &
&  config_flags, msfux, msfuy, msfvx, msfvy, msftx, msfty, fzm, fzp, rdx&
&  , rdy, rdzw, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, &
&  kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: field, &
&  field_old, ru, rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: fieldd, &
&  field_oldd, rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw
  REAL :: ubd, vbd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  INTEGER :: horz_order, vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified

  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_sca_adv_order
  vert_order = config_flags%v_sca_adv_order
!  begin with horizontal flux divergence
!  here is the choice of flux operators
  IF (horz_order .EQ. 6) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_6:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*(37.*(field(i, k, j)+field(i, k, j-1)&
&              )-8.*(field(i, k, j+1)+field(i, k, j-2))+(field(i, k, j+2)&
&              +field(i, k, j-3)))/60.0 + vel*(37.*(fieldd(i, k, j)+&
&              fieldd(i, k, j-1))-8.*(fieldd(i, k, j+1)+fieldd(i, k, j-2)&
&              )+fieldd(i, k, j+2)+fieldd(i, k, j-3))/60.0
            fqy(i, k, jp1) = vel*((37.*(field(i, k, j)+field(i, k, j-1))&
&              -8.*(field(i, k, j+1)+field(i, k, j-2))+(field(i, k, j+2)+&
&              field(i, k, j-3)))/60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*(7.*(field(i, k, j)+field(i, k, j-1))&
&              -(field(i, k, j+1)+field(i, k, j-2)))/12.0 + vel*(7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))-fieldd(i, k, j+1)-&
&              fieldd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(field(i, k, j)+field(i, k, j-1))-&
&              (field(i, k, j+1)+field(i, k, j-2)))/12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*(7.*(field(i, k, j)+field(i, k, j-1))&
&              -(field(i, k, j+1)+field(i, k, j-2)))/12.0 + vel*(7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))-fieldd(i, k, j+1)-&
&              fieldd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(field(i, k, j)+field(i, k, j-1))-&
&              (field(i, k, j+1)+field(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_6
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          fqxd(i, k) = veld*(37.*(field(i, k, j)+field(i-1, k, j))-8.*(&
&            field(i+1, k, j)+field(i-2, k, j))+(field(i+2, k, j)+field(i&
&            -3, k, j)))/60.0 + vel*(37.*(fieldd(i, k, j)+fieldd(i-1, k, &
&            j))-8.*(fieldd(i+1, k, j)+fieldd(i-2, k, j))+fieldd(i+2, k, &
&            j)+fieldd(i-3, k, j))/60.0
          fqx(i, k) = vel*((37.*(field(i, k, j)+field(i-1, k, j))-8.*(&
&            field(i+1, k, j)+field(i-2, k, j))+(field(i+2, k, j)+field(i&
&            -3, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*(7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0 + vel*(7.*(&
&                fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k, j)-&
&                fieldd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*(7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0 + vel*(7.*(&
&                fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k, j)-&
&                fieldd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 5) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*((37.*(field(i, k, j)+field(i, k, j-1&
&              ))-8.*(field(i, k, j+1)+field(i, k, j-2))+(field(i, k, j+2&
&              )+field(i, k, j-3)))/60.0-SIGN(1, time_step)*SIGN(1., vel)&
&              *(field(i, k, j+2)-field(i, k, j-3)-5.*(field(i, k, j+1)-&
&              field(i, k, j-2))+10.*(field(i, k, j)-field(i, k, j-1)))/&
&              60.0) + vel*((37.*(fieldd(i, k, j)+fieldd(i, k, j-1))-8.*(&
&              fieldd(i, k, j+1)+fieldd(i, k, j-2))+fieldd(i, k, j+2)+&
&              fieldd(i, k, j-3))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(&
&              fieldd(i, k, j+2)-fieldd(i, k, j-3)-5.*(fieldd(i, k, j+1)-&
&              fieldd(i, k, j-2))+10.*(fieldd(i, k, j)-fieldd(i, k, j-1))&
&              )/60.0)
            fqy(i, k, jp1) = vel*((37.*(field(i, k, j)+field(i, k, j-1))&
&              -8.*(field(i, k, j+1)+field(i, k, j-2))+(field(i, k, j+2)+&
&              field(i, k, j-3)))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(&
&              field(i, k, j+2)-field(i, k, j-3)-5.*(field(i, k, j+1)-&
&              field(i, k, j-2))+10.*(field(i, k, j)-field(i, k, j-1)))/&
&              60.0)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*((7.*(field(i, k, j)+field(i, k, j-1)&
&              )-(field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(1, &
&              time_step)*SIGN(1., vel)*(field(i, k, j+1)-field(i, k, j-2&
&              )-3.*(field(i, k, j)-field(i, k, j-1)))/12.0) + vel*((7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))-fieldd(i, k, j+1)-&
&              fieldd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(&
&              fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)-&
&              fieldd(i, k, j-1)))/12.0)
            fqy(i, k, jp1) = vel*((7.*(field(i, k, j)+field(i, k, j-1))-&
&              (field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(1, &
&              time_step)*SIGN(1., vel)*(field(i, k, j+1)-field(i, k, j-2&
&              )-3.*(field(i, k, j)-field(i, k, j-1)))/12.0)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*((7.*(field(i, k, j)+field(i, k, j-1)&
&              )-(field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(1, &
&              time_step)*SIGN(1., vel)*(field(i, k, j+1)-field(i, k, j-2&
&              )-3.*(field(i, k, j)-field(i, k, j-1)))/12.0) + vel*((7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))-fieldd(i, k, j+1)-&
&              fieldd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(&
&              fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)-&
&              fieldd(i, k, j-1)))/12.0)
            fqy(i, k, jp1) = vel*((7.*(field(i, k, j)+field(i, k, j-1))-&
&              (field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(1, &
&              time_step)*SIGN(1., vel)*(field(i, k, j+1)-field(i, k, j-2&
&              )-3.*(field(i, k, j)-field(i, k, j-1)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_5
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          fqxd(i, k) = veld*((37.*(field(i, k, j)+field(i-1, k, j))-8.*(&
&            field(i+1, k, j)+field(i-2, k, j))+(field(i+2, k, j)+field(i&
&            -3, k, j)))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(field(i+2&
&            , k, j)-field(i-3, k, j)-5.*(field(i+1, k, j)-field(i-2, k, &
&            j))+10.*(field(i, k, j)-field(i-1, k, j)))/60.0) + vel*((37.&
&            *(fieldd(i, k, j)+fieldd(i-1, k, j))-8.*(fieldd(i+1, k, j)+&
&            fieldd(i-2, k, j))+fieldd(i+2, k, j)+fieldd(i-3, k, j))/60.0&
&            -SIGN(1, time_step)*SIGN(1., vel)*(fieldd(i+2, k, j)-fieldd(&
&            i-3, k, j)-5.*(fieldd(i+1, k, j)-fieldd(i-2, k, j))+10.*(&
&            fieldd(i, k, j)-fieldd(i-1, k, j)))/60.0)
          fqx(i, k) = vel*((37.*(field(i, k, j)+field(i-1, k, j))-8.*(&
&            field(i+1, k, j)+field(i-2, k, j))+(field(i+2, k, j)+field(i&
&            -3, k, j)))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(field(i+2&
&            , k, j)-field(i-3, k, j)-5.*(field(i+1, k, j)-field(i-2, k, &
&            j))+10.*(field(i, k, j)-field(i-1, k, j)))/60.0)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, &
&                time_step)*SIGN(1., vel)*(field(i+1, k, j)-field(i-2, k&
&                , j)-3.*(field(i, k, j)-field(i-1, k, j)))/12.0) + vel*(&
&                (7.*(fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k, j&
&                )-fieldd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i, &
&                k, j)-fieldd(i-1, k, j)))/12.0)
              fqx(i, k) = vel*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, &
&                time_step)*SIGN(1., vel)*(field(i+1, k, j)-field(i-2, k&
&                , j)-3.*(field(i, k, j)-field(i-1, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, &
&                time_step)*SIGN(1., vel)*(field(i+1, k, j)-field(i-2, k&
&                , j)-3.*(field(i, k, j)-field(i-1, k, j)))/12.0) + vel*(&
&                (7.*(fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k, j&
&                )-fieldd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i, &
&                k, j)-fieldd(i-1, k, j)))/12.0)
              fqx(i, k) = vel*((7.*(field(i, k, j)+field(i-1, k, j))-(&
&                field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, &
&                time_step)*SIGN(1., vel)*(field(i+1, k, j)-field(i-2, k&
&                , j)-3.*(field(i, k, j)-field(i-1, k, j)))/12.0)
            END DO
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 4) THEN
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  3rd or 4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          fqxd(i, k) = rud(i, k, j)*(7.*(field(i, k, j)+field(i-1, k, j)&
&            )-(field(i+1, k, j)+field(i-2, k, j)))/12.0 + ru(i, k, j)*(&
&            7.*(fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k, j)-&
&            fieldd(i-2, k, j))/12.0
          fqx(i, k) = ru(i, k, j)*((7.*(field(i, k, j)+field(i-1, k, j))&
&            -(field(i+1, k, j)+field(i-2, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts,ktf
          fqxd(i_start, k) = 0.5*(rud(i_start, k, j)*(field(i_start, k, &
&            j)+field(i_start-1, k, j))+ru(i_start, k, j)*(fieldd(i_start&
&            , k, j)+fieldd(i_start-1, k, j)))
          fqx(i_start, k) = 0.5*ru(i_start, k, j)*(field(i_start, k, j)+&
&            field(i_start-1, k, j))
        END DO
      END IF
      IF (degrade_xe) THEN
        DO k=kts,ktf
          fqxd(i_end+1, k) = 0.5*(rud(i_end+1, k, j)*(field(i_end+1, k, &
&            j)+field(i_end, k, j))+ru(i_end+1, k, j)*(fieldd(i_end+1, k&
&            , j)+fieldd(i_end, k, j)))
          fqx(i_end+1, k) = 0.5*ru(i_end+1, k, j)*(field(i_end+1, k, j)+&
&            field(i_end, k, j))
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j_start)*(field(i, k, &
&              j_start)+field(i, k, j_start-1))+rv(i, k, j_start)*(fieldd&
&              (i, k, j_start)+fieldd(i, k, j_start-1)))
            fqy(i, k, jp1) = 0.5*rv(i, k, j_start)*(field(i, k, j_start)&
&              +field(i, k, j_start-1))
          END DO
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
!                *(field(i,k,j_end+1)+field(i,k,j_end))
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = rvd(i, k, j)*(7.*(field(i, k, j)+field(i, &
&              k, j-1))-(field(i, k, j+1)+field(i, k, j-2)))/12.0 + rv(i&
&              , k, j)*(7.*(fieldd(i, k, j)+fieldd(i, k, j-1))-fieldd(i, &
&              k, j+1)-fieldd(i, k, j-2))/12.0
            fqy(i, k, jp1) = rv(i, k, j)*((7.*(field(i, k, j)+field(i, k&
&              , j-1))-(field(i, k, j+1)+field(i, k, j-2)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 3) THEN
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  3rd or 4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          fqxd(i, k) = rud(i, k, j)*((7.*(field(i, k, j)+field(i-1, k, j&
&            ))-(field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, &
&            time_step)*SIGN(1., ru(i, k, j))*(field(i+1, k, j)-field(i-2&
&            , k, j)-3.*(field(i, k, j)-field(i-1, k, j)))/12.0) + ru(i, &
&            k, j)*((7.*(fieldd(i, k, j)+fieldd(i-1, k, j))-fieldd(i+1, k&
&            , j)-fieldd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., ru(&
&            i, k, j))*(fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i&
&            , k, j)-fieldd(i-1, k, j)))/12.0)
          fqx(i, k) = ru(i, k, j)*((7.*(field(i, k, j)+field(i-1, k, j))&
&            -(field(i+1, k, j)+field(i-2, k, j)))/12.0+SIGN(1, time_step&
&            )*SIGN(1., ru(i, k, j))*(field(i+1, k, j)-field(i-2, k, j)-&
&            3.*(field(i, k, j)-field(i-1, k, j)))/12.0)
        END DO
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts,ktf
          fqxd(i_start, k) = 0.5*(rud(i_start, k, j)*(field(i_start, k, &
&            j)+field(i_start-1, k, j))+ru(i_start, k, j)*(fieldd(i_start&
&            , k, j)+fieldd(i_start-1, k, j)))
          fqx(i_start, k) = 0.5*ru(i_start, k, j)*(field(i_start, k, j)+&
&            field(i_start-1, k, j))
        END DO
      END IF
      IF (degrade_xe) THEN
        DO k=kts,ktf
          fqxd(i_end+1, k) = 0.5*(rud(i_end+1, k, j)*(field(i_end+1, k, &
&            j)+field(i_end, k, j))+ru(i_end+1, k, j)*(fieldd(i_end+1, k&
&            , j)+fieldd(i_end, k, j)))
          fqx(i_end+1, k) = 0.5*ru(i_end+1, k, j)*(field(i_end+1, k, j)+&
&            field(i_end, k, j))
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j_start)*(field(i, k, &
&              j_start)+field(i, k, j_start-1))+rv(i, k, j_start)*(fieldd&
&              (i, k, j_start)+fieldd(i, k, j_start-1)))
            fqy(i, k, jp1) = 0.5*rv(i, k, j_start)*(field(i, k, j_start)&
&              +field(i, k, j_start-1))
          END DO
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!         fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)          &
!                *(field(i,k,j_end+1)+field(i,k,j_end))
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = rvd(i, k, j)*((7.*(field(i, k, j)+field(i&
&              , k, j-1))-(field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(&
&              1, time_step)*SIGN(1., rv(i, k, j))*(field(i, k, j+1)-&
&              field(i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))/&
&              12.0) + rv(i, k, j)*((7.*(fieldd(i, k, j)+fieldd(i, k, j-1&
&              ))-fieldd(i, k, j+1)-fieldd(i, k, j-2))/12.0+SIGN(1, &
&              time_step)*SIGN(1., rv(i, k, j))*(fieldd(i, k, j+1)-fieldd&
&              (i, k, j-2)-3.*(fieldd(i, k, j)-fieldd(i, k, j-1)))/12.0)
            fqy(i, k, jp1) = rv(i, k, j)*((7.*(field(i, k, j)+field(i, k&
&              , j-1))-(field(i, k, j+1)+field(i, k, j-2)))/12.0+SIGN(1, &
&              time_step)*SIGN(1., rv(i, k, j))*(field(i, k, j+1)-field(i&
&              , k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))/12.0)
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 2) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    IF (.NOT.config_flags%periodic_x) THEN
      IF (config_flags%open_xs .OR. specified) THEN
        IF (ids + 1 .LT. its) THEN
          i_start = its
        ELSE
          i_start = ids + 1
        END IF
      END IF
      IF (config_flags%open_xe .OR. specified) THEN
        IF (ide - 2 .GT. ite) THEN
          i_end = ite
        ELSE
          i_end = ide - 2
        END IF
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.5*(rud(i+1, k&
&            , j)*(field(i+1, k, j)+field(i, k, j))+ru(i+1, k, j)*(fieldd&
&            (i+1, k, j)+fieldd(i, k, j))-rud(i, k, j)*(field(i, k, j)+&
&            field(i-1, k, j))-ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k&
&            , j)))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.5*(ru(i+1, k, j&
&            )*(field(i+1, k, j)+field(i, k, j))-ru(i, k, j)*(field(i, k&
&            , j)+field(i-1, k, j)))
        END DO
      END DO
    END DO
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 2 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 2
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
          mrdy = msftx(i, j)*rdy
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.5*(rvd(i, k, &
&            j+1)*(field(i, k, j+1)+field(i, k, j))+rv(i, k, j+1)*(fieldd&
&            (i, k, j+1)+fieldd(i, k, j))-rvd(i, k, j)*(field(i, k, j)+&
&            field(i, k, j-1))-rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, &
&            j-1)))
          tendency(i, k, j) = tendency(i, k, j) - mrdy*0.5*(rv(i, k, j+1&
&            )*(field(i, k, j+1)+field(i, k, j))-rv(i, k, j)*(field(i, k&
&            , j)+field(i, k, j-1)))
        END DO
      END DO
    END DO
! Polar boundary condtions
! These won't be covered in the loop above...
    IF (config_flags%polar) THEN
      IF (jts .EQ. jds) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, jds)*rdy
            tendencyd(i, k, jds) = tendencyd(i, k, jds) - mrdy*0.5*(rvd(&
&              i, k, jds+1)*(field(i, k, jds+1)+field(i, k, jds))+rv(i, k&
&              , jds+1)*(fieldd(i, k, jds+1)+fieldd(i, k, jds)))
            tendency(i, k, jds) = tendency(i, k, jds) - mrdy*0.5*rv(i, k&
&              , jds+1)*(field(i, k, jds+1)+field(i, k, jds))
          END DO
        END DO
      END IF
      IF (jte .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
            mrdy = msftx(i, jde-1)*rdy
            tendencyd(i, k, jde-1) = tendencyd(i, k, jde-1) + mrdy*0.5*(&
&              rvd(i, k, jde-1)*(field(i, k, jde-1)+field(i, k, jde-2))+&
&              rv(i, k, jde-1)*(fieldd(i, k, jde-1)+fieldd(i, k, jde-2)))
            tendency(i, k, jde-1) = tendency(i, k, jde-1) + mrdy*0.5*rv(&
&              i, k, jde-1)*(field(i, k, jde-1)+field(i, k, jde-2))
          END DO
        END DO
      END IF
    END IF
  ELSE IF (horz_order .NE. 0) THEN
! Just in case we want to turn horizontal advection off, we can do it
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_scalar_6a, h_order not known ', horz_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(its, k, j)+rud(its+1, k, j))
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(&
&          field_old(its+1, k, j)-field_old(its, k, j))+ub*(field_oldd(&
&          its+1, k, j)-field_oldd(its, k, j))+fieldd(its, k, j)*(ru(its+&
&          1, k, j)-ru(its, k, j))+field(its, k, j)*(rud(its+1, k, j)-rud&
&          (its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(field_old(&
&          its+1, k, j)-field_old(its, k, j))+field(its, k, j)*(ru(its+1&
&          , k, j)-ru(its, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(ite-1, k, j)+rud(ite, k, j))
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+ub*(&
&          field_oldd(i_end, k, j)-field_oldd(i_end-1, k, j))+fieldd(&
&          i_end, k, j)*(ru(ite, k, j)-ru(ite-1, k, j))+field(i_end, k, j&
&          )*(rud(ite, k, j)-rud(ite-1, k, j)))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+field(i_end, &
&          k, j)*(ru(ite, k, j)-ru(ite-1, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jts)+rvd(i, k, jts+1))
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*(rv(i, k&
&          , jts+1)-rv(i, k, jts))+field(i, k, jts)*(rvd(i, k, jts+1)-rvd&
&          (i, k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*(rv(i, k, &
&          jts+1)-rv(i, k, jts)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jte-1)+rvd(i, k, jte))
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))+fieldd(i, k&
&          , j_end)*(rv(i, k, jte)-rv(i, k, jte-1))+field(i, k, j_end)*(&
&          rvd(i, k, jte)-rvd(i, k, jte-1)))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(rv(i, k, jte)-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!     Scalar equation has 3rd term on RHS = - partial d/dz (q rho w /my)
!     Here we have: - partial d/dz (q*rom) = - partial d/dz (q rho w / my)
!     So we don't need to make a correction for advect_scalar
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  IF (vert_order .EQ. 6) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          vfluxd(i, k) = veld*(37.*(field(i, k, j)+field(i, k-1, j))-8.*&
&            (field(i, k+1, j)+field(i, k-2, j))+(field(i, k+2, j)+field(&
&            i, k-3, j)))/60.0 + vel*(37.*(fieldd(i, k, j)+fieldd(i, k-1&
&            , j))-8.*(fieldd(i, k+1, j)+fieldd(i, k-2, j))+fieldd(i, k+2&
&            , j)+fieldd(i, k-3, j))/60.0
          vflux(i, k) = vel*((37.*(field(i, k, j)+field(i, k-1, j))-8.*(&
&            field(i, k+1, j)+field(i, k-2, j))+(field(i, k+2, j)+field(i&
&            , k-3, j)))/60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
        k = kts + 2
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        vfluxd(i, k) = veld*(7.*(field(i, k, j)+field(i, k-1, j))-(field&
&          (i, k+1, j)+field(i, k-2, j)))/12.0 + vel*(7.*(fieldd(i, k, j)&
&          +fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(field(&
&          i, k+1, j)+field(i, k-2, j)))/12.0)
        k = ktf - 1
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        vfluxd(i, k) = veld*(7.*(field(i, k, j)+field(i, k-1, j))-(field&
&          (i, k+1, j)+field(i, k-2, j)))/12.0 + vel*(7.*(fieldd(i, k, j)&
&          +fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(field(&
&          i, k+1, j)+field(i, k-2, j)))/12.0)
        k = ktf
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          vfluxd(i, k) = veld*((37.*(field(i, k, j)+field(i, k-1, j))-8.&
&            *(field(i, k+1, j)+field(i, k-2, j))+(field(i, k+2, j)+field&
&            (i, k-3, j)))/60.0-SIGN(1, time_step)*SIGN(1., -vel)*(field(&
&            i, k+2, j)-field(i, k-3, j)-5.*(field(i, k+1, j)-field(i, k-&
&            2, j))+10.*(field(i, k, j)-field(i, k-1, j)))/60.0) + vel*((&
&            37.*(fieldd(i, k, j)+fieldd(i, k-1, j))-8.*(fieldd(i, k+1, j&
&            )+fieldd(i, k-2, j))+fieldd(i, k+2, j)+fieldd(i, k-3, j))/&
&            60.0-SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+2, j)-&
&            fieldd(i, k-3, j)-5.*(fieldd(i, k+1, j)-fieldd(i, k-2, j))+&
&            10.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/60.0)
          vflux(i, k) = vel*((37.*(field(i, k, j)+field(i, k-1, j))-8.*(&
&            field(i, k+1, j)+field(i, k-2, j))+(field(i, k+2, j)+field(i&
&            , k-3, j)))/60.0-SIGN(1, time_step)*SIGN(1., -vel)*(field(i&
&            , k+2, j)-field(i, k-3, j)-5.*(field(i, k+1, j)-field(i, k-2&
&            , j))+10.*(field(i, k, j)-field(i, k-1, j)))/60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
        k = kts + 2
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        vfluxd(i, k) = veld*((7.*(field(i, k, j)+field(i, k-1, j))-(&
&          field(i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(i&
&          , k, j)-field(i, k-1, j)))/12.0) + vel*((7.*(fieldd(i, k, j)+&
&          fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, j))/12.0+&
&          SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-fieldd(i&
&          , k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(field(&
&          i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1.&
&          , -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-&
&          field(i, k-1, j)))/12.0)
        k = ktf - 1
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        vfluxd(i, k) = veld*((7.*(field(i, k, j)+field(i, k-1, j))-(&
&          field(i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(i&
&          , k, j)-field(i, k-1, j)))/12.0) + vel*((7.*(fieldd(i, k, j)+&
&          fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, j))/12.0+&
&          SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-fieldd(i&
&          , k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(field(&
&          i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1.&
&          , -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-&
&          field(i, k-1, j)))/12.0)
        k = ktf
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          vfluxd(i, k) = veld*(7.*(field(i, k, j)+field(i, k-1, j))-(&
&            field(i, k+1, j)+field(i, k-2, j)))/12.0 + vel*(7.*(fieldd(i&
&            , k, j)+fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, &
&            j))/12.0
          vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(&
&            field(i, k+1, j)+field(i, k-2, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
        k = ktf
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          vfluxd(i, k) = veld*((7.*(field(i, k, j)+field(i, k-1, j))-(&
&            field(i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*&
&            SIGN(1., -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&            i, k, j)-field(i, k-1, j)))/12.0) + vel*((7.*(fieldd(i, k, j&
&            )+fieldd(i, k-1, j))-fieldd(i, k+1, j)-fieldd(i, k-2, j))/&
&            12.0+SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-&
&            fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/&
&            12.0)
          vflux(i, k) = vel*((7.*(field(i, k, j)+field(i, k-1, j))-(&
&            field(i, k+1, j)+field(i, k-2, j)))/12.0+SIGN(1, time_step)*&
&            SIGN(1., -vel)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&            i, k, j)-field(i, k-1, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
        k = ktf
        vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&          (i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*&
&          fieldd(i, k-1, j))
        vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&          , k-1, j))
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
          vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp&
&            (k)*fieldd(i, k-1, j))
          vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field&
&            (i, k-1, j))
        END DO
      END DO
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
    END DO
  ELSE
    WRITE(wrf_err_message, *) ' advect_scalar_6a, v_order not known ', &
&    vert_order
    CALL WRF_ERROR_FATAL(wrf_err_message)
  END IF
END SUBROUTINE G_ADVECT_SCALAR

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_w in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom tendency w ru rv w_old
!   RW status of diff variables: rom:in tendency:in-out w:in ru:in
!                rv:in w_old:in
SUBROUTINE G_ADVECT_W(w, wd, w_old, w_oldd, tendency, tendencyd, ru, rud&
&  , rv, rvd, rom, romd, mut, time_step, config_flags, msfux, msfuy, &
&  msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzu, ids, ide, jds, &
&  jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, &
&  kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: w, w_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: wd, w_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzu
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw
  REAL :: ubd, vbd, uwd, vwd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  INTEGER :: horz_order, vert_order
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified




  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_sca_adv_order
  vert_order = config_flags%v_sca_adv_order
!  here is the choice of flux operators
!  begin with horizontal flux divergence
  IF (horz_order .EQ. 6) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_6:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*(37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(&
&              i, k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0&
&              + vel*(37.*(wd(i, k, j)+wd(i, k, j-1))-8.*(wd(i, k, j+1)+&
&              wd(i, k, j-2))+wd(i, k, j+2)+wd(i, k, j-3))/60.0
            fqy(i, k, jp1) = vel*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i&
&              , k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*(37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i&
&            , k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0 + &
&            vel*(37.*(wd(i, k, j)+wd(i, k, j-1))-8.*(wd(i, k, j+1)+wd(i&
&            , k, j-2))+wd(i, k, j+2)+wd(i, k, j-3))/60.0
          fqy(i, k, jp1) = vel*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i, &
&            k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0)
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k&
&              , j-1))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, &
&            j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k, j-1&
&            ))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0)
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k&
&              , j-1))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, &
&            j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k, j-1&
&            ))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0)
        END DO
      END IF
!  y flux-divergence into tendency
! Comments for polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts+1,ktf+1
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_6
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          fqxd(i, k) = veld*(37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k&
&            , j)+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0 + vel*(&
&            37.*(wd(i, k, j)+wd(i-1, k, j))-8.*(wd(i+1, k, j)+wd(i-2, k&
&            , j))+wd(i+2, k, j)+wd(i-3, k, j))/60.0
          fqx(i, k) = vel*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, &
&            j)+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
        fqxd(i, k) = veld*(37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, j&
&          )+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0 + vel*(37.*(&
&          wd(i, k, j)+wd(i-1, k, j))-8.*(wd(i+1, k, j)+wd(i-2, k, j))+wd&
&          (i+2, k, j)+wd(i-3, k, j))/60.0
        fqx(i, k) = vel*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, j)&
&          +w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0)
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts+1,ktf
              fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, &
&                j))*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)&
&                *ru(i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
              fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                (w(i, k, j)+w(i-1, k, j))
            END DO
            k = ktf + 1
            fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud&
&              (i, k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i&
&              , k-1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, &
&              j)))
            fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*(w(i, k, j)+w(i-1, k, j))
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts+1,ktf
              veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k&
&                , j)+w(i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, &
&                k, j))-wd(i+1, k, j)-wd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&                j)+w(i-2, k, j)))/12.0)
            END DO
            k = ktf + 1
            veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j&
&              )
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j&
&              )+w(i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, k, j)&
&              )-wd(i+1, k, j)-wd(i-2, k, j))/12.0
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0)
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts+1,ktf
              fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, &
&                j))*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)&
&                *ru(i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
              fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                (w(i, k, j)+w(i-1, k, j))
            END DO
            k = ktf + 1
            fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud&
&              (i, k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i&
&              , k-1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, &
&              j)))
            fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*(w(i, k, j)+w(i-1, k, j))
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts+1,ktf
              veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k&
&                , j)+w(i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, &
&                k, j))-wd(i+1, k, j)-wd(i-2, k, j))/12.0
              fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&                j)+w(i-2, k, j)))/12.0)
            END DO
            k = ktf + 1
            veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j&
&              )
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j&
&              )+w(i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, k, j)&
&              )-wd(i+1, k, j)-wd(i-2, k, j))/12.0
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0)
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 5) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w&
&              (i, k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/&
&              60.0-SIGN(1, time_step)*SIGN(1., vel)*(w(i, k, j+2)-w(i, k&
&              , j-3)-5.*(w(i, k, j+1)-w(i, k, j-2))+10.*(w(i, k, j)-w(i&
&              , k, j-1)))/60.0) + vel*((37.*(wd(i, k, j)+wd(i, k, j-1))-&
&              8.*(wd(i, k, j+1)+wd(i, k, j-2))+wd(i, k, j+2)+wd(i, k, j-&
&              3))/60.0-SIGN(1, time_step)*SIGN(1., vel)*(wd(i, k, j+2)-&
&              wd(i, k, j-3)-5.*(wd(i, k, j+1)-wd(i, k, j-2))+10.*(wd(i, &
&              k, j)-wd(i, k, j-1)))/60.0)
            fqy(i, k, jp1) = vel*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i&
&              , k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0-&
&              SIGN(1, time_step)*SIGN(1., vel)*(w(i, k, j+2)-w(i, k, j-3&
&              )-5.*(w(i, k, j+1)-w(i, k, j-2))+10.*(w(i, k, j)-w(i, k, j&
&              -1)))/60.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i&
&            , k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0-&
&            SIGN(1, time_step)*SIGN(1., vel)*(w(i, k, j+2)-w(i, k, j-3)-&
&            5.*(w(i, k, j+1)-w(i, k, j-2))+10.*(w(i, k, j)-w(i, k, j-1))&
&            )/60.0) + vel*((37.*(wd(i, k, j)+wd(i, k, j-1))-8.*(wd(i, k&
&            , j+1)+wd(i, k, j-2))+wd(i, k, j+2)+wd(i, k, j-3))/60.0-SIGN&
&            (1, time_step)*SIGN(1., vel)*(wd(i, k, j+2)-wd(i, k, j-3)-5.&
&            *(wd(i, k, j+1)-wd(i, k, j-2))+10.*(wd(i, k, j)-wd(i, k, j-1&
&            )))/60.0)
          fqy(i, k, jp1) = vel*((37.*(w(i, k, j)+w(i, k, j-1))-8.*(w(i, &
&            k, j+1)+w(i, k, j-2))+(w(i, k, j+2)+w(i, k, j-3)))/60.0-SIGN&
&            (1, time_step)*SIGN(1., vel)*(w(i, k, j+2)-w(i, k, j-3)-5.*(&
&            w(i, k, j+1)-w(i, k, j-2))+10.*(w(i, k, j)-w(i, k, j-1)))/&
&            60.0)
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, &
&              k, j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1&
&              )))/12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, &
&              j+1)-wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (wd(i, k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&            , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/&
&            12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-&
&            wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, &
&            k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(&
&            i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, &
&              k, j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1&
&              )))/12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, &
&              j+1)-wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (wd(i, k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&            , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/&
&            12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-&
&            wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, &
&            k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(&
&            i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
        END DO
      END IF
!  y flux-divergence into tendency
! Comments for polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts+1,ktf+1
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_5
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          fqxd(i, k) = veld*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k&
&            , j)+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., vel)*(w(i+2, k, j)-w(i-3, k, j)-5.*(w(&
&            i+1, k, j)-w(i-2, k, j))+10.*(w(i, k, j)-w(i-1, k, j)))/60.0&
&            ) + vel*((37.*(wd(i, k, j)+wd(i-1, k, j))-8.*(wd(i+1, k, j)+&
&            wd(i-2, k, j))+wd(i+2, k, j)+wd(i-3, k, j))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(wd(i+2, k, j)-wd(i-3, k, j)-5.*(wd&
&            (i+1, k, j)-wd(i-2, k, j))+10.*(wd(i, k, j)-wd(i-1, k, j)))/&
&            60.0)
          fqx(i, k) = vel*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, &
&            j)+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0-SIGN(1, &
&            time_step)*SIGN(1., vel)*(w(i+2, k, j)-w(i-3, k, j)-5.*(w(i+&
&            1, k, j)-w(i-2, k, j))+10.*(w(i, k, j)-w(i-1, k, j)))/60.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
        fqxd(i, k) = veld*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, &
&          j)+w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0-SIGN(1, &
&          time_step)*SIGN(1., vel)*(w(i+2, k, j)-w(i-3, k, j)-5.*(w(i+1&
&          , k, j)-w(i-2, k, j))+10.*(w(i, k, j)-w(i-1, k, j)))/60.0) + &
&          vel*((37.*(wd(i, k, j)+wd(i-1, k, j))-8.*(wd(i+1, k, j)+wd(i-2&
&          , k, j))+wd(i+2, k, j)+wd(i-3, k, j))/60.0-SIGN(1, time_step)*&
&          SIGN(1., vel)*(wd(i+2, k, j)-wd(i-3, k, j)-5.*(wd(i+1, k, j)-&
&          wd(i-2, k, j))+10.*(wd(i, k, j)-wd(i-1, k, j)))/60.0)
        fqx(i, k) = vel*((37.*(w(i, k, j)+w(i-1, k, j))-8.*(w(i+1, k, j)&
&          +w(i-2, k, j))+(w(i+2, k, j)+w(i-3, k, j)))/60.0-SIGN(1, &
&          time_step)*SIGN(1., vel)*(w(i+2, k, j)-w(i-3, k, j)-5.*(w(i+1&
&          , k, j)-w(i-2, k, j))+10.*(w(i, k, j)-w(i-1, k, j)))/60.0)
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts+1,ktf
              fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, &
&                j))*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)&
&                *ru(i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
              fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                (w(i, k, j)+w(i-1, k, j))
            END DO
            k = ktf + 1
            fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud&
&              (i, k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i&
&              , k-1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, &
&              j)))
            fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*(w(i, k, j)+w(i-1, k, j))
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts+1,ktf
              veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k&
&                , j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&                )*(w(i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)&
&                ))/12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, &
&                k, j)-wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(wd(i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1&
&                , k, j)))/12.0)
              fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&                j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&                (w(i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))&
&                /12.0)
            END DO
            k = ktf + 1
            veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j&
&              )
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&              j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w&
&              (i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/&
&              12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)&
&              -wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(&
&              i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&              +1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts+1,ktf
              fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, &
&                j))*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)&
&                *ru(i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
              fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                (w(i, k, j)+w(i-1, k, j))
            END DO
            k = ktf + 1
            fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud&
&              (i, k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i&
&              , k-1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, &
&              j)))
            fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*(w(i, k, j)+w(i-1, k, j))
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts+1,ktf
              veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k&
&                , j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&                )*(w(i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)&
&                ))/12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, &
&                k, j)-wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., &
&                vel)*(wd(i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1&
&                , k, j)))/12.0)
              fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&                j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&                (w(i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))&
&                /12.0)
            END DO
            k = ktf + 1
            veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j&
&              )
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&              j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w&
&              (i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/&
&              12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)&
&              -wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(&
&              i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&              +1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
  ELSE IF (horz_order .EQ. 4) THEN
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+&
&            w(i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, k, j))-wd&
&            (i+1, k, j)-wd(i-2, k, j))/12.0
          fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w&
&            (i-2, k, j)))/12.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
        fqxd(i, k) = veld*(7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w(&
&          i-2, k, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1&
&          , k, j)-wd(i-2, k, j))/12.0
        fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w(i&
&          -2, k, j)))/12.0)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts+1,ktf
          fqxd(i_start, k) = 0.5*((fzm(k)*rud(i_start, k, j)+fzp(k)*rud(&
&            i_start, k-1, j))*(w(i_start, k, j)+w(i_start-1, k, j))+(fzm&
&            (k)*ru(i_start, k, j)+fzp(k)*ru(i_start, k-1, j))*(wd(&
&            i_start, k, j)+wd(i_start-1, k, j)))
          fqx(i_start, k) = 0.5*(fzm(k)*ru(i_start, k, j)+fzp(k)*ru(&
&            i_start, k-1, j))*(w(i_start, k, j)+w(i_start-1, k, j))
        END DO
        k = ktf + 1
        fqxd(i_start, k) = 0.5*(((2.-fzm(k-1))*rud(i_start, k-1, j)-fzp(&
&          k-1)*rud(i_start, k-2, j))*(w(i_start, k, j)+w(i_start-1, k, j&
&          ))+((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1)*ru(i_start, k-2&
&          , j))*(wd(i_start, k, j)+wd(i_start-1, k, j)))
        fqx(i_start, k) = 0.5*((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1&
&          )*ru(i_start, k-2, j))*(w(i_start, k, j)+w(i_start-1, k, j))
      END IF
      IF (degrade_xe) THEN
        DO k=kts+1,ktf
          fqxd(i_end+1, k) = 0.5*((fzm(k)*rud(i_end+1, k, j)+fzp(k)*rud(&
&            i_end+1, k-1, j))*(w(i_end+1, k, j)+w(i_end, k, j))+(fzm(k)*&
&            ru(i_end+1, k, j)+fzp(k)*ru(i_end+1, k-1, j))*(wd(i_end+1, k&
&            , j)+wd(i_end, k, j)))
          fqx(i_end+1, k) = 0.5*(fzm(k)*ru(i_end+1, k, j)+fzp(k)*ru(&
&            i_end+1, k-1, j))*(w(i_end+1, k, j)+w(i_end, k, j))
        END DO
        k = ktf + 1
        fqxd(i_end+1, k) = 0.5*(((2.-fzm(k-1))*rud(i_end+1, k-1, j)-fzp(&
&          k-1)*rud(i_end+1, k-2, j))*(w(i_end+1, k, j)+w(i_end, k, j))+(&
&          (2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1)*ru(i_end+1, k-2, j)&
&          )*(wd(i_end+1, k, j)+wd(i_end, k, j)))
        fqx(i_end+1, k) = 0.5*((2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1&
&          )*ru(i_end+1, k-2, j))*(w(i_end+1, k, j)+w(i_end, k, j))
      END IF
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j_start)+fzp(k)*rvd&
&              (i, k-1, j_start))*(w(i, k, j_start)+w(i, k, j_start-1))+(&
&              fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, k-1, j_start))*(wd(i&
&              , k, j_start)+wd(i, k, j_start-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, &
&              k-1, j_start))*(w(i, k, j_start)+w(i, k, j_start-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j_start)-fzp&
&            (k-1)*rvd(i, k-2, j_start))*(w(i, k, j_start)+w(i, k, &
&            j_start-1))+((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-1)*rv(i&
&            , k-2, j_start))*(wd(i, k, j_start)+wd(i, k, j_start-1)))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-&
&            1)*rv(i, k-2, j_start))*(w(i, k, j_start)+w(i, k, j_start-1)&
&            )
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!            fqy(i, k, jp1) =                             &
!               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
!                   *(w(i,k,j_end+1)+w(i,k,j_end))
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!            fqy(i, k, jp1) =                                         &
!               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
!                   *(w(i,k,j_end+1)+w(i,k,j_end))
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k&
&              , j-1))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*(7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, &
&            j+1)+w(i, k, j-2)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k, j-1&
&            ))-wd(i, k, j+1)-wd(i, k, j-2))/12.0
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0)
        END DO
      END IF
!  y flux-divergence into tendency
! Comments for polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts+1,ktf+1
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 3) THEN
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 3) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      i_start = ids + 1
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      i_end = ide - 2
      i_end_f = ide - 2
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&            +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1&
&            , k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0) + &
&            vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)-wd(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i+1, k, j)-&
&            wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1, &
&            k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
        fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w&
&          (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1, k&
&          , j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0) + vel*((&
&          7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)-wd(i-2, k, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i+1, k, j)-wd(i-2, k&
&          , j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/12.0)
        fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w(i&
&          -2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1, k, j&
&          )-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO k=kts+1,ktf
          fqxd(i_start, k) = 0.5*((fzm(k)*rud(i_start, k, j)+fzp(k)*rud(&
&            i_start, k-1, j))*(w(i_start, k, j)+w(i_start-1, k, j))+(fzm&
&            (k)*ru(i_start, k, j)+fzp(k)*ru(i_start, k-1, j))*(wd(&
&            i_start, k, j)+wd(i_start-1, k, j)))
          fqx(i_start, k) = 0.5*(fzm(k)*ru(i_start, k, j)+fzp(k)*ru(&
&            i_start, k-1, j))*(w(i_start, k, j)+w(i_start-1, k, j))
        END DO
        k = ktf + 1
        fqxd(i_start, k) = 0.5*(((2.-fzm(k-1))*rud(i_start, k-1, j)-fzp(&
&          k-1)*rud(i_start, k-2, j))*(w(i_start, k, j)+w(i_start-1, k, j&
&          ))+((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1)*ru(i_start, k-2&
&          , j))*(wd(i_start, k, j)+wd(i_start-1, k, j)))
        fqx(i_start, k) = 0.5*((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1&
&          )*ru(i_start, k-2, j))*(w(i_start, k, j)+w(i_start-1, k, j))
      END IF
      IF (degrade_xe) THEN
        DO k=kts+1,ktf
          fqxd(i_end+1, k) = 0.5*((fzm(k)*rud(i_end+1, k, j)+fzp(k)*rud(&
&            i_end+1, k-1, j))*(w(i_end+1, k, j)+w(i_end, k, j))+(fzm(k)*&
&            ru(i_end+1, k, j)+fzp(k)*ru(i_end+1, k-1, j))*(wd(i_end+1, k&
&            , j)+wd(i_end, k, j)))
          fqx(i_end+1, k) = 0.5*(fzm(k)*ru(i_end+1, k, j)+fzp(k)*ru(&
&            i_end+1, k-1, j))*(w(i_end+1, k, j)+w(i_end, k, j))
        END DO
        k = ktf + 1
        fqxd(i_end+1, k) = 0.5*(((2.-fzm(k-1))*rud(i_end+1, k-1, j)-fzp(&
&          k-1)*rud(i_end+1, k-2, j))*(w(i_end+1, k, j)+w(i_end, k, j))+(&
&          (2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1)*ru(i_end+1, k-2, j)&
&          )*(wd(i_end+1, k, j)+wd(i_end, k, j)))
        fqx(i_end+1, k) = 0.5*((2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1&
&          )*ru(i_end+1, k-2, j))*(w(i_end+1, k, j)+w(i_end, k, j))
      END IF
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&            fqxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(&
&            i, k))
        END DO
      END DO
    END DO
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  3rd or 4th order flux has a 5 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      j_start = jds + 1
      j_start_f = j_start + 1
    END IF
    IF (degrade_ye) THEN
      j_end = jde - 2
      j_end_f = jde - 2
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
    DO j=j_start,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j_start)+fzp(k)*rvd&
&              (i, k-1, j_start))*(w(i, k, j_start)+w(i, k, j_start-1))+(&
&              fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, k-1, j_start))*(wd(i&
&              , k, j_start)+wd(i, k, j_start-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, &
&              k-1, j_start))*(w(i, k, j_start)+w(i, k, j_start-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j_start)-fzp&
&            (k-1)*rvd(i, k-2, j_start))*(w(i, k, j_start)+w(i, k, &
&            j_start-1))+((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-1)*rv(i&
&            , k-2, j_start))*(wd(i, k, j_start)+wd(i, k, j_start-1)))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-&
&            1)*rv(i, k-2, j_start))*(w(i, k, j_start)+w(i, k, j_start-1)&
&            )
        END DO
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!            fqy(i, k, jp1) =                             &
!               0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))     &
!                   *(w(i,k,j_end+1)+w(i,k,j_end))
            fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-&
&              1, j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k&
&              )*rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
            fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j&
&              ))*(w(i, k, j)+w(i, k, j-1))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
! Assumes j>j_end_f is ONLY j_end+1 ...
!            fqy(i, k, jp1) =                             &
!               0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))     &
!                   *(w(i,k,j_end+1)+w(i,k,j_end))
          fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&            rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(&
&            i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1&
&            )))
          fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(&
&            i, k-2, j))*(w(i, k, j)+w(i, k, j-1))
        END DO
      ELSE
!  3rd or 4th order flux
        DO k=kts+1,ktf
          DO i=i_start,i_end
            veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, &
&              k, j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., &
&              vel)*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1&
&              )))/12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, &
&              j+1)-wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&              (wd(i, k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)&
&              ))/12.0)
            fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&              , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel&
&              )*(w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))&
&              /12.0)
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
          veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
          fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&            , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/&
&            12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-&
&            wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, &
&            k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(&
&            i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
        END DO
      END IF
!  y flux-divergence into tendency
! Comments for polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
      IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k&
&              , jp1)
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, &
&              jp1)
          END DO
        END DO
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k&
&              , jp0)
            tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, &
&              jp0)
          END DO
        END DO
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts+1,ktf+1
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, j-1)*rdy
            tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, &
&              k, jp1)-fqyd(i, k, jp0))
            tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&              jp1)-fqy(i, k, jp0))
          END DO
        END DO
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO
  ELSE IF (horz_order .EQ. 2) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    IF (.NOT.config_flags%periodic_x) THEN
      IF (config_flags%open_xs .OR. specified) THEN
        IF (ids + 1 .LT. its) THEN
          i_start = its
        ELSE
          i_start = ids + 1
        END IF
      END IF
      IF (config_flags%open_xe .OR. specified) THEN
        IF (ide - 2 .GT. ite) THEN
          i_end = ite
        ELSE
          i_end = ide - 2
        END IF
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
          mrdx = msftx(i, j)*rdx
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.5*((fzm(k)*&
&            rud(i+1, k, j)+fzp(k)*rud(i+1, k-1, j))*(w(i+1, k, j)+w(i, k&
&            , j))+(fzm(k)*ru(i+1, k, j)+fzp(k)*ru(i+1, k-1, j))*(wd(i+1&
&            , k, j)+wd(i, k, j))-(fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1&
&            , j))*(w(i, k, j)+w(i-1, k, j))-(fzm(k)*ru(i, k, j)+fzp(k)*&
&            ru(i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
          tendency(i, k, j) = tendency(i, k, j) - mrdx*0.5*((fzm(k)*ru(i&
&            +1, k, j)+fzp(k)*ru(i+1, k-1, j))*(w(i+1, k, j)+w(i, k, j))-&
&            (fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*(w(i, k, j)+w(i-1&
&            , k, j)))
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
        mrdx = msftx(i, j)*rdx
        tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*0.5*(((2.-fzm(k-1&
&          ))*rud(i+1, k-1, j)-fzp(k-1)*rud(i+1, k-2, j))*(w(i+1, k, j)+w&
&          (i, k, j))+((2.-fzm(k-1))*ru(i+1, k-1, j)-fzp(k-1)*ru(i+1, k-2&
&          , j))*(wd(i+1, k, j)+wd(i, k, j))-((2.-fzm(k-1))*rud(i, k-1, j&
&          )-fzp(k-1)*rud(i, k-2, j))*(w(i, k, j)+w(i-1, k, j))-((2.-fzm(&
&          k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-&
&          1, k, j)))
        tendency(i, k, j) = tendency(i, k, j) - mrdx*0.5*(((2.-fzm(k-1))&
&          *ru(i+1, k-1, j)-fzp(k-1)*ru(i+1, k-2, j))*(w(i+1, k, j)+w(i, &
&          k, j))-((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-2, j))*(w&
&          (i, k, j)+w(i-1, k, j)))
      END DO
    END DO
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
! Polar boundary conditions are like open or specified
    IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&    THEN
      IF (jde - 2 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 2
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
!  see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, j)*rdy
          tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.5*((fzm(k)*&
&            rvd(i, k, j+1)+fzp(k)*rvd(i, k-1, j+1))*(w(i, k, j+1)+w(i, k&
&            , j))+(fzm(k)*rv(i, k, j+1)+fzp(k)*rv(i, k-1, j+1))*(wd(i, k&
&            , j+1)+wd(i, k, j))-(fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-1, &
&            j))*(w(i, k, j)+w(i, k, j-1))-(fzm(k)*rv(i, k, j)+fzp(k)*rv(&
&            i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
          tendency(i, k, j) = tendency(i, k, j) - mrdy*0.5*((fzm(k)*rv(i&
&            , k, j+1)+fzp(k)*rv(i, k-1, j+1))*(w(i, k, j+1)+w(i, k, j))-&
&            (fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*(w(i, k, j)+w(i, k&
&            , j-1)))
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
        mrdy = msftx(i, j)*rdy
        tendencyd(i, k, j) = tendencyd(i, k, j) - mrdy*0.5*(((2.-fzm(k-1&
&          ))*rvd(i, k-1, j+1)-fzp(k-1)*rvd(i, k-2, j+1))*(w(i, k, j+1)+w&
&          (i, k, j))+((2.-fzm(k-1))*rv(i, k-1, j+1)-fzp(k-1)*rv(i, k-2, &
&          j+1))*(wd(i, k, j+1)+wd(i, k, j))-((2.-fzm(k-1))*rvd(i, k-1, j&
&          )-fzp(k-1)*rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))-((2.-fzm(&
&          k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i&
&          , k, j-1)))
        tendency(i, k, j) = tendency(i, k, j) - mrdy*0.5*(((2.-fzm(k-1))&
&          *rv(i, k-1, j+1)-fzp(k-1)*rv(i, k-2, j+1))*(w(i, k, j+1)+w(i, &
&          k, j))-((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2, j))*(w&
&          (i, k, j)+w(i, k, j-1)))
      END DO
    END DO
! Polar boundary condition ... not covered in above j-loop
    IF (config_flags%polar) THEN
      IF (jts .EQ. jds) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, jds)*rdy
            tendencyd(i, k, jds) = tendencyd(i, k, jds) - mrdy*0.5*((fzm&
&              (k)*rvd(i, k, jds+1)+fzp(k)*rvd(i, k-1, jds+1))*(w(i, k, &
&              jds+1)+w(i, k, jds))+(fzm(k)*rv(i, k, jds+1)+fzp(k)*rv(i, &
&              k-1, jds+1))*(wd(i, k, jds+1)+wd(i, k, jds)))
            tendency(i, k, jds) = tendency(i, k, jds) - mrdy*0.5*((fzm(k&
&              )*rv(i, k, jds+1)+fzp(k)*rv(i, k-1, jds+1))*(w(i, k, jds+1&
&              )+w(i, k, jds)))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, jds)*rdy
          tendencyd(i, k, jds) = tendencyd(i, k, jds) - mrdy*0.5*(((2.-&
&            fzm(k-1))*rvd(i, k-1, jds+1)-fzp(k-1)*rvd(i, k-2, jds+1))*(w&
&            (i, k, jds+1)+w(i, k, jds))+((2.-fzm(k-1))*rv(i, k-1, jds+1)&
&            -fzp(k-1)*rv(i, k-2, jds+1))*(wd(i, k, jds+1)+wd(i, k, jds))&
&            )
          tendency(i, k, jds) = tendency(i, k, jds) - mrdy*0.5*((2.-fzm(&
&            k-1))*rv(i, k-1, jds+1)-fzp(k-1)*rv(i, k-2, jds+1))*(w(i, k&
&            , jds+1)+w(i, k, jds))
        END DO
      END IF
      IF (jte .EQ. jde) THEN
        DO k=kts+1,ktf
          DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
            mrdy = msftx(i, jde-1)*rdy
            tendencyd(i, k, jde-1) = tendencyd(i, k, jde-1) + mrdy*0.5*(&
&              (fzm(k)*rvd(i, k, jde-1)+fzp(k)*rvd(i, k-1, jde-1))*(w(i, &
&              k, jde-1)+w(i, k, jde-2))+(fzm(k)*rv(i, k, jde-1)+fzp(k)*&
&              rv(i, k-1, jde-1))*(wd(i, k, jde-1)+wd(i, k, jde-2)))
            tendency(i, k, jde-1) = tendency(i, k, jde-1) + mrdy*0.5*((&
&              fzm(k)*rv(i, k, jde-1)+fzp(k)*rv(i, k-1, jde-1))*(w(i, k, &
&              jde-1)+w(i, k, jde-2)))
          END DO
        END DO
        k = ktf + 1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, jde-1)*rdy
          tendencyd(i, k, jde-1) = tendencyd(i, k, jde-1) + mrdy*0.5*(((&
&            2.-fzm(k-1))*rvd(i, k-1, jde-1)-fzp(k-1)*rvd(i, k-2, jde-1))&
&            *(w(i, k, jde-1)+w(i, k, jde-2))+((2.-fzm(k-1))*rv(i, k-1, &
&            jde-1)-fzp(k-1)*rv(i, k-2, jde-1))*(wd(i, k, jde-1)+wd(i, k&
&            , jde-2)))
          tendency(i, k, jde-1) = tendency(i, k, jde-1) + mrdy*0.5*((2.-&
&            fzm(k-1))*rv(i, k-1, jde-1)-fzp(k-1)*rv(i, k-2, jde-1))*(w(i&
&            , k, jde-1)+w(i, k, jde-2))
        END DO
      END IF
    END IF
  ELSE IF (horz_order .NE. 0) THEN
! Just in case we want to turn horizontal advection off, we can do it
    WRITE(wrf_err_message, *) ' advect_w_6a, h_order not known ', &
&    horz_order
    CALL WRF_ERROR_FATAL(wrf_err_message)
  END IF
!  pick up the the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts+1,ktf
        uwd = 0.5*(fzm(k)*(rud(its, k, j)+rud(its+1, k, j))+fzp(k)*(rud(&
&          its, k-1, j)+rud(its+1, k-1, j)))
        uw = 0.5*(fzm(k)*(ru(its, k, j)+ru(its+1, k, j))+fzp(k)*(ru(its&
&          , k-1, j)+ru(its+1, k-1, j)))
        IF (uw .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(w_old(&
&          its+1, k, j)-w_old(its, k, j))+ub*(w_oldd(its+1, k, j)-w_oldd(&
&          its, k, j))+wd(its, k, j)*(fzm(k)*(ru(its+1, k, j)-ru(its, k, &
&          j))+fzp(k)*(ru(its+1, k-1, j)-ru(its, k-1, j)))+w(its, k, j)*(&
&          fzm(k)*(rud(its+1, k, j)-rud(its, k, j))+fzp(k)*(rud(its+1, k-&
&          1, j)-rud(its, k-1, j))))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(w_old(its+1&
&          , k, j)-w_old(its, k, j))+w(its, k, j)*(fzm(k)*(ru(its+1, k, j&
&          )-ru(its, k, j))+fzp(k)*(ru(its+1, k-1, j)-ru(its, k-1, j))))
      END DO
    END DO
    k = ktf + 1
    DO j=j_start,j_end
      uwd = 0.5*((2.-fzm(k-1))*(rud(its, k-1, j)+rud(its+1, k-1, j))-fzp&
&        (k-1)*(rud(its, k-2, j)+rud(its+1, k-2, j)))
      uw = 0.5*((2.-fzm(k-1))*(ru(its, k-1, j)+ru(its+1, k-1, j))-fzp(k-&
&        1)*(ru(its, k-2, j)+ru(its+1, k-2, j)))
      IF (uw .GT. 0.) THEN
        ub = 0.
        ubd = 0.0
      ELSE
        ubd = uwd
        ub = uw
      END IF
      tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(w_old(its+&
&        1, k, j)-w_old(its, k, j))+ub*(w_oldd(its+1, k, j)-w_oldd(its, k&
&        , j))+wd(its, k, j)*((2.-fzm(k-1))*(ru(its+1, k-1, j)-ru(its, k-&
&        1, j))-fzp(k-1)*(ru(its+1, k-2, j)-ru(its, k-2, j)))+w(its, k, j&
&        )*((2.-fzm(k-1))*(rud(its+1, k-1, j)-rud(its, k-1, j))-fzp(k-1)*&
&        (rud(its+1, k-2, j)-rud(its, k-2, j))))
      tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(w_old(its+1, &
&        k, j)-w_old(its, k, j))+w(its, k, j)*((2.-fzm(k-1))*(ru(its+1, k&
&        -1, j)-ru(its, k-1, j))-fzp(k-1)*(ru(its+1, k-2, j)-ru(its, k-2&
&        , j))))
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts+1,ktf
        uwd = 0.5*(fzm(k)*(rud(ite-1, k, j)+rud(ite, k, j))+fzp(k)*(rud(&
&          ite-1, k-1, j)+rud(ite, k-1, j)))
        uw = 0.5*(fzm(k)*(ru(ite-1, k, j)+ru(ite, k, j))+fzp(k)*(ru(ite-&
&          1, k-1, j)+ru(ite, k-1, j)))
        IF (uw .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          w_old(i_end, k, j)-w_old(i_end-1, k, j))+ub*(w_oldd(i_end, k, &
&          j)-w_oldd(i_end-1, k, j))+wd(i_end, k, j)*(fzm(k)*(ru(ite, k, &
&          j)-ru(ite-1, k, j))+fzp(k)*(ru(ite, k-1, j)-ru(ite-1, k-1, j))&
&          )+w(i_end, k, j)*(fzm(k)*(rud(ite, k, j)-rud(ite-1, k, j))+fzp&
&          (k)*(rud(ite, k-1, j)-rud(ite-1, k-1, j))))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(w_old(&
&          i_end, k, j)-w_old(i_end-1, k, j))+w(i_end, k, j)*(fzm(k)*(ru(&
&          ite, k, j)-ru(ite-1, k, j))+fzp(k)*(ru(ite, k-1, j)-ru(ite-1, &
&          k-1, j))))
      END DO
    END DO
    k = ktf + 1
    DO j=j_start,j_end
      uwd = 0.5*((2.-fzm(k-1))*(rud(ite-1, k-1, j)+rud(ite, k-1, j))-fzp&
&        (k-1)*(rud(ite-1, k-2, j)+rud(ite, k-2, j)))
      uw = 0.5*((2.-fzm(k-1))*(ru(ite-1, k-1, j)+ru(ite, k-1, j))-fzp(k-&
&        1)*(ru(ite-1, k-2, j)+ru(ite, k-2, j)))
      IF (uw .LT. 0.) THEN
        ub = 0.
        ubd = 0.0
      ELSE
        ubd = uwd
        ub = uw
      END IF
      tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(w_old(&
&        i_end, k, j)-w_old(i_end-1, k, j))+ub*(w_oldd(i_end, k, j)-&
&        w_oldd(i_end-1, k, j))+wd(i_end, k, j)*((2.-fzm(k-1))*(ru(ite, k&
&        -1, j)-ru(ite-1, k-1, j))-fzp(k-1)*(ru(ite, k-2, j)-ru(ite-1, k-&
&        2, j)))+w(i_end, k, j)*((2.-fzm(k-1))*(rud(ite, k-1, j)-rud(ite-&
&        1, k-1, j))-fzp(k-1)*(rud(ite, k-2, j)-rud(ite-1, k-2, j))))
      tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(w_old(&
&        i_end, k, j)-w_old(i_end-1, k, j))+w(i_end, k, j)*((2.-fzm(k-1))&
&        *(ru(ite, k-1, j)-ru(ite-1, k-1, j))-fzp(k-1)*(ru(ite, k-2, j)-&
&        ru(ite-1, k-2, j))))
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts+1,ktf
        vwd = 0.5*(fzm(k)*(rvd(i, k, jts)+rvd(i, k, jts+1))+fzp(k)*(rvd(&
&          i, k-1, jts)+rvd(i, k-1, jts+1)))
        vw = 0.5*(fzm(k)*(rv(i, k, jts)+rv(i, k, jts+1))+fzp(k)*(rv(i, k&
&          -1, jts)+rv(i, k-1, jts+1)))
        IF (vw .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(w_old(i&
&          , k, jts+1)-w_old(i, k, jts))+vb*(w_oldd(i, k, jts+1)-w_oldd(i&
&          , k, jts))+wd(i, k, jts)*(fzm(k)*(rv(i, k, jts+1)-rv(i, k, jts&
&          ))+fzp(k)*(rv(i, k-1, jts+1)-rv(i, k-1, jts)))+w(i, k, jts)*(&
&          fzm(k)*(rvd(i, k, jts+1)-rvd(i, k, jts))+fzp(k)*(rvd(i, k-1, &
&          jts+1)-rvd(i, k-1, jts))))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(w_old(i, k&
&          , jts+1)-w_old(i, k, jts))+w(i, k, jts)*(fzm(k)*(rv(i, k, jts+&
&          1)-rv(i, k, jts))+fzp(k)*(rv(i, k-1, jts+1)-rv(i, k-1, jts))))
      END DO
    END DO
    k = ktf + 1
    DO i=i_start,i_end
      vwd = 0.5*((2.-fzm(k-1))*(rvd(i, k-1, jts)+rvd(i, k-1, jts+1))-fzp&
&        (k-1)*(rvd(i, k-2, jts)+rvd(i, k-2, jts+1)))
      vw = 0.5*((2.-fzm(k-1))*(rv(i, k-1, jts)+rv(i, k-1, jts+1))-fzp(k-&
&        1)*(rv(i, k-2, jts)+rv(i, k-2, jts+1)))
      IF (vw .GT. 0.) THEN
        vb = 0.
        vbd = 0.0
      ELSE
        vbd = vwd
        vb = vw
      END IF
      tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(w_old(i, k&
&        , jts+1)-w_old(i, k, jts))+vb*(w_oldd(i, k, jts+1)-w_oldd(i, k, &
&        jts))+wd(i, k, jts)*((2.-fzm(k-1))*(rv(i, k-1, jts+1)-rv(i, k-1&
&        , jts))-fzp(k-1)*(rv(i, k-2, jts+1)-rv(i, k-2, jts)))+w(i, k, &
&        jts)*((2.-fzm(k-1))*(rvd(i, k-1, jts+1)-rvd(i, k-1, jts))-fzp(k-&
&        1)*(rvd(i, k-2, jts+1)-rvd(i, k-2, jts))))
      tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(w_old(i, k, &
&        jts+1)-w_old(i, k, jts))+w(i, k, jts)*((2.-fzm(k-1))*(rv(i, k-1&
&        , jts+1)-rv(i, k-1, jts))-fzp(k-1)*(rv(i, k-2, jts+1)-rv(i, k-2&
&        , jts))))
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts+1,ktf
        vwd = 0.5*(fzm(k)*(rvd(i, k, jte-1)+rvd(i, k, jte))+fzp(k)*(rvd(&
&          i, k-1, jte-1)+rvd(i, k-1, jte)))
        vw = 0.5*(fzm(k)*(rv(i, k, jte-1)+rv(i, k, jte))+fzp(k)*(rv(i, k&
&          -1, jte-1)+rv(i, k-1, jte)))
        IF (vw .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          w_old(i, k, j_end)-w_old(i, k, j_end-1))+vb*(w_oldd(i, k, &
&          j_end)-w_oldd(i, k, j_end-1))+wd(i, k, j_end)*(fzm(k)*(rv(i, k&
&          , jte)-rv(i, k, jte-1))+fzp(k)*(rv(i, k-1, jte)-rv(i, k-1, jte&
&          -1)))+w(i, k, j_end)*(fzm(k)*(rvd(i, k, jte)-rvd(i, k, jte-1))&
&          +fzp(k)*(rvd(i, k-1, jte)-rvd(i, k-1, jte-1))))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(w_old(i&
&          , k, j_end)-w_old(i, k, j_end-1))+w(i, k, j_end)*(fzm(k)*(rv(i&
&          , k, jte)-rv(i, k, jte-1))+fzp(k)*(rv(i, k-1, jte)-rv(i, k-1, &
&          jte-1))))
      END DO
    END DO
    k = ktf + 1
    DO i=i_start,i_end
      vwd = 0.5*((2.-fzm(k-1))*(rvd(i, k-1, jte-1)+rvd(i, k-1, jte))-fzp&
&        (k-1)*(rvd(i, k-2, jte-1)+rvd(i, k-2, jte)))
      vw = 0.5*((2.-fzm(k-1))*(rv(i, k-1, jte-1)+rv(i, k-1, jte))-fzp(k-&
&        1)*(rv(i, k-2, jte-1)+rv(i, k-2, jte)))
      IF (vw .LT. 0.) THEN
        vb = 0.
        vbd = 0.0
      ELSE
        vbd = vwd
        vb = vw
      END IF
      tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(w_old(&
&        i, k, j_end)-w_old(i, k, j_end-1))+vb*(w_oldd(i, k, j_end)-&
&        w_oldd(i, k, j_end-1))+wd(i, k, j_end)*((2.-fzm(k-1))*(rv(i, k-1&
&        , jte)-rv(i, k-1, jte-1))-fzp(k-1)*(rv(i, k-2, jte)-rv(i, k-2, &
&        jte-1)))+w(i, k, j_end)*((2.-fzm(k-1))*(rvd(i, k-1, jte)-rvd(i, &
&        k-1, jte-1))-fzp(k-1)*(rvd(i, k-2, jte)-rvd(i, k-2, jte-1))))
      tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(w_old(i, &
&        k, j_end)-w_old(i, k, j_end-1))+w(i, k, j_end)*((2.-fzm(k-1))*(&
&        rv(i, k-1, jte)-rv(i, k-1, jte-1))-fzp(k-1)*(rv(i, k-2, jte)-rv(&
&        i, k-2, jte-1))))
    END DO
  END IF
!-------------------- vertical advection
!     ADT eqn 46 has 3rd term on RHS (dividing through by my) = - partial d/dz (w rho w /my)
!     Here we have:  - partial d/dz (w*rom) = - partial d/dz (w rho w / my)
!     Therefore we don't need to make a correction for advect_w
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  IF (vert_order .EQ. 6) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          vfluxd(i, k) = veld*(37.*(w(i, k, j)+w(i, k-1, j))-8.*(w(i, k+&
&            1, j)+w(i, k-2, j))+(w(i, k+2, j)+w(i, k-3, j)))/60.0 + vel*&
&            (37.*(wd(i, k, j)+wd(i, k-1, j))-8.*(wd(i, k+1, j)+wd(i, k-2&
&            , j))+wd(i, k+2, j)+wd(i, k-3, j))/60.0
          vflux(i, k) = vel*((37.*(w(i, k, j)+w(i, k-1, j))-8.*(w(i, k+1&
&            , j)+w(i, k-2, j))+(w(i, k+2, j)+w(i, k-3, j)))/60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        vfluxd(i, k) = veld*(7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+&
&          w(i, k-2, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k-1, j))-wd(i&
&          , k+1, j)-wd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&          (i, k-2, j)))/12.0)
        k = ktf
        veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        vfluxd(i, k) = veld*(7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+&
&          w(i, k-2, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k-1, j))-wd(i&
&          , k+1, j)-wd(i, k-2, j))/12.0
        vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&          (i, k-2, j)))/12.0)
        k = ktf + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
! pick up flux contribution for w at the lid. wcs, 13 march 2004
      k = ktf + 1
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i&
&          , k)
        tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+3,ktf-1
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          vfluxd(i, k) = veld*((37.*(w(i, k, j)+w(i, k-1, j))-8.*(w(i, k&
&            +1, j)+w(i, k-2, j))+(w(i, k+2, j)+w(i, k-3, j)))/60.0-SIGN(&
&            1, time_step)*SIGN(1., -vel)*(w(i, k+2, j)-w(i, k-3, j)-5.*(&
&            w(i, k+1, j)-w(i, k-2, j))+10.*(w(i, k, j)-w(i, k-1, j)))/&
&            60.0) + vel*((37.*(wd(i, k, j)+wd(i, k-1, j))-8.*(wd(i, k+1&
&            , j)+wd(i, k-2, j))+wd(i, k+2, j)+wd(i, k-3, j))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(wd(i, k+2, j)-wd(i, k-3, j)-5.*&
&            (wd(i, k+1, j)-wd(i, k-2, j))+10.*(wd(i, k, j)-wd(i, k-1, j)&
&            ))/60.0)
          vflux(i, k) = vel*((37.*(w(i, k, j)+w(i, k-1, j))-8.*(w(i, k+1&
&            , j)+w(i, k-2, j))+(w(i, k+2, j)+w(i, k-3, j)))/60.0-SIGN(1&
&            , time_step)*SIGN(1., -vel)*(w(i, k+2, j)-w(i, k-3, j)-5.*(w&
&            (i, k+1, j)-w(i, k-2, j))+10.*(w(i, k, j)-w(i, k-1, j)))/&
&            60.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
        k = kts + 2
        veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        vfluxd(i, k) = veld*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)&
&          +w(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k&
&          +1, j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0) + vel*&
&          ((7.*(wd(i, k, j)+wd(i, k-1, j))-wd(i, k+1, j)-wd(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(wd(i, k+1, j)-wd(i, k-&
&          2, j)-3.*(wd(i, k, j)-wd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1&
&          , j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0)
        k = ktf
        veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        vfluxd(i, k) = veld*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)&
&          +w(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k&
&          +1, j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0) + vel*&
&          ((7.*(wd(i, k, j)+wd(i, k-1, j))-wd(i, k+1, j)-wd(i, k-2, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., -vel)*(wd(i, k+1, j)-wd(i, k-&
&          2, j)-3.*(wd(i, k, j)-wd(i, k-1, j)))/12.0)
        vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&          (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1&
&          , j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0)
        k = ktf + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i&
&          , k)
        tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          vfluxd(i, k) = veld*(7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j&
&            )+w(i, k-2, j)))/12.0 + vel*(7.*(wd(i, k, j)+wd(i, k-1, j))-&
&            wd(i, k+1, j)-wd(i, k-2, j))/12.0
          vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)&
&            +w(i, k-2, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
        k = ktf + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i&
&          , k)
        tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+2,ktf
        DO i=i_start,i_end
          veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          vfluxd(i, k) = veld*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, &
&            j)+w(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(&
&            i, k+1, j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0) &
&            + vel*((7.*(wd(i, k, j)+wd(i, k-1, j))-wd(i, k+1, j)-wd(i, k&
&            -2, j))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(wd(i, k+1, j&
&            )-wd(i, k-2, j)-3.*(wd(i, k, j)-wd(i, k-1, j)))/12.0)
          vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)&
&            +w(i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i&
&            , k+1, j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
        k = ktf + 1
        vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)&
&          +w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i&
&          , k-1, j)))
        vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i&
&          , k-1, j))
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i&
&          , k)
        tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxd = 0.0
    DO j=j_start,j_end
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
          vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, &
&            j)+w(i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+&
&            wd(i, k-1, j)))
          vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w&
&            (i, k-1, j))
        END DO
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k&
&            +1)-vfluxd(i, k))
          tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)&
&            -vflux(i, k))
        END DO
      END DO
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i&
&          , k)
        tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
      END DO
    END DO
  ELSE
    WRITE(wrf_err_message, *) ' advect_w, v_order not known ', &
&    vert_order
    CALL WRF_ERROR_FATAL(wrf_err_message)
  END IF
END SUBROUTINE G_ADVECT_W

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_scalar_pd in forward (tangent) mode:
!   variations   of useful results: tendency h_tendency z_tendency
!   with respect to varying inputs: rom field tendency h_tendency
!                z_tendency ru rv mu_old field_old mut
!   RW status of diff variables: rom:in field:in tendency:in-out
!                h_tendency:in-out z_tendency:in-out ru:in rv:in
!                mu_old:in field_old:in mut:in
SUBROUTINE G_ADVECT_SCALAR_PD(field, fieldd, field_old, field_oldd, &
&  tendency, tendencyd, h_tendency, h_tendencyd, z_tendency, z_tendencyd&
&  , ru, rud, rv, rvd, rom, romd, mut, mutd, mub, mu_old, mu_oldd, &
&  time_step, config_flags, tenddec, msfux, msfuy, msfvx, msfvy, msftx, &
&  msfty, fzm, fzp, rdx, rdy, rdzw, dt, ids, ide, jds, jde, kds, kde, ims&
&  , ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
! tendency flag
  LOGICAL, INTENT(IN) :: tenddec
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: field, &
&  field_old, ru, rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: fieldd, &
&  field_oldd, rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut, mub, mu_old
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd, mu_oldd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: h_tendency&
&  , z_tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: h_tendencyd&
&  , z_tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy, dt
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw, mu
  REAL :: ubd, vbd, mud
!  storage for high and low order fluxes
  REAL, DIMENSION(its - 1:ite + 2, kts:kte, jts - 1:jte + 2) :: fqx, fqy&
&  , fqz
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: fqxd, fqyd, fqzd
  REAL, DIMENSION(its - 1:ite + 2, kts:kte, jts - 1:jte + 2) :: fqxl, &
&  fqyl, fqzl
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: fqxld, fqyld, &
&  fqzld
  INTEGER :: horz_order, vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: flux_out, ph_low
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: flux_outd, ph_lowd
  REAL :: scale
  REAL :: scaled
  REAL, PARAMETER :: eps=1.e-20
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6, flux_upwind
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
  REAL :: veld, crd
!      flux_upwind(q_im1, q_i, cr ) = 0.5*(1.+sign(1.,cr))*q_im1 &
!                                    +0.5*(1.-sign(1.,cr))*q_i
!      flux_upwind(q_im1, q_i, cr ) = 0.
  REAL :: dx, dy, dz
  LOGICAL, PARAMETER :: pd_limit=.true.
  REAL :: abs30
  REAL :: y93
  REAL :: max43
  REAL :: abs67
  REAL :: abs100
  REAL :: abs18d
  REAL :: y92
  REAL :: max42
  REAL :: abs66
  REAL :: abs26d
  REAL :: max39d
  REAL :: y91
  REAL :: max41
  REAL :: abs65
  REAL :: y28d
  REAL :: abs34d
  REAL :: min5d
  REAL :: max10d
  REAL :: max47d
  REAL :: y90
  REAL :: max40
  REAL :: abs64
  REAL :: abs79d
  REAL :: y36d
  REAL :: abs42d
  REAL :: abs63
  REAL :: abs87d
  REAL :: y44d
  REAL :: abs50d
  REAL :: abs62
  REAL :: abs99
  REAL :: min37d
  REAL :: y52d
  REAL :: y89d
  REAL :: abs95d
  REAL :: abs61
  REAL :: abs98
  REAL :: y4d
  REAL :: y60d
  REAL :: y97d
  INTEGER :: min39
  REAL :: abs60
  REAL :: abs97
  INTEGER :: min9
  REAL :: min38
  REAL :: abs96
  REAL :: abs29d
  REAL :: min61d
  REAL :: abs102d
  INTEGER :: min8
  REAL :: min37
  REAL :: abs95
  REAL :: max13d
  REAL :: abs37d
  REAL :: min7
  REAL :: min36
  REAL :: abs94
  REAL :: max21d
  REAL :: abs1d
  REAL :: y39d
  REAL :: abs45d
  REAL :: min6
  INTEGER :: min35
  REAL :: y29
  REAL :: abs93
  REAL :: abs53d
  REAL :: y10d
  REAL :: y47d
  REAL :: min5
  INTEGER :: min34
  REAL :: y28
  REAL :: abs92
  REAL :: y55d
  REAL :: abs61d
  REAL :: abs98d
  REAL :: min4
  REAL :: min33
  REAL :: y27
  REAL :: abs91
  REAL :: y63d
  REAL :: min48d
  REAL :: max2d
  REAL :: y7d
  REAL :: min11d
  REAL :: min3
  REAL :: min32
  REAL :: y26
  REAL :: min69
  REAL :: abs90
  REAL :: y71d
  REAL :: min56d
  INTEGER :: min2
  REAL :: min31
  REAL :: y25
  REAL :: min68
  REAL :: min64d
  INTEGER :: min1
  INTEGER :: min30
  REAL :: y24
  REAL :: min67
  REAL :: max16d
  REAL :: y23
  REAL :: min66
  REAL :: abs11d
  REAL :: max24d
  REAL :: abs4d
  REAL :: abs48d
  REAL :: y22
  REAL :: min65
  REAL :: y59
  REAL :: y13d
  REAL :: max32d
  REAL :: abs56d
  REAL :: y21
  REAL :: min64
  REAL :: y58
  REAL :: abs64d
  REAL :: y21d
  REAL :: y58d
  REAL :: max40d
  REAL :: y20
  REAL :: min63
  REAL :: y57
  REAL :: y66d
  REAL :: abs72d
  REAL :: max5d
  REAL :: min14d
  REAL :: min62
  REAL :: y56
  REAL :: y74d
  REAL :: abs80d
  REAL :: min59d
  REAL :: y102d
  REAL :: min61
  REAL :: y55
  REAL :: abs29
  REAL :: y82d
  REAL :: min67d
  REAL :: min60
  REAL :: y54
  REAL :: abs28
  REAL :: max19d
  REAL :: y90d
  REAL :: min75d
  REAL :: y53
  REAL :: abs27
  REAL :: abs14d
  REAL :: max27d
  REAL :: abs7d
  REAL :: y52
  REAL :: abs26
  REAL :: y89
  REAL :: max39
  REAL :: y16d
  REAL :: abs22d
  REAL :: max35d
  REAL :: abs59d
  REAL :: y51
  REAL :: abs25
  REAL :: y88
  REAL :: max38
  REAL :: abs67d
  REAL :: y24d
  REAL :: abs30d
  REAL :: max43d
  REAL :: y50
  REAL :: abs24
  REAL :: y87
  REAL :: max37
  REAL :: min17d
  REAL :: y69d
  REAL :: abs75d
  REAL :: y32d
  REAL :: max8d
  REAL :: max51d
  REAL :: abs23
  REAL :: y86
  REAL :: max36
  REAL :: min25d
  REAL :: y77d
  REAL :: abs83d
  REAL :: y40d
  REAL :: abs22
  REAL :: y85
  REAL :: max35
  REAL :: abs59
  REAL :: min33d
  REAL :: y85d
  REAL :: abs91d
  REAL :: abs21
  REAL :: y84
  REAL :: max34
  REAL :: abs58
  REAL :: min41d
  REAL :: y93d
  REAL :: abs20
  REAL :: y83
  REAL :: max33
  REAL :: abs57
  REAL :: abs17d
  REAL :: y82
  REAL :: max32
  REAL :: abs56
  REAL :: y19d
  REAL :: abs25d
  REAL :: max38d
  REAL :: y81
  REAL :: max31
  REAL :: abs55
  REAL :: y27d
  REAL :: abs33d
  REAL :: min4d
  REAL :: max46d
  REAL :: y80
  REAL :: max30
  REAL :: abs54
  REAL :: abs78d
  REAL :: y35d
  REAL :: abs41d
  REAL :: max54d
  REAL :: abs53
  REAL :: min28d
  REAL :: abs86d
  REAL :: y43d
  REAL :: abs52
  REAL :: abs89
  REAL :: min36d
  REAL :: y88d
  REAL :: abs94d
  REAL :: y51d
  REAL :: abs51
  REAL :: abs88
  REAL :: y3d
  REAL :: y96d
  INTEGER :: min29
  REAL :: abs50
  REAL :: abs87
  REAL :: min52d
  REAL :: min28
  REAL :: abs86
  REAL :: abs28d
  REAL :: min60d
  REAL :: abs101d
  REAL :: min27
  REAL :: abs85
  REAL :: max12d
  REAL :: min7d
  REAL :: abs36d
  REAL :: max49d
  REAL :: min26
  REAL :: abs84
  REAL :: max20d
  REAL :: y38d
  REAL :: abs44d
  REAL :: min25
  REAL :: y19
  REAL :: abs83
  REAL :: abs52d
  REAL :: abs89d
  REAL :: y46d
  REAL :: min24
  REAL :: y18
  REAL :: abs82
  REAL :: y54d
  REAL :: abs60d
  REAL :: abs97d
  INTEGER :: min23
  REAL :: y17
  REAL :: abs81
  REAL :: y62d
  REAL :: min47d
  REAL :: y6d
  REAL :: min10d
  REAL :: y99d
  REAL :: max1d
  INTEGER :: min22
  REAL :: y16
  REAL :: min59
  REAL :: abs80
  REAL :: y70d
  REAL :: min55d
  REAL :: y15
  REAL :: min21
  REAL :: min58
  REAL :: min63d
  REAL :: y14
  REAL :: min20
  REAL :: min57
  REAL :: max15d
  REAL :: abs39d
  REAL :: min71d
  REAL :: y13
  REAL :: min56
  REAL :: max23d
  REAL :: abs3d
  REAL :: abs10d
  REAL :: abs47d
  REAL :: y12
  REAL :: min55
  REAL :: y49
  REAL :: y12d
  REAL :: max31d
  REAL :: abs55d
  REAL :: y49d
  REAL :: y11
  INTEGER :: min54
  REAL :: y48
  REAL :: abs63d
  REAL :: y20d
  REAL :: y57d
  REAL :: y10
  INTEGER :: min53
  REAL :: y47
  REAL :: y65d
  REAL :: abs71d
  REAL :: max4d
  REAL :: y9d
  REAL :: min13d
  REAL :: min52
  REAL :: y46
  REAL :: min21d
  REAL :: y73d
  REAL :: min58d
  REAL :: y101d
  REAL :: min51
  REAL :: y45
  REAL :: abs19
  REAL :: y81d
  REAL :: min66d
  INTEGER :: min50
  REAL :: y44
  REAL :: abs18
  REAL :: max18d
  REAL :: min74d
  REAL :: y43
  REAL :: abs17
  REAL :: abs13d
  REAL :: max26d
  REAL :: abs6d
  REAL :: y42
  REAL :: abs16
  REAL :: y79
  REAL :: max29
  REAL :: y15d
  REAL :: abs21d
  REAL :: max34d
  REAL :: abs58d
  REAL :: y41
  REAL :: abs15
  REAL :: y78
  REAL :: max28
  REAL :: abs66d
  REAL :: y23d
  REAL :: max42d
  REAL :: y40
  REAL :: abs14
  REAL :: y77
  REAL :: max27
  REAL :: y68d
  REAL :: abs74d
  REAL :: y31d
  REAL :: max7d
  REAL :: max50d
  REAL :: abs13
  REAL :: y76
  REAL :: max26
  REAL :: min24d
  REAL :: y76d
  REAL :: abs82d
  REAL :: abs12
  REAL :: y75
  REAL :: max25
  REAL :: abs49
  REAL :: min32d
  REAL :: y84d
  REAL :: abs90d
  REAL :: min69d
  REAL :: abs11
  REAL :: y74
  REAL :: max24
  REAL :: abs48
  REAL :: y102
  REAL :: y92d
  REAL :: abs10
  REAL :: y73
  REAL :: max23
  REAL :: abs47
  REAL :: y101
  REAL :: abs16d
  REAL :: max29d
  REAL :: abs9d
  REAL :: y72
  REAL :: max22
  REAL :: abs46
  REAL :: y100
  REAL :: y18d
  REAL :: abs24d
  REAL :: max37d
  REAL :: y71
  REAL :: max21
  REAL :: abs45
  REAL :: abs69d
  REAL :: y26d
  REAL :: abs32d
  REAL :: min3d
  REAL :: max45d
  REAL :: y70
  REAL :: max20
  REAL :: abs44
  REAL :: min19d
  REAL :: abs77d
  REAL :: y34d
  REAL :: abs40d
  REAL :: max53d
  REAL :: abs43
  REAL :: min27d
  REAL :: y79d
  REAL :: abs85d
  REAL :: y42d
  REAL :: abs42
  REAL :: abs79
  REAL :: y87d
  REAL :: abs93d
  REAL :: y50d
  REAL :: abs41
  REAL :: abs78
  REAL :: max54
  REAL :: min43d
  REAL :: y2d
  REAL :: y95d
  REAL :: min19
  REAL :: abs40
  REAL :: abs77
  REAL :: max53
  REAL :: abs19d
  REAL :: min51d
  REAL :: min18
  REAL :: max52
  REAL :: abs76
  REAL :: abs27d
  REAL :: abs100d
  REAL :: min17
  REAL :: max51
  REAL :: abs75
  REAL :: y29d
  REAL :: min6d
  REAL :: max11d
  REAL :: abs35d
  REAL :: max48d
  INTEGER :: min16
  REAL :: abs9
  REAL :: max50
  REAL :: abs74
  REAL :: y37d
  REAL :: abs43d
  INTEGER :: min15
  REAL :: abs8
  REAL :: abs73
  REAL :: abs88d
  REAL :: y45d
  REAL :: abs51d
  REAL :: min14
  REAL :: abs7
  REAL :: abs72
  REAL :: min38d
  REAL :: y53d
  REAL :: abs96d
  REAL :: min13
  REAL :: abs6
  REAL :: abs71
  REAL :: min46d
  REAL :: y5d
  REAL :: y61d
  REAL :: y98d
  REAL :: min12
  INTEGER :: min49
  REAL :: abs5
  REAL :: abs70
  REAL :: min11
  REAL :: min48
  REAL :: abs4
  REAL :: min62d
  REAL :: min10
  REAL :: min47
  REAL :: abs3
  REAL :: max14d
  REAL :: abs38d
  REAL :: min70d
  REAL :: min46
  REAL :: abs2
  REAL :: max22d
  REAL :: abs2d
  REAL :: abs46d
  INTEGER :: min45
  REAL :: y39
  REAL :: abs1
  REAL :: y11d
  REAL :: max30d
  REAL :: abs54d
  REAL :: y48d
  INTEGER :: min44
  REAL :: y38
  REAL :: abs62d
  REAL :: y56d
  REAL :: abs99d
  REAL :: min43
  REAL :: y37
  REAL :: y64d
  REAL :: abs70d
  REAL :: max3d
  REAL :: y8d
  REAL :: min12d
  REAL :: min42
  REAL :: y36
  REAL :: min20d
  REAL :: y72d
  REAL :: min57d
  REAL :: y100d
  REAL :: min41
  REAL :: y35
  REAL :: y80d
  REAL :: min65d
  INTEGER :: min40
  REAL :: y34
  REAL :: max17d
  REAL :: y33
  REAL :: max9
  REAL :: min76
  REAL :: abs12d
  REAL :: max25d
  REAL :: abs5d
  REAL :: abs49d
  REAL :: y32
  REAL :: max8
  REAL :: y69
  REAL :: max19
  REAL :: min75
  REAL :: y14d
  REAL :: abs20d
  REAL :: max33d
  REAL :: abs57d
  REAL :: y31
  REAL :: max7
  REAL :: y68
  REAL :: max18
  REAL :: min74
  REAL :: abs65d
  REAL :: y22d
  REAL :: y59d
  REAL :: max41d
  REAL :: y30
  INTEGER :: min73
  REAL :: max6
  REAL :: y67
  REAL :: max17
  REAL :: y67d
  REAL :: abs73d
  REAL :: y30d
  REAL :: max6d
  INTEGER :: min72
  REAL :: max5
  REAL :: y66
  REAL :: max16
  REAL :: y75d
  REAL :: abs81d
  REAL :: y9
  REAL :: min71
  REAL :: max4
  REAL :: y65
  REAL :: max15
  REAL :: abs39
  REAL :: min31d
  REAL :: y83d
  REAL :: min68d
  REAL :: y8
  REAL :: min70
  REAL :: max3
  REAL :: y64
  REAL :: max14
  REAL :: abs38
  REAL :: y91d
  REAL :: min76d
  REAL :: y7
  REAL :: max2
  REAL :: y63
  REAL :: max13
  REAL :: abs37
  REAL :: abs15d
  REAL :: max28d
  REAL :: abs8d
  REAL :: y6
  REAL :: max1
  REAL :: y62
  REAL :: max12
  REAL :: abs36
  REAL :: y99
  REAL :: max49
  REAL :: y17d
  REAL :: abs23d
  REAL :: max36d
  REAL :: y5
  REAL :: y61
  REAL :: max11
  REAL :: abs35
  REAL :: y98
  REAL :: max48
  REAL :: abs68d
  REAL :: y25d
  REAL :: abs31d
  REAL :: max44d
  REAL :: y4
  REAL :: y60
  REAL :: max10
  REAL :: abs34
  REAL :: y97
  REAL :: max47
  REAL :: min18d
  REAL :: abs76d
  REAL :: y33d
  REAL :: max9d
  REAL :: max52d
  REAL :: y3
  REAL :: abs33
  REAL :: y96
  REAL :: max46
  REAL :: min26d
  REAL :: y78d
  REAL :: abs84d
  REAL :: y41d
  REAL :: y2
  REAL :: abs32
  REAL :: y95
  REAL :: max45
  REAL :: abs69
  REAL :: abs102
  REAL :: y86d
  REAL :: abs92d
  REAL :: y1
  REAL :: abs31
  REAL :: y94
  REAL :: max44
  REAL :: abs68
  REAL :: abs101
  REAL :: min42d
  REAL :: y1d
  REAL :: y94d





! set order for the advection schemes
!  write(6,*) ' in pd advection routine '
! Empty arrays just in case:
  IF (config_flags%polar) THEN
    fqx(:, :, :) = 0.
    fqy(:, :, :) = 0.
    fqz(:, :, :) = 0.
    fqxl(:, :, :) = 0.
    fqyl(:, :, :) = 0.
    fqzl(:, :, :) = 0.
  END IF
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_sca_adv_order
  vert_order = config_flags%v_sca_adv_order
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
  degrade_xs = .true.
  degrade_xe = .true.
  degrade_ys = .true.
  degrade_ye = .true.
!  begin with horizontal flux divergence
!  here is the choice of flux operators
  IF (horz_order .EQ. 6) THEN
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 4) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min1 = ide - 1
    ELSE
      min1 = ite
    END IF
    i_end = min1 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min2 = jde - 1
    ELSE
      min2 = jte
    END IF
    j_end = min2 + 1
    j_start_f = j_start
    j_end_f = j_end + 1
!--  modify loop bounds if open or specified
!      IF(degrade_xs) i_start = MAX(its-1,ids-1)
!      IF(degrade_xe) i_end   = MIN(ite+1,ide-2)
    IF (degrade_xs) THEN
      IF (its - 1 .LT. ids) THEN
        i_start = ids
      ELSE
        i_start = its - 1
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ite + 1 .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite + 1
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts - 1
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte + 1
      END IF
      j_end_f = jde - 3
      fqyld = 0.0
      fqyd = 0.0
    ELSE
      fqyld = 0.0
      fqyd = 0.0
    END IF
!  compute fluxes, 6th order
j_loop_y_flux_6:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs1d = crd
              abs1 = cr
            ELSE
              abs1d = -crd
              abs1 = -cr
            END IF
            y1d = crd + abs1d
            y1 = cr + abs1
            IF (1.0 .GT. y1) THEN
              min3d = y1d
              min3 = y1
            ELSE
              min3 = 1.0
              min3d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs52d = crd
              abs52 = cr
            ELSE
              abs52d = -crd
              abs52 = -cr
            END IF
            y52d = crd - abs52d
            y52 = cr - abs52
            IF (-1.0 .LT. y52) THEN
              max2d = y52d
              max2 = y52
            ELSE
              max2 = -1.0
              max2d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min3*field_old(i, k, j-1)+0.5*&
&              max2*field_old(i, k, j))+mu*(0.5*(min3d*field_old(i, k, j-&
&              1)+min3*field_oldd(i, k, j-1))+0.5*(max2d*field_old(i, k, &
&              j)+max2*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min3*field_old(i, k, j-1)+&
&              0.5*max2*field_old(i, k, j))
            fqyd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i, k, j-&
&              1))-2./15.*(field(i, k, j+1)+field(i, k, j-2))+1./60.*(&
&              field(i, k, j+2)+field(i, k, j-3))) + vel*(37.*(fieldd(i, &
&              k, j)+fieldd(i, k, j-1))/60.-2.*(fieldd(i, k, j+1)+fieldd(&
&              i, k, j-2))/15.+(fieldd(i, k, j+2)+fieldd(i, k, j-3))/60.)
            fqy(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i, k, j-1)&
&              )-2./15.*(field(i, k, j+1)+field(i, k, j-2))+1./60.*(field&
&              (i, k, j+2)+field(i, k, j-3)))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs2d = crd
              abs2 = cr
            ELSE
              abs2d = -crd
              abs2 = -cr
            END IF
            y2d = crd + abs2d
            y2 = cr + abs2
            IF (1.0 .GT. y2) THEN
              min4d = y2d
              min4 = y2
            ELSE
              min4 = 1.0
              min4d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs53d = crd
              abs53 = cr
            ELSE
              abs53d = -crd
              abs53 = -cr
            END IF
            y53d = crd - abs53d
            y53 = cr - abs53
            IF (-1.0 .LT. y53) THEN
              max3d = y53d
              max3 = y53
            ELSE
              max3 = -1.0
              max3d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min4*field_old(i, k, j-1)+0.5*&
&              max3*field_old(i, k, j))+mu*(0.5*(min4d*field_old(i, k, j-&
&              1)+min4*field_oldd(i, k, j-1))+0.5*(max3d*field_old(i, k, &
&              j)+max3*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min4*field_old(i, k, j-1)+&
&              0.5*max3*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs3d = crd
              abs3 = cr
            ELSE
              abs3d = -crd
              abs3 = -cr
            END IF
            y3d = crd + abs3d
            y3 = cr + abs3
            IF (1.0 .GT. y3) THEN
              min5d = y3d
              min5 = y3
            ELSE
              min5 = 1.0
              min5d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs54d = crd
              abs54 = cr
            ELSE
              abs54d = -crd
              abs54 = -cr
            END IF
            y54d = crd - abs54d
            y54 = cr - abs54
            IF (-1.0 .LT. y54) THEN
              max4d = y54d
              max4 = y54
            ELSE
              max4 = -1.0
              max4d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min5*field_old(i, k, j-1)+0.5*&
&              max4*field_old(i, k, j))+mu*(0.5*(min5d*field_old(i, k, j-&
&              1)+min5*field_oldd(i, k, j-1))+0.5*(max4d*field_old(i, k, &
&              j)+max4*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min5*field_old(i, k, j-1)+&
&              0.5*max4*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))) + vel*(7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+&
&              fieldd(i, k, j-2))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2)))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs4d = crd
              abs4 = cr
            ELSE
              abs4d = -crd
              abs4 = -cr
            END IF
            y4d = crd + abs4d
            y4 = cr + abs4
            IF (1.0 .GT. y4) THEN
              min6d = y4d
              min6 = y4
            ELSE
              min6 = 1.0
              min6d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs55d = crd
              abs55 = cr
            ELSE
              abs55d = -crd
              abs55 = -cr
            END IF
            y55d = crd - abs55d
            y55 = cr - abs55
            IF (-1.0 .LT. y55) THEN
              max5d = y55d
              max5 = y55
            ELSE
              max5 = -1.0
              max5d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min6*field_old(i, k, j-1)+0.5*&
&              max5*field_old(i, k, j))+mu*(0.5*(min6d*field_old(i, k, j-&
&              1)+min6*field_oldd(i, k, j-1))+0.5*(max5d*field_old(i, k, &
&              j)+max5*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min6*field_old(i, k, j-1)+&
&              0.5*max5*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs5d = crd
              abs5 = cr
            ELSE
              abs5d = -crd
              abs5 = -cr
            END IF
            y5d = crd + abs5d
            y5 = cr + abs5
            IF (1.0 .GT. y5) THEN
              min7d = y5d
              min7 = y5
            ELSE
              min7 = 1.0
              min7d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs56d = crd
              abs56 = cr
            ELSE
              abs56d = -crd
              abs56 = -cr
            END IF
            y56d = crd - abs56d
            y56 = cr - abs56
            IF (-1.0 .LT. y56) THEN
              max6d = y56d
              max6 = y56
            ELSE
              max6 = -1.0
              max6d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min7*field_old(i, k, j-1)+0.5*&
&              max6*field_old(i, k, j))+mu*(0.5*(min7d*field_old(i, k, j-&
&              1)+min7*field_oldd(i, k, j-1))+0.5*(max6d*field_old(i, k, &
&              j)+max6*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min7*field_old(i, k, j-1)+&
&              0.5*max6*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))) + vel*(7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+&
&              fieldd(i, k, j-2))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2)))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      END IF
    END DO j_loop_y_flux_6
!  next, x flux
!--  these bounds are for periodic and sym conditions
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min8 = ide - 1
    ELSE
      min8 = ite
    END IF
    i_end = min8 + 1
    i_start_f = i_start
    i_end_f = i_end + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min9 = jde - 1
    ELSE
      min9 = jte
    END IF
    j_end = min9 + 1
!--  modify loop bounds for open and specified b.c
!      IF(degrade_ys) j_start = MAX(jts-1,jds+1)
!      IF(degrade_ye) j_end   = MIN(jte+1,jde-2)
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds) THEN
        j_start = jds
      ELSE
        j_start = jts - 1
      END IF
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte + 1
      END IF
    END IF
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its - 1) THEN
        i_start = its - 1
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = ids + 3
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite + 1) THEN
        i_end = ite + 1
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxld = 0.0
      fqxd = 0.0
    ELSE
      fqxld = 0.0
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          mud = 0.5*(mutd(i, j)+mutd(i-1, j))
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs6d = crd
            abs6 = cr
          ELSE
            abs6d = -crd
            abs6 = -cr
          END IF
          y6d = crd + abs6d
          y6 = cr + abs6
          IF (1.0 .GT. y6) THEN
            min10d = y6d
            min10 = y6
          ELSE
            min10 = 1.0
            min10d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs57d = crd
            abs57 = cr
          ELSE
            abs57d = -crd
            abs57 = -cr
          END IF
          y57d = crd - abs57d
          y57 = cr - abs57
          IF (-1.0 .LT. y57) THEN
            max7d = y57d
            max7 = y57
          ELSE
            max7 = -1.0
            max7d = 0.0
          END IF
          fqxld(i, k, j) = dx*(mud*(0.5*min10*field_old(i-1, k, j)+0.5*&
&            max7*field_old(i, k, j))+mu*(0.5*(min10d*field_old(i-1, k, j&
&            )+min10*field_oldd(i-1, k, j))+0.5*(max7d*field_old(i, k, j)&
&            +max7*field_oldd(i, k, j))))/dt
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min10*field_old(i-1, k, j)+0.5&
&            *max7*field_old(i, k, j))
          fqxd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i-1, k, j)&
&            )-2./15.*(field(i+1, k, j)+field(i-2, k, j))+1./60.*(field(i&
&            +2, k, j)+field(i-3, k, j))) + vel*(37.*(fieldd(i, k, j)+&
&            fieldd(i-1, k, j))/60.-2.*(fieldd(i+1, k, j)+fieldd(i-2, k, &
&            j))/15.+(fieldd(i+2, k, j)+fieldd(i-3, k, j))/60.)
          fqx(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i-1, k, j))-&
&            2./15.*(field(i+1, k, j)+field(i-2, k, j))+1./60.*(field(i+2&
&            , k, j)+field(i-3, k, j)))
          fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = (rud(i, k, j)*mu-ru(i, k, j)*mud)/mu**2
              vel = ru(i, k, j)/mu
              crd = dt*veld/dx
              cr = vel*dt/dx
              IF (cr .GE. 0.) THEN
                abs7d = crd
                abs7 = cr
              ELSE
                abs7d = -crd
                abs7 = -cr
              END IF
              y7d = crd + abs7d
              y7 = cr + abs7
              IF (1.0 .GT. y7) THEN
                min11d = y7d
                min11 = y7
              ELSE
                min11 = 1.0
                min11d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs58d = crd
                abs58 = cr
              ELSE
                abs58d = -crd
                abs58 = -cr
              END IF
              y58d = crd - abs58d
              y58 = cr - abs58
              IF (-1.0 .LT. y58) THEN
                max8d = y58d
                max8 = y58
              ELSE
                max8 = -1.0
                max8d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min11*field_old(i-1, k, j)+&
&                0.5*max8*field_old(i, k, j))+mu*(0.5*(min11d*field_old(i&
&                -1, k, j)+min11*field_oldd(i-1, k, j))+0.5*(max8d*&
&                field_old(i, k, j)+max8*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min11*field_old(i-1, k, j)&
&                +0.5*max8*field_old(i, k, j))
              fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-&
&                1, k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)&
&                ))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! fourth order
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs8d = crd
                abs8 = cr
              ELSE
                abs8d = -crd
                abs8 = -cr
              END IF
              y8d = crd + abs8d
              y8 = cr + abs8
              IF (1.0 .GT. y8) THEN
                min12d = y8d
                min12 = y8
              ELSE
                min12 = 1.0
                min12d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs59d = crd
                abs59 = cr
              ELSE
                abs59d = -crd
                abs59 = -cr
              END IF
              y59d = crd - abs59d
              y59 = cr - abs59
              IF (-1.0 .LT. y59) THEN
                max9d = y59d
                max9 = y59
              ELSE
                max9 = -1.0
                max9d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min12*field_old(i-1, k, j)+&
&                0.5*max9*field_old(i, k, j))+mu*(0.5*(min12d*field_old(i&
&                -1, k, j)+min12*field_oldd(i-1, k, j))+0.5*(max9d*&
&                field_old(i, k, j)+max9*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min12*field_old(i-1, k, j)&
&                +0.5*max9*field_old(i, k, j))
              fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k&
&                , j))-1./12.*(field(i+1, k, j)+field(i-2, k, j))) + vel*&
&                (7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1&
&                , k, j)+fieldd(i-2, k, j))/12.)
              fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j&
&                ))-1./12.*(field(i+1, k, j)+field(i-2, k, j)))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs9d = crd
                abs9 = cr
              ELSE
                abs9d = -crd
                abs9 = -cr
              END IF
              y9d = crd + abs9d
              y9 = cr + abs9
              IF (1.0 .GT. y9) THEN
                min13d = y9d
                min13 = y9
              ELSE
                min13 = 1.0
                min13d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs60d = crd
                abs60 = cr
              ELSE
                abs60d = -crd
                abs60 = -cr
              END IF
              y60d = crd - abs60d
              y60 = cr - abs60
              IF (-1.0 .LT. y60) THEN
                max10d = y60d
                max10 = y60
              ELSE
                max10 = -1.0
                max10d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min13*field_old(i-1, k, j)+&
&                0.5*max10*field_old(i, k, j))+mu*(0.5*(min13d*field_old(&
&                i-1, k, j)+min13*field_oldd(i-1, k, j))+0.5*(max10d*&
&                field_old(i, k, j)+max10*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min13*field_old(i-1, k, j)&
&                +0.5*max10*field_old(i, k, j))
              fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-&
&                1, k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)&
&                ))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! fourth order flux one in from the boundary
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs10d = crd
                abs10 = cr
              ELSE
                abs10d = -crd
                abs10 = -cr
              END IF
              y10d = crd + abs10d
              y10 = cr + abs10
              IF (1.0 .GT. y10) THEN
                min14d = y10d
                min14 = y10
              ELSE
                min14 = 1.0
                min14d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs61d = crd
                abs61 = cr
              ELSE
                abs61d = -crd
                abs61 = -cr
              END IF
              y61d = crd - abs61d
              y61 = cr - abs61
              IF (-1.0 .LT. y61) THEN
                max11d = y61d
                max11 = y61
              ELSE
                max11 = -1.0
                max11d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min14*field_old(i-1, k, j)+&
&                0.5*max11*field_old(i, k, j))+mu*(0.5*(min14d*field_old(&
&                i-1, k, j)+min14*field_oldd(i-1, k, j))+0.5*(max11d*&
&                field_old(i, k, j)+max11*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min14*field_old(i-1, k, j)&
&                +0.5*max11*field_old(i, k, j))
              fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k&
&                , j))-1./12.*(field(i+1, k, j)+field(i-2, k, j))) + vel*&
&                (7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1&
&                , k, j)+fieldd(i-2, k, j))/12.)
              fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j&
&                ))-1./12.*(field(i+1, k, j)+field(i-2, k, j)))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
        END DO
      END IF
    END DO
  ELSE IF (horz_order .EQ. 5) THEN
! enddo for outer J loop
!--- end of 6th order horizontal flux calculation
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 4) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min15 = ide - 1
    ELSE
      min15 = ite
    END IF
    i_end = min15 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min16 = jde - 1
    ELSE
      min16 = jte
    END IF
    j_end = min16 + 1
    j_start_f = j_start
    j_end_f = j_end + 1
!--  modify loop bounds if open or specified
!      IF(degrade_xs) i_start = MAX(its-1,ids-1)
!      IF(degrade_xe) i_end   = MIN(ite+1,ide-2)
    IF (degrade_xs) THEN
      IF (its - 1 .LT. ids) THEN
        i_start = ids
      ELSE
        i_start = its - 1
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ite + 1 .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite + 1
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts - 1
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte + 1
      END IF
      j_end_f = jde - 3
      fqyld = 0.0
      fqyd = 0.0
    ELSE
      fqyld = 0.0
      fqyd = 0.0
    END IF
!  compute fluxes, 5th order
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs11d = crd
              abs11 = cr
            ELSE
              abs11d = -crd
              abs11 = -cr
            END IF
            y11d = crd + abs11d
            y11 = cr + abs11
            IF (1.0 .GT. y11) THEN
              min17d = y11d
              min17 = y11
            ELSE
              min17 = 1.0
              min17d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs62d = crd
              abs62 = cr
            ELSE
              abs62d = -crd
              abs62 = -cr
            END IF
            y62d = crd - abs62d
            y62 = cr - abs62
            IF (-1.0 .LT. y62) THEN
              max12d = y62d
              max12 = y62
            ELSE
              max12 = -1.0
              max12d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min17*field_old(i, k, j-1)+0.5&
&              *max12*field_old(i, k, j))+mu*(0.5*(min17d*field_old(i, k&
&              , j-1)+min17*field_oldd(i, k, j-1))+0.5*(max12d*field_old(&
&              i, k, j)+max12*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min17*field_old(i, k, j-1)+&
&              0.5*max12*field_old(i, k, j))
            fqyd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i, k, j-&
&              1))-2./15.*(field(i, k, j+1)+field(i, k, j-2))+1./60.*(&
&              field(i, k, j+2)+field(i, k, j-3))-SIGN(1, time_step)*SIGN&
&              (1., vel)*(1./60.)*(field(i, k, j+2)-field(i, k, j-3)-5.*(&
&              field(i, k, j+1)-field(i, k, j-2))+10.*(field(i, k, j)-&
&              field(i, k, j-1)))) + vel*(37.*(fieldd(i, k, j)+fieldd(i, &
&              k, j-1))/60.-2.*(fieldd(i, k, j+1)+fieldd(i, k, j-2))/15.+&
&              (fieldd(i, k, j+2)+fieldd(i, k, j-3))/60.-SIGN(1, &
&              time_step)*SIGN(1., vel)*(fieldd(i, k, j+2)-fieldd(i, k, j&
&              -3)-5.*(fieldd(i, k, j+1)-fieldd(i, k, j-2))+10.*(fieldd(i&
&              , k, j)-fieldd(i, k, j-1)))/60.)
            fqy(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i, k, j-1)&
&              )-2./15.*(field(i, k, j+1)+field(i, k, j-2))+1./60.*(field&
&              (i, k, j+2)+field(i, k, j-3))-SIGN(1, time_step)*SIGN(1., &
&              vel)*(1./60.)*(field(i, k, j+2)-field(i, k, j-3)-5.*(field&
&              (i, k, j+1)-field(i, k, j-2))+10.*(field(i, k, j)-field(i&
&              , k, j-1))))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs12d = crd
              abs12 = cr
            ELSE
              abs12d = -crd
              abs12 = -cr
            END IF
            y12d = crd + abs12d
            y12 = cr + abs12
            IF (1.0 .GT. y12) THEN
              min18d = y12d
              min18 = y12
            ELSE
              min18 = 1.0
              min18d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs63d = crd
              abs63 = cr
            ELSE
              abs63d = -crd
              abs63 = -cr
            END IF
            y63d = crd - abs63d
            y63 = cr - abs63
            IF (-1.0 .LT. y63) THEN
              max13d = y63d
              max13 = y63
            ELSE
              max13 = -1.0
              max13d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min18*field_old(i, k, j-1)+0.5&
&              *max13*field_old(i, k, j))+mu*(0.5*(min18d*field_old(i, k&
&              , j-1)+min18*field_oldd(i, k, j-1))+0.5*(max13d*field_old(&
&              i, k, j)+max13*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min18*field_old(i, k, j-1)+&
&              0.5*max13*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs13d = crd
              abs13 = cr
            ELSE
              abs13d = -crd
              abs13 = -cr
            END IF
            y13d = crd + abs13d
            y13 = cr + abs13
            IF (1.0 .GT. y13) THEN
              min19d = y13d
              min19 = y13
            ELSE
              min19 = 1.0
              min19d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs64d = crd
              abs64 = cr
            ELSE
              abs64d = -crd
              abs64 = -cr
            END IF
            y64d = crd - abs64d
            y64 = cr - abs64
            IF (-1.0 .LT. y64) THEN
              max14d = y64d
              max14 = y64
            ELSE
              max14 = -1.0
              max14d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min19*field_old(i, k, j-1)+0.5&
&              *max14*field_old(i, k, j))+mu*(0.5*(min19d*field_old(i, k&
&              , j-1)+min19*field_oldd(i, k, j-1))+0.5*(max14d*field_old(&
&              i, k, j)+max14*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min19*field_old(i, k, j-1)+&
&              0.5*max14*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))) + vel*(&
&              7.*(fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j&
&              +1)+fieldd(i, k, j-2))/12.+SIGN(1, time_step)*SIGN(1., vel&
&              )*(fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)&
&              -fieldd(i, k, j-1)))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1))))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs14d = crd
              abs14 = cr
            ELSE
              abs14d = -crd
              abs14 = -cr
            END IF
            y14d = crd + abs14d
            y14 = cr + abs14
            IF (1.0 .GT. y14) THEN
              min20d = y14d
              min20 = y14
            ELSE
              min20 = 1.0
              min20d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs65d = crd
              abs65 = cr
            ELSE
              abs65d = -crd
              abs65 = -cr
            END IF
            y65d = crd - abs65d
            y65 = cr - abs65
            IF (-1.0 .LT. y65) THEN
              max15d = y65d
              max15 = y65
            ELSE
              max15 = -1.0
              max15d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min20*field_old(i, k, j-1)+0.5&
&              *max15*field_old(i, k, j))+mu*(0.5*(min20d*field_old(i, k&
&              , j-1)+min20*field_oldd(i, k, j-1))+0.5*(max15d*field_old(&
&              i, k, j)+max15*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min20*field_old(i, k, j-1)+&
&              0.5*max15*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs15d = crd
              abs15 = cr
            ELSE
              abs15d = -crd
              abs15 = -cr
            END IF
            y15d = crd + abs15d
            y15 = cr + abs15
            IF (1.0 .GT. y15) THEN
              min21d = y15d
              min21 = y15
            ELSE
              min21 = 1.0
              min21d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs66d = crd
              abs66 = cr
            ELSE
              abs66d = -crd
              abs66 = -cr
            END IF
            y66d = crd - abs66d
            y66 = cr - abs66
            IF (-1.0 .LT. y66) THEN
              max16d = y66d
              max16 = y66
            ELSE
              max16 = -1.0
              max16d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min21*field_old(i, k, j-1)+0.5&
&              *max16*field_old(i, k, j))+mu*(0.5*(min21d*field_old(i, k&
&              , j-1)+min21*field_oldd(i, k, j-1))+0.5*(max16d*field_old(&
&              i, k, j)+max16*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min21*field_old(i, k, j-1)+&
&              0.5*max16*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))) + vel*(&
&              7.*(fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j&
&              +1)+fieldd(i, k, j-2))/12.+SIGN(1, time_step)*SIGN(1., vel&
&              )*(fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)&
&              -fieldd(i, k, j-1)))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1))))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      END IF
    END DO j_loop_y_flux_5
!  next, x flux
!--  these bounds are for periodic and sym conditions
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min22 = ide - 1
    ELSE
      min22 = ite
    END IF
    i_end = min22 + 1
    i_start_f = i_start
    i_end_f = i_end + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min23 = jde - 1
    ELSE
      min23 = jte
    END IF
    j_end = min23 + 1
!--  modify loop bounds for open and specified b.c
!      IF(degrade_ys) j_start = MAX(jts-1,jds+1)
!      IF(degrade_ye) j_end   = MIN(jte+1,jde-2)
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds) THEN
        j_start = jds
      ELSE
        j_start = jts - 1
      END IF
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte + 1
      END IF
    END IF
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its - 1) THEN
        i_start = its - 1
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = ids + 3
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite + 1) THEN
        i_end = ite + 1
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxld = 0.0
      fqxd = 0.0
    ELSE
      fqxld = 0.0
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          mud = 0.5*(mutd(i, j)+mutd(i-1, j))
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs16d = crd
            abs16 = cr
          ELSE
            abs16d = -crd
            abs16 = -cr
          END IF
          y16d = crd + abs16d
          y16 = cr + abs16
          IF (1.0 .GT. y16) THEN
            min24d = y16d
            min24 = y16
          ELSE
            min24 = 1.0
            min24d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs67d = crd
            abs67 = cr
          ELSE
            abs67d = -crd
            abs67 = -cr
          END IF
          y67d = crd - abs67d
          y67 = cr - abs67
          IF (-1.0 .LT. y67) THEN
            max17d = y67d
            max17 = y67
          ELSE
            max17 = -1.0
            max17d = 0.0
          END IF
          fqxld(i, k, j) = dx*(mud*(0.5*min24*field_old(i-1, k, j)+0.5*&
&            max17*field_old(i, k, j))+mu*(0.5*(min24d*field_old(i-1, k, &
&            j)+min24*field_oldd(i-1, k, j))+0.5*(max17d*field_old(i, k, &
&            j)+max17*field_oldd(i, k, j))))/dt
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min24*field_old(i-1, k, j)+0.5&
&            *max17*field_old(i, k, j))
          fqxd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i-1, k, j)&
&            )-2./15.*(field(i+1, k, j)+field(i-2, k, j))+1./60.*(field(i&
&            +2, k, j)+field(i-3, k, j))-SIGN(1, time_step)*SIGN(1., vel)&
&            *(1./60.)*(field(i+2, k, j)-field(i-3, k, j)-5.*(field(i+1, &
&            k, j)-field(i-2, k, j))+10.*(field(i, k, j)-field(i-1, k, j)&
&            ))) + vel*(37.*(fieldd(i, k, j)+fieldd(i-1, k, j))/60.-2.*(&
&            fieldd(i+1, k, j)+fieldd(i-2, k, j))/15.+(fieldd(i+2, k, j)+&
&            fieldd(i-3, k, j))/60.-SIGN(1, time_step)*SIGN(1., vel)*(&
&            fieldd(i+2, k, j)-fieldd(i-3, k, j)-5.*(fieldd(i+1, k, j)-&
&            fieldd(i-2, k, j))+10.*(fieldd(i, k, j)-fieldd(i-1, k, j)))/&
&            60.)
          fqx(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i-1, k, j))-&
&            2./15.*(field(i+1, k, j)+field(i-2, k, j))+1./60.*(field(i+2&
&            , k, j)+field(i-3, k, j))-SIGN(1, time_step)*SIGN(1., vel)*(&
&            1./60.)*(field(i+2, k, j)-field(i-3, k, j)-5.*(field(i+1, k&
&            , j)-field(i-2, k, j))+10.*(field(i, k, j)-field(i-1, k, j))&
&            ))
          fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = (rud(i, k, j)*mu-ru(i, k, j)*mud)/mu**2
              vel = ru(i, k, j)/mu
              crd = dt*veld/dx
              cr = vel*dt/dx
              IF (cr .GE. 0.) THEN
                abs17d = crd
                abs17 = cr
              ELSE
                abs17d = -crd
                abs17 = -cr
              END IF
              y17d = crd + abs17d
              y17 = cr + abs17
              IF (1.0 .GT. y17) THEN
                min25d = y17d
                min25 = y17
              ELSE
                min25 = 1.0
                min25d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs68d = crd
                abs68 = cr
              ELSE
                abs68d = -crd
                abs68 = -cr
              END IF
              y68d = crd - abs68d
              y68 = cr - abs68
              IF (-1.0 .LT. y68) THEN
                max18d = y68d
                max18 = y68
              ELSE
                max18 = -1.0
                max18d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min25*field_old(i-1, k, j)+&
&                0.5*max18*field_old(i, k, j))+mu*(0.5*(min25d*field_old(&
&                i-1, k, j)+min25*field_oldd(i-1, k, j))+0.5*(max18d*&
&                field_old(i, k, j)+max18*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min25*field_old(i-1, k, j)&
&                +0.5*max18*field_old(i, k, j))
              fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-&
&                1, k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)&
&                ))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs18d = crd
                abs18 = cr
              ELSE
                abs18d = -crd
                abs18 = -cr
              END IF
              y18d = crd + abs18d
              y18 = cr + abs18
              IF (1.0 .GT. y18) THEN
                min26d = y18d
                min26 = y18
              ELSE
                min26 = 1.0
                min26d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs69d = crd
                abs69 = cr
              ELSE
                abs69d = -crd
                abs69 = -cr
              END IF
              y69d = crd - abs69d
              y69 = cr - abs69
              IF (-1.0 .LT. y69) THEN
                max19d = y69d
                max19 = y69
              ELSE
                max19 = -1.0
                max19d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min26*field_old(i-1, k, j)+&
&                0.5*max19*field_old(i, k, j))+mu*(0.5*(min26d*field_old(&
&                i-1, k, j)+min26*field_oldd(i-1, k, j))+0.5*(max19d*&
&                field_old(i, k, j)+max19*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min26*field_old(i-1, k, j)&
&                +0.5*max19*field_old(i, k, j))
              fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k&
&                , j))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1&
&                , time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-&
&                field(i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j)))) &
&                + vel*(7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(&
&                fieldd(i+1, k, j)+fieldd(i-2, k, j))/12.+SIGN(1, &
&                time_step)*SIGN(1., vel)*(fieldd(i+1, k, j)-fieldd(i-2, &
&                k, j)-3.*(fieldd(i, k, j)-fieldd(i-1, k, j)))/12.)
              fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j&
&                ))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&                time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-&
&                field(i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j))))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs19d = crd
                abs19 = cr
              ELSE
                abs19d = -crd
                abs19 = -cr
              END IF
              y19d = crd + abs19d
              y19 = cr + abs19
              IF (1.0 .GT. y19) THEN
                min27d = y19d
                min27 = y19
              ELSE
                min27 = 1.0
                min27d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs70d = crd
                abs70 = cr
              ELSE
                abs70d = -crd
                abs70 = -cr
              END IF
              y70d = crd - abs70d
              y70 = cr - abs70
              IF (-1.0 .LT. y70) THEN
                max20d = y70d
                max20 = y70
              ELSE
                max20 = -1.0
                max20d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min27*field_old(i-1, k, j)+&
&                0.5*max20*field_old(i, k, j))+mu*(0.5*(min27d*field_old(&
&                i-1, k, j)+min27*field_oldd(i-1, k, j))+0.5*(max20d*&
&                field_old(i, k, j)+max20*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min27*field_old(i-1, k, j)&
&                +0.5*max20*field_old(i, k, j))
              fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-&
&                1, k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)&
&                ))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              mud = 0.5*(mutd(i, j)+mutd(i-1, j))
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs20d = crd
                abs20 = cr
              ELSE
                abs20d = -crd
                abs20 = -cr
              END IF
              y20d = crd + abs20d
              y20 = cr + abs20
              IF (1.0 .GT. y20) THEN
                min28d = y20d
                min28 = y20
              ELSE
                min28 = 1.0
                min28d = 0.0
              END IF
              IF (cr .GE. 0.) THEN
                abs71d = crd
                abs71 = cr
              ELSE
                abs71d = -crd
                abs71 = -cr
              END IF
              y71d = crd - abs71d
              y71 = cr - abs71
              IF (-1.0 .LT. y71) THEN
                max21d = y71d
                max21 = y71
              ELSE
                max21 = -1.0
                max21d = 0.0
              END IF
              fqxld(i, k, j) = dx*(mud*(0.5*min28*field_old(i-1, k, j)+&
&                0.5*max21*field_old(i, k, j))+mu*(0.5*(min28d*field_old(&
&                i-1, k, j)+min28*field_oldd(i-1, k, j))+0.5*(max21d*&
&                field_old(i, k, j)+max21*field_oldd(i, k, j))))/dt
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min28*field_old(i-1, k, j)&
&                +0.5*max21*field_old(i, k, j))
              fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k&
&                , j))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1&
&                , time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-&
&                field(i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j)))) &
&                + vel*(7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(&
&                fieldd(i+1, k, j)+fieldd(i-2, k, j))/12.+SIGN(1, &
&                time_step)*SIGN(1., vel)*(fieldd(i+1, k, j)-fieldd(i-2, &
&                k, j)-3.*(fieldd(i, k, j)-fieldd(i-1, k, j)))/12.)
              fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j&
&                ))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&                time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-&
&                field(i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j))))
              fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
          END IF
        END DO
      END IF
    END DO
  ELSE IF (horz_order .EQ. 4) THEN
! enddo for outer J loop
!--- end of 5th order horizontal flux calculation
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 1) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 1) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 2) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min29 = ide - 1
    ELSE
      min29 = ite
    END IF
    i_end = min29 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min30 = jde - 1
    ELSE
      min30 = jte
    END IF
    j_end = min30 + 1
    j_start_f = j_start
    j_end_f = j_end + 1
!--  modify loop bounds if open or specified
    IF (degrade_xs) i_start = its
    IF (degrade_xe) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 2
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 2
      fqyld = 0.0
      fqyd = 0.0
    ELSE
      fqyld = 0.0
      fqyd = 0.0
    END IF
!  compute fluxes, 4th order
j_loop_y_flux_4:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs21d = crd
              abs21 = cr
            ELSE
              abs21d = -crd
              abs21 = -cr
            END IF
            y21d = crd + abs21d
            y21 = cr + abs21
            IF (1.0 .GT. y21) THEN
              min31d = y21d
              min31 = y21
            ELSE
              min31 = 1.0
              min31d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs72d = crd
              abs72 = cr
            ELSE
              abs72d = -crd
              abs72 = -cr
            END IF
            y72d = crd - abs72d
            y72 = cr - abs72
            IF (-1.0 .LT. y72) THEN
              max22d = y72d
              max22 = y72
            ELSE
              max22 = -1.0
              max22d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min31*field_old(i, k, j-1)+0.5&
&              *max22*field_old(i, k, j))+mu*(0.5*(min31d*field_old(i, k&
&              , j-1)+min31*field_oldd(i, k, j-1))+0.5*(max22d*field_old(&
&              i, k, j)+max22*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min31*field_old(i, k, j-1)+&
&              0.5*max22*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))) + vel*(7.*(&
&              fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+&
&              fieldd(i, k, j-2))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2)))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs22d = crd
              abs22 = cr
            ELSE
              abs22d = -crd
              abs22 = -cr
            END IF
            y22d = crd + abs22d
            y22 = cr + abs22
            IF (1.0 .GT. y22) THEN
              min32d = y22d
              min32 = y22
            ELSE
              min32 = 1.0
              min32d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs73d = crd
              abs73 = cr
            ELSE
              abs73d = -crd
              abs73 = -cr
            END IF
            y73d = crd - abs73d
            y73 = cr - abs73
            IF (-1.0 .LT. y73) THEN
              max23d = y73d
              max23 = y73
            ELSE
              max23 = -1.0
              max23d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min32*field_old(i, k, j-1)+0.5&
&              *max23*field_old(i, k, j))+mu*(0.5*(min32d*field_old(i, k&
&              , j-1)+min32*field_oldd(i, k, j-1))+0.5*(max23d*field_old(&
&              i, k, j)+max23*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min32*field_old(i, k, j-1)+&
&              0.5*max23*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs23d = crd
              abs23 = cr
            ELSE
              abs23d = -crd
              abs23 = -cr
            END IF
            y23d = crd + abs23d
            y23 = cr + abs23
            IF (1.0 .GT. y23) THEN
              min33d = y23d
              min33 = y23
            ELSE
              min33 = 1.0
              min33d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs74d = crd
              abs74 = cr
            ELSE
              abs74d = -crd
              abs74 = -cr
            END IF
            y74d = crd - abs74d
            y74 = cr - abs74
            IF (-1.0 .LT. y74) THEN
              max24d = y74d
              max24 = y74
            ELSE
              max24 = -1.0
              max24d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min33*field_old(i, k, j-1)+0.5&
&              *max24*field_old(i, k, j))+mu*(0.5*(min33d*field_old(i, k&
&              , j-1)+min33*field_oldd(i, k, j-1))+0.5*(max24d*field_old(&
&              i, k, j)+max24*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min33*field_old(i, k, j-1)+&
&              0.5*max24*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      END IF
    END DO j_loop_y_flux_4
!  next, x flux
!--  these bounds are for periodic and sym conditions
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min34 = ide - 1
    ELSE
      min34 = ite
    END IF
    i_end = min34 + 1
    i_start_f = i_start
    i_end_f = i_end + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min35 = jde - 1
    ELSE
      min35 = jte
    END IF
    j_end = min35 + 1
!--  modify loop bounds for open and specified b.c
    IF (degrade_ys) j_start = jts
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 2
      fqxld = 0.0
      fqxd = 0.0
    ELSE
      fqxld = 0.0
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          mud = 0.5*(mutd(i, j)+mutd(i-1, j))
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs24d = crd
            abs24 = cr
          ELSE
            abs24d = -crd
            abs24 = -cr
          END IF
          y24d = crd + abs24d
          y24 = cr + abs24
          IF (1.0 .GT. y24) THEN
            min36d = y24d
            min36 = y24
          ELSE
            min36 = 1.0
            min36d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs75d = crd
            abs75 = cr
          ELSE
            abs75d = -crd
            abs75 = -cr
          END IF
          y75d = crd - abs75d
          y75 = cr - abs75
          IF (-1.0 .LT. y75) THEN
            max25d = y75d
            max25 = y75
          ELSE
            max25 = -1.0
            max25d = 0.0
          END IF
          fqxld(i, k, j) = dx*(mud*(0.5*min36*field_old(i-1, k, j)+0.5*&
&            max25*field_old(i, k, j))+mu*(0.5*(min36d*field_old(i-1, k, &
&            j)+min36*field_oldd(i-1, k, j))+0.5*(max25d*field_old(i, k, &
&            j)+max25*field_oldd(i, k, j))))/dt
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min36*field_old(i-1, k, j)+0.5&
&            *max25*field_old(i, k, j))
          fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j))&
&            -1./12.*(field(i+1, k, j)+field(i-2, k, j))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k, j)+&
&            fieldd(i-2, k, j))/12.)
          fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))-&
&            1./12.*(field(i+1, k, j)+field(i-2, k, j)))
          fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        IF (i_start .EQ. ids + 1) THEN
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = (rud(i, k, j)*mu-ru(i, k, j)*mud)/mu**2
            vel = ru(i, k, j)/mu
            crd = dt*veld/dx
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs25d = crd
              abs25 = cr
            ELSE
              abs25d = -crd
              abs25 = -cr
            END IF
            y25d = crd + abs25d
            y25 = cr + abs25
            IF (1.0 .GT. y25) THEN
              min37d = y25d
              min37 = y25
            ELSE
              min37 = 1.0
              min37d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs76d = crd
              abs76 = cr
            ELSE
              abs76d = -crd
              abs76 = -cr
            END IF
            y76d = crd - abs76d
            y76 = cr - abs76
            IF (-1.0 .LT. y76) THEN
              max26d = y76d
              max26 = y76
            ELSE
              max26 = -1.0
              max26d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min37*field_old(i-1, k, j)+0.5&
&              *max26*field_old(i, k, j))+mu*(0.5*(min37d*field_old(i-1, &
&              k, j)+min37*field_oldd(i-1, k, j))+0.5*(max26d*field_old(i&
&              , k, j)+max26*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min37*field_old(i-1, k, j)+&
&              0.5*max26*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 2) THEN
! second order flux next to the boundary
          i = ide - 1
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = rud(i, k, j)
            vel = ru(i, k, j)
            crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs26d = crd
              abs26 = cr
            ELSE
              abs26d = -crd
              abs26 = -cr
            END IF
            y26d = crd + abs26d
            y26 = cr + abs26
            IF (1.0 .GT. y26) THEN
              min38d = y26d
              min38 = y26
            ELSE
              min38 = 1.0
              min38d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs77d = crd
              abs77 = cr
            ELSE
              abs77d = -crd
              abs77 = -cr
            END IF
            y77d = crd - abs77d
            y77 = cr - abs77
            IF (-1.0 .LT. y77) THEN
              max27d = y77d
              max27 = y77
            ELSE
              max27 = -1.0
              max27d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min38*field_old(i-1, k, j)+0.5&
&              *max27*field_old(i, k, j))+mu*(0.5*(min38d*field_old(i-1, &
&              k, j)+min38*field_oldd(i-1, k, j))+0.5*(max27d*field_old(i&
&              , k, j)+max27*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min38*field_old(i-1, k, j)+&
&              0.5*max27*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END IF
    END DO
  ELSE IF (horz_order .EQ. 3) THEN
! enddo for outer J loop
!--- end of 4th order horizontal flux calculation
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 2) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 1) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 2) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 1) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min39 = ide - 1
    ELSE
      min39 = ite
    END IF
    i_end = min39 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min40 = jde - 1
    ELSE
      min40 = jte
    END IF
    j_end = min40 + 1
    j_start_f = j_start
    j_end_f = j_end + 1
!--  modify loop bounds if open or specified
    IF (degrade_xs) i_start = its
    IF (degrade_xe) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 2
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 2
      fqyld = 0.0
      fqyd = 0.0
    ELSE
      fqyld = 0.0
      fqyd = 0.0
    END IF
!  compute fluxes, 3rd order
j_loop_y_flux_3:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs27d = crd
              abs27 = cr
            ELSE
              abs27d = -crd
              abs27 = -cr
            END IF
            y27d = crd + abs27d
            y27 = cr + abs27
            IF (1.0 .GT. y27) THEN
              min41d = y27d
              min41 = y27
            ELSE
              min41 = 1.0
              min41d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs78d = crd
              abs78 = cr
            ELSE
              abs78d = -crd
              abs78 = -cr
            END IF
            y78d = crd - abs78d
            y78 = cr - abs78
            IF (-1.0 .LT. y78) THEN
              max28d = y78d
              max28 = y78
            ELSE
              max28 = -1.0
              max28d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min41*field_old(i, k, j-1)+0.5&
&              *max28*field_old(i, k, j))+mu*(0.5*(min41d*field_old(i, k&
&              , j-1)+min41*field_oldd(i, k, j-1))+0.5*(max28d*field_old(&
&              i, k, j)+max28*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min41*field_old(i, k, j-1)+&
&              0.5*max28*field_old(i, k, j))
            fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))) + vel*(&
&              7.*(fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j&
&              +1)+fieldd(i, k, j-2))/12.+SIGN(1, time_step)*SIGN(1., vel&
&              )*(fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)&
&              -fieldd(i, k, j-1)))/12.)
            fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&              -1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(&
&              i, k, j-2)-3.*(field(i, k, j)-field(i, k, j-1))))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs28d = crd
              abs28 = cr
            ELSE
              abs28d = -crd
              abs28 = -cr
            END IF
            y28d = crd + abs28d
            y28 = cr + abs28
            IF (1.0 .GT. y28) THEN
              min42d = y28d
              min42 = y28
            ELSE
              min42 = 1.0
              min42d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs79d = crd
              abs79 = cr
            ELSE
              abs79d = -crd
              abs79 = -cr
            END IF
            y79d = crd - abs79d
            y79 = cr - abs79
            IF (-1.0 .LT. y79) THEN
              max29d = y79d
              max29 = y79
            ELSE
              max29 = -1.0
              max29d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min42*field_old(i, k, j-1)+0.5&
&              *max29*field_old(i, k, j))+mu*(0.5*(min42d*field_old(i, k&
&              , j-1)+min42*field_oldd(i, k, j-1))+0.5*(max29d*field_old(&
&              i, k, j)+max29*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min42*field_old(i, k, j-1)+&
&              0.5*max29*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            mud = 0.5*(mutd(i, j)+mutd(i, j-1))
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs29d = crd
              abs29 = cr
            ELSE
              abs29d = -crd
              abs29 = -cr
            END IF
            y29d = crd + abs29d
            y29 = cr + abs29
            IF (1.0 .GT. y29) THEN
              min43d = y29d
              min43 = y29
            ELSE
              min43 = 1.0
              min43d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs80d = crd
              abs80 = cr
            ELSE
              abs80d = -crd
              abs80 = -cr
            END IF
            y80d = crd - abs80d
            y80 = cr - abs80
            IF (-1.0 .LT. y80) THEN
              max30d = y80d
              max30 = y80
            ELSE
              max30 = -1.0
              max30d = 0.0
            END IF
            fqyld(i, k, j) = dy*(mud*(0.5*min43*field_old(i, k, j-1)+0.5&
&              *max30*field_old(i, k, j))+mu*(0.5*(min43d*field_old(i, k&
&              , j-1)+min43*field_oldd(i, k, j-1))+0.5*(max30d*field_old(&
&              i, k, j)+max30*field_oldd(i, k, j))))/dt
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min43*field_old(i, k, j-1)+&
&              0.5*max30*field_old(i, k, j))
            fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
        END DO
      END IF
    END DO j_loop_y_flux_3
!  next, x flux
!--  these bounds are for periodic and sym conditions
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min44 = ide - 1
    ELSE
      min44 = ite
    END IF
    i_end = min44 + 1
    i_start_f = i_start
    i_end_f = i_end + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min45 = jde - 1
    ELSE
      min45 = jte
    END IF
    j_end = min45 + 1
!--  modify loop bounds for open and specified b.c
    IF (degrade_ys) j_start = jts
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      i_start_f = i_start + 1
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 2
      fqxld = 0.0
      fqxd = 0.0
    ELSE
      fqxld = 0.0
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  4th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          mud = 0.5*(mutd(i, j)+mutd(i-1, j))
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs30d = crd
            abs30 = cr
          ELSE
            abs30d = -crd
            abs30 = -cr
          END IF
          y30d = crd + abs30d
          y30 = cr + abs30
          IF (1.0 .GT. y30) THEN
            min46d = y30d
            min46 = y30
          ELSE
            min46 = 1.0
            min46d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs81d = crd
            abs81 = cr
          ELSE
            abs81d = -crd
            abs81 = -cr
          END IF
          y81d = crd - abs81d
          y81 = cr - abs81
          IF (-1.0 .LT. y81) THEN
            max31d = y81d
            max31 = y81
          ELSE
            max31 = -1.0
            max31d = 0.0
          END IF
          fqxld(i, k, j) = dx*(mud*(0.5*min46*field_old(i-1, k, j)+0.5*&
&            max31*field_old(i, k, j))+mu*(0.5*(min46d*field_old(i-1, k, &
&            j)+min46*field_oldd(i-1, k, j))+0.5*(max31d*field_old(i, k, &
&            j)+max31*field_oldd(i, k, j))))/dt
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min46*field_old(i-1, k, j)+0.5&
&            *max31*field_old(i, k, j))
          fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j))&
&            -1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&            time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(i-&
&            2, k, j)-3.*(field(i, k, j)-field(i-1, k, j)))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k, j)+&
&            fieldd(i-2, k, j))/12.+SIGN(1, time_step)*SIGN(1., vel)*(&
&            fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i, k, j)-&
&            fieldd(i-1, k, j)))/12.)
          fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))-&
&            1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, time_step&
&            )*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(i-2, k, j)-&
&            3.*(field(i, k, j)-field(i-1, k, j))))
          fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        IF (i_start .EQ. ids + 1) THEN
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = (rud(i, k, j)*mu-ru(i, k, j)*mud)/mu**2
            vel = ru(i, k, j)/mu
            crd = dt*veld/dx
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs31d = crd
              abs31 = cr
            ELSE
              abs31d = -crd
              abs31 = -cr
            END IF
            y31d = crd + abs31d
            y31 = cr + abs31
            IF (1.0 .GT. y31) THEN
              min47d = y31d
              min47 = y31
            ELSE
              min47 = 1.0
              min47d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs82d = crd
              abs82 = cr
            ELSE
              abs82d = -crd
              abs82 = -cr
            END IF
            y82d = crd - abs82d
            y82 = cr - abs82
            IF (-1.0 .LT. y82) THEN
              max32d = y82d
              max32 = y82
            ELSE
              max32 = -1.0
              max32d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min47*field_old(i-1, k, j)+0.5&
&              *max32*field_old(i, k, j))+mu*(0.5*(min47d*field_old(i-1, &
&              k, j)+min47*field_oldd(i-1, k, j))+0.5*(max32d*field_old(i&
&              , k, j)+max32*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min47*field_old(i-1, k, j)+&
&              0.5*max32*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 2) THEN
! second order flux next to the boundary
          i = ide - 1
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = rud(i, k, j)
            vel = ru(i, k, j)
            crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs32d = crd
              abs32 = cr
            ELSE
              abs32d = -crd
              abs32 = -cr
            END IF
            y32d = crd + abs32d
            y32 = cr + abs32
            IF (1.0 .GT. y32) THEN
              min48d = y32d
              min48 = y32
            ELSE
              min48 = 1.0
              min48d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs83d = crd
              abs83 = cr
            ELSE
              abs83d = -crd
              abs83 = -cr
            END IF
            y83d = crd - abs83d
            y83 = cr - abs83
            IF (-1.0 .LT. y83) THEN
              max33d = y83d
              max33 = y83
            ELSE
              max33 = -1.0
              max33d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min48*field_old(i-1, k, j)+0.5&
&              *max33*field_old(i, k, j))+mu*(0.5*(min48d*field_old(i-1, &
&              k, j)+min48*field_oldd(i-1, k, j))+0.5*(max33d*field_old(i&
&              , k, j)+max33*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min48*field_old(i-1, k, j)+&
&              0.5*max33*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END IF
    END DO
  ELSE IF (horz_order .EQ. 2) THEN
! enddo for outer J loop
!--- end of 3rd order horizontal flux calculation
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 1) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 2) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 1) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 2) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min49 = ide - 1
    ELSE
      min49 = ite
    END IF
    i_end = min49 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min50 = jde - 1
    ELSE
      min50 = jte
    END IF
    j_end = min50 + 1
!--  modify loop bounds if open or specified
    IF (degrade_xs) i_start = its
    IF (degrade_xe) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      fqyld = 0.0
      fqyd = 0.0
    ELSE
      fqyld = 0.0
      fqyd = 0.0
    END IF
!  compute fluxes, 2nd order, y flux
    DO j=j_start,j_end+1
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs33d = crd
            abs33 = cr
          ELSE
            abs33d = -crd
            abs33 = -cr
          END IF
          y33d = crd + abs33d
          y33 = cr + abs33
          IF (1.0 .GT. y33) THEN
            min51d = y33d
            min51 = y33
          ELSE
            min51 = 1.0
            min51d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs84d = crd
            abs84 = cr
          ELSE
            abs84d = -crd
            abs84 = -cr
          END IF
          y84d = crd - abs84d
          y84 = cr - abs84
          IF (-1.0 .LT. y84) THEN
            max34d = y84d
            max34 = y84
          ELSE
            max34 = -1.0
            max34d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min51*field_old(i, k, j-1)+0.5*&
&            max34*field_old(i, k, j))+mu*(0.5*(min51d*field_old(i, k, j-&
&            1)+min51*field_oldd(i, k, j-1))+0.5*(max34d*field_old(i, k, &
&            j)+max34*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min51*field_old(i, k, j-1)+0.5&
&            *max34*field_old(i, k, j))
          fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k, &
&            j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&            ))
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    END DO
    fqxld = 0.0
    fqxd = 0.0
!  next, x flux
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end+1
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          mud = 0.5*(mutd(i, j)+mutd(i-1, j))
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          veld = rud(i, k, j)
          vel = ru(i, k, j)
          crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs34d = crd
            abs34 = cr
          ELSE
            abs34d = -crd
            abs34 = -cr
          END IF
          y34d = crd + abs34d
          y34 = cr + abs34
          IF (1.0 .GT. y34) THEN
            min52d = y34d
            min52 = y34
          ELSE
            min52 = 1.0
            min52d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs85d = crd
            abs85 = cr
          ELSE
            abs85d = -crd
            abs85 = -cr
          END IF
          y85d = crd - abs85d
          y85 = cr - abs85
          IF (-1.0 .LT. y85) THEN
            max35d = y85d
            max35 = y85
          ELSE
            max35 = -1.0
            max35d = 0.0
          END IF
          fqxld(i, k, j) = dx*(mud*(0.5*min52*field_old(i-1, k, j)+0.5*&
&            max35*field_old(i, k, j))+mu*(0.5*(min52d*field_old(i-1, k, &
&            j)+min52*field_oldd(i-1, k, j))+0.5*(max35d*field_old(i, k, &
&            j)+max35*field_oldd(i, k, j))))/dt
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min52*field_old(i-1, k, j)+0.5&
&            *max35*field_old(i, k, j))
          fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, k&
&            , j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
          fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, j&
&            ))
          fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
      END DO
    END DO
  ELSE
!--- end of 2nd order horizontal flux calculation
    WRITE(wrf_err_message, *) &
&    'module_advect: advect_scalar_pd, h_order not known ', horz_order
    CALL WRF_ERROR_FATAL(TRIM(wrf_err_message))
    fqxld = 0.0
    fqyld = 0.0
    fqxd = 0.0
    fqyd = 0.0
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(its, k, j)+rud(its+1, k, j))
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(&
&          field_old(its+1, k, j)-field_old(its, k, j))+ub*(field_oldd(&
&          its+1, k, j)-field_oldd(its, k, j))+fieldd(its, k, j)*(ru(its+&
&          1, k, j)-ru(its, k, j))+field(its, k, j)*(rud(its+1, k, j)-rud&
&          (its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(field_old(&
&          its+1, k, j)-field_old(its, k, j))+field(its, k, j)*(ru(its+1&
&          , k, j)-ru(its, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(ite-1, k, j)+rud(ite, k, j))
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+ub*(&
&          field_oldd(i_end, k, j)-field_oldd(i_end-1, k, j))+fieldd(&
&          i_end, k, j)*(ru(ite, k, j)-ru(ite-1, k, j))+field(i_end, k, j&
&          )*(rud(ite, k, j)-rud(ite-1, k, j)))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+field(i_end, &
&          k, j)*(ru(ite, k, j)-ru(ite-1, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jts)+rvd(i, k, jts+1))
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*(rv(i, k&
&          , jts+1)-rv(i, k, jts))+field(i, k, jts)*(rvd(i, k, jts+1)-rvd&
&          (i, k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*(rv(i, k, &
&          jts+1)-rv(i, k, jts)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jte-1)+rvd(i, k, jte))
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))+fieldd(i, k&
&          , j_end)*(rv(i, k, jte)-rv(i, k, jte-1))+field(i, k, j_end)*(&
&          rvd(i, k, jte)-rvd(i, k, jte-1)))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(rv(i, k, jte)-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
! Assuming rv(i,k,jds) = 0.
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jts+1) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*rvd(i, k, jts+1)
          vb = 0.5*rv(i, k, jts+1)
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*rv(i, k, &
&          jts+1)+field(i, k, jts)*rvd(i, k, jts+1))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*rv(i, k, &
&          jts+1))
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
! Assuming rv(i,k,jde) = 0.
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jte-1) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*rvd(i, k, jte-1)
          vb = 0.5*rv(i, k, jte-1)
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))-fieldd(i, k&
&          , j_end)*rv(i, k, jte-1)-field(i, k, j_end)*rvd(i, k, jte-1))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!-- loop bounds for periodic or sym conditions
  i_start = its - 1
  IF (ite .GT. ide - 1) THEN
    min53 = ide - 1
  ELSE
    min53 = ite
  END IF
  i_end = min53 + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min54 = jde - 1
  ELSE
    min54 = jte
  END IF
  j_end = min54 + 1
!-- loop bounds for open or specified conditions
  IF (degrade_xs) THEN
    IF (its - 1 .LT. ids) THEN
      i_start = ids
    ELSE
      i_start = its - 1
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ite + 1 .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite + 1
    END IF
  END IF
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds) THEN
      j_start = jds
    ELSE
      j_start = jts - 1
    END IF
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte + 1
    END IF
  END IF
  IF (vert_order .EQ. 6) THEN
    fqzd = 0.0
    fqzld = 0.0
    DO j=j_start,j_end
      DO i=i_start,i_end
        fqzd(i, 1, j) = 0.0
        fqz(i, 1, j) = 0.
        fqzld(i, 1, j) = 0.0
        fqzl(i, 1, j) = 0.
        fqzd(i, kde, j) = 0.0
        fqz(i, kde, j) = 0.
        fqzld(i, kde, j) = 0.0
        fqzl(i, kde, j) = 0.
      END DO
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          dz = 2./(rdzw(k)+rdzw(k-1))
          mud = 0.5*2*mutd(i, j)
          mu = 0.5*(mut(i, j)+mut(i, j))
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs35d = crd
            abs35 = cr
          ELSE
            abs35d = -crd
            abs35 = -cr
          END IF
          y35d = crd + abs35d
          y35 = cr + abs35
          IF (1.0 .GT. y35) THEN
            min55d = y35d
            min55 = y35
          ELSE
            min55 = 1.0
            min55d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs86d = crd
            abs86 = cr
          ELSE
            abs86d = -crd
            abs86 = -cr
          END IF
          y86d = crd - abs86d
          y86 = cr - abs86
          IF (-1.0 .LT. y86) THEN
            max36d = y86d
            max36 = y86
          ELSE
            max36 = -1.0
            max36d = 0.0
          END IF
          fqzld(i, k, j) = dz*(mud*(0.5*min55*field_old(i, k-1, j)+0.5*&
&            max36*field_old(i, k, j))+mu*(0.5*(min55d*field_old(i, k-1, &
&            j)+min55*field_oldd(i, k-1, j))+0.5*(max36d*field_old(i, k, &
&            j)+max36*field_oldd(i, k, j))))/dt
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min55*field_old(i, k-1, j)+0.5&
&            *max36*field_old(i, k, j))
          fqzd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i, k-1, j)&
&            )-2./15.*(field(i, k+1, j)+field(i, k-2, j))+1./60.*(field(i&
&            , k+2, j)+field(i, k-3, j))) + vel*(37.*(fieldd(i, k, j)+&
&            fieldd(i, k-1, j))/60.-2.*(fieldd(i, k+1, j)+fieldd(i, k-2, &
&            j))/15.+(fieldd(i, k+2, j)+fieldd(i, k-3, j))/60.)
          fqz(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i, k-1, j))-&
&            2./15.*(field(i, k+1, j)+field(i, k-2, j))+1./60.*(field(i, &
&            k+2, j)+field(i, k-3, j)))
          fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs36d = crd
          abs36 = cr
        ELSE
          abs36d = -crd
          abs36 = -cr
        END IF
        y36d = crd + abs36d
        y36 = cr + abs36
        IF (1.0 .GT. y36) THEN
          min56d = y36d
          min56 = y36
        ELSE
          min56 = 1.0
          min56d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs87d = crd
          abs87 = cr
        ELSE
          abs87d = -crd
          abs87 = -cr
        END IF
        y87d = crd - abs87d
        y87 = cr - abs87
        IF (-1.0 .LT. y87) THEN
          max37d = y87d
          max37 = y87
        ELSE
          max37 = -1.0
          max37d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min56*field_old(i, k-1, j)+0.5*&
&          max37*field_old(i, k, j))+mu*(0.5*(min56d*field_old(i, k-1, j)&
&          +min56*field_oldd(i, k-1, j))+0.5*(max37d*field_old(i, k, j)+&
&          max37*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min56*field_old(i, k-1, j)+0.5*&
&          max37*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = kts + 2
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs37d = crd
          abs37 = cr
        ELSE
          abs37d = -crd
          abs37 = -cr
        END IF
        y37d = crd + abs37d
        y37 = cr + abs37
        IF (1.0 .GT. y37) THEN
          min57d = y37d
          min57 = y37
        ELSE
          min57 = 1.0
          min57d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs88d = crd
          abs88 = cr
        ELSE
          abs88d = -crd
          abs88 = -cr
        END IF
        y88d = crd - abs88d
        y88 = cr - abs88
        IF (-1.0 .LT. y88) THEN
          max38d = y88d
          max38 = y88
        ELSE
          max38 = -1.0
          max38d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min57*field_old(i, k-1, j)+0.5*&
&          max38*field_old(i, k, j))+mu*(0.5*(min57d*field_old(i, k-1, j)&
&          +min57*field_oldd(i, k-1, j))+0.5*(max38d*field_old(i, k, j)+&
&          max38*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min57*field_old(i, k-1, j)+0.5*&
&          max38*field_old(i, k, j))
        fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&          1./12.*(field(i, k+1, j)+field(i, k-2, j))) + vel*(7.*(fieldd(&
&          i, k, j)+fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k&
&          -2, j))/12.)
        fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&          12.*(field(i, k+1, j)+field(i, k-2, j)))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf - 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs38d = crd
          abs38 = cr
        ELSE
          abs38d = -crd
          abs38 = -cr
        END IF
        y38d = crd + abs38d
        y38 = cr + abs38
        IF (1.0 .GT. y38) THEN
          min58d = y38d
          min58 = y38
        ELSE
          min58 = 1.0
          min58d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs89d = crd
          abs89 = cr
        ELSE
          abs89d = -crd
          abs89 = -cr
        END IF
        y89d = crd - abs89d
        y89 = cr - abs89
        IF (-1.0 .LT. y89) THEN
          max39d = y89d
          max39 = y89
        ELSE
          max39 = -1.0
          max39d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min58*field_old(i, k-1, j)+0.5*&
&          max39*field_old(i, k, j))+mu*(0.5*(min58d*field_old(i, k-1, j)&
&          +min58*field_oldd(i, k-1, j))+0.5*(max39d*field_old(i, k, j)+&
&          max39*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min58*field_old(i, k-1, j)+0.5*&
&          max39*field_old(i, k, j))
        fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&          1./12.*(field(i, k+1, j)+field(i, k-2, j))) + vel*(7.*(fieldd(&
&          i, k, j)+fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k&
&          -2, j))/12.)
        fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&          12.*(field(i, k+1, j)+field(i, k-2, j)))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs39d = crd
          abs39 = cr
        ELSE
          abs39d = -crd
          abs39 = -cr
        END IF
        y39d = crd + abs39d
        y39 = cr + abs39
        IF (1.0 .GT. y39) THEN
          min59d = y39d
          min59 = y39
        ELSE
          min59 = 1.0
          min59d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs90d = crd
          abs90 = cr
        ELSE
          abs90d = -crd
          abs90 = -cr
        END IF
        y90d = crd - abs90d
        y90 = cr - abs90
        IF (-1.0 .LT. y90) THEN
          max40d = y90d
          max40 = y90
        ELSE
          max40 = -1.0
          max40d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min59*field_old(i, k-1, j)+0.5*&
&          max40*field_old(i, k, j))+mu*(0.5*(min59d*field_old(i, k-1, j)&
&          +min59*field_oldd(i, k-1, j))+0.5*(max40d*field_old(i, k, j)+&
&          max40*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min59*field_old(i, k-1, j)+0.5*&
&          max40*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    fqzd = 0.0
    fqzld = 0.0
    DO j=j_start,j_end
      DO i=i_start,i_end
        fqzd(i, 1, j) = 0.0
        fqz(i, 1, j) = 0.
        fqzld(i, 1, j) = 0.0
        fqzl(i, 1, j) = 0.
        fqzd(i, kde, j) = 0.0
        fqz(i, kde, j) = 0.
        fqzld(i, kde, j) = 0.0
        fqzl(i, kde, j) = 0.
      END DO
      DO k=kts+3,ktf-2
        DO i=i_start,i_end
          dz = 2./(rdzw(k)+rdzw(k-1))
          mud = 0.5*2*mutd(i, j)
          mu = 0.5*(mut(i, j)+mut(i, j))
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs40d = crd
            abs40 = cr
          ELSE
            abs40d = -crd
            abs40 = -cr
          END IF
          y40d = crd + abs40d
          y40 = cr + abs40
          IF (1.0 .GT. y40) THEN
            min60d = y40d
            min60 = y40
          ELSE
            min60 = 1.0
            min60d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs91d = crd
            abs91 = cr
          ELSE
            abs91d = -crd
            abs91 = -cr
          END IF
          y91d = crd - abs91d
          y91 = cr - abs91
          IF (-1.0 .LT. y91) THEN
            max41d = y91d
            max41 = y91
          ELSE
            max41 = -1.0
            max41d = 0.0
          END IF
          fqzld(i, k, j) = dz*(mud*(0.5*min60*field_old(i, k-1, j)+0.5*&
&            max41*field_old(i, k, j))+mu*(0.5*(min60d*field_old(i, k-1, &
&            j)+min60*field_oldd(i, k-1, j))+0.5*(max41d*field_old(i, k, &
&            j)+max41*field_oldd(i, k, j))))/dt
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min60*field_old(i, k-1, j)+0.5&
&            *max41*field_old(i, k, j))
          fqzd(i, k, j) = veld*(37./60.*(field(i, k, j)+field(i, k-1, j)&
&            )-2./15.*(field(i, k+1, j)+field(i, k-2, j))+1./60.*(field(i&
&            , k+2, j)+field(i, k-3, j))-SIGN(1, time_step)*SIGN(1., -vel&
&            )*(1./60.)*(field(i, k+2, j)-field(i, k-3, j)-5.*(field(i, k&
&            +1, j)-field(i, k-2, j))+10.*(field(i, k, j)-field(i, k-1, j&
&            )))) + vel*(37.*(fieldd(i, k, j)+fieldd(i, k-1, j))/60.-2.*(&
&            fieldd(i, k+1, j)+fieldd(i, k-2, j))/15.+(fieldd(i, k+2, j)+&
&            fieldd(i, k-3, j))/60.-SIGN(1, time_step)*SIGN(1., -vel)*(&
&            fieldd(i, k+2, j)-fieldd(i, k-3, j)-5.*(fieldd(i, k+1, j)-&
&            fieldd(i, k-2, j))+10.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/&
&            60.)
          fqz(i, k, j) = vel*(37./60.*(field(i, k, j)+field(i, k-1, j))-&
&            2./15.*(field(i, k+1, j)+field(i, k-2, j))+1./60.*(field(i, &
&            k+2, j)+field(i, k-3, j))-SIGN(1, time_step)*SIGN(1., -vel)*&
&            (1./60.)*(field(i, k+2, j)-field(i, k-3, j)-5.*(field(i, k+1&
&            , j)-field(i, k-2, j))+10.*(field(i, k, j)-field(i, k-1, j))&
&            ))
          fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs41d = crd
          abs41 = cr
        ELSE
          abs41d = -crd
          abs41 = -cr
        END IF
        y41d = crd + abs41d
        y41 = cr + abs41
        IF (1.0 .GT. y41) THEN
          min61d = y41d
          min61 = y41
        ELSE
          min61 = 1.0
          min61d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs92d = crd
          abs92 = cr
        ELSE
          abs92d = -crd
          abs92 = -cr
        END IF
        y92d = crd - abs92d
        y92 = cr - abs92
        IF (-1.0 .LT. y92) THEN
          max42d = y92d
          max42 = y92
        ELSE
          max42 = -1.0
          max42d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min61*field_old(i, k-1, j)+0.5*&
&          max42*field_old(i, k, j))+mu*(0.5*(min61d*field_old(i, k-1, j)&
&          +min61*field_oldd(i, k-1, j))+0.5*(max42d*field_old(i, k, j)+&
&          max42*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min61*field_old(i, k-1, j)+0.5*&
&          max42*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = kts + 2
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs42d = crd
          abs42 = cr
        ELSE
          abs42d = -crd
          abs42 = -cr
        END IF
        y42d = crd + abs42d
        y42 = cr + abs42
        IF (1.0 .GT. y42) THEN
          min62d = y42d
          min62 = y42
        ELSE
          min62 = 1.0
          min62d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs93d = crd
          abs93 = cr
        ELSE
          abs93d = -crd
          abs93 = -cr
        END IF
        y93d = crd - abs93d
        y93 = cr - abs93
        IF (-1.0 .LT. y93) THEN
          max43d = y93d
          max43 = y93
        ELSE
          max43 = -1.0
          max43d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min62*field_old(i, k-1, j)+0.5*&
&          max43*field_old(i, k, j))+mu*(0.5*(min62d*field_old(i, k-1, j)&
&          +min62*field_oldd(i, k-1, j))+0.5*(max43d*field_old(i, k, j)+&
&          max43*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min62*field_old(i, k-1, j)+0.5*&
&          max43*field_old(i, k, j))
        fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&          1./12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*&
&          (field(i, k, j)-field(i, k-1, j)))) + vel*(7.*(fieldd(i, k, j)&
&          +fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k-2, j))/&
&          12.+SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-&
&          fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.)
        fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&          12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*&
&          (field(i, k, j)-field(i, k-1, j))))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf - 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs43d = crd
          abs43 = cr
        ELSE
          abs43d = -crd
          abs43 = -cr
        END IF
        y43d = crd + abs43d
        y43 = cr + abs43
        IF (1.0 .GT. y43) THEN
          min63d = y43d
          min63 = y43
        ELSE
          min63 = 1.0
          min63d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs94d = crd
          abs94 = cr
        ELSE
          abs94d = -crd
          abs94 = -cr
        END IF
        y94d = crd - abs94d
        y94 = cr - abs94
        IF (-1.0 .LT. y94) THEN
          max44d = y94d
          max44 = y94
        ELSE
          max44 = -1.0
          max44d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min63*field_old(i, k-1, j)+0.5*&
&          max44*field_old(i, k, j))+mu*(0.5*(min63d*field_old(i, k-1, j)&
&          +min63*field_oldd(i, k-1, j))+0.5*(max44d*field_old(i, k, j)+&
&          max44*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min63*field_old(i, k-1, j)+0.5*&
&          max44*field_old(i, k, j))
        fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&          1./12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*&
&          (field(i, k, j)-field(i, k-1, j)))) + vel*(7.*(fieldd(i, k, j)&
&          +fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k-2, j))/&
&          12.+SIGN(1, time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-&
&          fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.)
        fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&          12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*&
&          SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*&
&          (field(i, k, j)-field(i, k-1, j))))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs44d = crd
          abs44 = cr
        ELSE
          abs44d = -crd
          abs44 = -cr
        END IF
        y44d = crd + abs44d
        y44 = cr + abs44
        IF (1.0 .GT. y44) THEN
          min64d = y44d
          min64 = y44
        ELSE
          min64 = 1.0
          min64d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs95d = crd
          abs95 = cr
        ELSE
          abs95d = -crd
          abs95 = -cr
        END IF
        y95d = crd - abs95d
        y95 = cr - abs95
        IF (-1.0 .LT. y95) THEN
          max45d = y95d
          max45 = y95
        ELSE
          max45 = -1.0
          max45d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min64*field_old(i, k-1, j)+0.5*&
&          max45*field_old(i, k, j))+mu*(0.5*(min64d*field_old(i, k-1, j)&
&          +min64*field_oldd(i, k-1, j))+0.5*(max45d*field_old(i, k, j)+&
&          max45*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min64*field_old(i, k-1, j)+0.5*&
&          max45*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    fqzd = 0.0
    fqzld = 0.0
    DO j=j_start,j_end
      DO i=i_start,i_end
        fqzd(i, 1, j) = 0.0
        fqz(i, 1, j) = 0.
        fqzld(i, 1, j) = 0.0
        fqzl(i, 1, j) = 0.
        fqzd(i, kde, j) = 0.0
        fqz(i, kde, j) = 0.
        fqzld(i, kde, j) = 0.0
        fqzl(i, kde, j) = 0.
      END DO
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          dz = 2./(rdzw(k)+rdzw(k-1))
          mud = 0.5*2*mutd(i, j)
          mu = 0.5*(mut(i, j)+mut(i, j))
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs45d = crd
            abs45 = cr
          ELSE
            abs45d = -crd
            abs45 = -cr
          END IF
          y45d = crd + abs45d
          y45 = cr + abs45
          IF (1.0 .GT. y45) THEN
            min65d = y45d
            min65 = y45
          ELSE
            min65 = 1.0
            min65d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs96d = crd
            abs96 = cr
          ELSE
            abs96d = -crd
            abs96 = -cr
          END IF
          y96d = crd - abs96d
          y96 = cr - abs96
          IF (-1.0 .LT. y96) THEN
            max46d = y96d
            max46 = y96
          ELSE
            max46 = -1.0
            max46d = 0.0
          END IF
          fqzld(i, k, j) = dz*(mud*(0.5*min65*field_old(i, k-1, j)+0.5*&
&            max46*field_old(i, k, j))+mu*(0.5*(min65d*field_old(i, k-1, &
&            j)+min65*field_oldd(i, k-1, j))+0.5*(max46d*field_old(i, k, &
&            j)+max46*field_oldd(i, k, j))))/dt
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min65*field_old(i, k-1, j)+0.5&
&            *max46*field_old(i, k, j))
          fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))&
&            -1./12.*(field(i, k+1, j)+field(i, k-2, j))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+&
&            fieldd(i, k-2, j))/12.)
          fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&            1./12.*(field(i, k+1, j)+field(i, k-2, j)))
          fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs46d = crd
          abs46 = cr
        ELSE
          abs46d = -crd
          abs46 = -cr
        END IF
        y46d = crd + abs46d
        y46 = cr + abs46
        IF (1.0 .GT. y46) THEN
          min66d = y46d
          min66 = y46
        ELSE
          min66 = 1.0
          min66d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs97d = crd
          abs97 = cr
        ELSE
          abs97d = -crd
          abs97 = -cr
        END IF
        y97d = crd - abs97d
        y97 = cr - abs97
        IF (-1.0 .LT. y97) THEN
          max47d = y97d
          max47 = y97
        ELSE
          max47 = -1.0
          max47d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min66*field_old(i, k-1, j)+0.5*&
&          max47*field_old(i, k, j))+mu*(0.5*(min66d*field_old(i, k-1, j)&
&          +min66*field_oldd(i, k-1, j))+0.5*(max47d*field_old(i, k, j)+&
&          max47*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min66*field_old(i, k-1, j)+0.5*&
&          max47*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs47d = crd
          abs47 = cr
        ELSE
          abs47d = -crd
          abs47 = -cr
        END IF
        y47d = crd + abs47d
        y47 = cr + abs47
        IF (1.0 .GT. y47) THEN
          min67d = y47d
          min67 = y47
        ELSE
          min67 = 1.0
          min67d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs98d = crd
          abs98 = cr
        ELSE
          abs98d = -crd
          abs98 = -cr
        END IF
        y98d = crd - abs98d
        y98 = cr - abs98
        IF (-1.0 .LT. y98) THEN
          max48d = y98d
          max48 = y98
        ELSE
          max48 = -1.0
          max48d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min67*field_old(i, k-1, j)+0.5*&
&          max48*field_old(i, k, j))+mu*(0.5*(min67d*field_old(i, k-1, j)&
&          +min67*field_oldd(i, k-1, j))+0.5*(max48d*field_old(i, k, j)+&
&          max48*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min67*field_old(i, k-1, j)+0.5*&
&          max48*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    fqzd = 0.0
    fqzld = 0.0
    DO j=j_start,j_end
      DO i=i_start,i_end
        fqzd(i, 1, j) = 0.0
        fqz(i, 1, j) = 0.
        fqzld(i, 1, j) = 0.0
        fqzl(i, 1, j) = 0.
        fqzd(i, kde, j) = 0.0
        fqz(i, kde, j) = 0.
        fqzld(i, kde, j) = 0.0
        fqzl(i, kde, j) = 0.
      END DO
      DO k=kts+2,ktf-1
        DO i=i_start,i_end
          dz = 2./(rdzw(k)+rdzw(k-1))
          mud = 0.5*2*mutd(i, j)
          mu = 0.5*(mut(i, j)+mut(i, j))
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs48d = crd
            abs48 = cr
          ELSE
            abs48d = -crd
            abs48 = -cr
          END IF
          y48d = crd + abs48d
          y48 = cr + abs48
          IF (1.0 .GT. y48) THEN
            min68d = y48d
            min68 = y48
          ELSE
            min68 = 1.0
            min68d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs99d = crd
            abs99 = cr
          ELSE
            abs99d = -crd
            abs99 = -cr
          END IF
          y99d = crd - abs99d
          y99 = cr - abs99
          IF (-1.0 .LT. y99) THEN
            max49d = y99d
            max49 = y99
          ELSE
            max49 = -1.0
            max49d = 0.0
          END IF
          fqzld(i, k, j) = dz*(mud*(0.5*min68*field_old(i, k-1, j)+0.5*&
&            max49*field_old(i, k, j))+mu*(0.5*(min68d*field_old(i, k-1, &
&            j)+min68*field_oldd(i, k-1, j))+0.5*(max49d*field_old(i, k, &
&            j)+max49*field_oldd(i, k, j))))/dt
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min68*field_old(i, k-1, j)+0.5&
&            *max49*field_old(i, k, j))
          fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))&
&            -1./12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, &
&            time_step)*SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i&
&            , k-2, j)-3.*(field(i, k, j)-field(i, k-1, j)))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i, k-1, j))/12.-(fieldd(i, k+1, j)+&
&            fieldd(i, k-2, j))/12.+SIGN(1, time_step)*SIGN(1., -vel)*(&
&            fieldd(i, k+1, j)-fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-&
&            fieldd(i, k-1, j)))/12.)
          fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-&
&            1./12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step&
&            )*SIGN(1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)&
&            -3.*(field(i, k, j)-field(i, k-1, j))))
          fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
      END DO
      DO i=i_start,i_end
        k = kts + 1
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs49d = crd
          abs49 = cr
        ELSE
          abs49d = -crd
          abs49 = -cr
        END IF
        y49d = crd + abs49d
        y49 = cr + abs49
        IF (1.0 .GT. y49) THEN
          min69d = y49d
          min69 = y49
        ELSE
          min69 = 1.0
          min69d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs100d = crd
          abs100 = cr
        ELSE
          abs100d = -crd
          abs100 = -cr
        END IF
        y100d = crd - abs100d
        y100 = cr - abs100
        IF (-1.0 .LT. y100) THEN
          max50d = y100d
          max50 = y100
        ELSE
          max50 = -1.0
          max50d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min69*field_old(i, k-1, j)+0.5*&
&          max50*field_old(i, k, j))+mu*(0.5*(min69d*field_old(i, k-1, j)&
&          +min69*field_oldd(i, k-1, j))+0.5*(max50d*field_old(i, k, j)+&
&          max50*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min69*field_old(i, k-1, j)+0.5*&
&          max50*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs50d = crd
          abs50 = cr
        ELSE
          abs50d = -crd
          abs50 = -cr
        END IF
        y50d = crd + abs50d
        y50 = cr + abs50
        IF (1.0 .GT. y50) THEN
          min70d = y50d
          min70 = y50
        ELSE
          min70 = 1.0
          min70d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs101d = crd
          abs101 = cr
        ELSE
          abs101d = -crd
          abs101 = -cr
        END IF
        y101d = crd - abs101d
        y101 = cr - abs101
        IF (-1.0 .LT. y101) THEN
          max51d = y101d
          max51 = y101
        ELSE
          max51 = -1.0
          max51d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min70*field_old(i, k-1, j)+0.5*&
&          max51*field_old(i, k, j))+mu*(0.5*(min70d*field_old(i, k-1, j)&
&          +min70*field_oldd(i, k-1, j))+0.5*(max51d*field_old(i, k, j)+&
&          max51*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min70*field_old(i, k-1, j)+0.5*&
&          max51*field_old(i, k, j))
        fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k&
&          )*fieldd(i, k-1, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    fqzd = 0.0
    fqzld = 0.0
    DO j=j_start,j_end
      DO i=i_start,i_end
        fqzd(i, 1, j) = 0.0
        fqz(i, 1, j) = 0.
        fqzld(i, 1, j) = 0.0
        fqzl(i, 1, j) = 0.
        fqzd(i, kde, j) = 0.0
        fqz(i, kde, j) = 0.
        fqzld(i, kde, j) = 0.0
        fqzl(i, kde, j) = 0.
      END DO
      DO k=kts+1,ktf
        DO i=i_start,i_end
          dz = 2./(rdzw(k)+rdzw(k-1))
          mud = 0.5*2*mutd(i, j)
          mu = 0.5*(mut(i, j)+mut(i, j))
          veld = romd(i, k, j)
          vel = rom(i, k, j)
          crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs51d = crd
            abs51 = cr
          ELSE
            abs51d = -crd
            abs51 = -cr
          END IF
          y51d = crd + abs51d
          y51 = cr + abs51
          IF (1.0 .GT. y51) THEN
            min71d = y51d
            min71 = y51
          ELSE
            min71 = 1.0
            min71d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs102d = crd
            abs102 = cr
          ELSE
            abs102d = -crd
            abs102 = -cr
          END IF
          y102d = crd - abs102d
          y102 = cr - abs102
          IF (-1.0 .LT. y102) THEN
            max52d = y102d
            max52 = y102
          ELSE
            max52 = -1.0
            max52d = 0.0
          END IF
          fqzld(i, k, j) = dz*(mud*(0.5*min71*field_old(i, k-1, j)+0.5*&
&            max52*field_old(i, k, j))+mu*(0.5*(min71d*field_old(i, k-1, &
&            j)+min71*field_oldd(i, k-1, j))+0.5*(max52d*field_old(i, k, &
&            j)+max52*field_oldd(i, k, j))))/dt
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min71*field_old(i, k-1, j)+0.5&
&            *max52*field_old(i, k, j))
          fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp&
&            (k)*fieldd(i, k-1, j))
          fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))
          fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
      END DO
    END DO
  ELSE
    WRITE(wrf_err_message, *) ' advect_scalar_pd, v_order not known ', &
&    vert_order
    CALL WRF_ERROR_FATAL(wrf_err_message)
    fqzd = 0.0
    fqzld = 0.0
  END IF
  IF (pd_limit) THEN
! positive definite filter
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min72 = ide - 1
    ELSE
      min72 = ite
    END IF
    i_end = min72 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min73 = jde - 1
    ELSE
      min73 = jte
    END IF
    j_end = min73 + 1
!-- loop bounds for open or specified conditions
    IF (degrade_xs) THEN
      IF (its - 1 .LT. ids) THEN
        i_start = ids
      ELSE
        i_start = its - 1
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ite + 1 .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite + 1
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds) THEN
        j_start = jds
      ELSE
        j_start = jts - 1
      END IF
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte + 1
      END IF
    END IF
    IF (config_flags%specified .OR. config_flags%nested) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          i_start = ids + 1
        ELSE
          i_start = its - 1
        END IF
      END IF
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          i_end = ide - 2
        ELSE
          i_end = ite + 1
        END IF
      END IF
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          j_start = jds + 1
        ELSE
          j_start = jts - 1
        END IF
      END IF
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          j_end = jde - 2
        ELSE
          j_end = jte + 1
        END IF
      END IF
    END IF
    IF (config_flags%open_xs) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          i_start = ids + 1
        ELSE
          i_start = its - 1
        END IF
      END IF
    END IF
    IF (config_flags%open_xe) THEN
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          i_end = ide - 2
        ELSE
          i_end = ite + 1
        END IF
      END IF
    END IF
    IF (config_flags%open_ys) THEN
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          j_start = jds + 1
        ELSE
          j_start = jts - 1
        END IF
      END IF
    END IF
    IF (config_flags%open_ye) THEN
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          j_end = jde - 2
        ELSE
          j_end = jte + 1
        END IF
        ph_lowd = 0.0
      ELSE
        ph_lowd = 0.0
      END IF
    ELSE
      ph_lowd = 0.0
    END IF
! ADT note:
! We don't want to change j_start and j_end
! for polar BC's since we want to calculate
! fluxes for directions other than y at the
! edge
!-- here is the limiter...
    DO j=j_start,j_end
      DO k=kts,ktf
#ifdef XEON_SIMD
!DIR$ simd
#else
!DIR$ vector always
#endif
        DO i=i_start,i_end
          ph_lowd(i,k,j) = mu_oldd(i, j)*field_old(i, k, j) + (mub(i, j)+mu_old&
&            (i, j))*field_oldd(i, k, j) - dt*(msftx(i, j)*msfty(i, j)*(&
&            rdx*(fqxld(i+1, k, j)-fqxld(i, k, j))+rdy*(fqyld(i, k, j+1)-&
&            fqyld(i, k, j)))+msfty(i, j)*rdzw(k)*(fqzld(i, k+1, j)-fqzld&
&            (i, k, j)))
          ph_low(i,k,j) = (mub(i, j)+mu_old(i, j))*field_old(i, k, j) - dt*(&
&            msftx(i, j)*msfty(i, j)*(rdx*(fqxl(i+1, k, j)-fqxl(i, k, j))&
&            +rdy*(fqyl(i, k, j+1)-fqyl(i, k, j)))+msfty(i, j)*rdzw(k)*(&
&            fqzl(i, k+1, j)-fqzl(i, k, j)))
        ENDDO
      ENDDO
    ENDDO
    flux_outd = 0.0
    DO j=j_start,j_end
      DO k=kts,ktf
!DIR$ vector always
        DO i=i_start,i_end
          IF (0. .LT. fqx(i+1, k, j)) THEN
            max1d = fqxd(i+1, k, j)
            max1 = fqx(i+1, k, j)
          ELSE
            max1 = 0.
            max1d = 0.0
          END IF
          IF (0. .GT. fqx(i, k, j)) THEN
            min74d = fqxd(i, k, j)
            min74 = fqx(i, k, j)
          ELSE
            min74 = 0.
            min74d = 0.0
          END IF
          IF (0. .LT. fqy(i, k, j+1)) THEN
            max53d = fqyd(i, k, j+1)
            max53 = fqy(i, k, j+1)
          ELSE
            max53 = 0.
            max53d = 0.0
          END IF
          IF (0. .GT. fqy(i, k, j)) THEN
            min75d = fqyd(i, k, j)
            min75 = fqy(i, k, j)
          ELSE
            min75 = 0.
            min75d = 0.0
          END IF
          IF (0. .GT. fqz(i, k+1, j)) THEN
            min76d = fqzd(i, k+1, j)
            min76 = fqz(i, k+1, j)
          ELSE
            min76 = 0.
            min76d = 0.0
          END IF
          IF (0. .LT. fqz(i, k, j)) THEN
            max54d = fqzd(i, k, j)
            max54 = fqz(i, k, j)
          ELSE
            max54 = 0.
            max54d = 0.0
          END IF
          flux_outd(i,k,j) = dt*(msftx(i, j)*msfty(i, j)*(rdx*(max1d-min74d)+&
&            rdy*(max53d-min75d))+msfty(i, j)*rdzw(k)*(min76d-max54d))
          flux_out(i,k,j) = dt*(msftx(i, j)*msfty(i, j)*(rdx*(max1-min74)+rdy*(&
&            max53-min75))+msfty(i, j)*rdzw(k)*(min76-max54))
        ENDDO
      ENDDO
    ENDDO
    DO j=j_start,j_end
      DO k=kts,ktf
!DIR$ vector always
        DO i=i_start,i_end
          IF (flux_out(i,k,j) .GT. ph_low(i,k,j)) THEN
            y16d = (ph_lowd(i,k,j)*(flux_out(i,k,j)+eps)-ph_low(i,k,j)*flux_outd(i,k,j))/(&
&                flux_out(i,k,j)+eps)**2
            y16 = ph_low(i,k,j)/(flux_out(i,k,j)+eps)
            IF (0. .LT. y16) THEN
              scaled = y16d
              scale = y16
            ELSE
              scale = 0.
              scaled = 0.0
            END IF
            IF (fqx(i+1, k, j) .GT. 0.) THEN
              fqxd(i+1, k, j) = scaled*fqx(i+1, k, j) + scale*fqxd(i+1, &
&                k, j)
              fqx(i+1, k, j) = scale*fqx(i+1, k, j)
            END IF
            IF (fqx(i, k, j) .LT. 0.) THEN
              fqxd(i, k, j) = scaled*fqx(i, k, j) + scale*fqxd(i, k, j)
              fqx(i, k, j) = scale*fqx(i, k, j)
            END IF
            IF (fqy(i, k, j+1) .GT. 0.) THEN
              fqyd(i, k, j+1) = scaled*fqy(i, k, j+1) + scale*fqyd(i, k&
&                , j+1)
              fqy(i, k, j+1) = scale*fqy(i, k, j+1)
            END IF
            IF (fqy(i, k, j) .LT. 0.) THEN
              fqyd(i, k, j) = scaled*fqy(i, k, j) + scale*fqyd(i, k, j)
              fqy(i, k, j) = scale*fqy(i, k, j)
            END IF
!  note: z flux is opposite sign in mass coordinate because 
!  vertical coordinate decreases with increasing k
            IF (fqz(i, k+1, j) .LT. 0.) THEN
              fqzd(i, k+1, j) = scaled*fqz(i, k+1, j) + scale*fqzd(i, k+&
&                1, j)
              fqz(i, k+1, j) = scale*fqz(i, k+1, j)
            END IF
            IF (fqz(i, k, j) .GT. 0.) THEN
              fqzd(i, k, j) = scaled*fqz(i, k, j) + scale*fqzd(i, k, j)
              fqz(i, k, j) = scale*fqz(i, k, j)
            END IF
          END IF
        END DO
      END DO
    END DO
  END IF
! add in the pd-limited flux divergence
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(fqzd(i, k+1, &
&          j)-fqzd(i, k, j)+fqzld(i, k+1, j)-fqzld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(fqz(i, k+1, j)-&
&          fqz(i, k, j)+fqzl(i, k+1, j)-fqzl(i, k, j))
      END DO
    END DO
  END DO
  IF (tenddec) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          z_tendencyd(i, k, j) = -(rdzw(k)*(fqzd(i, k+1, j)-fqzd(i, k, j&
&            )+fqzld(i, k+1, j)-fqzld(i, k, j)))
          z_tendency(i, k, j) = 0. - rdzw(k)*(fqz(i, k+1, j)-fqz(i, k, j&
&            )+fqzl(i, k+1, j)-fqzl(i, k, j))
        END DO
      END DO
    END DO
  END IF
! x flux divergence
!
  IF (degrade_xs) THEN
    IF (its .LT. ids + 1) THEN
      i_start = ids + 1
    ELSE
      i_start = its
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ite .GT. ide - 2) THEN
      i_end = ide - 2
    ELSE
      i_end = ite
    END IF
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
! Un-"canceled" map scale factor, ADT Eq. 48
        tendencyd(i, k, j) = tendencyd(i, k, j) - msftx(i, j)*rdx*(fqxd(&
&          i+1, k, j)-fqxd(i, k, j)+fqxld(i+1, k, j)-fqxld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - msftx(i, j)*(rdx*(fqx(i+&
&          1, k, j)-fqx(i, k, j)+fqxl(i+1, k, j)-fqxl(i, k, j)))
      END DO
    END DO
  END DO
  IF (tenddec) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          h_tendencyd(i, k, j) = -(msftx(i, j)*rdx*(fqxd(i+1, k, j)-fqxd&
&            (i, k, j)+fqxld(i+1, k, j)-fqxld(i, k, j)))
          h_tendency(i, k, j) = 0. - msftx(i, j)*(rdx*(fqx(i+1, k, j)-&
&            fqx(i, k, j)+fqxl(i+1, k, j)-fqxl(i, k, j)))
        END DO
      END DO
    END DO
  END IF
! y flux divergence
!
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  IF (degrade_ys) THEN
    IF (jts .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts
    END IF
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 2) THEN
      j_end = jde - 2
    ELSE
      j_end = jte
    END IF
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
! Un-"canceled" map scale factor, ADT Eq. 48
! It is correct to use msftx (and not msfty), per W. Skamarock, 20080606
        tendencyd(i, k, j) = tendencyd(i, k, j) - msftx(i, j)*rdy*(fqyd(&
&          i, k, j+1)-fqyd(i, k, j)+fqyld(i, k, j+1)-fqyld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - msftx(i, j)*(rdy*(fqy(i&
&          , k, j+1)-fqy(i, k, j)+fqyl(i, k, j+1)-fqyl(i, k, j)))
      END DO
    END DO
  END DO
  IF (tenddec) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          h_tendencyd(i, k, j) = h_tendencyd(i, k, j) - msftx(i, j)*rdy*&
&            (fqyd(i, k, j+1)-fqyd(i, k, j)+fqyld(i, k, j+1)-fqyld(i, k, &
&            j))
          h_tendency(i, k, j) = h_tendency(i, k, j) - msftx(i, j)*(rdy*(&
&            fqy(i, k, j+1)-fqy(i, k, j)+fqyl(i, k, j+1)-fqyl(i, k, j)))
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE G_ADVECT_SCALAR_PD

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_scalar_wenopd in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom field tendency ru rv mu_old
!                field_old mut
!   RW status of diff variables: rom:in field:in tendency:in-out
!                ru:in rv:in mu_old:in field_old:in mut:in
SUBROUTINE G_ADVECT_SCALAR_WENOPD(field, fieldd, field_old, field_oldd, &
&  tendency, tendencyd, ru, rud, rv, rvd, rom, romd, mut, mutd, mub, &
&  mu_old, mu_oldd, time_step, config_flags, msfux, msfuy, msfvx, msfvy, &
&  msftx, msfty, fzm, fzp, rdx, rdy, rdzw, dt, ids, ide, jds, jde, kds, &
&  kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: field, &
&  field_old, ru, rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: fieldd, &
&  field_oldd, rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut, mub, mu_old
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd, mu_oldd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy, dt
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw, mu
  REAL :: ubd, vbd, mud
!  storage for high and low order fluxes
  REAL, DIMENSION(its - 1:ite + 2, kts:kte, jts - 1:jte + 2) :: fqx, fqy&
&  , fqz
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: fqxd, fqyd, fqzd
  REAL, DIMENSION(its - 1:ite + 2, kts:kte, jts - 1:jte + 2) :: fqxl, &
&  fqyl, fqzl
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: fqxld, fqyld, &
&  fqzld
  INTEGER :: horz_order, vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: flux_out, ph_low
  REAL, DIMENSION(its-1:ite+2, kts:kte, jts-1:jte+2) :: flux_outd, ph_lowd
  REAL :: scale
  REAL :: scaled
  REAL, PARAMETER :: eps=1.e-20
  REAL :: dir, vv
  REAL :: ue, vs, vn, wb, wt
  REAL, PARAMETER :: f30=7./12., f31=1./12.
  REAL, PARAMETER :: f50=37./60., f51=2./15., f52=1./60.
  REAL :: qim2, qim1, qi, qip1, qip2
  REAL :: qim2d, qim1d, qid, qip1d, qip2d
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0d, beta1d, beta2d, f0d, f1d, f2d, wi0d, wi1d&
&  , wi2d, sumwkd
  DOUBLE PRECISION, PARAMETER :: gi0=1.d0/10.d0, gi1=6.d0/10.d0, gi2=&
&    3.d0/10.d0, eps1=1.0d-28
  INTEGER, PARAMETER :: pw=2
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6, flux_upwind
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel, cr
  REAL :: veld, crd
!      flux_upwind(q_im1, q_i, cr ) = 0.5*(1.+sign(1.,cr))*q_im1 &
!                                    +0.5*(1.-sign(1.,cr))*q_i
!      flux_upwind(q_im1, q_i, cr ) = 0.
  REAL :: dx, dy, dz
  LOGICAL, PARAMETER :: pd_limit=.true.
  DOUBLE PRECISION :: pwx1
  DOUBLE PRECISION :: pwx1d
  DOUBLE PRECISION :: pwr1
  DOUBLE PRECISION :: pwr1d
  REAL :: abs18d
  REAL :: abs26d
  REAL :: min5d
  REAL :: max10d
  REAL :: y28d
  REAL :: y4d
  INTEGER :: min9
  REAL :: abs29d
  INTEGER :: min8
  REAL :: max13d
  REAL :: min7
  REAL :: abs1d
  REAL :: y29
  REAL :: min6
  REAL :: y10d
  REAL :: y28
  REAL :: min5
  REAL :: y27
  REAL :: min4
  REAL :: max2d
  REAL :: y7d
  REAL :: min11d
  REAL :: y26
  REAL :: min3
  REAL :: y25
  INTEGER :: min2
  REAL :: y24
  INTEGER :: min1
  REAL :: max16d
  REAL :: y23
  REAL :: abs4d
  REAL :: abs11d
  REAL :: y22
  REAL :: y13d
  REAL :: y21
  REAL :: y21d
  REAL :: y20
  REAL :: max5d
  REAL :: min14d
  REAL :: abs29
  INTRINSIC MAX
  REAL :: abs28
  REAL :: abs27
  REAL :: abs7d
  REAL :: abs14d
  REAL :: abs26
  REAL :: y16d
  REAL :: abs22d
  INTRINSIC SIGN
  REAL :: abs25
  REAL :: y24d
  REAL :: abs24
  REAL :: max8d
  REAL :: min17d
  REAL :: abs23
  REAL :: min25d
  INTRINSIC ABS
  REAL :: abs22
  REAL :: abs21
  REAL :: abs20
  REAL :: abs17d
  REAL :: y19d
  REAL :: abs25d
  REAL :: min4d
  REAL :: y27d
  REAL :: y3d
  REAL :: abs28d
  REAL :: min7d
  REAL :: max12d
  REAL :: min26
  REAL :: abs0d
  REAL :: y19
  REAL :: min25
  REAL :: y18
  REAL :: min24
  REAL :: y17
  INTEGER :: min23
  REAL :: y6d
  REAL :: min10d
  REAL :: max1d
  REAL :: y16
  INTEGER :: min22
  REAL :: y15
  REAL :: min21
  REAL :: y14
  REAL :: min20
  REAL :: max15d
  REAL :: y13
  REAL :: abs3d
  REAL :: abs10d
  REAL :: y12
  REAL :: y12d
  REAL :: y11
  REAL :: y20d
  REAL :: y10
  REAL :: max4d
  REAL :: y9d
  REAL :: min13d
  REAL :: min21d
  REAL :: abs19
  REAL :: abs18
  REAL :: max18d
  REAL :: abs17
  REAL :: abs6d
  REAL :: abs13d
  REAL :: abs16
  REAL :: abs21d
  REAL :: y15d
  REAL :: abs15
  REAL :: y23d
  REAL :: abs14
  REAL :: max7d
  REAL :: abs13
  REAL :: min24d
  REAL :: abs12
  REAL :: abs11
  REAL :: abs10
  REAL :: abs16d
  REAL :: abs9d
  REAL :: y18d
  REAL :: abs24d
  REAL :: min3d
  REAL :: y26d
  REAL :: min19d
  REAL :: y2d
  REAL :: min19
  REAL :: abs19d
  REAL :: min18
  REAL :: abs27d
  REAL :: min17
  REAL :: min6d
  REAL :: max11d
  REAL :: y29d
  INTEGER :: min16
  REAL :: abs9
  INTEGER :: min15
  REAL :: abs8
  REAL :: min14
  REAL :: abs7
  REAL :: min13
  REAL :: abs6
  REAL :: y5d
  REAL :: min12
  REAL :: abs5
  REAL :: min11
  REAL :: abs4
  REAL :: min10
  REAL :: abs3
  REAL :: max14d
  REAL :: abs2
  REAL :: abs2d
  REAL :: abs1
  REAL :: y11d
  REAL :: abs0
  REAL :: max3d
  REAL :: y8d
  REAL :: min12d
  REAL :: min20d
  INTRINSIC MIN
  REAL :: max17d
  REAL :: max9
  REAL :: abs5d
  REAL :: abs12d
  REAL :: max8
  REAL :: abs20d
  REAL :: y14d
  REAL :: max7
  REAL :: max18
  REAL :: y22d
  REAL :: y30
  REAL :: max6
  REAL :: max17
  REAL :: max6d
  REAL :: y30d
  REAL :: max5
  REAL :: max16
  REAL :: y9
  REAL :: max4
  REAL :: max15
  REAL :: y8
  REAL :: max3
  REAL :: max14
  REAL :: y7
  REAL :: max2
  REAL :: max13
  REAL :: abs15d
  REAL :: abs8d
  REAL :: y6
  REAL :: max1
  REAL :: max12
  REAL :: y17d
  REAL :: abs23d
  REAL :: y5
  REAL :: max11
  REAL :: y25d
  REAL :: y4
  REAL :: max10
  REAL :: max9d
  REAL :: min18d
  REAL :: y3
  REAL :: min26d
  REAL :: y2
  REAL :: y1
  REAL :: y1d





! set order for the advection schemes
!  write(6,*) ' in pd advection routine '
! Empty arrays just in case:
  IF (config_flags%polar) THEN
    fqx(:, :, :) = 0.
    fqy(:, :, :) = 0.
    fqz(:, :, :) = 0.
    fqxl(:, :, :) = 0.
    fqyl(:, :, :) = 0.
    fqzl(:, :, :) = 0.
  END IF
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_sca_adv_order
  vert_order = config_flags%v_sca_adv_order
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
  degrade_xs = .true.
  degrade_xe = .true.
  degrade_ys = .true.
  degrade_ye = .true.
!  begin with horizontal flux divergence
!  here is the choice of flux operators
!  horizontal_order_test : IF( horz_order == 6 ) THEN
!    ELSE IF( horz_order == 5 ) THEN
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. its &
&      .GT. ids + 3) degrade_xs = .false.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. ite &
&      .LT. ide - 4) degrade_xe = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. jts &
&      .GT. jds + 3) degrade_ys = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. jte &
&      .LT. jde - 4) degrade_ye = .false.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  i_start = its - 1
  IF (ite .GT. ide - 1) THEN
    min1 = ide - 1
  ELSE
    min1 = ite
  END IF
  i_end = min1 + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min2 = jde - 1
  ELSE
    min2 = jte
  END IF
  j_end = min2 + 1
  j_start_f = j_start
  j_end_f = j_end + 1
!--  modify loop bounds if open or specified
!      IF(degrade_xs) i_start = MAX(its-1,ids-1)
!      IF(degrade_xe) i_end   = MIN(ite+1,ide-2)
  IF (degrade_xs) THEN
    IF (its - 1 .LT. ids) THEN
      i_start = ids
    ELSE
      i_start = its - 1
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ite + 1 .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite + 1
    END IF
  END IF
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts - 1
    END IF
    j_start_f = jds + 3
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 2) THEN
      j_end = jde - 2
    ELSE
      j_end = jte + 1
    END IF
    j_end_f = jde - 3
    fqyld = 0.0
    fqyd = 0.0
  ELSE
    fqyld = 0.0
    fqyd = 0.0
  END IF
!  compute fluxes, 5th order
j_loop_y_flux_5:DO j=j_start,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs0d = crd
            abs0 = cr
          ELSE
            abs0d = -crd
            abs0 = -cr
          END IF
          y1d = crd + abs0d
          y1 = cr + abs0
          IF (1.0 .GT. y1) THEN
            min3d = y1d
            min3 = y1
          ELSE
            min3 = 1.0
            min3d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs15d = crd
            abs15 = cr
          ELSE
            abs15d = -crd
            abs15 = -cr
          END IF
          y16d = crd - abs15d
          y16 = cr - abs15
          IF (-1.0 .LT. y16) THEN
            max2d = y16d
            max2 = y16
          ELSE
            max2 = -1.0
            max2d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min3*field_old(i, k, j-1)+0.5*&
&            max2*field_old(i, k, j))+mu*(0.5*(min3d*field_old(i, k, j-1)&
&            +min3*field_oldd(i, k, j-1))+0.5*(max2d*field_old(i, k, j)+&
&            max2*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min3*field_old(i, k, j-1)+0.5*&
&            max2*field_old(i, k, j))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            qip2d = fieldd(i, k, j+1)
            qip2 = field(i, k, j+1)
            qip1d = fieldd(i, k, j)
            qip1 = field(i, k, j)
            qid = fieldd(i, k, j-1)
            qi = field(i, k, j-1)
            qim1d = fieldd(i, k, j-2)
            qim1 = field(i, k, j-2)
            qim2d = fieldd(i, k, j-3)
            qim2 = field(i, k, j-3)
          ELSE
            qip2d = fieldd(i, k, j-2)
            qip2 = field(i, k, j-2)
            qip1d = fieldd(i, k, j-1)
            qip1 = field(i, k, j-1)
            qid = fieldd(i, k, j)
            qi = field(i, k, j)
            qim1d = fieldd(i, k, j+1)
            qim1 = field(i, k, j+1)
            qim2d = fieldd(i, k, j+2)
            qim2 = field(i, k, j+2)
          END IF
          f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*&
&            (qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*&
&            (qim1-qip1)*(qim1d-qip1d)/4.
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*&
&            (qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
          pwx1d = beta0d
          pwx1 = eps1 + beta0
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi0d = -(gi0*pwr1d/pwr1**2)
          wi0 = gi0/pwr1
          pwx1d = beta1d
          pwx1 = eps1 + beta1
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi1d = -(gi1*pwr1d/pwr1**2)
          wi1 = gi1/pwr1
          pwx1d = beta2d
          pwx1 = eps1 + beta2
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi2d = -(gi2*pwr1d/pwr1**2)
          wi2 = gi2/pwr1
          sumwkd = wi0d + wi1d + wi2d
          sumwk = wi0 + wi1 + wi2
          fqyd(i, k, j) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0&
&            *f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1&
&            *f1+wi2*f2)*sumwkd)/sumwk**2
          fqy(i, k, j) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
!          fqy( i, k, j  ) = vel*flux5(                                  &
!                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
!                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs1d = crd
            abs1 = cr
          ELSE
            abs1d = -crd
            abs1 = -cr
          END IF
          y2d = crd + abs1d
          y2 = cr + abs1
          IF (1.0 .GT. y2) THEN
            min4d = y2d
            min4 = y2
          ELSE
            min4 = 1.0
            min4d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs16d = crd
            abs16 = cr
          ELSE
            abs16d = -crd
            abs16 = -cr
          END IF
          y17d = crd - abs16d
          y17 = cr - abs16
          IF (-1.0 .LT. y17) THEN
            max3d = y17d
            max3 = y17
          ELSE
            max3 = -1.0
            max3d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min4*field_old(i, k, j-1)+0.5*&
&            max3*field_old(i, k, j))+mu*(0.5*(min4d*field_old(i, k, j-1)&
&            +min4*field_oldd(i, k, j-1))+0.5*(max3d*field_old(i, k, j)+&
&            max3*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min4*field_old(i, k, j-1)+0.5*&
&            max3*field_old(i, k, j))
          fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k, &
&            j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&            ))
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs2d = crd
            abs2 = cr
          ELSE
            abs2d = -crd
            abs2 = -cr
          END IF
          y3d = crd + abs2d
          y3 = cr + abs2
          IF (1.0 .GT. y3) THEN
            min5d = y3d
            min5 = y3
          ELSE
            min5 = 1.0
            min5d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs17d = crd
            abs17 = cr
          ELSE
            abs17d = -crd
            abs17 = -cr
          END IF
          y18d = crd - abs17d
          y18 = cr - abs17
          IF (-1.0 .LT. y18) THEN
            max4d = y18d
            max4 = y18
          ELSE
            max4 = -1.0
            max4d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min5*field_old(i, k, j-1)+0.5*&
&            max4*field_old(i, k, j))+mu*(0.5*(min5d*field_old(i, k, j-1)&
&            +min5*field_oldd(i, k, j-1))+0.5*(max4d*field_old(i, k, j)+&
&            max4*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min5*field_old(i, k, j-1)+0.5*&
&            max4*field_old(i, k, j))
          fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&            -1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&            time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(i&
&            , k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+&
&            fieldd(i, k, j-2))/12.+SIGN(1, time_step)*SIGN(1., vel)*(&
&            fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)-&
&            fieldd(i, k, j-1)))/12.)
          fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))-&
&            1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, time_step&
&            )*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-&
&            3.*(field(i, k, j)-field(i, k, j-1))))
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs3d = crd
            abs3 = cr
          ELSE
            abs3d = -crd
            abs3 = -cr
          END IF
          y4d = crd + abs3d
          y4 = cr + abs3
          IF (1.0 .GT. y4) THEN
            min6d = y4d
            min6 = y4
          ELSE
            min6 = 1.0
            min6d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs18d = crd
            abs18 = cr
          ELSE
            abs18d = -crd
            abs18 = -cr
          END IF
          y19d = crd - abs18d
          y19 = cr - abs18
          IF (-1.0 .LT. y19) THEN
            max5d = y19d
            max5 = y19
          ELSE
            max5 = -1.0
            max5d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min6*field_old(i, k, j-1)+0.5*&
&            max5*field_old(i, k, j))+mu*(0.5*(min6d*field_old(i, k, j-1)&
&            +min6*field_oldd(i, k, j-1))+0.5*(max5d*field_old(i, k, j)+&
&            max5*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min6*field_old(i, k, j-1)+0.5*&
&            max5*field_old(i, k, j))
          fqyd(i, k, j) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i, k, &
&            j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1)))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&            ))
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          mud = 0.5*(mutd(i, j)+mutd(i, j-1))
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          veld = rvd(i, k, j)
          vel = rv(i, k, j)
          crd = (dt*veld*mu/dy-vel*dt*mud/dy)/mu**2
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs4d = crd
            abs4 = cr
          ELSE
            abs4d = -crd
            abs4 = -cr
          END IF
          y5d = crd + abs4d
          y5 = cr + abs4
          IF (1.0 .GT. y5) THEN
            min7d = y5d
            min7 = y5
          ELSE
            min7 = 1.0
            min7d = 0.0
          END IF
          IF (cr .GE. 0.) THEN
            abs19d = crd
            abs19 = cr
          ELSE
            abs19d = -crd
            abs19 = -cr
          END IF
          y20d = crd - abs19d
          y20 = cr - abs19
          IF (-1.0 .LT. y20) THEN
            max6d = y20d
            max6 = y20
          ELSE
            max6 = -1.0
            max6d = 0.0
          END IF
          fqyld(i, k, j) = dy*(mud*(0.5*min7*field_old(i, k, j-1)+0.5*&
&            max6*field_old(i, k, j))+mu*(0.5*(min7d*field_old(i, k, j-1)&
&            +min7*field_oldd(i, k, j-1))+0.5*(max6d*field_old(i, k, j)+&
&            max6*field_oldd(i, k, j))))/dt
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min7*field_old(i, k, j-1)+0.5*&
&            max6*field_old(i, k, j))
          fqyd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k, j-1))&
&            -1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, &
&            time_step)*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(i&
&            , k, j-2)-3.*(field(i, k, j)-field(i, k, j-1)))) + vel*(7.*(&
&            fieldd(i, k, j)+fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+&
&            fieldd(i, k, j-2))/12.+SIGN(1, time_step)*SIGN(1., vel)*(&
&            fieldd(i, k, j+1)-fieldd(i, k, j-2)-3.*(fieldd(i, k, j)-&
&            fieldd(i, k, j-1)))/12.)
          fqy(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1))-&
&            1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1, time_step&
&            )*SIGN(1., vel)*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-&
&            3.*(field(i, k, j)-field(i, k, j-1))))
          fqyd(i, k, j) = fqyd(i, k, j) - fqyld(i, k, j)
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
      END DO
    END IF
  END DO j_loop_y_flux_5
!  next, x flux
!--  these bounds are for periodic and sym conditions
  i_start = its - 1
  IF (ite .GT. ide - 1) THEN
    min8 = ide - 1
  ELSE
    min8 = ite
  END IF
  i_end = min8 + 1
  i_start_f = i_start
  i_end_f = i_end + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min9 = jde - 1
  ELSE
    min9 = jte
  END IF
  j_end = min9 + 1
!--  modify loop bounds for open and specified b.c
!      IF(degrade_ys) j_start = MAX(jts-1,jds+1)
!      IF(degrade_ye) j_end   = MIN(jte+1,jde-2)
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds) THEN
      j_start = jds
    ELSE
      j_start = jts - 1
    END IF
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte + 1
    END IF
  END IF
  IF (degrade_xs) THEN
    IF (ids + 1 .LT. its - 1) THEN
      i_start = its - 1
    ELSE
      i_start = ids + 1
    END IF
    i_start_f = ids + 3
  END IF
  IF (degrade_xe) THEN
    IF (ide - 2 .GT. ite + 1) THEN
      i_end = ite + 1
    ELSE
      i_end = ide - 2
    END IF
    i_end_f = ide - 3
    fqxld = 0.0
    fqxd = 0.0
  ELSE
    fqxld = 0.0
    fqxd = 0.0
  END IF
!  compute fluxes
  DO j=j_start,j_end
!  5th order flux
    DO k=kts,ktf
      DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
        dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
        mud = 0.5*(mutd(i, j)+mutd(i-1, j))
        mu = 0.5*(mut(i, j)+mut(i-1, j))
        veld = rud(i, k, j)
        vel = ru(i, k, j)
        crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
        cr = vel*dt/dx/mu
        IF (cr .GE. 0.) THEN
          abs5d = crd
          abs5 = cr
        ELSE
          abs5d = -crd
          abs5 = -cr
        END IF
        y6d = crd + abs5d
        y6 = cr + abs5
        IF (1.0 .GT. y6) THEN
          min10d = y6d
          min10 = y6
        ELSE
          min10 = 1.0
          min10d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs20d = crd
          abs20 = cr
        ELSE
          abs20d = -crd
          abs20 = -cr
        END IF
        y21d = crd - abs20d
        y21 = cr - abs20
        IF (-1.0 .LT. y21) THEN
          max7d = y21d
          max7 = y21
        ELSE
          max7 = -1.0
          max7d = 0.0
        END IF
        fqxld(i, k, j) = dx*(mud*(0.5*min10*field_old(i-1, k, j)+0.5*&
&          max7*field_old(i, k, j))+mu*(0.5*(min10d*field_old(i-1, k, j)+&
&          min10*field_oldd(i-1, k, j))+0.5*(max7d*field_old(i, k, j)+&
&          max7*field_oldd(i, k, j))))/dt
        fqxl(i, k, j) = mu*(dx/dt)*(0.5*min10*field_old(i-1, k, j)+0.5*&
&          max7*field_old(i, k, j))
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = fieldd(i+1, k, j)
          qip2 = field(i+1, k, j)
          qip1d = fieldd(i, k, j)
          qip1 = field(i, k, j)
          qid = fieldd(i-1, k, j)
          qi = field(i-1, k, j)
          qim1d = fieldd(i-2, k, j)
          qim1 = field(i-2, k, j)
          qim2d = fieldd(i-3, k, j)
          qim2 = field(i-3, k, j)
        ELSE
          qip2d = fieldd(i-2, k, j)
          qip2 = field(i-2, k, j)
          qip1d = fieldd(i-1, k, j)
          qip1 = field(i-1, k, j)
          qid = fieldd(i, k, j)
          qi = field(i, k, j)
          qim1d = fieldd(i+1, k, j)
          qim1 = field(i+1, k, j)
          qim2d = fieldd(i+2, k, j)
          qim2 = field(i+2, k, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps1 + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps1 + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps1 + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqxd(i, k, j) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        fqx(i, k, j) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
!          fqx( i,k,j ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
!                                         field(i-1,k,j), field(i  ,k,j),  &
!                                         field(i+1,k,j), field(i+2,k,j),  &
!                                         vel                             )
        fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
        fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
      END DO
    END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
    IF (degrade_xs) THEN
      DO i=i_start,i_start_f-1
        IF (i .EQ. ids + 1) THEN
! second order
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = (rud(i, k, j)*mu-ru(i, k, j)*mud)/mu**2
            vel = ru(i, k, j)/mu
            crd = dt*veld/dx
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs6d = crd
              abs6 = cr
            ELSE
              abs6d = -crd
              abs6 = -cr
            END IF
            y7d = crd + abs6d
            y7 = cr + abs6
            IF (1.0 .GT. y7) THEN
              min11d = y7d
              min11 = y7
            ELSE
              min11 = 1.0
              min11d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs21d = crd
              abs21 = cr
            ELSE
              abs21d = -crd
              abs21 = -cr
            END IF
            y22d = crd - abs21d
            y22 = cr - abs21
            IF (-1.0 .LT. y22) THEN
              max8d = y22d
              max8 = y22
            ELSE
              max8 = -1.0
              max8d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min11*field_old(i-1, k, j)+0.5&
&              *max8*field_old(i, k, j))+mu*(0.5*(min11d*field_old(i-1, k&
&              , j)+min11*field_oldd(i-1, k, j))+0.5*(max8d*field_old(i, &
&              k, j)+max8*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min11*field_old(i-1, k, j)+&
&              0.5*max8*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
        IF (i .EQ. ids + 2) THEN
! third order
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = rud(i, k, j)
            vel = ru(i, k, j)
            crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs7d = crd
              abs7 = cr
            ELSE
              abs7d = -crd
              abs7 = -cr
            END IF
            y8d = crd + abs7d
            y8 = cr + abs7
            IF (1.0 .GT. y8) THEN
              min12d = y8d
              min12 = y8
            ELSE
              min12 = 1.0
              min12d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs22d = crd
              abs22 = cr
            ELSE
              abs22d = -crd
              abs22 = -cr
            END IF
            y23d = crd - abs22d
            y23 = cr - abs22
            IF (-1.0 .LT. y23) THEN
              max9d = y23d
              max9 = y23
            ELSE
              max9 = -1.0
              max9d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min12*field_old(i-1, k, j)+0.5&
&              *max9*field_old(i, k, j))+mu*(0.5*(min12d*field_old(i-1, k&
&              , j)+min12*field_oldd(i-1, k, j))+0.5*(max9d*field_old(i, &
&              k, j)+max9*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min12*field_old(i-1, k, j)+&
&              0.5*max9*field_old(i, k, j))
            fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j&
&              ))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(&
&              i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j)))) + vel*(&
&              7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k&
&              , j)+fieldd(i-2, k, j))/12.+SIGN(1, time_step)*SIGN(1., &
&              vel)*(fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i, k&
&              , j)-fieldd(i-1, k, j)))/12.)
            fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))&
&              -1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(&
&              i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j))))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END DO
    END IF
    IF (degrade_xe) THEN
      DO i=i_end_f+1,i_end+1
        IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = rud(i, k, j)
            vel = ru(i, k, j)
            crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs8d = crd
              abs8 = cr
            ELSE
              abs8d = -crd
              abs8 = -cr
            END IF
            y9d = crd + abs8d
            y9 = cr + abs8
            IF (1.0 .GT. y9) THEN
              min13d = y9d
              min13 = y9
            ELSE
              min13 = 1.0
              min13d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs23d = crd
              abs23 = cr
            ELSE
              abs23d = -crd
              abs23 = -cr
            END IF
            y24d = crd - abs23d
            y24 = cr - abs23
            IF (-1.0 .LT. y24) THEN
              max10d = y24d
              max10 = y24
            ELSE
              max10 = -1.0
              max10d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min13*field_old(i-1, k, j)+0.5&
&              *max10*field_old(i, k, j))+mu*(0.5*(min13d*field_old(i-1, &
&              k, j)+min13*field_oldd(i-1, k, j))+0.5*(max10d*field_old(i&
&              , k, j)+max10*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min13*field_old(i-1, k, j)+&
&              0.5*max10*field_old(i, k, j))
            fqxd(i, k, j) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1&
&              , k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
        IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
          DO k=kts,ktf
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            mud = 0.5*(mutd(i, j)+mutd(i-1, j))
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            veld = rud(i, k, j)
            vel = ru(i, k, j)
            crd = (dt*veld*mu/dx-vel*dt*mud/dx)/mu**2
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs9d = crd
              abs9 = cr
            ELSE
              abs9d = -crd
              abs9 = -cr
            END IF
            y10d = crd + abs9d
            y10 = cr + abs9
            IF (1.0 .GT. y10) THEN
              min14d = y10d
              min14 = y10
            ELSE
              min14 = 1.0
              min14d = 0.0
            END IF
            IF (cr .GE. 0.) THEN
              abs24d = crd
              abs24 = cr
            ELSE
              abs24d = -crd
              abs24 = -cr
            END IF
            y25d = crd - abs24d
            y25 = cr - abs24
            IF (-1.0 .LT. y25) THEN
              max11d = y25d
              max11 = y25
            ELSE
              max11 = -1.0
              max11d = 0.0
            END IF
            fqxld(i, k, j) = dx*(mud*(0.5*min14*field_old(i-1, k, j)+0.5&
&              *max11*field_old(i, k, j))+mu*(0.5*(min14d*field_old(i-1, &
&              k, j)+min14*field_oldd(i-1, k, j))+0.5*(max11d*field_old(i&
&              , k, j)+max11*field_oldd(i, k, j))))/dt
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min14*field_old(i-1, k, j)+&
&              0.5*max11*field_old(i, k, j))
            fqxd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j&
&              ))-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(&
&              i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j)))) + vel*(&
&              7.*(fieldd(i, k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k&
&              , j)+fieldd(i-2, k, j))/12.+SIGN(1, time_step)*SIGN(1., &
&              vel)*(fieldd(i+1, k, j)-fieldd(i-2, k, j)-3.*(fieldd(i, k&
&              , j)-fieldd(i-1, k, j)))/12.)
            fqx(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))&
&              -1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1, &
&              time_step)*SIGN(1., vel)*(1./12.)*(field(i+1, k, j)-field(&
&              i-2, k, j)-3.*(field(i, k, j)-field(i-1, k, j))))
            fqxd(i, k, j) = fqxd(i, k, j) - fqxld(i, k, j)
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
        END IF
      END DO
    END IF
  END DO
! enddo for outer J loop
!--- end of 5th order horizontal flux calculation
!   ELSE
!      WRITE ( wrf_err_message , * ) 'module_advect: advect_scalar_pd, h_order not known ',horz_order
!      CALL wrf_error_fatal ( TRIM( wrf_err_message ) )
!   ENDIF horizontal_order_test
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(its, k, j)+rud(its+1, k, j))
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(&
&          field_old(its+1, k, j)-field_old(its, k, j))+ub*(field_oldd(&
&          its+1, k, j)-field_oldd(its, k, j))+fieldd(its, k, j)*(ru(its+&
&          1, k, j)-ru(its, k, j))+field(its, k, j)*(rud(its+1, k, j)-rud&
&          (its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(field_old(&
&          its+1, k, j)-field_old(its, k, j))+field(its, k, j)*(ru(its+1&
&          , k, j)-ru(its, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(ite-1, k, j)+rud(ite, k, j))
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+ub*(&
&          field_oldd(i_end, k, j)-field_oldd(i_end-1, k, j))+fieldd(&
&          i_end, k, j)*(ru(ite, k, j)-ru(ite-1, k, j))+field(i_end, k, j&
&          )*(rud(ite, k, j)-rud(ite-1, k, j)))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+field(i_end, &
&          k, j)*(ru(ite, k, j)-ru(ite-1, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jts)+rvd(i, k, jts+1))
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*(rv(i, k&
&          , jts+1)-rv(i, k, jts))+field(i, k, jts)*(rvd(i, k, jts+1)-rvd&
&          (i, k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*(rv(i, k, &
&          jts+1)-rv(i, k, jts)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jte-1)+rvd(i, k, jte))
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))+fieldd(i, k&
&          , j_end)*(rv(i, k, jte)-rv(i, k, jte-1))+field(i, k, j_end)*(&
&          rvd(i, k, jte)-rvd(i, k, jte-1)))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(rv(i, k, jte)-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
! Assuming rv(i,k,jds) = 0.
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jts+1) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*rvd(i, k, jts+1)
          vb = 0.5*rv(i, k, jts+1)
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*rv(i, k, &
&          jts+1)+field(i, k, jts)*rvd(i, k, jts+1))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*rv(i, k, &
&          jts+1))
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
! Assuming rv(i,k,jde) = 0.
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jte-1) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*rvd(i, k, jte-1)
          vb = 0.5*rv(i, k, jte-1)
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))-fieldd(i, k&
&          , j_end)*rv(i, k, jte-1)-field(i, k, j_end)*rvd(i, k, jte-1))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!-- loop bounds for periodic or sym conditions
  i_start = its - 1
  IF (ite .GT. ide - 1) THEN
    min15 = ide - 1
  ELSE
    min15 = ite
  END IF
  i_end = min15 + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min16 = jde - 1
  ELSE
    min16 = jte
  END IF
  j_end = min16 + 1
!-- loop bounds for open or specified conditions
  IF (degrade_xs) THEN
    IF (its - 1 .LT. ids) THEN
      i_start = ids
    ELSE
      i_start = its - 1
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ite + 1 .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite + 1
    END IF
  END IF
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds) THEN
      j_start = jds
    ELSE
      j_start = jts - 1
    END IF
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte + 1
    END IF
    fqzd = 0.0
    fqzld = 0.0
  ELSE
    fqzd = 0.0
    fqzld = 0.0
  END IF
!    vert_order_test : IF (vert_order == 6) THEN    
!    ELSE IF (vert_order == 5) THEN    
  DO j=j_start,j_end
    DO i=i_start,i_end
      fqzd(i, 1, j) = 0.0
      fqz(i, 1, j) = 0.
      fqzld(i, 1, j) = 0.0
      fqzl(i, 1, j) = 0.
      fqzd(i, kde, j) = 0.0
      fqz(i, kde, j) = 0.
      fqzld(i, kde, j) = 0.0
      fqzl(i, kde, j) = 0.
    END DO
    DO k=kts+3,ktf-2
      DO i=i_start,i_end
        dz = 2./(rdzw(k)+rdzw(k-1))
        mud = 0.5*2*mutd(i, j)
        mu = 0.5*(mut(i, j)+mut(i, j))
        veld = romd(i, k, j)
        vel = rom(i, k, j)
        crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs10d = crd
          abs10 = cr
        ELSE
          abs10d = -crd
          abs10 = -cr
        END IF
        y11d = crd + abs10d
        y11 = cr + abs10
        IF (1.0 .GT. y11) THEN
          min17d = y11d
          min17 = y11
        ELSE
          min17 = 1.0
          min17d = 0.0
        END IF
        IF (cr .GE. 0.) THEN
          abs25d = crd
          abs25 = cr
        ELSE
          abs25d = -crd
          abs25 = -cr
        END IF
        y26d = crd - abs25d
        y26 = cr - abs25
        IF (-1.0 .LT. y26) THEN
          max12d = y26d
          max12 = y26
        ELSE
          max12 = -1.0
          max12d = 0.0
        END IF
        fqzld(i, k, j) = dz*(mud*(0.5*min17*field_old(i, k-1, j)+0.5*&
&          max12*field_old(i, k, j))+mu*(0.5*(min17d*field_old(i, k-1, j)&
&          +min17*field_oldd(i, k-1, j))+0.5*(max12d*field_old(i, k, j)+&
&          max12*field_oldd(i, k, j))))/dt
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min17*field_old(i, k-1, j)+0.5*&
&          max12*field_old(i, k, j))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = fieldd(i, k+1, j)
          qip2 = field(i, k+1, j)
          qip1d = fieldd(i, k, j)
          qip1 = field(i, k, j)
          qid = fieldd(i, k-1, j)
          qi = field(i, k-1, j)
          qim1d = fieldd(i, k-2, j)
          qim1 = field(i, k-2, j)
          qim2d = fieldd(i, k-3, j)
          qim2 = field(i, k-3, j)
        ELSE
          qip2d = fieldd(i, k-2, j)
          qip2 = field(i, k-2, j)
          qip1d = fieldd(i, k-1, j)
          qip1 = field(i, k-1, j)
          qid = fieldd(i, k, j)
          qi = field(i, k, j)
          qim1d = fieldd(i, k+1, j)
          qim1 = field(i, k+1, j)
          qim2d = fieldd(i, k+2, j)
          qim2 = field(i, k+2, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps1 + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps1 + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps1 + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqzd(i, k, j) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        fqz(i, k, j) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
!           fqz(i,k,j) = vel*flux5( field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),      &
!                                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
        fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
    END DO
    DO i=i_start,i_end
      k = kts + 1
      dz = 2./(rdzw(k)+rdzw(k-1))
      mud = 0.5*2*mutd(i, j)
      mu = 0.5*(mut(i, j)+mut(i, j))
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs11d = crd
        abs11 = cr
      ELSE
        abs11d = -crd
        abs11 = -cr
      END IF
      y12d = crd + abs11d
      y12 = cr + abs11
      IF (1.0 .GT. y12) THEN
        min18d = y12d
        min18 = y12
      ELSE
        min18 = 1.0
        min18d = 0.0
      END IF
      IF (cr .GE. 0.) THEN
        abs26d = crd
        abs26 = cr
      ELSE
        abs26d = -crd
        abs26 = -cr
      END IF
      y27d = crd - abs26d
      y27 = cr - abs26
      IF (-1.0 .LT. y27) THEN
        max13d = y27d
        max13 = y27
      ELSE
        max13 = -1.0
        max13d = 0.0
      END IF
      fqzld(i, k, j) = dz*(mud*(0.5*min18*field_old(i, k-1, j)+0.5*max13&
&        *field_old(i, k, j))+mu*(0.5*(min18d*field_old(i, k-1, j)+min18*&
&        field_oldd(i, k-1, j))+0.5*(max13d*field_old(i, k, j)+max13*&
&        field_oldd(i, k, j))))/dt
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min18*field_old(i, k-1, j)+0.5*&
&        max13*field_old(i, k, j))
      fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&        i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*fieldd&
&        (i, k-1, j))
      fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&        , k-1, j))
      fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = kts + 2
      dz = 2./(rdzw(k)+rdzw(k-1))
      mud = 0.5*2*mutd(i, j)
      mu = 0.5*(mut(i, j)+mut(i, j))
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs12d = crd
        abs12 = cr
      ELSE
        abs12d = -crd
        abs12 = -cr
      END IF
      y13d = crd + abs12d
      y13 = cr + abs12
      IF (1.0 .GT. y13) THEN
        min19d = y13d
        min19 = y13
      ELSE
        min19 = 1.0
        min19d = 0.0
      END IF
      IF (cr .GE. 0.) THEN
        abs27d = crd
        abs27 = cr
      ELSE
        abs27d = -crd
        abs27 = -cr
      END IF
      y28d = crd - abs27d
      y28 = cr - abs27
      IF (-1.0 .LT. y28) THEN
        max14d = y28d
        max14 = y28
      ELSE
        max14 = -1.0
        max14d = 0.0
      END IF
      fqzld(i, k, j) = dz*(mud*(0.5*min19*field_old(i, k-1, j)+0.5*max14&
&        *field_old(i, k, j))+mu*(0.5*(min19d*field_old(i, k-1, j)+min19*&
&        field_oldd(i, k-1, j))+0.5*(max14d*field_old(i, k, j)+max14*&
&        field_oldd(i, k, j))))/dt
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min19*field_old(i, k-1, j)+0.5*&
&        max14*field_old(i, k, j))
      fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*SIGN(&
&        1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&        i, k, j)-field(i, k-1, j)))) + vel*(7.*(fieldd(i, k, j)+fieldd(i&
&        , k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k-2, j))/12.+SIGN(1&
&        , time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-fieldd(i, k-2, j)&
&        -3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.)
      fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*SIGN(&
&        1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&        i, k, j)-field(i, k-1, j))))
      fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = ktf - 1
      dz = 2./(rdzw(k)+rdzw(k-1))
      mud = 0.5*2*mutd(i, j)
      mu = 0.5*(mut(i, j)+mut(i, j))
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs13d = crd
        abs13 = cr
      ELSE
        abs13d = -crd
        abs13 = -cr
      END IF
      y14d = crd + abs13d
      y14 = cr + abs13
      IF (1.0 .GT. y14) THEN
        min20d = y14d
        min20 = y14
      ELSE
        min20 = 1.0
        min20d = 0.0
      END IF
      IF (cr .GE. 0.) THEN
        abs28d = crd
        abs28 = cr
      ELSE
        abs28d = -crd
        abs28 = -cr
      END IF
      y29d = crd - abs28d
      y29 = cr - abs28
      IF (-1.0 .LT. y29) THEN
        max15d = y29d
        max15 = y29
      ELSE
        max15 = -1.0
        max15d = 0.0
      END IF
      fqzld(i, k, j) = dz*(mud*(0.5*min20*field_old(i, k-1, j)+0.5*max15&
&        *field_old(i, k, j))+mu*(0.5*(min20d*field_old(i, k-1, j)+min20*&
&        field_oldd(i, k-1, j))+0.5*(max15d*field_old(i, k, j)+max15*&
&        field_oldd(i, k, j))))/dt
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min20*field_old(i, k-1, j)+0.5*&
&        max15*field_old(i, k, j))
      fqzd(i, k, j) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*SIGN(&
&        1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&        i, k, j)-field(i, k-1, j)))) + vel*(7.*(fieldd(i, k, j)+fieldd(i&
&        , k-1, j))/12.-(fieldd(i, k+1, j)+fieldd(i, k-2, j))/12.+SIGN(1&
&        , time_step)*SIGN(1., -vel)*(fieldd(i, k+1, j)-fieldd(i, k-2, j)&
&        -3.*(fieldd(i, k, j)-fieldd(i, k-1, j)))/12.)
      fqz(i, k, j) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1, time_step)*SIGN(&
&        1., -vel)*(1./12.)*(field(i, k+1, j)-field(i, k-2, j)-3.*(field(&
&        i, k, j)-field(i, k-1, j))))
      fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = ktf
      dz = 2./(rdzw(k)+rdzw(k-1))
      mud = 0.5*2*mutd(i, j)
      mu = 0.5*(mut(i, j)+mut(i, j))
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      crd = (dt*veld*mu/dz-vel*dt*mud/dz)/mu**2
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs14d = crd
        abs14 = cr
      ELSE
        abs14d = -crd
        abs14 = -cr
      END IF
      y15d = crd + abs14d
      y15 = cr + abs14
      IF (1.0 .GT. y15) THEN
        min21d = y15d
        min21 = y15
      ELSE
        min21 = 1.0
        min21d = 0.0
      END IF
      IF (cr .GE. 0.) THEN
        abs29d = crd
        abs29 = cr
      ELSE
        abs29d = -crd
        abs29 = -cr
      END IF
      y30d = crd - abs29d
      y30 = cr - abs29
      IF (-1.0 .LT. y30) THEN
        max16d = y30d
        max16 = y30
      ELSE
        max16 = -1.0
        max16d = 0.0
      END IF
      fqzld(i, k, j) = dz*(mud*(0.5*min21*field_old(i, k-1, j)+0.5*max16&
&        *field_old(i, k, j))+mu*(0.5*(min21d*field_old(i, k-1, j)+min21*&
&        field_oldd(i, k-1, j))+0.5*(max16d*field_old(i, k, j)+max16*&
&        field_oldd(i, k, j))))/dt
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min21*field_old(i, k-1, j)+0.5*&
&        max16*field_old(i, k, j))
      fqzd(i, k, j) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&        i, k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*fieldd&
&        (i, k-1, j))
      fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&        , k-1, j))
      fqzd(i, k, j) = fqzd(i, k, j) - fqzld(i, k, j)
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
    END DO
  END DO
!   ELSE
!      WRITE (wrf_err_message,*) ' advect_scalar_pd, v_order not known ',vert_order
!      CALL wrf_error_fatal ( wrf_err_message )
!   ENDIF vert_order_test
  IF (pd_limit) THEN
! positive definite filter
    i_start = its - 1
    IF (ite .GT. ide - 1) THEN
      min22 = ide - 1
    ELSE
      min22 = ite
    END IF
    i_end = min22 + 1
    j_start = jts - 1
    IF (jte .GT. jde - 1) THEN
      min23 = jde - 1
    ELSE
      min23 = jte
    END IF
    j_end = min23 + 1
!-- loop bounds for open or specified conditions
    IF (degrade_xs) THEN
      IF (its - 1 .LT. ids) THEN
        i_start = ids
      ELSE
        i_start = its - 1
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ite + 1 .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite + 1
      END IF
    END IF
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds) THEN
        j_start = jds
      ELSE
        j_start = jts - 1
      END IF
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte + 1
      END IF
    END IF
    IF (config_flags%specified .OR. config_flags%nested) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          i_start = ids + 1
        ELSE
          i_start = its - 1
        END IF
      END IF
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          i_end = ide - 2
        ELSE
          i_end = ite + 1
        END IF
      END IF
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          j_start = jds + 1
        ELSE
          j_start = jts - 1
        END IF
      END IF
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          j_end = jde - 2
        ELSE
          j_end = jte + 1
        END IF
      END IF
    END IF
    IF (config_flags%open_xs) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          i_start = ids + 1
        ELSE
          i_start = its - 1
        END IF
      END IF
    END IF
    IF (config_flags%open_xe) THEN
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          i_end = ide - 2
        ELSE
          i_end = ite + 1
        END IF
      END IF
    END IF
    IF (config_flags%open_ys) THEN
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          j_start = jds + 1
        ELSE
          j_start = jts - 1
        END IF
      END IF
    END IF
    IF (config_flags%open_ye) THEN
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          j_end = jde - 2
        ELSE
          j_end = jte + 1
        END IF
        ph_lowd = 0.0
      ELSE
        ph_lowd = 0.0
      END IF
    ELSE
      ph_lowd = 0.0
    END IF
! ADT note:
! We don't want to change j_start and j_end
! for polar BC's since we want to calculate
! fluxes for directions other than y at the
! edge
!-- here is the limiter...
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          ph_lowd(i,k,j) = mu_oldd(i, j)*field_old(i, k, j) + (mub(i, j)+mu_old&
&            (i, j))*field_oldd(i, k, j) - dt*(msftx(i, j)*msfty(i, j)*(&
&            rdx*(fqxld(i+1, k, j)-fqxld(i, k, j))+rdy*(fqyld(i, k, j+1)-&
&            fqyld(i, k, j)))+msfty(i, j)*rdzw(k)*(fqzld(i, k+1, j)-fqzld&
&            (i, k, j)))
          ph_low(i,k,j) = (mub(i, j)+mu_old(i, j))*field_old(i, k, j) - dt*(&
&            msftx(i, j)*msfty(i, j)*(rdx*(fqxl(i+1, k, j)-fqxl(i, k, j))&
&            +rdy*(fqyl(i, k, j+1)-fqyl(i, k, j)))+msfty(i, j)*rdzw(k)*(&
&            fqzl(i, k+1, j)-fqzl(i, k, j)))
        ENDDO
      ENDDO
    ENDDO
    flux_outd = 0.0
    DO j=j_start,j_end
      DO k=kts,ktf
!DIR$ vector always
        DO i=i_start,i_end
          IF (0. .LT. fqx(i+1, k, j)) THEN
            max1d = fqxd(i+1, k, j)
            max1 = fqx(i+1, k, j)
          ELSE
            max1 = 0.
            max1d = 0.0
          END IF
          IF (0. .GT. fqx(i, k, j)) THEN
            min24d = fqxd(i, k, j)
            min24 = fqx(i, k, j)
          ELSE
            min24 = 0.
            min24d = 0.0
          END IF
          IF (0. .LT. fqy(i, k, j+1)) THEN
            max17d = fqyd(i, k, j+1)
            max17 = fqy(i, k, j+1)
          ELSE
            max17 = 0.
            max17d = 0.0
          END IF
          IF (0. .GT. fqy(i, k, j)) THEN
            min25d = fqyd(i, k, j)
            min25 = fqy(i, k, j)
          ELSE
            min25 = 0.
            min25d = 0.0
          END IF
          IF (0. .GT. fqz(i, k+1, j)) THEN
            min26d = fqzd(i, k+1, j)
            min26 = fqz(i, k+1, j)
          ELSE
            min26 = 0.
            min26d = 0.0
          END IF
          IF (0. .LT. fqz(i, k, j)) THEN
            max18d = fqzd(i, k, j)
            max18 = fqz(i, k, j)
          ELSE
            max18 = 0.
            max18d = 0.0
          END IF
          flux_outd(i,k,j) = dt*(msftx(i, j)*msfty(i, j)*(rdx*(max1d-min24d)+&
&            rdy*(max17d-min25d))+msfty(i, j)*rdzw(k)*(min26d-max18d))
          flux_out(i,k,j) = dt*(msftx(i, j)*msfty(i, j)*(rdx*(max1-min24)+rdy*(&
&            max17-min25))+msfty(i, j)*rdzw(k)*(min26-max18))
        ENDDO
      ENDDO
    ENDDO
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          IF (flux_out(i,k,j) .GT. ph_low(i,k,j)) THEN
            IF (0. .LT. ph_low(i,k,j)/(flux_out(i,k,j)+eps)) THEN
              scaled = (ph_lowd(i,k,j)*(flux_out(i,k,j)+eps)-ph_low(i,k,j)*flux_outd(i,k,j))/(&
&                flux_out(i,k,j)+eps)**2
              scale = ph_low(i,k,j)/(flux_out(i,k,j)+eps)
            ELSE
              scale = 0.
              scaled = 0.0
            END IF
            IF (fqx(i+1, k, j) .GT. 0.) THEN
              fqxd(i+1, k, j) = scaled*fqx(i+1, k, j) + scale*fqxd(i+1, &
&                k, j)
              fqx(i+1, k, j) = scale*fqx(i+1, k, j)
            END IF
            IF (fqx(i, k, j) .LT. 0.) THEN
              fqxd(i, k, j) = scaled*fqx(i, k, j) + scale*fqxd(i, k, j)
              fqx(i, k, j) = scale*fqx(i, k, j)
            END IF
            IF (fqy(i, k, j+1) .GT. 0.) THEN
              fqyd(i, k, j+1) = scaled*fqy(i, k, j+1) + scale*fqyd(i, k&
&                , j+1)
              fqy(i, k, j+1) = scale*fqy(i, k, j+1)
            END IF
            IF (fqy(i, k, j) .LT. 0.) THEN
              fqyd(i, k, j) = scaled*fqy(i, k, j) + scale*fqyd(i, k, j)
              fqy(i, k, j) = scale*fqy(i, k, j)
            END IF
!  note: z flux is opposite sign in mass coordinate because 
!  vertical coordinate decreases with increasing k
            IF (fqz(i, k+1, j) .LT. 0.) THEN
              fqzd(i, k+1, j) = scaled*fqz(i, k+1, j) + scale*fqzd(i, k+&
&                1, j)
              fqz(i, k+1, j) = scale*fqz(i, k+1, j)
            END IF
            IF (fqz(i, k, j) .GT. 0.) THEN
              fqzd(i, k, j) = scaled*fqz(i, k, j) + scale*fqzd(i, k, j)
              fqz(i, k, j) = scale*fqz(i, k, j)
            END IF
          END IF
        END DO
      END DO
    END DO
  END IF
! add in the pd-limited flux divergence
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(fqzd(i, k+1, &
&          j)-fqzd(i, k, j)+fqzld(i, k+1, j)-fqzld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(fqz(i, k+1, j)-&
&          fqz(i, k, j)+fqzl(i, k+1, j)-fqzl(i, k, j))
      END DO
    END DO
  END DO
! x flux divergence
!
  IF (degrade_xs) THEN
    IF (its .LT. ids + 1) THEN
      i_start = ids + 1
    ELSE
      i_start = its
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ite .GT. ide - 2) THEN
      i_end = ide - 2
    ELSE
      i_end = ite
    END IF
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
! Un-"canceled" map scale factor, ADT Eq. 48
        tendencyd(i, k, j) = tendencyd(i, k, j) - msftx(i, j)*rdx*(fqxd(&
&          i+1, k, j)-fqxd(i, k, j)+fqxld(i+1, k, j)-fqxld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - msftx(i, j)*(rdx*(fqx(i+&
&          1, k, j)-fqx(i, k, j)+fqxl(i+1, k, j)-fqxl(i, k, j)))
      END DO
    END DO
  END DO
! y flux divergence
!
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  IF (degrade_ys) THEN
    IF (jts .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts
    END IF
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 2) THEN
      j_end = jde - 2
    ELSE
      j_end = jte
    END IF
  END IF
  DO j=j_start,j_end
    DO k=kts,ktf
      DO i=i_start,i_end
! Un-"canceled" map scale factor, ADT Eq. 48
! It is correct to use msftx (and not msfty), per W. Skamarock, 20080606
        tendencyd(i, k, j) = tendencyd(i, k, j) - msftx(i, j)*rdy*(fqyd(&
&          i, k, j+1)-fqyd(i, k, j)+fqyld(i, k, j+1)-fqyld(i, k, j))
        tendency(i, k, j) = tendency(i, k, j) - msftx(i, j)*(rdy*(fqy(i&
&          , k, j+1)-fqy(i, k, j)+fqyl(i, k, j+1)-fqyl(i, k, j)))
      END DO
    END DO
  END DO
END SUBROUTINE G_ADVECT_SCALAR_WENOPD

 SUBROUTINE g_advect_scalar_mono(field,g_field,field_old,g_field_old, &
 tendency,g_tendency,h_tendency,g_h_tendency,z_tendency,g_z_tendency,ru,g_ru,rv,g_rv,rom,g_rom,mut,g_mut,mub,mu_old, &
 g_mu_old,config_flags,tenddec,msfux,msfuy,msfvx,msfvy,msftx,msfty,fzm,fzp,rdx,rdy,rdzw,dt, &
 ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)

 IMPLICIT NONE

 REAL :: Tmpv1,g_Tmpv1,Tmpv2,g_Tmpv2,Tmpv3,g_Tmpv3,Tmpv4,g_Tmpv4,Tmpv5, &
 g_Tmpv5,Tmpv6,g_Tmpv6,Tmpv7,g_Tmpv7,Tmpv8,g_Tmpv8

 REAL g_FuncVal1,FuncVal1
 TYPE(grid_config_rec_type) :: config_flags
 LOGICAL :: tenddec
 INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: field,g_field,field_old,g_field_old, &
 ru,g_ru,rv,g_rv,rom,g_rom
 REAL,DIMENSION(ims:ime,jms:jme) :: mut,g_mut,mub,mu_old,g_mu_old
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,g_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: h_tendency, z_tendency
 REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: g_h_tendency, g_z_tendency
 REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty
 REAL,DIMENSION(kms:kme) :: fzm,fzp,rdzw
 REAL :: rdx,rdy,dt

 INTEGER :: i,j,k,itf,jtf,ktf
 INTEGER :: i_start,i_end,j_start,j_end
 INTEGER :: i_start_f,i_end_f,j_start_f,j_end_f
 INTEGER :: jmin,jmax,jp,jm,imin,imax
 REAL :: mrdx,g_mrdx,mrdy,g_mrdy,ub,g_ub,vb,g_vb,uw,g_uw,vw,g_vw,mu,g_mu
 REAL,DIMENSION(its:ite,kts:kte) :: vflux,g_vflux
 REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: fqx,g_fqx,fqy,g_fqy,fqz,g_fqz
 REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: fqxl,g_fqxl,fqyl,g_fqyl, &
 fqzl,g_fqzl
 REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: qmin,g_qmin,qmax,g_qmax
 REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: scale_in,g_scale_in,scale_out, &
 g_scale_out
 REAL :: ph_upwind,g_ph_upwind
 INTEGER :: horz_order,vert_order
 LOGICAL :: degrade_xs,degrade_ys
 LOGICAL :: degrade_xe,degrade_ye
 INTEGER :: jp1,jp0,jtmp
 REAL :: flux_out,g_flux_out,ph_low,g_ph_low,flux_in,g_flux_in,ph_hi, &
 g_ph_hi,scale,g_scale
 REAL,PARAMETER :: eps =1.e-20
 REAL :: flux3,g_flux3,flux4,g_flux4,flux5,g_flux5,flux6,g_flux6, &
 flux_upwind,g_flux_upwind
 REAL :: q_im3,g_q_im3,q_im2,g_q_im2,q_im1,g_q_im1,q_i,g_q_i,q_ip1, &
 g_q_ip1,q_ip2,g_q_ip2,ua,g_ua,vel,g_vel,cr,g_cr

! Revised by Ning Pan, 2010-07-25
! g_flux4(g_q_im2, q_im2,g_q_im1, q_im1,g_q_i, q_i,g_q_ip1, q_ip1, &
! g_ua, ua) =(7./12.)*(g_q_i +g_q_im1) -(1./12.)*(g_q_ip1 +g_q_im2)
 g_flux4(q_im2, g_q_im2,q_im1, g_q_im1,q_i, g_q_i,q_ip1, g_q_ip1, &
 ua, g_ua) =(7./12.)*(g_q_i +g_q_im1) -(1./12.)*(g_q_ip1 +g_q_im2)
 flux4(q_im2,q_im1,q_i,q_ip1,ua) =(7./12.)*(q_i +q_im1) -(1./12.)*(q_ip1 +q_im2)

! Revised by Ning Pan, 2010-07-25
! g_flux3(g_q_im2, q_im2,g_q_im1, q_im1,g_q_i, q_i,g_q_ip1, q_ip1, &
! g_ua, ua) =g_flux4(q_im2,g_q_im2,q_im1,g_q_im1,q_i,g_q_i,q_ip1, &
 g_flux3(q_im2, g_q_im2,q_im1, g_q_im1,q_i, g_q_i,q_ip1, g_q_ip1, &
 ua, g_ua) =g_flux4(q_im2,g_q_im2,q_im1,g_q_im1,q_i,g_q_i,q_ip1, &
 g_q_ip1,ua,g_ua) +sign(1., ua) *(1./12.)*((g_q_ip1 -g_q_im2) &
 -3.*(g_q_i -g_q_im1))
 flux3(q_im2,q_im1,q_i,q_ip1,ua) =flux4(q_im2,q_im1,q_i,q_ip1,ua) +sign(1., ua) &
 *(1./12.)*((q_ip1 -q_im2) -3.*(q_i -q_im1))

! Revised by Ning Pan, 2010-07-25
! g_flux6(g_q_im3, q_im3,g_q_im2, q_im2,g_q_im1, q_im1,g_q_i, q_i, &
! g_q_ip1, q_ip1,g_q_ip2, q_ip2,g_ua, ua) =(37./60.)*(g_q_i +g_q_im1) &
 g_flux6(q_im3, g_q_im3,q_im2, g_q_im2,q_im1, g_q_im1,q_i, g_q_i, &
 q_ip1, g_q_ip1,q_ip2, g_q_ip2,ua, g_ua) =(37./60.)*(g_q_i +g_q_im1) &
 -(2./15.)*(g_q_ip1 +g_q_im2) +(1./60.)*(g_q_ip2 +g_q_im3)
 flux6(q_im3,q_im2,q_im1,q_i,q_ip1,q_ip2,ua) =(37./60.)*(q_i +q_im1) -(2./15.) &
*(q_ip1 +q_im2) +(1./60.)*(q_ip2 +q_im3)

! Revised by Ning Pan, 2010-07-25
! g_flux5(g_q_im3, q_im3,g_q_im2, q_im2,g_q_im1, q_im1,g_q_i, q_i, &
! g_q_ip1, q_ip1,g_q_ip2, q_ip2,g_ua, ua) =g_flux6(q_im3,g_q_im3,q_im2, &
 g_flux5(q_im3, g_q_im3,q_im2, g_q_im2,q_im1, g_q_im1,q_i, g_q_i, &
 q_ip1, g_q_ip1,q_ip2, g_q_ip2,ua, g_ua) =g_flux6(q_im3,g_q_im3,q_im2, &
 g_q_im2,q_im1,g_q_im1,q_i,g_q_i,q_ip1,g_q_ip1,q_ip2,g_q_ip2,ua, &
 g_ua) -sign(1., ua) *(1./60.)*((g_q_ip2 -g_q_im3) -5.*(g_q_ip1 - &
 g_q_im2) +10.*(g_q_i -g_q_im1))
 flux5(q_im3,q_im2,q_im1,q_i,q_ip1,q_ip2,ua) =flux6(q_im3,q_im2,q_im1,q_i,q_ip1,q_ip2, &
 ua) -sign(1., ua) *(1./60.)*((q_ip2 -q_im3) -5.*(q_ip1 -q_im2) +10.*(q_i -q_im1))

! Revised by Ning Pan, 2010-07-25
! g_flux_upwind(g_q_im1, q_im1,g_q_i, q_i,g_cr, cr) =0.5 *(1.+sign(1., cr)) &
 g_flux_upwind(q_im1, g_q_im1,q_i, g_q_i,cr, g_cr) =0.5 *(1.+sign(1., cr)) &
*g_q_im1 +0.5 *(1.-sign(1., cr))*g_q_i
 flux_upwind(q_im1,q_i,cr) =0.5 *(1.+sign(1., cr))*q_im1 +0.5 *(1.-sign(1., cr))*q_i

 LOGICAL,PARAMETER :: mono_limit =.true.

 ktf =min(kte,kde-1)

 horz_order =config_flags%h_sca_adv_order

 vert_order =config_flags%v_sca_adv_order

! Added by Ning Pan, 2010-07-27
 degrade_xs =.true.
 degrade_xe =.true.
 degrade_ys =.true.
 degrade_ye =.true.
 IF( config_flags%periodic_x   .or.   &
       config_flags%symmetric_xs .or.   &
       (its > ids+3)                ) degrade_xs =.false.
 IF( config_flags%periodic_x   .or.   &
       config_flags%symmetric_xe .or.   &
       (ite < ide-4)                ) degrade_xe =.false.
 IF( config_flags%periodic_y   .or.   &
       config_flags%symmetric_ys .or.   &
       (jts > jds+3)                ) degrade_ys =.false.
 IF( config_flags%periodic_y   .or.   &
       config_flags%symmetric_ye .or.   &
       (jte < jde-4)                ) degrade_ye =.false.

 DO j =jts-2,jte+2
 DO k =kts,kte
 DO i =its-2,ite+2

 g_qmin(i,k,j) =g_field_old(i,k,j)
 qmin(i,k,j) =field_old(i,k,j)

 g_qmax(i,k,j) =g_field_old(i,k,j)
 qmax(i,k,j) =field_old(i,k,j)

 g_scale_in(i,k,j) =0.0
 scale_in(i,k,j) =1.

 g_scale_out(i,k,j) =0.0
 scale_out(i,k,j) =1.

 g_fqx(i,k,j) =0.0
 fqx(i,k,j) =0.

 g_fqy(i,k,j) =0.0
 fqy(i,k,j) =0.

 g_fqz(i,k,j) =0.0
 fqz(i,k,j) =0.

 g_fqxl(i,k,j) =0.0
 fqxl(i,k,j) =0.

 g_fqyl(i,k,j) =0.0
 fqyl(i,k,j) =0.

 g_fqzl(i,k,j) =0.0
 fqzl(i,k,j) =0.

 ENDDO
 ENDDO
 ENDDO

 IF( horz_order == 5 ) THEN

! degrade_xs =.true.

! degrade_xe =.true.

! degrade_ys =.true.

! degrade_ye =.true.

! IF( config_flags%periodic_x   .or.   &
!       config_flags%symmetric_xs .or.   &
!       (its > ids+3)                ) degrade_xs =.false.

! IF( config_flags%periodic_x   .or.   &
!       config_flags%symmetric_xe .or.   &
!       (ite < ide-4)                ) degrade_xe =.false.

! IF( config_flags%periodic_y   .or.   &
!       config_flags%symmetric_ys .or.   &
!       (jts > jds+3)                ) degrade_ys =.false.

! IF( config_flags%periodic_y   .or.   &
!       config_flags%symmetric_ye .or.   &
!       (jte < jde-4)                ) degrade_ye =.false.

 ktf =min(kte,kde-1)

 i_start =its-1

 i_end =min(ite,ide-1) +1

 j_start =jts-1

 j_end =min(jte,jde-1) +1

 j_start_f =j_start

 j_end_f =j_end+1

 IF(degrade_xs) i_start =max(its-1,ids)

 IF(degrade_xe) i_end =min(ite+1,ide-1)

 IF(degrade_ys) THEN

 j_start =max(jts-1,jds+1)

 j_start_f =jds+3
 ENDIF

 IF(degrade_ye) THEN

 j_end =min(jte+1,jde-2)

 j_end_f =jde-3
 ENDIF

 DO j =j_start,j_end+1

 IF( (j >= j_start_f ) .and. (j <= j_end_f) ) THEN

 DO k =kts,ktf
 DO i =i_start,i_end

 g_vel =g_rv(i,k,j)
 vel =rv(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i,k,j-1),g_field_old(i,k,j-1) &
,field_old(i,k,j),g_field_old(i,k,j),vel,g_vel)
 FuncVal1 =flux_upwind(field_old(i,k,j-1),field_old(i,k,j),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqyl(i,k,j) =g_Tmpv1
 fqyl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux5(field(i,k,j-3),g_field(i,k,j-3),field(i,k,j-2) &
,g_field(i,k,j-2),field(i,k,j-1),g_field(i,k,j-1),field(i,k,j),g_field(i,k, &
 j),field(i,k,j+1),g_field(i,k,j+1),field(i,k,j+2),g_field(i,k,j+2),vel,g_vel)
 FuncVal1 =flux5(field(i,k,j-3),field(i,k,j-2),field(i,k,j-1),field(i,k,j) &
,field(i,k,j+1),field(i,k,j+2),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 g_fqy(i,k,j) =g_fqy(i,k,j) -g_fqyl(i,k,j)
 fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k,j-1) +(g_qmax(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmax(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k,j-1))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k,j-1) -(g_qmin(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmin(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k,j-1))

 else

 g_qmax(i,k,j-1) =(g_qmax(i,k,j-1) +g_field_old(i,k,j) +(g_qmax(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmax(i,k,j-1) =max(qmax(i,k,j-1),field_old(i,k,j))

 g_qmin(i,k,j-1) =(g_qmin(i,k,j-1) +g_field_old(i,k,j) -(g_qmin(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmin(i,k,j-1) =min(qmin(i,k,j-1),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 ELSE IF( j == jds+1 ) THEN

 DO k =kts,ktf
 DO i =i_start,i_end

 g_vel =g_rv(i,k,j)
 vel =rv(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i,k,j-1),g_field_old(i,k,j-1) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqyl(i,k,j) =g_Tmpv1
 fqyl(i,k,j) =Tmpv1

 g_Tmpv1 =0.5*rv(i,k,j)*(g_field(i,k,j) +g_field(i,k,j-1)) +0.5*g_rv(i,k, &
 j)*(field(i,k,j) +field(i,k,j-1)) 
 Tmpv1 =0.5*rv(i,k,j)*(field(i,k,j) +field(i,k,j-1))

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 g_fqy(i,k,j) =g_fqy(i,k,j) -g_fqyl(i,k,j)
 fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k,j-1) +(g_qmax(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmax(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k,j-1))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k,j-1) -(g_qmin(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmin(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k,j-1))

 else

 g_qmax(i,k,j-1) =(g_qmax(i,k,j-1) +g_field_old(i,k,j) +(g_qmax(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmax(i,k,j-1) =max(qmax(i,k,j-1),field_old(i,k,j))

 g_qmin(i,k,j-1) =(g_qmin(i,k,j-1) +g_field_old(i,k,j) -(g_qmin(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmin(i,k,j-1) =min(qmin(i,k,j-1),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 ELSE IF( j == jds+2 ) THEN

 DO k =kts,ktf
 DO i =i_start,i_end

 g_vel =g_rv(i,k,j)
 vel =rv(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i,k,j-1),g_field_old(i,k,j-1) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqyl(i,k,j) =g_Tmpv1
 fqyl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux3(field(i,k,j-2),g_field(i,k,j-2),field(i,k,j-1) &
,g_field(i,k,j-1),field(i,k,j),g_field(i,k,j),field(i,k,j+1),g_field(i,k,j+ &
 1),vel,g_vel)
 FuncVal1 =flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 g_fqy(i,k,j) =g_fqy(i,k,j) -g_fqyl(i,k,j)
 fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k,j-1) +(g_qmax(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmax(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k,j-1))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k,j-1) -(g_qmin(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmin(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k,j-1))

 else

 g_qmax(i,k,j-1) =(g_qmax(i,k,j-1) +g_field_old(i,k,j) +(g_qmax(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmax(i,k,j-1) =max(qmax(i,k,j-1),field_old(i,k,j))

 g_qmin(i,k,j-1) =(g_qmin(i,k,j-1) +g_field_old(i,k,j) -(g_qmin(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmin(i,k,j-1) =min(qmin(i,k,j-1),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 ELSE IF( j == jde-1 ) THEN

 DO k =kts,ktf
 DO i =i_start,i_end

 g_vel =g_rv(i,k,j)
 vel =rv(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i,k,j-1),g_field_old(i,k,j-1) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqyl(i,k,j) =g_Tmpv1
 fqyl(i,k,j) =Tmpv1

 g_Tmpv1 =0.5*rv(i,k,j)*(g_field(i,k,j) +g_field(i,k,j-1)) +0.5*g_rv(i,k, &
 j)*(field(i,k,j) +field(i,k,j-1)) 
 Tmpv1 =0.5*rv(i,k,j)*(field(i,k,j) +field(i,k,j-1))

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 g_fqy(i,k,j) =g_fqy(i,k,j) -g_fqyl(i,k,j)
 fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k,j-1) +(g_qmax(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmax(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k,j-1))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k,j-1) -(g_qmin(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmin(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k,j-1))

 else

 g_qmax(i,k,j-1) =(g_qmax(i,k,j-1) +g_field_old(i,k,j) +(g_qmax(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmax(i,k,j-1) =max(qmax(i,k,j-1),field_old(i,k,j))

 g_qmin(i,k,j-1) =(g_qmin(i,k,j-1) +g_field_old(i,k,j) -(g_qmin(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmin(i,k,j-1) =min(qmin(i,k,j-1),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 ELSE IF( j == jde-2 ) THEN

 DO k =kts,ktf
 DO i =i_start,i_end

 g_vel =g_rv(i,k,j)
 vel =rv(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i,k,j-1),g_field_old(i,k,j-1) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqyl(i,k,j) =g_Tmpv1
 fqyl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux3(field(i,k,j-2),g_field(i,k,j-2),field(i,k,j-1) &
,g_field(i,k,j-1),field(i,k,j),g_field(i,k,j),field(i,k,j+1),g_field(i,k,j+ &
 1),vel,g_vel)
 FuncVal1 =flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 g_fqy(i,k,j) =g_fqy(i,k,j) -g_fqyl(i,k,j)
 fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k,j-1) +(g_qmax(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmax(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k,j-1))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k,j-1) -(g_qmin(i,k,j) &
 -g_field_old(i,k,j-1))*sign(1.0, qmin(i,k,j) -(field_old(i,k,j-1))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k,j-1))

 else

 g_qmax(i,k,j-1) =(g_qmax(i,k,j-1) +g_field_old(i,k,j) +(g_qmax(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmax(i,k,j-1) =max(qmax(i,k,j-1),field_old(i,k,j))

 g_qmin(i,k,j-1) =(g_qmin(i,k,j-1) +g_field_old(i,k,j) -(g_qmin(i,k,j-1) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k,j-1) -(field_old(i,k,j))))*0.5
 qmin(i,k,j-1) =min(qmin(i,k,j-1),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO
 ENDIF
 ENDDO

 i_start =its-1

 i_end =min(ite,ide-1) +1

 i_start_f =i_start

 i_end_f =i_end+1

 j_start =jts-1

 j_end =min(jte,jde-1) +1

 IF(degrade_ys) j_start =max(jts-1,jds)

 IF(degrade_ye) j_end =min(jte+1,jde-1)

 IF(degrade_xs) THEN

 i_start =max(ids+1,its-1)

 i_start_f =ids+3
 ENDIF

 IF(degrade_xe) THEN

 i_end =min(ide-2,ite+1)

 i_end_f =ide-3
 ENDIF

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start_f,i_end_f

 g_vel =g_ru(i,k,j)
 vel =ru(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i-1,k,j),g_field_old(i-1,k,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqxl(i,k,j) =g_Tmpv1
 fqxl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux5(field(i-3,k,j),g_field(i-3,k,j),field(i-2,k,j) &
,g_field(i-2,k,j),field(i-1,k,j),g_field(i-1,k,j),field(i,k,j),g_field(i,k, &
 j),field(i+1,k,j),g_field(i+1,k,j),field(i+2,k,j),g_field(i+2,k,j),vel,g_vel)
 FuncVal1 =flux5(field(i-3,k,j),field(i-2,k,j),field(i-1,k,j),field(i,k,j) &
,field(i+1,k,j),field(i+2,k,j),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 g_fqx(i,k,j) =g_fqx(i,k,j) -g_fqxl(i,k,j)
 fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i-1,k,j) +(g_qmax(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmax(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i-1,k,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i-1,k,j) -(g_qmin(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmin(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i-1,k,j))

 else

 g_qmax(i-1,k,j) =(g_qmax(i-1,k,j) +g_field_old(i,k,j) +(g_qmax(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmax(i-1,k,j) =max(qmax(i-1,k,j),field_old(i,k,j))

 g_qmin(i-1,k,j) =(g_qmin(i-1,k,j) +g_field_old(i,k,j) -(g_qmin(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmin(i-1,k,j) =min(qmin(i-1,k,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 IF( degrade_xs ) THEN

 DO i =i_start,i_start_f-1

 IF(i == ids+1) THEN

 DO k =kts,ktf

 g_vel =g_ru(i,k,j)
 vel =ru(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i-1,k,j),g_field_old(i-1,k,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqxl(i,k,j) =g_Tmpv1
 fqxl(i,k,j) =Tmpv1

 g_Tmpv1 =0.5*(ru(i,k,j))*(g_field(i,k,j) +g_field(i-1,k,j)) +0.5*(g_ru( &
 i,k,j))*(field(i,k,j) +field(i-1,k,j)) 
 Tmpv1 =0.5*(ru(i,k,j))*(field(i,k,j) +field(i-1,k,j))

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 g_fqx(i,k,j) =g_fqx(i,k,j) -g_fqxl(i,k,j)
 fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i-1,k,j) +(g_qmax(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmax(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i-1,k,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i-1,k,j) -(g_qmin(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmin(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i-1,k,j))

 else

 g_qmax(i-1,k,j) =(g_qmax(i-1,k,j) +g_field_old(i,k,j) +(g_qmax(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmax(i-1,k,j) =max(qmax(i-1,k,j),field_old(i,k,j))

 g_qmin(i-1,k,j) =(g_qmin(i-1,k,j) +g_field_old(i,k,j) -(g_qmin(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmin(i-1,k,j) =min(qmin(i-1,k,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDIF

 IF(i == ids+2) THEN

 DO k =kts,ktf

 g_vel =g_ru(i,k,j)
 vel =ru(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i-1,k,j),g_field_old(i-1,k,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqxl(i,k,j) =g_Tmpv1
 fqxl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux3(field(i-2,k,j),g_field(i-2,k,j),field(i-1,k,j) &
,g_field(i-1,k,j),field(i,k,j),g_field(i,k,j),field(i+1,k,j),g_field(i+1,k, &
 j),vel,g_vel)
 FuncVal1 =flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 g_fqx(i,k,j) =g_fqx(i,k,j) -g_fqxl(i,k,j)
 fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i-1,k,j) +(g_qmax(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmax(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i-1,k,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i-1,k,j) -(g_qmin(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmin(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i-1,k,j))

 else

 g_qmax(i-1,k,j) =(g_qmax(i-1,k,j) +g_field_old(i,k,j) +(g_qmax(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmax(i-1,k,j) =max(qmax(i-1,k,j),field_old(i,k,j))

 g_qmin(i-1,k,j) =(g_qmin(i-1,k,j) +g_field_old(i,k,j) -(g_qmin(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmin(i-1,k,j) =min(qmin(i-1,k,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDIF
 ENDDO
 ENDIF

 IF( degrade_xe ) THEN

 DO i =i_end_f+1,i_end+1

 IF( i == ide-1 ) THEN

 DO k =kts,ktf

 g_vel =g_ru(i,k,j)
 vel =ru(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i-1,k,j),g_field_old(i-1,k,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqxl(i,k,j) =g_Tmpv1
 fqxl(i,k,j) =Tmpv1

 g_Tmpv1 =0.5*(ru(i,k,j))*(g_field(i,k,j) +g_field(i-1,k,j)) +0.5*(g_ru( &
 i,k,j))*(field(i,k,j) +field(i-1,k,j)) 
 Tmpv1 =0.5*(ru(i,k,j))*(field(i,k,j) +field(i-1,k,j))

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 g_fqx(i,k,j) =g_fqx(i,k,j) -g_fqxl(i,k,j)
 fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i-1,k,j) +(g_qmax(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmax(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i-1,k,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i-1,k,j) -(g_qmin(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmin(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i-1,k,j))

 else

 g_qmax(i-1,k,j) =(g_qmax(i-1,k,j) +g_field_old(i,k,j) +(g_qmax(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmax(i-1,k,j) =max(qmax(i-1,k,j),field_old(i,k,j))

 g_qmin(i-1,k,j) =(g_qmin(i-1,k,j) +g_field_old(i,k,j) -(g_qmin(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmin(i-1,k,j) =min(qmin(i-1,k,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDIF

 IF( i == ide-2 ) THEN

 DO k =kts,ktf

 g_vel =g_ru(i,k,j)
 vel =ru(i,k,j)

 g_cr =g_vel
 cr =vel

 g_FuncVal1=g_flux_upwind(field_old(i-1,k,j),g_field_old(i-1,k,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqxl(i,k,j) =g_Tmpv1
 fqxl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux3(field(i-2,k,j),g_field(i-2,k,j),field(i-1,k,j) &
,g_field(i-1,k,j),field(i,k,j),g_field(i,k,j),field(i+1,k,j),g_field(i+1,k, &
 j),vel,g_vel)
 FuncVal1 =flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 g_fqx(i,k,j) =g_fqx(i,k,j) -g_fqxl(i,k,j)
 fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i-1,k,j) +(g_qmax(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmax(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i-1,k,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i-1,k,j) -(g_qmin(i,k,j) &
 -g_field_old(i-1,k,j))*sign(1.0, qmin(i,k,j) -(field_old(i-1,k,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i-1,k,j))

 else

 g_qmax(i-1,k,j) =(g_qmax(i-1,k,j) +g_field_old(i,k,j) +(g_qmax(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmax(i-1,k,j) =max(qmax(i-1,k,j),field_old(i,k,j))

 g_qmin(i-1,k,j) =(g_qmin(i-1,k,j) +g_field_old(i,k,j) -(g_qmin(i-1,k,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i-1,k,j) -(field_old(i,k,j))))*0.5
 qmin(i-1,k,j) =min(qmin(i-1,k,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDIF
 ENDDO
 ENDIF

 ENDDO
 ELSE

! Revised by Ning Pan, 2010-07-25
! WRITE (wrf_err_message,*) 'module_advect: advect_scalar_mono, h_order not known ',horz_order
 WRITE (wrf_err_message,*) 'g_module_advect: g_advect_scalar_mono, h_order not known ',horz_order

!DELETED BY WALLS
!CALL g_wrf_error_fatal(Trim(wrf_err_message))
CALL wrf_error_fatal(Trim(wrf_err_message))  ! Added by Ning Pan, 2010-07-25
 ENDIF

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 IF( (config_flags%open_xs) .and. (its == ids) ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf

 g_ub =(0.5*(g_ru(its,k,j) +g_ru(its+1,k,j)) +0.0 -(0.5*(g_ru(its,k,j) &
 +g_ru(its+1,k,j)) -0.0)*sign(1.0, 0.5*(ru(its,k,j) +ru(its+1,k,j)) -(0.)))*0.5
 ub =min(0.5*(ru(its,k,j) +ru(its+1,k,j)),0.)

 g_Tmpv1 =ub*(g_field_old(its+1,k,j) -g_field_old(its,k,j)) +g_ub*( &
 field_old(its+1,k,j) -field_old(its,k,j)) 
 Tmpv1 =ub*(field_old(its+1,k,j) -field_old(its,k,j))

 g_Tmpv2 =field(its,k,j)*(g_ru(its+1,k,j) -g_ru(its,k,j)) +g_field(its,k, &
 j)*(ru(its+1,k,j) -ru(its,k,j)) 
 Tmpv2 =field(its,k,j)*(ru(its+1,k,j) -ru(its,k,j))

 g_tendency(its,k,j) =g_tendency(its,k,j) -rdx*(g_Tmpv1 +g_Tmpv2)
 tendency(its,k,j) =tendency(its,k,j) -rdx*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO
 ENDIF

 IF( (config_flags%open_xe) .and. (ite == ide) ) THEN

 DO j =j_start,j_end
 DO k =kts,ktf

 g_ub =(0.5*(g_ru(ite-1,k,j) +g_ru(ite,k,j)) +0.0 +(0.5*(g_ru(ite-1,k,j) &
 +g_ru(ite,k,j)) -0.0)*sign(1.0, 0.5*(ru(ite-1,k,j) +ru(ite,k,j)) -(0.)))*0.5
 ub =max(0.5*(ru(ite-1,k,j) +ru(ite,k,j)),0.)

 g_Tmpv1 =ub*(g_field_old(i_end,k,j) -g_field_old(i_end-1,k,j)) &
 +g_ub*(field_old(i_end,k,j) -field_old(i_end-1,k,j)) 
 Tmpv1 =ub*(field_old(i_end,k,j) -field_old(i_end-1,k,j))

 g_Tmpv2 =field(i_end,k,j)*(g_ru(ite,k,j) -g_ru(ite-1,k,j)) +g_field( &
 i_end,k,j)*(ru(ite,k,j) -ru(ite-1,k,j)) 
 Tmpv2 =field(i_end,k,j)*(ru(ite,k,j) -ru(ite-1,k,j))

 g_tendency(i_end,k,j) =g_tendency(i_end,k,j) -rdx*(g_Tmpv1 +g_Tmpv2)
 tendency(i_end,k,j) =tendency(i_end,k,j) -rdx*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO
 ENDIF

 IF( (config_flags%open_ys) .and. (jts == jds) ) THEN

 DO i =i_start,i_end
 DO k =kts,ktf

 g_vb =(0.5*(g_rv(i,k,jts) +g_rv(i,k,jts+1)) +0.0 -(0.5*(g_rv(i,k,jts) &
 +g_rv(i,k,jts+1)) -0.0)*sign(1.0, 0.5*(rv(i,k,jts) +rv(i,k,jts+1)) -(0.)))*0.5
 vb =min(0.5*(rv(i,k,jts) +rv(i,k,jts+1)),0.)

 g_Tmpv1 =vb*(g_field_old(i,k,jts+1) -g_field_old(i,k,jts)) +g_vb*( &
 field_old(i,k,jts+1) -field_old(i,k,jts)) 
 Tmpv1 =vb*(field_old(i,k,jts+1) -field_old(i,k,jts))

 g_Tmpv2 =field(i,k,jts)*(g_rv(i,k,jts+1) -g_rv(i,k,jts)) +g_field(i,k, &
 jts)*(rv(i,k,jts+1) -rv(i,k,jts)) 
 Tmpv2 =field(i,k,jts)*(rv(i,k,jts+1) -rv(i,k,jts))

 g_tendency(i,k,jts) =g_tendency(i,k,jts) -rdy*(g_Tmpv1 +g_Tmpv2)
 tendency(i,k,jts) =tendency(i,k,jts) -rdy*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO
 ENDIF

 IF( (config_flags%open_ye) .and. (jte == jde)) THEN

 DO i =i_start,i_end
 DO k =kts,ktf

 g_vb =(0.5*(g_rv(i,k,jte-1) +g_rv(i,k,jte)) +0.0 +(0.5*(g_rv(i,k,jte-1) &
 +g_rv(i,k,jte)) -0.0)*sign(1.0, 0.5*(rv(i,k,jte-1) +rv(i,k,jte)) -(0.)))*0.5
 vb =max(0.5*(rv(i,k,jte-1) +rv(i,k,jte)),0.)

 g_Tmpv1 =vb*(g_field_old(i,k,j_end) -g_field_old(i,k,j_end-1)) &
 +g_vb*(field_old(i,k,j_end) -field_old(i,k,j_end-1)) 
 Tmpv1 =vb*(field_old(i,k,j_end) -field_old(i,k,j_end-1))

 g_Tmpv2 =field(i,k,j_end)*(g_rv(i,k,jte) -g_rv(i,k,jte-1)) +g_field(i,k, &
 j_end)*(rv(i,k,jte) -rv(i,k,jte-1)) 
 Tmpv2 =field(i,k,j_end)*(rv(i,k,jte) -rv(i,k,jte-1))

 g_tendency(i,k,j_end) =g_tendency(i,k,j_end) -rdy*(g_Tmpv1 +g_Tmpv2)
 tendency(i,k,j_end) =tendency(i,k,j_end) -rdy*(Tmpv1 +Tmpv2)

 ENDDO
 ENDDO
 ENDIF

 i_start =its-1

 i_end =min(ite,ide-1) +1

 j_start =jts-1

 j_end =min(jte,jde-1) +1

 IF(degrade_xs) i_start =max(its-1,ids)

 IF(degrade_xe) i_end =min(ite+1,ide-1)

 IF(degrade_ys) j_start =max(jts-1,jds)

 IF(degrade_ye) j_end =min(jte+1,jde-1)

 IF(vert_order == 3) THEN

 DO j =j_start,j_end
 DO i =i_start,i_end

 g_fqz(i,1,j) =0.0
 fqz(i,1,j) =0.

 g_fqzl(i,1,j) =0.0
 fqzl(i,1,j) =0.

 g_fqz(i,kde,j) =0.0
 fqz(i,kde,j) =0.

 g_fqzl(i,kde,j) =0.0
 fqzl(i,kde,j) =0.

 ENDDO

 DO k =kts+2,ktf-1
 DO i =i_start,i_end

 g_vel =g_rom(i,k,j)
 vel =rom(i,k,j)

 g_cr =-g_vel
 cr =-vel

 g_FuncVal1=g_flux_upwind(field_old(i,k-1,j),g_field_old(i,k-1,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqzl(i,k,j) =g_Tmpv1
 fqzl(i,k,j) =Tmpv1

 g_FuncVal1=g_flux3(field(i,k-2,j),g_field(i,k-2,j),field(i,k-1,j) &
,g_field(i,k-1,j),field(i,k,j),g_field(i,k,j),field(i,k+1,j),g_field(i,k+1, &
 j),-vel,-g_vel)
 FuncVal1 =flux3(field(i,k-2,j),field(i,k-1,j),field(i,k,j),field(i,k+1,j),-vel)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqz(i,k,j) =g_Tmpv1
 fqz(i,k,j) =Tmpv1

 g_fqz(i,k,j) =g_fqz(i,k,j) -g_fqzl(i,k,j)
 fqz(i,k,j) =fqz(i,k,j) -fqzl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k-1,j) +(g_qmax(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmax(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k-1,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k-1,j) -(g_qmin(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmin(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k-1,j))

 else

 g_qmax(i,k-1,j) =(g_qmax(i,k-1,j) +g_field_old(i,k,j) +(g_qmax(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmax(i,k-1,j) =max(qmax(i,k-1,j),field_old(i,k,j))

 g_qmin(i,k-1,j) =(g_qmin(i,k-1,j) +g_field_old(i,k,j) -(g_qmin(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmin(i,k-1,j) =min(qmin(i,k-1,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO

 DO i =i_start,i_end

 k =kts+1

 g_vel =g_rom(i,k,j)
 vel =rom(i,k,j)

 g_cr =-g_vel
 cr =-vel

 g_FuncVal1=g_flux_upwind(field_old(i,k-1,j),g_field_old(i,k-1,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqzl(i,k,j) =g_Tmpv1
 fqzl(i,k,j) =Tmpv1

 g_Tmpv1 =rom(i,k,j)*(fzm(k)*g_field(i,k,j) +fzp(k)*g_field(i,k-1,j)) &
 +g_rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j)) 
 Tmpv1 =rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j))

 g_fqz(i,k,j) =g_Tmpv1
 fqz(i,k,j) =Tmpv1

 g_fqz(i,k,j) =g_fqz(i,k,j) -g_fqzl(i,k,j)
 fqz(i,k,j) =fqz(i,k,j) -fqzl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k-1,j) +(g_qmax(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmax(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k-1,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k-1,j) -(g_qmin(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmin(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k-1,j))

 else

 g_qmax(i,k-1,j) =(g_qmax(i,k-1,j) +g_field_old(i,k,j) +(g_qmax(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmax(i,k-1,j) =max(qmax(i,k-1,j),field_old(i,k,j))

 g_qmin(i,k-1,j) =(g_qmin(i,k-1,j) +g_field_old(i,k,j) -(g_qmin(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmin(i,k-1,j) =min(qmin(i,k-1,j),field_old(i,k,j))

 end IF

 k =ktf

 g_vel =g_rom(i,k,j)
 vel =rom(i,k,j)

 g_cr =-g_vel
 cr =-vel

 g_FuncVal1=g_flux_upwind(field_old(i,k-1,j),g_field_old(i,k-1,j) &
,field_old(i,k,j),g_field_old(i,k,j),cr,g_cr)
 FuncVal1 =flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)

 g_Tmpv1 =vel*g_FuncVal1 +g_vel*FuncVal1 
 Tmpv1 =vel*FuncVal1

 g_fqzl(i,k,j) =g_Tmpv1
 fqzl(i,k,j) =Tmpv1

 g_Tmpv1 =rom(i,k,j)*(fzm(k)*g_field(i,k,j) +fzp(k)*g_field(i,k-1,j)) &
 +g_rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j)) 
 Tmpv1 =rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j))

 g_fqz(i,k,j) =g_Tmpv1
 fqz(i,k,j) =Tmpv1

 g_fqz(i,k,j) =g_fqz(i,k,j) -g_fqzl(i,k,j)
 fqz(i,k,j) =fqz(i,k,j) -fqzl(i,k,j)

 IF(cr.gt. 0) THEN

 g_qmax(i,k,j) =(g_qmax(i,k,j) +g_field_old(i,k-1,j) +(g_qmax(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmax(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmax(i,k,j) =max(qmax(i,k,j),field_old(i,k-1,j))

 g_qmin(i,k,j) =(g_qmin(i,k,j) +g_field_old(i,k-1,j) -(g_qmin(i,k,j) &
 -g_field_old(i,k-1,j))*sign(1.0, qmin(i,k,j) -(field_old(i,k-1,j))))*0.5
 qmin(i,k,j) =min(qmin(i,k,j),field_old(i,k-1,j))

 else

 g_qmax(i,k-1,j) =(g_qmax(i,k-1,j) +g_field_old(i,k,j) +(g_qmax(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmax(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmax(i,k-1,j) =max(qmax(i,k-1,j),field_old(i,k,j))

 g_qmin(i,k-1,j) =(g_qmin(i,k-1,j) +g_field_old(i,k,j) -(g_qmin(i,k-1,j) &
 -g_field_old(i,k,j))*sign(1.0, qmin(i,k-1,j) -(field_old(i,k,j))))*0.5
 qmin(i,k-1,j) =min(qmin(i,k-1,j),field_old(i,k,j))

 end IF
 ENDDO
 ENDDO
 ELSE

! Revised by Ning Pan, 2010-07-25
! WRITE (wrf_err_message,*) ' advect_scalar_mono, v_order not known ',vert_order
 WRITE (wrf_err_message,*) ' g_advect_scalar_mono, v_order not known ',vert_order

!DELETED BY WALLS
!CALL g_wrf_error_fatal(wrf_err_message)
CALL wrf_error_fatal(wrf_err_message)  ! Added by Ning Pan, 2010-07-25
 ENDIF

 IF(mono_limit) THEN

 i_start =its-1

 i_end =min(ite,ide-1) +1

 j_start =jts-1

 j_end =min(jte,jde-1) +1

 IF(degrade_xs) i_start =max(its-1,ids)

 IF(degrade_xe) i_end =min(ite+1,ide-1)

 IF(degrade_ys) j_start =max(jts-1,jds)

 IF(degrade_ye) j_end =min(jte+1,jde-1)

 IF(config_flags%specified .or. config_flags%nested) THEN

 IF(degrade_xs) i_start =max(its-1,ids+1)

 IF(degrade_xe) i_end =min(ite+1,ide-2)

 IF(degrade_ys) j_start =max(jts-1,jds+1)

 IF(degrade_ye) j_end =min(jte+1,jde-2)
  END IF

 IF(config_flags%open_xs) THEN

 IF(degrade_xs) i_start =max(its-1,ids+1)
  END IF

 IF(config_flags%open_xe) THEN

 IF(degrade_xe) i_end =min(ite+1,ide-2)
  END IF

 IF(config_flags%open_ys) THEN

 IF(degrade_ys) j_start =max(jts-1,jds+1)
  END IF

 IF(config_flags%open_ye) THEN

 IF(degrade_ye) j_end =min(jte+1,jde-2)
  END IF

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_Tmpv1 =(mub(i,j) +mu_old(i,j))*g_field_old(i,k,j) +(g_mu_old(i,j)) &
*field_old(i,k,j) 
 Tmpv1 =(mub(i,j) +mu_old(i,j))*field_old(i,k,j)

 g_ph_upwind =g_Tmpv1 -dt*(msftx(i,j) *msfty(i,j)*(rdx*(g_fqxl(i+1,k,j) &
 -g_fqxl(i,k,j)) +rdy*(g_fqyl(i,k,j+1) -g_fqyl(i,k,j))) +msfty(i,j) *rdzw(k) &
*(g_fqzl(i,k+1,j) -g_fqzl(i,k,j)))
 ph_upwind =Tmpv1 -dt*(msftx(i,j) *msfty(i,j)*(rdx*(fqxl(i+1,k,j) -fqxl(i,k,j)) &
 +rdy*(fqyl(i,k,j+1) -fqyl(i,k,j))) +msfty(i,j) *rdzw(k)*(fqzl(i,k+1,j) -fqzl(i,k,j)))

 g_flux_in =-dt*((msftx(i,j) *msfty(i,j))*(rdx*((0.0 +g_fqx(i+1,k,j) &
 -(0.0 -g_fqx(i+1,k,j))*sign(1.0, 0. -(fqx(i+1,k,j))))*0.5 -(0.0 +g_fqx(i,k,j) &
 +(0.0 -g_fqx(i,k,j))*sign(1.0, 0. -(fqx(i,k,j))))*0.5) +rdy*((0.0 +g_fqy(i,k, &
 j+1) -(0.0 -g_fqy(i,k,j+1))*sign(1.0, 0. -(fqy(i,k,j+1))))*0.5 -(0.0 +g_fqy(i, &
 k,j) +(0.0 -g_fqy(i,k,j))*sign(1.0, 0. -(fqy(i,k,j))))*0.5)) +msfty(i,j) *rdzw(k) &
*((0.0 +g_fqz(i,k+1,j) +(0.0 -g_fqz(i,k+1,j))*sign(1.0, 0. -(fqz(i,k+1,j)))) &
*0.5 -(0.0 +g_fqz(i,k,j) -(0.0 -g_fqz(i,k,j))*sign(1.0, 0. -(fqz(i,k,j))))*0.5))
 flux_in =-dt*((msftx(i,j) *msfty(i,j))*(rdx*(min(0.,fqx(i+1,k,j)) -max(0.,fqx(i,k, &
 j))) +rdy*(min(0.,fqy(i,k,j+1)) -max(0.,fqy(i,k,j)))) +msfty(i,j) *rdzw(k) &
*(max(0.,fqz(i,k+1,j)) -min(0.,fqz(i,k,j))))

 g_Tmpv1 =mut(i,j)*g_qmax(i,k,j) +g_mut(i,j)*qmax(i,k,j) 
 Tmpv1 =mut(i,j)*qmax(i,k,j)

 g_ph_hi =g_Tmpv1 -g_ph_upwind
 ph_hi =Tmpv1 -ph_upwind

 g_Tmpv1 =(g_ph_hi*(flux_in +eps) -(g_flux_in)*ph_hi)/((flux_in +eps)*(flux_in +eps)) 
 Tmpv1 =ph_hi/(flux_in +eps)

 IF( flux_in .gt. ph_hi ) g_scale_in(i,k,j) =(0.0 +g_Tmpv1 +(0.0 -g_Tmpv1) &
*sign(1.0, 0. -(Tmpv1)))*0.5
 IF( flux_in .gt. ph_hi ) scale_in(i,k,j) =max(0.,Tmpv1)

 g_flux_out =dt*((msftx(i,j) *msfty(i,j))*(rdx*((0.0 +g_fqx(i+1,k,j) &
 +(0.0 -g_fqx(i+1,k,j))*sign(1.0, 0. -(fqx(i+1,k,j))))*0.5 -(0.0 +g_fqx(i,k,j) &
 -(0.0 -g_fqx(i,k,j))*sign(1.0, 0. -(fqx(i,k,j))))*0.5) +rdy*((0.0 +g_fqy(i,k, &
 j+1) +(0.0 -g_fqy(i,k,j+1))*sign(1.0, 0. -(fqy(i,k,j+1))))*0.5 -(0.0 +g_fqy(i, &
 k,j) -(0.0 -g_fqy(i,k,j))*sign(1.0, 0. -(fqy(i,k,j))))*0.5)) +msfty(i,j) *rdzw(k) &
*((0.0 +g_fqz(i,k+1,j) -(0.0 -g_fqz(i,k+1,j))*sign(1.0, 0. -(fqz(i,k+1,j)))) &
*0.5 -(0.0 +g_fqz(i,k,j) +(0.0 -g_fqz(i,k,j))*sign(1.0, 0. -(fqz(i,k,j))))*0.5))
 flux_out =dt*((msftx(i,j) *msfty(i,j))*(rdx*(max(0.,fqx(i+1,k,j)) -min(0.,fqx(i,k, &
 j))) +rdy*(max(0.,fqy(i,k,j+1)) -min(0.,fqy(i,k,j)))) +msfty(i,j) *rdzw(k) &
*(min(0.,fqz(i,k+1,j)) -max(0.,fqz(i,k,j))))

 g_Tmpv1 =mut(i,j)*g_qmin(i,k,j) +g_mut(i,j)*qmin(i,k,j) 
 Tmpv1 =mut(i,j)*qmin(i,k,j)

 g_ph_low =g_ph_upwind -g_Tmpv1
 ph_low =ph_upwind -Tmpv1

 g_Tmpv1 =(g_ph_low*(flux_out +eps) -(g_flux_out)*ph_low)/((flux_out +eps) &
*(flux_out +eps)) 
 Tmpv1 =ph_low/(flux_out +eps)

 IF( flux_out .gt. ph_low ) g_scale_out(i,k,j) =(0.0 +g_Tmpv1 +(0.0 -g_Tmpv1) &
*sign(1.0, 0. -(Tmpv1)))*0.5
 IF( flux_out .gt. ph_low ) scale_out(i,k,j) =max(0.,Tmpv1)
 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end+1

 IF( fqx (i,k,j) .gt. 0.) THEN

 g_Tmpv1 =min(scale_in(i,k,j),scale_out(i-1,k,j))*g_fqx(i,k,j) +(g_scale_in( &
 i,k,j) +g_scale_out(i-1,k,j) -(g_scale_in(i,k,j) -g_scale_out(i-1,k,j)) &
*sign(1.0, scale_in(i,k,j) -(scale_out(i-1,k,j))))*0.5*fqx(i,k,j) 
 Tmpv1 =min(scale_in(i,k,j),scale_out(i-1,k,j))*fqx(i,k,j)

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 ELSE

 g_Tmpv1 =min(scale_out(i,k,j),scale_in(i-1,k,j))*g_fqx(i,k,j) +( &
 g_scale_out(i,k,j) +g_scale_in(i-1,k,j) -(g_scale_out(i,k,j) -g_scale_in( &
 i-1,k,j))*sign(1.0, scale_out(i,k,j) -(scale_in(i-1,k,j))))*0.5*fqx(i,k,j) 
 Tmpv1 =min(scale_out(i,k,j),scale_in(i-1,k,j))*fqx(i,k,j)

 g_fqx(i,k,j) =g_Tmpv1
 fqx(i,k,j) =Tmpv1

 ENDIF
 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end+1
 DO k =kts,ktf
 DO i =i_start,i_end

 IF( fqy (i,k,j) .gt. 0.) THEN

 g_Tmpv1 =min(scale_in(i,k,j),scale_out(i,k,j-1))*g_fqy(i,k,j) +(g_scale_in( &
 i,k,j) +g_scale_out(i,k,j-1) -(g_scale_in(i,k,j) -g_scale_out(i,k,j-1)) &
*sign(1.0, scale_in(i,k,j) -(scale_out(i,k,j-1))))*0.5*fqy(i,k,j) 
 Tmpv1 =min(scale_in(i,k,j),scale_out(i,k,j-1))*fqy(i,k,j)

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 ELSE

 g_Tmpv1 =min(scale_out(i,k,j),scale_in(i,k,j-1))*g_fqy(i,k,j) +( &
 g_scale_out(i,k,j) +g_scale_in(i,k,j-1) -(g_scale_out(i,k,j) -g_scale_in( &
 i,k,j-1))*sign(1.0, scale_out(i,k,j) -(scale_in(i,k,j-1))))*0.5*fqy(i,k,j) 
 Tmpv1 =min(scale_out(i,k,j),scale_in(i,k,j-1))*fqy(i,k,j)

 g_fqy(i,k,j) =g_Tmpv1
 fqy(i,k,j) =Tmpv1

 ENDIF
 ENDDO
 ENDDO
 ENDDO

 DO j =j_start,j_end
 DO k =kts+1,ktf
 DO i =i_start,i_end

 IF( fqz (i,k,j) .lt. 0.) THEN

 g_Tmpv1 =min(scale_in(i,k,j),scale_out(i,k-1,j))*g_fqz(i,k,j) +(g_scale_in( &
 i,k,j) +g_scale_out(i,k-1,j) -(g_scale_in(i,k,j) -g_scale_out(i,k-1,j)) &
*sign(1.0, scale_in(i,k,j) -(scale_out(i,k-1,j))))*0.5*fqz(i,k,j) 
 Tmpv1 =min(scale_in(i,k,j),scale_out(i,k-1,j))*fqz(i,k,j)

 g_fqz(i,k,j) =g_Tmpv1
 fqz(i,k,j) =Tmpv1

 ELSE

 g_Tmpv1 =min(scale_out(i,k,j),scale_in(i,k-1,j))*g_fqz(i,k,j) +( &
 g_scale_out(i,k,j) +g_scale_in(i,k-1,j) -(g_scale_out(i,k,j) -g_scale_in( &
 i,k-1,j))*sign(1.0, scale_out(i,k,j) -(scale_in(i,k-1,j))))*0.5*fqz(i,k,j) 
 Tmpv1 =min(scale_out(i,k,j),scale_in(i,k-1,j))*fqz(i,k,j)

 g_fqz(i,k,j) =g_Tmpv1
 fqz(i,k,j) =Tmpv1

 ENDIF
 ENDDO
 ENDDO
 ENDDO
 END IF

 i_start =its

 i_end =min(ite,ide-1)

 j_start =jts

 j_end =min(jte,jde-1)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tendency(i,k,j) =g_tendency(i,k,j) -rdzw(k)*(g_fqz(i,k+1,j) -g_fqz(i,k, &
 j) +g_fqzl(i,k+1,j) -g_fqzl(i,k,j))
 tendency(i,k,j) =tendency(i,k,j) -rdzw(k)*(fqz(i,k+1,j) -fqz(i,k,j) +fqzl(i,k+1,j) &
 -fqzl(i,k,j))

 ENDDO
 ENDDO
 ENDDO

 IF(tenddec) THEN
 DO j = j_start, j_end
 DO k = kts, ktf
 DO i = i_start, i_end

    g_z_tendency (i,k,j) = -rdzw(k)*( g_fqz (i,k+1,j)-g_fqz (i,k,j)  &
                                     +g_fqzl(i,k+1,j)-g_fqzl(i,k,j))

    z_tendency (i,k,j) = 0. -rdzw(k)*( fqz (i,k+1,j)-fqz (i,k,j)  &
                                     +fqzl(i,k+1,j)-fqzl(i,k,j))

 ENDDO
 ENDDO
 ENDDO
 END IF

 IF(degrade_xs) i_start =max(its,ids+1)

 IF(degrade_xe) i_end =min(ite,ide-2)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tendency(i,k,j) =g_tendency(i,k,j) -msftx(i,j)*(rdx*(g_fqx(i+1,k,j) &
 -g_fqx(i,k,j) +g_fqxl(i+1,k,j) -g_fqxl(i,k,j)))
 tendency(i,k,j) =tendency(i,k,j) -msftx(i,j)*(rdx*(fqx(i+1,k,j) -fqx(i,k,j) &
 +fqxl(i+1,k,j) -fqxl(i,k,j)))

 ENDDO
 ENDDO
 ENDDO

 IF(tenddec) THEN
 DO j = j_start, j_end
 DO k = kts, ktf
 DO i = i_start, i_end

    g_h_tendency (i,k,j) =                                       &
              - msftx(i,j)*( rdx*( g_fqx (i+1,k,j)-g_fqx (i,k,j)     &
                                  +g_fqxl(i+1,k,j)-g_fqxl(i,k,j))   )
    h_tendency (i,k,j) = 0.                                      &
              - msftx(i,j)*( rdx*( fqx (i+1,k,j)-fqx (i,k,j)     &
                                  +fqxl(i+1,k,j)-fqxl(i,k,j))   )

 ENDDO
 ENDDO
 ENDDO
 END IF

 i_start =its

 i_end =min(ite,ide-1)

 IF(degrade_ys) j_start =max(jts,jds+1)

 IF(degrade_ye) j_end =min(jte,jde-2)

 DO j =j_start,j_end
 DO k =kts,ktf
 DO i =i_start,i_end

 g_tendency(i,k,j) =g_tendency(i,k,j) -msftx(i,j)*(rdy*(g_fqy(i,k,j+1) &
 -g_fqy(i,k,j) +g_fqyl(i,k,j+1) -g_fqyl(i,k,j)))
 tendency(i,k,j) =tendency(i,k,j) -msftx(i,j)*(rdy*(fqy(i,k,j+1) -fqy(i,k,j) &
 +fqyl(i,k,j+1) -fqyl(i,k,j)))

 ENDDO
 ENDDO
 ENDDO

 IF(tenddec) THEN
 DO j = j_start, j_end
 DO k = kts, ktf
 DO i = i_start, i_end

    g_h_tendency (i,k,j) = g_h_tendency (i,k,j)                      &
              - msftx(i,j)*( rdy*( g_fqy (i,k,j+1)-g_fqy (i,k,j)     &
                                  +g_fqyl(i,k,j+1)-g_fqyl(i,k,j))   )
    h_tendency (i,k,j) = h_tendency (i,k,j)                      &
              - msftx(i,j)*( rdy*( fqy (i,k,j+1)-fqy (i,k,j)     &
                                  +fqyl(i,k,j+1)-fqyl(i,k,j))   )

 ENDDO
 ENDDO
 ENDDO
 END IF

 END SUBROUTINE g_advect_scalar_mono


!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_scalar_weno in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom field tendency ru rv field_old
!   RW status of diff variables: rom:in field:in tendency:in-out
!                ru:in rv:in field_old:in
SUBROUTINE G_ADVECT_SCALAR_WENO(field, fieldd, field_old, field_oldd, &
&  tendency, tendencyd, ru, rud, rv, rvd, rom, romd, mut, time_step, &
&  config_flags, msfux, msfuy, msfvx, msfvy, msftx, msfty, fzm, fzp, rdx&
&  , rdy, rdzw, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, &
&  kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: field, &
&  field_old, ru, rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: fieldd, &
&  field_oldd, rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  INTEGER, PARAMETER :: is=0, js=0, ks=0
  REAL :: mrdx, mrdy, ub, vb, vw
  REAL :: ubd, vbd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its - is:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its-is:ite+1, kts:kte) :: fqxd
!   REAL,  DIMENSION( its:ite+1, kts:kte  ) :: fqx
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  INTEGER :: horz_order, vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
  REAL :: dir, vv
  REAL :: ue, uw, vs, vn, wb, wt
  REAL, PARAMETER :: f30=7./12., f31=1./12.
  REAL, PARAMETER :: f50=37./60., f51=2./15., f52=1./60.
  INTEGER :: kt, kb
  REAL :: qim2, qim1, qi, qip1, qip2
  REAL :: qim2d, qim1d, qid, qip1d, qip2d
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0d, beta1d, beta2d, f0d, f1d, f2d, wi0d, wi1d&
&  , wi2d, sumwkd
  DOUBLE PRECISION, PARAMETER :: gi0=1.d0/10.d0, gi1=6.d0/10.d0, gi2=&
&    3.d0/10.d0, eps=1.0d-28
  INTEGER, PARAMETER :: pw=2
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified
  DOUBLE PRECISION :: pwx1
  DOUBLE PRECISION :: pwx1d
  DOUBLE PRECISION :: pwr1
  DOUBLE PRECISION :: pwr1d
  INTRINSIC MAX
  INTRINSIC SIGN
  INTRINSIC MIN




  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
! config_flags%h_sca_adv_order
  horz_order = 5
! config_flags%v_sca_adv_order
  vert_order = 5
!  begin with horizontal flux divergence
!  here is the choice of flux operators
  IF (horz_order .EQ. 5) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
    degrade_xs = .true.
    degrade_xe = .true.
    degrade_ys = .true.
    degrade_ye = .true.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. &
&        its .GT. ids + 3) degrade_xs = .false.
    IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. &
&        ite .LT. ide - 3) degrade_xe = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. &
&        jts .GT. jds + 3) degrade_ys = .false.
    IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. &
&        jte .LT. jde - 4) degrade_ye = .false.
    IF (kte .GT. kde - 1) THEN
      ktf = kde - 1
    ELSE
      ktf = kte
    END IF
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
! check for U
    IF (is .EQ. 1) THEN
      i_start = its
      i_end = ite
      IF (config_flags%open_xs .OR. specified) THEN
        IF (ids + 1 .LT. its) THEN
          i_start = its
        ELSE
          i_start = ids + 1
        END IF
      END IF
      IF (config_flags%open_xe .OR. specified) THEN
        IF (ide - 1 .GT. ite) THEN
          i_end = ite
        ELSE
          i_end = ide - 1
        END IF
      END IF
      IF (config_flags%periodic_x) i_start = its
      IF (config_flags%periodic_x) i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    j_start_f = j_start
    j_end_f = j_end + 1
    IF (degrade_ys) THEN
      IF (jts .LT. jds + 1) THEN
        j_start = jds + 1
      ELSE
        j_start = jts
      END IF
      j_start_f = jds + 3
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        j_end = jde - 2
      ELSE
        j_end = jte
      END IF
      j_end_f = jde - 3
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        j_end = jde - 1
      ELSE
        j_end = jte
      END IF
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          DO i=i_start,i_end
!          vel = rv(i,k,j)
            veld = 0.5*(rvd(i, k, j)+rvd(i-is, k-ks, j-js))
            vel = 0.5*(rv(i, k, j)+rv(i-is, k-ks, j-js))
            IF (vel*sign(1,time_step) .GE. 0.0) THEN
              qip2d = fieldd(i, k, j+1)
              qip2 = field(i, k, j+1)
              qip1d = fieldd(i, k, j)
              qip1 = field(i, k, j)
              qid = fieldd(i, k, j-1)
              qi = field(i, k, j-1)
              qim1d = fieldd(i, k, j-2)
              qim1 = field(i, k, j-2)
              qim2d = fieldd(i, k, j-3)
              qim2 = field(i, k, j-3)
            ELSE
              qip2d = fieldd(i, k, j-2)
              qip2 = field(i, k, j-2)
              qip1d = fieldd(i, k, j-1)
              qip1 = field(i, k, j-1)
              qid = fieldd(i, k, j)
              qi = field(i, k, j)
              qim1d = fieldd(i, k, j+1)
              qim1 = field(i, k, j+1)
              qim2d = fieldd(i, k, j+2)
              qim2 = field(i, k, j+2)
            END IF
            f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
            f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
            f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
            f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
            f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
            f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
            beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + &
&              2*(qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
            beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+&
&              3.*qi)**2
            beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + &
&              2*(qim1-qip1)*(qim1d-qip1d)/4.
            beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
            beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + &
&              2*(qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
            beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+&
&              3.*qi)**2
            pwx1d = beta0d
            pwx1 = eps + beta0
            IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))&
&            ) THEN
              pwr1d = pw*pwx1**(pw-1)*pwx1d
            ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
              pwr1d = pwx1d
            ELSE
              pwr1d = 0.0
            END IF
            pwr1 = pwx1**pw
            wi0d = -(gi0*pwr1d/pwr1**2)
            wi0 = gi0/pwr1
            pwx1d = beta1d
            pwx1 = eps + beta1
            IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))&
&            ) THEN
              pwr1d = pw*pwx1**(pw-1)*pwx1d
            ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
              pwr1d = pwx1d
            ELSE
              pwr1d = 0.0
            END IF
            pwr1 = pwx1**pw
            wi1d = -(gi1*pwr1d/pwr1**2)
            wi1 = gi1/pwr1
            pwx1d = beta2d
            pwx1 = eps + beta2
            IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))&
&            ) THEN
              pwr1d = pw*pwx1**(pw-1)*pwx1d
            ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
              pwr1d = pwx1d
            ELSE
              pwr1d = 0.0
            END IF
            pwr1 = pwx1**pw
            wi2d = -(gi2*pwr1d/pwr1**2)
            wi2 = gi2/pwr1
            sumwkd = wi0d + wi1d + wi2d
            sumwk = wi0 + wi1 + wi2
            fqyd(i, k, jp1) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0&
&              +wi0*f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*&
&              f0+wi1*f1+wi2*f2)*sumwkd)/sumwk**2
            fqy(i, k, jp1) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
          END DO
        END DO
      ELSE IF (j .EQ. jds + 1) THEN
!          fqy( i, k, jp1 ) = vel*flux5(                                &
!                  field(i,k,j-3), field(i,k,j-2), field(i,k,j-1),       &
!                  field(i,k,j  ), field(i,k,j+1), field(i,k,j+2),  vel )
! 2nd order flux next to south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
!              fqy(i,k, jp1) = 0.5*0.5*( rv(i,k,j) + rv(i-is,k-ks,j-js) )*          &
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          DO i=i_start,i_end
!              vel = 0.5*( rv(i,k,j) + rv(i-is,k-ks,j-js) )
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
            fqyd(i, k, jp1) = veld*(7./12.*(field(i, k, j)+field(i, k, j&
&              -1))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1., &
&              vel)*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-3.*(field&
&              (i, k, j)-field(i, k, j-1)))) + vel*(7.*(fieldd(i, k, j)+&
&              fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+fieldd(i, k, j-2&
&              ))/12.+SIGN(1., vel)*(fieldd(i, k, j+1)-fieldd(i, k, j-2)-&
&              3.*(fieldd(i, k, j)-fieldd(i, k, j-1)))/12.)
            fqy(i, k, jp1) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1., vel&
&              )*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-3.*(field(i&
&              , k, j)-field(i, k, j-1))))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
!              fqy(i, k, jp1) = 0.5*0.5*( rv(i,k,j) + rv(i-is,k-ks,j-js) )*      &
            fqyd(i, k, jp1) = 0.5*(rvd(i, k, j)*(field(i, k, j)+field(i&
&              , k, j-1))+rv(i, k, j)*(fieldd(i, k, j)+fieldd(i, k, j-1))&
&              )
            fqy(i, k, jp1) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k&
&              , j-1))
          END DO
        END DO
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          DO i=i_start,i_end
            veld = rvd(i, k, j)
            vel = rv(i, k, j)
!              vel = 0.5*( rv(i,k,j) + rv(i-is,k-ks,j-js) )
            fqyd(i, k, jp1) = veld*(7./12.*(field(i, k, j)+field(i, k, j&
&              -1))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1., &
&              vel)*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-3.*(field&
&              (i, k, j)-field(i, k, j-1)))) + vel*(7.*(fieldd(i, k, j)+&
&              fieldd(i, k, j-1))/12.-(fieldd(i, k, j+1)+fieldd(i, k, j-2&
&              ))/12.+SIGN(1., vel)*(fieldd(i, k, j+1)-fieldd(i, k, j-2)-&
&              3.*(fieldd(i, k, j)-fieldd(i, k, j-1)))/12.)
            fqy(i, k, jp1) = vel*(7./12.*(field(i, k, j)+field(i, k, j-1&
&              ))-1./12.*(field(i, k, j+1)+field(i, k, j-2))+SIGN(1., vel&
&              )*(1./12.)*(field(i, k, j+1)-field(i, k, j-2)-3.*(field(i&
&              , k, j)-field(i, k, j-1))))
          END DO
        END DO
      END IF
!  y flux-divergence into tendency
      IF (is .EQ. 0) THEN
! Comments on polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
        IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
          DO k=kts,ktf
            DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
              mrdy = msftx(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i&
&                , k, jp1)
              tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k&
&                , jp1)
            END DO
          END DO
        ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
          DO k=kts,ktf
            DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
              mrdy = msftx(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i&
&                , k, jp0)
              tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k&
&                , jp0)
            END DO
          END DO
        ELSE IF (j .GT. j_start) THEN
! normal code
          DO k=kts,ktf
            DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 2nd term RHS
              mrdy = msftx(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i&
&                , k, jp1)-fqyd(i, k, jp0))
              tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k&
&                , jp1)-fqy(i, k, jp0))
            END DO
          END DO
        END IF
      ELSE IF (is .EQ. 1) THEN
! (j > j_start) will miss the u(,,jds) tendency
        IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
          DO k=kts,ktf
            DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
              mrdy = msfux(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i&
&                , k, jp1)
              tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k&
&                , jp1)
            END DO
          END DO
        ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
          DO k=kts,ktf
            DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
              mrdy = msfux(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i&
&                , k, jp0)
              tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k&
&                , jp0)
            END DO
          END DO
        ELSE IF (j .GT. j_start) THEN
! normal code
          DO k=kts,ktf
            DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
              mrdy = msfux(i, j-1)*rdy
              tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i&
&                , k, jp1)-fqyd(i, k, jp0))
              tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k&
&                , jp1)-fqy(i, k, jp0))
            END DO
          END DO
        END IF
      END IF
      jtmp = jp1
      jp1 = jp0
      jp0 = jtmp
    END DO j_loop_y_flux_5
!  next, x - flux divergence
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
    i_start_f = i_start
    i_end_f = i_end + 1
    IF (degrade_xs) THEN
      IF (ids + 1 .LT. its) THEN
        i_start = its
      ELSE
        i_start = ids + 1
      END IF
      IF (i_start + 2 .GT. ids + 3) THEN
        i_start_f = ids + 3
      ELSE
        i_start_f = i_start + 2
      END IF
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        i_end = ite
      ELSE
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
      fqxd = 0.0
    ELSE
      fqxd = 0.0
    END IF
!  compute fluxes
    DO j=j_start,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
!          vel = ru(i,k,j)
          veld = 0.5*(rud(i, k, j)+rud(i-is, k-ks, j-js))
          vel = 0.5*(ru(i, k, j)+ru(i-is, k-ks, j-js))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            qip2d = fieldd(i+1, k, j)
            qip2 = field(i+1, k, j)
            qip1d = fieldd(i, k, j)
            qip1 = field(i, k, j)
            qid = fieldd(i-1, k, j)
            qi = field(i-1, k, j)
            qim1d = fieldd(i-2, k, j)
            qim1 = field(i-2, k, j)
            qim2d = fieldd(i-3, k, j)
            qim2 = field(i-3, k, j)
          ELSE
            qip2d = fieldd(i-2, k, j)
            qip2 = field(i-2, k, j)
            qip1d = fieldd(i-1, k, j)
            qip1 = field(i-1, k, j)
            qid = fieldd(i, k, j)
            qi = field(i, k, j)
            qim1d = fieldd(i+1, k, j)
            qim1 = field(i+1, k, j)
            qim2d = fieldd(i+2, k, j)
            qim2 = field(i+2, k, j)
          END IF
          f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*&
&            (qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*&
&            (qim1-qip1)*(qim1d-qip1d)/4.
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*&
&            (qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
          pwx1d = beta0d
          pwx1 = eps + beta0
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi0d = -(gi0*pwr1d/pwr1**2)
          wi0 = gi0/pwr1
          pwx1d = beta1d
          pwx1 = eps + beta1
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi1d = -(gi1*pwr1d/pwr1**2)
          wi1 = gi1/pwr1
          pwx1d = beta2d
          pwx1 = eps + beta2
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi2d = -(gi2*pwr1d/pwr1**2)
          wi2 = gi2/pwr1
          sumwkd = wi0d + wi1d + wi2d
          sumwk = wi0 + wi1 + wi2
          fqxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&            f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*&
&            f1+wi2*f2)*sumwkd)/sumwk**2
          fqx(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
        END DO
      END DO
!          fqx( i,k ) = vel*flux5( field(i-3,k,j), field(i-2,k,j),  &
!                                         field(i-1,k,j), field(i  ,k,j),  &
!                                         field(i+1,k,j), field(i+2,k,j),  &
!                                         vel                             )
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        DO i=i_start,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j)&
&                )-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1., &
&                vel)*(1./12.)*(field(i+1, k, j)-field(i-2, k, j)-3.*(&
&                field(i, k, j)-field(i-1, k, j)))) + vel*(7.*(fieldd(i, &
&                k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k, j)+fieldd(i&
&                -2, k, j))/12.+SIGN(1., vel)*(fieldd(i+1, k, j)-fieldd(i&
&                -2, k, j)-3.*(fieldd(i, k, j)-fieldd(i-1, k, j)))/12.)
              fqx(i, k) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))-&
&                1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1., vel)&
&                *(1./12.)*(field(i+1, k, j)-field(i-2, k, j)-3.*(field(i&
&                , k, j)-field(i-1, k, j))))
            END DO
          END IF
        END DO
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
            DO k=kts,ktf
              fqxd(i, k) = 0.5*(rud(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))+ru(i, k, j)*(fieldd(i, k, j)+fieldd(i-1, k, j)))
              fqx(i, k) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, &
&                j))
            END DO
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              veld = rud(i, k, j)
              vel = ru(i, k, j)
              fqxd(i, k) = veld*(7./12.*(field(i, k, j)+field(i-1, k, j)&
&                )-1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1., &
&                vel)*(1./12.)*(field(i+1, k, j)-field(i-2, k, j)-3.*(&
&                field(i, k, j)-field(i-1, k, j)))) + vel*(7.*(fieldd(i, &
&                k, j)+fieldd(i-1, k, j))/12.-(fieldd(i+1, k, j)+fieldd(i&
&                -2, k, j))/12.+SIGN(1., vel)*(fieldd(i+1, k, j)-fieldd(i&
&                -2, k, j)-3.*(fieldd(i, k, j)-fieldd(i-1, k, j)))/12.)
              fqx(i, k) = vel*(7./12.*(field(i, k, j)+field(i-1, k, j))-&
&                1./12.*(field(i+1, k, j)+field(i-2, k, j))+SIGN(1., vel)&
&                *(1./12.)*(field(i+1, k, j)-field(i-2, k, j)-3.*(field(i&
&                , k, j)-field(i-1, k, j))))
            END DO
          END IF
        END DO
      END IF
!  x flux-divergence into tendency
      IF (is .EQ. 0) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! see ADT eqn 48 [rho->rho*q] dividing by my, 1st term RHS
            mrdx = msftx(i, j)*rdx
            tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)&
&              -fqxd(i, k))
            tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-&
&              fqx(i, k))
          END DO
        END DO
      ELSE IF (is .EQ. 1) THEN
        DO k=kts,ktf
          DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
            mrdx = msfux(i, j)*rdx
            tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)&
&              -fqxd(i, k))
            tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-&
&              fqx(i, k))
          END DO
        END DO
      END IF
    END DO
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(its, k, j)+rud(its+1, k, j))
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(&
&          field_old(its+1, k, j)-field_old(its, k, j))+ub*(field_oldd(&
&          its+1, k, j)-field_oldd(its, k, j))+fieldd(its, k, j)*(ru(its+&
&          1, k, j)-ru(its, k, j))+field(its, k, j)*(rud(its+1, k, j)-rud&
&          (its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(field_old(&
&          its+1, k, j)-field_old(its, k, j))+field(its, k, j)*(ru(its+1&
&          , k, j)-ru(its, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = 0.5*(rud(ite-1, k, j)+rud(ite, k, j))
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+ub*(&
&          field_oldd(i_end, k, j)-field_oldd(i_end-1, k, j))+fieldd(&
&          i_end, k, j)*(ru(ite, k, j)-ru(ite-1, k, j))+field(i_end, k, j&
&          )*(rud(ite, k, j)-rud(ite-1, k, j)))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(&
&          field_old(i_end, k, j)-field_old(i_end-1, k, j))+field(i_end, &
&          k, j)*(ru(ite, k, j)-ru(ite-1, k, j)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jts)+rvd(i, k, jts+1))
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(&
&          field_old(i, k, jts+1)-field_old(i, k, jts))+vb*(field_oldd(i&
&          , k, jts+1)-field_oldd(i, k, jts))+fieldd(i, k, jts)*(rv(i, k&
&          , jts+1)-rv(i, k, jts))+field(i, k, jts)*(rvd(i, k, jts+1)-rvd&
&          (i, k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(field_old(i&
&          , k, jts+1)-field_old(i, k, jts))+field(i, k, jts)*(rv(i, k, &
&          jts+1)-rv(i, k, jts)))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = 0.5*(rvd(i, k, jte-1)+rvd(i, k, jte))
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+vb*(&
&          field_oldd(i, k, j_end)-field_oldd(i, k, j_end-1))+fieldd(i, k&
&          , j_end)*(rv(i, k, jte)-rv(i, k, jte-1))+field(i, k, j_end)*(&
&          rvd(i, k, jte)-rvd(i, k, jte-1)))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(&
&          field_old(i, k, j_end)-field_old(i, k, j_end-1))+field(i, k, &
&          j_end)*(rv(i, k, jte)-rv(i, k, jte-1)))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!     Scalar equation has 3rd term on RHS = - partial d/dz (q rho w /my)
!     Here we have: - partial d/dz (q*rom) = - partial d/dz (q rho w / my)
!     So we don't need to make a correction for advect_scalar
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  vfluxd = 0.0
  DO j=j_start,j_end
    DO k=kts+3,ktf-2
      DO i=i_start,i_end
!           vel = rom(i,k,j)
        veld = 0.5*(romd(i, k, j)+romd(i-is, k-ks, j-js))
        vel = 0.5*(rom(i, k, j)+rom(i-is, k-ks, j-js))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = fieldd(i, k+1, j)
          qip2 = field(i, k+1, j)
          qip1d = fieldd(i, k, j)
          qip1 = field(i, k, j)
          qid = fieldd(i, k-1, j)
          qi = field(i, k-1, j)
          qim1d = fieldd(i, k-2, j)
          qim1 = field(i, k-2, j)
          qim2d = fieldd(i, k-3, j)
          qim2 = field(i, k-3, j)
        ELSE
          qip2d = fieldd(i, k-2, j)
          qip2 = field(i, k-2, j)
          qip1d = fieldd(i, k-1, j)
          qip1 = field(i, k-1, j)
          qid = fieldd(i, k, j)
          qi = field(i, k, j)
          qim1d = fieldd(i, k+1, j)
          qim1 = field(i, k+1, j)
          qim2d = fieldd(i, k+2, j)
          qim2 = field(i, k+2, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        vfluxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        vflux(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!           vflux(i,k) = vel*flux5(                                 &
!                   field(i,k-3,j), field(i,k-2,j), field(i,k-1,j),       &
!                   field(i,k  ,j), field(i,k+1,j), field(i,k+2,j),  -vel )
    DO i=i_start,i_end
      k = kts + 1
      vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&        , k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*fieldd(&
&        i, k-1, j))
      vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i, &
&        k-1, j))
      k = kts + 2
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      vfluxd(i, k) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1., -vel)*(1./12.)*&
&        (field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-field(i, k&
&        -1, j)))) + vel*(7.*(fieldd(i, k, j)+fieldd(i, k-1, j))/12.-(&
&        fieldd(i, k+1, j)+fieldd(i, k-2, j))/12.+SIGN(1., -vel)*(fieldd(&
&        i, k+1, j)-fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, &
&        j)))/12.)
      vflux(i, k) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./12.&
&        *(field(i, k+1, j)+field(i, k-2, j))+SIGN(1., -vel)*(1./12.)*(&
&        field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-field(i, k-&
&        1, j))))
      k = ktf - 1
      veld = romd(i, k, j)
      vel = rom(i, k, j)
      vfluxd(i, k) = veld*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./&
&        12.*(field(i, k+1, j)+field(i, k-2, j))+SIGN(1., -vel)*(1./12.)*&
&        (field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-field(i, k&
&        -1, j)))) + vel*(7.*(fieldd(i, k, j)+fieldd(i, k-1, j))/12.-(&
&        fieldd(i, k+1, j)+fieldd(i, k-2, j))/12.+SIGN(1., -vel)*(fieldd(&
&        i, k+1, j)-fieldd(i, k-2, j)-3.*(fieldd(i, k, j)-fieldd(i, k-1, &
&        j)))/12.)
      vflux(i, k) = vel*(7./12.*(field(i, k, j)+field(i, k-1, j))-1./12.&
&        *(field(i, k+1, j)+field(i, k-2, j))+SIGN(1., -vel)*(1./12.)*(&
&        field(i, k+1, j)-field(i, k-2, j)-3.*(field(i, k, j)-field(i, k-&
&        1, j))))
      k = ktf
      vfluxd(i, k) = romd(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&        , k-1, j)) + rom(i, k, j)*(fzm(k)*fieldd(i, k, j)+fzp(k)*fieldd(&
&        i, k-1, j))
      vflux(i, k) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i, &
&        k-1, j))
    END DO
    DO k=kts,ktf
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k+1&
&          )-vfluxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)-&
&          vflux(i, k))
      END DO
    END DO
  END DO
END SUBROUTINE G_ADVECT_SCALAR_WENO

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_u in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom u tendency u_old ru rv
!                mut
!   RW status of diff variables: rom:in u:in tendency:in-out u_old:in
!                ru:in rv:in mut:in
SUBROUTINE G_ADVECT_WENO_U(u, ud, u_old, u_oldd, tendency, tendencyd, ru&
&  , rud, rv, rvd, rom, romd, mut, mutd, time_step, config_flags, msfux, &
&  msfuy, msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzw, ids, ide&
&  , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
&  , kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u, u_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ud, u_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax, im, ip
  INTEGER :: jp1, jp0, jtmp
  REAL :: dir, vv
  REAL :: ue, vs, vn, wb, wt
  REAL, PARAMETER :: f30=7./12., f31=1./12.
  REAL, PARAMETER :: f50=37./60., f51=2./15., f52=1./60.
  INTEGER :: kt, kb
  REAL :: qim2, qim1, qi, qip1, qip2
  REAL :: qim2d, qim1d, qid, qip1d, qip2d
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0d, beta1d, beta2d, f0d, f1d, f2d, wi0d, wi1d&
&  , wi2d, sumwkd
  DOUBLE PRECISION, PARAMETER :: gi0=1.d0/10.d0, gi1=6.d0/10.d0, gi2=&
&    3.d0/10.d0, eps=1.0d-18
  INTEGER, PARAMETER :: pw=2
  INTEGER :: horz_order, vert_order
  REAL :: mrdx, mrdy, ub, vb, uw, vw, dvm, dvp
  REAL :: ubd, vbd, vwd, dvmd, dvpd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its - 1:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its-1:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified
  DOUBLE PRECISION :: pwx1
  DOUBLE PRECISION :: pwx1d
  DOUBLE PRECISION :: pwr1
  DOUBLE PRECISION :: pwr1d
  INTRINSIC MAX
  INTRINSIC SIGN
  INTRINSIC MIN




  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
!  set order for vertical and horzontal flux operators
  horz_order = config_flags%h_mom_adv_order
  vert_order = config_flags%v_mom_adv_order
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
!  begin with horizontal flux divergence
!   horizontal_order_test : IF( horz_order == 6 ) THEN
!   ELSE IF( horz_order == 5 ) THEN
!  5th order horizontal flux calculation
!  This code is EXACTLY the same as the 6th order code
!  EXCEPT the 5th order and 3rd operators are used in
!  place of the 6th and 4th order operators
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
  degrade_xs = .true.
  degrade_xe = .true.
  degrade_ys = .true.
  degrade_ye = .true.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. its &
&      .GT. ids + 3) degrade_xs = .false.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. ite &
&      .LT. ide - 2) degrade_xe = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. jts &
&      .GT. jds + 3) degrade_ys = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. jte &
&      .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
  i_start = its
  i_end = ite
  IF (config_flags%open_xs .OR. specified) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
  END IF
  IF (config_flags%open_xe .OR. specified) THEN
    IF (ide - 1 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 1
    END IF
  END IF
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) i_end = ite
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  j_start_f = j_start
  j_end_f = j_end + 1
  IF (degrade_ys) THEN
    IF (jts .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts
    END IF
    j_start_f = jds + 3
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 2) THEN
      j_end = jde - 2
    ELSE
      j_end = jte
    END IF
    j_end_f = jde - 3
  END IF
  IF (config_flags%polar) THEN
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
  END IF
!  compute fluxes, 5th or 6th order
  jp1 = 2
  jp0 = 1
  fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
          vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            qip2d = ud(i, k, j+1)
            qip2 = u(i, k, j+1)
            qip1d = ud(i, k, j)
            qip1 = u(i, k, j)
            qid = ud(i, k, j-1)
            qi = u(i, k, j-1)
            qim1d = ud(i, k, j-2)
            qim1 = u(i, k, j-2)
            qim2d = ud(i, k, j-3)
            qim2 = u(i, k, j-3)
          ELSE
            qip2d = ud(i, k, j-2)
            qip2 = u(i, k, j-2)
            qip1d = ud(i, k, j-1)
            qip1 = u(i, k, j-1)
            qid = ud(i, k, j)
            qi = u(i, k, j)
            qim1d = ud(i, k, j+1)
            qim1 = u(i, k, j+1)
            qim2d = ud(i, k, j+2)
            qim2 = u(i, k, j+2)
          END IF
          f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*&
&            (qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*&
&            (qim1-qip1)*(qim1d-qip1d)/4.
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*&
&            (qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
          pwx1d = beta0d
          pwx1 = eps + beta0
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi0d = -(gi0*pwr1d/pwr1**2)
          wi0 = gi0/pwr1
          pwx1d = beta1d
          pwx1 = eps + beta1
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi1d = -(gi1*pwr1d/pwr1**2)
          wi1 = gi1/pwr1
          pwx1d = beta2d
          pwx1 = eps + beta2
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi2d = -(gi2*pwr1d/pwr1**2)
          wi2 = gi2/pwr1
          sumwkd = wi0d + wi1d + wi2d
          sumwk = wi0 + wi1 + wi2
          fqyd(i, k, jp1) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+&
&            wi0*f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+&
&            wi1*f1+wi2*f2)*sumwkd)/sumwk**2
          fqy(i, k, jp1) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
        END DO
      END DO
    ELSE IF (j .EQ. jds + 1) THEN
!          fqy( i, k, jp1 ) = vel*flux5(               &
!                  u(i,k,j-3), u(i,k,j-2), u(i,k,j-1),       &
!                  u(i,k,j  ), u(i,k,j+1), u(i,k,j+2),  vel )
!  we must be close to some boundary where we need to reduce the order of the stencil
! 2nd order flux next to south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, k&
&            , j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, j)+&
&            ud(i, k, j-1)))
          fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j)+&
&            u(i, k, j-1))
        END DO
      END DO
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
          vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
          fqyd(i, k, jp1) = veld*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&            , j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))/&
&            12.0) + vel*((7.*(ud(i, k, j)+ud(i, k, j-1))-ud(i, k, j+1)-&
&            ud(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i, &
&            k, j+1)-ud(i, k, j-2)-3.*(ud(i, k, j)-ud(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k, j&
&            +1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(&
&            i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))/12.0)
        END DO
      END DO
    ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i-1, k, j))*(u(i, k&
&            , j)+u(i, k, j-1))+(rv(i, k, j)+rv(i-1, k, j))*(ud(i, k, j)+&
&            ud(i, k, j-1)))
          fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i-1, k, j))*(u(i, k, j)+&
&            u(i, k, j-1))
        END DO
      END DO
    ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i-1, k, j))
          vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
          fqyd(i, k, jp1) = veld*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k&
&            , j+1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (u(i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))/&
&            12.0) + vel*((7.*(ud(i, k, j)+ud(i, k, j-1))-ud(i, k, j+1)-&
&            ud(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i, &
&            k, j+1)-ud(i, k, j-2)-3.*(ud(i, k, j)-ud(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(u(i, k, j)+u(i, k, j-1))-(u(i, k, j&
&            +1)+u(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(&
&            i, k, j+1)-u(i, k, j-2)-3.*(u(i, k, j)-u(i, k, j-1)))/12.0)
        END DO
      END DO
    END IF
!  y flux-divergence into tendency
! (j > j_start) will miss the u(,,jds) tendency
    IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
          mrdy = msfux(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k, &
&            jp1)
          tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, jp1&
&            )
        END DO
      END DO
    ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
! This would be seen by (j > j_start) but we need to zero out the NP tendency
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
          mrdy = msfux(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k, &
&            jp0)
          tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, jp0&
&            )
        END DO
      END DO
    ELSE IF (j .GT. j_start) THEN
! normal code
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
          mrdy = msfux(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, k&
&            , jp1)-fqyd(i, k, jp0))
          tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&            jp1)-fqy(i, k, jp0))
        END DO
      END DO
    END IF
    jtmp = jp1
    jp1 = jp0
    jp0 = jtmp
  END DO j_loop_y_flux_5
!  next, x - flux divergence
  i_start = its
  i_end = ite
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  i_start_f = i_start
  i_end_f = i_end + 1
  IF (degrade_xs) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
    i_start_f = ids + 3
  END IF
  IF (degrade_xe) THEN
    IF (ide - 1 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 1
    END IF
    i_end_f = ide - 2
    fqxd = 0.0
  ELSE
    fqxd = 0.0
  END IF
!  compute fluxes
  DO j=j_start,j_end
!  5th or 6th order flux
    DO k=kts,ktf
      DO i=i_start_f,i_end_f
        veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = ud(i+1, k, j)
          qip2 = u(i+1, k, j)
          qip1d = ud(i, k, j)
          qip1 = u(i, k, j)
          qid = ud(i-1, k, j)
          qi = u(i-1, k, j)
          qim1d = ud(i-2, k, j)
          qim1 = u(i-2, k, j)
          qim2d = ud(i-3, k, j)
          qim2 = u(i-3, k, j)
        ELSE
          qip2d = ud(i-2, k, j)
          qip2 = u(i-2, k, j)
          qip1d = ud(i-1, k, j)
          qip1 = u(i-1, k, j)
          qid = ud(i, k, j)
          qi = u(i, k, j)
          qim1d = ud(i+1, k, j)
          qim1 = u(i+1, k, j)
          qim2d = ud(i+2, k, j)
          qim2 = u(i+2, k, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*f0d+&
&          wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1+wi2&
&          *f2)*sumwkd)/sumwk**2
        fqx(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!          fqx( i,k ) = vel*flux5( u(i-3,k,j), u(i-2,k,j),  &
!                                         u(i-1,k,j), u(i  ,k,j),  &
!                                         u(i+1,k,j), u(i+2,k,j),  &
!                                         vel                     )
!  lower order fluxes close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
    IF (degrade_xs) THEN
      IF (i_start .EQ. ids + 1) THEN
! second order flux next to the boundary
        i = ids + 1
        DO k=kts,ktf
          ubd = ud(i-1, k, j)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ubd = ud(i, k, j)
            ub = u(i, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i, k, j)+&
&            ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i, k, j)+ub)
        END DO
      END IF
      i = ids + 2
      DO k=kts,ktf
        veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        fqxd(i, k) = veld*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&          (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, k&
&          , j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0) + vel*((&
&          7.*(ud(i, k, j)+ud(i-1, k, j))-ud(i+1, k, j)-ud(i-2, k, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i+1, k, j)-ud(i-2, k&
&          , j)-3.*(ud(i, k, j)-ud(i-1, k, j)))/12.0)
        fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u(i&
&          -2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, k, j&
&          )-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0)
      END DO
    END IF
    IF (degrade_xe) THEN
      IF (i_end .EQ. ide - 1) THEN
! second order flux next to the boundary
        i = ide
        DO k=kts,ktf
          ubd = ud(i, k, j)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ubd = ud(i-1, k, j)
            ub = u(i-1, k, j)
          END IF
          fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i-1, k, j))*(u(i-1, k, j)&
&            +ub)+(ru(i, k, j)+ru(i-1, k, j))*(ud(i-1, k, j)+ubd))
          fqx(i, k) = 0.25*(ru(i, k, j)+ru(i-1, k, j))*(u(i-1, k, j)+ub)
        END DO
      END IF
      DO k=kts,ktf
        i = ide - 1
        veld = 0.5*(rud(i, k, j)+rud(i-1, k, j))
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        fqxd(i, k) = veld*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u&
&          (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, k&
&          , j)-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0) + vel*((&
&          7.*(ud(i, k, j)+ud(i-1, k, j))-ud(i+1, k, j)-ud(i-2, k, j))/&
&          12.0+SIGN(1, time_step)*SIGN(1., vel)*(ud(i+1, k, j)-ud(i-2, k&
&          , j)-3.*(ud(i, k, j)-ud(i-1, k, j)))/12.0)
        fqx(i, k) = vel*((7.*(u(i, k, j)+u(i-1, k, j))-(u(i+1, k, j)+u(i&
&          -2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(u(i+1, k, j&
&          )-u(i-2, k, j)-3.*(u(i, k, j)-u(i-1, k, j)))/12.0)
      END DO
    END IF
!  x flux-divergence into tendency
    DO k=kts,ktf
      DO i=i_start,i_end
! ADT eqn 44, 1st term on RHS
        mrdx = msfux(i, j)*rdx
        tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&          fqxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(i&
&          , k))
      END DO
    END DO
  END DO
!  radiative lateral boundary condition in x for normal velocity (u)
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ru(its, k, j) - cb*mut(its, j) .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = rud(its, k, j) - cb*mutd(its, j)
          ub = ru(its, k, j) - cb*mut(its, j)
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(u_old(&
&          its+1, k, j)-u_old(its, k, j))+ub*(u_oldd(its+1, k, j)-u_oldd(&
&          its, k, j)))
        tendency(its, k, j) = tendency(its, k, j) - rdx*ub*(u_old(its+1&
&          , k, j)-u_old(its, k, j))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ru(ite, k, j) + cb*mut(ite-1, j) .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = rud(ite, k, j) + cb*mutd(ite-1, j)
          ub = ru(ite, k, j) + cb*mut(ite-1, j)
        END IF
        tendencyd(ite, k, j) = tendencyd(ite, k, j) - rdx*(ubd*(u_old(&
&          ite, k, j)-u_old(ite-1, k, j))+ub*(u_oldd(ite, k, j)-u_oldd(&
&          ite-1, k, j)))
        tendency(ite, k, j) = tendency(ite, k, j) - rdx*ub*(u_old(ite, k&
&          , j)-u_old(ite-1, k, j))
      END DO
    END DO
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb')
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide) THEN
    i_end = ide
  ELSE
    i_end = ite
  END IF
  imin = ids
  imax = ide - 1
  IF (config_flags%open_xs) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
    imin = ids
  END IF
  IF (config_flags%open_xe) THEN
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    imax = ide - 1
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jts)*rdy
      IF (imax .GT. i) THEN
        ip = i
      ELSE
        ip = imax
      END IF
      IF (imin .LT. i - 1) THEN
        im = i - 1
      ELSE
        im = imin
      END IF
      DO k=kts,ktf
        vwd = 0.5*(rvd(ip, k, jts)+rvd(im, k, jts))
        vw = 0.5*(rv(ip, k, jts)+rv(im, k, jts))
        IF (vw .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        dvmd = rvd(ip, k, jts+1) - rvd(ip, k, jts)
        dvm = rv(ip, k, jts+1) - rv(ip, k, jts)
        dvpd = rvd(im, k, jts+1) - rvd(im, k, jts)
        dvp = rv(im, k, jts+1) - rv(im, k, jts)
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - mrdy*(vbd*(u_old(i&
&          , k, jts+1)-u_old(i, k, jts))+vb*(u_oldd(i, k, jts+1)-u_oldd(i&
&          , k, jts))+0.5*(ud(i, k, jts)*(dvm+dvp)+u(i, k, jts)*(dvmd+&
&          dvpd)))
        tendency(i, k, jts) = tendency(i, k, jts) - mrdy*(vb*(u_old(i, k&
&          , jts+1)-u_old(i, k, jts))+0.5*u(i, k, jts)*(dvm+dvp))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jte-1)*rdy
      IF (imax .GT. i) THEN
        ip = i
      ELSE
        ip = imax
      END IF
      IF (imin .LT. i - 1) THEN
        im = i - 1
      ELSE
        im = imin
      END IF
      DO k=kts,ktf
        vwd = 0.5*(rvd(ip, k, jte)+rvd(im, k, jte))
        vw = 0.5*(rv(ip, k, jte)+rv(im, k, jte))
        IF (vw .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        dvmd = rvd(ip, k, jte) - rvd(ip, k, jte-1)
        dvm = rv(ip, k, jte) - rv(ip, k, jte-1)
        dvpd = rvd(im, k, jte) - rvd(im, k, jte-1)
        dvp = rv(im, k, jte) - rv(im, k, jte-1)
        tendencyd(i, k, jte-1) = tendencyd(i, k, jte-1) - mrdy*(vbd*(&
&          u_old(i, k, jte-1)-u_old(i, k, jte-2))+vb*(u_oldd(i, k, jte-1)&
&          -u_oldd(i, k, jte-2))+0.5*(ud(i, k, jte-1)*(dvm+dvp)+u(i, k, &
&          jte-1)*(dvmd+dvpd)))
        tendency(i, k, jte-1) = tendency(i, k, jte-1) - mrdy*(vb*(u_old(&
&          i, k, jte-1)-u_old(i, k, jte-2))+0.5*u(i, k, jte-1)*(dvm+dvp))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!  ADT eqn 44 has 3rd term on RHS = -(1/my) partial d/dz (rho u w)
!  Here we have:  - partial d/dz (u*rom) = - partial d/dz (u rho w / my)
!  Since 'my' (map scale factor in y-direction) isn't a function of z,
!  this is what we need, so leave unchanged in advect_u
  i_start = its
  i_end = ite
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!   IF ( config_flags%open_xs ) i_start = MAX(ids+1,its)
!   IF ( config_flags%open_xe ) i_end   = MIN(ide-1,ite)
  IF (config_flags%open_ys .OR. specified) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
  END IF
  IF (config_flags%open_ye .OR. specified) THEN
    IF (ide - 1 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 1
    END IF
  END IF
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) i_end = ite
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  vfluxd = 0.0
!   vert_order_test : IF (vert_order == 6) THEN    
!    ELSE IF (vert_order == 5) THEN    
  DO j=j_start,j_end
    DO k=kts+3,ktf-2
      DO i=i_start,i_end
        veld = 0.5*(romd(i-1, k, j)+romd(i, k, j))
        vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = ud(i, k+1, j)
          qip2 = u(i, k+1, j)
          qip1d = ud(i, k, j)
          qip1 = u(i, k, j)
          qid = ud(i, k-1, j)
          qi = u(i, k-1, j)
          qim1d = ud(i, k-2, j)
          qim1 = u(i, k-2, j)
          qim2d = ud(i, k-3, j)
          qim2 = u(i, k-3, j)
        ELSE
          qip2d = ud(i, k-2, j)
          qip2 = u(i, k-2, j)
          qip1d = ud(i, k-1, j)
          qip1 = u(i, k-1, j)
          qid = ud(i, k, j)
          qi = u(i, k, j)
          qim1d = ud(i, k+1, j)
          qim1 = u(i, k+1, j)
          qim2d = ud(i, k+2, j)
          qim2 = u(i, k+2, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        vfluxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        vflux(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!           vflux(i,k) = vel*flux5(                     &
!                   u(i,k-3,j), u(i,k-2,j), u(i,k-1,j),       &
!                   u(i,k  ,j), u(i,k+1,j), u(i,k+2,j),  -vel )
    DO i=i_start,i_end
      k = kts + 1
      vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i, k&
&        , j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*&
&        ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
      vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, j)&
&        +fzp(k)*u(i, k-1, j))
      k = kts + 2
      veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
      vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
      vfluxd(i, k) = veld*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1, &
&        j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0) + vel*((7.*(&
&        ud(i, k, j)+ud(i, k-1, j))-ud(i, k+1, j)-ud(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(ud(i, k+1, j)-ud(i, k-2, j)-&
&        3.*(ud(i, k, j)-ud(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1, j)&
&        -u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0)
      k = ktf - 1
      veld = 0.5*(romd(i, k, j)+romd(i-1, k, j))
      vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
      vfluxd(i, k) = veld*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1, &
&        j)-u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0) + vel*((7.*(&
&        ud(i, k, j)+ud(i, k-1, j))-ud(i, k+1, j)-ud(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(ud(i, k+1, j)-ud(i, k-2, j)-&
&        3.*(ud(i, k, j)-ud(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(u(i, k, j)+u(i, k-1, j))-(u(i, k+1, j)+u(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(u(i, k+1, j)&
&        -u(i, k-2, j)-3.*(u(i, k, j)-u(i, k-1, j)))/12.0)
      k = ktf
      vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i-1, k, j))*(fzm(k)*u(i, k&
&        , j)+fzp(k)*u(i, k-1, j))+(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*&
&        ud(i, k, j)+fzp(k)*ud(i, k-1, j)))
      vflux(i, k) = 0.5*(rom(i, k, j)+rom(i-1, k, j))*(fzm(k)*u(i, k, j)&
&        +fzp(k)*u(i, k-1, j))
    END DO
    DO k=kts,ktf
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) - rdzw(k)*(vfluxd(i, k+1&
&          )-vfluxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - rdzw(k)*(vflux(i, k+1)-&
&          vflux(i, k))
      END DO
    END DO
  END DO
END SUBROUTINE G_ADVECT_WENO_U

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_v in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom tendency v v_old ru rv
!                mut
!   RW status of diff variables: rom:in tendency:in-out v:in v_old:in
!                ru:in rv:in mut:in
SUBROUTINE G_ADVECT_WENO_V(v, vd, v_old, v_oldd, tendency, tendencyd, ru&
&  , rud, rv, rvd, rom, romd, mut, mutd, time_step, config_flags, msfux, &
&  msfuy, msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzw, ids, ide&
&  , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
&  , kts, kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: v, v_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: vd, v_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mutd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzw
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: dir, vv
  REAL :: ue, vs, vn, wb, wt
  REAL, PARAMETER :: f30=7./12., f31=1./12.
  REAL, PARAMETER :: f50=37./60., f51=2./15., f52=1./60.
  INTEGER :: kt, kb
  REAL :: qim2, qim1, qi, qip1, qip2
  REAL :: qim2d, qim1d, qid, qip1d, qip2d
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0d, beta1d, beta2d, f0d, f1d, f2d, wi0d, wi1d&
&  , wi2d, sumwkd
  DOUBLE PRECISION, PARAMETER :: gi0=1.d0/10.d0, gi1=6.d0/10.d0, gi2=&
&    3.d0/10.d0, eps=1.0d-18
  INTEGER, PARAMETER :: pw=2
  REAL :: mrdx, mrdy, ub, vb, uw, vw, dup, dum
  REAL :: ubd, vbd, uwd, dupd, dumd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  INTEGER :: horz_order
  INTEGER :: vert_order
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified
  DOUBLE PRECISION :: pwx1
  DOUBLE PRECISION :: pwx1d
  DOUBLE PRECISION :: pwr1
  DOUBLE PRECISION :: pwr1d
  INTRINSIC MAX
  INTRINSIC SIGN
  INTRINSIC MIN




  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_mom_adv_order
  vert_order = config_flags%v_mom_adv_order
!  here is the choice of flux operators
!   horizontal_order_test : IF( horz_order == 6 ) THEN
!   ELSE IF( horz_order == 5 ) THEN
!  5th order horizontal flux calculation
!  This code is EXACTLY the same as the 6th order code
!  EXCEPT the 5th order and 3rd operators are used in
!  place of the 6th and 4th order operators
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
  degrade_xs = .true.
  degrade_xe = .true.
  degrade_ys = .true.
  degrade_ye = .true.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. its &
&      .GT. ids + 3) degrade_xs = .false.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. ite &
&      .LT. ide - 3) degrade_xe = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. jts &
&      .GT. jds + 3) degrade_ys = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. jte &
&      .LT. jde - 3) degrade_ye = .false.
!--------------- y - advection first
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  j_end = jte
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  j_start_f = j_start
  j_end_f = j_end + 1
  IF (degrade_ys) THEN
    IF (jts .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts
    END IF
    j_start_f = jds + 3
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    j_end_f = jde - 2
  END IF
!  compute fluxes, 5th or 6th order
  jp1 = 2
  jp0 = 1
  fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
          vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            qip2d = vd(i, k, j+1)
            qip2 = v(i, k, j+1)
            qip1d = vd(i, k, j)
            qip1 = v(i, k, j)
            qid = vd(i, k, j-1)
            qi = v(i, k, j-1)
            qim1d = vd(i, k, j-2)
            qim1 = v(i, k, j-2)
            qim2d = vd(i, k, j-3)
            qim2 = v(i, k, j-3)
          ELSE
            qip2d = vd(i, k, j-2)
            qip2 = v(i, k, j-2)
            qip1d = vd(i, k, j-1)
            qip1 = v(i, k, j-1)
            qid = vd(i, k, j)
            qi = v(i, k, j)
            qim1d = vd(i, k, j+1)
            qim1 = v(i, k, j+1)
            qim2d = vd(i, k, j+2)
            qim2 = v(i, k, j+2)
          END IF
          f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*&
&            (qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*&
&            (qim1-qip1)*(qim1d-qip1d)/4.
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*&
&            (qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
          pwx1d = beta0d
          pwx1 = eps + beta0
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi0d = -(gi0*pwr1d/pwr1**2)
          wi0 = gi0/pwr1
          pwx1d = beta1d
          pwx1 = eps + beta1
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi1d = -(gi1*pwr1d/pwr1**2)
          wi1 = gi1/pwr1
          pwx1d = beta2d
          pwx1 = eps + beta2
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi2d = -(gi2*pwr1d/pwr1**2)
          wi2 = gi2/pwr1
          sumwkd = wi0d + wi1d + wi2d
          sumwk = wi0 + wi1 + wi2
          fqyd(i, k, jp1) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+&
&            wi0*f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+&
&            wi1*f1+wi2*f2)*sumwkd)/sumwk**2
          fqy(i, k, jp1) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
        END DO
      END DO
    ELSE IF (j .EQ. jds + 1) THEN
!          fqy( i, k, jp1 ) = vel*flux5(               &
!                  v(i,k,j-3), v(i,k,j-2), v(i,k,j-1),       &
!                  v(i,k,j  ), v(i,k,j+1), v(i,k,j+2),  vel )
!  we must be close to some boundary where we need to reduce the order of the stencil
!  specified uses upstream normal wind at boundaries
! 2nd order flux next to south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          vbd = vd(i, k, j-1)
          vb = v(i, k, j-1)
          IF (specified .AND. v(i, k, j) .LT. 0.) THEN
            vbd = vd(i, k, j)
            vb = v(i, k, j)
          END IF
          fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(v(i, k&
&            , j)+vb)+(rv(i, k, j)+rv(i, k, j-1))*(vd(i, k, j)+vbd))
          fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(v(i, k, j)+&
&            vb)
        END DO
      END DO
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
          vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
          fqyd(i, k, jp1) = veld*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&            , j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))/&
&            12.0) + vel*((7.*(vd(i, k, j)+vd(i, k, j-1))-vd(i, k, j+1)-&
&            vd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(vd(i, &
&            k, j+1)-vd(i, k, j-2)-3.*(vd(i, k, j)-vd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k, j&
&            +1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(&
&            i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))/12.0)
        END DO
      END DO
    ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          vbd = vd(i, k, j)
          vb = v(i, k, j)
          IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
            vbd = vd(i, k, j-1)
            vb = v(i, k, j-1)
          END IF
          fqyd(i, k, jp1) = 0.25*((rvd(i, k, j)+rvd(i, k, j-1))*(vb+v(i&
&            , k, j-1))+(rv(i, k, j)+rv(i, k, j-1))*(vbd+vd(i, k, j-1)))
          fqy(i, k, jp1) = 0.25*(rv(i, k, j)+rv(i, k, j-1))*(vb+v(i, k, &
&            j-1))
        END DO
      END DO
    ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts,ktf
        DO i=i_start,i_end
          veld = 0.5*(rvd(i, k, j)+rvd(i, k, j-1))
          vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
          fqyd(i, k, jp1) = veld*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k&
&            , j+1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (v(i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))/&
&            12.0) + vel*((7.*(vd(i, k, j)+vd(i, k, j-1))-vd(i, k, j+1)-&
&            vd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(vd(i, &
&            k, j+1)-vd(i, k, j-2)-3.*(vd(i, k, j)-vd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(v(i, k, j)+v(i, k, j-1))-(v(i, k, j&
&            +1)+v(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(&
&            i, k, j+1)-v(i, k, j-2)-3.*(v(i, k, j)-v(i, k, j-1)))/12.0)
        END DO
      END DO
    END IF
!  y flux-divergence into tendency
! Comments on polar boundary conditions
! No advection over the poles means tendencies (held from jds [S. pole]
! to jde [N pole], i.e., on v grid) must be zero at poles
! [tendency(jds) and tendency(jde)=0]
    IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j-1) = 0.0
          tendency(i, k, j-1) = 0.
        END DO
      END DO
    ELSE IF (config_flags%polar .AND. j .EQ. jde + 1) THEN
! If j_end were set to jde in a special if statement apart from
! degrade_ye, then we would hit the next conditional.  But since
! we want the tendency to be zero anyway, not looping to jde+1
! will produce the same effect.
      DO k=kts,ktf
        DO i=i_start,i_end
          tendencyd(i, k, j-1) = 0.0
          tendency(i, k, j-1) = 0.
        END DO
      END DO
    ELSE IF (j .GT. j_start) THEN
! Normal code
      DO k=kts,ktf
        DO i=i_start,i_end
! ADT eqn 45, 2nd term on RHS
          mrdy = msfvy(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, k&
&            , jp1)-fqyd(i, k, jp0))
          tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&            jp1)-fqy(i, k, jp0))
        END DO
      END DO
    END IF
    jtmp = jp1
    jp1 = jp0
    jp0 = jtmp
  END DO j_loop_y_flux_5
!  next, x - flux divergence
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  j_end = jte
! Polar boundary conditions are like open or specified
  IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
  END IF
  IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jde - 1 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1
    END IF
  END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  i_start_f = i_start
  i_end_f = i_end + 1
  IF (degrade_xs) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
    IF (i_start + 2 .GT. ids + 3) THEN
      i_start_f = ids + 3
    ELSE
      i_start_f = i_start + 2
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ide - 2 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 2
    END IF
    i_end_f = ide - 3
    fqxd = 0.0
  ELSE
    fqxd = 0.0
  END IF
!  compute fluxes
  DO j=j_start,j_end
!  5th or 6th order flux
    DO k=kts,ktf
      DO i=i_start_f,i_end_f
        veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
        vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = vd(i+1, k, j)
          qip2 = v(i+1, k, j)
          qip1d = vd(i, k, j)
          qip1 = v(i, k, j)
          qid = vd(i-1, k, j)
          qi = v(i-1, k, j)
          qim1d = vd(i-2, k, j)
          qim1 = v(i-2, k, j)
          qim2d = vd(i-3, k, j)
          qim2 = v(i-3, k, j)
        ELSE
          qip2d = vd(i-2, k, j)
          qip2 = v(i-2, k, j)
          qip1d = vd(i-1, k, j)
          qip1 = v(i-1, k, j)
          qid = vd(i, k, j)
          qi = v(i, k, j)
          qim1d = vd(i+1, k, j)
          qim1 = v(i+1, k, j)
          qim2d = vd(i+2, k, j)
          qim2 = v(i+2, k, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*f0d+&
&          wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1+wi2&
&          *f2)*sumwkd)/sumwk**2
        fqx(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!          fqx( i, k ) = vel*flux5( v(i-3,k,j), v(i-2,k,j),  &
!                                         v(i-1,k,j), v(i  ,k,j),  &
!                                         v(i+1,k,j), v(i+2,k,j),  &
!                                         vel                     )
!  lower order fluxes close to boundaries (if not periodic or symmetric)
    IF (degrade_xs) THEN
      DO i=i_start,i_start_f-1
        IF (i .EQ. ids + 1) THEN
! second order
          DO k=kts,ktf
            fqxd(i, k) = 0.25*((rud(i, k, j)+rud(i, k, j-1))*(v(i, k, j)&
&              +v(i-1, k, j))+(ru(i, k, j)+ru(i, k, j-1))*(vd(i, k, j)+vd&
&              (i-1, k, j)))
            fqx(i, k) = 0.25*(ru(i, k, j)+ru(i, k, j-1))*(v(i, k, j)+v(i&
&              -1, k, j))
          END DO
        END IF
        IF (i .EQ. ids + 2) THEN
! third order
          DO k=kts,ktf
            veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            fqxd(i, k) = veld*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&              j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v&
&              (i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/&
&              12.0) + vel*((7.*(vd(i, k, j)+vd(i-1, k, j))-vd(i+1, k, j)&
&              -vd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(vd(&
&              i+1, k, j)-vd(i-2, k, j)-3.*(vd(i, k, j)-vd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)&
&              +v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(i&
&              +1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/12.0)
          END DO
        END IF
      END DO
    END IF
    IF (degrade_xe) THEN
      DO i=i_end_f+1,i_end+1
        IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
          DO k=kts,ktf
            fqxd(i, k) = 0.25*((rud(i_end+1, k, j)+rud(i_end+1, k, j-1))&
&              *(v(i_end+1, k, j)+v(i_end, k, j))+(ru(i_end+1, k, j)+ru(&
&              i_end+1, k, j-1))*(vd(i_end+1, k, j)+vd(i_end, k, j)))
            fqx(i, k) = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*(v(&
&              i_end+1, k, j)+v(i_end, k, j))
          END DO
        END IF
        IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
          DO k=kts,ktf
            veld = 0.5*(rud(i, k, j)+rud(i, k, j-1))
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            fqxd(i, k) = veld*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, &
&              j)+v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v&
&              (i+1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/&
&              12.0) + vel*((7.*(vd(i, k, j)+vd(i-1, k, j))-vd(i+1, k, j)&
&              -vd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(vd(&
&              i+1, k, j)-vd(i-2, k, j)-3.*(vd(i, k, j)-vd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(v(i, k, j)+v(i-1, k, j))-(v(i+1, k, j)&
&              +v(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(v(i&
&              +1, k, j)-v(i-2, k, j)-3.*(v(i, k, j)-v(i-1, k, j)))/12.0)
          END DO
        END IF
      END DO
    END IF
!  x flux-divergence into tendency
    DO k=kts,ktf
      DO i=i_start,i_end
! ADT eqn 45, 1st term on RHS
        mrdx = msfvy(i, j)*rdx
        tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&          fqxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(i&
&          , k))
      END DO
    END DO
  END DO
!  Comments on polar boundary condition
!  Force tendency=0 at NP and SP
!  We keep setting this everywhere, but it can't hurt...
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
    DO i=its,ite
      DO k=kts,ktf
        tendencyd(i, k, jts) = 0.0
        tendency(i, k, jts) = 0.
      END DO
    END DO
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    DO i=its,ite
      DO k=kts,ktf
        tendencyd(i, k, jte) = 0.0
        tendency(i, k, jte) = 0.
      END DO
    END DO
  END IF
!  radiative lateral boundary condition in y for normal velocity (v)
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (rv(i, k, jts) - cb*mut(i, jts) .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = rvd(i, k, jts) - cb*mutd(i, jts)
          vb = rv(i, k, jts) - cb*mut(i, jts)
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(v_old(i&
&          , k, jts+1)-v_old(i, k, jts))+vb*(v_oldd(i, k, jts+1)-v_oldd(i&
&          , k, jts)))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*vb*(v_old(i, k, &
&          jts+1)-v_old(i, k, jts))
      END DO
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      i_end = ide - 1
    ELSE
      i_end = ite
    END IF
    DO i=i_start,i_end
      DO k=kts,ktf
        IF (rv(i, k, jte) + cb*mut(i, jte-1) .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = rvd(i, k, jte) + cb*mutd(i, jte-1)
          vb = rv(i, k, jte) + cb*mut(i, jte-1)
        END IF
        tendencyd(i, k, jte) = tendencyd(i, k, jte) - rdy*(vbd*(v_old(i&
&          , k, jte)-v_old(i, k, jte-1))+vb*(v_oldd(i, k, jte)-v_oldd(i, &
&          k, jte-1)))
        tendency(i, k, jte) = tendency(i, k, jte) - rdy*vb*(v_old(i, k, &
&          jte)-v_old(i, k, jte-1))
      END DO
    END DO
  END IF
!  pick up the rest of the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  j_start = jts
  IF (jte .GT. jde) THEN
    j_end = jde
  ELSE
    j_end = jte
  END IF
  jmin = jds
  jmax = jde - 1
  IF (config_flags%open_ys) THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
    jmin = jds
  END IF
  IF (config_flags%open_ye) THEN
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    jmax = jde - 1
  END IF
!  compute x (u) conditions for v, w, or scalar
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(its, j)*rdx
      IF (jmax .GT. j) THEN
        jp = j
      ELSE
        jp = jmax
      END IF
      IF (jmin .LT. j - 1) THEN
        jm = j - 1
      ELSE
        jm = jmin
      END IF
      DO k=kts,ktf
        uwd = 0.5*(rud(its, k, jp)+rud(its, k, jm))
        uw = 0.5*(ru(its, k, jp)+ru(its, k, jm))
        IF (uw .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        dupd = rud(its+1, k, jp) - rud(its, k, jp)
        dup = ru(its+1, k, jp) - ru(its, k, jp)
        dumd = rud(its+1, k, jm) - rud(its, k, jm)
        dum = ru(its+1, k, jm) - ru(its, k, jm)
        tendencyd(its, k, j) = tendencyd(its, k, j) - mrdx*(ubd*(v_old(&
&          its+1, k, j)-v_old(its, k, j))+ub*(v_oldd(its+1, k, j)-v_oldd(&
&          its, k, j))+0.5*(vd(its, k, j)*(dup+dum)+v(its, k, j)*(dupd+&
&          dumd)))
        tendency(its, k, j) = tendency(its, k, j) - mrdx*(ub*(v_old(its+&
&          1, k, j)-v_old(its, k, j))+0.5*v(its, k, j)*(dup+dum))
      END DO
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(ite-1, j)*rdx
      IF (jmax .GT. j) THEN
        jp = j
      ELSE
        jp = jmax
      END IF
      IF (jmin .LT. j - 1) THEN
        jm = j - 1
      ELSE
        jm = jmin
      END IF
      DO k=kts,ktf
        uwd = 0.5*(rud(ite, k, jp)+rud(ite, k, jm))
        uw = 0.5*(ru(ite, k, jp)+ru(ite, k, jm))
        IF (uw .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        dupd = rud(ite, k, jp) - rud(ite-1, k, jp)
        dup = ru(ite, k, jp) - ru(ite-1, k, jp)
        dumd = rud(ite, k, jm) - rud(ite-1, k, jm)
        dum = ru(ite, k, jm) - ru(ite-1, k, jm)
!          tendency(ite-1,k,j)=tendency(ite-1,k,j)-mrdx*(              &
!                            ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))    &
!                           +0.5*v(ite-1,k,j)*                         &
!                                  ( ru(ite,k,jp)-ru(ite-1,k,jp)       &
!                                   +ru(ite,k,jm)-ru(ite-1,k,jm))     )
        tendencyd(ite-1, k, j) = tendencyd(ite-1, k, j) - mrdx*(ubd*(&
&          v_old(ite-1, k, j)-v_old(ite-2, k, j))+ub*(v_oldd(ite-1, k, j)&
&          -v_oldd(ite-2, k, j))+0.5*(vd(ite-1, k, j)*(dup+dum)+v(ite-1, &
&          k, j)*(dupd+dumd)))
        tendency(ite-1, k, j) = tendency(ite-1, k, j) - mrdx*(ub*(v_old(&
&          ite-1, k, j)-v_old(ite-2, k, j))+0.5*v(ite-1, k, j)*(dup+dum))
      END DO
    END DO
  END IF
!-------------------- vertical advection
!     ADT eqn 45 has 3rd term on RHS = -(1/mx) partial d/dz (rho v w)
!     Here we have: - partial d/dz (v*rom) = - partial d/dz (v rho w / my)
!     We therefore need to make a correction for advect_v
!     since 'my' (map scale factor in y direction) isn't a function of z,
!     we can do this using *(my/mx) (see eqn. 45 for example)
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  j_end = jte
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
! Polar boundary conditions are like open or specified
! We don't want to calculate vertical v tendencies at the N or S pole
  IF ((config_flags%open_ys .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jds + 1 .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + 1
    END IF
  END IF
  IF ((config_flags%open_ye .OR. specified) .OR. config_flags%polar) &
&  THEN
    IF (jde - 1 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1
    END IF
    vfluxd = 0.0
  ELSE
    vfluxd = 0.0
  END IF
!    vert_order_test : IF (vert_order == 6) THEN    
!   ELSE IF (vert_order == 5) THEN    
  DO j=j_start,j_end
    DO k=kts+3,ktf-2
      DO i=i_start,i_end
        veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = vd(i, k+1, j)
          qip2 = v(i, k+1, j)
          qip1d = vd(i, k, j)
          qip1 = v(i, k, j)
          qid = vd(i, k-1, j)
          qi = v(i, k-1, j)
          qim1d = vd(i, k-2, j)
          qim1 = v(i, k-2, j)
          qim2d = vd(i, k-3, j)
          qim2 = v(i, k-3, j)
        ELSE
          qip2d = vd(i, k-2, j)
          qip2 = v(i, k-2, j)
          qip1d = vd(i, k-1, j)
          qip1 = v(i, k-1, j)
          qid = vd(i, k, j)
          qi = v(i, k, j)
          qim1d = vd(i, k+1, j)
          qim1 = v(i, k+1, j)
          qim2d = vd(i, k+2, j)
          qim2 = v(i, k+2, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        vfluxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        vflux(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!           vflux(i,k) = vel*flux5(                       &
!                   v(i,k-3,j), v(i,k-2,j), v(i,k-1,j),       &
!                   v(i,k  ,j), v(i,k+1,j), v(i,k+2,j),  -vel )
    DO i=i_start,i_end
      k = kts + 1
      vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i, k&
&        , j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*&
&        vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
      vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, j)&
&        +fzp(k)*v(i, k-1, j))
      k = kts + 2
      veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
      vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
      vfluxd(i, k) = veld*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1, &
&        j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0) + vel*((7.*(&
&        vd(i, k, j)+vd(i, k-1, j))-vd(i, k+1, j)-vd(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(vd(i, k+1, j)-vd(i, k-2, j)-&
&        3.*(vd(i, k, j)-vd(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1, j)&
&        -v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0)
      k = ktf - 1
      veld = 0.5*(romd(i, k, j)+romd(i, k, j-1))
      vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
      vfluxd(i, k) = veld*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1, &
&        j)-v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0) + vel*((7.*(&
&        vd(i, k, j)+vd(i, k-1, j))-vd(i, k+1, j)-vd(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(vd(i, k+1, j)-vd(i, k-2, j)-&
&        3.*(vd(i, k, j)-vd(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(v(i, k, j)+v(i, k-1, j))-(v(i, k+1, j)+v(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(v(i, k+1, j)&
&        -v(i, k-2, j)-3.*(v(i, k, j)-v(i, k-1, j)))/12.0)
      k = ktf
      vfluxd(i, k) = 0.5*((romd(i, k, j)+romd(i, k, j-1))*(fzm(k)*v(i, k&
&        , j)+fzp(k)*v(i, k-1, j))+(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*&
&        vd(i, k, j)+fzp(k)*vd(i, k-1, j)))
      vflux(i, k) = 0.5*(rom(i, k, j)+rom(i, k, j-1))*(fzm(k)*v(i, k, j)&
&        +fzp(k)*v(i, k-1, j))
    END DO
    DO k=kts,ktf
      DO i=i_start,i_end
! We are calculating vertical fluxes on v points,
! so we must mean msf_v_x/y variables
! ADT eqn 45, 3rd term on RHS
        tendencyd(i, k, j) = tendencyd(i, k, j) - msfvy(i, j)*rdzw(k)*(&
&          vfluxd(i, k+1)-vfluxd(i, k))/msfvx(i, j)
        tendency(i, k, j) = tendency(i, k, j) - msfvy(i, j)/msfvx(i, j)*&
&          rdzw(k)*(vflux(i, k+1)-vflux(i, k))
      END DO
    END DO
  END DO
END SUBROUTINE G_ADVECT_WENO_V

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_w in forward (tangent) mode:
!   variations   of useful results: tendency
!   with respect to varying inputs: rom tendency w ru rv w_old
!   RW status of diff variables: rom:in tendency:in-out w:in ru:in
!                rv:in w_old:in
SUBROUTINE G_ADVECT_WENO_W(w, wd, w_old, w_oldd, tendency, tendencyd, ru&
&  , rud, rv, rvd, rom, romd, mut, time_step, config_flags, msfux, msfuy&
&  , msfvx, msfvy, msftx, msfty, fzm, fzp, rdx, rdy, rdzu, ids, ide, jds&
&  , jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
&  , kte)
  IMPLICIT NONE
! Input data
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: w, w_old, ru&
&  , rv, rom
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: wd, w_oldd, &
&  rud, rvd, romd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyd
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp, rdzu
  REAL, INTENT(IN) :: rdx, rdy
  INTEGER, INTENT(IN) :: time_step
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
  INTEGER :: jmin, jmax, jp, jm, imin, imax
  REAL :: mrdx, mrdy, ub, vb, uw, vw
  REAL :: ubd, vbd, uwd, vwd
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxd
  REAL :: dir, vv
  REAL :: ue, vs, vn, wb, wt
  REAL, PARAMETER :: f30=7./12., f31=1./12.
  REAL, PARAMETER :: f50=37./60., f51=2./15., f52=1./60.
  INTEGER :: kt, kb
  REAL :: qim2, qim1, qi, qip1, qip2
  REAL :: qim2d, qim1d, qid, qip1d, qip2d
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0d, beta1d, beta2d, f0d, f1d, f2d, wi0d, wi1d&
&  , wi2d, sumwkd
  DOUBLE PRECISION, PARAMETER :: gi0=1.d0/10.d0, gi1=6.d0/10.d0, gi2=&
&    3.d0/10.d0, eps=1.0d-18
  INTEGER, PARAMETER :: pw=2
  INTEGER :: horz_order, vert_order
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxd
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyd
  LOGICAL :: degrade_xs, degrade_ys
  LOGICAL :: degrade_xe, degrade_ye
  INTEGER :: jp1, jp0, jtmp
! definition of flux operators, 3rd, 4th, 5th or 6th order
  REAL :: flux3, flux4, flux5, flux6
  REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
  REAL :: veld
  LOGICAL :: specified
  DOUBLE PRECISION :: pwx1
  DOUBLE PRECISION :: pwx1d
  DOUBLE PRECISION :: pwr1
  DOUBLE PRECISION :: pwr1d
  INTRINSIC MAX
  INTRINSIC SIGN
  INTRINSIC MIN




  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  horz_order = config_flags%h_sca_adv_order
  vert_order = config_flags%v_sca_adv_order
!  here is the choice of flux operators
!  begin with horizontal flux divergence
!  horizontal_order_test : IF( horz_order == 6 ) THEN
! ELSE IF (horz_order == 5 ) THEN
!  determine boundary mods for flux operators
!  We degrade the flux operators from 3rd/4th order
!   to second order one gridpoint in from the boundaries for
!   all boundary conditions except periodic and symmetry - these
!   conditions have boundary zone data fill for correct application
!   of the higher order flux stencils
  degrade_xs = .true.
  degrade_xe = .true.
  degrade_ys = .true.
  degrade_ye = .true.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xs) .OR. its &
&      .GT. ids + 3) degrade_xs = .false.
  IF ((config_flags%periodic_x .OR. config_flags%symmetric_xe) .OR. ite &
&      .LT. ide - 3) degrade_xe = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ys) .OR. jts &
&      .GT. jds + 3) degrade_ys = .false.
  IF ((config_flags%periodic_y .OR. config_flags%symmetric_ye) .OR. jte &
&      .LT. jde - 4) degrade_ye = .false.
!--------------- y - advection first
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  j_start_f = j_start
  j_end_f = j_end + 1
  IF (degrade_ys) THEN
    IF (jts .LT. jds + 1) THEN
      j_start = jds + 1
    ELSE
      j_start = jts
    END IF
    j_start_f = jds + 3
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 2) THEN
      j_end = jde - 2
    ELSE
      j_end = jte
    END IF
    j_end_f = jde - 3
  END IF
  IF (config_flags%polar) THEN
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
  END IF
!  compute fluxes, 5th or 6th order
  jp1 = 2
  jp0 = 1
  fqyd = 0.0
j_loop_y_flux_5:DO j=j_start,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
      DO k=kts+1,ktf
        DO i=i_start,i_end
          veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
          vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            qip2d = wd(i, k, j+1)
            qip2 = w(i, k, j+1)
            qip1d = wd(i, k, j)
            qip1 = w(i, k, j)
            qid = wd(i, k, j-1)
            qi = w(i, k, j-1)
            qim1d = wd(i, k, j-2)
            qim1 = w(i, k, j-2)
            qim2d = wd(i, k, j-3)
            qim2 = w(i, k, j-3)
          ELSE
            qip2d = wd(i, k, j-2)
            qip2 = w(i, k, j-2)
            qip1d = wd(i, k, j-1)
            qip1 = w(i, k, j-1)
            qid = wd(i, k, j)
            qi = w(i, k, j)
            qim1d = wd(i, k, j+1)
            qim1 = w(i, k, j+1)
            qim2d = wd(i, k, j+2)
            qim2 = w(i, k, j+2)
          END IF
          f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*&
&            (qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*&
&            (qim1-qip1)*(qim1d-qip1d)/4.
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*&
&            (qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
          pwx1d = beta0d
          pwx1 = eps + beta0
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi0d = -(gi0*pwr1d/pwr1**2)
          wi0 = gi0/pwr1
          pwx1d = beta1d
          pwx1 = eps + beta1
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi1d = -(gi1*pwr1d/pwr1**2)
          wi1 = gi1/pwr1
          pwx1d = beta2d
          pwx1 = eps + beta2
          IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&          THEN
            pwr1d = pw*pwx1**(pw-1)*pwx1d
          ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
            pwr1d = pwx1d
          ELSE
            pwr1d = 0.0
          END IF
          pwr1 = pwx1**pw
          wi2d = -(gi2*pwr1d/pwr1**2)
          wi2 = gi2/pwr1
          sumwkd = wi0d + wi1d + wi2d
          sumwk = wi0 + wi1 + wi2
          fqyd(i, k, jp1) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+&
&            wi0*f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+&
&            wi1*f1+wi2*f2)*sumwkd)/sumwk**2
          fqy(i, k, jp1) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
        END DO
      END DO
!          fqy( i, k, jp1 ) = vel*flux5(                     &
!                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
!                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
      k = ktf + 1
      DO i=i_start,i_end
        veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
        vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = wd(i, k, j+1)
          qip2 = w(i, k, j+1)
          qip1d = wd(i, k, j)
          qip1 = w(i, k, j)
          qid = wd(i, k, j-1)
          qi = w(i, k, j-1)
          qim1d = wd(i, k, j-2)
          qim1 = w(i, k, j-2)
          qim2d = wd(i, k, j-3)
          qim2 = w(i, k, j-3)
        ELSE
          qip2d = wd(i, k, j-2)
          qip2 = w(i, k, j-2)
          qip1d = wd(i, k, j-1)
          qip1 = w(i, k, j-1)
          qid = wd(i, k, j)
          qi = w(i, k, j)
          qim1d = wd(i, k, j+1)
          qim1 = w(i, k, j+1)
          qim2d = wd(i, k, j+2)
          qim2 = w(i, k, j+2)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqyd(i, k, jp1) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0&
&          *f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*&
&          f1+wi2*f2)*sumwkd)/sumwk**2
        fqy(i, k, jp1) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    ELSE IF (j .EQ. jds + 1) THEN
!          fqy( i, k, jp1 ) = vel*flux5(                     &
!                  w(i,k,j-3), w(i,k,j-2), w(i,k,j-1),       &
!                  w(i,k,j  ), w(i,k,j+1), w(i,k,j+2),  vel )
! 2nd order flux next to south boundary
      DO k=kts+1,ktf
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-1&
&            , j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k)*&
&            rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
          fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))&
&            *(w(i, k, j)+w(i, k, j-1))
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
        fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&          rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(i&
&          , k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1)))
        fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i&
&          , k-2, j))*(w(i, k, j)+w(i, k, j-1))
      END DO
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts+1,ktf
        DO i=i_start,i_end
          veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
          vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
          fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&            , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/&
&            12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-&
&            wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, &
&            k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(&
&            i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
        veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
        vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&          +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&          , k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0) + &
&          vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-wd(i, k, j-&
&          2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, k, j+1)-wd(i&
&          , k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
        fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j+1&
&          )+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i, k&
&          , j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
      END DO
    ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
      DO k=kts+1,ktf
        DO i=i_start,i_end
          fqyd(i, k, jp1) = 0.5*((fzm(k)*rvd(i, k, j)+fzp(k)*rvd(i, k-1&
&            , j))*(w(i, k, j)+w(i, k, j-1))+(fzm(k)*rv(i, k, j)+fzp(k)*&
&            rv(i, k-1, j))*(wd(i, k, j)+wd(i, k, j-1)))
          fqy(i, k, jp1) = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))&
&            *(w(i, k, j)+w(i, k, j-1))
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
        fqyd(i, k, jp1) = 0.5*(((2.-fzm(k-1))*rvd(i, k-1, j)-fzp(k-1)*&
&          rvd(i, k-2, j))*(w(i, k, j)+w(i, k, j-1))+((2.-fzm(k-1))*rv(i&
&          , k-1, j)-fzp(k-1)*rv(i, k-2, j))*(wd(i, k, j)+wd(i, k, j-1)))
        fqy(i, k, jp1) = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i&
&          , k-2, j))*(w(i, k, j)+w(i, k, j-1))
      END DO
    ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts+1,ktf
        DO i=i_start,i_end
          veld = fzm(k)*rvd(i, k, j) + fzp(k)*rvd(i, k-1, j)
          vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
          fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k&
&            , j+1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*&
&            (w(i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/&
&            12.0) + vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-&
&            wd(i, k, j-2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, &
&            k, j+1)-wd(i, k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
          fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&            +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(&
&            i, k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start,i_end
        veld = (2.-fzm(k-1))*rvd(i, k-1, j) - fzp(k-1)*rvd(i, k-2, j)
        vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        fqyd(i, k, jp1) = veld*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j&
&          +1)+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&          , k, j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0) + &
&          vel*((7.*(wd(i, k, j)+wd(i, k, j-1))-wd(i, k, j+1)-wd(i, k, j-&
&          2))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i, k, j+1)-wd(i&
&          , k, j-2)-3.*(wd(i, k, j)-wd(i, k, j-1)))/12.0)
        fqy(i, k, jp1) = vel*((7.*(w(i, k, j)+w(i, k, j-1))-(w(i, k, j+1&
&          )+w(i, k, j-2)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i, k&
&          , j+1)-w(i, k, j-2)-3.*(w(i, k, j)-w(i, k, j-1)))/12.0)
      END DO
    END IF
!  y flux-divergence into tendency
! Comments for polar boundary conditions
! Same process as for advect_u - tendencies run from jds to jde-1 
! (latitudes are as for u grid, longitudes are displaced)
! Therefore: flow is only from one side for points next to poles
    IF (config_flags%polar .AND. j .EQ. jds + 1) THEN
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*fqyd(i, k, &
&            jp1)
          tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*fqy(i, k, jp1&
&            )
        END DO
      END DO
    ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
      DO k=kts,ktf
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) + mrdy*fqyd(i, k, &
&            jp0)
          tendency(i, k, j-1) = tendency(i, k, j-1) + mrdy*fqy(i, k, jp0&
&            )
        END DO
      END DO
    ELSE IF (j .GT. j_start) THEN
! normal code
      DO k=kts+1,ktf+1
        DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 2nd term RHS
          mrdy = msftx(i, j-1)*rdy
          tendencyd(i, k, j-1) = tendencyd(i, k, j-1) - mrdy*(fqyd(i, k&
&            , jp1)-fqyd(i, k, jp0))
          tendency(i, k, j-1) = tendency(i, k, j-1) - mrdy*(fqy(i, k, &
&            jp1)-fqy(i, k, jp0))
        END DO
      END DO
    END IF
    jtmp = jp1
    jp1 = jp0
    jp0 = jtmp
  END DO j_loop_y_flux_5
!  next, x - flux divergence
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
!  higher order flux has a 5 or 7 point stencil, so compute
!  bounds so we can switch to second order flux close to the boundary
  i_start_f = i_start
  i_end_f = i_end + 1
  IF (degrade_xs) THEN
    IF (ids + 1 .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + 1
    END IF
    IF (i_start + 2 .GT. ids + 3) THEN
      i_start_f = ids + 3
    ELSE
      i_start_f = i_start + 2
    END IF
  END IF
  IF (degrade_xe) THEN
    IF (ide - 2 .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 2
    END IF
    i_end_f = ide - 3
    fqxd = 0.0
  ELSE
    fqxd = 0.0
  END IF
!  compute fluxes
  DO j=j_start,j_end
!  5th or 6th order flux
    DO k=kts+1,ktf
      DO i=i_start_f,i_end_f
        veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
        vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = wd(i+1, k, j)
          qip2 = w(i+1, k, j)
          qip1d = wd(i, k, j)
          qip1 = w(i, k, j)
          qid = wd(i-1, k, j)
          qi = w(i-1, k, j)
          qim1d = wd(i-2, k, j)
          qim1 = w(i-2, k, j)
          qim2d = wd(i-3, k, j)
          qim2 = w(i-3, k, j)
        ELSE
          qip2d = wd(i-2, k, j)
          qip2 = w(i-2, k, j)
          qip1d = wd(i-1, k, j)
          qip1 = w(i-1, k, j)
          qid = wd(i, k, j)
          qi = w(i, k, j)
          qim1d = wd(i+1, k, j)
          qim1 = w(i+1, k, j)
          qim2d = wd(i+2, k, j)
          qim2 = w(i+2, k, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        fqxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*f0d+&
&          wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1+wi2&
&          *f2)*sumwkd)/sumwk**2
        fqx(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
!                                  w(i-1,k,j), w(i  ,k,j),  &
!                                  w(i+1,k,j), w(i+2,k,j),  &
!                                  vel                     )
    k = ktf + 1
    DO i=i_start_f,i_end_f
      veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
      vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
      IF (vel*sign(1,time_step) .GE. 0.0) THEN
        qip2d = wd(i+1, k, j)
        qip2 = w(i+1, k, j)
        qip1d = wd(i, k, j)
        qip1 = w(i, k, j)
        qid = wd(i-1, k, j)
        qi = w(i-1, k, j)
        qim1d = wd(i-2, k, j)
        qim1 = w(i-2, k, j)
        qim2d = wd(i-3, k, j)
        qim2 = w(i-3, k, j)
      ELSE
        qip2d = wd(i-2, k, j)
        qip2 = w(i-2, k, j)
        qip1d = wd(i-1, k, j)
        qip1 = w(i-1, k, j)
        qid = wd(i, k, j)
        qi = w(i, k, j)
        qim1d = wd(i+1, k, j)
        qim1 = w(i+1, k, j)
        qim2d = wd(i+2, k, j)
        qim2 = w(i+2, k, j)
      END IF
      f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
      f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
      f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
      f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
      f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
      f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
      beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&        qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
      beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi)&
&        **2
      beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&        qim1-qip1)*(qim1d-qip1d)/4.
      beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
      beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&        qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
      beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi)&
&        **2
      pwx1d = beta0d
      pwx1 = eps + beta0
      IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) THEN
        pwr1d = pw*pwx1**(pw-1)*pwx1d
      ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
        pwr1d = pwx1d
      ELSE
        pwr1d = 0.0
      END IF
      pwr1 = pwx1**pw
      wi0d = -(gi0*pwr1d/pwr1**2)
      wi0 = gi0/pwr1
      pwx1d = beta1d
      pwx1 = eps + beta1
      IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) THEN
        pwr1d = pw*pwx1**(pw-1)*pwx1d
      ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
        pwr1d = pwx1d
      ELSE
        pwr1d = 0.0
      END IF
      pwr1 = pwx1**pw
      wi1d = -(gi1*pwr1d/pwr1**2)
      wi1 = gi1/pwr1
      pwx1d = beta2d
      pwx1 = eps + beta2
      IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) THEN
        pwr1d = pw*pwx1**(pw-1)*pwx1d
      ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
        pwr1d = pwx1d
      ELSE
        pwr1d = 0.0
      END IF
      pwr1 = pwx1**pw
      wi2d = -(gi2*pwr1d/pwr1**2)
      wi2 = gi2/pwr1
      sumwkd = wi0d + wi1d + wi2d
      sumwk = wi0 + wi1 + wi2
      fqxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*f0d+&
&        wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1+wi2*&
&        f2)*sumwkd)/sumwk**2
      fqx(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
    END DO
!          fqx( i,k ) = vel*flux5( w(i-3,k,j), w(i-2,k,j),  &
!                                  w(i-1,k,j), w(i  ,k,j),  &
!                                  w(i+1,k,j), w(i+2,k,j),  &
!                                  vel                     )
!  lower order fluxes close to boundaries (if not periodic or symmetric)
    IF (degrade_xs) THEN
      DO i=i_start,i_start_f-1
        IF (i .EQ. ids + 1) THEN
! second order
          DO k=kts+1,ktf
            fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, j)&
&              )*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)*ru(&
&              i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
            fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*(w&
&              (i, k, j)+w(i-1, k, j))
          END DO
          k = ktf + 1
          fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud(i&
&            , k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i, k-&
&            1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, j)))
          fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-&
&            2, j))*(w(i, k, j)+w(i-1, k, j))
        END IF
        IF (i .EQ. ids + 2) THEN
! third order
          DO k=kts+1,ktf
            veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&              j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w&
&              (i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/&
&              12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)&
&              -wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(&
&              i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&              +1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
          END DO
          k = ktf + 1
          veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
          vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
          fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&            +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1&
&            , k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0) + &
&            vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)-wd(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i+1, k, j)-&
&            wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1, &
&            k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
        END IF
      END DO
    END IF
    IF (degrade_xe) THEN
      DO i=i_end_f+1,i_end+1
        IF (i .EQ. ide - 1) THEN
! second order flux next to the boundary
          DO k=kts+1,ktf
            fqxd(i, k) = 0.5*((fzm(k)*rud(i, k, j)+fzp(k)*rud(i, k-1, j)&
&              )*(w(i, k, j)+w(i-1, k, j))+(fzm(k)*ru(i, k, j)+fzp(k)*ru(&
&              i, k-1, j))*(wd(i, k, j)+wd(i-1, k, j)))
            fqx(i, k) = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*(w&
&              (i, k, j)+w(i-1, k, j))
          END DO
          k = ktf + 1
          fqxd(i, k) = 0.5*(((2.-fzm(k-1))*rud(i, k-1, j)-fzp(k-1)*rud(i&
&            , k-2, j))*(w(i, k, j)+w(i-1, k, j))+((2.-fzm(k-1))*ru(i, k-&
&            1, j)-fzp(k-1)*ru(i, k-2, j))*(wd(i, k, j)+wd(i-1, k, j)))
          fqx(i, k) = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-&
&            2, j))*(w(i, k, j)+w(i-1, k, j))
        END IF
        IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
          DO k=kts+1,ktf
            veld = fzm(k)*rud(i, k, j) + fzp(k)*rud(i, k-1, j)
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, &
&              j)+w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w&
&              (i+1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/&
&              12.0) + vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)&
&              -wd(i-2, k, j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(&
&              i+1, k, j)-wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/&
&              12.0)
            fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&              +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i&
&              +1, k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
          END DO
          k = ktf + 1
          veld = (2.-fzm(k-1))*rud(i, k-1, j) - fzp(k-1)*rud(i, k-2, j)
          vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
          fqxd(i, k) = veld*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)&
&            +w(i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1&
&            , k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0) + &
&            vel*((7.*(wd(i, k, j)+wd(i-1, k, j))-wd(i+1, k, j)-wd(i-2, k&
&            , j))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(wd(i+1, k, j)-&
&            wd(i-2, k, j)-3.*(wd(i, k, j)-wd(i-1, k, j)))/12.0)
          fqx(i, k) = vel*((7.*(w(i, k, j)+w(i-1, k, j))-(w(i+1, k, j)+w&
&            (i-2, k, j)))/12.0+SIGN(1, time_step)*SIGN(1., vel)*(w(i+1, &
&            k, j)-w(i-2, k, j)-3.*(w(i, k, j)-w(i-1, k, j)))/12.0)
        END IF
      END DO
    END IF
!  x flux-divergence into tendency
    DO k=kts+1,ktf+1
      DO i=i_start,i_end
! see ADT eqn 46 dividing by my, 1st term RHS
        mrdx = msftx(i, j)*rdx
        tendencyd(i, k, j) = tendencyd(i, k, j) - mrdx*(fqxd(i+1, k)-&
&          fqxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - mrdx*(fqx(i+1, k)-fqx(i&
&          , k))
      END DO
    END DO
  END DO
!  pick up the the horizontal radiation boundary conditions.
!  (these are the computations that don't require 'cb'.
!  first, set to index ranges
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    DO j=j_start,j_end
      DO k=kts+1,ktf
        uwd = 0.5*(fzm(k)*(rud(its, k, j)+rud(its+1, k, j))+fzp(k)*(rud(&
&          its, k-1, j)+rud(its+1, k-1, j)))
        uw = 0.5*(fzm(k)*(ru(its, k, j)+ru(its+1, k, j))+fzp(k)*(ru(its&
&          , k-1, j)+ru(its+1, k-1, j)))
        IF (uw .GT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(w_old(&
&          its+1, k, j)-w_old(its, k, j))+ub*(w_oldd(its+1, k, j)-w_oldd(&
&          its, k, j))+wd(its, k, j)*(fzm(k)*(ru(its+1, k, j)-ru(its, k, &
&          j))+fzp(k)*(ru(its+1, k-1, j)-ru(its, k-1, j)))+w(its, k, j)*(&
&          fzm(k)*(rud(its+1, k, j)-rud(its, k, j))+fzp(k)*(rud(its+1, k-&
&          1, j)-rud(its, k-1, j))))
        tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(w_old(its+1&
&          , k, j)-w_old(its, k, j))+w(its, k, j)*(fzm(k)*(ru(its+1, k, j&
&          )-ru(its, k, j))+fzp(k)*(ru(its+1, k-1, j)-ru(its, k-1, j))))
      END DO
    END DO
    k = ktf + 1
    DO j=j_start,j_end
      uwd = 0.5*((2.-fzm(k-1))*(rud(its, k-1, j)+rud(its+1, k-1, j))-fzp&
&        (k-1)*(rud(its, k-2, j)+rud(its+1, k-2, j)))
      uw = 0.5*((2.-fzm(k-1))*(ru(its, k-1, j)+ru(its+1, k-1, j))-fzp(k-&
&        1)*(ru(its, k-2, j)+ru(its+1, k-2, j)))
      IF (uw .GT. 0.) THEN
        ub = 0.
        ubd = 0.0
      ELSE
        ubd = uwd
        ub = uw
      END IF
      tendencyd(its, k, j) = tendencyd(its, k, j) - rdx*(ubd*(w_old(its+&
&        1, k, j)-w_old(its, k, j))+ub*(w_oldd(its+1, k, j)-w_oldd(its, k&
&        , j))+wd(its, k, j)*((2.-fzm(k-1))*(ru(its+1, k-1, j)-ru(its, k-&
&        1, j))-fzp(k-1)*(ru(its+1, k-2, j)-ru(its, k-2, j)))+w(its, k, j&
&        )*((2.-fzm(k-1))*(rud(its+1, k-1, j)-rud(its, k-1, j))-fzp(k-1)*&
&        (rud(its+1, k-2, j)-rud(its, k-2, j))))
      tendency(its, k, j) = tendency(its, k, j) - rdx*(ub*(w_old(its+1, &
&        k, j)-w_old(its, k, j))+w(its, k, j)*((2.-fzm(k-1))*(ru(its+1, k&
&        -1, j)-ru(its, k-1, j))-fzp(k-1)*(ru(its+1, k-2, j)-ru(its, k-2&
&        , j))))
    END DO
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    DO j=j_start,j_end
      DO k=kts+1,ktf
        uwd = 0.5*(fzm(k)*(rud(ite-1, k, j)+rud(ite, k, j))+fzp(k)*(rud(&
&          ite-1, k-1, j)+rud(ite, k-1, j)))
        uw = 0.5*(fzm(k)*(ru(ite-1, k, j)+ru(ite, k, j))+fzp(k)*(ru(ite-&
&          1, k-1, j)+ru(ite, k-1, j)))
        IF (uw .LT. 0.) THEN
          ub = 0.
          ubd = 0.0
        ELSE
          ubd = uwd
          ub = uw
        END IF
        tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(&
&          w_old(i_end, k, j)-w_old(i_end-1, k, j))+ub*(w_oldd(i_end, k, &
&          j)-w_oldd(i_end-1, k, j))+wd(i_end, k, j)*(fzm(k)*(ru(ite, k, &
&          j)-ru(ite-1, k, j))+fzp(k)*(ru(ite, k-1, j)-ru(ite-1, k-1, j))&
&          )+w(i_end, k, j)*(fzm(k)*(rud(ite, k, j)-rud(ite-1, k, j))+fzp&
&          (k)*(rud(ite, k-1, j)-rud(ite-1, k-1, j))))
        tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(w_old(&
&          i_end, k, j)-w_old(i_end-1, k, j))+w(i_end, k, j)*(fzm(k)*(ru(&
&          ite, k, j)-ru(ite-1, k, j))+fzp(k)*(ru(ite, k-1, j)-ru(ite-1, &
&          k-1, j))))
      END DO
    END DO
    k = ktf + 1
    DO j=j_start,j_end
      uwd = 0.5*((2.-fzm(k-1))*(rud(ite-1, k-1, j)+rud(ite, k-1, j))-fzp&
&        (k-1)*(rud(ite-1, k-2, j)+rud(ite, k-2, j)))
      uw = 0.5*((2.-fzm(k-1))*(ru(ite-1, k-1, j)+ru(ite, k-1, j))-fzp(k-&
&        1)*(ru(ite-1, k-2, j)+ru(ite, k-2, j)))
      IF (uw .LT. 0.) THEN
        ub = 0.
        ubd = 0.0
      ELSE
        ubd = uwd
        ub = uw
      END IF
      tendencyd(i_end, k, j) = tendencyd(i_end, k, j) - rdx*(ubd*(w_old(&
&        i_end, k, j)-w_old(i_end-1, k, j))+ub*(w_oldd(i_end, k, j)-&
&        w_oldd(i_end-1, k, j))+wd(i_end, k, j)*((2.-fzm(k-1))*(ru(ite, k&
&        -1, j)-ru(ite-1, k-1, j))-fzp(k-1)*(ru(ite, k-2, j)-ru(ite-1, k-&
&        2, j)))+w(i_end, k, j)*((2.-fzm(k-1))*(rud(ite, k-1, j)-rud(ite-&
&        1, k-1, j))-fzp(k-1)*(rud(ite, k-2, j)-rud(ite-1, k-2, j))))
      tendency(i_end, k, j) = tendency(i_end, k, j) - rdx*(ub*(w_old(&
&        i_end, k, j)-w_old(i_end-1, k, j))+w(i_end, k, j)*((2.-fzm(k-1))&
&        *(ru(ite, k-1, j)-ru(ite-1, k-1, j))-fzp(k-1)*(ru(ite, k-2, j)-&
&        ru(ite-1, k-2, j))))
    END DO
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    DO i=i_start,i_end
      DO k=kts+1,ktf
        vwd = 0.5*(fzm(k)*(rvd(i, k, jts)+rvd(i, k, jts+1))+fzp(k)*(rvd(&
&          i, k-1, jts)+rvd(i, k-1, jts+1)))
        vw = 0.5*(fzm(k)*(rv(i, k, jts)+rv(i, k, jts+1))+fzp(k)*(rv(i, k&
&          -1, jts)+rv(i, k-1, jts+1)))
        IF (vw .GT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(w_old(i&
&          , k, jts+1)-w_old(i, k, jts))+vb*(w_oldd(i, k, jts+1)-w_oldd(i&
&          , k, jts))+wd(i, k, jts)*(fzm(k)*(rv(i, k, jts+1)-rv(i, k, jts&
&          ))+fzp(k)*(rv(i, k-1, jts+1)-rv(i, k-1, jts)))+w(i, k, jts)*(&
&          fzm(k)*(rvd(i, k, jts+1)-rvd(i, k, jts))+fzp(k)*(rvd(i, k-1, &
&          jts+1)-rvd(i, k-1, jts))))
        tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(w_old(i, k&
&          , jts+1)-w_old(i, k, jts))+w(i, k, jts)*(fzm(k)*(rv(i, k, jts+&
&          1)-rv(i, k, jts))+fzp(k)*(rv(i, k-1, jts+1)-rv(i, k-1, jts))))
      END DO
    END DO
    k = ktf + 1
    DO i=i_start,i_end
      vwd = 0.5*((2.-fzm(k-1))*(rvd(i, k-1, jts)+rvd(i, k-1, jts+1))-fzp&
&        (k-1)*(rvd(i, k-2, jts)+rvd(i, k-2, jts+1)))
      vw = 0.5*((2.-fzm(k-1))*(rv(i, k-1, jts)+rv(i, k-1, jts+1))-fzp(k-&
&        1)*(rv(i, k-2, jts)+rv(i, k-2, jts+1)))
      IF (vw .GT. 0.) THEN
        vb = 0.
        vbd = 0.0
      ELSE
        vbd = vwd
        vb = vw
      END IF
      tendencyd(i, k, jts) = tendencyd(i, k, jts) - rdy*(vbd*(w_old(i, k&
&        , jts+1)-w_old(i, k, jts))+vb*(w_oldd(i, k, jts+1)-w_oldd(i, k, &
&        jts))+wd(i, k, jts)*((2.-fzm(k-1))*(rv(i, k-1, jts+1)-rv(i, k-1&
&        , jts))-fzp(k-1)*(rv(i, k-2, jts+1)-rv(i, k-2, jts)))+w(i, k, &
&        jts)*((2.-fzm(k-1))*(rvd(i, k-1, jts+1)-rvd(i, k-1, jts))-fzp(k-&
&        1)*(rvd(i, k-2, jts+1)-rvd(i, k-2, jts))))
      tendency(i, k, jts) = tendency(i, k, jts) - rdy*(vb*(w_old(i, k, &
&        jts+1)-w_old(i, k, jts))+w(i, k, jts)*((2.-fzm(k-1))*(rv(i, k-1&
&        , jts+1)-rv(i, k-1, jts))-fzp(k-1)*(rv(i, k-2, jts+1)-rv(i, k-2&
&        , jts))))
    END DO
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    DO i=i_start,i_end
      DO k=kts+1,ktf
        vwd = 0.5*(fzm(k)*(rvd(i, k, jte-1)+rvd(i, k, jte))+fzp(k)*(rvd(&
&          i, k-1, jte-1)+rvd(i, k-1, jte)))
        vw = 0.5*(fzm(k)*(rv(i, k, jte-1)+rv(i, k, jte))+fzp(k)*(rv(i, k&
&          -1, jte-1)+rv(i, k-1, jte)))
        IF (vw .LT. 0.) THEN
          vb = 0.
          vbd = 0.0
        ELSE
          vbd = vwd
          vb = vw
        END IF
        tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(&
&          w_old(i, k, j_end)-w_old(i, k, j_end-1))+vb*(w_oldd(i, k, &
&          j_end)-w_oldd(i, k, j_end-1))+wd(i, k, j_end)*(fzm(k)*(rv(i, k&
&          , jte)-rv(i, k, jte-1))+fzp(k)*(rv(i, k-1, jte)-rv(i, k-1, jte&
&          -1)))+w(i, k, j_end)*(fzm(k)*(rvd(i, k, jte)-rvd(i, k, jte-1))&
&          +fzp(k)*(rvd(i, k-1, jte)-rvd(i, k-1, jte-1))))
        tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(w_old(i&
&          , k, j_end)-w_old(i, k, j_end-1))+w(i, k, j_end)*(fzm(k)*(rv(i&
&          , k, jte)-rv(i, k, jte-1))+fzp(k)*(rv(i, k-1, jte)-rv(i, k-1, &
&          jte-1))))
      END DO
    END DO
    k = ktf + 1
    DO i=i_start,i_end
      vwd = 0.5*((2.-fzm(k-1))*(rvd(i, k-1, jte-1)+rvd(i, k-1, jte))-fzp&
&        (k-1)*(rvd(i, k-2, jte-1)+rvd(i, k-2, jte)))
      vw = 0.5*((2.-fzm(k-1))*(rv(i, k-1, jte-1)+rv(i, k-1, jte))-fzp(k-&
&        1)*(rv(i, k-2, jte-1)+rv(i, k-2, jte)))
      IF (vw .LT. 0.) THEN
        vb = 0.
        vbd = 0.0
      ELSE
        vbd = vwd
        vb = vw
      END IF
      tendencyd(i, k, j_end) = tendencyd(i, k, j_end) - rdy*(vbd*(w_old(&
&        i, k, j_end)-w_old(i, k, j_end-1))+vb*(w_oldd(i, k, j_end)-&
&        w_oldd(i, k, j_end-1))+wd(i, k, j_end)*((2.-fzm(k-1))*(rv(i, k-1&
&        , jte)-rv(i, k-1, jte-1))-fzp(k-1)*(rv(i, k-2, jte)-rv(i, k-2, &
&        jte-1)))+w(i, k, j_end)*((2.-fzm(k-1))*(rvd(i, k-1, jte)-rvd(i, &
&        k-1, jte-1))-fzp(k-1)*(rvd(i, k-2, jte)-rvd(i, k-2, jte-1))))
      tendency(i, k, j_end) = tendency(i, k, j_end) - rdy*(vb*(w_old(i, &
&        k, j_end)-w_old(i, k, j_end-1))+w(i, k, j_end)*((2.-fzm(k-1))*(&
&        rv(i, k-1, jte)-rv(i, k-1, jte-1))-fzp(k-1)*(rv(i, k-2, jte)-rv(&
&        i, k-2, jte-1))))
    END DO
  END IF
!-------------------- vertical advection
!     ADT eqn 46 has 3rd term on RHS (dividing through by my) = - partial d/dz (w rho w /my)
!     Here we have:  - partial d/dz (w*rom) = - partial d/dz (w rho w / my)
!     Therefore we don't need to make a correction for advect_w
  i_start = its
  IF (ite .GT. ide - 1) THEN
    i_end = ide - 1
  ELSE
    i_end = ite
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    j_end = jde - 1
  ELSE
    j_end = jte
  END IF
  DO i=i_start,i_end
    vfluxd(i, kts) = 0.0
    vflux(i, kts) = 0.
    vfluxd(i, kte) = 0.0
    vflux(i, kte) = 0.
  END DO
  vfluxd = 0.0
!    vert_order_test : IF (vert_order == 6) THEN    
! ELSE IF (vert_order == 5) THEN    
  DO j=j_start,j_end
    DO k=kts+3,ktf-1
      DO i=i_start,i_end
        veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          qip2d = wd(i, k+1, j)
          qip2 = w(i, k+1, j)
          qip1d = wd(i, k, j)
          qip1 = w(i, k, j)
          qid = wd(i, k-1, j)
          qi = w(i, k-1, j)
          qim1d = wd(i, k-2, j)
          qim1 = w(i, k-2, j)
          qim2d = wd(i, k-3, j)
          qim2 = w(i, k-3, j)
        ELSE
          qip2d = wd(i, k-2, j)
          qip2 = w(i, k-2, j)
          qip1d = wd(i, k-1, j)
          qip1 = w(i, k-1, j)
          qid = wd(i, k, j)
          qi = w(i, k, j)
          qim1d = wd(i, k+1, j)
          qim1 = w(i, k+1, j)
          qim2d = wd(i, k+2, j)
          qim2 = w(i, k+2, j)
        END IF
        f0d = qim2d/3. - 7.*qim1d/6. + 11.*qid/6.
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        f1d = 5.*qid/6. - qim1d/6. + qip1d/3.
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        f2d = qid/3. + 5.*qip1d/6. - qip2d/6.
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        beta0d = 13.*2*(qim2-2.*qim1+qi)*(qim2d-2.*qim1d+qid)/12. + 2*(&
&          qim2-4.*qim1+3.*qi)*(qim2d-4.*qim1d+3.*qid)/4.
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        beta1d = 13.*2*(qim1-2.*qi+qip1)*(qim1d-2.*qid+qip1d)/12. + 2*(&
&          qim1-qip1)*(qim1d-qip1d)/4.
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        beta2d = 13.*2*(qi-2.*qip1+qip2)*(qid-2.*qip1d+qip2d)/12. + 2*(&
&          qip2-4.*qip1+3.*qi)*(qip2d-4.*qip1d+3.*qid)/4.
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
        pwx1d = beta0d
        pwx1 = eps + beta0
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi0d = -(gi0*pwr1d/pwr1**2)
        wi0 = gi0/pwr1
        pwx1d = beta1d
        pwx1 = eps + beta1
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi1d = -(gi1*pwr1d/pwr1**2)
        wi1 = gi1/pwr1
        pwx1d = beta2d
        pwx1 = eps + beta2
        IF (pwx1 .GT. 0.0 .OR. (pwx1 .LT. 0.0 .AND. pw .EQ. INT(pw))) &
&        THEN
          pwr1d = pw*pwx1**(pw-1)*pwx1d
        ELSE IF (pwx1 .EQ. 0.0 .AND. pw .EQ. 1.0) THEN
          pwr1d = pwx1d
        ELSE
          pwr1d = 0.0
        END IF
        pwr1 = pwx1**pw
        wi2d = -(gi2*pwr1d/pwr1**2)
        wi2 = gi2/pwr1
        sumwkd = wi0d + wi1d + wi2d
        sumwk = wi0 + wi1 + wi2
        vfluxd(i, k) = ((veld*(wi0*f0+wi1*f1+wi2*f2)+vel*(wi0d*f0+wi0*&
&          f0d+wi1d*f1+wi1*f1d+wi2d*f2+wi2*f2d))*sumwk-vel*(wi0*f0+wi1*f1&
&          +wi2*f2)*sumwkd)/sumwk**2
        vflux(i, k) = vel*(wi0*f0+wi1*f1+wi2*f2)/sumwk
      END DO
    END DO
!           vflux(i,k) = vel*flux5(                                   &
!                   w(i,k-3,j), w(i,k-2,j), w(i,k-1,j),       &
!                   w(i,k  ,j), w(i,k+1,j), w(i,k+2,j),  -vel )
    DO i=i_start,i_end
      k = kts + 1
      vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)+w&
&        (i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i, k-&
&        1, j)))
      vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i, &
&        k-1, j))
      k = kts + 2
      veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
      vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
      vfluxd(i, k) = veld*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1, &
&        j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0) + vel*((7.*(&
&        wd(i, k, j)+wd(i, k-1, j))-wd(i, k+1, j)-wd(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(wd(i, k+1, j)-wd(i, k-2, j)-&
&        3.*(wd(i, k, j)-wd(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1, j)&
&        -w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0)
      k = ktf
      veld = 0.5*(romd(i, k, j)+romd(i, k-1, j))
      vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
      vfluxd(i, k) = veld*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w&
&        (i, k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1, &
&        j)-w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0) + vel*((7.*(&
&        wd(i, k, j)+wd(i, k-1, j))-wd(i, k+1, j)-wd(i, k-2, j))/12.0+&
&        SIGN(1, time_step)*SIGN(1., -vel)*(wd(i, k+1, j)-wd(i, k-2, j)-&
&        3.*(wd(i, k, j)-wd(i, k-1, j)))/12.0)
      vflux(i, k) = vel*((7.*(w(i, k, j)+w(i, k-1, j))-(w(i, k+1, j)+w(i&
&        , k-2, j)))/12.0+SIGN(1, time_step)*SIGN(1., -vel)*(w(i, k+1, j)&
&        -w(i, k-2, j)-3.*(w(i, k, j)-w(i, k-1, j)))/12.0)
      k = ktf + 1
      vfluxd(i, k) = 0.25*((romd(i, k, j)+romd(i, k-1, j))*(w(i, k, j)+w&
&        (i, k-1, j))+(rom(i, k, j)+rom(i, k-1, j))*(wd(i, k, j)+wd(i, k-&
&        1, j)))
      vflux(i, k) = 0.25*(rom(i, k, j)+rom(i, k-1, j))*(w(i, k, j)+w(i, &
&        k-1, j))
    END DO
    DO k=kts+1,ktf
      DO i=i_start,i_end
        tendencyd(i, k, j) = tendencyd(i, k, j) - rdzu(k)*(vfluxd(i, k+1&
&          )-vfluxd(i, k))
        tendency(i, k, j) = tendency(i, k, j) - rdzu(k)*(vflux(i, k+1)-&
&          vflux(i, k))
      END DO
    END DO
! pick up flux contribution for w at the lid, wcs. 13 march 2004
    k = ktf + 1
    DO i=i_start,i_end
      tendencyd(i, k, j) = tendencyd(i, k, j) + 2.*rdzu(k-1)*vfluxd(i, k&
&        )
      tendency(i, k, j) = tendency(i, k, j) + 2.*rdzu(k-1)*vflux(i, k)
    END DO
  END DO
END SUBROUTINE G_ADVECT_WENO_W

 END MODULE g_module_advect_em

