
! ======================================================================================
! This file was generated by the version 4.3.7 of ADG on 07/17/2010. The Adjoint Code
! Generator (ADG) was developed and sponsored by LASG of IAP (1999-2010)
! The Copyright of the ADG system was declared by Walls at LASG, 1999-2010
! ======================================================================================

MODULE a_module_advect_em

   USE module_bc
   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 reverse (adjoint) mode:
!   gradient     of useful results: rom u tendency u_old ru rv
!                mut
!   with respect to varying inputs: rom u tendency u_old ru rv
!                mut
!   RW status of diff variables: rom:incr u:incr tendency:in-out
!                u_old:incr ru:incr rv:incr mut:incr
SUBROUTINE A_ADVECT_U(u, ub0, u_old, u_oldb, tendency, tendencyb, ru, &
&  rub, rv, rvb, rom, romb, mut, mutb, 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) :: ub0, u_oldb, rub, rvb, &
&  romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: tendencyb
  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 :: ubb, vbb, vwb, dvmb, dvpb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its - 1:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its-1:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: branch
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  INTEGER :: ad_from27
  INTEGER :: ad_to27
  INTEGER :: ad_from28
  INTEGER :: ad_to28
  INTEGER :: ad_from29
  INTEGER :: ad_to29
  INTEGER :: ad_from30
  INTEGER :: ad_to30
  INTEGER :: ad_from31
  INTEGER :: ad_to31
  INTEGER :: ad_from32
  INTEGER :: ad_to32
  INTEGER :: ad_from33
  INTEGER :: ad_to33
  INTEGER :: ad_from34
  INTEGER :: ad_to34
  INTEGER :: ad_from35
  INTEGER :: ad_to35
  INTEGER :: ad_from36
  INTEGER :: ad_to36
  INTEGER :: ad_from37
  INTEGER :: ad_to37
  INTEGER :: ad_from38
  INTEGER :: ad_to38
  INTEGER :: ad_from39
  INTEGER :: ad_to39
  INTEGER :: ad_from40
  INTEGER :: ad_to40
  INTEGER :: ad_from41
  INTEGER :: ad_to41
  INTEGER :: ad_from42
  INTEGER :: ad_to42
  INTEGER :: ad_from43
  INTEGER :: ad_to43
  INTEGER :: ad_from44
  INTEGER :: ad_to44
  INTEGER :: ad_from45
  INTEGER :: ad_to45
  INTEGER :: ad_from46
  INTEGER :: ad_to46
  INTEGER :: ad_from47
  INTEGER :: ad_to47
  INTEGER :: ad_from48
  INTEGER :: ad_to48
  REAL :: temp3
  REAL :: temp29
  REAL :: temp31b43
  REAL :: temp2
  INTEGER :: temp28
  REAL :: temp31b42
  REAL :: temp1
  REAL :: temp27
  REAL :: temp31b41
  INTEGER :: temp0
  REAL :: temp26
  REAL :: temp31b40
  REAL :: temp7b
  REAL :: temp25
  INTEGER :: temp24
  REAL :: temp23
  REAL :: temp22
  REAL :: temp21
  REAL :: temp35b3
  INTEGER :: temp20
  REAL :: temp35b2
  REAL :: temp35b1
  REAL :: temp35b0
  REAL :: temp23b9
  REAL :: temp23b8
  REAL :: temp19b
  REAL :: temp23b7
  REAL :: temp23b6
  REAL :: temp27b
  REAL :: temp23b5
  REAL :: temp35b
  REAL :: tempb1
  REAL :: temp23b4
  REAL :: temp43b
  REAL :: tempb0
  REAL :: temp23b3
  REAL :: temp23b2
  REAL :: temp23b1
  REAL :: temp23b0
  REAL :: temp31b39
  REAL :: temp31b38
  REAL :: temp7b3
  REAL :: temp31b37
  REAL :: temp3b
  REAL :: temp7b2
  REAL :: temp31b36
  REAL :: temp7b1
  REAL :: temp31b35
  REAL :: temp7b0
  REAL :: temp31b34
  REAL :: temp19
  REAL :: temp31b33
  REAL :: temp18
  REAL :: temp31b32
  REAL :: temp17
  REAL :: temp31b31
  INTEGER :: temp16
  REAL :: temp23b11
  REAL :: temp31b30
  REAL :: temp43b8
  REAL :: temp15
  REAL :: temp23b10
  REAL :: temp43b7
  REAL :: temp14
  REAL :: temp11b1
  REAL :: temp43b6
  REAL :: temp13
  REAL :: temp11b0
  REAL :: temp43b5
  INTEGER :: temp12
  REAL :: temp43b4
  REAL :: temp11
  REAL :: temp43b3
  REAL :: temp10
  REAL :: temp43b2
  REAL :: temp15b
  REAL :: temp43b1
  REAL :: temp46
  REAL :: temp23b
  REAL :: temp43b0
  REAL :: temp45
  REAL :: temp31b
  INTEGER :: temp44
  REAL :: temp43
  REAL :: temp42
  REAL :: temp19b3
  REAL :: temp31b9
  REAL :: temp41
  REAL :: temp19b2
  REAL :: temp31b8
  INTEGER :: temp40
  REAL :: temp19b1
  REAL :: temp31b7
  REAL :: temp19b0
  REAL :: temp31b6
  REAL :: temp31b5
  REAL :: temp31b4
  REAL :: temp31b3
  REAL :: tempb
  REAL :: temp31b2
  REAL :: temp31b1
  REAL :: temp31b0
  REAL :: temp31b29
  REAL :: temp31b28
  REAL :: temp31b27
  REAL :: temp31b26
  REAL :: temp31b25
  REAL :: temp31b24
  REAL :: temp31b23
  REAL :: temp31b22
  REAL :: temp31b21
  REAL :: temp11b
  REAL :: temp31b20
  REAL :: temp39b1
  REAL :: temp39b0
  REAL :: temp31b54
  REAL :: temp31b53
  REAL :: temp39
  REAL :: temp31b52
  REAL :: temp38
  REAL :: temp3b3
  REAL :: temp27b9
  REAL :: temp31b51
  REAL :: temp37
  REAL :: temp3b2
  REAL :: temp27b8
  REAL :: temp31b50
  INTEGER :: temp36
  REAL :: temp3b1
  REAL :: temp27b7
  REAL :: temp35
  REAL :: temp3b0
  REAL :: temp27b6
  REAL :: temp34
  REAL :: temp27b5
  REAL :: temp33
  REAL :: temp27b4
  INTEGER :: temp32
  REAL :: temp27b3
  REAL :: temp31
  REAL :: temp27b2
  REAL :: temp30
  REAL :: temp27b1
  REAL :: temp27b0
  INTRINSIC MIN
  REAL :: temp31b19
  REAL :: temp31b18
  REAL :: temp31b17
  REAL :: temp15b3
  REAL :: temp31b16
  REAL :: temp
  REAL :: temp15b2
  REAL :: temp31b15
  REAL :: temp15b1
  REAL :: temp31b14
  REAL :: temp15b0
  REAL :: temp31b13
  REAL :: temp9
  REAL :: temp31b12
  REAL :: temp31b49
  REAL :: temp47b4
  INTEGER :: temp8
  REAL :: temp31b11
  REAL :: temp31b48
  REAL :: temp39b
  REAL :: temp47b3
  REAL :: temp7
  REAL :: temp31b10
  REAL :: temp31b47
  REAL :: temp47b
  REAL :: temp47b2
  REAL :: temp6
  REAL :: temp31b46
  REAL :: temp47b1
  REAL :: temp5
  REAL :: temp31b45
  REAL :: temp47b0
  INTEGER :: temp4
  REAL :: temp31b44
  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
    ad_from42 = j_start
j_loop_y_flux_6:DO j=ad_from42,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from34 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from34)
        END DO
        CALL PUSHCONTROL3B(0)
      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
          ad_from35 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from35)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from36 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from36)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from37 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from37)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from38 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from38)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from39 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from39)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from40 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from40)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from41 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from41)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_6
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from42)
!  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
    END IF
    ad_from44 = j_start
!  compute fluxes
    DO j=ad_from44,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      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
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            CALL PUSHREAL8(ub)
            ub = u(i-1, k, j)
            IF (specified .AND. u(i, k, j) .LT. 0.) THEN
              ub = u(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHINTEGER4(i)
        i = ids + 2
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 1) THEN
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ide
          DO k=kts,ktf
            CALL PUSHREAL8(ub)
            ub = u(i, k, j)
            IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
              ub = u(i-1, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
        DO k=kts,ktf
          CALL PUSHINTEGER4(i)
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from43 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from43)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from44)
    CALL PUSHCONTROL3B(0)
  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
    ad_from7 = j_start
j_loop_y_flux_5:DO j=ad_from7,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHCONTROL3B(0)
      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
          ad_from0 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from0)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from1 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from2 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from2)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from3 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from4 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from4)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from5 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from5)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from6 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from6)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from7)
!  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
    END IF
    ad_from9 = j_start
!  compute fluxes
    DO j=ad_from9,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      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
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            CALL PUSHREAL8(ub)
            ub = u(i-1, k, j)
            IF (specified .AND. u(i, k, j) .LT. 0.) THEN
              ub = u(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHINTEGER4(i)
        i = ids + 2
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 1) THEN
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ide
          DO k=kts,ktf
            CALL PUSHREAL8(ub)
            ub = u(i, k, j)
            IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
              ub = u(i-1, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
        DO k=kts,ktf
          CALL PUSHINTEGER4(i)
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from8 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from8)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from9)
    CALL PUSHCONTROL3B(1)
  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
    END IF
    ad_from11 = j_start
!  compute fluxes
    DO j=ad_from11,j_end
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        CALL PUSHINTEGER4(i)
        i = i_start
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ub = u(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ub = u(i-1, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from10 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from10)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from11)
!  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
    ad_from18 = j_start
    DO j=ad_from18,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from12 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from12)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from13 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from13)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          ad_from14 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from14)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from15 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from15)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from16 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from16)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from17 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from17)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from18)
    CALL PUSHCONTROL3B(2)
  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
    END IF
    ad_from20 = j_start
!  compute fluxes
    DO j=ad_from20,j_end
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
!  specified uses upstream normal wind at boundaries
      IF (degrade_xs) THEN
        CALL PUSHINTEGER4(i)
        i = i_start
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ub = u(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ub = u(i-1, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from19 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from19)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from20)
!  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
    ad_from27 = j_start
    DO j=ad_from27,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from21 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from21)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from22 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from22)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          ad_from23 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from23)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from24 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from24)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from25 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from25)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from26 = i_start
          CALL PUSHINTEGER4(i)
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from26)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from27)
    CALL PUSHCONTROL3B(3)
  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
    ad_from29 = j_start
    DO j=ad_from29,j_end
      DO k=kts,ktf
        ad_from28 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from28)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from29)
    IF (specified .AND. its .LE. ids + 1 .AND. (.NOT.config_flags%&
&        periodic_x)) THEN
      ad_from30 = j_start
      DO j=ad_from30,j_end
        DO k=kts,ktf
          i = ids + 1
          CALL PUSHREAL8(ub)
! ADT eqn 44, 1st term on RHS
          ub = u(i-1, k, j)
          IF (u(i, k, j) .LT. 0.) THEN
            ub = u(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
      END DO
      CALL PUSHINTEGER4(j - 1)
      CALL PUSHINTEGER4(ad_from30)
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (specified .AND. ite .GE. ide - 1 .AND. (.NOT.config_flags%&
&        periodic_x)) THEN
      ad_from31 = j_start
      DO j=ad_from31,j_end
        DO k=kts,ktf
          i = ide - 1
          CALL PUSHREAL8(ub)
! ADT eqn 44, 1st term on RHS
          ub = u(i+1, k, j)
          IF (u(i, k, j) .GT. 0.) THEN
            ub = u(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
      END DO
      CALL PUSHINTEGER4(j - 1)
      CALL PUSHINTEGER4(ad_from31)
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    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
    ad_from33 = j_start
    DO j=ad_from33,j_end
      DO k=kts,ktf
        ad_from32 = i_start
        CALL PUSHINTEGER4(i)
        DO i=ad_from32,i_end
! ADT eqn 44, 1st term on RHS
! 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
            CALL PUSHCONTROL2B(2)
          ELSE IF (config_flags%polar .AND. j .EQ. jde - 1) THEN
            CALL PUSHCONTROL2B(1)
          ELSE
            CALL PUSHCONTROL2B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from32)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from33)
    CALL PUSHCONTROL3B(4)
  ELSE
    CALL PUSHCONTROL3B(5)
  END IF
!  radiative lateral boundary condition in x for normal velocity (u)
  IF (config_flags%open_xs .AND. its .EQ. ids) THEN
    CALL PUSHINTEGER4(j_start)
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    ad_from45 = j_start
    DO j=ad_from45,j_end
      DO k=kts,ktf
        IF (ru(its, k, j) - cb*mut(its, j) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = ru(its, k, j) - cb*mut(its, j)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from45)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    CALL PUSHINTEGER4(j_start)
    j_start = jts
    IF (jte .GT. jde - 1) THEN
      j_end = jde - 1
    ELSE
      j_end = jte
    END IF
    ad_from46 = j_start
    DO j=ad_from46,j_end
      DO k=kts,ktf
        IF (ru(ite, k, j) + cb*mut(ite-1, j) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = ru(ite, k, j) + cb*mut(ite-1, j)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from46)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(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) 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
    ad_from47 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from47,i_end
      CALL PUSHREAL8(mrdy)
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jts)*rdy
      IF (imax .GT. i) THEN
        CALL PUSHINTEGER4(ip)
        ip = i
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(ip)
        ip = imax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (imin .LT. i - 1) THEN
        CALL PUSHINTEGER4(im)
        im = i - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(im)
        im = imin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        vw = 0.5*(rv(ip, k, jts)+rv(im, k, jts))
        IF (vw .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from47)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from48 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from48,i_end
      CALL PUSHREAL8(mrdy)
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jte-1)*rdy
      IF (imax .GT. i) THEN
        CALL PUSHINTEGER4(ip)
        ip = i
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(ip)
        ip = imax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (imin .LT. i - 1) THEN
        CALL PUSHINTEGER4(im)
        im = i - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(im)
        im = imin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        vw = 0.5*(rv(ip, k, jte)+rv(im, k, jte))
        IF (vw .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from48)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
  CALL PUSHINTEGER4(j_start)
  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
  IF (vert_order .EQ. 6) THEN
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        CALL PUSHINTEGER4(i)
      END DO
      CALL PUSHINTEGER4(i)
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp31b46 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp31b47 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp31b46
        romb(i-1, k, j) = romb(i-1, k, j) + temp31b46
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp31b47
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp31b47
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        temp31b48 = vel*vfluxb(i, k)/12.0
        velb = (7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b48
        ub0(i, k-1, j) = ub0(i, k-1, j) + 7.*temp31b48
        ub0(i, k+1, j) = ub0(i, k+1, j) - temp31b48
        ub0(i, k-2, j) = ub0(i, k-2, j) - temp31b48
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        temp31b49 = vel*vfluxb(i, k)/12.0
        velb = (7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b49
        ub0(i, k-1, j) = ub0(i, k-1, j) + 7.*temp31b49
        ub0(i, k+1, j) = ub0(i, k+1, j) - temp31b49
        ub0(i, k-2, j) = ub0(i, k-2, j) - temp31b49
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
        k = kts + 1
        temp31b50 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp31b51 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp31b50
        romb(i-1, k, j) = romb(i-1, k, j) + temp31b50
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp31b51
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp31b51
        vfluxb(i, k) = 0.0
      END DO
      CALL POPINTEGER4(i)
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          temp31b45 = vel*vfluxb(i, k)/60.0
          velb = (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))*vfluxb(i, k)/60.0
          ub0(i, k, j) = ub0(i, k, j) + 37.*temp31b45
          ub0(i, k-1, j) = ub0(i, k-1, j) + 37.*temp31b45
          ub0(i, k+1, j) = ub0(i, k+1, j) - 8.*temp31b45
          ub0(i, k-2, j) = ub0(i, k-2, j) - 8.*temp31b45
          ub0(i, k+2, j) = ub0(i, k+2, j) + temp31b45
          ub0(i, k-3, j) = ub0(i, k-3, j) + temp31b45
          vfluxb(i, k) = 0.0
          romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    DO j=j_start,j_end
      DO k=kts+3,ktf-2
        CALL PUSHINTEGER4(i)
      END DO
      CALL PUSHINTEGER4(i)
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i, &
&          k)
        temp43b0 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b
        romb(i-1, k, j) = romb(i-1, k, j) + temp43b
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp43b0
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp43b0
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        temp39 = u(i, k+1, j) - u(i, k-2, j) - 3.*(u(i, k, j)-u(i, k-1, &
&          j))
        temp42 = SIGN(1., -vel)
        temp41 = temp42/12.0
        temp40 = SIGN(1, time_step)
        temp39b = vel*vfluxb(i, k)
        temp39b0 = temp39b/12.0
        temp39b1 = temp40*temp41*temp39b
        velb = ((7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))&
&          /12.0+temp40*(temp41*temp39))*vfluxb(i, k)
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp39b0 - 3.*temp39b1
        ub0(i, k-1, j) = ub0(i, k-1, j) + 3.*temp39b1 + 7.*temp39b0
        ub0(i, k+1, j) = ub0(i, k+1, j) + temp39b1 - temp39b0
        ub0(i, k-2, j) = ub0(i, k-2, j) - temp39b1 - temp39b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
        temp35 = u(i, k+1, j) - u(i, k-2, j) - 3.*(u(i, k, j)-u(i, k-1, &
&          j))
        temp38 = SIGN(1., -vel)
        temp37 = temp38/12.0
        temp36 = SIGN(1, time_step)
        temp35b = vel*vfluxb(i, k)
        temp35b0 = temp35b/12.0
        temp35b1 = temp36*temp37*temp35b
        velb = ((7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))&
&          /12.0+temp36*(temp37*temp35))*vfluxb(i, k)
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp35b0 - 3.*temp35b1
        ub0(i, k-1, j) = ub0(i, k-1, j) + 3.*temp35b1 + 7.*temp35b0
        ub0(i, k+1, j) = ub0(i, k+1, j) + temp35b1 - temp35b0
        ub0(i, k-2, j) = ub0(i, k-2, j) - temp35b1 - temp35b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
        k = kts + 1
        temp35b2 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp35b3 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp35b2
        romb(i-1, k, j) = romb(i-1, k, j) + temp35b2
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp35b3
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp35b3
        vfluxb(i, k) = 0.0
      END DO
      CALL POPINTEGER4(i)
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          temp31 = u(i, k+2, j) - u(i, k-3, j) + 10.*(u(i, k, j)-u(i, k-&
&            1, j)) - 5.*(u(i, k+1, j)-u(i, k-2, j))
          temp34 = SIGN(1., -vel)
          temp33 = temp34/60.0
          temp32 = SIGN(1, time_step)
          temp31b52 = vel*vfluxb(i, k)
          temp31b53 = temp31b52/60.0
          temp31b54 = -(temp32*temp33*temp31b52)
          velb = ((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-temp32*(temp33*&
&            temp31))*vfluxb(i, k)
          ub0(i, k, j) = ub0(i, k, j) + 10.*temp31b54 + 37.*temp31b53
          ub0(i, k-1, j) = ub0(i, k-1, j) + 37.*temp31b53 - 10.*&
&            temp31b54
          ub0(i, k+1, j) = ub0(i, k+1, j) - 5.*temp31b54 - 8.*temp31b53
          ub0(i, k-2, j) = ub0(i, k-2, j) + 5.*temp31b54 - 8.*temp31b53
          ub0(i, k+2, j) = ub0(i, k+2, j) + temp31b54 + temp31b53
          ub0(i, k-3, j) = ub0(i, k-3, j) + temp31b53 - temp31b54
          vfluxb(i, k) = 0.0
          romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        CALL PUSHINTEGER4(i)
      END DO
      CALL PUSHINTEGER4(i)
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b2 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp43b3 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b2
        romb(i-1, k, j) = romb(i-1, k, j) + temp43b2
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp43b3
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp43b3
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp43b4 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp43b5 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b4
        romb(i-1, k, j) = romb(i-1, k, j) + temp43b4
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp43b5
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp43b5
        vfluxb(i, k) = 0.0
      END DO
      CALL POPINTEGER4(i)
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          temp43b1 = vel*vfluxb(i, k)/12.0
          velb = (7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j)&
&            )*vfluxb(i, k)/12.0
          ub0(i, k, j) = ub0(i, k, j) + 7.*temp43b1
          ub0(i, k-1, j) = ub0(i, k-1, j) + 7.*temp43b1
          ub0(i, k+1, j) = ub0(i, k+1, j) - temp43b1
          ub0(i, k-2, j) = ub0(i, k-2, j) - temp43b1
          vfluxb(i, k) = 0.0
          romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    DO j=j_start,j_end
      DO k=kts+2,ktf-1
        CALL PUSHINTEGER4(i)
      END DO
      CALL PUSHINTEGER4(i)
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp47b = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i, &
&          k)
        temp47b0 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp47b
        romb(i-1, k, j) = romb(i-1, k, j) + temp47b
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp47b0
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp47b0
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp47b1 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i&
&          , k)
        temp47b2 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp47b1
        romb(i-1, k, j) = romb(i-1, k, j) + temp47b1
        ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp47b2
        ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp47b2
        vfluxb(i, k) = 0.0
      END DO
      CALL POPINTEGER4(i)
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
          temp43 = u(i, k+1, j) - u(i, k-2, j) - 3.*(u(i, k, j)-u(i, k-1&
&            , j))
          temp46 = SIGN(1., -vel)
          temp45 = temp46/12.0
          temp44 = SIGN(1, time_step)
          temp43b6 = vel*vfluxb(i, k)
          temp43b7 = temp43b6/12.0
          temp43b8 = temp44*temp45*temp43b6
          velb = ((7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j&
&            ))/12.0+temp44*(temp45*temp43))*vfluxb(i, k)
          ub0(i, k, j) = ub0(i, k, j) + 7.*temp43b7 - 3.*temp43b8
          ub0(i, k-1, j) = ub0(i, k-1, j) + 3.*temp43b8 + 7.*temp43b7
          ub0(i, k+1, j) = ub0(i, k+1, j) + temp43b8 - temp43b7
          ub0(i, k-2, j) = ub0(i, k-2, j) - temp43b8 - temp43b7
          vfluxb(i, k) = 0.0
          romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    DO j=j_start,j_end
      DO k=kts+1,ktf
        CALL PUSHINTEGER4(i)
      END DO
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      END DO
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
        CALL POPINTEGER4(i)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          temp47b3 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(&
&            i, k)
          temp47b4 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
          romb(i, k, j) = romb(i, k, j) + temp47b3
          romb(i-1, k, j) = romb(i-1, k, j) + temp47b3
          ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp47b4
          ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp47b4
          vfluxb(i, k) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  END IF
  CALL POPINTEGER4(j_start)
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from48)
    CALL POPINTEGER4(ad_to48)
    DO i=ad_to48,ad_from48,-1
      DO k=ktf,kts,-1
        dvm = rv(ip, k, jte) - rv(ip, k, jte-1)
        dvp = rv(im, k, jte) - rv(im, k, jte-1)
        temp31b43 = -(mrdy*tendencyb(i, k, jte-1))
        temp31b44 = 0.5*u(i, k, jte-1)*temp31b43
        vbb = (u_old(i, k, jte-1)-u_old(i, k, jte-2))*temp31b43
        u_oldb(i, k, jte-1) = u_oldb(i, k, jte-1) + vb*temp31b43
        u_oldb(i, k, jte-2) = u_oldb(i, k, jte-2) - vb*temp31b43
        ub0(i, k, jte-1) = ub0(i, k, jte-1) + 0.5*(dvm+dvp)*temp31b43
        dvmb = temp31b44
        dvpb = temp31b44
        rvb(im, k, jte) = rvb(im, k, jte) + dvpb
        rvb(im, k, jte-1) = rvb(im, k, jte-1) - dvpb
        rvb(ip, k, jte) = rvb(ip, k, jte) + dvmb
        rvb(ip, k, jte-1) = rvb(ip, k, jte-1) - dvmb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        rvb(ip, k, jte) = rvb(ip, k, jte) + 0.5*vwb
        rvb(im, k, jte) = rvb(im, k, jte) + 0.5*vwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(im)
      ELSE
        CALL POPINTEGER4(im)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ip)
      ELSE
        CALL POPINTEGER4(ip)
      END IF
      CALL POPREAL8(mrdy)
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from47)
    CALL POPINTEGER4(ad_to47)
    DO i=ad_to47,ad_from47,-1
      DO k=ktf,kts,-1
        dvm = rv(ip, k, jts+1) - rv(ip, k, jts)
        dvp = rv(im, k, jts+1) - rv(im, k, jts)
        temp31b41 = -(mrdy*tendencyb(i, k, jts))
        temp31b42 = 0.5*u(i, k, jts)*temp31b41
        vbb = (u_old(i, k, jts+1)-u_old(i, k, jts))*temp31b41
        u_oldb(i, k, jts+1) = u_oldb(i, k, jts+1) + vb*temp31b41
        u_oldb(i, k, jts) = u_oldb(i, k, jts) - vb*temp31b41
        ub0(i, k, jts) = ub0(i, k, jts) + 0.5*(dvm+dvp)*temp31b41
        dvmb = temp31b42
        dvpb = temp31b42
        rvb(im, k, jts+1) = rvb(im, k, jts+1) + dvpb
        rvb(im, k, jts) = rvb(im, k, jts) - dvpb
        rvb(ip, k, jts+1) = rvb(ip, k, jts+1) + dvmb
        rvb(ip, k, jts) = rvb(ip, k, jts) - dvmb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        rvb(ip, k, jts) = rvb(ip, k, jts) + 0.5*vwb
        rvb(im, k, jts) = rvb(im, k, jts) + 0.5*vwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(im)
      ELSE
        CALL POPINTEGER4(im)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ip)
      ELSE
        CALL POPINTEGER4(ip)
      END IF
      CALL POPREAL8(mrdy)
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from46)
    CALL POPINTEGER4(ad_to46)
    DO j=ad_to46,ad_from46,-1
      DO k=ktf,kts,-1
        temp31b40 = -(rdx*tendencyb(ite, k, j))
        ubb = (u_old(ite, k, j)-u_old(ite-1, k, j))*temp31b40
        u_oldb(ite, k, j) = u_oldb(ite, k, j) + ub*temp31b40
        u_oldb(ite-1, k, j) = u_oldb(ite-1, k, j) - ub*temp31b40
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite, k, j) = rub(ite, k, j) + ubb
          mutb(ite-1, j) = mutb(ite-1, j) + cb*ubb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(j_start)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from45)
    CALL POPINTEGER4(ad_to45)
    DO j=ad_to45,ad_from45,-1
      DO k=ktf,kts,-1
        temp31b39 = -(rdx*tendencyb(its, k, j))
        ubb = (u_old(its+1, k, j)-u_old(its, k, j))*temp31b39
        u_oldb(its+1, k, j) = u_oldb(its+1, k, j) + ub*temp31b39
        u_oldb(its, k, j) = u_oldb(its, k, j) - ub*temp31b39
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + ubb
          mutb(its, j) = mutb(its, j) - cb*ubb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(j_start)
  END IF
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 3) THEN
    IF (branch .EQ. 0) THEN
      fqxb = 0.0
      CALL POPINTEGER4(ad_from44)
      CALL POPINTEGER4(ad_to44)
      DO j=ad_to44,ad_from44,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from43)
          CALL POPINTEGER4(ad_to43)
          DO i=ad_to43,ad_from43,-1
            mrdx = msfux(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
          CALL POPINTEGER4(i)
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            i = ide - 1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp31b38 = vel*fqxb(i, k)/12.0
            velb = (7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, &
&              j))*fqxb(i, k)/12.0
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b38
            ub0(i-1, k, j) = ub0(i-1, k, j) + 7.*temp31b38
            ub0(i+1, k, j) = ub0(i+1, k, j) - temp31b38
            ub0(i-2, k, j) = ub0(i-2, k, j) - temp31b38
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
            CALL POPINTEGER4(i)
          END DO
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              temp31b36 = 0.25*(u(i-1, k, j)+ub)*fqxb(i, k)
              temp31b37 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + temp31b36
              rub(i-1, k, j) = rub(i-1, k, j) + temp31b36
              ub0(i-1, k, j) = ub0(i-1, k, j) + temp31b37
              ubb = temp31b37
              fqxb(i, k) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
                ubb = 0.0
              END IF
              CALL POPREAL8(ub)
              ub0(i, k, j) = ub0(i, k, j) + ubb
            END DO
            CALL POPINTEGER4(i)
          END IF
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp31b35 = vel*fqxb(i, k)/12.0
            velb = (7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, &
&              j))*fqxb(i, k)/12.0
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b35
            ub0(i-1, k, j) = ub0(i-1, k, j) + 7.*temp31b35
            ub0(i+1, k, j) = ub0(i+1, k, j) - temp31b35
            ub0(i-2, k, j) = ub0(i-2, k, j) - temp31b35
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp31b33 = 0.25*(u(i, k, j)+ub)*fqxb(i, k)
              temp31b34 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + temp31b33
              rub(i-1, k, j) = rub(i-1, k, j) + temp31b33
              ub0(i, k, j) = ub0(i, k, j) + temp31b34
              ubb = temp31b34
              fqxb(i, k) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                ub0(i, k, j) = ub0(i, k, j) + ubb
                ubb = 0.0
              END IF
              CALL POPREAL8(ub)
              ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
            END DO
            CALL POPINTEGER4(i)
          END IF
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp31b32 = vel*fqxb(i, k)/60.0
            velb = (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))*fqxb(i, k)/60.0
            ub0(i, k, j) = ub0(i, k, j) + 37.*temp31b32
            ub0(i-1, k, j) = ub0(i-1, k, j) + 37.*temp31b32
            ub0(i+1, k, j) = ub0(i+1, k, j) - 8.*temp31b32
            ub0(i-2, k, j) = ub0(i-2, k, j) - 8.*temp31b32
            ub0(i+2, k, j) = ub0(i+2, k, j) + temp31b32
            ub0(i-3, k, j) = ub0(i-3, k, j) + temp31b32
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
        END DO
      END DO
      fqyb = 0.0
      CALL POPINTEGER4(ad_from42)
      CALL POPINTEGER4(ad_to42)
      DO j=ad_to42,ad_from42,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from39)
              CALL POPINTEGER4(ad_to39)
              DO i=ad_to39,ad_from39,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from40)
              CALL POPINTEGER4(ad_to40)
              DO i=ad_to40,ad_from40,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from41)
            CALL POPINTEGER4(ad_to41)
            DO i=ad_to41,ad_from41,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL3B(branch)
        IF (branch .LT. 3) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from34)
              CALL POPINTEGER4(ad_to34)
              DO i=ad_to34,ad_from34,-1
                vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
                temp31b25 = vel*fqyb(i, k, jp1)/60.0
                velb = (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))*fqyb(i, k, jp1&
&                  )/60.0
                ub0(i, k, j) = ub0(i, k, j) + 37.*temp31b25
                ub0(i, k, j-1) = ub0(i, k, j-1) + 37.*temp31b25
                ub0(i, k, j+1) = ub0(i, k, j+1) - 8.*temp31b25
                ub0(i, k, j-2) = ub0(i, k, j-2) - 8.*temp31b25
                ub0(i, k, j+2) = ub0(i, k, j+2) + temp31b25
                ub0(i, k, j-3) = ub0(i, k, j-3) + temp31b25
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
              END DO
            END DO
          ELSE IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from35)
              CALL POPINTEGER4(ad_to35)
              DO i=ad_to35,ad_from35,-1
                temp31b26 = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, &
&                  jp1)
                temp31b27 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, &
&                  jp1)
                rvb(i, k, j) = rvb(i, k, j) + temp31b26
                rvb(i-1, k, j) = rvb(i-1, k, j) + temp31b26
                ub0(i, k, j) = ub0(i, k, j) + temp31b27
                ub0(i, k, j-1) = ub0(i, k, j-1) + temp31b27
                fqyb(i, k, jp1) = 0.0
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from36)
              CALL POPINTEGER4(ad_to36)
              DO i=ad_to36,ad_from36,-1
                vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
                temp31b28 = vel*fqyb(i, k, jp1)/12.0
                velb = (7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k&
&                  , j-2))*fqyb(i, k, jp1)/12.0
                ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b28
                ub0(i, k, j-1) = ub0(i, k, j-1) + 7.*temp31b28
                ub0(i, k, j+1) = ub0(i, k, j+1) - temp31b28
                ub0(i, k, j-2) = ub0(i, k, j-2) - temp31b28
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 3) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from37)
            CALL POPINTEGER4(ad_to37)
            DO i=ad_to37,ad_from37,-1
              temp31b29 = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
              temp31b30 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, &
&                jp1)
              rvb(i, k, j) = rvb(i, k, j) + temp31b29
              rvb(i-1, k, j) = rvb(i-1, k, j) + temp31b29
              ub0(i, k, j) = ub0(i, k, j) + temp31b30
              ub0(i, k, j-1) = ub0(i, k, j-1) + temp31b30
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE IF (branch .EQ. 4) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from38)
            CALL POPINTEGER4(ad_to38)
            DO i=ad_to38,ad_from38,-1
              vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
              temp31b31 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              ub0(i, k, j) = ub0(i, k, j) + 7.*temp31b31
              ub0(i, k, j-1) = ub0(i, k, j-1) + 7.*temp31b31
              ub0(i, k, j+1) = ub0(i, k, j+1) - temp31b31
              ub0(i, k, j-2) = ub0(i, k, j-2) - temp31b31
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
            END DO
          END DO
        END IF
      END DO
    ELSE IF (branch .EQ. 1) THEN
      fqxb = 0.0
      CALL POPINTEGER4(ad_from9)
      CALL POPINTEGER4(ad_to9)
      DO j=ad_to9,ad_from9,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from8)
          CALL POPINTEGER4(ad_to8)
          DO i=ad_to8,ad_from8,-1
            mrdx = msfux(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
          CALL POPINTEGER4(i)
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            i = ide - 1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp19 = u(i+1, k, j) - u(i-2, k, j) - 3.*(u(i, k, j)-u(i-1&
&              , k, j))
            temp22 = SIGN(1., vel)
            temp21 = temp22/12.0
            temp20 = SIGN(1, time_step)
            temp19b1 = vel*fqxb(i, k)
            temp19b2 = temp19b1/12.0
            temp19b3 = temp20*temp21*temp19b1
            velb = ((7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k&
&              , j))/12.0+temp20*(temp21*temp19))*fqxb(i, k)
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp19b2 - 3.*temp19b3
            ub0(i-1, k, j) = ub0(i-1, k, j) + 3.*temp19b3 + 7.*temp19b2
            ub0(i+1, k, j) = ub0(i+1, k, j) + temp19b3 - temp19b2
            ub0(i-2, k, j) = ub0(i-2, k, j) - temp19b3 - temp19b2
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
            CALL POPINTEGER4(i)
          END DO
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              temp19b = 0.25*(u(i-1, k, j)+ub)*fqxb(i, k)
              temp19b0 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + temp19b
              rub(i-1, k, j) = rub(i-1, k, j) + temp19b
              ub0(i-1, k, j) = ub0(i-1, k, j) + temp19b0
              ubb = temp19b0
              fqxb(i, k) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
                ubb = 0.0
              END IF
              CALL POPREAL8(ub)
              ub0(i, k, j) = ub0(i, k, j) + ubb
            END DO
            CALL POPINTEGER4(i)
          END IF
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp15 = u(i+1, k, j) - u(i-2, k, j) - 3.*(u(i, k, j)-u(i-1&
&              , k, j))
            temp18 = SIGN(1., vel)
            temp17 = temp18/12.0
            temp16 = SIGN(1, time_step)
            temp15b1 = vel*fqxb(i, k)
            temp15b2 = temp15b1/12.0
            temp15b3 = temp16*temp17*temp15b1
            velb = ((7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k&
&              , j))/12.0+temp16*(temp17*temp15))*fqxb(i, k)
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp15b2 - 3.*temp15b3
            ub0(i-1, k, j) = ub0(i-1, k, j) + 3.*temp15b3 + 7.*temp15b2
            ub0(i+1, k, j) = ub0(i+1, k, j) + temp15b3 - temp15b2
            ub0(i-2, k, j) = ub0(i-2, k, j) - temp15b3 - temp15b2
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp15b = 0.25*(u(i, k, j)+ub)*fqxb(i, k)
              temp15b0 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + temp15b
              rub(i-1, k, j) = rub(i-1, k, j) + temp15b
              ub0(i, k, j) = ub0(i, k, j) + temp15b0
              ubb = temp15b0
              fqxb(i, k) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                ub0(i, k, j) = ub0(i, k, j) + ubb
                ubb = 0.0
              END IF
              CALL POPREAL8(ub)
              ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
            END DO
            CALL POPINTEGER4(i)
          END IF
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp11 = u(i+2, k, j) - u(i-3, k, j) + 10.*(u(i, k, j)-u(i-1&
&              , k, j)) - 5.*(u(i+1, k, j)-u(i-2, k, j))
            temp14 = SIGN(1., vel)
            temp13 = temp14/60.0
            temp12 = SIGN(1, time_step)
            temp11b = vel*fqxb(i, k)
            temp11b0 = temp11b/60.0
            temp11b1 = -(temp12*temp13*temp11b)
            velb = ((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-temp12*(temp13*&
&              temp11))*fqxb(i, k)
            ub0(i, k, j) = ub0(i, k, j) + 10.*temp11b1 + 37.*temp11b0
            ub0(i-1, k, j) = ub0(i-1, k, j) + 37.*temp11b0 - 10.*&
&              temp11b1
            ub0(i+1, k, j) = ub0(i+1, k, j) - 5.*temp11b1 - 8.*temp11b0
            ub0(i-2, k, j) = ub0(i-2, k, j) + 5.*temp11b1 - 8.*temp11b0
            ub0(i+2, k, j) = ub0(i+2, k, j) + temp11b1 + temp11b0
            ub0(i-3, k, j) = ub0(i-3, k, j) + temp11b0 - temp11b1
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
        END DO
      END DO
      fqyb = 0.0
      CALL POPINTEGER4(ad_from7)
      CALL POPINTEGER4(ad_to7)
      DO j=ad_to7,ad_from7,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from4)
              CALL POPINTEGER4(ad_to4)
              DO i=ad_to4,ad_from4,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from5)
              CALL POPINTEGER4(ad_to5)
              DO i=ad_to5,ad_from5,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from6)
            CALL POPINTEGER4(ad_to6)
            DO i=ad_to6,ad_from6,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL3B(branch)
        IF (branch .LT. 3) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from)
              CALL POPINTEGER4(ad_to)
              DO i=ad_to,ad_from,-1
                vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
                temp = u(i, k, j+2) - u(i, k, j-3) + 10.*(u(i, k, j)-u(i&
&                  , k, j-1)) - 5.*(u(i, k, j+1)-u(i, k, j-2))
                temp2 = SIGN(1., vel)
                temp1 = temp2/60.0
                temp0 = SIGN(1, time_step)
                tempb = vel*fqyb(i, k, jp1)
                tempb0 = tempb/60.0
                tempb1 = -(temp0*temp1*tempb)
                velb = ((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-temp0*(&
&                  temp1*temp))*fqyb(i, k, jp1)
                ub0(i, k, j) = ub0(i, k, j) + 10.*tempb1 + 37.*tempb0
                ub0(i, k, j-1) = ub0(i, k, j-1) + 37.*tempb0 - 10.*&
&                  tempb1
                ub0(i, k, j+1) = ub0(i, k, j+1) - 5.*tempb1 - 8.*tempb0
                ub0(i, k, j-2) = ub0(i, k, j-2) + 5.*tempb1 - 8.*tempb0
                ub0(i, k, j+2) = ub0(i, k, j+2) + tempb1 + tempb0
                ub0(i, k, j-3) = ub0(i, k, j-3) + tempb0 - tempb1
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
              END DO
            END DO
          ELSE IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from0)
              CALL POPINTEGER4(ad_to0)
              DO i=ad_to0,ad_from0,-1
                temp3b = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
                temp3b0 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, &
&                  jp1)
                rvb(i, k, j) = rvb(i, k, j) + temp3b
                rvb(i-1, k, j) = rvb(i-1, k, j) + temp3b
                ub0(i, k, j) = ub0(i, k, j) + temp3b0
                ub0(i, k, j-1) = ub0(i, k, j-1) + temp3b0
                fqyb(i, k, jp1) = 0.0
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from1)
              CALL POPINTEGER4(ad_to1)
              DO i=ad_to1,ad_from1,-1
                vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
                temp3 = u(i, k, j+1) - u(i, k, j-2) - 3.*(u(i, k, j)-u(i&
&                  , k, j-1))
                temp6 = SIGN(1., vel)
                temp5 = temp6/12.0
                temp4 = SIGN(1, time_step)
                temp3b1 = vel*fqyb(i, k, jp1)
                temp3b2 = temp3b1/12.0
                temp3b3 = temp4*temp5*temp3b1
                velb = ((7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, &
&                  k, j-2))/12.0+temp4*(temp5*temp3))*fqyb(i, k, jp1)
                ub0(i, k, j) = ub0(i, k, j) + 7.*temp3b2 - 3.*temp3b3
                ub0(i, k, j-1) = ub0(i, k, j-1) + 3.*temp3b3 + 7.*&
&                  temp3b2
                ub0(i, k, j+1) = ub0(i, k, j+1) + temp3b3 - temp3b2
                ub0(i, k, j-2) = ub0(i, k, j-2) - temp3b3 - temp3b2
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 3) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from2)
            CALL POPINTEGER4(ad_to2)
            DO i=ad_to2,ad_from2,-1
              temp7b = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
              temp7b0 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + temp7b
              rvb(i-1, k, j) = rvb(i-1, k, j) + temp7b
              ub0(i, k, j) = ub0(i, k, j) + temp7b0
              ub0(i, k, j-1) = ub0(i, k, j-1) + temp7b0
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE IF (branch .EQ. 4) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from3)
            CALL POPINTEGER4(ad_to3)
            DO i=ad_to3,ad_from3,-1
              vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
              temp7 = u(i, k, j+1) - u(i, k, j-2) - 3.*(u(i, k, j)-u(i, &
&                k, j-1))
              temp10 = SIGN(1., vel)
              temp9 = temp10/12.0
              temp8 = SIGN(1, time_step)
              temp7b1 = vel*fqyb(i, k, jp1)
              temp7b2 = temp7b1/12.0
              temp7b3 = temp8*temp9*temp7b1
              velb = ((7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k&
&                , j-2))/12.0+temp8*(temp9*temp7))*fqyb(i, k, jp1)
              ub0(i, k, j) = ub0(i, k, j) + 7.*temp7b2 - 3.*temp7b3
              ub0(i, k, j-1) = ub0(i, k, j-1) + 3.*temp7b3 + 7.*temp7b2
              ub0(i, k, j+1) = ub0(i, k, j+1) + temp7b3 - temp7b2
              ub0(i, k, j-2) = ub0(i, k, j-2) - temp7b3 - temp7b2
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
            END DO
          END DO
        END IF
      END DO
    ELSE
      fqyb = 0.0
      CALL POPINTEGER4(ad_from18)
      CALL POPINTEGER4(ad_to18)
      DO j=ad_to18,ad_from18,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from15)
              CALL POPINTEGER4(ad_to15)
              DO i=ad_to15,ad_from15,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
              CALL POPINTEGER4(i)
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from16)
              CALL POPINTEGER4(ad_to16)
              DO i=ad_to16,ad_from16,-1
                mrdy = msfux(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
              CALL POPINTEGER4(i)
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from17)
            CALL POPINTEGER4(ad_to17)
            DO i=ad_to17,ad_from17,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
            CALL POPINTEGER4(i)
          END DO
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from12)
            CALL POPINTEGER4(ad_to12)
            DO i=ad_to12,ad_from12,-1
              temp23b4 = 0.25*(u(i, k, j_start)+u(i, k, j_start-1))*fqyb&
&                (i, k, jp1)
              temp23b5 = 0.25*(rv(i, k, j_start)+rv(i-1, k, j_start))*&
&                fqyb(i, k, jp1)
              rvb(i, k, j_start) = rvb(i, k, j_start) + temp23b4
              rvb(i-1, k, j_start) = rvb(i-1, k, j_start) + temp23b4
              ub0(i, k, j_start) = ub0(i, k, j_start) + temp23b5
              ub0(i, k, j_start-1) = ub0(i, k, j_start-1) + temp23b5
              fqyb(i, k, jp1) = 0.0
            END DO
            CALL POPINTEGER4(i)
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from13)
            CALL POPINTEGER4(ad_to13)
            DO i=ad_to13,ad_from13,-1
              temp23b6 = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
              temp23b7 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, jp1&
&                )
              rvb(i, k, j) = rvb(i, k, j) + temp23b6
              rvb(i-1, k, j) = rvb(i-1, k, j) + temp23b6
              ub0(i, k, j) = ub0(i, k, j) + temp23b7
              ub0(i, k, j-1) = ub0(i, k, j-1) + temp23b7
              fqyb(i, k, jp1) = 0.0
            END DO
            CALL POPINTEGER4(i)
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from14)
            CALL POPINTEGER4(ad_to14)
            DO i=ad_to14,ad_from14,-1
              vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
              temp23b8 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              ub0(i, k, j) = ub0(i, k, j) + 7.*temp23b8
              ub0(i, k, j-1) = ub0(i, k, j-1) + 7.*temp23b8
              ub0(i, k, j+1) = ub0(i, k, j+1) - temp23b8
              ub0(i, k, j-2) = ub0(i, k, j-2) - temp23b8
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
            END DO
            CALL POPINTEGER4(i)
          END DO
        END IF
      END DO
      fqxb = 0.0
      CALL POPINTEGER4(ad_from11)
      CALL POPINTEGER4(ad_to11)
      DO j=ad_to11,ad_from11,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from10)
          CALL POPINTEGER4(ad_to10)
          DO i=ad_to10,ad_from10,-1
            mrdx = msfux(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
          CALL POPINTEGER4(i)
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            temp23b2 = 0.25*(u(i-1, k, j)+ub)*fqxb(i, k)
            temp23b3 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
            rub(i, k, j) = rub(i, k, j) + temp23b2
            rub(i-1, k, j) = rub(i-1, k, j) + temp23b2
            ub0(i-1, k, j) = ub0(i-1, k, j) + temp23b3
            ubb = temp23b3
            fqxb(i, k) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
              ubb = 0.0
            END IF
            CALL POPREAL8(ub)
            ub0(i, k, j) = ub0(i, k, j) + ubb
          END DO
          CALL POPINTEGER4(i)
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp23b0 = 0.25*(u(i, k, j)+ub)*fqxb(i, k)
            temp23b1 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
            rub(i, k, j) = rub(i, k, j) + temp23b0
            rub(i-1, k, j) = rub(i-1, k, j) + temp23b0
            ub0(i, k, j) = ub0(i, k, j) + temp23b1
            ubb = temp23b1
            fqxb(i, k) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              ub0(i, k, j) = ub0(i, k, j) + ubb
              ubb = 0.0
            END IF
            CALL POPREAL8(ub)
            ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
          END DO
          CALL POPINTEGER4(i)
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
            temp23b = vel*fqxb(i, k)/12.0
            velb = (7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, &
&              j))*fqxb(i, k)/12.0
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp23b
            ub0(i-1, k, j) = ub0(i-1, k, j) + 7.*temp23b
            ub0(i+1, k, j) = ub0(i+1, k, j) - temp23b
            ub0(i-2, k, j) = ub0(i-2, k, j) - temp23b
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
        END DO
      END DO
    END IF
  ELSE IF (branch .EQ. 3) THEN
    fqyb = 0.0
    CALL POPINTEGER4(ad_from27)
    CALL POPINTEGER4(ad_to27)
    DO j=ad_to27,ad_from27,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from24)
            CALL POPINTEGER4(ad_to24)
            DO i=ad_to24,ad_from24,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
            END DO
            CALL POPINTEGER4(i)
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from25)
            CALL POPINTEGER4(ad_to25)
            DO i=ad_to25,ad_from25,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
            CALL POPINTEGER4(i)
          END DO
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from26)
          CALL POPINTEGER4(ad_to26)
          DO i=ad_to26,ad_from26,-1
            mrdy = msfux(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
          CALL POPINTEGER4(i)
        END DO
      END IF
      CALL POPCONTROL2B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from21)
          CALL POPINTEGER4(ad_to21)
          DO i=ad_to21,ad_from21,-1
            temp27b3 = 0.25*(u(i, k, j_start)+u(i, k, j_start-1))*fqyb(i&
&              , k, jp1)
            temp27b4 = 0.25*(rv(i, k, j_start)+rv(i-1, k, j_start))*fqyb&
&              (i, k, jp1)
            rvb(i, k, j_start) = rvb(i, k, j_start) + temp27b3
            rvb(i-1, k, j_start) = rvb(i-1, k, j_start) + temp27b3
            ub0(i, k, j_start) = ub0(i, k, j_start) + temp27b4
            ub0(i, k, j_start-1) = ub0(i, k, j_start-1) + temp27b4
            fqyb(i, k, jp1) = 0.0
          END DO
          CALL POPINTEGER4(i)
        END DO
      ELSE IF (branch .EQ. 1) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from22)
          CALL POPINTEGER4(ad_to22)
          DO i=ad_to22,ad_from22,-1
            temp27b5 = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
            temp27b6 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + temp27b5
            rvb(i-1, k, j) = rvb(i-1, k, j) + temp27b5
            ub0(i, k, j) = ub0(i, k, j) + temp27b6
            ub0(i, k, j-1) = ub0(i, k, j-1) + temp27b6
            fqyb(i, k, jp1) = 0.0
          END DO
          CALL POPINTEGER4(i)
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from23)
          CALL POPINTEGER4(ad_to23)
          DO i=ad_to23,ad_from23,-1
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            temp27 = u(i, k, j+1) - u(i, k, j-2) - 3.*(u(i, k, j)-u(i, k&
&              , j-1))
            temp30 = SIGN(1., vel)
            temp29 = temp30/12.0
            temp28 = SIGN(1, time_step)
            temp27b7 = vel*fqyb(i, k, jp1)
            temp27b8 = temp27b7/12.0
            temp27b9 = temp28*temp29*temp27b7
            velb = ((7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k, j&
&              -2))/12.0+temp28*(temp29*temp27))*fqyb(i, k, jp1)
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp27b8 - 3.*temp27b9
            ub0(i, k, j-1) = ub0(i, k, j-1) + 3.*temp27b9 + 7.*temp27b8
            ub0(i, k, j+1) = ub0(i, k, j+1) + temp27b9 - temp27b8
            ub0(i, k, j-2) = ub0(i, k, j-2) - temp27b9 - temp27b8
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
          END DO
          CALL POPINTEGER4(i)
        END DO
      END IF
    END DO
    fqxb = 0.0
    CALL POPINTEGER4(ad_from20)
    CALL POPINTEGER4(ad_to20)
    DO j=ad_to20,ad_from20,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from19)
        CALL POPINTEGER4(ad_to19)
        DO i=ad_to19,ad_from19,-1
          mrdx = msfux(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        DO k=ktf,kts,-1
          temp27b1 = 0.25*(u(i-1, k, j)+ub)*fqxb(i, k)
          temp27b2 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
          rub(i, k, j) = rub(i, k, j) + temp27b1
          rub(i-1, k, j) = rub(i-1, k, j) + temp27b1
          ub0(i-1, k, j) = ub0(i-1, k, j) + temp27b2
          ubb = temp27b2
          fqxb(i, k) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i, k, j) = ub0(i, k, j) + ubb
        END DO
        CALL POPINTEGER4(i)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          temp27b = 0.25*(u(i, k, j)+ub)*fqxb(i, k)
          temp27b0 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
          rub(i, k, j) = rub(i, k, j) + temp27b
          rub(i-1, k, j) = rub(i-1, k, j) + temp27b
          ub0(i, k, j) = ub0(i, k, j) + temp27b0
          ubb = temp27b0
          fqxb(i, k) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i, k, j) = ub0(i, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
        END DO
        CALL POPINTEGER4(i)
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
          temp23 = u(i+1, k, j) - u(i-2, k, j) - 3.*(u(i, k, j)-u(i-1, k&
&            , j))
          temp26 = SIGN(1., vel)
          temp25 = temp26/12.0
          temp24 = SIGN(1, time_step)
          temp23b9 = vel*fqxb(i, k)
          temp23b10 = temp23b9/12.0
          temp23b11 = temp24*temp25*temp23b9
          velb = ((7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, j&
&            ))/12.0+temp24*(temp25*temp23))*fqxb(i, k)
          ub0(i, k, j) = ub0(i, k, j) + 7.*temp23b10 - 3.*temp23b11
          ub0(i-1, k, j) = ub0(i-1, k, j) + 3.*temp23b11 + 7.*temp23b10
          ub0(i+1, k, j) = ub0(i+1, k, j) + temp23b11 - temp23b10
          ub0(i-2, k, j) = ub0(i-2, k, j) - temp23b11 - temp23b10
          fqxb(i, k) = 0.0
          rub(i, k, j) = rub(i, k, j) + 0.5*velb
          rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
  ELSE IF (branch .EQ. 4) THEN
    CALL POPINTEGER4(ad_from33)
    CALL POPINTEGER4(ad_to33)
    DO j=ad_to33,ad_from33,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from32)
        CALL POPINTEGER4(ad_to32)
        DO i=ad_to32,ad_from32,-1
          CALL POPCONTROL2B(branch)
          IF (branch .EQ. 0) THEN
            mrdy = msfux(i, j)*rdy
            temp31b20 = -(mrdy*0.25*tendencyb(i, k, j))
            temp31b21 = (u(i, k, j+1)+u(i, k, j))*temp31b20
            temp31b22 = (rv(i, k, j+1)+rv(i-1, k, j+1))*temp31b20
            temp31b23 = -((u(i, k, j)+u(i, k, j-1))*temp31b20)
            temp31b24 = -((rv(i, k, j)+rv(i-1, k, j))*temp31b20)
            rvb(i, k, j+1) = rvb(i, k, j+1) + temp31b21
            rvb(i-1, k, j+1) = rvb(i-1, k, j+1) + temp31b21
            ub0(i, k, j+1) = ub0(i, k, j+1) + temp31b22
            ub0(i, k, j) = ub0(i, k, j) + temp31b24 + temp31b22
            rvb(i, k, j) = rvb(i, k, j) + temp31b23
            rvb(i-1, k, j) = rvb(i-1, k, j) + temp31b23
            ub0(i, k, j-1) = ub0(i, k, j-1) + temp31b24
          ELSE IF (branch .EQ. 1) THEN
            mrdy = msfux(i, j)*rdy
            temp31b17 = mrdy*0.25*tendencyb(i, k, j)
            temp31b18 = (u(i, k, j)+u(i, k, j-1))*temp31b17
            temp31b19 = (rv(i, k, j)+rv(i-1, k, j))*temp31b17
            rvb(i, k, j) = rvb(i, k, j) + temp31b18
            rvb(i-1, k, j) = rvb(i-1, k, j) + temp31b18
            ub0(i, k, j) = ub0(i, k, j) + temp31b19
            ub0(i, k, j-1) = ub0(i, k, j-1) + temp31b19
          ELSE
            mrdy = msfux(i, j)*rdy
            temp31b14 = -(mrdy*0.25*tendencyb(i, k, j))
            temp31b15 = (u(i, k, j+1)+u(i, k, j))*temp31b14
            temp31b16 = (rv(i, k, j+1)+rv(i-1, k, j+1))*temp31b14
            rvb(i, k, j+1) = rvb(i, k, j+1) + temp31b15
            rvb(i-1, k, j+1) = rvb(i-1, k, j+1) + temp31b15
            ub0(i, k, j+1) = ub0(i, k, j+1) + temp31b16
            ub0(i, k, j) = ub0(i, k, j) + temp31b16
          END IF
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from31)
      CALL POPINTEGER4(ad_to31)
      DO j=ad_to31,ad_from31,-1
        DO k=ktf,kts,-1
          i = ide - 1
          mrdx = msfux(i, j)*rdx
          temp31b9 = -(mrdx*0.25*tendencyb(i, k, j))
          temp31b10 = (ub+u(i, k, j))*temp31b9
          temp31b11 = (ru(i+1, k, j)+ru(i, k, j))*temp31b9
          temp31b12 = -((u(i, k, j)+u(i-1, k, j))*temp31b9)
          temp31b13 = -((ru(i, k, j)+ru(i-1, k, j))*temp31b9)
          rub(i+1, k, j) = rub(i+1, k, j) + temp31b10
          rub(i, k, j) = rub(i, k, j) + temp31b12 + temp31b10
          ubb = temp31b11
          ub0(i, k, j) = ub0(i, k, j) + temp31b13 + temp31b11
          rub(i-1, k, j) = rub(i-1, k, j) + temp31b12
          ub0(i-1, k, j) = ub0(i-1, k, j) + temp31b13
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i, k, j) = ub0(i, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i+1, k, j) = ub0(i+1, k, j) + ubb
        END DO
      END DO
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from30)
      CALL POPINTEGER4(ad_to30)
      DO j=ad_to30,ad_from30,-1
        DO k=ktf,kts,-1
          i = ids + 1
          mrdx = msfux(i, j)*rdx
          temp31b4 = -(mrdx*0.25*tendencyb(i, k, j))
          temp31b5 = (u(i+1, k, j)+u(i, k, j))*temp31b4
          temp31b6 = (ru(i+1, k, j)+ru(i, k, j))*temp31b4
          temp31b7 = -((u(i, k, j)+ub)*temp31b4)
          temp31b8 = -((ru(i, k, j)+ru(i-1, k, j))*temp31b4)
          rub(i+1, k, j) = rub(i+1, k, j) + temp31b5
          rub(i, k, j) = rub(i, k, j) + temp31b7 + temp31b5
          ub0(i+1, k, j) = ub0(i+1, k, j) + temp31b6
          ub0(i, k, j) = ub0(i, k, j) + temp31b8 + temp31b6
          rub(i-1, k, j) = rub(i-1, k, j) + temp31b7
          ubb = temp31b8
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i, k, j) = ub0(i, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
        END DO
      END DO
    END IF
    CALL POPINTEGER4(ad_from29)
    CALL POPINTEGER4(ad_to29)
    DO j=ad_to29,ad_from29,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from28)
        CALL POPINTEGER4(ad_to28)
        DO i=ad_to28,ad_from28,-1
          mrdx = msfux(i, j)*rdx
          temp31b = -(mrdx*0.25*tendencyb(i, k, j))
          temp31b0 = (u(i+1, k, j)+u(i, k, j))*temp31b
          temp31b1 = (ru(i+1, k, j)+ru(i, k, j))*temp31b
          temp31b2 = -((u(i, k, j)+u(i-1, k, j))*temp31b)
          temp31b3 = -((ru(i, k, j)+ru(i-1, k, j))*temp31b)
          rub(i+1, k, j) = rub(i+1, k, j) + temp31b0
          rub(i, k, j) = rub(i, k, j) + temp31b2 + temp31b0
          ub0(i+1, k, j) = ub0(i+1, k, j) + temp31b1
          ub0(i, k, j) = ub0(i, k, j) + temp31b3 + temp31b1
          rub(i-1, k, j) = rub(i-1, k, j) + temp31b2
          ub0(i-1, k, j) = ub0(i-1, k, j) + temp31b3
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_ADVECT_U

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_v in reverse (adjoint) mode:
!   gradient     of useful results: rom tendency v v_old ru rv
!                mut
!   with respect to varying inputs: rom tendency v v_old ru rv
!                mut
!   RW status of diff variables: rom:incr tendency:in-out v:incr
!                v_old:incr ru:incr rv:incr mut:incr
SUBROUTINE A_ADVECT_V(v, vb0, v_old, v_oldb, tendency, tendencyb, ru, &
&  rub, rv, rvb, rom, romb, mut, mutb, 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) :: vb0, v_oldb, rub, rvb, &
&  romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: tendencyb
  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 :: ubb, vbb, uwb, dupb, dumb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: branch
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  INTEGER :: ad_from27
  INTEGER :: ad_to27
  INTEGER :: ad_from28
  INTEGER :: ad_to28
  INTEGER :: ad_from29
  INTEGER :: ad_to29
  INTEGER :: ad_from30
  INTEGER :: ad_to30
  INTEGER :: ad_from31
  INTEGER :: ad_to31
  INTEGER :: ad_from32
  INTEGER :: ad_to32
  INTEGER :: ad_from33
  INTEGER :: ad_to33
  INTEGER :: ad_from34
  INTEGER :: ad_to34
  INTEGER :: ad_from35
  INTEGER :: ad_to35
  INTEGER :: ad_from36
  INTEGER :: ad_to36
  INTEGER :: ad_from37
  INTEGER :: ad_to37
  INTEGER :: ad_from38
  INTEGER :: ad_to38
  INTEGER :: ad_from39
  INTEGER :: ad_to39
  INTEGER :: ad_from40
  INTEGER :: ad_to40
  INTEGER :: ad_from41
  INTEGER :: ad_to41
  INTEGER :: ad_from42
  INTEGER :: ad_to42
  INTEGER :: ad_from43
  INTEGER :: ad_to43
  INTEGER :: ad_from44
  INTEGER :: ad_to44
  INTEGER :: ad_from45
  INTEGER :: ad_to45
  INTEGER :: ad_from46
  INTEGER :: ad_to46
  INTEGER :: ad_from47
  INTEGER :: ad_to47
  INTEGER :: ad_from48
  INTEGER :: ad_to48
  INTEGER :: ad_from49
  INTEGER :: ad_to49
  INTEGER :: ad_from50
  INTEGER :: ad_to50
  INTEGER :: ad_from51
  INTEGER :: ad_to51
  INTEGER :: ad_from52
  INTEGER :: ad_to52
  REAL :: temp3
  REAL :: temp29
  REAL :: temp31b43
  REAL :: temp2
  INTEGER :: temp28
  REAL :: temp31b42
  REAL :: temp1
  REAL :: temp27
  REAL :: temp31b41
  INTEGER :: temp0
  REAL :: temp26
  REAL :: temp31b40
  REAL :: temp7b
  REAL :: temp25
  INTEGER :: temp24
  REAL :: temp23
  REAL :: temp22
  REAL :: temp21
  REAL :: temp35b3
  INTEGER :: temp20
  REAL :: temp35b2
  REAL :: temp35b1
  REAL :: temp35b0
  REAL :: temp23b9
  REAL :: temp23b8
  REAL :: temp19b
  REAL :: temp23b7
  REAL :: temp23b6
  REAL :: temp27b
  REAL :: temp23b5
  REAL :: temp35b
  REAL :: tempb1
  REAL :: temp23b4
  REAL :: temp43b
  REAL :: tempb0
  REAL :: temp23b3
  REAL :: temp23b2
  REAL :: temp23b1
  REAL :: temp23b0
  REAL :: temp31b39
  REAL :: temp31b38
  REAL :: temp7b3
  REAL :: temp31b37
  REAL :: temp3b
  REAL :: temp7b2
  REAL :: temp31b36
  REAL :: temp7b1
  REAL :: temp31b35
  REAL :: temp7b0
  REAL :: temp23b15
  REAL :: temp31b34
  REAL :: temp19
  REAL :: temp23b14
  REAL :: temp31b33
  REAL :: cb
  REAL :: temp18
  REAL :: temp23b13
  REAL :: temp31b32
  REAL :: temp17
  REAL :: temp23b12
  REAL :: temp31b31
  REAL :: temp43b9
  INTEGER :: temp16
  REAL :: temp23b11
  REAL :: temp31b30
  REAL :: temp43b8
  REAL :: temp15
  REAL :: temp23b10
  REAL :: temp43b7
  REAL :: temp14
  REAL :: temp11b1
  REAL :: temp43b6
  REAL :: temp13
  REAL :: temp11b0
  REAL :: temp43b5
  INTEGER :: temp12
  REAL :: temp43b4
  REAL :: temp11
  REAL :: temp43b3
  REAL :: temp10
  REAL :: temp43b2
  REAL :: temp15b
  REAL :: temp43b1
  REAL :: temp46
  REAL :: temp23b
  REAL :: temp43b0
  REAL :: temp45
  REAL :: temp31b
  INTEGER :: temp44
  REAL :: temp43
  REAL :: temp42
  REAL :: temp19b3
  REAL :: temp31b9
  REAL :: temp41
  REAL :: temp19b2
  REAL :: temp31b8
  INTEGER :: temp40
  REAL :: temp19b1
  REAL :: temp31b7
  REAL :: temp19b0
  REAL :: temp31b6
  REAL :: temp31b5
  REAL :: temp31b4
  REAL :: temp31b3
  REAL :: tempb
  REAL :: temp31b2
  REAL :: temp31b1
  REAL :: temp31b0
  REAL :: temp31b29
  REAL :: temp31b28
  REAL :: temp31b27
  REAL :: temp31b26
  REAL :: temp31b25
  REAL :: temp31b24
  REAL :: temp31b23
  REAL :: temp31b22
  REAL :: temp31b21
  REAL :: temp11b
  REAL :: temp31b20
  REAL :: temp39b1
  REAL :: temp39b0
  REAL :: temp31b53
  REAL :: temp39
  REAL :: temp31b52
  REAL :: temp38
  REAL :: temp3b3
  REAL :: temp31b51
  REAL :: temp37
  REAL :: temp3b2
  REAL :: temp31b50
  INTEGER :: temp36
  REAL :: temp3b1
  REAL :: temp35
  REAL :: temp3b0
  REAL :: temp34
  REAL :: temp33
  INTEGER :: temp32
  REAL :: temp31
  REAL :: temp30
  REAL :: temp27b1
  REAL :: temp27b0
  REAL :: temp31b19
  REAL :: temp31b18
  REAL :: temp31b17
  REAL :: temp15b3
  REAL :: temp31b16
  REAL :: temp
  REAL :: temp15b2
  REAL :: temp31b15
  REAL :: temp15b1
  REAL :: temp31b14
  REAL :: temp47b6
  REAL :: temp15b0
  REAL :: temp31b13
  REAL :: temp43b10
  REAL :: temp47b5
  REAL :: temp9
  REAL :: temp31b12
  REAL :: temp31b49
  REAL :: temp47b4
  INTEGER :: temp8
  REAL :: temp31b11
  REAL :: temp31b48
  REAL :: temp39b
  REAL :: temp47b3
  REAL :: temp7
  REAL :: temp31b10
  REAL :: temp31b47
  REAL :: temp47b
  REAL :: temp47b2
  REAL :: temp6
  REAL :: temp31b46
  REAL :: temp47b1
  REAL :: temp5
  REAL :: temp31b45
  REAL :: temp47b0
  INTEGER :: temp4
  REAL :: temp31b44
  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
    ad_from45 = j_start
j_loop_y_flux_6:DO j=ad_from45,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts,ktf
          ad_from37 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from37)
        END DO
        CALL PUSHCONTROL3B(0)
      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
          ad_from38 = i_start
          DO i=ad_from38,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vb = v(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from38)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from39 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from39)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from40 = i_start
          DO i=ad_from40,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vb = v(i, k, j-1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from40)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from41 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from41)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from42 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from42)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from43 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from43)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          ad_from44 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from44)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_6
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from45)
!  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
    END IF
    ad_from48 = j_start
!  compute fluxes
    DO j=ad_from48,j_end
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from46 = i_start
        DO i=ad_from46,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from46)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from47 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from47)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from48)
    CALL PUSHCONTROL3B(0)
  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
    ad_from7 = j_start
j_loop_y_flux_5:DO j=ad_from7,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        DO k=kts,ktf
          ad_from = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHCONTROL3B(0)
      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
          ad_from0 = i_start
          DO i=ad_from0,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vb = v(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from0)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from1 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from2 = i_start
          DO i=ad_from2,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vb = v(i, k, j-1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from2)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from3 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from4 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from4)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from5 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from5)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          ad_from6 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from6)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from7)
!  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
    END IF
    ad_from10 = j_start
!  compute fluxes
    DO j=ad_from10,j_end
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from8 = i_start
        DO i=ad_from8,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from8)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from9 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from9)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from10)
    CALL PUSHCONTROL3B(1)
  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
!CJM May not work with tiling because defined in terms of domain dims
    IF (degrade_ys) j_start = jds + 1
    IF (degrade_ye) j_end = jde - 1
!  compute fluxes
!  specified uses upstream normal wind at boundaries
    jp0 = 1
    jp1 = 2
    ad_from17 = j_start
    DO j=ad_from17,j_end+1
      IF (j .EQ. j_start .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from11 = i_start
          DO i=ad_from11,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vb = v(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from11)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .EQ. j_end + 1 .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from12 = i_start
          DO i=ad_from12,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vb = v(i, k, j-1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from12)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
        DO k=kts,ktf
          ad_from13 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from13)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from14 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from14)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from15 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from15)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          ad_from16 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from16)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from17)
!  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
    END IF
    ad_from19 = j_start
!  compute fluxes
    DO j=ad_from19,j_end
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from18 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from18)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from19)
    CALL PUSHCONTROL3B(2)
  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
!CJM May not work with tiling because defined in terms of domain dims
    IF (degrade_ys) j_start = jds + 1
    IF (degrade_ye) j_end = jde - 1
!  compute fluxes
!  specified uses upstream normal wind at boundaries
    jp0 = 1
    jp1 = 2
    ad_from26 = j_start
    DO j=ad_from26,j_end+1
      IF (j .EQ. j_start .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from20 = i_start
          DO i=ad_from20,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j-1)
            IF (specified .AND. v(i, k, j) .LT. 0.) THEN
              vb = v(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from20)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .EQ. j_end + 1 .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from21 = i_start
          DO i=ad_from21,i_end
            CALL PUSHREAL8(vb)
            vb = v(i, k, j)
            IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
              vb = v(i, k, j-1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from21)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
        DO k=kts,ktf
          ad_from22 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from22)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from23 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from23)
        END DO
        CALL PUSHCONTROL2B(0)
      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
          ad_from24 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from24)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! Normal code
        DO k=kts,ktf
          ad_from25 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from25)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from26)
!  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
    END IF
    ad_from28 = j_start
!  compute fluxes
    DO j=ad_from28,j_end
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from27 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from27)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from28)
    CALL PUSHCONTROL3B(3)
  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
    ad_from30 = j_start
    DO j=ad_from30,j_end
      DO k=kts,ktf
        ad_from29 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from29)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from30)
! 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
          ad_from31 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from31)
        END DO
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jte .EQ. jde) THEN
        DO k=kts,ktf
          ad_from32 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from32)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE
        CALL PUSHCONTROL2B(1)
      END IF
    ELSE
      CALL PUSHCONTROL2B(2)
    END IF
!  specified uses upstream normal wind at boundaries
    IF (specified .AND. jts .LE. jds + 1) THEN
      j = jds + 1
      DO k=kts,ktf
        ad_from33 = i_start
        DO i=ad_from33,i_end
          CALL PUSHREAL8(vb)
! ADT eqn 45, 2nd term on RHS
          vb = v(i, k, j-1)
          IF (v(i, k, j) .LT. 0.) THEN
            vb = v(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from33)
      END DO
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (specified .AND. jte .GE. jde - 1) THEN
      CALL PUSHINTEGER4(j)
      j = jde - 1
      DO k=kts,ktf
        ad_from34 = i_start
        DO i=ad_from34,i_end
          CALL PUSHREAL8(vb)
! ADT eqn 45, 2nd term on RHS
          vb = v(i, k, j+1)
          IF (v(i, k, j) .GT. 0.) THEN
            vb = v(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from34)
      END DO
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    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
    ad_from36 = j_start
    CALL PUSHINTEGER4(j)
    DO j=ad_from36,j_end
      DO k=kts,ktf
        ad_from35 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from35)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from36)
    CALL PUSHCONTROL3B(4)
  ELSE
    CALL PUSHCONTROL3B(5)
  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
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
!  radiative lateral boundary condition in y for normal velocity (v)
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    CALL PUSHINTEGER4(i_start)
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    END IF
    ad_from49 = i_start
    DO i=ad_from49,i_end
      DO k=kts,ktf
        IF (rv(i, k, jts) - cb*mut(i, jts) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = rv(i, k, jts) - cb*mut(i, jts)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from49)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    CALL PUSHINTEGER4(i_start)
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    END IF
    ad_from50 = i_start
    DO i=ad_from50,i_end
      DO k=kts,ktf
        IF (rv(i, k, jte) + cb*mut(i, jte-1) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = rv(i, k, jte) + cb*mut(i, jte-1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from50)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(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
  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
    ad_from51 = j_start
    DO j=ad_from51,j_end
      CALL PUSHREAL8(mrdx)
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(its, j)*rdx
      IF (jmax .GT. j) THEN
        CALL PUSHINTEGER4(jp)
        jp = j
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jp)
        jp = jmax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jmin .LT. j - 1) THEN
        CALL PUSHINTEGER4(jm)
        jm = j - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jm)
        jm = jmin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        uw = 0.5*(ru(its, k, jp)+ru(its, k, jm))
        IF (uw .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from51)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from52 = j_start
    DO j=ad_from52,j_end
      CALL PUSHREAL8(mrdx)
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(ite-1, j)*rdx
      IF (jmax .GT. j) THEN
        CALL PUSHINTEGER4(jp)
        jp = j
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jp)
        jp = jmax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jmin .LT. j - 1) THEN
        CALL PUSHINTEGER4(jm)
        jm = j - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jm)
        jm = jmin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        uw = 0.5*(ru(ite, k, jp)+ru(ite, k, jm))
        IF (uw .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from52)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  CALL PUSHINTEGER4(i_start)
!-------------------- 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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  j_end = jte
! 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
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp31b50 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, &
&            j))
          vfluxb(i, k+1) = vfluxb(i, k+1) + temp31b50
          vfluxb(i, k) = vfluxb(i, k) - temp31b50
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp31b44 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp31b45 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp31b44
        romb(i, k, j-1) = romb(i, k, j-1) + temp31b44
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp31b45
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp31b45
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        temp31b46 = vel*vfluxb(i, k)/12.0
        velb = (7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b46
        vb0(i, k-1, j) = vb0(i, k-1, j) + 7.*temp31b46
        vb0(i, k+1, j) = vb0(i, k+1, j) - temp31b46
        vb0(i, k-2, j) = vb0(i, k-2, j) - temp31b46
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        temp31b47 = vel*vfluxb(i, k)/12.0
        velb = (7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b47
        vb0(i, k-1, j) = vb0(i, k-1, j) + 7.*temp31b47
        vb0(i, k+1, j) = vb0(i, k+1, j) - temp31b47
        vb0(i, k-2, j) = vb0(i, k-2, j) - temp31b47
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        k = kts + 1
        temp31b48 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp31b49 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp31b48
        romb(i, k, j-1) = romb(i, k, j-1) + temp31b48
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp31b49
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp31b49
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          temp31b43 = vel*vfluxb(i, k)/60.0
          velb = (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))*vfluxb(i, k)/60.0
          vb0(i, k, j) = vb0(i, k, j) + 37.*temp31b43
          vb0(i, k-1, j) = vb0(i, k-1, j) + 37.*temp31b43
          vb0(i, k+1, j) = vb0(i, k+1, j) - 8.*temp31b43
          vb0(i, k-2, j) = vb0(i, k-2, j) - 8.*temp31b43
          vb0(i, k+2, j) = vb0(i, k+2, j) + temp31b43
          vb0(i, k-3, j) = vb0(i, k-3, j) + temp31b43
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp43b1 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, j&
&            ))
          vfluxb(i, k+1) = vfluxb(i, k+1) + temp43b1
          vfluxb(i, k) = vfluxb(i, k) - temp43b1
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i, &
&          k)
        temp43b0 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b
        romb(i, k, j-1) = romb(i, k, j-1) + temp43b
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp43b0
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp43b0
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        temp39 = v(i, k+1, j) - v(i, k-2, j) - 3.*(v(i, k, j)-v(i, k-1, &
&          j))
        temp42 = SIGN(1., -vel)
        temp41 = temp42/12.0
        temp40 = SIGN(1, time_step)
        temp39b = vel*vfluxb(i, k)
        temp39b0 = temp39b/12.0
        temp39b1 = temp40*temp41*temp39b
        velb = ((7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))&
&          /12.0+temp40*(temp41*temp39))*vfluxb(i, k)
        vb0(i, k, j) = vb0(i, k, j) + 7.*temp39b0 - 3.*temp39b1
        vb0(i, k-1, j) = vb0(i, k-1, j) + 3.*temp39b1 + 7.*temp39b0
        vb0(i, k+1, j) = vb0(i, k+1, j) + temp39b1 - temp39b0
        vb0(i, k-2, j) = vb0(i, k-2, j) - temp39b1 - temp39b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        temp35 = v(i, k+1, j) - v(i, k-2, j) - 3.*(v(i, k, j)-v(i, k-1, &
&          j))
        temp38 = SIGN(1., -vel)
        temp37 = temp38/12.0
        temp36 = SIGN(1, time_step)
        temp35b = vel*vfluxb(i, k)
        temp35b0 = temp35b/12.0
        temp35b1 = temp36*temp37*temp35b
        velb = ((7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))&
&          /12.0+temp36*(temp37*temp35))*vfluxb(i, k)
        vb0(i, k, j) = vb0(i, k, j) + 7.*temp35b0 - 3.*temp35b1
        vb0(i, k-1, j) = vb0(i, k-1, j) + 3.*temp35b1 + 7.*temp35b0
        vb0(i, k+1, j) = vb0(i, k+1, j) + temp35b1 - temp35b0
        vb0(i, k-2, j) = vb0(i, k-2, j) - temp35b1 - temp35b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        k = kts + 1
        temp35b2 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp35b3 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp35b2
        romb(i, k, j-1) = romb(i, k, j-1) + temp35b2
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp35b3
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp35b3
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          temp31 = v(i, k+2, j) - v(i, k-3, j) + 10.*(v(i, k, j)-v(i, k-&
&            1, j)) - 5.*(v(i, k+1, j)-v(i, k-2, j))
          temp34 = SIGN(1., -vel)
          temp33 = temp34/60.0
          temp32 = SIGN(1, time_step)
          temp31b51 = vel*vfluxb(i, k)
          temp31b52 = temp31b51/60.0
          temp31b53 = -(temp32*temp33*temp31b51)
          velb = ((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-temp32*(temp33*&
&            temp31))*vfluxb(i, k)
          vb0(i, k, j) = vb0(i, k, j) + 10.*temp31b53 + 37.*temp31b52
          vb0(i, k-1, j) = vb0(i, k-1, j) + 37.*temp31b52 - 10.*&
&            temp31b53
          vb0(i, k+1, j) = vb0(i, k+1, j) - 5.*temp31b53 - 8.*temp31b52
          vb0(i, k-2, j) = vb0(i, k-2, j) + 5.*temp31b53 - 8.*temp31b52
          vb0(i, k+2, j) = vb0(i, k+2, j) + temp31b53 + temp31b52
          vb0(i, k-3, j) = vb0(i, k-3, j) + temp31b52 - temp31b53
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp43b7 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, j&
&            ))
          vfluxb(i, k+1) = vfluxb(i, k+1) + temp43b7
          vfluxb(i, k) = vfluxb(i, k) - temp43b7
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b3 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp43b4 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b3
        romb(i, k, j-1) = romb(i, k, j-1) + temp43b3
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp43b4
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp43b4
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp43b5 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp43b6 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp43b5
        romb(i, k, j-1) = romb(i, k, j-1) + temp43b5
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp43b6
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp43b6
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          temp43b2 = vel*vfluxb(i, k)/12.0
          velb = (7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j)&
&            )*vfluxb(i, k)/12.0
          vb0(i, k, j) = vb0(i, k, j) + 7.*temp43b2
          vb0(i, k-1, j) = vb0(i, k-1, j) + 7.*temp43b2
          vb0(i, k+1, j) = vb0(i, k+1, j) - temp43b2
          vb0(i, k-2, j) = vb0(i, k-2, j) - temp43b2
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp47b3 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, j&
&            ))
          vfluxb(i, k+1) = vfluxb(i, k+1) + temp47b3
          vfluxb(i, k) = vfluxb(i, k) - temp47b3
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp47b = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i, &
&          k)
        temp47b0 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp47b
        romb(i, k, j-1) = romb(i, k, j-1) + temp47b
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp47b0
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp47b0
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp47b1 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i&
&          , k)
        temp47b2 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp47b1
        romb(i, k, j-1) = romb(i, k, j-1) + temp47b1
        vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp47b2
        vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp47b2
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
          temp43 = v(i, k+1, j) - v(i, k-2, j) - 3.*(v(i, k, j)-v(i, k-1&
&            , j))
          temp46 = SIGN(1., -vel)
          temp45 = temp46/12.0
          temp44 = SIGN(1, time_step)
          temp43b8 = vel*vfluxb(i, k)
          temp43b9 = temp43b8/12.0
          temp43b10 = temp44*temp45*temp43b8
          velb = ((7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j&
&            ))/12.0+temp44*(temp45*temp43))*vfluxb(i, k)
          vb0(i, k, j) = vb0(i, k, j) + 7.*temp43b9 - 3.*temp43b10
          vb0(i, k-1, j) = vb0(i, k-1, j) + 3.*temp43b10 + 7.*temp43b9
          vb0(i, k+1, j) = vb0(i, k+1, j) + temp43b10 - temp43b9
          vb0(i, k-2, j) = vb0(i, k-2, j) - temp43b10 - temp43b9
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp47b6 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, j&
&            ))
          vfluxb(i, k+1) = vfluxb(i, k+1) + temp47b6
          vfluxb(i, k) = vfluxb(i, k) - temp47b6
        END DO
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          temp47b4 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(&
&            i, k)
          temp47b5 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
          romb(i, k, j) = romb(i, k, j) + temp47b4
          romb(i, k, j-1) = romb(i, k, j-1) + temp47b4
          vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp47b5
          vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp47b5
          vfluxb(i, k) = 0.0
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPINTEGER4(i_start)
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from52)
    CALL POPINTEGER4(ad_to52)
    DO j=ad_to52,ad_from52,-1
      DO k=ktf,kts,-1
        dum = ru(ite, k, jm) - ru(ite-1, k, jm)
        dup = ru(ite, k, jp) - ru(ite-1, k, jp)
        temp31b41 = -(mrdx*tendencyb(ite-1, k, j))
        temp31b42 = 0.5*v(ite-1, k, j)*temp31b41
        ubb = (v_old(ite-1, k, j)-v_old(ite-2, k, j))*temp31b41
        v_oldb(ite-1, k, j) = v_oldb(ite-1, k, j) + ub*temp31b41
        v_oldb(ite-2, k, j) = v_oldb(ite-2, k, j) - ub*temp31b41
        vb0(ite-1, k, j) = vb0(ite-1, k, j) + 0.5*(dup+dum)*temp31b41
        dupb = temp31b42
        dumb = temp31b42
        rub(ite, k, jm) = rub(ite, k, jm) + dumb
        rub(ite-1, k, jm) = rub(ite-1, k, jm) - dumb
        rub(ite, k, jp) = rub(ite, k, jp) + dupb
        rub(ite-1, k, jp) = rub(ite-1, k, jp) - dupb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        rub(ite, k, jp) = rub(ite, k, jp) + 0.5*uwb
        rub(ite, k, jm) = rub(ite, k, jm) + 0.5*uwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jm)
      ELSE
        CALL POPINTEGER4(jm)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jp)
      ELSE
        CALL POPINTEGER4(jp)
      END IF
      CALL POPREAL8(mrdx)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from51)
    CALL POPINTEGER4(ad_to51)
    DO j=ad_to51,ad_from51,-1
      DO k=ktf,kts,-1
        dum = ru(its+1, k, jm) - ru(its, k, jm)
        dup = ru(its+1, k, jp) - ru(its, k, jp)
        temp31b39 = -(mrdx*tendencyb(its, k, j))
        temp31b40 = 0.5*v(its, k, j)*temp31b39
        ubb = (v_old(its+1, k, j)-v_old(its, k, j))*temp31b39
        v_oldb(its+1, k, j) = v_oldb(its+1, k, j) + ub*temp31b39
        v_oldb(its, k, j) = v_oldb(its, k, j) - ub*temp31b39
        vb0(its, k, j) = vb0(its, k, j) + 0.5*(dup+dum)*temp31b39
        dupb = temp31b40
        dumb = temp31b40
        rub(its+1, k, jm) = rub(its+1, k, jm) + dumb
        rub(its, k, jm) = rub(its, k, jm) - dumb
        rub(its+1, k, jp) = rub(its+1, k, jp) + dupb
        rub(its, k, jp) = rub(its, k, jp) - dupb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        rub(its, k, jp) = rub(its, k, jp) + 0.5*uwb
        rub(its, k, jm) = rub(its, k, jm) + 0.5*uwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jm)
      ELSE
        CALL POPINTEGER4(jm)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jp)
      ELSE
        CALL POPINTEGER4(jp)
      END IF
      CALL POPREAL8(mrdx)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from50)
    CALL POPINTEGER4(ad_to50)
    DO i=ad_to50,ad_from50,-1
      DO k=ktf,kts,-1
        temp31b38 = -(rdy*tendencyb(i, k, jte))
        vbb = (v_old(i, k, jte)-v_old(i, k, jte-1))*temp31b38
        v_oldb(i, k, jte) = v_oldb(i, k, jte) + vb*temp31b38
        v_oldb(i, k, jte-1) = v_oldb(i, k, jte-1) - vb*temp31b38
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte) = rvb(i, k, jte) + vbb
          mutb(i, jte-1) = mutb(i, jte-1) + cb*vbb
        END IF
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(i_end)
    ELSE
      CALL POPINTEGER4(i_end)
    END IF
    CALL POPINTEGER4(i_start)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from49)
    CALL POPINTEGER4(ad_to49)
    DO i=ad_to49,ad_from49,-1
      DO k=ktf,kts,-1
        temp31b37 = -(rdy*tendencyb(i, k, jts))
        vbb = (v_old(i, k, jts+1)-v_old(i, k, jts))*temp31b37
        v_oldb(i, k, jts+1) = v_oldb(i, k, jts+1) + vb*temp31b37
        v_oldb(i, k, jts) = v_oldb(i, k, jts) - vb*temp31b37
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + vbb
          mutb(i, jts) = mutb(i, jts) - cb*vbb
        END IF
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(i_end)
    ELSE
      CALL POPINTEGER4(i_end)
    END IF
    CALL POPINTEGER4(i_start)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO i=ite,its,-1
      DO k=ktf,kts,-1
        tendencyb(i, k, jte) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO i=ite,its,-1
      DO k=ktf,kts,-1
        tendencyb(i, k, jts) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 3) THEN
    IF (branch .EQ. 0) THEN
      fqxb = 0.0
      CALL POPINTEGER4(ad_from48)
      CALL POPINTEGER4(ad_to48)
      DO j=ad_to48,ad_from48,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from47)
          CALL POPINTEGER4(ad_to47)
          DO i=ad_to47,ad_from47,-1
            mrdx = msfvy(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          CALL POPINTEGER4(ad_to46)
          DO i=ad_to46,i_end_f+1,-1
            CALL POPCONTROL1B(branch)
            IF (branch .NE. 0) THEN
              DO k=ktf,kts,-1
                vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
                temp31b36 = vel*fqxb(i, k)/12.0
                velb = (7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2&
&                  , k, j))*fqxb(i, k)/12.0
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b36
                vb0(i-1, k, j) = vb0(i-1, k, j) + 7.*temp31b36
                vb0(i+1, k, j) = vb0(i+1, k, j) - temp31b36
                vb0(i-2, k, j) = vb0(i-2, k, j) - temp31b36
                fqxb(i, k) = 0.0
                rub(i, k, j) = rub(i, k, j) + 0.5*velb
                rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
              END DO
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              DO k=ktf,kts,-1
                temp31b34 = 0.25*(v(i_end+1, k, j)+v(i_end, k, j))*fqxb(&
&                  i, k)
                temp31b35 = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))&
&                  *fqxb(i, k)
                rub(i_end+1, k, j) = rub(i_end+1, k, j) + temp31b34
                rub(i_end+1, k, j-1) = rub(i_end+1, k, j-1) + temp31b34
                vb0(i_end+1, k, j) = vb0(i_end+1, k, j) + temp31b35
                vb0(i_end, k, j) = vb0(i_end, k, j) + temp31b35
                fqxb(i, k) = 0.0
              END DO
            END IF
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from46)
          DO i=i_start_f-1,ad_from46,-1
            CALL POPCONTROL1B(branch)
            IF (branch .NE. 0) THEN
              DO k=ktf,kts,-1
                vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
                temp31b33 = vel*fqxb(i, k)/12.0
                velb = (7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2&
&                  , k, j))*fqxb(i, k)/12.0
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b33
                vb0(i-1, k, j) = vb0(i-1, k, j) + 7.*temp31b33
                vb0(i+1, k, j) = vb0(i+1, k, j) - temp31b33
                vb0(i-2, k, j) = vb0(i-2, k, j) - temp31b33
                fqxb(i, k) = 0.0
                rub(i, k, j) = rub(i, k, j) + 0.5*velb
                rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
              END DO
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              DO k=ktf,kts,-1
                temp31b31 = 0.25*(v(i, k, j)+v(i-1, k, j))*fqxb(i, k)
                temp31b32 = 0.25*(ru(i, k, j)+ru(i, k, j-1))*fqxb(i, k)
                rub(i, k, j) = rub(i, k, j) + temp31b31
                rub(i, k, j-1) = rub(i, k, j-1) + temp31b31
                vb0(i, k, j) = vb0(i, k, j) + temp31b32
                vb0(i-1, k, j) = vb0(i-1, k, j) + temp31b32
                fqxb(i, k) = 0.0
              END DO
            END IF
          END DO
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            temp31b30 = vel*fqxb(i, k)/60.0
            velb = (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))*fqxb(i, k)/60.0
            vb0(i, k, j) = vb0(i, k, j) + 37.*temp31b30
            vb0(i-1, k, j) = vb0(i-1, k, j) + 37.*temp31b30
            vb0(i+1, k, j) = vb0(i+1, k, j) - 8.*temp31b30
            vb0(i-2, k, j) = vb0(i-2, k, j) - 8.*temp31b30
            vb0(i+2, k, j) = vb0(i+2, k, j) + temp31b30
            vb0(i-3, k, j) = vb0(i-3, k, j) + temp31b30
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
          END DO
        END DO
      END DO
      fqyb = 0.0
      CALL POPINTEGER4(ad_from45)
      CALL POPINTEGER4(ad_to45)
      DO j=ad_to45,ad_from45,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from42)
              CALL POPINTEGER4(ad_to42)
              DO i=ad_to42,ad_from42,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from43)
              CALL POPINTEGER4(ad_to43)
              DO i=ad_to43,ad_from43,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from44)
            CALL POPINTEGER4(ad_to44)
            DO i=ad_to44,ad_from44,-1
              mrdy = msfvy(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL3B(branch)
        IF (branch .LT. 3) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from37)
              CALL POPINTEGER4(ad_to37)
              DO i=ad_to37,ad_from37,-1
                vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
                temp31b23 = vel*fqyb(i, k, jp1)/60.0
                velb = (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))*fqyb(i, k, jp1&
&                  )/60.0
                vb0(i, k, j) = vb0(i, k, j) + 37.*temp31b23
                vb0(i, k, j-1) = vb0(i, k, j-1) + 37.*temp31b23
                vb0(i, k, j+1) = vb0(i, k, j+1) - 8.*temp31b23
                vb0(i, k, j-2) = vb0(i, k, j-2) - 8.*temp31b23
                vb0(i, k, j+2) = vb0(i, k, j+2) + temp31b23
                vb0(i, k, j-3) = vb0(i, k, j-3) + temp31b23
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
              END DO
            END DO
          ELSE IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from38)
              CALL POPINTEGER4(ad_to38)
              DO i=ad_to38,ad_from38,-1
                temp31b24 = 0.25*(v(i, k, j)+vb)*fqyb(i, k, jp1)
                temp31b25 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, &
&                  jp1)
                rvb(i, k, j) = rvb(i, k, j) + temp31b24
                rvb(i, k, j-1) = rvb(i, k, j-1) + temp31b24
                vb0(i, k, j) = vb0(i, k, j) + temp31b25
                vbb = temp31b25
                fqyb(i, k, jp1) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  vb0(i, k, j) = vb0(i, k, j) + vbb
                  vbb = 0.0
                END IF
                CALL POPREAL8(vb)
                vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from39)
              CALL POPINTEGER4(ad_to39)
              DO i=ad_to39,ad_from39,-1
                vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
                temp31b26 = vel*fqyb(i, k, jp1)/12.0
                velb = (7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k&
&                  , j-2))*fqyb(i, k, jp1)/12.0
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b26
                vb0(i, k, j-1) = vb0(i, k, j-1) + 7.*temp31b26
                vb0(i, k, j+1) = vb0(i, k, j+1) - temp31b26
                vb0(i, k, j-2) = vb0(i, k, j-2) - temp31b26
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 3) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from40)
            CALL POPINTEGER4(ad_to40)
            DO i=ad_to40,ad_from40,-1
              temp31b27 = 0.25*(vb+v(i, k, j-1))*fqyb(i, k, jp1)
              temp31b28 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, &
&                jp1)
              rvb(i, k, j) = rvb(i, k, j) + temp31b27
              rvb(i, k, j-1) = rvb(i, k, j-1) + temp31b27
              vbb = temp31b28
              vb0(i, k, j-1) = vb0(i, k, j-1) + temp31b28
              fqyb(i, k, jp1) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
                vbb = 0.0
              END IF
              CALL POPREAL8(vb)
              vb0(i, k, j) = vb0(i, k, j) + vbb
            END DO
          END DO
        ELSE IF (branch .EQ. 4) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from41)
            CALL POPINTEGER4(ad_to41)
            DO i=ad_to41,ad_from41,-1
              vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
              temp31b29 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              vb0(i, k, j) = vb0(i, k, j) + 7.*temp31b29
              vb0(i, k, j-1) = vb0(i, k, j-1) + 7.*temp31b29
              vb0(i, k, j+1) = vb0(i, k, j+1) - temp31b29
              vb0(i, k, j-2) = vb0(i, k, j-2) - temp31b29
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
            END DO
          END DO
        END IF
      END DO
    ELSE IF (branch .EQ. 1) THEN
      fqxb = 0.0
      CALL POPINTEGER4(ad_from10)
      CALL POPINTEGER4(ad_to10)
      DO j=ad_to10,ad_from10,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from9)
          CALL POPINTEGER4(ad_to9)
          DO i=ad_to9,ad_from9,-1
            mrdx = msfvy(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          CALL POPINTEGER4(ad_to8)
          DO i=ad_to8,i_end_f+1,-1
            CALL POPCONTROL1B(branch)
            IF (branch .NE. 0) THEN
              DO k=ktf,kts,-1
                vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
                temp19 = v(i+1, k, j) - v(i-2, k, j) - 3.*(v(i, k, j)-v(&
&                  i-1, k, j))
                temp22 = SIGN(1., vel)
                temp21 = temp22/12.0
                temp20 = SIGN(1, time_step)
                temp19b1 = vel*fqxb(i, k)
                temp19b2 = temp19b1/12.0
                temp19b3 = temp20*temp21*temp19b1
                velb = ((7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2&
&                  , k, j))/12.0+temp20*(temp21*temp19))*fqxb(i, k)
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp19b2 - 3.*temp19b3
                vb0(i-1, k, j) = vb0(i-1, k, j) + 3.*temp19b3 + 7.*&
&                  temp19b2
                vb0(i+1, k, j) = vb0(i+1, k, j) + temp19b3 - temp19b2
                vb0(i-2, k, j) = vb0(i-2, k, j) - temp19b3 - temp19b2
                fqxb(i, k) = 0.0
                rub(i, k, j) = rub(i, k, j) + 0.5*velb
                rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
              END DO
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              DO k=ktf,kts,-1
                temp19b = 0.25*(v(i_end+1, k, j)+v(i_end, k, j))*fqxb(i&
&                  , k)
                temp19b0 = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*&
&                  fqxb(i, k)
                rub(i_end+1, k, j) = rub(i_end+1, k, j) + temp19b
                rub(i_end+1, k, j-1) = rub(i_end+1, k, j-1) + temp19b
                vb0(i_end+1, k, j) = vb0(i_end+1, k, j) + temp19b0
                vb0(i_end, k, j) = vb0(i_end, k, j) + temp19b0
                fqxb(i, k) = 0.0
              END DO
            END IF
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from8)
          DO i=i_start_f-1,ad_from8,-1
            CALL POPCONTROL1B(branch)
            IF (branch .NE. 0) THEN
              DO k=ktf,kts,-1
                vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
                temp15 = v(i+1, k, j) - v(i-2, k, j) - 3.*(v(i, k, j)-v(&
&                  i-1, k, j))
                temp18 = SIGN(1., vel)
                temp17 = temp18/12.0
                temp16 = SIGN(1, time_step)
                temp15b1 = vel*fqxb(i, k)
                temp15b2 = temp15b1/12.0
                temp15b3 = temp16*temp17*temp15b1
                velb = ((7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2&
&                  , k, j))/12.0+temp16*(temp17*temp15))*fqxb(i, k)
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp15b2 - 3.*temp15b3
                vb0(i-1, k, j) = vb0(i-1, k, j) + 3.*temp15b3 + 7.*&
&                  temp15b2
                vb0(i+1, k, j) = vb0(i+1, k, j) + temp15b3 - temp15b2
                vb0(i-2, k, j) = vb0(i-2, k, j) - temp15b3 - temp15b2
                fqxb(i, k) = 0.0
                rub(i, k, j) = rub(i, k, j) + 0.5*velb
                rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
              END DO
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              DO k=ktf,kts,-1
                temp15b = 0.25*(v(i, k, j)+v(i-1, k, j))*fqxb(i, k)
                temp15b0 = 0.25*(ru(i, k, j)+ru(i, k, j-1))*fqxb(i, k)
                rub(i, k, j) = rub(i, k, j) + temp15b
                rub(i, k, j-1) = rub(i, k, j-1) + temp15b
                vb0(i, k, j) = vb0(i, k, j) + temp15b0
                vb0(i-1, k, j) = vb0(i-1, k, j) + temp15b0
                fqxb(i, k) = 0.0
              END DO
            END IF
          END DO
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            temp11 = v(i+2, k, j) - v(i-3, k, j) + 10.*(v(i, k, j)-v(i-1&
&              , k, j)) - 5.*(v(i+1, k, j)-v(i-2, k, j))
            temp14 = SIGN(1., vel)
            temp13 = temp14/60.0
            temp12 = SIGN(1, time_step)
            temp11b = vel*fqxb(i, k)
            temp11b0 = temp11b/60.0
            temp11b1 = -(temp12*temp13*temp11b)
            velb = ((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-temp12*(temp13*&
&              temp11))*fqxb(i, k)
            vb0(i, k, j) = vb0(i, k, j) + 10.*temp11b1 + 37.*temp11b0
            vb0(i-1, k, j) = vb0(i-1, k, j) + 37.*temp11b0 - 10.*&
&              temp11b1
            vb0(i+1, k, j) = vb0(i+1, k, j) - 5.*temp11b1 - 8.*temp11b0
            vb0(i-2, k, j) = vb0(i-2, k, j) + 5.*temp11b1 - 8.*temp11b0
            vb0(i+2, k, j) = vb0(i+2, k, j) + temp11b1 + temp11b0
            vb0(i-3, k, j) = vb0(i-3, k, j) + temp11b0 - temp11b1
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
          END DO
        END DO
      END DO
      fqyb = 0.0
      CALL POPINTEGER4(ad_from7)
      CALL POPINTEGER4(ad_to7)
      DO j=ad_to7,ad_from7,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from4)
              CALL POPINTEGER4(ad_to4)
              DO i=ad_to4,ad_from4,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from5)
              CALL POPINTEGER4(ad_to5)
              DO i=ad_to5,ad_from5,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from6)
            CALL POPINTEGER4(ad_to6)
            DO i=ad_to6,ad_from6,-1
              mrdy = msfvy(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL3B(branch)
        IF (branch .LT. 3) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from)
              CALL POPINTEGER4(ad_to)
              DO i=ad_to,ad_from,-1
                vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
                temp = v(i, k, j+2) - v(i, k, j-3) + 10.*(v(i, k, j)-v(i&
&                  , k, j-1)) - 5.*(v(i, k, j+1)-v(i, k, j-2))
                temp2 = SIGN(1., vel)
                temp1 = temp2/60.0
                temp0 = SIGN(1, time_step)
                tempb = vel*fqyb(i, k, jp1)
                tempb0 = tempb/60.0
                tempb1 = -(temp0*temp1*tempb)
                velb = ((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-temp0*(&
&                  temp1*temp))*fqyb(i, k, jp1)
                vb0(i, k, j) = vb0(i, k, j) + 10.*tempb1 + 37.*tempb0
                vb0(i, k, j-1) = vb0(i, k, j-1) + 37.*tempb0 - 10.*&
&                  tempb1
                vb0(i, k, j+1) = vb0(i, k, j+1) - 5.*tempb1 - 8.*tempb0
                vb0(i, k, j-2) = vb0(i, k, j-2) + 5.*tempb1 - 8.*tempb0
                vb0(i, k, j+2) = vb0(i, k, j+2) + tempb1 + tempb0
                vb0(i, k, j-3) = vb0(i, k, j-3) + tempb0 - tempb1
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
              END DO
            END DO
          ELSE IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from0)
              CALL POPINTEGER4(ad_to0)
              DO i=ad_to0,ad_from0,-1
                temp3b = 0.25*(v(i, k, j)+vb)*fqyb(i, k, jp1)
                temp3b0 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, &
&                  jp1)
                rvb(i, k, j) = rvb(i, k, j) + temp3b
                rvb(i, k, j-1) = rvb(i, k, j-1) + temp3b
                vb0(i, k, j) = vb0(i, k, j) + temp3b0
                vbb = temp3b0
                fqyb(i, k, jp1) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  vb0(i, k, j) = vb0(i, k, j) + vbb
                  vbb = 0.0
                END IF
                CALL POPREAL8(vb)
                vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from1)
              CALL POPINTEGER4(ad_to1)
              DO i=ad_to1,ad_from1,-1
                vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
                temp3 = v(i, k, j+1) - v(i, k, j-2) - 3.*(v(i, k, j)-v(i&
&                  , k, j-1))
                temp6 = SIGN(1., vel)
                temp5 = temp6/12.0
                temp4 = SIGN(1, time_step)
                temp3b1 = vel*fqyb(i, k, jp1)
                temp3b2 = temp3b1/12.0
                temp3b3 = temp4*temp5*temp3b1
                velb = ((7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, &
&                  k, j-2))/12.0+temp4*(temp5*temp3))*fqyb(i, k, jp1)
                vb0(i, k, j) = vb0(i, k, j) + 7.*temp3b2 - 3.*temp3b3
                vb0(i, k, j-1) = vb0(i, k, j-1) + 3.*temp3b3 + 7.*&
&                  temp3b2
                vb0(i, k, j+1) = vb0(i, k, j+1) + temp3b3 - temp3b2
                vb0(i, k, j-2) = vb0(i, k, j-2) - temp3b3 - temp3b2
                fqyb(i, k, jp1) = 0.0
                rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
                rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 3) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from2)
            CALL POPINTEGER4(ad_to2)
            DO i=ad_to2,ad_from2,-1
              temp7b = 0.25*(vb+v(i, k, j-1))*fqyb(i, k, jp1)
              temp7b0 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + temp7b
              rvb(i, k, j-1) = rvb(i, k, j-1) + temp7b
              vbb = temp7b0
              vb0(i, k, j-1) = vb0(i, k, j-1) + temp7b0
              fqyb(i, k, jp1) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
                vbb = 0.0
              END IF
              CALL POPREAL8(vb)
              vb0(i, k, j) = vb0(i, k, j) + vbb
            END DO
          END DO
        ELSE IF (branch .EQ. 4) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from3)
            CALL POPINTEGER4(ad_to3)
            DO i=ad_to3,ad_from3,-1
              vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
              temp7 = v(i, k, j+1) - v(i, k, j-2) - 3.*(v(i, k, j)-v(i, &
&                k, j-1))
              temp10 = SIGN(1., vel)
              temp9 = temp10/12.0
              temp8 = SIGN(1, time_step)
              temp7b1 = vel*fqyb(i, k, jp1)
              temp7b2 = temp7b1/12.0
              temp7b3 = temp8*temp9*temp7b1
              velb = ((7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k&
&                , j-2))/12.0+temp8*(temp9*temp7))*fqyb(i, k, jp1)
              vb0(i, k, j) = vb0(i, k, j) + 7.*temp7b2 - 3.*temp7b3
              vb0(i, k, j-1) = vb0(i, k, j-1) + 3.*temp7b3 + 7.*temp7b2
              vb0(i, k, j+1) = vb0(i, k, j+1) + temp7b3 - temp7b2
              vb0(i, k, j-2) = vb0(i, k, j-2) - temp7b3 - temp7b2
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
            END DO
          END DO
        END IF
      END DO
    ELSE
      fqxb = 0.0
      CALL POPINTEGER4(ad_from19)
      CALL POPINTEGER4(ad_to19)
      DO j=ad_to19,ad_from19,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from18)
          CALL POPINTEGER4(ad_to18)
          DO i=ad_to18,ad_from18,-1
            mrdx = msfvy(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            temp23b7 = 0.25*(v(i_end+1, k, j)+v(i_end, k, j))*fqxb(i_end&
&              +1, k)
            temp23b8 = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*fqxb&
&              (i_end+1, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + temp23b7
            rub(i_end+1, k, j-1) = rub(i_end+1, k, j-1) + temp23b7
            vb0(i_end+1, k, j) = vb0(i_end+1, k, j) + temp23b8
            vb0(i_end, k, j) = vb0(i_end, k, j) + temp23b8
            fqxb(i_end+1, k) = 0.0
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp23b5 = 0.25*(v(i_start, k, j)+v(i_start-1, k, j))*fqxb(&
&              i_start, k)
            temp23b6 = 0.25*(ru(i_start, k, j)+ru(i_start, k, j-1))*fqxb&
&              (i_start, k)
            rub(i_start, k, j) = rub(i_start, k, j) + temp23b5
            rub(i_start, k, j-1) = rub(i_start, k, j-1) + temp23b5
            vb0(i_start, k, j) = vb0(i_start, k, j) + temp23b6
            vb0(i_start-1, k, j) = vb0(i_start-1, k, j) + temp23b6
            fqxb(i_start, k) = 0.0
          END DO
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            temp23b4 = vel*fqxb(i, k)/12.0
            velb = (7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2, k, &
&              j))*fqxb(i, k)/12.0
            vb0(i, k, j) = vb0(i, k, j) + 7.*temp23b4
            vb0(i-1, k, j) = vb0(i-1, k, j) + 7.*temp23b4
            vb0(i+1, k, j) = vb0(i+1, k, j) - temp23b4
            vb0(i-2, k, j) = vb0(i-2, k, j) - temp23b4
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
          END DO
        END DO
      END DO
      fqyb = 0.0
      CALL POPINTEGER4(ad_from17)
      CALL POPINTEGER4(ad_to17)
      DO j=ad_to17,ad_from17,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from14)
              CALL POPINTEGER4(ad_to14)
              DO i=ad_to14,ad_from14,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from15)
              CALL POPINTEGER4(ad_to15)
              DO i=ad_to15,ad_from15,-1
                tendencyb(i, k, j-1) = 0.0
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from16)
            CALL POPINTEGER4(ad_to16)
            DO i=ad_to16,ad_from16,-1
              mrdy = msfvy(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from11)
            CALL POPINTEGER4(ad_to11)
            DO i=ad_to11,ad_from11,-1
              temp23b = 0.25*(v(i, k, j)+vb)*fqyb(i, k, jp1)
              temp23b0 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1&
&                )
              rvb(i, k, j) = rvb(i, k, j) + temp23b
              rvb(i, k, j-1) = rvb(i, k, j-1) + temp23b
              vb0(i, k, j) = vb0(i, k, j) + temp23b0
              vbb = temp23b0
              fqyb(i, k, jp1) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                vb0(i, k, j) = vb0(i, k, j) + vbb
                vbb = 0.0
              END IF
              CALL POPREAL8(vb)
              vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from12)
            CALL POPINTEGER4(ad_to12)
            DO i=ad_to12,ad_from12,-1
              temp23b1 = 0.25*(vb+v(i, k, j-1))*fqyb(i, k, jp1)
              temp23b2 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1&
&                )
              rvb(i, k, j) = rvb(i, k, j) + temp23b1
              rvb(i, k, j-1) = rvb(i, k, j-1) + temp23b1
              vbb = temp23b2
              vb0(i, k, j-1) = vb0(i, k, j-1) + temp23b2
              fqyb(i, k, jp1) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
                vbb = 0.0
              END IF
              CALL POPREAL8(vb)
              vb0(i, k, j) = vb0(i, k, j) + vbb
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from13)
            CALL POPINTEGER4(ad_to13)
            DO i=ad_to13,ad_from13,-1
              vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
              temp23b3 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              vb0(i, k, j) = vb0(i, k, j) + 7.*temp23b3
              vb0(i, k, j-1) = vb0(i, k, j-1) + 7.*temp23b3
              vb0(i, k, j+1) = vb0(i, k, j+1) - temp23b3
              vb0(i, k, j-2) = vb0(i, k, j-2) - temp23b3
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
            END DO
          END DO
        END IF
      END DO
    END IF
  ELSE IF (branch .EQ. 3) THEN
    fqxb = 0.0
    CALL POPINTEGER4(ad_from28)
    CALL POPINTEGER4(ad_to28)
    DO j=ad_to28,ad_from28,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from27)
        CALL POPINTEGER4(ad_to27)
        DO i=ad_to27,ad_from27,-1
          mrdx = msfvy(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        DO k=ktf,kts,-1
          temp31b1 = 0.25*(v(i_end+1, k, j)+v(i_end, k, j))*fqxb(i_end+1&
&            , k)
          temp31b2 = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*fqxb(&
&            i_end+1, k)
          rub(i_end+1, k, j) = rub(i_end+1, k, j) + temp31b1
          rub(i_end+1, k, j-1) = rub(i_end+1, k, j-1) + temp31b1
          vb0(i_end+1, k, j) = vb0(i_end+1, k, j) + temp31b2
          vb0(i_end, k, j) = vb0(i_end, k, j) + temp31b2
          fqxb(i_end+1, k) = 0.0
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          temp31b = 0.25*(v(i_start, k, j)+v(i_start-1, k, j))*fqxb(&
&            i_start, k)
          temp31b0 = 0.25*(ru(i_start, k, j)+ru(i_start, k, j-1))*fqxb(&
&            i_start, k)
          rub(i_start, k, j) = rub(i_start, k, j) + temp31b
          rub(i_start, k, j-1) = rub(i_start, k, j-1) + temp31b
          vb0(i_start, k, j) = vb0(i_start, k, j) + temp31b0
          vb0(i_start-1, k, j) = vb0(i_start-1, k, j) + temp31b0
          fqxb(i_start, k) = 0.0
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
          temp27 = v(i+1, k, j) - v(i-2, k, j) - 3.*(v(i, k, j)-v(i-1, k&
&            , j))
          temp30 = SIGN(1., vel)
          temp29 = temp30/12.0
          temp28 = SIGN(1, time_step)
          temp27b = vel*fqxb(i, k)
          temp27b0 = temp27b/12.0
          temp27b1 = temp28*temp29*temp27b
          velb = ((7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2, k, j&
&            ))/12.0+temp28*(temp29*temp27))*fqxb(i, k)
          vb0(i, k, j) = vb0(i, k, j) + 7.*temp27b0 - 3.*temp27b1
          vb0(i-1, k, j) = vb0(i-1, k, j) + 3.*temp27b1 + 7.*temp27b0
          vb0(i+1, k, j) = vb0(i+1, k, j) + temp27b1 - temp27b0
          vb0(i-2, k, j) = vb0(i-2, k, j) - temp27b1 - temp27b0
          fqxb(i, k) = 0.0
          rub(i, k, j) = rub(i, k, j) + 0.5*velb
          rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END DO
    fqyb = 0.0
    CALL POPINTEGER4(ad_from26)
    CALL POPINTEGER4(ad_to26)
    DO j=ad_to26,ad_from26,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from23)
            CALL POPINTEGER4(ad_to23)
            DO i=ad_to23,ad_from23,-1
              tendencyb(i, k, j-1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from24)
            CALL POPINTEGER4(ad_to24)
            DO i=ad_to24,ad_from24,-1
              tendencyb(i, k, j-1) = 0.0
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from25)
          CALL POPINTEGER4(ad_to25)
          DO i=ad_to25,ad_from25,-1
            mrdy = msfvy(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
      END IF
      CALL POPCONTROL2B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from20)
          CALL POPINTEGER4(ad_to20)
          DO i=ad_to20,ad_from20,-1
            temp23b9 = 0.25*(v(i, k, j)+vb)*fqyb(i, k, jp1)
            temp23b10 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + temp23b9
            rvb(i, k, j-1) = rvb(i, k, j-1) + temp23b9
            vb0(i, k, j) = vb0(i, k, j) + temp23b10
            vbb = temp23b10
            fqyb(i, k, jp1) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              vb0(i, k, j) = vb0(i, k, j) + vbb
              vbb = 0.0
            END IF
            CALL POPREAL8(vb)
            vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
          END DO
        END DO
      ELSE IF (branch .EQ. 1) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from21)
          CALL POPINTEGER4(ad_to21)
          DO i=ad_to21,ad_from21,-1
            temp23b11 = 0.25*(vb+v(i, k, j-1))*fqyb(i, k, jp1)
            temp23b12 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + temp23b11
            rvb(i, k, j-1) = rvb(i, k, j-1) + temp23b11
            vbb = temp23b12
            vb0(i, k, j-1) = vb0(i, k, j-1) + temp23b12
            fqyb(i, k, jp1) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
              vbb = 0.0
            END IF
            CALL POPREAL8(vb)
            vb0(i, k, j) = vb0(i, k, j) + vbb
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from22)
          CALL POPINTEGER4(ad_to22)
          DO i=ad_to22,ad_from22,-1
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            temp23 = v(i, k, j+1) - v(i, k, j-2) - 3.*(v(i, k, j)-v(i, k&
&              , j-1))
            temp26 = SIGN(1., vel)
            temp25 = temp26/12.0
            temp24 = SIGN(1, time_step)
            temp23b13 = vel*fqyb(i, k, jp1)
            temp23b14 = temp23b13/12.0
            temp23b15 = temp24*temp25*temp23b13
            velb = ((7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k, j&
&              -2))/12.0+temp24*(temp25*temp23))*fqyb(i, k, jp1)
            vb0(i, k, j) = vb0(i, k, j) + 7.*temp23b14 - 3.*temp23b15
            vb0(i, k, j-1) = vb0(i, k, j-1) + 3.*temp23b15 + 7.*&
&              temp23b14
            vb0(i, k, j+1) = vb0(i, k, j+1) + temp23b15 - temp23b14
            vb0(i, k, j-2) = vb0(i, k, j-2) - temp23b15 - temp23b14
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
          END DO
        END DO
      END IF
    END DO
  ELSE IF (branch .EQ. 4) THEN
    CALL POPINTEGER4(ad_from36)
    CALL POPINTEGER4(ad_to36)
    DO j=ad_to36,ad_from36,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from35)
        CALL POPINTEGER4(ad_to35)
        DO i=ad_to35,ad_from35,-1
          mrdx = msfvy(i, j)*rdx
          temp31b18 = -(mrdx*0.25*tendencyb(i, k, j))
          temp31b19 = (v(i+1, k, j)+v(i, k, j))*temp31b18
          temp31b20 = (ru(i+1, k, j)+ru(i+1, k, j-1))*temp31b18
          temp31b21 = -((v(i, k, j)+v(i-1, k, j))*temp31b18)
          temp31b22 = -((ru(i, k, j)+ru(i, k, j-1))*temp31b18)
          rub(i+1, k, j) = rub(i+1, k, j) + temp31b19
          rub(i+1, k, j-1) = rub(i+1, k, j-1) + temp31b19
          vb0(i+1, k, j) = vb0(i+1, k, j) + temp31b20
          vb0(i, k, j) = vb0(i, k, j) + temp31b22 + temp31b20
          rub(i, k, j) = rub(i, k, j) + temp31b21
          rub(i, k, j-1) = rub(i, k, j-1) + temp31b21
          vb0(i-1, k, j) = vb0(i-1, k, j) + temp31b22
        END DO
      END DO
    END DO
    CALL POPINTEGER4(j)
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from34)
        CALL POPINTEGER4(ad_to34)
        DO i=ad_to34,ad_from34,-1
          mrdy = msfvy(i, j)*rdy
          temp31b13 = -(mrdy*0.25*tendencyb(i, k, j))
          temp31b14 = (vb+v(i, k, j))*temp31b13
          temp31b15 = (rv(i, k, j+1)+rv(i, k, j))*temp31b13
          temp31b16 = -((v(i, k, j)+v(i, k, j-1))*temp31b13)
          temp31b17 = -((rv(i, k, j)+rv(i, k, j-1))*temp31b13)
          rvb(i, k, j+1) = rvb(i, k, j+1) + temp31b14
          rvb(i, k, j) = rvb(i, k, j) + temp31b16 + temp31b14
          vbb = temp31b15
          vb0(i, k, j) = vb0(i, k, j) + temp31b17 + temp31b15
          rvb(i, k, j-1) = rvb(i, k, j-1) + temp31b16
          vb0(i, k, j-1) = vb0(i, k, j-1) + temp31b17
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            vb0(i, k, j) = vb0(i, k, j) + vbb
            vbb = 0.0
          END IF
          CALL POPREAL8(vb)
          vb0(i, k, j+1) = vb0(i, k, j+1) + vbb
        END DO
      END DO
      CALL POPINTEGER4(j)
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from33)
        CALL POPINTEGER4(ad_to33)
        DO i=ad_to33,ad_from33,-1
          mrdy = msfvy(i, j)*rdy
          temp31b8 = -(mrdy*0.25*tendencyb(i, k, j))
          temp31b9 = (v(i, k, j+1)+v(i, k, j))*temp31b8
          temp31b10 = (rv(i, k, j+1)+rv(i, k, j))*temp31b8
          temp31b11 = -((v(i, k, j)+vb)*temp31b8)
          temp31b12 = -((rv(i, k, j)+rv(i, k, j-1))*temp31b8)
          rvb(i, k, j+1) = rvb(i, k, j+1) + temp31b9
          rvb(i, k, j) = rvb(i, k, j) + temp31b11 + temp31b9
          vb0(i, k, j+1) = vb0(i, k, j+1) + temp31b10
          vb0(i, k, j) = vb0(i, k, j) + temp31b12 + temp31b10
          rvb(i, k, j-1) = rvb(i, k, j-1) + temp31b11
          vbb = temp31b12
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            vb0(i, k, j) = vb0(i, k, j) + vbb
            vbb = 0.0
          END IF
          CALL POPREAL8(vb)
          vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
        END DO
      END DO
    END IF
    CALL POPCONTROL2B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from32)
        CALL POPINTEGER4(ad_to32)
        DO i=ad_to32,ad_from32,-1
          tendencyb(i, k, jde) = 0.0
        END DO
      END DO
    ELSE IF (branch .NE. 1) THEN
      GOTO 100
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from31)
        CALL POPINTEGER4(ad_to31)
        DO i=ad_to31,ad_from31,-1
          tendencyb(i, k, jds) = 0.0
        END DO
      END DO
    END IF
 100 CALL POPINTEGER4(ad_from30)
    CALL POPINTEGER4(ad_to30)
    DO j=ad_to30,ad_from30,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from29)
        CALL POPINTEGER4(ad_to29)
        DO i=ad_to29,ad_from29,-1
          mrdy = msfvy(i, j)*rdy
          temp31b3 = -(mrdy*0.25*tendencyb(i, k, j))
          temp31b4 = (v(i, k, j+1)+v(i, k, j))*temp31b3
          temp31b5 = (rv(i, k, j+1)+rv(i, k, j))*temp31b3
          temp31b6 = -((v(i, k, j)+v(i, k, j-1))*temp31b3)
          temp31b7 = -((rv(i, k, j)+rv(i, k, j-1))*temp31b3)
          rvb(i, k, j+1) = rvb(i, k, j+1) + temp31b4
          rvb(i, k, j) = rvb(i, k, j) + temp31b6 + temp31b4
          vb0(i, k, j+1) = vb0(i, k, j+1) + temp31b5
          vb0(i, k, j) = vb0(i, k, j) + temp31b7 + temp31b5
          rvb(i, k, j-1) = rvb(i, k, j-1) + temp31b6
          vb0(i, k, j-1) = vb0(i, k, j-1) + temp31b7
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_ADVECT_V

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_scalar in reverse (adjoint) mode:
!   gradient     of useful results: rom field tendency ru rv field_old
!   with respect to varying inputs: rom field tendency ru rv field_old
!   RW status of diff variables: rom:incr field:incr tendency:in-out
!                ru:incr rv:incr field_old:incr
SUBROUTINE A_ADVECT_SCALAR(field, fieldb, field_old, field_oldb, &
&  tendency, tendencyb, ru, rub, rv, rvb, rom, romb, 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) :: fieldb, field_oldb, rub&
&  , rvb, romb
  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) :: tendencyb
  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 :: ubb, vbb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: branch
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  INTEGER :: ad_from27
  INTEGER :: ad_to27
  INTEGER :: ad_from28
  INTEGER :: ad_to28
  INTEGER :: ad_from29
  INTEGER :: ad_to29
  INTEGER :: ad_from30
  INTEGER :: ad_to30
  INTEGER :: ad_from31
  INTEGER :: ad_to31
  INTEGER :: ad_from32
  INTEGER :: ad_to32
  INTEGER :: ad_from33
  INTEGER :: ad_to33
  INTEGER :: ad_from34
  INTEGER :: ad_to34
  INTEGER :: ad_from35
  INTEGER :: ad_to35
  INTEGER :: ad_from36
  INTEGER :: ad_to36
  INTEGER :: ad_from37
  INTEGER :: ad_to37
  INTEGER :: ad_from38
  INTEGER :: ad_to38
  INTEGER :: ad_from39
  INTEGER :: ad_to39
  INTEGER :: ad_from40
  INTEGER :: ad_to40
  INTEGER :: ad_from41
  INTEGER :: ad_to41
  INTEGER :: ad_from42
  INTEGER :: ad_to42
  INTEGER :: ad_from43
  INTEGER :: ad_to43
  INTEGER :: ad_from44
  INTEGER :: ad_to44
  INTEGER :: ad_from45
  INTEGER :: ad_to45
  INTEGER :: ad_from46
  INTEGER :: ad_to46
  INTEGER :: ad_from47
  INTEGER :: ad_to47
  INTEGER :: ad_from48
  INTEGER :: ad_to48
  INTEGER :: ad_from49
  INTEGER :: ad_to49
  INTEGER :: ad_from50
  INTEGER :: ad_to50
  REAL :: temp3
  REAL :: temp29
  REAL :: temp2
  INTEGER :: temp28
  REAL :: temp1
  REAL :: temp27
  INTEGER :: temp0
  REAL :: temp26
  REAL :: temp7b
  REAL :: temp25
  INTEGER :: temp24
  REAL :: temp23
  REAL :: temp22
  REAL :: temp21
  INTEGER :: temp20
  REAL :: temp35b2
  REAL :: temp35b1
  REAL :: temp35b0
  REAL :: temp19b
  REAL :: temp23b7
  REAL :: temp23b6
  REAL :: temp27b
  REAL :: temp23b5
  REAL :: temp35b
  REAL :: tempb1
  REAL :: temp23b4
  REAL :: temp43b
  REAL :: tempb0
  REAL :: temp23b3
  REAL :: temp23b2
  REAL :: temp23b1
  REAL :: temp23b0
  REAL :: temp3b
  REAL :: temp7b2
  REAL :: temp7b1
  REAL :: temp7b0
  REAL :: temp31b34
  REAL :: temp19
  REAL :: temp31b33
  REAL :: temp18
  REAL :: temp31b32
  REAL :: temp17
  REAL :: temp31b31
  INTEGER :: temp16
  REAL :: temp31b30
  REAL :: temp15
  REAL :: temp14
  REAL :: temp11b1
  REAL :: temp13
  REAL :: temp11b0
  REAL :: temp43b5
  INTEGER :: temp12
  REAL :: temp43b4
  REAL :: temp11
  REAL :: temp43b3
  REAL :: temp10
  REAL :: temp43b2
  REAL :: temp15b
  REAL :: temp43b1
  REAL :: temp46
  REAL :: temp23b
  REAL :: temp43b0
  REAL :: temp45
  REAL :: temp31b
  INTEGER :: temp44
  REAL :: temp43
  REAL :: temp42
  REAL :: temp31b9
  REAL :: temp41
  REAL :: temp19b2
  REAL :: temp31b8
  INTEGER :: temp40
  REAL :: temp19b1
  REAL :: temp31b7
  REAL :: temp19b0
  REAL :: temp31b6
  REAL :: temp31b5
  REAL :: temp31b4
  REAL :: temp31b3
  REAL :: tempb
  REAL :: temp31b2
  REAL :: temp31b1
  REAL :: temp31b0
  REAL :: temp31b29
  REAL :: temp31b28
  REAL :: temp31b27
  REAL :: temp31b26
  REAL :: temp31b25
  REAL :: temp31b24
  REAL :: temp31b23
  REAL :: temp31b22
  REAL :: temp31b21
  REAL :: temp11b
  REAL :: temp31b20
  REAL :: temp39b1
  REAL :: temp39b0
  REAL :: temp39
  REAL :: temp38
  REAL :: temp37
  REAL :: temp3b2
  INTEGER :: temp36
  REAL :: temp3b1
  REAL :: temp35
  REAL :: temp3b0
  REAL :: temp34
  REAL :: temp27b5
  REAL :: temp33
  REAL :: temp27b4
  INTEGER :: temp32
  REAL :: temp27b3
  REAL :: temp31
  REAL :: temp27b2
  REAL :: temp30
  REAL :: temp27b1
  REAL :: temp27b0
  INTRINSIC MIN
  REAL :: temp31b19
  REAL :: temp31b18
  REAL :: temp31b17
  REAL :: temp31b16
  REAL :: temp
  REAL :: temp15b2
  REAL :: temp31b15
  REAL :: temp15b1
  REAL :: temp31b14
  REAL :: temp15b0
  REAL :: temp31b13
  REAL :: temp9
  REAL :: temp31b12
  INTEGER :: temp8
  REAL :: temp31b11
  REAL :: temp39b
  REAL :: temp7
  REAL :: temp31b10
  REAL :: temp47b
  REAL :: temp6
  REAL :: temp47b1
  REAL :: temp5
  REAL :: temp47b0
  INTEGER :: temp4
  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
    ad_from43 = j_start
j_loop_y_flux_6:DO j=ad_from43,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from35 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from35)
        END DO
        CALL PUSHCONTROL3B(0)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from36 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from36)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from37 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from37)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from38 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from38)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from39 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from39)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from40 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from40)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          ad_from41 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from41)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from42 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from42)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_6
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from43)
!  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
    END IF
    ad_from46 = j_start
!  compute fluxes
    DO j=ad_from46,j_end
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from44 = i_start
        DO i=ad_from44,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from44)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from45 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from45)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from46)
    CALL PUSHCONTROL3B(7)
  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
    ad_from7 = j_start
j_loop_y_flux_5:DO j=ad_from7,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHCONTROL3B(0)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from0 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from0)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from1 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from2 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from2)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from3 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
          ad_from4 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from4)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          ad_from5 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from5)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from6 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from6)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from7)
!  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
    END IF
    ad_from10 = j_start
!  compute fluxes
    DO j=ad_from10,j_end
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from8 = i_start
        DO i=ad_from8,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from8)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from9 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from9)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from10)
    CALL PUSHCONTROL3B(6)
  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
    END IF
    ad_from12 = j_start
!  compute fluxes
    DO j=ad_from12,j_end
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from11 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from11)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from12)
    CALL PUSHINTEGER4(i_start)
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    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
    ad_from19 = j_start
    DO j=ad_from19,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from13 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from13)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from14 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from14)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          ad_from15 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from15)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from16 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from16)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          ad_from17 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from17)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from18 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from18)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from19)
    CALL PUSHCONTROL3B(5)
  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
    END IF
    ad_from21 = j_start
!  compute fluxes
    DO j=ad_from21,j_end
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
!  x flux-divergence into tendency
      DO k=kts,ktf
        ad_from20 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from20)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from21)
    CALL PUSHINTEGER4(i_start)
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    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
    ad_from28 = j_start
    DO j=ad_from28,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        DO k=kts,ktf
          ad_from22 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from22)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        DO k=kts,ktf
          ad_from23 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from23)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
!  3rd or 4th order flux
        DO k=kts,ktf
          ad_from24 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from24)
        END DO
        CALL PUSHCONTROL2B(2)
      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
          ad_from25 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from25)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        DO k=kts,ktf
          ad_from26 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from26)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        DO k=kts,ktf
          ad_from27 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from27)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from28)
    CALL PUSHCONTROL3B(4)
  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
    ad_from30 = j_start
    DO j=ad_from30,j_end
      DO k=kts,ktf
        ad_from29 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from29)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from30)
    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
    ad_from32 = j_start
    DO j=ad_from32,j_end
      DO k=kts,ktf
        ad_from31 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from31)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from32)
! 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
          ad_from33 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from33)
        END DO
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jte .EQ. jde) THEN
        DO k=kts,ktf
          ad_from34 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from34)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE
        CALL PUSHCONTROL3B(2)
      END IF
    ELSE
      CALL PUSHCONTROL3B(1)
    END IF
  ELSE
    CALL PUSHCONTROL3B(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
  CALL PUSHINTEGER4(j_start)
  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
    ad_from47 = j_start
    DO j=ad_from47,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from47)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from48 = j_start
    DO j=ad_from48,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from48)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from49 = i_start
    DO i=ad_from49,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from49)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from50 = i_start
    DO i=ad_from50,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from50)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    CALL PUSHINTEGER4(j_end)
    j_end = jde - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(j_end)
    j_end = jte
    CALL PUSHCONTROL1B(1)
  END IF
  IF (vert_order .EQ. 6) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp31b28 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp31b28
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp31b28
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = rom(i, k, j)
        temp31b29 = vel*vfluxb(i, k)/12.0
        velb = (7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)-&
&          field(i, k-2, j))*vfluxb(i, k)/12.0
        fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b29
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + 7.*temp31b29
        fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp31b29
        fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp31b29
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + velb
        k = kts + 2
        vel = rom(i, k, j)
        temp31b30 = vel*vfluxb(i, k)/12.0
        velb = (7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)-&
&          field(i, k-2, j))*vfluxb(i, k)/12.0
        fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b30
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + 7.*temp31b30
        fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp31b30
        fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp31b30
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + velb
        k = kts + 1
        temp31b31 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp31b31
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp31b31
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = rom(i, k, j)
          temp31b27 = vel*vfluxb(i, k)/60.0
          velb = (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))*&
&            vfluxb(i, k)/60.0
          fieldb(i, k, j) = fieldb(i, k, j) + 37.*temp31b27
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 37.*temp31b27
          fieldb(i, k+1, j) = fieldb(i, k+1, j) - 8.*temp31b27
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - 8.*temp31b27
          fieldb(i, k+2, j) = fieldb(i, k+2, j) + temp31b27
          fieldb(i, k-3, j) = fieldb(i, k-3, j) + temp31b27
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b
        vfluxb(i, k) = 0.0
        k = ktf - 1
        vel = rom(i, k, j)
        temp39 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j&
&          )-field(i, k-1, j))
        temp42 = SIGN(1., -vel)
        temp41 = temp42/12.0
        temp40 = SIGN(1, time_step)
        temp39b = vel*vfluxb(i, k)
        temp39b0 = temp39b/12.0
        temp39b1 = temp40*temp41*temp39b
        velb = ((7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)-&
&          field(i, k-2, j))/12.0+temp40*(temp41*temp39))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp39b0 - 3.*temp39b1
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp39b1 + 7.*&
&          temp39b0
        fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp39b1 - temp39b0
        fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp39b1 - temp39b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + velb
        k = kts + 2
        vel = rom(i, k, j)
        temp35 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j&
&          )-field(i, k-1, j))
        temp38 = SIGN(1., -vel)
        temp37 = temp38/12.0
        temp36 = SIGN(1, time_step)
        temp35b = vel*vfluxb(i, k)
        temp35b0 = temp35b/12.0
        temp35b1 = temp36*temp37*temp35b
        velb = ((7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)-&
&          field(i, k-2, j))/12.0+temp36*(temp37*temp35))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp35b0 - 3.*temp35b1
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp35b1 + 7.*&
&          temp35b0
        fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp35b1 - temp35b0
        fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp35b1 - temp35b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + velb
        k = kts + 1
        temp35b2 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp35b2
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp35b2
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-2,kts+3,-1
        DO i=i_end,i_start,-1
          vel = rom(i, k, j)
          temp31 = field(i, k+2, j) - field(i, k-3, j) + 10.*(field(i, k&
&            , j)-field(i, k-1, j)) - 5.*(field(i, k+1, j)-field(i, k-2, &
&            j))
          temp34 = SIGN(1., -vel)
          temp33 = temp34/60.0
          temp32 = SIGN(1, time_step)
          temp31b32 = vel*vfluxb(i, k)
          temp31b33 = temp31b32/60.0
          temp31b34 = -(temp32*temp33*temp31b32)
          velb = ((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-temp32*(temp33*temp31))*vfluxb(i, k)
          fieldb(i, k, j) = fieldb(i, k, j) + 10.*temp31b34 + 37.*&
&            temp31b33
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 37.*temp31b33 - 10.*&
&            temp31b34
          fieldb(i, k+1, j) = fieldb(i, k+1, j) - 5.*temp31b34 - 8.*&
&            temp31b33
          fieldb(i, k-2, j) = fieldb(i, k-2, j) + 5.*temp31b34 - 8.*&
&            temp31b33
          fieldb(i, k+2, j) = fieldb(i, k+2, j) + temp31b34 + temp31b33
          fieldb(i, k-3, j) = fieldb(i, k-3, j) + temp31b33 - temp31b34
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp43b1 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b1
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b1
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp43b2 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b2
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b2
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = rom(i, k, j)
          temp43b0 = vel*vfluxb(i, k)/12.0
          velb = (7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)-&
&            field(i, k-2, j))*vfluxb(i, k)/12.0
          fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp43b0
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 7.*temp43b0
          fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp43b0
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp43b0
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf
        temp47b = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp47b0 = rom(i, k, j)*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*vfluxb(i, k)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b0
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b0
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+2,-1
        DO i=i_end,i_start,-1
          vel = rom(i, k, j)
          temp43 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k&
&            , j)-field(i, k-1, j))
          temp46 = SIGN(1., -vel)
          temp45 = temp46/12.0
          temp44 = SIGN(1, time_step)
          temp43b3 = vel*vfluxb(i, k)
          temp43b4 = temp43b3/12.0
          temp43b5 = temp44*temp45*temp43b3
          velb = ((7.*(field(i, k, j)+field(i, k-1, j))-field(i, k+1, j)&
&            -field(i, k-2, j))/12.0+temp44*(temp45*temp43))*vfluxb(i, k)
          fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp43b4 - 3.*temp43b5
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp43b5 + 7.*&
&            temp43b4
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp43b5 - temp43b4
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp43b5 - temp43b4
          vfluxb(i, k) = 0.0
          romb(i, k, j) = romb(i, k, j) + velb
        END DO
      END DO
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
        END DO
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          temp47b1 = rom(i, k, j)*vfluxb(i, k)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*vfluxb(i, k)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b1
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b1
          vfluxb(i, k) = 0.0
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(j_end)
  ELSE
    CALL POPINTEGER4(j_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from50)
    CALL POPINTEGER4(ad_to50)
    DO i=ad_to50,ad_from50,-1
      DO k=ktf,kts,-1
        temp31b25 = -(rdy*tendencyb(i, k, j_end))
        temp31b26 = field(i, k, j_end)*temp31b25
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*&
&          temp31b25
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*temp31b25
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&          temp31b25
        fieldb(i, k, j_end) = fieldb(i, k, j_end) + (rv(i, k, jte)-rv(i&
&          , k, jte-1))*temp31b25
        rvb(i, k, jte) = rvb(i, k, jte) + temp31b26
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - temp31b26
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
          rvb(i, k, jte) = rvb(i, k, jte) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from49)
    CALL POPINTEGER4(ad_to49)
    DO i=ad_to49,ad_from49,-1
      DO k=ktf,kts,-1
        temp31b23 = -(rdy*tendencyb(i, k, jts))
        temp31b24 = field(i, k, jts)*temp31b23
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*temp31b23
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*temp31b23
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*temp31b23
        fieldb(i, k, jts) = fieldb(i, k, jts) + (rv(i, k, jts+1)-rv(i, k&
&          , jts))*temp31b23
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + temp31b24
        rvb(i, k, jts) = rvb(i, k, jts) - temp31b24
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + 0.5*vbb
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from48)
    CALL POPINTEGER4(ad_to48)
    DO j=ad_to48,ad_from48,-1
      DO k=ktf,kts,-1
        temp31b21 = -(rdx*tendencyb(i_end, k, j))
        temp31b22 = field(i_end, k, j)*temp31b21
        ubb = (field_old(i_end, k, j)-field_old(i_end-1, k, j))*&
&          temp31b21
        field_oldb(i_end, k, j) = field_oldb(i_end, k, j) + ub*temp31b21
        field_oldb(i_end-1, k, j) = field_oldb(i_end-1, k, j) - ub*&
&          temp31b21
        fieldb(i_end, k, j) = fieldb(i_end, k, j) + (ru(ite, k, j)-ru(&
&          ite-1, k, j))*temp31b21
        rub(ite, k, j) = rub(ite, k, j) + temp31b22
        rub(ite-1, k, j) = rub(ite-1, k, j) - temp31b22
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite-1, k, j) = rub(ite-1, k, j) + 0.5*ubb
          rub(ite, k, j) = rub(ite, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from47)
    CALL POPINTEGER4(ad_to47)
    DO j=ad_to47,ad_from47,-1
      DO k=ktf,kts,-1
        temp31b19 = -(rdx*tendencyb(its, k, j))
        temp31b20 = field(its, k, j)*temp31b19
        ubb = (field_old(its+1, k, j)-field_old(its, k, j))*temp31b19
        field_oldb(its+1, k, j) = field_oldb(its+1, k, j) + ub*temp31b19
        field_oldb(its, k, j) = field_oldb(its, k, j) - ub*temp31b19
        fieldb(its, k, j) = fieldb(its, k, j) + (ru(its+1, k, j)-ru(its&
&          , k, j))*temp31b19
        rub(its+1, k, j) = rub(its+1, k, j) + temp31b20
        rub(its, k, j) = rub(its, k, j) - temp31b20
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + 0.5*ubb
          rub(its+1, k, j) = rub(its+1, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPINTEGER4(j_start)
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 4) THEN
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) GOTO 100
    ELSE
      IF (branch .NE. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from34)
          CALL POPINTEGER4(ad_to34)
          DO i=ad_to34,ad_from34,-1
            mrdy = msftx(i, jde-1)*rdy
            temp31b7 = mrdy*0.5*tendencyb(i, k, jde-1)
            temp31b8 = rv(i, k, jde-1)*temp31b7
            rvb(i, k, jde-1) = rvb(i, k, jde-1) + (field(i, k, jde-1)+&
&              field(i, k, jde-2))*temp31b7
            fieldb(i, k, jde-1) = fieldb(i, k, jde-1) + temp31b8
            fieldb(i, k, jde-2) = fieldb(i, k, jde-2) + temp31b8
          END DO
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from33)
          CALL POPINTEGER4(ad_to33)
          DO i=ad_to33,ad_from33,-1
            mrdy = msftx(i, jds)*rdy
            temp31b5 = -(mrdy*0.5*tendencyb(i, k, jds))
            temp31b6 = rv(i, k, jds+1)*temp31b5
            rvb(i, k, jds+1) = rvb(i, k, jds+1) + (field(i, k, jds+1)+&
&              field(i, k, jds))*temp31b5
            fieldb(i, k, jds+1) = fieldb(i, k, jds+1) + temp31b6
            fieldb(i, k, jds) = fieldb(i, k, jds) + temp31b6
          END DO
        END DO
      END IF
    END IF
    CALL POPINTEGER4(ad_from32)
    CALL POPINTEGER4(ad_to32)
    DO j=ad_to32,ad_from32,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from31)
        CALL POPINTEGER4(ad_to31)
        DO i=ad_to31,ad_from31,-1
          mrdy = msftx(i, j)*rdy
          temp31b2 = -(mrdy*0.5*tendencyb(i, k, j))
          temp31b3 = rv(i, k, j+1)*temp31b2
          temp31b4 = -(rv(i, k, j)*temp31b2)
          rvb(i, k, j+1) = rvb(i, k, j+1) + (field(i, k, j+1)+field(i, k&
&            , j))*temp31b2
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp31b3
          fieldb(i, k, j) = fieldb(i, k, j) + temp31b4 + temp31b3
          rvb(i, k, j) = rvb(i, k, j) - (field(i, k, j)+field(i, k, j-1)&
&            )*temp31b2
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b4
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_from30)
    CALL POPINTEGER4(ad_to30)
    DO j=ad_to30,ad_from30,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from29)
        CALL POPINTEGER4(ad_to29)
        DO i=ad_to29,ad_from29,-1
          mrdx = msftx(i, j)*rdx
          temp31b = -(mrdx*0.5*tendencyb(i, k, j))
          temp31b0 = ru(i+1, k, j)*temp31b
          temp31b1 = -(ru(i, k, j)*temp31b)
          rub(i+1, k, j) = rub(i+1, k, j) + (field(i+1, k, j)+field(i, k&
&            , j))*temp31b
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp31b0
          fieldb(i, k, j) = fieldb(i, k, j) + temp31b1 + temp31b0
          rub(i, k, j) = rub(i, k, j) - (field(i, k, j)+field(i-1, k, j)&
&            )*temp31b
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b1
        END DO
      END DO
    END DO
  ELSE IF (branch .LT. 6) THEN
    IF (branch .EQ. 4) THEN
      fqyb = 0.0
      CALL POPINTEGER4(ad_from28)
      CALL POPINTEGER4(ad_to28)
      DO j=ad_to28,ad_from28,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from25)
              CALL POPINTEGER4(ad_to25)
              DO i=ad_to25,ad_from25,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from26)
              CALL POPINTEGER4(ad_to26)
              DO i=ad_to26,ad_from26,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from27)
            CALL POPINTEGER4(ad_to27)
            DO i=ad_to27,ad_from27,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from22)
            CALL POPINTEGER4(ad_to22)
            DO i=ad_to22,ad_from22,-1
              temp27b1 = 0.5*rv(i, k, j_start)*fqyb(i, k, jp1)
              rvb(i, k, j_start) = rvb(i, k, j_start) + 0.5*(field(i, k&
&                , j_start)+field(i, k, j_start-1))*fqyb(i, k, jp1)
              fieldb(i, k, j_start) = fieldb(i, k, j_start) + temp27b1
              fieldb(i, k, j_start-1) = fieldb(i, k, j_start-1) + &
&                temp27b1
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from23)
            CALL POPINTEGER4(ad_to23)
            DO i=ad_to23,ad_from23,-1
              temp27b2 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + temp27b2
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp27b2
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from24)
            CALL POPINTEGER4(ad_to24)
            DO i=ad_to24,ad_from24,-1
              temp27 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i&
&                , k, j)-field(i, k, j-1))
              temp30 = SIGN(1., rv(i, k, j))
              temp29 = temp30/12.0
              temp28 = SIGN(1, time_step)
              temp27b3 = rv(i, k, j)*fqyb(i, k, jp1)
              temp27b4 = temp27b3/12.0
              temp27b5 = temp28*temp29*temp27b3
              rvb(i, k, j) = rvb(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+&
&                temp28*(temp29*temp27))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp27b4 - 3.*&
&                temp27b5
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp27b5 + 7.*&
&                temp27b4
              fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp27b5 - &
&                temp27b4
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp27b5 - &
&                temp27b4
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        END IF
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(i_end)
      ELSE
        CALL POPINTEGER4(i_end)
      END IF
      CALL POPINTEGER4(i_start)
      fqxb = 0.0
      CALL POPINTEGER4(ad_from21)
      CALL POPINTEGER4(ad_to21)
      DO j=ad_to21,ad_from21,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from20)
          CALL POPINTEGER4(ad_to20)
          DO i=ad_to20,ad_from20,-1
            mrdx = msftx(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            temp27b0 = 0.5*ru(i_end+1, k, j)*fqxb(i_end+1, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + 0.5*(field(i_end+1&
&              , k, j)+field(i_end, k, j))*fqxb(i_end+1, k)
            fieldb(i_end+1, k, j) = fieldb(i_end+1, k, j) + temp27b0
            fieldb(i_end, k, j) = fieldb(i_end, k, j) + temp27b0
            fqxb(i_end+1, k) = 0.0
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp27b = 0.5*ru(i_start, k, j)*fqxb(i_start, k)
            rub(i_start, k, j) = rub(i_start, k, j) + 0.5*(field(i_start&
&              , k, j)+field(i_start-1, k, j))*fqxb(i_start, k)
            fieldb(i_start, k, j) = fieldb(i_start, k, j) + temp27b
            fieldb(i_start-1, k, j) = fieldb(i_start-1, k, j) + temp27b
            fqxb(i_start, k) = 0.0
          END DO
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            temp23 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i, &
&              k, j)-field(i-1, k, j))
            temp26 = SIGN(1., ru(i, k, j))
            temp25 = temp26/12.0
            temp24 = SIGN(1, time_step)
            temp23b5 = ru(i, k, j)*fqxb(i, k)
            temp23b6 = temp23b5/12.0
            temp23b7 = temp24*temp25*temp23b5
            rub(i, k, j) = rub(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+temp24*(&
&              temp25*temp23))*fqxb(i, k)
            fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp23b6 - 3.*&
&              temp23b7
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp23b7 + 7.*&
&              temp23b6
            fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp23b7 - temp23b6
            fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp23b7 - temp23b6
            fqxb(i, k) = 0.0
          END DO
        END DO
      END DO
    ELSE
      fqyb = 0.0
      CALL POPINTEGER4(ad_from19)
      CALL POPINTEGER4(ad_to19)
      DO j=ad_to19,ad_from19,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from16)
              CALL POPINTEGER4(ad_to16)
              DO i=ad_to16,ad_from16,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from17)
              CALL POPINTEGER4(ad_to17)
              DO i=ad_to17,ad_from17,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from18)
            CALL POPINTEGER4(ad_to18)
            DO i=ad_to18,ad_from18,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from13)
            CALL POPINTEGER4(ad_to13)
            DO i=ad_to13,ad_from13,-1
              temp23b2 = 0.5*rv(i, k, j_start)*fqyb(i, k, jp1)
              rvb(i, k, j_start) = rvb(i, k, j_start) + 0.5*(field(i, k&
&                , j_start)+field(i, k, j_start-1))*fqyb(i, k, jp1)
              fieldb(i, k, j_start) = fieldb(i, k, j_start) + temp23b2
              fieldb(i, k, j_start-1) = fieldb(i, k, j_start-1) + &
&                temp23b2
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from14)
            CALL POPINTEGER4(ad_to14)
            DO i=ad_to14,ad_from14,-1
              temp23b3 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + temp23b3
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp23b3
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from15)
            CALL POPINTEGER4(ad_to15)
            DO i=ad_to15,ad_from15,-1
              temp23b4 = rv(i, k, j)*fqyb(i, k, jp1)/12.0
              rvb(i, k, j) = rvb(i, k, j) + (7.*(field(i, k, j)+field(i&
&                , k, j-1))-field(i, k, j+1)-field(i, k, j-2))*fqyb(i, k&
&                , jp1)/12.0
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp23b4
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 7.*temp23b4
              fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp23b4
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp23b4
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        END IF
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(i_end)
      ELSE
        CALL POPINTEGER4(i_end)
      END IF
      CALL POPINTEGER4(i_start)
      fqxb = 0.0
      CALL POPINTEGER4(ad_from12)
      CALL POPINTEGER4(ad_to12)
      DO j=ad_to12,ad_from12,-1
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from11)
          CALL POPINTEGER4(ad_to11)
          DO i=ad_to11,ad_from11,-1
            mrdx = msftx(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            temp23b1 = 0.5*ru(i_end+1, k, j)*fqxb(i_end+1, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + 0.5*(field(i_end+1&
&              , k, j)+field(i_end, k, j))*fqxb(i_end+1, k)
            fieldb(i_end+1, k, j) = fieldb(i_end+1, k, j) + temp23b1
            fieldb(i_end, k, j) = fieldb(i_end, k, j) + temp23b1
            fqxb(i_end+1, k) = 0.0
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp23b0 = 0.5*ru(i_start, k, j)*fqxb(i_start, k)
            rub(i_start, k, j) = rub(i_start, k, j) + 0.5*(field(i_start&
&              , k, j)+field(i_start-1, k, j))*fqxb(i_start, k)
            fieldb(i_start, k, j) = fieldb(i_start, k, j) + temp23b0
            fieldb(i_start-1, k, j) = fieldb(i_start-1, k, j) + temp23b0
            fqxb(i_start, k) = 0.0
          END DO
        END IF
        DO k=ktf,kts,-1
          DO i=i_end_f,i_start_f,-1
            temp23b = ru(i, k, j)*fqxb(i, k)/12.0
            rub(i, k, j) = rub(i, k, j) + (7.*(field(i, k, j)+field(i-1&
&              , k, j))-field(i+1, k, j)-field(i-2, k, j))*fqxb(i, k)/&
&              12.0
            fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp23b
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + 7.*temp23b
            fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp23b
            fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp23b
            fqxb(i, k) = 0.0
          END DO
        END DO
      END DO
    END IF
  ELSE IF (branch .EQ. 6) THEN
    fqxb = 0.0
    CALL POPINTEGER4(ad_from10)
    CALL POPINTEGER4(ad_to10)
    DO j=ad_to10,ad_from10,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from9)
        CALL POPINTEGER4(ad_to9)
        DO i=ad_to9,ad_from9,-1
          mrdx = msftx(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to8)
        DO i=ad_to8,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp19 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&                , k, j)-field(i-1, k, j))
              temp22 = SIGN(1., vel)
              temp21 = temp22/12.0
              temp20 = SIGN(1, time_step)
              temp19b0 = vel*fqxb(i, k)
              temp19b1 = temp19b0/12.0
              temp19b2 = temp20*temp21*temp19b0
              velb = ((7.*(field(i, k, j)+field(i-1, k, j))-field(i+1, k&
&                , j)-field(i-2, k, j))/12.0+temp20*(temp21*temp19))*fqxb&
&                (i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp19b1 - 3.*&
&                temp19b2
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp19b2 + 7.*&
&                temp19b1
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp19b2 - &
&                temp19b1
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp19b2 - &
&                temp19b1
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp19b = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + temp19b
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp19b
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from8)
        DO i=i_start_f-1,ad_from8,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp15 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&                , k, j)-field(i-1, k, j))
              temp18 = SIGN(1., vel)
              temp17 = temp18/12.0
              temp16 = SIGN(1, time_step)
              temp15b0 = vel*fqxb(i, k)
              temp15b1 = temp15b0/12.0
              temp15b2 = temp16*temp17*temp15b0
              velb = ((7.*(field(i, k, j)+field(i-1, k, j))-field(i+1, k&
&                , j)-field(i-2, k, j))/12.0+temp16*(temp17*temp15))*fqxb&
&                (i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp15b1 - 3.*&
&                temp15b2
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp15b2 + 7.*&
&                temp15b1
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp15b2 - &
&                temp15b1
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp15b2 - &
&                temp15b1
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp15b = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + temp15b
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp15b
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          vel = ru(i, k, j)
          temp11 = field(i+2, k, j) - field(i-3, k, j) + 10.*(field(i, k&
&            , j)-field(i-1, k, j)) - 5.*(field(i+1, k, j)-field(i-2, k, &
&            j))
          temp14 = SIGN(1., vel)
          temp13 = temp14/60.0
          temp12 = SIGN(1, time_step)
          temp11b = vel*fqxb(i, k)
          temp11b0 = temp11b/60.0
          temp11b1 = -(temp12*temp13*temp11b)
          velb = ((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-temp12*(temp13*temp11))*fqxb(i, k)
          fieldb(i, k, j) = fieldb(i, k, j) + 10.*temp11b1 + 37.*&
&            temp11b0
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + 37.*temp11b0 - 10.*&
&            temp11b1
          fieldb(i+1, k, j) = fieldb(i+1, k, j) - 5.*temp11b1 - 8.*&
&            temp11b0
          fieldb(i-2, k, j) = fieldb(i-2, k, j) + 5.*temp11b1 - 8.*&
&            temp11b0
          fieldb(i+2, k, j) = fieldb(i+2, k, j) + temp11b1 + temp11b0
          fieldb(i-3, k, j) = fieldb(i-3, k, j) + temp11b0 - temp11b1
          fqxb(i, k) = 0.0
          rub(i, k, j) = rub(i, k, j) + velb
        END DO
      END DO
    END DO
    fqyb = 0.0
    CALL POPINTEGER4(ad_from7)
    CALL POPINTEGER4(ad_to7)
    DO j=ad_to7,ad_from7,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from4)
            CALL POPINTEGER4(ad_to4)
            DO i=ad_to4,ad_from4,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from5)
            CALL POPINTEGER4(ad_to5)
            DO i=ad_to5,ad_from5,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from6)
          CALL POPINTEGER4(ad_to6)
          DO i=ad_to6,ad_from6,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
      END IF
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from)
            CALL POPINTEGER4(ad_to)
            DO i=ad_to,ad_from,-1
              vel = rv(i, k, j)
              temp = field(i, k, j+2) - field(i, k, j-3) + 10.*(field(i&
&                , k, j)-field(i, k, j-1)) - 5.*(field(i, k, j+1)-field(i&
&                , k, j-2))
              temp2 = SIGN(1., vel)
              temp1 = temp2/60.0
              temp0 = SIGN(1, time_step)
              tempb = vel*fqyb(i, k, jp1)
              tempb0 = tempb/60.0
              tempb1 = -(temp0*temp1*tempb)
              velb = ((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-temp0*(temp1*temp))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + 10.*tempb1 + 37.*&
&                tempb0
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 37.*tempb0 - 10.*&
&                tempb1
              fieldb(i, k, j+1) = fieldb(i, k, j+1) - 5.*tempb1 - 8.*&
&                tempb0
              fieldb(i, k, j-2) = fieldb(i, k, j-2) + 5.*tempb1 - 8.*&
&                tempb0
              fieldb(i, k, j+2) = fieldb(i, k, j+2) + tempb1 + tempb0
              fieldb(i, k, j-3) = fieldb(i, k, j-3) + tempb0 - tempb1
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + velb
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from0)
            CALL POPINTEGER4(ad_to0)
            DO i=ad_to0,ad_from0,-1
              temp3b = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + temp3b
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp3b
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from1)
            CALL POPINTEGER4(ad_to1)
            DO i=ad_to1,ad_from1,-1
              vel = rv(i, k, j)
              temp3 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i&
&                , k, j)-field(i, k, j-1))
              temp6 = SIGN(1., vel)
              temp5 = temp6/12.0
              temp4 = SIGN(1, time_step)
              temp3b0 = vel*fqyb(i, k, jp1)
              temp3b1 = temp3b0/12.0
              temp3b2 = temp4*temp5*temp3b0
              velb = ((7.*(field(i, k, j)+field(i, k, j-1))-field(i, k, &
&                j+1)-field(i, k, j-2))/12.0+temp4*(temp5*temp3))*fqyb(i&
&                , k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp3b1 - 3.*&
&                temp3b2
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp3b2 + 7.*&
&                temp3b1
              fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp3b2 - temp3b1
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp3b2 - temp3b1
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + velb
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 3) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from2)
          CALL POPINTEGER4(ad_to2)
          DO i=ad_to2,ad_from2,-1
            temp7b = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&              , j-1))*fqyb(i, k, jp1)
            fieldb(i, k, j) = fieldb(i, k, j) + temp7b
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp7b
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
      ELSE IF (branch .EQ. 4) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from3)
          CALL POPINTEGER4(ad_to3)
          DO i=ad_to3,ad_from3,-1
            vel = rv(i, k, j)
            temp7 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i, k&
&              , j)-field(i, k, j-1))
            temp10 = SIGN(1., vel)
            temp9 = temp10/12.0
            temp8 = SIGN(1, time_step)
            temp7b0 = vel*fqyb(i, k, jp1)
            temp7b1 = temp7b0/12.0
            temp7b2 = temp8*temp9*temp7b0
            velb = ((7.*(field(i, k, j)+field(i, k, j-1))-field(i, k, j+&
&              1)-field(i, k, j-2))/12.0+temp8*(temp9*temp7))*fqyb(i, k, &
&              jp1)
            fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp7b1 - 3.*temp7b2
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp7b2 + 7.*&
&              temp7b1
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp7b2 - temp7b1
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp7b2 - temp7b1
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + velb
          END DO
        END DO
      END IF
    END DO
  ELSE
    fqxb = 0.0
    CALL POPINTEGER4(ad_from46)
    CALL POPINTEGER4(ad_to46)
    DO j=ad_to46,ad_from46,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from45)
        CALL POPINTEGER4(ad_to45)
        DO i=ad_to45,ad_from45,-1
          mrdx = msftx(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to44)
        DO i=ad_to44,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp31b18 = vel*fqxb(i, k)/12.0
              velb = (7.*(field(i, k, j)+field(i-1, k, j))-field(i+1, k&
&                , j)-field(i-2, k, j))*fqxb(i, k)/12.0
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b18
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 7.*temp31b18
              fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp31b18
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp31b18
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp31b17 = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b17
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b17
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from44)
        DO i=i_start_f-1,ad_from44,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp31b16 = vel*fqxb(i, k)/12.0
              velb = (7.*(field(i, k, j)+field(i-1, k, j))-field(i+1, k&
&                , j)-field(i-2, k, j))*fqxb(i, k)/12.0
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b16
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 7.*temp31b16
              fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp31b16
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp31b16
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              temp31b15 = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b15
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b15
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          vel = ru(i, k, j)
          temp31b14 = vel*fqxb(i, k)/60.0
          velb = (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))*&
&            fqxb(i, k)/60.0
          fieldb(i, k, j) = fieldb(i, k, j) + 37.*temp31b14
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + 37.*temp31b14
          fieldb(i+1, k, j) = fieldb(i+1, k, j) - 8.*temp31b14
          fieldb(i-2, k, j) = fieldb(i-2, k, j) - 8.*temp31b14
          fieldb(i+2, k, j) = fieldb(i+2, k, j) + temp31b14
          fieldb(i-3, k, j) = fieldb(i-3, k, j) + temp31b14
          fqxb(i, k) = 0.0
          rub(i, k, j) = rub(i, k, j) + velb
        END DO
      END DO
    END DO
    fqyb = 0.0
    CALL POPINTEGER4(ad_from43)
    CALL POPINTEGER4(ad_to43)
    DO j=ad_to43,ad_from43,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from40)
            CALL POPINTEGER4(ad_to40)
            DO i=ad_to40,ad_from40,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from41)
            CALL POPINTEGER4(ad_to41)
            DO i=ad_to41,ad_from41,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from42)
          CALL POPINTEGER4(ad_to42)
          DO i=ad_to42,ad_from42,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
      END IF
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from35)
            CALL POPINTEGER4(ad_to35)
            DO i=ad_to35,ad_from35,-1
              vel = rv(i, k, j)
              temp31b9 = vel*fqyb(i, k, jp1)/60.0
              velb = (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))*fqyb(i, k, jp1)/60.0
              fieldb(i, k, j) = fieldb(i, k, j) + 37.*temp31b9
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 37.*temp31b9
              fieldb(i, k, j+1) = fieldb(i, k, j+1) - 8.*temp31b9
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - 8.*temp31b9
              fieldb(i, k, j+2) = fieldb(i, k, j+2) + temp31b9
              fieldb(i, k, j-3) = fieldb(i, k, j-3) + temp31b9
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + velb
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from36)
            CALL POPINTEGER4(ad_to36)
            DO i=ad_to36,ad_from36,-1
              temp31b10 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b10
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b10
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from37)
            CALL POPINTEGER4(ad_to37)
            DO i=ad_to37,ad_from37,-1
              vel = rv(i, k, j)
              temp31b11 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(field(i, k, j)+field(i, k, j-1))-field(i, k, j&
&                +1)-field(i, k, j-2))*fqyb(i, k, jp1)/12.0
              fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b11
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 7.*temp31b11
              fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp31b11
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp31b11
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + velb
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 3) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from38)
          CALL POPINTEGER4(ad_to38)
          DO i=ad_to38,ad_from38,-1
            temp31b12 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&              , j-1))*fqyb(i, k, jp1)
            fieldb(i, k, j) = fieldb(i, k, j) + temp31b12
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b12
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
      ELSE IF (branch .EQ. 4) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from39)
          CALL POPINTEGER4(ad_to39)
          DO i=ad_to39,ad_from39,-1
            vel = rv(i, k, j)
            temp31b13 = vel*fqyb(i, k, jp1)/12.0
            velb = (7.*(field(i, k, j)+field(i, k, j-1))-field(i, k, j+1&
&              )-field(i, k, j-2))*fqyb(i, k, jp1)/12.0
            fieldb(i, k, j) = fieldb(i, k, j) + 7.*temp31b13
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + 7.*temp31b13
            fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp31b13
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp31b13
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + velb
          END DO
        END DO
      END IF
    END DO
  END IF
 100 CONTINUE
END SUBROUTINE A_ADVECT_SCALAR

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_w in reverse (adjoint) mode:
!   gradient     of useful results: rom tendency w ru rv w_old
!   with respect to varying inputs: rom tendency w ru rv w_old
!   RW status of diff variables: rom:incr tendency:in-out w:incr
!                ru:incr rv:incr w_old:incr
SUBROUTINE A_ADVECT_W(w, wb, w_old, w_oldb, tendency, tendencyb, ru, rub&
&  , rv, rvb, rom, romb, 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) :: wb, w_oldb, rub, rvb, &
&  romb
  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) :: tendencyb
  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 :: ubb, vbb, uwb, vwb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  INTEGER :: horz_order, vert_order
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  EXTERNAL WRF_ERROR_FATAL
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: branch
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  INTEGER :: ad_from27
  INTEGER :: ad_to27
  INTEGER :: ad_from28
  INTEGER :: ad_to28
  INTEGER :: ad_from29
  INTEGER :: ad_to29
  INTEGER :: ad_from30
  INTEGER :: ad_to30
  INTEGER :: ad_from31
  INTEGER :: ad_to31
  INTEGER :: ad_from32
  INTEGER :: ad_to32
  INTEGER :: ad_from33
  INTEGER :: ad_to33
  INTEGER :: ad_from34
  INTEGER :: ad_to34
  INTEGER :: ad_from35
  INTEGER :: ad_to35
  INTEGER :: ad_from36
  INTEGER :: ad_to36
  INTEGER :: ad_from37
  INTEGER :: ad_to37
  INTEGER :: ad_from38
  INTEGER :: ad_to38
  INTEGER :: ad_from39
  INTEGER :: ad_to39
  INTEGER :: ad_from40
  INTEGER :: ad_to40
  INTEGER :: ad_from41
  INTEGER :: ad_to41
  INTEGER :: ad_from42
  INTEGER :: ad_to42
  INTEGER :: ad_from43
  INTEGER :: ad_to43
  INTEGER :: ad_from44
  INTEGER :: ad_to44
  INTEGER :: ad_from45
  INTEGER :: ad_to45
  INTEGER :: ad_from46
  INTEGER :: ad_to46
  INTEGER :: ad_from47
  INTEGER :: ad_to47
  INTEGER :: ad_from48
  INTEGER :: ad_to48
  INTEGER :: ad_from49
  INTEGER :: ad_to49
  INTEGER :: ad_from50
  INTEGER :: ad_to50
  INTEGER :: ad_from51
  INTEGER :: ad_to51
  INTEGER :: ad_from52
  INTEGER :: ad_to52
  INTEGER :: ad_from53
  INTEGER :: ad_to53
  INTEGER :: ad_from54
  INTEGER :: ad_to54
  INTEGER :: ad_from55
  INTEGER :: ad_to55
  INTEGER :: ad_from56
  INTEGER :: ad_to56
  INTEGER :: ad_from57
  INTEGER :: ad_to57
  INTEGER :: ad_from58
  INTEGER :: ad_to58
  INTEGER :: ad_from59
  INTEGER :: ad_to59
  INTEGER :: ad_from60
  INTEGER :: ad_to60
  INTEGER :: ad_from61
  INTEGER :: ad_to61
  INTEGER :: ad_from62
  INTEGER :: ad_to62
  INTEGER :: ad_from63
  INTEGER :: ad_to63
  INTEGER :: ad_from64
  INTEGER :: ad_to64
  INTEGER :: ad_from65
  INTEGER :: ad_to65
  INTEGER :: ad_from66
  INTEGER :: ad_to66
  INTEGER :: ad_from67
  INTEGER :: ad_to67
  INTEGER :: ad_from68
  INTEGER :: ad_to68
  INTEGER :: ad_from69
  INTEGER :: ad_to69
  INTEGER :: ad_from70
  INTEGER :: ad_to70
  INTEGER :: ad_from71
  INTEGER :: ad_to71
  INTEGER :: ad_from72
  INTEGER :: ad_to72
  INTEGER :: ad_from73
  INTEGER :: ad_to73
  INTEGER :: ad_from74
  INTEGER :: ad_to74
  REAL :: temp3
  REAL :: temp29
  REAL :: temp63b93
  REAL :: temp79b3
  REAL :: temp2
  INTEGER :: temp28
  REAL :: temp63b92
  REAL :: temp79b2
  REAL :: temp1
  REAL :: temp27
  REAL :: temp63b91
  REAL :: temp79b1
  INTEGER :: temp0
  REAL :: temp26
  REAL :: temp63b90
  REAL :: temp63b104
  REAL :: temp79b0
  REAL :: temp7b
  REAL :: temp25
  REAL :: temp63b103
  INTEGER :: temp24
  REAL :: temp63b102
  REAL :: temp23
  REAL :: temp63b101
  REAL :: temp22
  REAL :: temp59
  REAL :: temp63b100
  REAL :: temp21
  REAL :: temp58
  INTEGER :: temp20
  REAL :: temp57
  REAL :: temp35b1
  INTEGER :: temp56
  REAL :: temp35b0
  REAL :: temp55
  REAL :: temp63b29
  REAL :: temp54
  REAL :: temp63b28
  REAL :: temp53
  REAL :: temp63b27
  REAL :: temp67b3
  INTEGER :: temp52
  REAL :: temp63b26
  REAL :: temp67b2
  REAL :: temp51
  REAL :: temp63b25
  REAL :: temp67b1
  REAL :: temp50
  REAL :: temp63b24
  REAL :: temp67b0
  REAL :: temp19b
  REAL :: temp63b23
  REAL :: temp27b
  REAL :: temp63b22
  REAL :: temp63b59
  REAL :: temp35b
  REAL :: temp63b21
  REAL :: temp63b58
  REAL :: tempb1
  REAL :: temp43b
  REAL :: temp47b19
  REAL :: temp55b9
  REAL :: temp63b20
  REAL :: temp63b57
  REAL :: tempb0
  REAL :: temp47b18
  REAL :: temp51b
  REAL :: temp55b8
  REAL :: temp63b56
  REAL :: temp47b17
  REAL :: temp55b7
  REAL :: temp63b55
  INTRINSIC MAX
  REAL :: temp23b1
  REAL :: temp47b16
  REAL :: temp55b6
  REAL :: temp63b54
  REAL :: temp23b0
  REAL :: temp47b15
  REAL :: temp55b5
  REAL :: temp63b53
  REAL :: temp7b5
  REAL :: temp47b14
  REAL :: temp55b4
  REAL :: temp63b52
  REAL :: temp63b89
  INTRINSIC SIGN
  REAL :: temp7b4
  REAL :: temp47b13
  REAL :: temp55b3
  REAL :: temp63b51
  REAL :: temp63b88
  REAL :: temp7b3
  REAL :: temp47b12
  REAL :: temp55b2
  REAL :: temp63b50
  REAL :: temp63b87
  REAL :: temp3b
  REAL :: temp7b2
  REAL :: temp47b11
  REAL :: temp55b1
  REAL :: temp63b86
  REAL :: temp7b1
  REAL :: temp47b10
  REAL :: temp55b0
  REAL :: temp63b85
  REAL :: temp7b0
  REAL :: temp63b84
  REAL :: temp19
  REAL :: temp63b83
  REAL :: temp18
  REAL :: temp63b82
  REAL :: temp17
  REAL :: temp63b81
  INTEGER :: temp16
  REAL :: temp63b80
  REAL :: temp15
  REAL :: temp14
  REAL :: temp11b1
  REAL :: temp13
  REAL :: temp11b0
  INTEGER :: temp12
  REAL :: temp49
  REAL :: temp11
  INTEGER :: temp48
  REAL :: temp75b8
  REAL :: temp10
  REAL :: temp47
  REAL :: temp75b7
  REAL :: temp15b
  REAL :: temp46
  REAL :: temp43b1
  REAL :: temp75b6
  REAL :: temp23b
  REAL :: temp45
  REAL :: temp43b0
  REAL :: temp63b19
  REAL :: temp75b5
  REAL :: temp31b
  INTEGER :: temp44
  REAL :: temp63b18
  REAL :: temp75b4
  REAL :: temp43
  REAL :: temp63b17
  REAL :: temp75b3
  REAL :: temp42
  REAL :: temp63b16
  REAL :: temp75b2
  REAL :: temp41
  REAL :: temp63b15
  REAL :: temp75b1
  REAL :: temp78
  INTEGER :: temp40
  REAL :: temp63b14
  REAL :: temp75b0
  REAL :: temp77
  REAL :: temp19b1
  REAL :: temp63b13
  INTEGER :: temp76
  REAL :: temp19b0
  REAL :: temp63b12
  REAL :: temp63b49
  REAL :: temp75
  REAL :: temp31b5
  REAL :: temp63b11
  REAL :: temp63b48
  REAL :: temp74
  REAL :: temp31b4
  REAL :: temp63b9
  REAL :: temp63b10
  REAL :: temp63b47
  REAL :: temp73
  REAL :: temp79b
  REAL :: temp31b3
  REAL :: temp63b8
  REAL :: temp63b46
  INTEGER :: temp72
  REAL :: tempb
  REAL :: temp31b2
  REAL :: temp63b7
  REAL :: temp63b45
  REAL :: temp71
  REAL :: temp31b1
  REAL :: temp63b6
  REAL :: temp63b44
  REAL :: temp70
  REAL :: temp31b0
  REAL :: temp63b5
  REAL :: temp63b43
  REAL :: temp63b4
  REAL :: temp63b42
  REAL :: temp63b79
  REAL :: temp63b3
  REAL :: temp63b41
  REAL :: temp63b78
  REAL :: temp63b2
  REAL :: temp63b40
  REAL :: temp63b77
  REAL :: temp63b1
  REAL :: temp63b76
  REAL :: temp63b0
  REAL :: temp63b75
  REAL :: temp63b74
  REAL :: temp39b5
  REAL :: temp63b73
  REAL :: temp39b4
  REAL :: temp63b72
  REAL :: temp39b3
  REAL :: temp63b71
  REAL :: temp11b
  REAL :: temp39b2
  REAL :: temp63b70
  REAL :: temp39b1
  REAL :: temp39b0
  REAL :: temp39
  REAL :: temp38
  REAL :: temp37
  INTEGER :: temp36
  REAL :: temp51b1
  REAL :: temp3b1
  REAL :: temp35
  REAL :: temp51b0
  REAL :: temp59b
  REAL :: temp3b0
  REAL :: temp34
  REAL :: temp67b
  REAL :: temp33
  REAL :: temp75b
  INTEGER :: temp32
  REAL :: temp69
  REAL :: temp31
  INTEGER :: temp68
  REAL :: temp30
  REAL :: temp67
  REAL :: temp27b1
  REAL :: temp66
  REAL :: temp27b0
  REAL :: temp63b39
  REAL :: temp65
  REAL :: temp63b38
  INTEGER :: temp64
  REAL :: temp63b37
  REAL :: temp63
  REAL :: temp55b17
  REAL :: temp62
  REAL :: temp63b36
  REAL :: temp55b16
  REAL :: temp61
  REAL :: temp59b1
  REAL :: temp63b35
  INTRINSIC MIN
  REAL :: temp55b15
  INTEGER :: temp60
  REAL :: temp59b0
  REAL :: temp63b34
  REAL :: temp55b14
  REAL :: temp63b33
  REAL :: temp55b13
  REAL :: temp63b32
  REAL :: temp63b69
  REAL :: temp15b5
  REAL :: temp55b12
  REAL :: temp63b31
  REAL :: temp63b68
  REAL :: temp15b4
  REAL :: temp47b9
  REAL :: temp55b11
  REAL :: temp63b30
  REAL :: temp63b67
  REAL :: temp15b3
  REAL :: temp47b8
  REAL :: temp55b10
  REAL :: temp63b66
  REAL :: temp71b1
  REAL :: temp
  REAL :: temp15b2
  REAL :: temp47b7
  REAL :: temp63b65
  REAL :: temp71b0
  REAL :: temp15b1
  REAL :: temp47b6
  REAL :: temp63b64
  REAL :: temp15b0
  REAL :: temp47b5
  REAL :: temp63b63
  REAL :: temp9
  REAL :: temp47b4
  REAL :: temp63b62
  REAL :: temp63b99
  INTEGER :: temp8
  REAL :: temp39b
  REAL :: temp47b3
  REAL :: temp63b61
  REAL :: temp63b98
  REAL :: temp7
  REAL :: temp47b
  REAL :: temp47b2
  REAL :: temp63b60
  REAL :: temp63b97
  REAL :: temp6
  REAL :: temp47b1
  REAL :: temp47b21
  REAL :: temp55b
  REAL :: temp63b96
  REAL :: temp5
  REAL :: temp47b0
  REAL :: temp47b20
  REAL :: temp63b
  REAL :: temp63b95
  INTEGER :: temp4
  REAL :: temp63b94
  REAL :: temp71b
  REAL :: temp79b4
  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
    ad_from63 = j_start
j_loop_y_flux_6:DO j=ad_from63,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from50 = i_start
          DO i=ad_from50,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from50)
        END DO
        k = ktf + 1
        ad_from51 = i_start
        DO i=ad_from51,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from51)
        CALL PUSHCONTROL3B(0)
      ELSE IF (j .EQ. jds + 1) THEN
        CALL PUSHINTEGER4(k)
! 2nd order flux next to south boundary
        DO k=kts+1,ktf
          ad_from52 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from52)
        END DO
        k = ktf + 1
        ad_from53 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from53)
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
        CALL PUSHINTEGER4(k)
! third of 4th order flux 2 in from south boundary
        DO k=kts+1,ktf
          ad_from54 = i_start
          DO i=ad_from54,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from54)
        END DO
        k = ktf + 1
        ad_from55 = i_start
        DO i=ad_from55,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from55)
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
        CALL PUSHINTEGER4(k)
! 2nd order flux next to north boundary
        DO k=kts+1,ktf
          ad_from56 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from56)
        END DO
        k = ktf + 1
        ad_from57 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from57)
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
        CALL PUSHINTEGER4(k)
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts+1,ktf
          ad_from58 = i_start
          DO i=ad_from58,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from58)
        END DO
        k = ktf + 1
        ad_from59 = i_start
        DO i=ad_from59,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from59)
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from60 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from60)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from61 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from61)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf+1
          ad_from62 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from62)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_6
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from63)
!  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
    END IF
    ad_from66 = j_start
!  compute fluxes
    DO j=ad_from66,j_end
      CALL PUSHINTEGER4(k)
!  5th or 6th order flux
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(vel)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from64 = i_start
        DO i=ad_from64,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHINTEGER4(k)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHINTEGER4(k)
! third order
            DO k=kts+1,ktf
              CALL PUSHREAL8(vel)
            END DO
            k = ktf + 1
            CALL PUSHREAL8(vel)
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from64)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHINTEGER4(k)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHINTEGER4(k)
! third order flux one in from the boundary
            DO k=kts+1,ktf
              CALL PUSHREAL8(vel)
            END DO
            k = ktf + 1
            CALL PUSHREAL8(vel)
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        ad_from65 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from65)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from66)
    CALL PUSHCONTROL3B(7)
  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
    ad_from12 = j_start
j_loop_y_flux_5:DO j=ad_from12,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from = i_start
          DO i=ad_from,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        k = ktf + 1
        ad_from0 = i_start
        DO i=ad_from0,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from0)
        CALL PUSHCONTROL3B(0)
      ELSE IF (j .EQ. jds + 1) THEN
        CALL PUSHINTEGER4(k)
! 2nd order flux next to south boundary
        DO k=kts+1,ktf
          ad_from1 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        k = ktf + 1
        ad_from2 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from2)
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
        CALL PUSHINTEGER4(k)
! third of 4th order flux 2 in from south boundary
        DO k=kts+1,ktf
          ad_from3 = i_start
          DO i=ad_from3,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        k = ktf + 1
        ad_from4 = i_start
        DO i=ad_from4,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from4)
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
        CALL PUSHINTEGER4(k)
! 2nd order flux next to north boundary
        DO k=kts+1,ktf
          ad_from5 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from5)
        END DO
        k = ktf + 1
        ad_from6 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from6)
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
        CALL PUSHINTEGER4(k)
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts+1,ktf
          ad_from7 = i_start
          DO i=ad_from7,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from7)
        END DO
        k = ktf + 1
        ad_from8 = i_start
        DO i=ad_from8,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from8)
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from9 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from9)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from10 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from10)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf+1
          ad_from11 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from11)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from12)
!  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
    END IF
    ad_from15 = j_start
!  compute fluxes
    DO j=ad_from15,j_end
      CALL PUSHINTEGER4(k)
!  5th or 6th order flux
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(vel)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
      END DO
!  lower order fluxes close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        ad_from13 = i_start
        DO i=ad_from13,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHINTEGER4(k)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHINTEGER4(k)
! third order
            DO k=kts+1,ktf
              CALL PUSHREAL8(vel)
            END DO
            k = ktf + 1
            CALL PUSHREAL8(vel)
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from13)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHINTEGER4(k)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHINTEGER4(k)
! third order flux one in from the boundary
            DO k=kts+1,ktf
              CALL PUSHREAL8(vel)
            END DO
            k = ktf + 1
            CALL PUSHREAL8(vel)
            vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        ad_from14 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from14)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from15)
    CALL PUSHCONTROL3B(6)
  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
    END IF
    ad_from17 = j_start
!  compute fluxes
    DO j=ad_from17,j_end
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(vel)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHINTEGER4(k)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHINTEGER4(k)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        ad_from16 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from16)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from17)
    CALL PUSHINTEGER4(i_start)
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    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
    ad_from27 = j_start
    DO j=ad_from27,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from18 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from18)
        END DO
        k = ktf + 1
        ad_from19 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from19)
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from20 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from20)
        END DO
        k = ktf + 1
        ad_from21 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from21)
        CALL PUSHCONTROL2B(1)
      ELSE
        CALL PUSHINTEGER4(k)
!  3rd or 4th order flux
        DO k=kts+1,ktf
          ad_from22 = i_start
          DO i=ad_from22,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from22)
        END DO
        k = ktf + 1
        ad_from23 = i_start
        DO i=ad_from23,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from23)
        CALL PUSHCONTROL2B(2)
      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
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from24 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from24)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from25 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from25)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf+1
          ad_from26 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from26)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from27)
    CALL PUSHCONTROL3B(5)
  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
    END IF
    ad_from29 = j_start
!  compute fluxes
    DO j=ad_from29,j_end
      DO k=kts+1,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(vel)
        END DO
      END DO
      k = ktf + 1
      DO i=i_start_f,i_end_f
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
      END DO
!  second order flux close to boundaries (if not periodic or symmetric)
      IF (degrade_xs) THEN
        CALL PUSHINTEGER4(k)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        CALL PUSHINTEGER4(k)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
!  x flux-divergence into tendency
      DO k=kts+1,ktf+1
        ad_from28 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from28)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from29)
    CALL PUSHINTEGER4(i_start)
!  next -> y flux divergence calculation
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    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
    ad_from39 = j_start
    DO j=ad_from39,j_end+1
      IF (j .LT. j_start_f .AND. degrade_ys) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from30 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from30)
        END DO
        k = ktf + 1
        ad_from31 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from31)
        CALL PUSHCONTROL2B(0)
      ELSE IF (j .GT. j_end_f .AND. degrade_ye) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from32 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from32)
        END DO
        k = ktf + 1
        ad_from33 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from33)
        CALL PUSHCONTROL2B(1)
      ELSE
        CALL PUSHINTEGER4(k)
!  3rd or 4th order flux
        DO k=kts+1,ktf
          ad_from34 = i_start
          DO i=ad_from34,i_end
            CALL PUSHREAL8(vel)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from34)
        END DO
        k = ktf + 1
        ad_from35 = i_start
        DO i=ad_from35,i_end
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from35)
        CALL PUSHCONTROL2B(2)
      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
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from36 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from36)
        END DO
        CALL PUSHCONTROL2B(0)
      ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts,ktf
          ad_from37 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from37)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE IF (j .GT. j_start) THEN
! normal code
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf+1
          ad_from38 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from38)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE
        CALL PUSHCONTROL2B(3)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from39)
    CALL PUSHCONTROL3B(4)
  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
    ad_from42 = j_start
    DO j=ad_from42,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        ad_from40 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from40)
      END DO
      k = ktf + 1
      ad_from41 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from41)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from42)
    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
    ad_from45 = j_start
    DO j=ad_from45,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        ad_from43 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from43)
      END DO
      k = ktf + 1
      ad_from44 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from44)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from45)
! Polar boundary condition ... not covered in above j-loop
    IF (config_flags%polar) THEN
      IF (jts .EQ. jds) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from46 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from46)
        END DO
        k = ktf + 1
        ad_from47 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from47)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jte .EQ. jde) THEN
        CALL PUSHINTEGER4(k)
        DO k=kts+1,ktf
          ad_from48 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from48)
        END DO
        k = ktf + 1
        ad_from49 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from49)
        CALL PUSHCONTROL3B(3)
      ELSE
        CALL PUSHCONTROL3B(2)
      END IF
    ELSE
      CALL PUSHCONTROL3B(1)
    END IF
  ELSE
    CALL PUSHCONTROL3B(0)
  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
  CALL PUSHINTEGER4(j_start)
  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
    ad_from67 = j_start
    DO j=ad_from67,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from67)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from68 = j_start
    DO j=ad_from68,j_end
      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
        CALL PUSHREAL8(ub)
        ub = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(ub)
        ub = uw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from68)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from69 = j_start
    DO j=ad_from69,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from69)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from70 = j_start
    DO j=ad_from70,j_end
      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
        CALL PUSHREAL8(ub)
        ub = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(ub)
        ub = uw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from70)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from71 = i_start
    DO i=ad_from71,i_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from71)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from72 = i_start
    DO i=ad_from72,i_end
      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
        CALL PUSHREAL8(vb)
        vb = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(vb)
        vb = vw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from72)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from73 = i_start
    DO i=ad_from73,i_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from73)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from74 = i_start
    DO i=ad_from74,i_end
      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
        CALL PUSHREAL8(vb)
        vb = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(vb)
        vb = vw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from74)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    CALL PUSHINTEGER4(j_end)
    j_end = jde - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(j_end)
    j_end = jte
    CALL PUSHCONTROL1B(1)
  END IF
  IF (vert_order .EQ. 6) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+3,ktf-1
        DO i=i_start,i_end
          CALL PUSHREAL8(vel)
        END DO
      END DO
      DO i=i_start,i_end
        CALL PUSHREAL8(vel)
      END DO
      CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid. wcs, 13 march 2004
      k = ktf + 1
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf + 1
        temp63b96 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp63b97 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp63b96
        romb(i, k-1, j) = romb(i, k-1, j) + temp63b96
        wb(i, k, j) = wb(i, k, j) + temp63b97
        wb(i, k-1, j) = wb(i, k-1, j) + temp63b97
        vfluxb(i, k) = 0.0
        k = ktf
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        temp63b98 = vel*vfluxb(i, k)/12.0
        velb = (7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        wb(i, k, j) = wb(i, k, j) + 7.*temp63b98
        wb(i, k-1, j) = wb(i, k-1, j) + 7.*temp63b98
        wb(i, k+1, j) = wb(i, k+1, j) - temp63b98
        wb(i, k-2, j) = wb(i, k-2, j) - temp63b98
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        temp63b99 = vel*vfluxb(i, k)/12.0
        velb = (7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))*&
&          vfluxb(i, k)/12.0
        wb(i, k, j) = wb(i, k, j) + 7.*temp63b99
        wb(i, k-1, j) = wb(i, k-1, j) + 7.*temp63b99
        wb(i, k+1, j) = wb(i, k+1, j) - temp63b99
        wb(i, k-2, j) = wb(i, k-2, j) - temp63b99
        vfluxb(i, k) = 0.0
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        k = kts + 1
        temp63b100 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp63b101 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp63b100
        romb(i, k-1, j) = romb(i, k-1, j) + temp63b100
        wb(i, k, j) = wb(i, k, j) + temp63b101
        wb(i, k-1, j) = wb(i, k-1, j) + temp63b101
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          temp63b95 = vel*vfluxb(i, k)/60.0
          velb = (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))*vfluxb(i, k)/60.0
          wb(i, k, j) = wb(i, k, j) + 37.*temp63b95
          wb(i, k-1, j) = wb(i, k-1, j) + 37.*temp63b95
          wb(i, k+1, j) = wb(i, k+1, j) - 8.*temp63b95
          wb(i, k-2, j) = wb(i, k-2, j) - 8.*temp63b95
          wb(i, k+2, j) = wb(i, k+2, j) + temp63b95
          wb(i, k-3, j) = wb(i, k-3, j) + temp63b95
          vfluxb(i, k) = 0.0
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE IF (vert_order .EQ. 5) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+3,ktf-1
        DO i=i_start,i_end
          CALL PUSHREAL8(vel)
        END DO
      END DO
      DO i=i_start,i_end
        CALL PUSHREAL8(vel)
      END DO
      CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf + 1
        temp75b = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp75b0 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp75b
        romb(i, k-1, j) = romb(i, k-1, j) + temp75b
        wb(i, k, j) = wb(i, k, j) + temp75b0
        wb(i, k-1, j) = wb(i, k-1, j) + temp75b0
        vfluxb(i, k) = 0.0
        k = ktf
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        temp71 = w(i, k+1, j) - w(i, k-2, j) - 3.*(w(i, k, j)-w(i, k-1, &
&          j))
        temp74 = SIGN(1., -vel)
        temp73 = temp74/12.0
        temp72 = SIGN(1, time_step)
        temp71b = vel*vfluxb(i, k)
        temp71b0 = temp71b/12.0
        temp71b1 = temp72*temp73*temp71b
        velb = ((7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))&
&          /12.0+temp72*(temp73*temp71))*vfluxb(i, k)
        wb(i, k, j) = wb(i, k, j) + 7.*temp71b0 - 3.*temp71b1
        wb(i, k-1, j) = wb(i, k-1, j) + 3.*temp71b1 + 7.*temp71b0
        wb(i, k+1, j) = wb(i, k+1, j) + temp71b1 - temp71b0
        wb(i, k-2, j) = wb(i, k-2, j) - temp71b1 - temp71b0
        vfluxb(i, k) = 0.0
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        k = kts + 2
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        temp67 = w(i, k+1, j) - w(i, k-2, j) - 3.*(w(i, k, j)-w(i, k-1, &
&          j))
        temp70 = SIGN(1., -vel)
        temp69 = temp70/12.0
        temp68 = SIGN(1, time_step)
        temp67b = vel*vfluxb(i, k)
        temp67b0 = temp67b/12.0
        temp67b1 = temp68*temp69*temp67b
        velb = ((7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))&
&          /12.0+temp68*(temp69*temp67))*vfluxb(i, k)
        wb(i, k, j) = wb(i, k, j) + 7.*temp67b0 - 3.*temp67b1
        wb(i, k-1, j) = wb(i, k-1, j) + 3.*temp67b1 + 7.*temp67b0
        wb(i, k+1, j) = wb(i, k+1, j) + temp67b1 - temp67b0
        wb(i, k-2, j) = wb(i, k-2, j) - temp67b1 - temp67b0
        vfluxb(i, k) = 0.0
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        k = kts + 1
        temp67b2 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp67b3 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp67b2
        romb(i, k-1, j) = romb(i, k-1, j) + temp67b2
        wb(i, k, j) = wb(i, k, j) + temp67b3
        wb(i, k-1, j) = wb(i, k-1, j) + temp67b3
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf-1,kts+3,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          temp63 = w(i, k+2, j) - w(i, k-3, j) + 10.*(w(i, k, j)-w(i, k-&
&            1, j)) - 5.*(w(i, k+1, j)-w(i, k-2, j))
          temp66 = SIGN(1., -vel)
          temp65 = temp66/60.0
          temp64 = SIGN(1, time_step)
          temp63b102 = vel*vfluxb(i, k)
          temp63b103 = temp63b102/60.0
          temp63b104 = -(temp64*temp65*temp63b102)
          velb = ((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-temp64*(temp65*&
&            temp63))*vfluxb(i, k)
          wb(i, k, j) = wb(i, k, j) + 10.*temp63b104 + 37.*temp63b103
          wb(i, k-1, j) = wb(i, k-1, j) + 37.*temp63b103 - 10.*&
&            temp63b104
          wb(i, k+1, j) = wb(i, k+1, j) - 5.*temp63b104 - 8.*temp63b103
          wb(i, k-2, j) = wb(i, k-2, j) + 5.*temp63b104 - 8.*temp63b103
          wb(i, k+2, j) = wb(i, k+2, j) + temp63b104 + temp63b103
          wb(i, k-3, j) = wb(i, k-3, j) + temp63b103 - temp63b104
          vfluxb(i, k) = 0.0
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE IF (vert_order .EQ. 4) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+2,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(vel)
        END DO
      END DO
      CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf + 1
        temp75b2 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp75b3 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp75b2
        romb(i, k-1, j) = romb(i, k-1, j) + temp75b2
        wb(i, k, j) = wb(i, k, j) + temp75b3
        wb(i, k-1, j) = wb(i, k-1, j) + temp75b3
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp75b4 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp75b5 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp75b4
        romb(i, k-1, j) = romb(i, k-1, j) + temp75b4
        wb(i, k, j) = wb(i, k, j) + temp75b5
        wb(i, k-1, j) = wb(i, k-1, j) + temp75b5
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          temp75b1 = vel*vfluxb(i, k)/12.0
          velb = (7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j)&
&            )*vfluxb(i, k)/12.0
          wb(i, k, j) = wb(i, k, j) + 7.*temp75b1
          wb(i, k-1, j) = wb(i, k-1, j) + 7.*temp75b1
          wb(i, k+1, j) = wb(i, k+1, j) - temp75b1
          wb(i, k-2, j) = wb(i, k-2, j) - temp75b1
          vfluxb(i, k) = 0.0
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE IF (vert_order .EQ. 3) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+2,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(vel)
        END DO
      END DO
      CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      DO i=i_end,i_start,-1
        k = ktf + 1
        temp79b = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp79b0 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp79b
        romb(i, k-1, j) = romb(i, k-1, j) + temp79b
        wb(i, k, j) = wb(i, k, j) + temp79b0
        wb(i, k-1, j) = wb(i, k-1, j) + temp79b0
        vfluxb(i, k) = 0.0
        k = kts + 1
        temp79b1 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
        temp79b2 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
        romb(i, k, j) = romb(i, k, j) + temp79b1
        romb(i, k-1, j) = romb(i, k-1, j) + temp79b1
        wb(i, k, j) = wb(i, k, j) + temp79b2
        wb(i, k-1, j) = wb(i, k-1, j) + temp79b2
        vfluxb(i, k) = 0.0
      END DO
      DO k=ktf,kts+2,-1
        DO i=i_end,i_start,-1
          vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
          temp75 = w(i, k+1, j) - w(i, k-2, j) - 3.*(w(i, k, j)-w(i, k-1&
&            , j))
          temp78 = SIGN(1., -vel)
          temp77 = temp78/12.0
          temp76 = SIGN(1, time_step)
          temp75b6 = vel*vfluxb(i, k)
          temp75b7 = temp75b6/12.0
          temp75b8 = temp76*temp77*temp75b6
          velb = ((7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j&
&            ))/12.0+temp76*(temp77*temp75))*vfluxb(i, k)
          wb(i, k, j) = wb(i, k, j) + 7.*temp75b7 - 3.*temp75b8
          wb(i, k-1, j) = wb(i, k-1, j) + 3.*temp75b8 + 7.*temp75b7
          wb(i, k+1, j) = wb(i, k+1, j) + temp75b8 - temp75b7
          wb(i, k-2, j) = wb(i, k-2, j) - temp75b8 - temp75b7
          vfluxb(i, k) = 0.0
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + 0.5*velb
          romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE IF (vert_order .EQ. 2) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid, wcs. 13 march 2004
      k = ktf + 1
    END DO
    vfluxb = 0.0
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
          vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
        END DO
      END DO
      DO k=ktf+1,kts+1,-1
        DO i=i_end,i_start,-1
          temp79b3 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
          temp79b4 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
          romb(i, k, j) = romb(i, k, j) + temp79b3
          romb(i, k-1, j) = romb(i, k-1, j) + temp79b3
          wb(i, k, j) = wb(i, k, j) + temp79b4
          wb(i, k-1, j) = wb(i, k-1, j) + temp79b4
          vfluxb(i, k) = 0.0
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(j_end)
  ELSE
    CALL POPINTEGER4(j_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from74)
    CALL POPINTEGER4(ad_to74)
    DO i=ad_to74,ad_from74,-1
      temp63b91 = -(rdy*tendencyb(i, k, j_end))
      temp63b92 = w(i, k, j_end)*temp63b91
      temp63b93 = (2.-fzm(k-1))*temp63b92
      temp63b94 = -(fzp(k-1)*temp63b92)
      vbb = (w_old(i, k, j_end)-w_old(i, k, j_end-1))*temp63b91
      w_oldb(i, k, j_end) = w_oldb(i, k, j_end) + vb*temp63b91
      w_oldb(i, k, j_end-1) = w_oldb(i, k, j_end-1) - vb*temp63b91
      wb(i, k, j_end) = wb(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)&
&        ))*temp63b91
      rvb(i, k-1, jte) = rvb(i, k-1, jte) + temp63b93
      rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) - temp63b93
      rvb(i, k-2, jte) = rvb(i, k-2, jte) + temp63b94
      rvb(i, k-2, jte-1) = rvb(i, k-2, jte-1) - temp63b94
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(vb)
        vwb = 0.0
      ELSE
        CALL POPREAL8(vb)
        vwb = vbb
      END IF
      temp63b89 = 0.5*(2.-fzm(k-1))*vwb
      temp63b90 = -(0.5*fzp(k-1)*vwb)
      rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) + temp63b89
      rvb(i, k-1, jte) = rvb(i, k-1, jte) + temp63b89
      rvb(i, k-2, jte-1) = rvb(i, k-2, jte-1) + temp63b90
      rvb(i, k-2, jte) = rvb(i, k-2, jte) + temp63b90
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from73)
    CALL POPINTEGER4(ad_to73)
    DO i=ad_to73,ad_from73,-1
      DO k=ktf,kts+1,-1
        temp63b87 = -(rdy*tendencyb(i, k, j_end))
        temp63b88 = w(i, k, j_end)*temp63b87
        vbb = (w_old(i, k, j_end)-w_old(i, k, j_end-1))*temp63b87
        w_oldb(i, k, j_end) = w_oldb(i, k, j_end) + vb*temp63b87
        w_oldb(i, k, j_end-1) = w_oldb(i, k, j_end-1) - vb*temp63b87
        wb(i, k, j_end) = wb(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)))*&
&          temp63b87
        rvb(i, k, jte) = rvb(i, k, jte) + fzm(k)*temp63b88
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - fzm(k)*temp63b88
        rvb(i, k-1, jte) = rvb(i, k-1, jte) + fzp(k)*temp63b88
        rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) - fzp(k)*temp63b88
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        temp63b86 = 0.5*vwb
        rvb(i, k, jte-1) = rvb(i, k, jte-1) + fzm(k)*temp63b86
        rvb(i, k, jte) = rvb(i, k, jte) + fzm(k)*temp63b86
        rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) + fzp(k)*temp63b86
        rvb(i, k-1, jte) = rvb(i, k-1, jte) + fzp(k)*temp63b86
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from72)
    CALL POPINTEGER4(ad_to72)
    DO i=ad_to72,ad_from72,-1
      temp63b82 = -(rdy*tendencyb(i, k, jts))
      temp63b83 = w(i, k, jts)*temp63b82
      temp63b84 = (2.-fzm(k-1))*temp63b83
      temp63b85 = -(fzp(k-1)*temp63b83)
      vbb = (w_old(i, k, jts+1)-w_old(i, k, jts))*temp63b82
      w_oldb(i, k, jts+1) = w_oldb(i, k, jts+1) + vb*temp63b82
      w_oldb(i, k, jts) = w_oldb(i, k, jts) - vb*temp63b82
      wb(i, k, jts) = wb(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)))*&
&        temp63b82
      rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + temp63b84
      rvb(i, k-1, jts) = rvb(i, k-1, jts) - temp63b84
      rvb(i, k-2, jts+1) = rvb(i, k-2, jts+1) + temp63b85
      rvb(i, k-2, jts) = rvb(i, k-2, jts) - temp63b85
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(vb)
        vwb = 0.0
      ELSE
        CALL POPREAL8(vb)
        vwb = vbb
      END IF
      temp63b80 = 0.5*(2.-fzm(k-1))*vwb
      temp63b81 = -(0.5*fzp(k-1)*vwb)
      rvb(i, k-1, jts) = rvb(i, k-1, jts) + temp63b80
      rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + temp63b80
      rvb(i, k-2, jts) = rvb(i, k-2, jts) + temp63b81
      rvb(i, k-2, jts+1) = rvb(i, k-2, jts+1) + temp63b81
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from71)
    CALL POPINTEGER4(ad_to71)
    DO i=ad_to71,ad_from71,-1
      DO k=ktf,kts+1,-1
        temp63b78 = -(rdy*tendencyb(i, k, jts))
        temp63b79 = w(i, k, jts)*temp63b78
        vbb = (w_old(i, k, jts+1)-w_old(i, k, jts))*temp63b78
        w_oldb(i, k, jts+1) = w_oldb(i, k, jts+1) + vb*temp63b78
        w_oldb(i, k, jts) = w_oldb(i, k, jts) - vb*temp63b78
        wb(i, k, jts) = wb(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)))*temp63b78
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + fzm(k)*temp63b79
        rvb(i, k, jts) = rvb(i, k, jts) - fzm(k)*temp63b79
        rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + fzp(k)*temp63b79
        rvb(i, k-1, jts) = rvb(i, k-1, jts) - fzp(k)*temp63b79
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        temp63b77 = 0.5*vwb
        rvb(i, k, jts) = rvb(i, k, jts) + fzm(k)*temp63b77
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + fzm(k)*temp63b77
        rvb(i, k-1, jts) = rvb(i, k-1, jts) + fzp(k)*temp63b77
        rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + fzp(k)*temp63b77
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from70)
    CALL POPINTEGER4(ad_to70)
    DO j=ad_to70,ad_from70,-1
      temp63b73 = -(rdx*tendencyb(i_end, k, j))
      temp63b74 = w(i_end, k, j)*temp63b73
      temp63b75 = (2.-fzm(k-1))*temp63b74
      temp63b76 = -(fzp(k-1)*temp63b74)
      ubb = (w_old(i_end, k, j)-w_old(i_end-1, k, j))*temp63b73
      w_oldb(i_end, k, j) = w_oldb(i_end, k, j) + ub*temp63b73
      w_oldb(i_end-1, k, j) = w_oldb(i_end-1, k, j) - ub*temp63b73
      wb(i_end, k, j) = wb(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)&
&        ))*temp63b73
      rub(ite, k-1, j) = rub(ite, k-1, j) + temp63b75
      rub(ite-1, k-1, j) = rub(ite-1, k-1, j) - temp63b75
      rub(ite, k-2, j) = rub(ite, k-2, j) + temp63b76
      rub(ite-1, k-2, j) = rub(ite-1, k-2, j) - temp63b76
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(ub)
        uwb = 0.0
      ELSE
        CALL POPREAL8(ub)
        uwb = ubb
      END IF
      temp63b71 = 0.5*(2.-fzm(k-1))*uwb
      temp63b72 = -(0.5*fzp(k-1)*uwb)
      rub(ite-1, k-1, j) = rub(ite-1, k-1, j) + temp63b71
      rub(ite, k-1, j) = rub(ite, k-1, j) + temp63b71
      rub(ite-1, k-2, j) = rub(ite-1, k-2, j) + temp63b72
      rub(ite, k-2, j) = rub(ite, k-2, j) + temp63b72
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from69)
    CALL POPINTEGER4(ad_to69)
    DO j=ad_to69,ad_from69,-1
      DO k=ktf,kts+1,-1
        temp63b69 = -(rdx*tendencyb(i_end, k, j))
        temp63b70 = w(i_end, k, j)*temp63b69
        ubb = (w_old(i_end, k, j)-w_old(i_end-1, k, j))*temp63b69
        w_oldb(i_end, k, j) = w_oldb(i_end, k, j) + ub*temp63b69
        w_oldb(i_end-1, k, j) = w_oldb(i_end-1, k, j) - ub*temp63b69
        wb(i_end, k, j) = wb(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)))*&
&          temp63b69
        rub(ite, k, j) = rub(ite, k, j) + fzm(k)*temp63b70
        rub(ite-1, k, j) = rub(ite-1, k, j) - fzm(k)*temp63b70
        rub(ite, k-1, j) = rub(ite, k-1, j) + fzp(k)*temp63b70
        rub(ite-1, k-1, j) = rub(ite-1, k-1, j) - fzp(k)*temp63b70
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        temp63b68 = 0.5*uwb
        rub(ite-1, k, j) = rub(ite-1, k, j) + fzm(k)*temp63b68
        rub(ite, k, j) = rub(ite, k, j) + fzm(k)*temp63b68
        rub(ite-1, k-1, j) = rub(ite-1, k-1, j) + fzp(k)*temp63b68
        rub(ite, k-1, j) = rub(ite, k-1, j) + fzp(k)*temp63b68
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from68)
    CALL POPINTEGER4(ad_to68)
    DO j=ad_to68,ad_from68,-1
      temp63b64 = -(rdx*tendencyb(its, k, j))
      temp63b65 = w(its, k, j)*temp63b64
      temp63b66 = (2.-fzm(k-1))*temp63b65
      temp63b67 = -(fzp(k-1)*temp63b65)
      ubb = (w_old(its+1, k, j)-w_old(its, k, j))*temp63b64
      w_oldb(its+1, k, j) = w_oldb(its+1, k, j) + ub*temp63b64
      w_oldb(its, k, j) = w_oldb(its, k, j) - ub*temp63b64
      wb(its, k, j) = wb(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)))*&
&        temp63b64
      rub(its+1, k-1, j) = rub(its+1, k-1, j) + temp63b66
      rub(its, k-1, j) = rub(its, k-1, j) - temp63b66
      rub(its+1, k-2, j) = rub(its+1, k-2, j) + temp63b67
      rub(its, k-2, j) = rub(its, k-2, j) - temp63b67
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(ub)
        uwb = 0.0
      ELSE
        CALL POPREAL8(ub)
        uwb = ubb
      END IF
      temp63b62 = 0.5*(2.-fzm(k-1))*uwb
      temp63b63 = -(0.5*fzp(k-1)*uwb)
      rub(its, k-1, j) = rub(its, k-1, j) + temp63b62
      rub(its+1, k-1, j) = rub(its+1, k-1, j) + temp63b62
      rub(its, k-2, j) = rub(its, k-2, j) + temp63b63
      rub(its+1, k-2, j) = rub(its+1, k-2, j) + temp63b63
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from67)
    CALL POPINTEGER4(ad_to67)
    DO j=ad_to67,ad_from67,-1
      DO k=ktf,kts+1,-1
        temp63b60 = -(rdx*tendencyb(its, k, j))
        temp63b61 = w(its, k, j)*temp63b60
        ubb = (w_old(its+1, k, j)-w_old(its, k, j))*temp63b60
        w_oldb(its+1, k, j) = w_oldb(its+1, k, j) + ub*temp63b60
        w_oldb(its, k, j) = w_oldb(its, k, j) - ub*temp63b60
        wb(its, k, j) = wb(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)))*temp63b60
        rub(its+1, k, j) = rub(its+1, k, j) + fzm(k)*temp63b61
        rub(its, k, j) = rub(its, k, j) - fzm(k)*temp63b61
        rub(its+1, k-1, j) = rub(its+1, k-1, j) + fzp(k)*temp63b61
        rub(its, k-1, j) = rub(its, k-1, j) - fzp(k)*temp63b61
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        temp63b59 = 0.5*uwb
        rub(its, k, j) = rub(its, k, j) + fzm(k)*temp63b59
        rub(its+1, k, j) = rub(its+1, k, j) + fzm(k)*temp63b59
        rub(its, k-1, j) = rub(its, k-1, j) + fzp(k)*temp63b59
        rub(its+1, k-1, j) = rub(its+1, k-1, j) + fzp(k)*temp63b59
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPINTEGER4(j_start)
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 4) THEN
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) GOTO 100
    ELSE
      IF (branch .NE. 2) THEN
        CALL POPINTEGER4(ad_from49)
        CALL POPINTEGER4(ad_to49)
        DO i=ad_to49,ad_from49,-1
          mrdy = msftx(i, jde-1)*rdy
          temp63b28 = mrdy*0.5*tendencyb(i, k, jde-1)
          temp63b29 = (w(i, k, jde-1)+w(i, k, jde-2))*temp63b28
          temp63b30 = ((2.-fzm(k-1))*rv(i, k-1, jde-1)-fzp(k-1)*rv(i, k-&
&            2, jde-1))*temp63b28
          rvb(i, k-1, jde-1) = rvb(i, k-1, jde-1) + (2.-fzm(k-1))*&
&            temp63b29
          rvb(i, k-2, jde-1) = rvb(i, k-2, jde-1) - fzp(k-1)*temp63b29
          wb(i, k, jde-1) = wb(i, k, jde-1) + temp63b30
          wb(i, k, jde-2) = wb(i, k, jde-2) + temp63b30
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from48)
          CALL POPINTEGER4(ad_to48)
          DO i=ad_to48,ad_from48,-1
            mrdy = msftx(i, jde-1)*rdy
            temp63b25 = mrdy*0.5*tendencyb(i, k, jde-1)
            temp63b26 = (w(i, k, jde-1)+w(i, k, jde-2))*temp63b25
            temp63b27 = (fzm(k)*rv(i, k, jde-1)+fzp(k)*rv(i, k-1, jde-1)&
&              )*temp63b25
            rvb(i, k, jde-1) = rvb(i, k, jde-1) + fzm(k)*temp63b26
            rvb(i, k-1, jde-1) = rvb(i, k-1, jde-1) + fzp(k)*temp63b26
            wb(i, k, jde-1) = wb(i, k, jde-1) + temp63b27
            wb(i, k, jde-2) = wb(i, k, jde-2) + temp63b27
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from47)
        CALL POPINTEGER4(ad_to47)
        DO i=ad_to47,ad_from47,-1
          mrdy = msftx(i, jds)*rdy
          temp63b22 = -(mrdy*0.5*tendencyb(i, k, jds))
          temp63b23 = (w(i, k, jds+1)+w(i, k, jds))*temp63b22
          temp63b24 = ((2.-fzm(k-1))*rv(i, k-1, jds+1)-fzp(k-1)*rv(i, k-&
&            2, jds+1))*temp63b22
          rvb(i, k-1, jds+1) = rvb(i, k-1, jds+1) + (2.-fzm(k-1))*&
&            temp63b23
          rvb(i, k-2, jds+1) = rvb(i, k-2, jds+1) - fzp(k-1)*temp63b23
          wb(i, k, jds+1) = wb(i, k, jds+1) + temp63b24
          wb(i, k, jds) = wb(i, k, jds) + temp63b24
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from46)
          CALL POPINTEGER4(ad_to46)
          DO i=ad_to46,ad_from46,-1
            mrdy = msftx(i, jds)*rdy
            temp63b19 = -(mrdy*0.5*tendencyb(i, k, jds))
            temp63b20 = (w(i, k, jds+1)+w(i, k, jds))*temp63b19
            temp63b21 = (fzm(k)*rv(i, k, jds+1)+fzp(k)*rv(i, k-1, jds+1)&
&              )*temp63b19
            rvb(i, k, jds+1) = rvb(i, k, jds+1) + fzm(k)*temp63b20
            rvb(i, k-1, jds+1) = rvb(i, k-1, jds+1) + fzp(k)*temp63b20
            wb(i, k, jds+1) = wb(i, k, jds+1) + temp63b21
            wb(i, k, jds) = wb(i, k, jds) + temp63b21
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
    END IF
    CALL POPINTEGER4(ad_from45)
    CALL POPINTEGER4(ad_to45)
    DO j=ad_to45,ad_from45,-1
      CALL POPINTEGER4(ad_from44)
      CALL POPINTEGER4(ad_to44)
      DO i=ad_to44,ad_from44,-1
        mrdy = msftx(i, j)*rdy
        temp63b14 = -(mrdy*0.5*tendencyb(i, k, j))
        temp63b15 = (w(i, k, j+1)+w(i, k, j))*temp63b14
        temp63b16 = ((2.-fzm(k-1))*rv(i, k-1, j+1)-fzp(k-1)*rv(i, k-2, j&
&          +1))*temp63b14
        temp63b17 = -((w(i, k, j)+w(i, k, j-1))*temp63b14)
        temp63b18 = -(((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2, j&
&          ))*temp63b14)
        rvb(i, k-1, j+1) = rvb(i, k-1, j+1) + (2.-fzm(k-1))*temp63b15
        rvb(i, k-2, j+1) = rvb(i, k-2, j+1) - fzp(k-1)*temp63b15
        wb(i, k, j+1) = wb(i, k, j+1) + temp63b16
        wb(i, k, j) = wb(i, k, j) + temp63b18 + temp63b16
        rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp63b17
        rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp63b17
        wb(i, k, j-1) = wb(i, k, j-1) + temp63b18
      END DO
      DO k=ktf,kts+1,-1
        CALL POPINTEGER4(ad_from43)
        CALL POPINTEGER4(ad_to43)
        DO i=ad_to43,ad_from43,-1
          mrdy = msftx(i, j)*rdy
          temp63b9 = -(mrdy*0.5*tendencyb(i, k, j))
          temp63b10 = (w(i, k, j+1)+w(i, k, j))*temp63b9
          temp63b11 = (fzm(k)*rv(i, k, j+1)+fzp(k)*rv(i, k-1, j+1))*&
&            temp63b9
          temp63b12 = -((w(i, k, j)+w(i, k, j-1))*temp63b9)
          temp63b13 = -((fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&            temp63b9)
          rvb(i, k, j+1) = rvb(i, k, j+1) + fzm(k)*temp63b10
          rvb(i, k-1, j+1) = rvb(i, k-1, j+1) + fzp(k)*temp63b10
          wb(i, k, j+1) = wb(i, k, j+1) + temp63b11
          wb(i, k, j) = wb(i, k, j) + temp63b13 + temp63b11
          rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp63b12
          rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp63b12
          wb(i, k, j-1) = wb(i, k, j-1) + temp63b13
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(ad_from42)
    CALL POPINTEGER4(ad_to42)
    DO j=ad_to42,ad_from42,-1
      CALL POPINTEGER4(ad_from41)
      CALL POPINTEGER4(ad_to41)
      DO i=ad_to41,ad_from41,-1
        mrdx = msftx(i, j)*rdx
        temp63b4 = -(mrdx*0.5*tendencyb(i, k, j))
        temp63b5 = (w(i+1, k, j)+w(i, k, j))*temp63b4
        temp63b6 = ((2.-fzm(k-1))*ru(i+1, k-1, j)-fzp(k-1)*ru(i+1, k-2, &
&          j))*temp63b4
        temp63b7 = -((w(i, k, j)+w(i-1, k, j))*temp63b4)
        temp63b8 = -(((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-2, j)&
&          )*temp63b4)
        rub(i+1, k-1, j) = rub(i+1, k-1, j) + (2.-fzm(k-1))*temp63b5
        rub(i+1, k-2, j) = rub(i+1, k-2, j) - fzp(k-1)*temp63b5
        wb(i+1, k, j) = wb(i+1, k, j) + temp63b6
        wb(i, k, j) = wb(i, k, j) + temp63b8 + temp63b6
        rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp63b7
        rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp63b7
        wb(i-1, k, j) = wb(i-1, k, j) + temp63b8
      END DO
      DO k=ktf,kts+1,-1
        CALL POPINTEGER4(ad_from40)
        CALL POPINTEGER4(ad_to40)
        DO i=ad_to40,ad_from40,-1
          mrdx = msftx(i, j)*rdx
          temp63b = -(mrdx*0.5*tendencyb(i, k, j))
          temp63b0 = (w(i+1, k, j)+w(i, k, j))*temp63b
          temp63b1 = (fzm(k)*ru(i+1, k, j)+fzp(k)*ru(i+1, k-1, j))*&
&            temp63b
          temp63b2 = -((w(i, k, j)+w(i-1, k, j))*temp63b)
          temp63b3 = -((fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*temp63b&
&            )
          rub(i+1, k, j) = rub(i+1, k, j) + fzm(k)*temp63b0
          rub(i+1, k-1, j) = rub(i+1, k-1, j) + fzp(k)*temp63b0
          wb(i+1, k, j) = wb(i+1, k, j) + temp63b1
          wb(i, k, j) = wb(i, k, j) + temp63b3 + temp63b1
          rub(i, k, j) = rub(i, k, j) + fzm(k)*temp63b2
          rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp63b2
          wb(i-1, k, j) = wb(i-1, k, j) + temp63b3
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE IF (branch .LT. 6) THEN
    IF (branch .EQ. 4) THEN
      fqyb = 0.0
      CALL POPINTEGER4(ad_from39)
      CALL POPINTEGER4(ad_to39)
      DO j=ad_to39,ad_from39,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from36)
              CALL POPINTEGER4(ad_to36)
              DO i=ad_to36,ad_from36,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
            CALL POPINTEGER4(k)
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from37)
              CALL POPINTEGER4(ad_to37)
              DO i=ad_to37,ad_from37,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
            CALL POPINTEGER4(k)
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf+1,kts+1,-1
            CALL POPINTEGER4(ad_from38)
            CALL POPINTEGER4(ad_to38)
            DO i=ad_to38,ad_from38,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from31)
          CALL POPINTEGER4(ad_to31)
          DO i=ad_to31,ad_from31,-1
            temp55b9 = 0.5*(w(i, k, j_start)+w(i, k, j_start-1))*fqyb(i&
&              , k, jp1)
            temp55b10 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-1)*&
&              rv(i, k-2, j_start))*fqyb(i, k, jp1)
            rvb(i, k-1, j_start) = rvb(i, k-1, j_start) + (2.-fzm(k-1))*&
&              temp55b9
            rvb(i, k-2, j_start) = rvb(i, k-2, j_start) - fzp(k-1)*&
&              temp55b9
            wb(i, k, j_start) = wb(i, k, j_start) + temp55b10
            wb(i, k, j_start-1) = wb(i, k, j_start-1) + temp55b10
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from30)
            CALL POPINTEGER4(ad_to30)
            DO i=ad_to30,ad_from30,-1
              temp55b7 = 0.5*(w(i, k, j_start)+w(i, k, j_start-1))*fqyb(&
&                i, k, jp1)
              temp55b8 = 0.5*(fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, k-1&
&                , j_start))*fqyb(i, k, jp1)
              rvb(i, k, j_start) = rvb(i, k, j_start) + fzm(k)*temp55b7
              rvb(i, k-1, j_start) = rvb(i, k-1, j_start) + fzp(k)*&
&                temp55b7
              wb(i, k, j_start) = wb(i, k, j_start) + temp55b8
              wb(i, k, j_start-1) = wb(i, k, j_start-1) + temp55b8
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE IF (branch .EQ. 1) THEN
          CALL POPINTEGER4(ad_from33)
          CALL POPINTEGER4(ad_to33)
          DO i=ad_to33,ad_from33,-1
            temp55b13 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp55b14 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, &
&              k-2, j))*fqyb(i, k, jp1)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp55b13
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp55b13
            wb(i, k, j) = wb(i, k, j) + temp55b14
            wb(i, k, j-1) = wb(i, k, j-1) + temp55b14
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from32)
            CALL POPINTEGER4(ad_to32)
            DO i=ad_to32,ad_from32,-1
              temp55b11 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
              temp55b12 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&                fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp55b11
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp55b11
              wb(i, k, j) = wb(i, k, j) + temp55b12
              wb(i, k, j-1) = wb(i, k, j-1) + temp55b12
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          CALL POPINTEGER4(ad_from35)
          CALL POPINTEGER4(ad_to35)
          DO i=ad_to35,ad_from35,-1
            temp59 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k&
&              , j-1))
            temp62 = SIGN(1., vel)
            temp61 = temp62/12.0
            temp60 = SIGN(1, time_step)
            temp59b = vel*fqyb(i, k, jp1)
            temp59b0 = temp59b/12.0
            temp59b1 = temp60*temp61*temp59b
            velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j&
&              -2))/12.0+temp60*(temp61*temp59))*fqyb(i, k, jp1)
            wb(i, k, j) = wb(i, k, j) + 7.*temp59b0 - 3.*temp59b1
            wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp59b1 + 7.*temp59b0
            wb(i, k, j+1) = wb(i, k, j+1) + temp59b1 - temp59b0
            wb(i, k, j-2) = wb(i, k, j-2) - temp59b1 - temp59b0
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from34)
            CALL POPINTEGER4(ad_to34)
            DO i=ad_to34,ad_from34,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp55 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i&
&                , k, j-1))
              temp58 = SIGN(1., vel)
              temp57 = temp58/12.0
              temp56 = SIGN(1, time_step)
              temp55b15 = vel*fqyb(i, k, jp1)
              temp55b16 = temp55b15/12.0
              temp55b17 = temp56*temp57*temp55b15
              velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k&
&                , j-2))/12.0+temp56*(temp57*temp55))*fqyb(i, k, jp1)
              wb(i, k, j) = wb(i, k, j) + 7.*temp55b16 - 3.*temp55b17
              wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp55b17 + 7.*&
&                temp55b16
              wb(i, k, j+1) = wb(i, k, j+1) + temp55b17 - temp55b16
              wb(i, k, j-2) = wb(i, k, j-2) - temp55b17 - temp55b16
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(i_end)
      ELSE
        CALL POPINTEGER4(i_end)
      END IF
      CALL POPINTEGER4(i_start)
      fqxb = 0.0
      CALL POPINTEGER4(ad_from29)
      CALL POPINTEGER4(ad_to29)
      DO j=ad_to29,ad_from29,-1
        DO k=ktf+1,kts+1,-1
          CALL POPINTEGER4(ad_from28)
          CALL POPINTEGER4(ad_to28)
          DO i=ad_to28,ad_from28,-1
            mrdx = msftx(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPINTEGER4(k)
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          k = ktf + 1
          temp55b5 = 0.5*(w(i_end+1, k, j)+w(i_end, k, j))*fqxb(i_end+1&
&            , k)
          temp55b6 = 0.5*((2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1)*ru(&
&            i_end+1, k-2, j))*fqxb(i_end+1, k)
          rub(i_end+1, k-1, j) = rub(i_end+1, k-1, j) + (2.-fzm(k-1))*&
&            temp55b5
          rub(i_end+1, k-2, j) = rub(i_end+1, k-2, j) - fzp(k-1)*&
&            temp55b5
          wb(i_end+1, k, j) = wb(i_end+1, k, j) + temp55b6
          wb(i_end, k, j) = wb(i_end, k, j) + temp55b6
          fqxb(i_end+1, k) = 0.0
          DO k=ktf,kts+1,-1
            temp55b3 = 0.5*(w(i_end+1, k, j)+w(i_end, k, j))*fqxb(i_end+&
&              1, k)
            temp55b4 = 0.5*(fzm(k)*ru(i_end+1, k, j)+fzp(k)*ru(i_end+1, &
&              k-1, j))*fqxb(i_end+1, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + fzm(k)*temp55b3
            rub(i_end+1, k-1, j) = rub(i_end+1, k-1, j) + fzp(k)*&
&              temp55b3
            wb(i_end+1, k, j) = wb(i_end+1, k, j) + temp55b4
            wb(i_end, k, j) = wb(i_end, k, j) + temp55b4
            fqxb(i_end+1, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          k = ktf + 1
          temp55b1 = 0.5*(w(i_start, k, j)+w(i_start-1, k, j))*fqxb(&
&            i_start, k)
          temp55b2 = 0.5*((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1)*ru(&
&            i_start, k-2, j))*fqxb(i_start, k)
          rub(i_start, k-1, j) = rub(i_start, k-1, j) + (2.-fzm(k-1))*&
&            temp55b1
          rub(i_start, k-2, j) = rub(i_start, k-2, j) - fzp(k-1)*&
&            temp55b1
          wb(i_start, k, j) = wb(i_start, k, j) + temp55b2
          wb(i_start-1, k, j) = wb(i_start-1, k, j) + temp55b2
          fqxb(i_start, k) = 0.0
          DO k=ktf,kts+1,-1
            temp55b = 0.5*(w(i_start, k, j)+w(i_start-1, k, j))*fqxb(&
&              i_start, k)
            temp55b0 = 0.5*(fzm(k)*ru(i_start, k, j)+fzp(k)*ru(i_start, &
&              k-1, j))*fqxb(i_start, k)
            rub(i_start, k, j) = rub(i_start, k, j) + fzm(k)*temp55b
            rub(i_start, k-1, j) = rub(i_start, k-1, j) + fzp(k)*temp55b
            wb(i_start, k, j) = wb(i_start, k, j) + temp55b0
            wb(i_start-1, k, j) = wb(i_start-1, k, j) + temp55b0
            fqxb(i_start, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
        k = ktf + 1
        DO i=i_end_f,i_start_f,-1
          temp51 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1, k&
&            , j))
          temp54 = SIGN(1., vel)
          temp53 = temp54/12.0
          temp52 = SIGN(1, time_step)
          temp51b = vel*fqxb(i, k)
          temp51b0 = temp51b/12.0
          temp51b1 = temp52*temp53*temp51b
          velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, j&
&            ))/12.0+temp52*(temp53*temp51))*fqxb(i, k)
          wb(i, k, j) = wb(i, k, j) + 7.*temp51b0 - 3.*temp51b1
          wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp51b1 + 7.*temp51b0
          wb(i+1, k, j) = wb(i+1, k, j) + temp51b1 - temp51b0
          wb(i-2, k, j) = wb(i-2, k, j) - temp51b1 - temp51b0
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          DO i=i_end_f,i_start_f,-1
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            temp47 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1&
&              , k, j))
            temp50 = SIGN(1., vel)
            temp49 = temp50/12.0
            temp48 = SIGN(1, time_step)
            temp47b19 = vel*fqxb(i, k)
            temp47b20 = temp47b19/12.0
            temp47b21 = temp48*temp49*temp47b19
            velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&              , j))/12.0+temp48*(temp49*temp47))*fqxb(i, k)
            wb(i, k, j) = wb(i, k, j) + 7.*temp47b20 - 3.*temp47b21
            wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp47b21 + 7.*temp47b20
            wb(i+1, k, j) = wb(i+1, k, j) + temp47b21 - temp47b20
            wb(i-2, k, j) = wb(i-2, k, j) - temp47b21 - temp47b20
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
      END DO
    ELSE
      fqyb = 0.0
      CALL POPINTEGER4(ad_from27)
      CALL POPINTEGER4(ad_to27)
      DO j=ad_to27,ad_from27,-1
        CALL POPINTEGER4(jp0)
        CALL POPINTEGER4(jp1)
        CALL POPCONTROL2B(branch)
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from24)
              CALL POPINTEGER4(ad_to24)
              DO i=ad_to24,ad_from24,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
            CALL POPINTEGER4(k)
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from25)
              CALL POPINTEGER4(ad_to25)
              DO i=ad_to25,ad_from25,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                  , j-1)
              END DO
            END DO
            CALL POPINTEGER4(k)
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf+1,kts+1,-1
            CALL POPINTEGER4(ad_from26)
            CALL POPINTEGER4(ad_to26)
            DO i=ad_to26,ad_from26,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL2B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from19)
          CALL POPINTEGER4(ad_to19)
          DO i=ad_to19,ad_from19,-1
            temp47b11 = 0.5*(w(i, k, j_start)+w(i, k, j_start-1))*fqyb(i&
&              , k, jp1)
            temp47b12 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j_start)-fzp(k-1)*&
&              rv(i, k-2, j_start))*fqyb(i, k, jp1)
            rvb(i, k-1, j_start) = rvb(i, k-1, j_start) + (2.-fzm(k-1))*&
&              temp47b11
            rvb(i, k-2, j_start) = rvb(i, k-2, j_start) - fzp(k-1)*&
&              temp47b11
            wb(i, k, j_start) = wb(i, k, j_start) + temp47b12
            wb(i, k, j_start-1) = wb(i, k, j_start-1) + temp47b12
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from18)
            CALL POPINTEGER4(ad_to18)
            DO i=ad_to18,ad_from18,-1
              temp47b9 = 0.5*(w(i, k, j_start)+w(i, k, j_start-1))*fqyb(&
&                i, k, jp1)
              temp47b10 = 0.5*(fzm(k)*rv(i, k, j_start)+fzp(k)*rv(i, k-1&
&                , j_start))*fqyb(i, k, jp1)
              rvb(i, k, j_start) = rvb(i, k, j_start) + fzm(k)*temp47b9
              rvb(i, k-1, j_start) = rvb(i, k-1, j_start) + fzp(k)*&
&                temp47b9
              wb(i, k, j_start) = wb(i, k, j_start) + temp47b10
              wb(i, k, j_start-1) = wb(i, k, j_start-1) + temp47b10
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE IF (branch .EQ. 1) THEN
          CALL POPINTEGER4(ad_from21)
          CALL POPINTEGER4(ad_to21)
          DO i=ad_to21,ad_from21,-1
            temp47b15 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp47b16 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, &
&              k-2, j))*fqyb(i, k, jp1)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp47b15
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp47b15
            wb(i, k, j) = wb(i, k, j) + temp47b16
            wb(i, k, j-1) = wb(i, k, j-1) + temp47b16
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from20)
            CALL POPINTEGER4(ad_to20)
            DO i=ad_to20,ad_from20,-1
              temp47b13 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
              temp47b14 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&                fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp47b13
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp47b13
              wb(i, k, j) = wb(i, k, j) + temp47b14
              wb(i, k, j-1) = wb(i, k, j-1) + temp47b14
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          CALL POPINTEGER4(ad_from23)
          CALL POPINTEGER4(ad_to23)
          DO i=ad_to23,ad_from23,-1
            temp47b18 = vel*fqyb(i, k, jp1)/12.0
            velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-&
&              2))*fqyb(i, k, jp1)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp47b18
            wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp47b18
            wb(i, k, j+1) = wb(i, k, j+1) - temp47b18
            wb(i, k, j-2) = wb(i, k, j-2) - temp47b18
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from22)
            CALL POPINTEGER4(ad_to22)
            DO i=ad_to22,ad_from22,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp47b17 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              wb(i, k, j) = wb(i, k, j) + 7.*temp47b17
              wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp47b17
              wb(i, k, j+1) = wb(i, k, j+1) - temp47b17
              wb(i, k, j-2) = wb(i, k, j-2) - temp47b17
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(i_end)
      ELSE
        CALL POPINTEGER4(i_end)
      END IF
      CALL POPINTEGER4(i_start)
      fqxb = 0.0
      CALL POPINTEGER4(ad_from17)
      CALL POPINTEGER4(ad_to17)
      DO j=ad_to17,ad_from17,-1
        DO k=ktf+1,kts+1,-1
          CALL POPINTEGER4(ad_from16)
          CALL POPINTEGER4(ad_to16)
          DO i=ad_to16,ad_from16,-1
            mrdx = msftx(i, j)*rdx
            fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
            fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
          END DO
        END DO
        CALL POPINTEGER4(k)
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          k = ktf + 1
          temp47b7 = 0.5*(w(i_end+1, k, j)+w(i_end, k, j))*fqxb(i_end+1&
&            , k)
          temp47b8 = 0.5*((2.-fzm(k-1))*ru(i_end+1, k-1, j)-fzp(k-1)*ru(&
&            i_end+1, k-2, j))*fqxb(i_end+1, k)
          rub(i_end+1, k-1, j) = rub(i_end+1, k-1, j) + (2.-fzm(k-1))*&
&            temp47b7
          rub(i_end+1, k-2, j) = rub(i_end+1, k-2, j) - fzp(k-1)*&
&            temp47b7
          wb(i_end+1, k, j) = wb(i_end+1, k, j) + temp47b8
          wb(i_end, k, j) = wb(i_end, k, j) + temp47b8
          fqxb(i_end+1, k) = 0.0
          DO k=ktf,kts+1,-1
            temp47b5 = 0.5*(w(i_end+1, k, j)+w(i_end, k, j))*fqxb(i_end+&
&              1, k)
            temp47b6 = 0.5*(fzm(k)*ru(i_end+1, k, j)+fzp(k)*ru(i_end+1, &
&              k-1, j))*fqxb(i_end+1, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + fzm(k)*temp47b5
            rub(i_end+1, k-1, j) = rub(i_end+1, k-1, j) + fzp(k)*&
&              temp47b5
            wb(i_end+1, k, j) = wb(i_end+1, k, j) + temp47b6
            wb(i_end, k, j) = wb(i_end, k, j) + temp47b6
            fqxb(i_end+1, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          k = ktf + 1
          temp47b3 = 0.5*(w(i_start, k, j)+w(i_start-1, k, j))*fqxb(&
&            i_start, k)
          temp47b4 = 0.5*((2.-fzm(k-1))*ru(i_start, k-1, j)-fzp(k-1)*ru(&
&            i_start, k-2, j))*fqxb(i_start, k)
          rub(i_start, k-1, j) = rub(i_start, k-1, j) + (2.-fzm(k-1))*&
&            temp47b3
          rub(i_start, k-2, j) = rub(i_start, k-2, j) - fzp(k-1)*&
&            temp47b3
          wb(i_start, k, j) = wb(i_start, k, j) + temp47b4
          wb(i_start-1, k, j) = wb(i_start-1, k, j) + temp47b4
          fqxb(i_start, k) = 0.0
          DO k=ktf,kts+1,-1
            temp47b1 = 0.5*(w(i_start, k, j)+w(i_start-1, k, j))*fqxb(&
&              i_start, k)
            temp47b2 = 0.5*(fzm(k)*ru(i_start, k, j)+fzp(k)*ru(i_start, &
&              k-1, j))*fqxb(i_start, k)
            rub(i_start, k, j) = rub(i_start, k, j) + fzm(k)*temp47b1
            rub(i_start, k-1, j) = rub(i_start, k-1, j) + fzp(k)*&
&              temp47b1
            wb(i_start, k, j) = wb(i_start, k, j) + temp47b2
            wb(i_start-1, k, j) = wb(i_start-1, k, j) + temp47b2
            fqxb(i_start, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
        k = ktf + 1
        DO i=i_end_f,i_start_f,-1
          temp47b0 = vel*fqxb(i, k)/12.0
          velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, j)&
&            )*fqxb(i, k)/12.0
          wb(i, k, j) = wb(i, k, j) + 7.*temp47b0
          wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp47b0
          wb(i+1, k, j) = wb(i+1, k, j) - temp47b0
          wb(i-2, k, j) = wb(i-2, k, j) - temp47b0
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          DO i=i_end_f,i_start_f,-1
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            temp47b = vel*fqxb(i, k)/12.0
            velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, &
&              j))*fqxb(i, k)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp47b
            wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp47b
            wb(i+1, k, j) = wb(i+1, k, j) - temp47b
            wb(i-2, k, j) = wb(i-2, k, j) - temp47b
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
      END DO
    END IF
  ELSE IF (branch .EQ. 6) THEN
    fqxb = 0.0
    CALL POPINTEGER4(ad_from15)
    CALL POPINTEGER4(ad_to15)
    DO j=ad_to15,ad_from15,-1
      DO k=ktf+1,kts+1,-1
        CALL POPINTEGER4(ad_from14)
        CALL POPINTEGER4(ad_to14)
        DO i=ad_to14,ad_from14,-1
          mrdx = msftx(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to13)
        DO i=ad_to13,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            k = ktf + 1
            temp43 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1&
&              , k, j))
            temp46 = SIGN(1., vel)
            temp45 = temp46/12.0
            temp44 = SIGN(1, time_step)
            temp43b = vel*fqxb(i, k)
            temp43b0 = temp43b/12.0
            temp43b1 = temp44*temp45*temp43b
            velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&              , j))/12.0+temp44*(temp45*temp43))*fqxb(i, k)
            wb(i, k, j) = wb(i, k, j) + 7.*temp43b0 - 3.*temp43b1
            wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp43b1 + 7.*temp43b0
            wb(i+1, k, j) = wb(i+1, k, j) + temp43b1 - temp43b0
            wb(i-2, k, j) = wb(i-2, k, j) - temp43b1 - temp43b0
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
            DO k=ktf,kts+1,-1
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              temp39 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-&
&                1, k, j))
              temp42 = SIGN(1., vel)
              temp41 = temp42/12.0
              temp40 = SIGN(1, time_step)
              temp39b3 = vel*fqxb(i, k)
              temp39b4 = temp39b3/12.0
              temp39b5 = temp40*temp41*temp39b3
              velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, &
&                k, j))/12.0+temp40*(temp41*temp39))*fqxb(i, k)
              wb(i, k, j) = wb(i, k, j) + 7.*temp39b4 - 3.*temp39b5
              wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp39b5 + 7.*temp39b4
              wb(i+1, k, j) = wb(i+1, k, j) + temp39b5 - temp39b4
              wb(i-2, k, j) = wb(i-2, k, j) - temp39b5 - temp39b4
              fqxb(i, k) = 0.0
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
            END DO
            CALL POPINTEGER4(k)
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            k = ktf + 1
            temp39b1 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp39b2 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k&
&              -2, j))*fqxb(i, k)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp39b1
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp39b1
            wb(i, k, j) = wb(i, k, j) + temp39b2
            wb(i-1, k, j) = wb(i-1, k, j) + temp39b2
            fqxb(i, k) = 0.0
            DO k=ktf,kts+1,-1
              temp39b = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
              temp39b0 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*temp39b
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp39b
              wb(i, k, j) = wb(i, k, j) + temp39b0
              wb(i-1, k, j) = wb(i-1, k, j) + temp39b0
              fqxb(i, k) = 0.0
            END DO
            CALL POPINTEGER4(k)
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from13)
        DO i=i_start_f-1,ad_from13,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            k = ktf + 1
            temp35 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1&
&              , k, j))
            temp38 = SIGN(1., vel)
            temp37 = temp38/12.0
            temp36 = SIGN(1, time_step)
            temp35b = vel*fqxb(i, k)
            temp35b0 = temp35b/12.0
            temp35b1 = temp36*temp37*temp35b
            velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&              , j))/12.0+temp36*(temp37*temp35))*fqxb(i, k)
            wb(i, k, j) = wb(i, k, j) + 7.*temp35b0 - 3.*temp35b1
            wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp35b1 + 7.*temp35b0
            wb(i+1, k, j) = wb(i+1, k, j) + temp35b1 - temp35b0
            wb(i-2, k, j) = wb(i-2, k, j) - temp35b1 - temp35b0
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
            DO k=ktf,kts+1,-1
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              temp31 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-&
&                1, k, j))
              temp34 = SIGN(1., vel)
              temp33 = temp34/12.0
              temp32 = SIGN(1, time_step)
              temp31b3 = vel*fqxb(i, k)
              temp31b4 = temp31b3/12.0
              temp31b5 = temp32*temp33*temp31b3
              velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, &
&                k, j))/12.0+temp32*(temp33*temp31))*fqxb(i, k)
              wb(i, k, j) = wb(i, k, j) + 7.*temp31b4 - 3.*temp31b5
              wb(i-1, k, j) = wb(i-1, k, j) + 3.*temp31b5 + 7.*temp31b4
              wb(i+1, k, j) = wb(i+1, k, j) + temp31b5 - temp31b4
              wb(i-2, k, j) = wb(i-2, k, j) - temp31b5 - temp31b4
              fqxb(i, k) = 0.0
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
            END DO
            CALL POPINTEGER4(k)
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            k = ktf + 1
            temp31b1 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp31b2 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k&
&              -2, j))*fqxb(i, k)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp31b1
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp31b1
            wb(i, k, j) = wb(i, k, j) + temp31b2
            wb(i-1, k, j) = wb(i-1, k, j) + temp31b2
            fqxb(i, k) = 0.0
            DO k=ktf,kts+1,-1
              temp31b = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
              temp31b0 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*temp31b
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp31b
              wb(i, k, j) = wb(i, k, j) + temp31b0
              wb(i-1, k, j) = wb(i-1, k, j) + temp31b0
              fqxb(i, k) = 0.0
            END DO
            CALL POPINTEGER4(k)
          END IF
        END DO
      END IF
      k = ktf + 1
      DO i=i_end_f,i_start_f,-1
        temp27 = w(i+2, k, j) - w(i-3, k, j) + 10.*(w(i, k, j)-w(i-1, k&
&          , j)) - 5.*(w(i+1, k, j)-w(i-2, k, j))
        temp30 = SIGN(1., vel)
        temp29 = temp30/60.0
        temp28 = SIGN(1, time_step)
        temp27b = vel*fqxb(i, k)
        temp27b0 = temp27b/60.0
        temp27b1 = -(temp28*temp29*temp27b)
        velb = ((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-temp28*(temp29*temp27))*&
&          fqxb(i, k)
        wb(i, k, j) = wb(i, k, j) + 10.*temp27b1 + 37.*temp27b0
        wb(i-1, k, j) = wb(i-1, k, j) + 37.*temp27b0 - 10.*temp27b1
        wb(i+1, k, j) = wb(i+1, k, j) - 5.*temp27b1 - 8.*temp27b0
        wb(i-2, k, j) = wb(i-2, k, j) + 5.*temp27b1 - 8.*temp27b0
        wb(i+2, k, j) = wb(i+2, k, j) + temp27b1 + temp27b0
        wb(i-3, k, j) = wb(i-3, k, j) + temp27b0 - temp27b1
        fqxb(i, k) = 0.0
        CALL POPREAL8(vel)
        rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
        rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end_f,i_start_f,-1
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          temp23 = w(i+2, k, j) - w(i-3, k, j) + 10.*(w(i, k, j)-w(i-1, &
&            k, j)) - 5.*(w(i+1, k, j)-w(i-2, k, j))
          temp26 = SIGN(1., vel)
          temp25 = temp26/60.0
          temp24 = SIGN(1, time_step)
          temp23b = vel*fqxb(i, k)
          temp23b0 = temp23b/60.0
          temp23b1 = -(temp24*temp25*temp23b)
          velb = ((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-temp24*(temp25*&
&            temp23))*fqxb(i, k)
          wb(i, k, j) = wb(i, k, j) + 10.*temp23b1 + 37.*temp23b0
          wb(i-1, k, j) = wb(i-1, k, j) + 37.*temp23b0 - 10.*temp23b1
          wb(i+1, k, j) = wb(i+1, k, j) - 5.*temp23b1 - 8.*temp23b0
          wb(i-2, k, j) = wb(i-2, k, j) + 5.*temp23b1 - 8.*temp23b0
          wb(i+2, k, j) = wb(i+2, k, j) + temp23b1 + temp23b0
          wb(i-3, k, j) = wb(i-3, k, j) + temp23b0 - temp23b1
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
          rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    fqyb = 0.0
    CALL POPINTEGER4(ad_from12)
    CALL POPINTEGER4(ad_to12)
    DO j=ad_to12,ad_from12,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from9)
            CALL POPINTEGER4(ad_to9)
            DO i=ad_to9,ad_from9,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from10)
            CALL POPINTEGER4(ad_to10)
            DO i=ad_to10,ad_from10,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf+1,kts+1,-1
          CALL POPINTEGER4(ad_from11)
          CALL POPINTEGER4(ad_to11)
          DO i=ad_to11,ad_from11,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from0)
          CALL POPINTEGER4(ad_to0)
          DO i=ad_to0,ad_from0,-1
            temp3 = w(i, k, j+2) - w(i, k, j-3) + 10.*(w(i, k, j)-w(i, k&
&              , j-1)) - 5.*(w(i, k, j+1)-w(i, k, j-2))
            temp6 = SIGN(1., vel)
            temp5 = temp6/60.0
            temp4 = SIGN(1, time_step)
            temp3b = vel*fqyb(i, k, jp1)
            temp3b0 = temp3b/60.0
            temp3b1 = -(temp4*temp5*temp3b)
            velb = ((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-temp4*(temp5*&
&              temp3))*fqyb(i, k, jp1)
            wb(i, k, j) = wb(i, k, j) + 10.*temp3b1 + 37.*temp3b0
            wb(i, k, j-1) = wb(i, k, j-1) + 37.*temp3b0 - 10.*temp3b1
            wb(i, k, j+1) = wb(i, k, j+1) - 5.*temp3b1 - 8.*temp3b0
            wb(i, k, j-2) = wb(i, k, j-2) + 5.*temp3b1 - 8.*temp3b0
            wb(i, k, j+2) = wb(i, k, j+2) + temp3b1 + temp3b0
            wb(i, k, j-3) = wb(i, k, j-3) + temp3b0 - temp3b1
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from)
            CALL POPINTEGER4(ad_to)
            DO i=ad_to,ad_from,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp = w(i, k, j+2) - w(i, k, j-3) + 10.*(w(i, k, j)-w(i, &
&                k, j-1)) - 5.*(w(i, k, j+1)-w(i, k, j-2))
              temp2 = SIGN(1., vel)
              temp1 = temp2/60.0
              temp0 = SIGN(1, time_step)
              tempb = vel*fqyb(i, k, jp1)
              tempb0 = tempb/60.0
              tempb1 = -(temp0*temp1*tempb)
              velb = ((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-temp0*(temp1&
&                *temp))*fqyb(i, k, jp1)
              wb(i, k, j) = wb(i, k, j) + 10.*tempb1 + 37.*tempb0
              wb(i, k, j-1) = wb(i, k, j-1) + 37.*tempb0 - 10.*tempb1
              wb(i, k, j+1) = wb(i, k, j+1) - 5.*tempb1 - 8.*tempb0
              wb(i, k, j-2) = wb(i, k, j-2) + 5.*tempb1 - 8.*tempb0
              wb(i, k, j+2) = wb(i, k, j+2) + tempb1 + tempb0
              wb(i, k, j-3) = wb(i, k, j-3) + tempb0 - tempb1
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE IF (branch .EQ. 1) THEN
          CALL POPINTEGER4(ad_from2)
          CALL POPINTEGER4(ad_to2)
          DO i=ad_to2,ad_from2,-1
            temp7b1 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp7b2 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-&
&              2, j))*fqyb(i, k, jp1)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp7b1
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp7b1
            wb(i, k, j) = wb(i, k, j) + temp7b2
            wb(i, k, j-1) = wb(i, k, j-1) + temp7b2
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from1)
            CALL POPINTEGER4(ad_to1)
            DO i=ad_to1,ad_from1,-1
              temp7b = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
              temp7b0 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&                fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp7b
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp7b
              wb(i, k, j) = wb(i, k, j) + temp7b0
              wb(i, k, j-1) = wb(i, k, j-1) + temp7b0
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          CALL POPINTEGER4(ad_from4)
          CALL POPINTEGER4(ad_to4)
          DO i=ad_to4,ad_from4,-1
            temp11 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k&
&              , j-1))
            temp14 = SIGN(1., vel)
            temp13 = temp14/12.0
            temp12 = SIGN(1, time_step)
            temp11b = vel*fqyb(i, k, jp1)
            temp11b0 = temp11b/12.0
            temp11b1 = temp12*temp13*temp11b
            velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j&
&              -2))/12.0+temp12*(temp13*temp11))*fqyb(i, k, jp1)
            wb(i, k, j) = wb(i, k, j) + 7.*temp11b0 - 3.*temp11b1
            wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp11b1 + 7.*temp11b0
            wb(i, k, j+1) = wb(i, k, j+1) + temp11b1 - temp11b0
            wb(i, k, j-2) = wb(i, k, j-2) - temp11b1 - temp11b0
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from3)
            CALL POPINTEGER4(ad_to3)
            DO i=ad_to3,ad_from3,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp7 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, &
&                k, j-1))
              temp10 = SIGN(1., vel)
              temp9 = temp10/12.0
              temp8 = SIGN(1, time_step)
              temp7b3 = vel*fqyb(i, k, jp1)
              temp7b4 = temp7b3/12.0
              temp7b5 = temp8*temp9*temp7b3
              velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k&
&                , j-2))/12.0+temp8*(temp9*temp7))*fqyb(i, k, jp1)
              wb(i, k, j) = wb(i, k, j) + 7.*temp7b4 - 3.*temp7b5
              wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp7b5 + 7.*temp7b4
              wb(i, k, j+1) = wb(i, k, j+1) + temp7b5 - temp7b4
              wb(i, k, j-2) = wb(i, k, j-2) - temp7b5 - temp7b4
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      ELSE IF (branch .EQ. 3) THEN
        CALL POPINTEGER4(ad_from6)
        CALL POPINTEGER4(ad_to6)
        DO i=ad_to6,ad_from6,-1
          temp15b1 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
          temp15b2 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2&
&            , j))*fqyb(i, k, jp1)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp15b1
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp15b1
          wb(i, k, j) = wb(i, k, j) + temp15b2
          wb(i, k, j-1) = wb(i, k, j-1) + temp15b2
          fqyb(i, k, jp1) = 0.0
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from5)
          CALL POPINTEGER4(ad_to5)
          DO i=ad_to5,ad_from5,-1
            temp15b = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp15b0 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&              fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp15b
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp15b
            wb(i, k, j) = wb(i, k, j) + temp15b0
            wb(i, k, j-1) = wb(i, k, j-1) + temp15b0
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
        CALL POPINTEGER4(k)
      ELSE IF (branch .EQ. 4) THEN
        CALL POPINTEGER4(ad_from8)
        CALL POPINTEGER4(ad_to8)
        DO i=ad_to8,ad_from8,-1
          temp19 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k, &
&            j-1))
          temp22 = SIGN(1., vel)
          temp21 = temp22/12.0
          temp20 = SIGN(1, time_step)
          temp19b = vel*fqyb(i, k, jp1)
          temp19b0 = temp19b/12.0
          temp19b1 = temp20*temp21*temp19b
          velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-2&
&            ))/12.0+temp20*(temp21*temp19))*fqyb(i, k, jp1)
          wb(i, k, j) = wb(i, k, j) + 7.*temp19b0 - 3.*temp19b1
          wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp19b1 + 7.*temp19b0
          wb(i, k, j+1) = wb(i, k, j+1) + temp19b1 - temp19b0
          wb(i, k, j-2) = wb(i, k, j-2) - temp19b1 - temp19b0
          fqyb(i, k, jp1) = 0.0
          CALL POPREAL8(vel)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from7)
          CALL POPINTEGER4(ad_to7)
          DO i=ad_to7,ad_from7,-1
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            temp15 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k&
&              , j-1))
            temp18 = SIGN(1., vel)
            temp17 = temp18/12.0
            temp16 = SIGN(1, time_step)
            temp15b3 = vel*fqyb(i, k, jp1)
            temp15b4 = temp15b3/12.0
            temp15b5 = temp16*temp17*temp15b3
            velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j&
&              -2))/12.0+temp16*(temp17*temp15))*fqyb(i, k, jp1)
            wb(i, k, j) = wb(i, k, j) + 7.*temp15b4 - 3.*temp15b5
            wb(i, k, j-1) = wb(i, k, j-1) + 3.*temp15b5 + 7.*temp15b4
            wb(i, k, j+1) = wb(i, k, j+1) + temp15b5 - temp15b4
            wb(i, k, j-2) = wb(i, k, j-2) - temp15b5 - temp15b4
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
    END DO
  ELSE
    fqxb = 0.0
    CALL POPINTEGER4(ad_from66)
    CALL POPINTEGER4(ad_to66)
    DO j=ad_to66,ad_from66,-1
      DO k=ktf+1,kts+1,-1
        CALL POPINTEGER4(ad_from65)
        CALL POPINTEGER4(ad_to65)
        DO i=ad_to65,ad_from65,-1
          mrdx = msftx(i, j)*rdx
          fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
          fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
        END DO
      END DO
      CALL POPINTEGER4(k)
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to64)
        DO i=ad_to64,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            k = ktf + 1
            temp63b58 = vel*fqxb(i, k)/12.0
            velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, &
&              j))*fqxb(i, k)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp63b58
            wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp63b58
            wb(i+1, k, j) = wb(i+1, k, j) - temp63b58
            wb(i-2, k, j) = wb(i-2, k, j) - temp63b58
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
            DO k=ktf,kts+1,-1
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              temp63b57 = vel*fqxb(i, k)/12.0
              velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&                , j))*fqxb(i, k)/12.0
              wb(i, k, j) = wb(i, k, j) + 7.*temp63b57
              wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp63b57
              wb(i+1, k, j) = wb(i+1, k, j) - temp63b57
              wb(i-2, k, j) = wb(i-2, k, j) - temp63b57
              fqxb(i, k) = 0.0
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
            END DO
            CALL POPINTEGER4(k)
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            k = ktf + 1
            temp63b55 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp63b56 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*fqxb(i, k)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp63b55
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp63b55
            wb(i, k, j) = wb(i, k, j) + temp63b56
            wb(i-1, k, j) = wb(i-1, k, j) + temp63b56
            fqxb(i, k) = 0.0
            DO k=ktf,kts+1,-1
              temp63b53 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
              temp63b54 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*temp63b53
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp63b53
              wb(i, k, j) = wb(i, k, j) + temp63b54
              wb(i-1, k, j) = wb(i-1, k, j) + temp63b54
              fqxb(i, k) = 0.0
            END DO
            CALL POPINTEGER4(k)
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from64)
        DO i=i_start_f-1,ad_from64,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            k = ktf + 1
            temp63b52 = vel*fqxb(i, k)/12.0
            velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, &
&              j))*fqxb(i, k)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp63b52
            wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp63b52
            wb(i+1, k, j) = wb(i+1, k, j) - temp63b52
            wb(i-2, k, j) = wb(i-2, k, j) - temp63b52
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
            DO k=ktf,kts+1,-1
              vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
              temp63b51 = vel*fqxb(i, k)/12.0
              velb = (7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&                , j))*fqxb(i, k)/12.0
              wb(i, k, j) = wb(i, k, j) + 7.*temp63b51
              wb(i-1, k, j) = wb(i-1, k, j) + 7.*temp63b51
              wb(i+1, k, j) = wb(i+1, k, j) - temp63b51
              wb(i-2, k, j) = wb(i-2, k, j) - temp63b51
              fqxb(i, k) = 0.0
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
            END DO
            CALL POPINTEGER4(k)
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            k = ktf + 1
            temp63b49 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp63b50 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, &
&              k-2, j))*fqxb(i, k)
            rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp63b49
            rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp63b49
            wb(i, k, j) = wb(i, k, j) + temp63b50
            wb(i-1, k, j) = wb(i-1, k, j) + temp63b50
            fqxb(i, k) = 0.0
            DO k=ktf,kts+1,-1
              temp63b47 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
              temp63b48 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&                fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + fzm(k)*temp63b47
              rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp63b47
              wb(i, k, j) = wb(i, k, j) + temp63b48
              wb(i-1, k, j) = wb(i-1, k, j) + temp63b48
              fqxb(i, k) = 0.0
            END DO
            CALL POPINTEGER4(k)
          END IF
        END DO
      END IF
      k = ktf + 1
      DO i=i_end_f,i_start_f,-1
        temp63b46 = vel*fqxb(i, k)/60.0
        velb = (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))*fqxb(i, k)/60.0
        wb(i, k, j) = wb(i, k, j) + 37.*temp63b46
        wb(i-1, k, j) = wb(i-1, k, j) + 37.*temp63b46
        wb(i+1, k, j) = wb(i+1, k, j) - 8.*temp63b46
        wb(i-2, k, j) = wb(i-2, k, j) - 8.*temp63b46
        wb(i+2, k, j) = wb(i+2, k, j) + temp63b46
        wb(i-3, k, j) = wb(i-3, k, j) + temp63b46
        fqxb(i, k) = 0.0
        CALL POPREAL8(vel)
        rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
        rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
      END DO
      DO k=ktf,kts+1,-1
        DO i=i_end_f,i_start_f,-1
          vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
          temp63b45 = vel*fqxb(i, k)/60.0
          velb = (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))*fqxb(i, k)/60.0
          wb(i, k, j) = wb(i, k, j) + 37.*temp63b45
          wb(i-1, k, j) = wb(i-1, k, j) + 37.*temp63b45
          wb(i+1, k, j) = wb(i+1, k, j) - 8.*temp63b45
          wb(i-2, k, j) = wb(i-2, k, j) - 8.*temp63b45
          wb(i+2, k, j) = wb(i+2, k, j) + temp63b45
          wb(i-3, k, j) = wb(i-3, k, j) + temp63b45
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
          rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    fqyb = 0.0
    CALL POPINTEGER4(ad_from63)
    CALL POPINTEGER4(ad_to63)
    DO j=ad_to63,ad_from63,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from60)
            CALL POPINTEGER4(ad_to60)
            DO i=ad_to60,ad_from60,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from61)
            CALL POPINTEGER4(ad_to61)
            DO i=ad_to61,ad_from61,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&                -1)
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf+1,kts+1,-1
          CALL POPINTEGER4(ad_from62)
          CALL POPINTEGER4(ad_to62)
          DO i=ad_to62,ad_from62,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4(ad_from51)
          CALL POPINTEGER4(ad_to51)
          DO i=ad_to51,ad_from51,-1
            temp63b32 = vel*fqyb(i, k, jp1)/60.0
            velb = (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))*fqyb(i, k, jp1)/60.0
            wb(i, k, j) = wb(i, k, j) + 37.*temp63b32
            wb(i, k, j-1) = wb(i, k, j-1) + 37.*temp63b32
            wb(i, k, j+1) = wb(i, k, j+1) - 8.*temp63b32
            wb(i, k, j-2) = wb(i, k, j-2) - 8.*temp63b32
            wb(i, k, j+2) = wb(i, k, j+2) + temp63b32
            wb(i, k, j-3) = wb(i, k, j-3) + temp63b32
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from50)
            CALL POPINTEGER4(ad_to50)
            DO i=ad_to50,ad_from50,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp63b31 = vel*fqyb(i, k, jp1)/60.0
              velb = (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))*fqyb(i, k, jp1)/&
&                60.0
              wb(i, k, j) = wb(i, k, j) + 37.*temp63b31
              wb(i, k, j-1) = wb(i, k, j-1) + 37.*temp63b31
              wb(i, k, j+1) = wb(i, k, j+1) - 8.*temp63b31
              wb(i, k, j-2) = wb(i, k, j-2) - 8.*temp63b31
              wb(i, k, j+2) = wb(i, k, j+2) + temp63b31
              wb(i, k, j-3) = wb(i, k, j-3) + temp63b31
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE IF (branch .EQ. 1) THEN
          CALL POPINTEGER4(ad_from53)
          CALL POPINTEGER4(ad_to53)
          DO i=ad_to53,ad_from53,-1
            temp63b35 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp63b36 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, &
&              k-2, j))*fqyb(i, k, jp1)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp63b35
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp63b35
            wb(i, k, j) = wb(i, k, j) + temp63b36
            wb(i, k, j-1) = wb(i, k, j-1) + temp63b36
            fqyb(i, k, jp1) = 0.0
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from52)
            CALL POPINTEGER4(ad_to52)
            DO i=ad_to52,ad_from52,-1
              temp63b33 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
              temp63b34 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&                fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp63b33
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp63b33
              wb(i, k, j) = wb(i, k, j) + temp63b34
              wb(i, k, j-1) = wb(i, k, j-1) + temp63b34
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
          CALL POPINTEGER4(k)
        ELSE
          CALL POPINTEGER4(ad_from55)
          CALL POPINTEGER4(ad_to55)
          DO i=ad_to55,ad_from55,-1
            temp63b38 = vel*fqyb(i, k, jp1)/12.0
            velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-&
&              2))*fqyb(i, k, jp1)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp63b38
            wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp63b38
            wb(i, k, j+1) = wb(i, k, j+1) - temp63b38
            wb(i, k, j-2) = wb(i, k, j-2) - temp63b38
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
            rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
          END DO
          DO k=ktf,kts+1,-1
            CALL POPINTEGER4(ad_from54)
            CALL POPINTEGER4(ad_to54)
            DO i=ad_to54,ad_from54,-1
              vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
              temp63b37 = vel*fqyb(i, k, jp1)/12.0
              velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, &
&                j-2))*fqyb(i, k, jp1)/12.0
              wb(i, k, j) = wb(i, k, j) + 7.*temp63b37
              wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp63b37
              wb(i, k, j+1) = wb(i, k, j+1) - temp63b37
              wb(i, k, j-2) = wb(i, k, j-2) - temp63b37
              fqyb(i, k, jp1) = 0.0
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
              rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
            END DO
          END DO
          CALL POPINTEGER4(k)
        END IF
      ELSE IF (branch .EQ. 3) THEN
        CALL POPINTEGER4(ad_from57)
        CALL POPINTEGER4(ad_to57)
        DO i=ad_to57,ad_from57,-1
          temp63b41 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
          temp63b42 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-&
&            2, j))*fqyb(i, k, jp1)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp63b41
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp63b41
          wb(i, k, j) = wb(i, k, j) + temp63b42
          wb(i, k, j-1) = wb(i, k, j-1) + temp63b42
          fqyb(i, k, jp1) = 0.0
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from56)
          CALL POPINTEGER4(ad_to56)
          DO i=ad_to56,ad_from56,-1
            temp63b39 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp63b40 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*&
&              fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp63b39
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp63b39
            wb(i, k, j) = wb(i, k, j) + temp63b40
            wb(i, k, j-1) = wb(i, k, j-1) + temp63b40
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
        CALL POPINTEGER4(k)
      ELSE IF (branch .EQ. 4) THEN
        CALL POPINTEGER4(ad_from59)
        CALL POPINTEGER4(ad_to59)
        DO i=ad_to59,ad_from59,-1
          temp63b44 = vel*fqyb(i, k, jp1)/12.0
          velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-2)&
&            )*fqyb(i, k, jp1)/12.0
          wb(i, k, j) = wb(i, k, j) + 7.*temp63b44
          wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp63b44
          wb(i, k, j+1) = wb(i, k, j+1) - temp63b44
          wb(i, k, j-2) = wb(i, k, j-2) - temp63b44
          fqyb(i, k, jp1) = 0.0
          CALL POPREAL8(vel)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from58)
          CALL POPINTEGER4(ad_to58)
          DO i=ad_to58,ad_from58,-1
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            temp63b43 = vel*fqyb(i, k, jp1)/12.0
            velb = (7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-&
&              2))*fqyb(i, k, jp1)/12.0
            wb(i, k, j) = wb(i, k, j) + 7.*temp63b43
            wb(i, k, j-1) = wb(i, k, j-1) + 7.*temp63b43
            wb(i, k, j+1) = wb(i, k, j+1) - temp63b43
            wb(i, k, j-2) = wb(i, k, j-2) - temp63b43
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
    END DO
  END IF
 100 CONTINUE
END SUBROUTINE A_ADVECT_W

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of advect_scalar_pd in reverse (adjoint) mode:
!   gradient     of useful results: rom field tendency h_tendency
!                z_tendency ru rv mu_old field_old mut
!   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:incr field:incr tendency:in-out
!                h_tendency:in-out z_tendency:in-out ru:incr rv:incr
!                mu_old:incr field_old:incr mut:incr
SUBROUTINE A_ADVECT_SCALAR_PD(field, fieldb, field_old, field_oldb, &
&  tendency, tendencyb, h_tendency, h_tendencyb, z_tendency, z_tendencyb&
&  , ru, rub, rv, rvb, rom, romb, mut, mutb, mub, mu_old, mu_oldb, &
&  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) :: fieldb, field_oldb, rub&
&  , rvb, romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut, mub, mu_old
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb, mu_oldb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: tendencyb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: h_tendency, z_tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: h_tendencyb, z_tendencyb
  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 :: ubb, vbb, mub0
!  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) :: fqxb, fqyb, fqzb
  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) :: fqxlb, fqylb, &
&  fqzlb
  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_outb, ph_lowb
  REAL :: scale
  REAL :: scaleb
  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 :: velb, crb
!      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.
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  INTEGER :: ad_from27
  INTEGER :: ad_to27
  INTEGER :: ad_from28
  INTEGER :: ad_to28
  INTEGER :: ad_from29
  INTEGER :: ad_to29
  INTEGER :: ad_from30
  INTEGER :: ad_to30
  INTEGER :: ad_from31
  INTEGER :: ad_to31
  INTEGER :: ad_from32
  INTEGER :: ad_to32
  INTEGER :: ad_from33
  INTEGER :: ad_to33
  INTEGER :: ad_from34
  INTEGER :: ad_to34
  INTEGER :: ad_from35
  INTEGER :: ad_to35
  INTEGER :: ad_from36
  INTEGER :: ad_to36
  INTEGER :: ad_from37
  INTEGER :: ad_to37
  INTEGER :: ad_from38
  INTEGER :: ad_to38
  INTEGER :: ad_from39
  INTEGER :: ad_to39
  INTEGER :: ad_from40
  INTEGER :: ad_to40
  INTEGER :: ad_from41
  INTEGER :: ad_to41
  INTEGER :: ad_from42
  INTEGER :: ad_to42
  INTEGER :: ad_from43
  INTEGER :: ad_to43
  INTEGER :: ad_from44
  INTEGER :: ad_to44
  INTEGER :: ad_from45
  INTEGER :: ad_to45
  INTEGER :: ad_from46
  INTEGER :: ad_to46
  INTEGER :: ad_from47
  INTEGER :: ad_to47
  INTEGER :: ad_from48
  INTEGER :: ad_to48
  INTEGER :: ad_from49
  INTEGER :: ad_to49
  INTEGER :: ad_from50
  INTEGER :: ad_to50
  INTEGER :: ad_from51
  INTEGER :: ad_to51
  INTEGER :: ad_from52
  INTEGER :: ad_to52
  INTEGER :: ad_from53
  INTEGER :: ad_to53
  INTEGER :: ad_from54
  INTEGER :: ad_to54
  INTEGER :: ad_from55
  INTEGER :: ad_to55
  INTEGER :: ad_from56
  INTEGER :: ad_to56
  INTEGER :: ad_from57
  INTEGER :: ad_to57
  INTEGER :: ad_from58
  INTEGER :: ad_to58
  INTEGER :: ad_from59
  INTEGER :: ad_to59
  INTEGER :: ad_from60
  INTEGER :: ad_to60
  INTEGER :: ad_from61
  INTEGER :: ad_to61
  INTEGER :: ad_from62
  INTEGER :: ad_to62
  INTEGER :: ad_from63
  INTEGER :: ad_to63
  REAL :: abs30
  REAL :: y93
  REAL :: max43
  REAL :: abs67
  REAL :: abs100
  REAL :: temp3
  REAL :: temp29
  REAL :: temp31b43
  REAL :: y86b
  REAL :: abs92b
  REAL :: y92
  REAL :: max42
  REAL :: abs66
  REAL :: temp2
  REAL :: min42b
  INTEGER :: temp28
  REAL :: y1b
  REAL :: temp31b42
  REAL :: temp31b79
  REAL :: y94b
  REAL :: y91
  REAL :: max41
  REAL :: abs65
  REAL :: temp1
  REAL :: abs18b
  REAL :: temp23b22
  REAL :: temp27
  REAL :: temp31b41
  REAL :: temp31b78
  REAL :: y90
  REAL :: max40
  REAL :: abs64
  INTEGER :: temp0
  REAL :: abs26b
  REAL :: temp26
  REAL :: temp23b21
  REAL :: temp31b40
  REAL :: max39b
  REAL :: temp31b77
  REAL :: abs63
  REAL :: temp7b
  REAL :: temp25
  REAL :: temp23b20
  REAL :: y28b
  REAL :: abs34b
  REAL :: min5b
  REAL :: max10b
  REAL :: temp31b76
  REAL :: max47b
  REAL :: abs62
  REAL :: abs99
  INTEGER :: temp24
  REAL :: abs79b
  REAL :: y36b
  REAL :: temp31b75
  REAL :: abs42b
  REAL :: temp35b6
  REAL :: abs61
  REAL :: abs98
  REAL :: temp23
  REAL :: abs87b
  REAL :: temp31b74
  REAL :: temp35b5
  REAL :: y44b
  REAL :: abs50b
  INTEGER :: min39
  REAL :: abs60
  REAL :: abs97
  REAL :: temp22
  REAL :: min37b
  REAL :: y52b
  REAL :: y89b
  REAL :: temp31b73
  REAL :: temp35b4
  REAL :: abs95b
  INTEGER :: min9
  REAL :: min38
  REAL :: abs96
  REAL :: temp21
  REAL :: y4b
  REAL :: y60b
  REAL :: temp31b72
  REAL :: temp35b3
  REAL :: y97b
  INTEGER :: min8
  REAL :: min37
  REAL :: abs95
  INTEGER :: temp20
  REAL :: temp31b71
  REAL :: temp35b2
  REAL :: min7
  REAL :: min36
  REAL :: abs94
  REAL :: abs29b
  REAL :: temp31b70
  REAL :: min61b
  REAL :: temp35b1
  REAL :: abs102b
  REAL :: min6
  INTEGER :: min35
  REAL :: y29
  REAL :: abs93
  REAL :: max13b
  REAL :: abs37b
  REAL :: temp35b0
  REAL :: min5
  INTEGER :: min34
  REAL :: y28
  REAL :: abs92
  REAL :: max21b
  REAL :: abs1b
  REAL :: y39b
  REAL :: abs45b
  REAL :: min4
  REAL :: min33
  REAL :: y27
  REAL :: abs91
  REAL :: abs53b
  REAL :: y10b
  REAL :: y47b
  REAL :: min3
  REAL :: min32
  REAL :: y26
  REAL :: min69
  REAL :: abs90
  REAL :: y55b
  REAL :: abs61b
  REAL :: abs98b
  INTEGER :: min2
  REAL :: min31
  REAL :: y25
  REAL :: min68
  REAL :: y63b
  REAL :: temp23b9
  REAL :: min48b
  REAL :: max2b
  REAL :: y7b
  REAL :: min11b
  INTEGER :: min1
  INTEGER :: min30
  REAL :: y24
  REAL :: min67
  REAL :: y71b
  REAL :: temp23b8
  REAL :: min56b
  REAL :: y23
  REAL :: min66
  REAL :: tempb4
  REAL :: temp19b
  REAL :: temp23b7
  REAL :: min64b
  REAL :: y22
  REAL :: min65
  REAL :: y59
  REAL :: tempb3
  REAL :: max16b
  REAL :: temp23b6
  REAL :: temp27b
  REAL :: y21
  REAL :: min64
  REAL :: y58
  REAL :: abs11b
  REAL :: tempb2
  REAL :: temp23b5
  REAL :: max24b
  REAL :: abs4b
  REAL :: temp35b
  REAL :: abs48b
  REAL :: y20
  REAL :: min63
  REAL :: y57
  REAL :: tempb1
  REAL :: y13b
  REAL :: temp23b4
  REAL :: max32b
  REAL :: abs56b
  REAL :: temp43b
  REAL :: min62
  REAL :: y56
  REAL :: tempb0
  REAL :: abs64b
  REAL :: y21b
  REAL :: temp23b3
  REAL :: y58b
  REAL :: max40b
  REAL :: temp47b18
  REAL :: min61
  REAL :: y55
  REAL :: abs29
  REAL :: y66b
  REAL :: abs72b
  REAL :: temp23b2
  REAL :: max5b
  REAL :: min14b
  REAL :: temp47b17
  REAL :: min60
  REAL :: y54
  REAL :: abs28
  REAL :: temp23b1
  REAL :: y74b
  REAL :: abs80b
  REAL :: min59b
  REAL :: y102b
  REAL :: temp47b16
  REAL :: y53
  REAL :: abs27
  REAL :: temp7b6
  REAL :: temp23b0
  REAL :: y82b
  REAL :: min67b
  REAL :: temp47b15
  REAL :: y52
  REAL :: abs26
  REAL :: y89
  REAL :: max39
  REAL :: temp7b5
  REAL :: max19b
  REAL :: temp31b39
  REAL :: y90b
  REAL :: min75b
  REAL :: temp47b14
  REAL :: y51
  REAL :: abs25
  REAL :: y88
  REAL :: max38
  REAL :: abs14b
  REAL :: temp7b4
  REAL :: max27b
  REAL :: temp23b19
  REAL :: abs7b
  REAL :: temp31b38
  REAL :: temp47b13
  REAL :: y50
  REAL :: abs24
  REAL :: y87
  REAL :: max37
  REAL :: temp7b3
  REAL :: y16b
  REAL :: abs22b
  REAL :: temp23b18
  REAL :: max35b
  REAL :: abs59b
  REAL :: temp31b37
  REAL :: temp47b12
  REAL :: abs23
  REAL :: y86
  REAL :: max36
  REAL :: temp3b
  REAL :: temp7b2
  REAL :: abs67b
  REAL :: y24b
  REAL :: temp23b17
  REAL :: abs30b
  REAL :: temp31b36
  REAL :: max43b
  REAL :: temp47b11
  REAL :: abs22
  REAL :: y85
  REAL :: max35
  REAL :: abs59
  REAL :: min17b
  REAL :: temp7b1
  REAL :: y69b
  REAL :: abs75b
  REAL :: temp23b16
  REAL :: y32b
  REAL :: max8b
  REAL :: temp31b35
  REAL :: max51b
  REAL :: temp47b10
  REAL :: abs21
  REAL :: y84
  REAL :: max34
  REAL :: abs58
  REAL :: temp7b0
  REAL :: min25b
  REAL :: temp23b15
  REAL :: y77b
  REAL :: abs83b
  REAL :: temp31b34
  REAL :: y40b
  REAL :: abs20
  REAL :: y83
  REAL :: max33
  REAL :: abs57
  REAL :: temp19
  REAL :: min33b
  REAL :: temp23b14
  REAL :: y85b
  REAL :: temp31b33
  REAL :: abs91b
  REAL :: y82
  REAL :: max32
  REAL :: abs56
  REAL :: temp18
  REAL :: temp23b13
  REAL :: min41b
  REAL :: temp31b32
  REAL :: temp31b69
  REAL :: y93b
  REAL :: y81
  REAL :: max31
  REAL :: abs55
  REAL :: temp11b4
  REAL :: abs17b
  REAL :: temp17
  REAL :: temp23b12
  REAL :: temp31b31
  REAL :: temp31b68
  REAL :: temp43b9
  REAL :: y80
  REAL :: max30
  REAL :: abs54
  REAL :: temp11b3
  INTEGER :: temp16
  REAL :: y19b
  REAL :: temp23b11
  REAL :: abs25b
  REAL :: temp31b30
  REAL :: max38b
  REAL :: temp31b67
  REAL :: temp43b8
  REAL :: abs53
  REAL :: temp11b2
  REAL :: temp15
  REAL :: temp23b10
  REAL :: y27b
  REAL :: abs33b
  REAL :: min4b
  REAL :: temp31b66
  REAL :: max46b
  REAL :: temp43b7
  REAL :: abs52
  REAL :: abs89
  REAL :: temp14
  REAL :: temp11b1
  REAL :: abs78b
  REAL :: y35b
  REAL :: temp31b65
  REAL :: abs41b
  REAL :: temp43b6
  REAL :: max54b
  REAL :: abs51
  REAL :: abs88
  REAL :: temp13
  REAL :: temp11b0
  REAL :: min28b
  REAL :: abs86b
  REAL :: temp31b64
  REAL :: y43b
  REAL :: temp43b5
  INTEGER :: min29
  REAL :: abs50
  REAL :: abs87
  INTEGER :: temp12
  REAL :: min36b
  REAL :: temp31b63
  REAL :: y88b
  REAL :: abs94b
  REAL :: temp43b4
  REAL :: y51b
  REAL :: min28
  REAL :: abs86
  REAL :: temp11
  REAL :: y3b
  REAL :: temp31b62
  REAL :: y96b
  REAL :: temp43b3
  REAL :: min27
  REAL :: abs85
  REAL :: temp10
  REAL :: min52b
  REAL :: temp31b61
  REAL :: temp43b2
  REAL :: min26
  REAL :: abs84
  REAL :: temp15b
  REAL :: abs28b
  REAL :: temp31b60
  REAL :: min60b
  REAL :: temp43b1
  REAL :: temp46
  REAL :: abs101b
  REAL :: min25
  REAL :: y19
  REAL :: abs83
  REAL :: max12b
  REAL :: temp23b
  REAL :: min7b
  REAL :: abs36b
  REAL :: temp43b0
  REAL :: max49b
  REAL :: temp45
  REAL :: min24
  REAL :: y18
  REAL :: abs82
  REAL :: max20b
  REAL :: temp19b6
  REAL :: temp31b
  REAL :: y38b
  REAL :: abs44b
  INTEGER :: temp44
  INTEGER :: min23
  REAL :: y17
  REAL :: abs81
  REAL :: temp19b5
  REAL :: abs52b
  REAL :: abs89b
  REAL :: y46b
  REAL :: temp43
  INTEGER :: min22
  REAL :: y16
  REAL :: min59
  REAL :: abs80
  REAL :: temp19b4
  REAL :: y54b
  REAL :: abs60b
  REAL :: temp42
  REAL :: abs97b
  REAL :: y15
  REAL :: min21
  REAL :: min58
  REAL :: y62b
  REAL :: temp19b3
  REAL :: min47b
  REAL :: temp31b9
  REAL :: y6b
  REAL :: min10b
  REAL :: temp41
  REAL :: y99b
  REAL :: max1b
  REAL :: y14
  REAL :: min20
  REAL :: min57
  REAL :: y70b
  REAL :: temp19b2
  REAL :: temp31b8
  REAL :: min55b
  INTEGER :: temp40
  REAL :: y13
  REAL :: min56
  REAL :: temp19b1
  REAL :: temp31b7
  REAL :: min63b
  REAL :: y12
  REAL :: min55
  REAL :: y49
  REAL :: max15b
  REAL :: temp19b0
  REAL :: temp31b6
  REAL :: abs39b
  REAL :: min71b
  REAL :: y11
  INTEGER :: min54
  REAL :: y48
  REAL :: max23b
  REAL :: temp31b5
  REAL :: abs3b
  REAL :: abs10b
  REAL :: abs47b
  REAL :: y10
  INTEGER :: min53
  REAL :: y47
  REAL :: y12b
  REAL :: max31b
  REAL :: temp31b4
  REAL :: abs55b
  REAL :: y49b
  REAL :: min52
  REAL :: y46
  REAL :: abs63b
  REAL :: y20b
  REAL :: temp31b3
  REAL :: y57b
  REAL :: min51
  REAL :: y45
  REAL :: abs19
  REAL :: tempb
  REAL :: y65b
  REAL :: abs71b
  REAL :: temp31b2
  REAL :: max4b
  REAL :: y9b
  REAL :: min13b
  INTEGER :: min50
  REAL :: y44
  REAL :: abs18
  REAL :: min21b
  REAL :: y73b
  REAL :: temp31b1
  REAL :: min58b
  REAL :: y101b
  REAL :: y43
  REAL :: abs17
  REAL :: y81b
  REAL :: temp31b0
  REAL :: min66b
  REAL :: y42
  REAL :: abs16
  REAL :: y79
  REAL :: max29
  REAL :: max18b
  REAL :: temp31b29
  REAL :: min74b
  REAL :: y41
  REAL :: abs15
  REAL :: y78
  REAL :: max28
  REAL :: abs13b
  REAL :: max26b
  REAL :: temp31b28
  REAL :: abs6b
  REAL :: y40
  REAL :: abs14
  REAL :: y77
  REAL :: max27
  REAL :: y15b
  REAL :: abs21b
  REAL :: max34b
  REAL :: temp31b27
  REAL :: abs58b
  REAL :: abs13
  REAL :: y76
  REAL :: max26
  REAL :: abs66b
  REAL :: y23b
  REAL :: temp31b26
  REAL :: max42b
  REAL :: abs12
  REAL :: y75
  REAL :: max25
  REAL :: abs49
  REAL :: y68b
  REAL :: abs74b
  REAL :: y31b
  REAL :: temp31b25
  REAL :: max7b
  REAL :: max50b
  REAL :: abs11
  REAL :: y74
  REAL :: max24
  REAL :: abs48
  REAL :: y102
  REAL :: min24b
  REAL :: y76b
  REAL :: abs82b
  REAL :: temp31b24
  REAL :: abs10
  REAL :: y73
  REAL :: max23
  REAL :: abs47
  REAL :: y101
  REAL :: min32b
  REAL :: y84b
  REAL :: temp31b23
  REAL :: abs90b
  REAL :: min69b
  REAL :: y72
  REAL :: max22
  REAL :: abs46
  REAL :: y100
  REAL :: temp31b22
  REAL :: temp31b59
  REAL :: y92b
  REAL :: y71
  REAL :: max21
  REAL :: abs45
  REAL :: abs16b
  REAL :: max29b
  REAL :: temp31b21
  REAL :: abs9b
  REAL :: temp31b58
  REAL :: temp39b3
  REAL :: y70
  REAL :: max20
  REAL :: abs44
  REAL :: temp11b
  REAL :: y18b
  REAL :: abs24b
  REAL :: temp31b20
  REAL :: temp31b57
  REAL :: max37b
  REAL :: temp39b2
  REAL :: abs43
  REAL :: abs69b
  REAL :: y26b
  REAL :: abs32b
  REAL :: min3b
  REAL :: temp31b56
  REAL :: temp39b1
  REAL :: max45b
  REAL :: abs42
  REAL :: abs79
  REAL :: min19b
  REAL :: abs77b
  REAL :: y34b
  REAL :: temp31b55
  REAL :: abs40b
  REAL :: temp39b0
  REAL :: max53b
  REAL :: abs41
  REAL :: abs78
  REAL :: max54
  REAL :: temp3b6
  REAL :: min27b
  REAL :: y79b
  REAL :: abs85b
  REAL :: temp31b54
  REAL :: y42b
  REAL :: min19
  REAL :: abs40
  REAL :: abs77
  REAL :: max53
  REAL :: temp3b5
  REAL :: temp31b53
  REAL :: y87b
  REAL :: abs93b
  REAL :: temp39
  REAL :: y50b
  REAL :: min18
  REAL :: max52
  REAL :: abs76
  REAL :: temp3b4
  REAL :: min43b
  REAL :: y2b
  REAL :: temp31b52
  REAL :: temp38
  REAL :: y95b
  REAL :: min17
  REAL :: max51
  REAL :: abs75
  REAL :: temp3b3
  REAL :: abs19b
  REAL :: temp27b9
  REAL :: min51b
  REAL :: temp31b51
  REAL :: temp37
  INTEGER :: min16
  REAL :: abs9
  REAL :: max50
  REAL :: abs74
  REAL :: temp3b2
  REAL :: abs27b
  REAL :: temp27b8
  REAL :: temp31b50
  INTEGER :: temp36
  REAL :: abs100b
  INTEGER :: min15
  REAL :: abs8
  REAL :: abs73
  REAL :: temp3b1
  REAL :: y29b
  REAL :: temp27b7
  REAL :: min6b
  REAL :: max11b
  REAL :: abs35b
  REAL :: temp35
  REAL :: max48b
  REAL :: min14
  REAL :: abs7
  REAL :: abs72
  REAL :: temp3b0
  REAL :: temp27b6
  REAL :: y37b
  REAL :: temp34
  REAL :: abs43b
  REAL :: min13
  REAL :: abs6
  REAL :: abs71
  REAL :: temp27b5
  REAL :: abs88b
  REAL :: temp33
  REAL :: y45b
  REAL :: abs51b
  REAL :: min12
  INTEGER :: min49
  REAL :: abs5
  REAL :: abs70
  REAL :: min38b
  REAL :: temp27b4
  REAL :: y53b
  INTEGER :: temp32
  REAL :: abs96b
  REAL :: min11
  REAL :: min48
  REAL :: abs4
  REAL :: temp27b3
  REAL :: min46b
  REAL :: y5b
  REAL :: y61b
  REAL :: temp31
  REAL :: y98b
  REAL :: min10
  REAL :: min47
  REAL :: abs3
  REAL :: temp27b2
  REAL :: temp30
  REAL :: temp31b81
  REAL :: min46
  REAL :: abs2
  REAL :: temp27b1
  REAL :: temp31b80
  REAL :: min62b
  INTEGER :: min45
  REAL :: y39
  REAL :: abs1
  REAL :: max14b
  REAL :: temp27b0
  REAL :: abs38b
  REAL :: min70b
  INTEGER :: min44
  REAL :: y38
  REAL :: max22b
  REAL :: abs2b
  REAL :: abs46b
  REAL :: min43
  REAL :: y37
  REAL :: y11b
  REAL :: max30b
  REAL :: abs54b
  REAL :: y48b
  REAL :: min42
  REAL :: y36
  REAL :: abs62b
  REAL :: y56b
  REAL :: abs99b
  REAL :: min41
  REAL :: y35
  REAL :: y64b
  REAL :: abs70b
  REAL :: max3b
  REAL :: y8b
  REAL :: min12b
  INTEGER :: min40
  REAL :: y34
  REAL :: min20b
  REAL :: y72b
  REAL :: min57b
  REAL :: y100b
  REAL :: y33
  REAL :: max9
  REAL :: min76
  REAL :: y80b
  REAL :: min65b
  REAL :: y32
  REAL :: max8
  REAL :: y69
  REAL :: max19
  REAL :: min75
  REAL :: max17b
  REAL :: temp31b19
  REAL :: temp43b16
  REAL :: y31
  REAL :: max7
  REAL :: y68
  REAL :: max18
  REAL :: min74
  REAL :: abs12b
  REAL :: temp15b5
  REAL :: max25b
  REAL :: temp31b18
  REAL :: abs5b
  REAL :: temp43b15
  REAL :: abs49b
  REAL :: y30
  INTEGER :: min73
  REAL :: max6
  REAL :: y67
  REAL :: max17
  REAL :: y14b
  REAL :: temp15b4
  REAL :: abs20b
  REAL :: max33b
  REAL :: temp31b17
  REAL :: abs57b
  REAL :: temp43b14
  REAL :: temp47b9
  INTEGER :: min72
  REAL :: max5
  REAL :: y66
  REAL :: max16
  REAL :: abs65b
  REAL :: temp15b3
  REAL :: y22b
  REAL :: temp31b16
  REAL :: y59b
  REAL :: max41b
  REAL :: temp43b13
  REAL :: temp47b8
  REAL :: y9
  REAL :: min71
  REAL :: max4
  REAL :: y65
  REAL :: max15
  REAL :: abs39
  REAL :: temp
  REAL :: y67b
  REAL :: temp15b2
  REAL :: abs73b
  REAL :: y30b
  REAL :: temp31b15
  REAL :: max6b
  REAL :: temp43b12
  REAL :: temp47b7
  REAL :: y8
  REAL :: min70
  REAL :: max3
  REAL :: y64
  REAL :: max14
  REAL :: abs38
  REAL :: temp15b1
  REAL :: y75b
  REAL :: abs81b
  REAL :: temp31b14
  REAL :: temp43b11
  REAL :: temp47b6
  REAL :: y7
  REAL :: max2
  REAL :: y63
  REAL :: max13
  REAL :: abs37
  REAL :: temp15b0
  REAL :: min31b
  REAL :: y83b
  REAL :: temp31b13
  REAL :: temp43b10
  REAL :: min68b
  REAL :: temp47b5
  REAL :: y6
  REAL :: max1
  REAL :: y62
  REAL :: max12
  REAL :: abs36
  REAL :: y99
  REAL :: max49
  REAL :: temp9
  REAL :: temp31b12
  REAL :: temp31b49
  REAL :: y91b
  REAL :: temp47b4
  REAL :: min76b
  REAL :: y5
  REAL :: y61
  REAL :: max11
  REAL :: abs35
  REAL :: y98
  REAL :: max48
  REAL :: abs15b
  INTEGER :: temp8
  REAL :: max28b
  REAL :: temp31b11
  REAL :: abs8b
  REAL :: temp31b48
  REAL :: temp39b
  REAL :: temp47b3
  REAL :: y4
  REAL :: y60
  REAL :: max10
  REAL :: abs34
  REAL :: y97
  REAL :: max47
  REAL :: temp7
  REAL :: y17b
  REAL :: abs23b
  REAL :: temp31b10
  REAL :: temp31b47
  REAL :: max36b
  REAL :: temp47b
  REAL :: temp47b2
  REAL :: y3
  REAL :: abs33
  REAL :: y96
  REAL :: max46
  REAL :: temp6
  REAL :: abs68b
  REAL :: y25b
  REAL :: abs31b
  REAL :: temp31b46
  REAL :: max44b
  REAL :: temp47b1
  REAL :: y2
  REAL :: abs32
  REAL :: y95
  REAL :: max45
  REAL :: abs69
  REAL :: abs102
  REAL :: min18b
  REAL :: temp5
  REAL :: abs76b
  REAL :: y33b
  REAL :: max9b
  REAL :: temp31b45
  REAL :: temp47b0
  REAL :: max52b
  REAL :: y1
  REAL :: abs31
  REAL :: y94
  REAL :: max44
  REAL :: abs68
  REAL :: abs101
  INTEGER :: temp4
  REAL :: min26b
  REAL :: y78b
  REAL :: abs84b
  REAL :: temp31b44
  REAL :: y41b
! 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
    END IF
    ad_from26 = j_start
!  compute fluxes, 6th order
j_loop_y_flux_6:DO j=ad_from26,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from21 = i_start
          DO i=ad_from21,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs1 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs1 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y1 = cr + abs1
            IF (1.0 .GT. y1) THEN
              CALL PUSHREAL8(min3)
              min3 = y1
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min3)
              min3 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs52 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs52 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y52 = cr - abs52
            IF (-1.0 .LT. y52) THEN
              CALL PUSHREAL8(max2)
              max2 = y52
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max2)
              max2 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min3*field_old(i, k, j-1)+&
&              0.5*max2*field_old(i, k, j))
            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)))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from21)
        END DO
        CALL PUSHCONTROL3B(5)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from22 = i_start
          DO i=ad_from22,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs2 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs2 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y2 = cr + abs2
            IF (1.0 .GT. y2) THEN
              CALL PUSHREAL8(min4)
              min4 = y2
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min4)
              min4 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs53 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs53 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y53 = cr - abs53
            IF (-1.0 .LT. y53) THEN
              CALL PUSHREAL8(max3)
              max3 = y53
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max3)
              max3 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min4*field_old(i, k, j-1)+&
&              0.5*max3*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from22)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from23 = i_start
          DO i=ad_from23,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs3 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs3 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y3 = cr + abs3
            IF (1.0 .GT. y3) THEN
              CALL PUSHREAL8(min5)
              min5 = y3
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min5)
              min5 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs54 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs54 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y54 = cr - abs54
            IF (-1.0 .LT. y54) THEN
              CALL PUSHREAL8(max4)
              max4 = y54
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max4)
              max4 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min5*field_old(i, k, j-1)+&
&              0.5*max4*field_old(i, k, j))
            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)))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from23)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from24 = i_start
          DO i=ad_from24,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs4 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs4 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y4 = cr + abs4
            IF (1.0 .GT. y4) THEN
              CALL PUSHREAL8(min6)
              min6 = y4
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min6)
              min6 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs55 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs55 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y55 = cr - abs55
            IF (-1.0 .LT. y55) THEN
              CALL PUSHREAL8(max5)
              max5 = y55
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max5)
              max5 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min6*field_old(i, k, j-1)+&
&              0.5*max5*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from24)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from25 = i_start
          DO i=ad_from25,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs5 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs5 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y5 = cr + abs5
            IF (1.0 .GT. y5) THEN
              CALL PUSHREAL8(min7)
              min7 = y5
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min7)
              min7 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs56 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs56 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y56 = cr - abs56
            IF (-1.0 .LT. y56) THEN
              CALL PUSHREAL8(max6)
              max6 = y56
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max6)
              max6 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min7*field_old(i, k, j-1)+&
&              0.5*max6*field_old(i, k, j))
            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)))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from25)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE
        CALL PUSHCONTROL3B(0)
      END IF
    END DO j_loop_y_flux_6
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from26)
!  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
    END IF
    ad_from28 = j_start
!  compute fluxes
    DO j=ad_from28,j_end
!  5th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          CALL PUSHREAL8(vel)
          vel = ru(i, k, j)
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs6 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs6 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y6 = cr + abs6
          IF (1.0 .GT. y6) THEN
            CALL PUSHREAL8(min10)
            min10 = y6
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min10)
            min10 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs57 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs57 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y57 = cr - abs57
          IF (-1.0 .LT. y57) THEN
            CALL PUSHREAL8(max7)
            max7 = y57
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max7)
            max7 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min10*field_old(i-1, k, j)+0.5&
&            *max7*field_old(i, k, j))
          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)))
          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
        ad_from27 = i_start
        DO i=ad_from27,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)/mu
              cr = vel*dt/dx
              IF (cr .GE. 0.) THEN
                abs7 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs7 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y7 = cr + abs7
              IF (1.0 .GT. y7) THEN
                CALL PUSHREAL8(min11)
                min11 = y7
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min11)
                min11 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs58 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs58 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y58 = cr - abs58
              IF (-1.0 .LT. y58) THEN
                CALL PUSHREAL8(max8)
                max8 = y58
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max8)
                max8 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min11*field_old(i-1, k, j)&
&                +0.5*max8*field_old(i, k, j))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
! fourth order
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs8 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs8 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y8 = cr + abs8
              IF (1.0 .GT. y8) THEN
                CALL PUSHREAL8(min12)
                min12 = y8
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min12)
                min12 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs59 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs59 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y59 = cr - abs59
              IF (-1.0 .LT. y59) THEN
                CALL PUSHREAL8(max9)
                max9 = y59
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max9)
                max9 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min12*field_old(i-1, k, j)&
&                +0.5*max9*field_old(i, k, j))
              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)))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from27)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      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
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs9 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs9 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y9 = cr + abs9
              IF (1.0 .GT. y9) THEN
                CALL PUSHREAL8(min13)
                min13 = y9
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min13)
                min13 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs60 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs60 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y60 = cr - abs60
              IF (-1.0 .LT. y60) THEN
                CALL PUSHREAL8(max10)
                max10 = y60
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max10)
                max10 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min13*field_old(i-1, k, j)&
&                +0.5*max10*field_old(i, k, j))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
! fourth order flux one in from the boundary
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs10 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs10 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y10 = cr + abs10
              IF (1.0 .GT. y10) THEN
                CALL PUSHREAL8(min14)
                min14 = y10
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min14)
                min14 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs61 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs61 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y61 = cr - abs61
              IF (-1.0 .LT. y61) THEN
                CALL PUSHREAL8(max11)
                max11 = y61
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max11)
                max11 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min14*field_old(i-1, k, j)&
&                +0.5*max11*field_old(i, k, j))
              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)))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from28)
    CALL PUSHCONTROL3B(5)
  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
    END IF
    ad_from4 = j_start
!  compute fluxes, 5th order
j_loop_y_flux_5:DO j=ad_from4,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from = i_start
          DO i=ad_from,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs11 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs11 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y11 = cr + abs11
            IF (1.0 .GT. y11) THEN
              CALL PUSHREAL8(min17)
              min17 = y11
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min17)
              min17 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs62 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs62 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y62 = cr - abs62
            IF (-1.0 .LT. y62) THEN
              CALL PUSHREAL8(max12)
              max12 = y62
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max12)
              max12 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min17*field_old(i, k, j-1)+&
&              0.5*max12*field_old(i, k, j))
            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))))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHCONTROL3B(5)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from0 = i_start
          DO i=ad_from0,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs12 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs12 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y12 = cr + abs12
            IF (1.0 .GT. y12) THEN
              CALL PUSHREAL8(min18)
              min18 = y12
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min18)
              min18 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs63 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs63 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y63 = cr - abs63
            IF (-1.0 .LT. y63) THEN
              CALL PUSHREAL8(max13)
              max13 = y63
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max13)
              max13 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min18*field_old(i, k, j-1)+&
&              0.5*max13*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from0)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from1 = i_start
          DO i=ad_from1,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs13 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs13 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y13 = cr + abs13
            IF (1.0 .GT. y13) THEN
              CALL PUSHREAL8(min19)
              min19 = y13
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min19)
              min19 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs64 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs64 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y64 = cr - abs64
            IF (-1.0 .LT. y64) THEN
              CALL PUSHREAL8(max14)
              max14 = y64
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max14)
              max14 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min19*field_old(i, k, j-1)+&
&              0.5*max14*field_old(i, k, j))
            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))))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from2 = i_start
          DO i=ad_from2,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs14 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs14 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y14 = cr + abs14
            IF (1.0 .GT. y14) THEN
              CALL PUSHREAL8(min20)
              min20 = y14
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min20)
              min20 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs65 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs65 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y65 = cr - abs65
            IF (-1.0 .LT. y65) THEN
              CALL PUSHREAL8(max15)
              max15 = y65
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max15)
              max15 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min20*field_old(i, k, j-1)+&
&              0.5*max15*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from2)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from3 = i_start
          DO i=ad_from3,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs15 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs15 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y15 = cr + abs15
            IF (1.0 .GT. y15) THEN
              CALL PUSHREAL8(min21)
              min21 = y15
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min21)
              min21 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs66 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs66 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y66 = cr - abs66
            IF (-1.0 .LT. y66) THEN
              CALL PUSHREAL8(max16)
              max16 = y66
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max16)
              max16 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min21*field_old(i, k, j-1)+&
&              0.5*max16*field_old(i, k, j))
            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))))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE
        CALL PUSHCONTROL3B(0)
      END IF
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from4)
!  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
    END IF
    ad_from6 = j_start
!  compute fluxes
    DO j=ad_from6,j_end
!  5th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          CALL PUSHREAL8(vel)
          vel = ru(i, k, j)
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs16 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs16 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y16 = cr + abs16
          IF (1.0 .GT. y16) THEN
            CALL PUSHREAL8(min24)
            min24 = y16
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min24)
            min24 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs67 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs67 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y67 = cr - abs67
          IF (-1.0 .LT. y67) THEN
            CALL PUSHREAL8(max17)
            max17 = y67
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max17)
            max17 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min24*field_old(i-1, k, j)+0.5&
&            *max17*field_old(i, k, j))
          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))&
&            ))
          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
        ad_from5 = i_start
        DO i=ad_from5,i_start_f-1
          IF (i .EQ. ids + 1) THEN
! second order
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)/mu
              cr = vel*dt/dx
              IF (cr .GE. 0.) THEN
                abs17 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs17 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y17 = cr + abs17
              IF (1.0 .GT. y17) THEN
                CALL PUSHREAL8(min25)
                min25 = y17
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min25)
                min25 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs68 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs68 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y68 = cr - abs68
              IF (-1.0 .LT. y68) THEN
                CALL PUSHREAL8(max18)
                max18 = y68
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max18)
                max18 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min25*field_old(i-1, k, j)&
&                +0.5*max18*field_old(i, k, j))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
! third order
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs18 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs18 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y18 = cr + abs18
              IF (1.0 .GT. y18) THEN
                CALL PUSHREAL8(min26)
                min26 = y18
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min26)
                min26 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs69 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs69 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y69 = cr - abs69
              IF (-1.0 .LT. y69) THEN
                CALL PUSHREAL8(max19)
                max19 = y69
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max19)
                max19 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min26*field_old(i-1, k, j)&
&                +0.5*max19*field_old(i, k, j))
              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))))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from5)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      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
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs19 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs19 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y19 = cr + abs19
              IF (1.0 .GT. y19) THEN
                CALL PUSHREAL8(min27)
                min27 = y19
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min27)
                min27 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs70 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs70 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y70 = cr - abs70
              IF (-1.0 .LT. y70) THEN
                CALL PUSHREAL8(max20)
                max20 = y70
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max20)
                max20 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min27*field_old(i-1, k, j)&
&                +0.5*max20*field_old(i, k, j))
              fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, &
&                k, j))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
! third order flux one in from the boundary
            DO k=kts,ktf
              CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
              dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
              CALL PUSHREAL8(mu)
              mu = 0.5*(mut(i, j)+mut(i-1, j))
              CALL PUSHREAL8(vel)
              vel = ru(i, k, j)
              cr = vel*dt/dx/mu
              IF (cr .GE. 0.) THEN
                abs20 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs20 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y20 = cr + abs20
              IF (1.0 .GT. y20) THEN
                CALL PUSHREAL8(min28)
                min28 = y20
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(min28)
                min28 = 1.0
                CALL PUSHCONTROL1B(1)
              END IF
              IF (cr .GE. 0.) THEN
                abs71 = cr
                CALL PUSHCONTROL1B(0)
              ELSE
                abs71 = -cr
                CALL PUSHCONTROL1B(1)
              END IF
              y71 = cr - abs71
              IF (-1.0 .LT. y71) THEN
                CALL PUSHREAL8(max21)
                max21 = y71
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHREAL8(max21)
                max21 = -1.0
                CALL PUSHCONTROL1B(1)
              END IF
              fqxl(i, k, j) = mu*(dx/dt)*(0.5*min28*field_old(i-1, k, j)&
&                +0.5*max21*field_old(i, k, j))
              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))))
              fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
            END DO
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from6)
    CALL PUSHCONTROL3B(4)
  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
    END IF
    ad_from10 = j_start
!  compute fluxes, 4th order
j_loop_y_flux_4:DO j=ad_from10,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from7 = i_start
          DO i=ad_from7,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs21 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs21 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y21 = cr + abs21
            IF (1.0 .GT. y21) THEN
              CALL PUSHREAL8(min31)
              min31 = y21
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min31)
              min31 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs72 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs72 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y72 = cr - abs72
            IF (-1.0 .LT. y72) THEN
              CALL PUSHREAL8(max22)
              max22 = y72
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max22)
              max22 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min31*field_old(i, k, j-1)+&
&              0.5*max22*field_old(i, k, j))
            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)))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from7)
        END DO
        CALL PUSHCONTROL2B(3)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from8 = i_start
          DO i=ad_from8,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs22 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs22 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y22 = cr + abs22
            IF (1.0 .GT. y22) THEN
              CALL PUSHREAL8(min32)
              min32 = y22
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min32)
              min32 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs73 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs73 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y73 = cr - abs73
            IF (-1.0 .LT. y73) THEN
              CALL PUSHREAL8(max23)
              max23 = y73
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max23)
              max23 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min32*field_old(i, k, j-1)+&
&              0.5*max23*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from8)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from9 = i_start
          DO i=ad_from9,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs23 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs23 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y23 = cr + abs23
            IF (1.0 .GT. y23) THEN
              CALL PUSHREAL8(min33)
              min33 = y23
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min33)
              min33 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs74 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs74 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y74 = cr - abs74
            IF (-1.0 .LT. y74) THEN
              CALL PUSHREAL8(max24)
              max24 = y74
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max24)
              max24 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min33*field_old(i, k, j-1)+&
&              0.5*max24*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from9)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    END DO j_loop_y_flux_4
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from10)
!  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
    END IF
    ad_from11 = j_start
!  compute fluxes
    DO j=ad_from11,j_end
!  4th order flux
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          CALL PUSHREAL8(vel)
          vel = ru(i, k, j)
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs24 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs24 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y24 = cr + abs24
          IF (1.0 .GT. y24) THEN
            CALL PUSHREAL8(min36)
            min36 = y24
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min36)
            min36 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs75 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs75 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y75 = cr - abs75
          IF (-1.0 .LT. y75) THEN
            CALL PUSHREAL8(max25)
            max25 = y75
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max25)
            max25 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min36*field_old(i-1, k, j)+0.5&
&            *max25*field_old(i, k, j))
          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)))
          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
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)/mu
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs25 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs25 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y25 = cr + abs25
            IF (1.0 .GT. y25) THEN
              CALL PUSHREAL8(min37)
              min37 = y25
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min37)
              min37 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs76 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs76 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y76 = cr - abs76
            IF (-1.0 .LT. y76) THEN
              CALL PUSHREAL8(max26)
              max26 = y76
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max26)
              max26 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min37*field_old(i-1, k, j)+&
&              0.5*max26*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL2B(0)
        ELSE
          CALL PUSHCONTROL2B(1)
        END IF
      ELSE
        CALL PUSHCONTROL2B(2)
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 2) THEN
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ide - 1
          DO k=kts,ktf
            CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs26 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs26 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y26 = cr + abs26
            IF (1.0 .GT. y26) THEN
              CALL PUSHREAL8(min38)
              min38 = y26
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min38)
              min38 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs77 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs77 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y77 = cr - abs77
            IF (-1.0 .LT. y77) THEN
              CALL PUSHREAL8(max27)
              max27 = y77
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max27)
              max27 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min38*field_old(i-1, k, j)+&
&              0.5*max27*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL2B(2)
        ELSE
          CALL PUSHCONTROL2B(1)
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from11)
    CALL PUSHCONTROL3B(3)
  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
    END IF
    ad_from15 = j_start
!  compute fluxes, 3rd order
j_loop_y_flux_3:DO j=ad_from15,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from12 = i_start
          DO i=ad_from12,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs27 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs27 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y27 = cr + abs27
            IF (1.0 .GT. y27) THEN
              CALL PUSHREAL8(min41)
              min41 = y27
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min41)
              min41 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs78 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs78 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y78 = cr - abs78
            IF (-1.0 .LT. y78) THEN
              CALL PUSHREAL8(max28)
              max28 = y78
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max28)
              max28 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min41*field_old(i, k, j-1)+&
&              0.5*max28*field_old(i, k, j))
            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))))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from12)
        END DO
        CALL PUSHCONTROL2B(3)
      ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
        DO k=kts,ktf
          ad_from13 = i_start
          DO i=ad_from13,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs28 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs28 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y28 = cr + abs28
            IF (1.0 .GT. y28) THEN
              CALL PUSHREAL8(min42)
              min42 = y28
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min42)
              min42 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs79 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs79 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y79 = cr - abs79
            IF (-1.0 .LT. y79) THEN
              CALL PUSHREAL8(max29)
              max29 = y79
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max29)
              max29 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min42*field_old(i, k, j-1)+&
&              0.5*max29*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from13)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from14 = i_start
          DO i=ad_from14,i_end
            CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
            dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i, j-1))
            CALL PUSHREAL8(vel)
            vel = rv(i, k, j)
            cr = vel*dt/dy/mu
            IF (cr .GE. 0.) THEN
              abs29 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs29 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y29 = cr + abs29
            IF (1.0 .GT. y29) THEN
              CALL PUSHREAL8(min43)
              min43 = y29
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min43)
              min43 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs80 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs80 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y80 = cr - abs80
            IF (-1.0 .LT. y80) THEN
              CALL PUSHREAL8(max30)
              max30 = y80
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max30)
              max30 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqyl(i, k, j) = mu*(dy/dt)*(0.5*min43*field_old(i, k, j-1)+&
&              0.5*max30*field_old(i, k, j))
            fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j&
&              -1))
            fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from14)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    END DO j_loop_y_flux_3
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from15)
!  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
    END IF
    ad_from16 = j_start
!  compute fluxes
    DO j=ad_from16,j_end
!  4th order flux
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
        DO i=i_start_f,i_end_f
          CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          CALL PUSHREAL8(vel)
          vel = ru(i, k, j)
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs30 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs30 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y30 = cr + abs30
          IF (1.0 .GT. y30) THEN
            CALL PUSHREAL8(min46)
            min46 = y30
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min46)
            min46 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs81 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs81 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y81 = cr - abs81
          IF (-1.0 .LT. y81) THEN
            CALL PUSHREAL8(max31)
            max31 = y81
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max31)
            max31 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min46*field_old(i-1, k, j)+0.5&
&            *max31*field_old(i, k, j))
          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))))
          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
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ids + 1
          DO k=kts,ktf
            CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)/mu
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs31 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs31 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y31 = cr + abs31
            IF (1.0 .GT. y31) THEN
              CALL PUSHREAL8(min47)
              min47 = y31
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min47)
              min47 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs82 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs82 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y82 = cr - abs82
            IF (-1.0 .LT. y82) THEN
              CALL PUSHREAL8(max32)
              max32 = y82
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max32)
              max32 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min47*field_old(i-1, k, j)+&
&              0.5*max32*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL2B(0)
        ELSE
          CALL PUSHCONTROL2B(1)
        END IF
      ELSE
        CALL PUSHCONTROL2B(2)
      END IF
      IF (degrade_xe) THEN
        IF (i_end .EQ. ide - 2) THEN
          CALL PUSHINTEGER4(i)
! second order flux next to the boundary
          i = ide - 1
          DO k=kts,ktf
            CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs32 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs32 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y32 = cr + abs32
            IF (1.0 .GT. y32) THEN
              CALL PUSHREAL8(min48)
              min48 = y32
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min48)
              min48 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs83 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs83 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y83 = cr - abs83
            IF (-1.0 .LT. y83) THEN
              CALL PUSHREAL8(max33)
              max33 = y83
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max33)
              max33 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min48*field_old(i-1, k, j)+&
&              0.5*max33*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&              , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL2B(2)
        ELSE
          CALL PUSHCONTROL2B(1)
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from16)
    CALL PUSHCONTROL3B(2)
  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
    END IF
    ad_from18 = j_start
!  compute fluxes, 2nd order, y flux
    DO j=ad_from18,j_end+1
      DO k=kts,ktf
        ad_from17 = i_start
        DO i=ad_from17,i_end
          CALL PUSHREAL8(dy)
! ADT eqn 48 d/dy
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs33 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs33 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y33 = cr + abs33
          IF (1.0 .GT. y33) THEN
            CALL PUSHREAL8(min51)
            min51 = y33
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min51)
            min51 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs84 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs84 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y84 = cr - abs84
          IF (-1.0 .LT. y84) THEN
            CALL PUSHREAL8(max34)
            max34 = y84
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max34)
            max34 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min51*field_old(i, k, j-1)+0.5&
&            *max34*field_old(i, k, j))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&            ))
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from17)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from18)
    ad_from20 = j_start
!  next, x flux
    DO j=ad_from20,j_end
      DO k=kts,ktf
        ad_from19 = i_start
        DO i=ad_from19,i_end+1
          CALL PUSHREAL8(dx)
! ADT eqn 48 d/dx
          dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i-1, j))
          CALL PUSHREAL8(vel)
          vel = ru(i, k, j)
          cr = vel*dt/dx/mu
          IF (cr .GE. 0.) THEN
            abs34 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs34 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y34 = cr + abs34
          IF (1.0 .GT. y34) THEN
            CALL PUSHREAL8(min52)
            min52 = y34
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min52)
            min52 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs85 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs85 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y85 = cr - abs85
          IF (-1.0 .LT. y85) THEN
            CALL PUSHREAL8(max35)
            max35 = y85
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max35)
            max35 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqxl(i, k, j) = mu*(dx/dt)*(0.5*min52*field_old(i-1, k, j)+0.5&
&            *max35*field_old(i, k, j))
          fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k, j&
&            ))
          fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from19)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from20)
    CALL PUSHCONTROL3B(1)
  ELSE
    CALL PUSHCONTROL3B(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
    ad_from29 = j_start
    DO j=ad_from29,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from29)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from30 = j_start
    DO j=ad_from30,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from30)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from31 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from31,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from31)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from32 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from32,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from32)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
    ad_from33 = i_start
    CALL PUSHINTEGER4(i)
! Assuming rv(i,k,jds) = 0.
    DO i=ad_from33,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jts+1) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*rv(i, k, jts+1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from33)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    ad_from34 = i_start
    CALL PUSHINTEGER4(i)
! Assuming rv(i,k,jde) = 0.
    DO i=ad_from34,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jte-1) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*rv(i, k, jte-1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from34)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
  CALL PUSHINTEGER4(i_end)
  i_end = min53 + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min54 = jde - 1
  ELSE
    min54 = jte
  END IF
  CALL PUSHINTEGER4(j_end)
  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
    ad_from38 = j_start
    DO j=ad_from38,j_end
      ad_from35 = i_start
      CALL PUSHINTEGER4(i)
      DO i=ad_from35,i_end
        fqz(i, 1, j) = 0.
        fqzl(i, 1, j) = 0.
        fqz(i, kde, j) = 0.
        fqzl(i, kde, j) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from35)
      CALL PUSHINTEGER4(k)
      DO k=kts+3,ktf-2
        ad_from36 = i_start
        DO i=ad_from36,i_end
          CALL PUSHREAL8(dz)
          dz = 2./(rdzw(k)+rdzw(k-1))
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL PUSHREAL8(vel)
          vel = rom(i, k, j)
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs35 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs35 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y35 = cr + abs35
          IF (1.0 .GT. y35) THEN
            CALL PUSHREAL8(min55)
            min55 = y35
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min55)
            min55 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs86 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs86 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y86 = cr - abs86
          IF (-1.0 .LT. y86) THEN
            CALL PUSHREAL8(max36)
            max36 = y86
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max36)
            max36 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min55*field_old(i, k-1, j)+0.5&
&            *max36*field_old(i, k, j))
          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)))
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from36)
      END DO
      ad_from37 = i_start
      DO i=ad_from37,i_end
        CALL PUSHINTEGER4(k)
        k = kts + 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs36 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs36 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y36 = cr + abs36
        IF (1.0 .GT. y36) THEN
          CALL PUSHREAL8(min56)
          min56 = y36
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min56)
          min56 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs87 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs87 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y87 = cr - abs87
        IF (-1.0 .LT. y87) THEN
          CALL PUSHREAL8(max37)
          max37 = y87
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max37)
          max37 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min56*field_old(i, k-1, j)+0.5*&
&          max37*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = kts + 2
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs37 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs37 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y37 = cr + abs37
        IF (1.0 .GT. y37) THEN
          CALL PUSHREAL8(min57)
          min57 = y37
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min57)
          min57 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs88 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs88 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y88 = cr - abs88
        IF (-1.0 .LT. y88) THEN
          CALL PUSHREAL8(max38)
          max38 = y88
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max38)
          max38 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min57*field_old(i, k-1, j)+0.5*&
&          max38*field_old(i, k, j))
        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)))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf - 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs38 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs38 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y38 = cr + abs38
        IF (1.0 .GT. y38) THEN
          CALL PUSHREAL8(min58)
          min58 = y38
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min58)
          min58 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs89 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs89 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y89 = cr - abs89
        IF (-1.0 .LT. y89) THEN
          CALL PUSHREAL8(max39)
          max39 = y89
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max39)
          max39 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min58*field_old(i, k-1, j)+0.5*&
&          max39*field_old(i, k, j))
        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)))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs39 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs39 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y39 = cr + abs39
        IF (1.0 .GT. y39) THEN
          CALL PUSHREAL8(min59)
          min59 = y39
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min59)
          min59 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs90 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs90 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y90 = cr - abs90
        IF (-1.0 .LT. y90) THEN
          CALL PUSHREAL8(max40)
          max40 = y90
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max40)
          max40 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min59*field_old(i, k-1, j)+0.5*&
&          max40*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from37)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from38)
    CALL PUSHCONTROL3B(0)
  ELSE IF (vert_order .EQ. 5) THEN
    ad_from42 = j_start
    DO j=ad_from42,j_end
      ad_from39 = i_start
      CALL PUSHINTEGER4(i)
      DO i=ad_from39,i_end
        fqz(i, 1, j) = 0.
        fqzl(i, 1, j) = 0.
        fqz(i, kde, j) = 0.
        fqzl(i, kde, j) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from39)
      CALL PUSHINTEGER4(k)
      DO k=kts+3,ktf-2
        ad_from40 = i_start
        DO i=ad_from40,i_end
          CALL PUSHREAL8(dz)
          dz = 2./(rdzw(k)+rdzw(k-1))
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL PUSHREAL8(vel)
          vel = rom(i, k, j)
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs40 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs40 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y40 = cr + abs40
          IF (1.0 .GT. y40) THEN
            CALL PUSHREAL8(min60)
            min60 = y40
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min60)
            min60 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs91 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs91 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y91 = cr - abs91
          IF (-1.0 .LT. y91) THEN
            CALL PUSHREAL8(max41)
            max41 = y91
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max41)
            max41 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min60*field_old(i, k-1, j)+0.5&
&            *max41*field_old(i, k, j))
          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))&
&            ))
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from40)
      END DO
      ad_from41 = i_start
      DO i=ad_from41,i_end
        CALL PUSHINTEGER4(k)
        k = kts + 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs41 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs41 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y41 = cr + abs41
        IF (1.0 .GT. y41) THEN
          CALL PUSHREAL8(min61)
          min61 = y41
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min61)
          min61 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs92 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs92 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y92 = cr - abs92
        IF (-1.0 .LT. y92) THEN
          CALL PUSHREAL8(max42)
          max42 = y92
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max42)
          max42 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min61*field_old(i, k-1, j)+0.5*&
&          max42*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = kts + 2
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs42 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs42 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y42 = cr + abs42
        IF (1.0 .GT. y42) THEN
          CALL PUSHREAL8(min62)
          min62 = y42
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min62)
          min62 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs93 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs93 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y93 = cr - abs93
        IF (-1.0 .LT. y93) THEN
          CALL PUSHREAL8(max43)
          max43 = y93
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max43)
          max43 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min62*field_old(i, k-1, j)+0.5*&
&          max43*field_old(i, k, j))
        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))))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf - 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs43 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs43 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y43 = cr + abs43
        IF (1.0 .GT. y43) THEN
          CALL PUSHREAL8(min63)
          min63 = y43
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min63)
          min63 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs94 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs94 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y94 = cr - abs94
        IF (-1.0 .LT. y94) THEN
          CALL PUSHREAL8(max44)
          max44 = y94
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max44)
          max44 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min63*field_old(i, k-1, j)+0.5*&
&          max44*field_old(i, k, j))
        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))))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs44 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs44 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y44 = cr + abs44
        IF (1.0 .GT. y44) THEN
          CALL PUSHREAL8(min64)
          min64 = y44
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min64)
          min64 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs95 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs95 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y95 = cr - abs95
        IF (-1.0 .LT. y95) THEN
          CALL PUSHREAL8(max45)
          max45 = y95
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max45)
          max45 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min64*field_old(i, k-1, j)+0.5*&
&          max45*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from41)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from42)
    CALL PUSHCONTROL3B(1)
  ELSE IF (vert_order .EQ. 4) THEN
    ad_from46 = j_start
    DO j=ad_from46,j_end
      ad_from43 = i_start
      CALL PUSHINTEGER4(i)
      DO i=ad_from43,i_end
        fqz(i, 1, j) = 0.
        fqzl(i, 1, j) = 0.
        fqz(i, kde, j) = 0.
        fqzl(i, kde, j) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from43)
      CALL PUSHINTEGER4(k)
      DO k=kts+2,ktf-1
        ad_from44 = i_start
        DO i=ad_from44,i_end
          CALL PUSHREAL8(dz)
          dz = 2./(rdzw(k)+rdzw(k-1))
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL PUSHREAL8(vel)
          vel = rom(i, k, j)
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs45 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs45 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y45 = cr + abs45
          IF (1.0 .GT. y45) THEN
            CALL PUSHREAL8(min65)
            min65 = y45
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min65)
            min65 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs96 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs96 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y96 = cr - abs96
          IF (-1.0 .LT. y96) THEN
            CALL PUSHREAL8(max46)
            max46 = y96
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max46)
            max46 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min65*field_old(i, k-1, j)+0.5&
&            *max46*field_old(i, k, j))
          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)))
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from44)
      END DO
      ad_from45 = i_start
      DO i=ad_from45,i_end
        CALL PUSHINTEGER4(k)
        k = kts + 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs46 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs46 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y46 = cr + abs46
        IF (1.0 .GT. y46) THEN
          CALL PUSHREAL8(min66)
          min66 = y46
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min66)
          min66 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs97 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs97 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y97 = cr - abs97
        IF (-1.0 .LT. y97) THEN
          CALL PUSHREAL8(max47)
          max47 = y97
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max47)
          max47 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min66*field_old(i, k-1, j)+0.5*&
&          max47*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs47 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs47 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y47 = cr + abs47
        IF (1.0 .GT. y47) THEN
          CALL PUSHREAL8(min67)
          min67 = y47
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min67)
          min67 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs98 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs98 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y98 = cr - abs98
        IF (-1.0 .LT. y98) THEN
          CALL PUSHREAL8(max48)
          max48 = y98
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max48)
          max48 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min67*field_old(i, k-1, j)+0.5*&
&          max48*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from45)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from46)
    CALL PUSHCONTROL3B(2)
  ELSE IF (vert_order .EQ. 3) THEN
    ad_from50 = j_start
    DO j=ad_from50,j_end
      ad_from47 = i_start
      CALL PUSHINTEGER4(i)
      DO i=ad_from47,i_end
        fqz(i, 1, j) = 0.
        fqzl(i, 1, j) = 0.
        fqz(i, kde, j) = 0.
        fqzl(i, kde, j) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from47)
      CALL PUSHINTEGER4(k)
      DO k=kts+2,ktf-1
        ad_from48 = i_start
        DO i=ad_from48,i_end
          CALL PUSHREAL8(dz)
          dz = 2./(rdzw(k)+rdzw(k-1))
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL PUSHREAL8(vel)
          vel = rom(i, k, j)
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs48 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs48 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y48 = cr + abs48
          IF (1.0 .GT. y48) THEN
            CALL PUSHREAL8(min68)
            min68 = y48
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min68)
            min68 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs99 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs99 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y99 = cr - abs99
          IF (-1.0 .LT. y99) THEN
            CALL PUSHREAL8(max49)
            max49 = y99
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max49)
            max49 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min68*field_old(i, k-1, j)+0.5&
&            *max49*field_old(i, k, j))
          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))))
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from48)
      END DO
      ad_from49 = i_start
      DO i=ad_from49,i_end
        CALL PUSHINTEGER4(k)
        k = kts + 1
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs49 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs49 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y49 = cr + abs49
        IF (1.0 .GT. y49) THEN
          CALL PUSHREAL8(min69)
          min69 = y49
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min69)
          min69 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs100 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs100 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y100 = cr - abs100
        IF (-1.0 .LT. y100) THEN
          CALL PUSHREAL8(max50)
          max50 = y100
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max50)
          max50 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min69*field_old(i, k-1, j)+0.5*&
&          max50*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        k = ktf
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs50 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs50 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y50 = cr + abs50
        IF (1.0 .GT. y50) THEN
          CALL PUSHREAL8(min70)
          min70 = y50
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min70)
          min70 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs101 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs101 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y101 = cr - abs101
        IF (-1.0 .LT. y101) THEN
          CALL PUSHREAL8(max51)
          max51 = y101
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max51)
          max51 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        fqzl(i, k, j) = mu*(dz/dt)*(0.5*min70*field_old(i, k-1, j)+0.5*&
&          max51*field_old(i, k, j))
        fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(&
&          i, k-1, j))
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from49)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from50)
    CALL PUSHCONTROL3B(3)
  ELSE IF (vert_order .EQ. 2) THEN
    ad_from53 = j_start
    DO j=ad_from53,j_end
      ad_from51 = i_start
      CALL PUSHINTEGER4(i)
      DO i=ad_from51,i_end
        fqz(i, 1, j) = 0.
        fqzl(i, 1, j) = 0.
        fqz(i, kde, j) = 0.
        fqzl(i, kde, j) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from51)
      DO k=kts+1,ktf
        ad_from52 = i_start
        DO i=ad_from52,i_end
          CALL PUSHREAL8(dz)
          dz = 2./(rdzw(k)+rdzw(k-1))
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL PUSHREAL8(vel)
          vel = rom(i, k, j)
          cr = vel*dt/dz/mu
          IF (cr .GE. 0.) THEN
            abs51 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs51 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y51 = cr + abs51
          IF (1.0 .GT. y51) THEN
            CALL PUSHREAL8(min71)
            min71 = y51
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min71)
            min71 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs102 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs102 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y102 = cr - abs102
          IF (-1.0 .LT. y102) THEN
            CALL PUSHREAL8(max52)
            max52 = y102
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max52)
            max52 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqzl(i, k, j) = mu*(dz/dt)*(0.5*min71*field_old(i, k-1, j)+0.5&
&            *max52*field_old(i, k, j))
          fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))
          fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from52)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from53)
    CALL PUSHCONTROL3B(4)
  ELSE
    CALL PUSHCONTROL3B(5)
  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
      END IF
    END IF
    ad_from55 = j_start
! 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=ad_from55,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from54 = i_start
        CALL PUSHINTEGER4(i)
        DO i=ad_from54,i_end
          CALL PUSHREAL8(ph_low(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
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from54)
      END DO
    ENDDO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from55)

    ad_from55 = j_start
    DO j=ad_from55,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from54 = i_start
        CALL PUSHINTEGER4(i)
        DO i=ad_from54,i_end
          IF (0. .LT. fqx(i+1, k, j)) THEN
            max1 = fqx(i+1, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            max1 = 0.
          END IF
          IF (0. .GT. fqx(i, k, j)) THEN
            min74 = fqx(i, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min74 = 0.
          END IF
          IF (0. .LT. fqy(i, k, j+1)) THEN
            max53 = fqy(i, k, j+1)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            max53 = 0.
          END IF
          IF (0. .GT. fqy(i, k, j)) THEN
            min75 = fqy(i, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min75 = 0.
          END IF
          IF (0. .GT. fqz(i, k+1, j)) THEN
            min76 = fqz(i, k+1, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min76 = 0.
          END IF
          IF (0. .LT. fqz(i, k, j)) THEN
            max54 = fqz(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
            max54 = 0.
          END IF
          CALL PUSHREAL8(flux_out(i,k,j))
          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
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from54)
      END DO
    ENDDO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from55)

    ad_from55 = j_start
    DO j=ad_from55,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from54 = i_start
        CALL PUSHINTEGER4(i)
        DO i=ad_from54,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
              CALL PUSHREAL8(scale)
              scale = ph_low(i,k,j)/(flux_out(i,k,j)+eps)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(scale)
              scale = 0.
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqx(i+1, k, j) .GT. 0.) THEN
              CALL PUSHREAL8(fqx(i+1, k, j))
              fqx(i+1, k, j) = scale*fqx(i+1, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqx(i, k, j) .LT. 0.) THEN
              CALL PUSHREAL8(fqx(i, k, j))
              fqx(i, k, j) = scale*fqx(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqy(i, k, j+1) .GT. 0.) THEN
              CALL PUSHREAL8(fqy(i, k, j+1))
              fqy(i, k, j+1) = scale*fqy(i, k, j+1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqy(i, k, j) .LT. 0.) THEN
              CALL PUSHREAL8(fqy(i, k, j))
              fqy(i, k, j) = scale*fqy(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            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
              CALL PUSHREAL8(fqz(i, k+1, j))
              fqz(i, k+1, j) = scale*fqz(i, k+1, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqz(i, k, j) .GT. 0.) THEN
              CALL PUSHREAL8(fqz(i, k, j))
              fqz(i, k, j) = scale*fqz(i, k, j)
              CALL PUSHCONTROL2B(2)
            ELSE
              CALL PUSHCONTROL2B(1)
            END IF
          ELSE
            CALL PUSHCONTROL2B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from54)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from55)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
  ad_from57 = j_start
  DO j=ad_from57,j_end
    CALL PUSHINTEGER4(k)
    DO k=kts,ktf
      ad_from56 = i_start
      CALL PUSHINTEGER4(i)
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from56)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from57)
  IF (tenddec) THEN
    ad_from59 = j_start
    DO j=ad_from59,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from58 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from58)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from59)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  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
  ad_from61 = j_start
  DO j=ad_from61,j_end
    CALL PUSHINTEGER4(k)
    DO k=kts,ktf
      ad_from60 = i_start
      CALL PUSHINTEGER4(i)
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from60)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from61)
  IF (tenddec) THEN
    ad_from63 = j_start
    DO j=ad_from63,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from62 = i_start
        CALL PUSHINTEGER4(i)
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from62)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from63)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(k)
    DO k=kts,ktf
      CALL PUSHINTEGER4(i)
    END DO
  END DO
  IF (tenddec) THEN
    DO j=j_start,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      END DO
    END DO
    fqylb = 0.0
    fqyb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp47b18 = -(msftx(i, j)*rdy*h_tendencyb(i, k, j))
          fqyb(i, k, j+1) = fqyb(i, k, j+1) + temp47b18
          fqyb(i, k, j) = fqyb(i, k, j) - temp47b18
          fqylb(i, k, j+1) = fqylb(i, k, j+1) + temp47b18
          fqylb(i, k, j) = fqylb(i, k, j) - temp47b18
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE
    fqylb = 0.0
    fqyb = 0.0
  END IF
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        temp47b17 = -(msftx(i, j)*rdy*tendencyb(i, k, j))
        fqyb(i, k, j+1) = fqyb(i, k, j+1) + temp47b17
        fqyb(i, k, j) = fqyb(i, k, j) - temp47b17
        fqylb(i, k, j+1) = fqylb(i, k, j+1) + temp47b17
        fqylb(i, k, j) = fqylb(i, k, j) - temp47b17
      END DO
      CALL POPINTEGER4(i)
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    fqxlb = 0.0
    fqxb = 0.0
  ELSE
    fqxlb = 0.0
    fqxb = 0.0
    CALL POPINTEGER4(ad_from63)
    CALL POPINTEGER4(ad_to63)
    DO j=ad_to63,ad_from63,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from62)
        CALL POPINTEGER4(ad_to62)
        DO i=ad_to62,ad_from62,-1
          temp47b16 = -(msftx(i, j)*rdx*h_tendencyb(i, k, j))
          fqxb(i+1, k, j) = fqxb(i+1, k, j) + temp47b16
          fqxb(i, k, j) = fqxb(i, k, j) - temp47b16
          fqxlb(i+1, k, j) = fqxlb(i+1, k, j) + temp47b16
          fqxlb(i, k, j) = fqxlb(i, k, j) - temp47b16
          h_tendencyb(i, k, j) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPINTEGER4(ad_from61)
  CALL POPINTEGER4(ad_to61)
  DO j=ad_to61,ad_from61,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from60)
      CALL POPINTEGER4(ad_to60)
      DO i=ad_to60,ad_from60,-1
        temp47b15 = -(msftx(i, j)*rdx*tendencyb(i, k, j))
        fqxb(i+1, k, j) = fqxb(i+1, k, j) + temp47b15
        fqxb(i, k, j) = fqxb(i, k, j) - temp47b15
        fqxlb(i+1, k, j) = fqxlb(i+1, k, j) + temp47b15
        fqxlb(i, k, j) = fqxlb(i, k, j) - temp47b15
      END DO
      CALL POPINTEGER4(i)
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    fqzb = 0.0
    fqzlb = 0.0
    CALL POPINTEGER4(ad_from59)
    CALL POPINTEGER4(ad_to59)
    DO j=ad_to59,ad_from59,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from58)
        CALL POPINTEGER4(ad_to58)
        DO i=ad_to58,ad_from58,-1
          temp47b14 = -(rdzw(k)*z_tendencyb(i, k, j))
          fqzb(i, k+1, j) = fqzb(i, k+1, j) + temp47b14
          fqzb(i, k, j) = fqzb(i, k, j) - temp47b14
          fqzlb(i, k+1, j) = fqzlb(i, k+1, j) + temp47b14
          fqzlb(i, k, j) = fqzlb(i, k, j) - temp47b14
          z_tendencyb(i, k, j) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
  ELSE
    fqzb = 0.0
    fqzlb = 0.0
  END IF
  CALL POPINTEGER4(ad_from57)
  CALL POPINTEGER4(ad_to57)
  DO j=ad_to57,ad_from57,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from56)
      CALL POPINTEGER4(ad_to56)
      DO i=ad_to56,ad_from56,-1
        temp47b13 = -(rdzw(k)*tendencyb(i, k, j))
        fqzb(i, k+1, j) = fqzb(i, k+1, j) + temp47b13
        fqzb(i, k, j) = fqzb(i, k, j) - temp47b13
        fqzlb(i, k+1, j) = fqzlb(i, k+1, j) + temp47b13
        fqzlb(i, k, j) = fqzlb(i, k, j) - temp47b13
      END DO
      CALL POPINTEGER4(i)
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from55)
    CALL POPINTEGER4(ad_to55)
    DO j=ad_to55,ad_from55,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from54)
        CALL POPINTEGER4(ad_to54)
        DO i=ad_to54,ad_from54,-1
          CALL POPCONTROL2B(branch)
          IF (branch .EQ. 0) THEN
            flux_outb(i,k,j) = 0.0
            ph_lowb(i,k,j) = 0.0
          ELSE
            IF (branch .EQ. 1) THEN
              scaleb = 0.0
            ELSE
              CALL POPREAL8(fqz(i, k, j))
              scaleb = fqz(i, k, j)*fqzb(i, k, j)
              fqzb(i, k, j) = scale*fqzb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqz(i, k+1, j))
              scaleb = scaleb + fqz(i, k+1, j)*fqzb(i, k+1, j)
              fqzb(i, k+1, j) = scale*fqzb(i, k+1, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqy(i, k, j))
              scaleb = scaleb + fqy(i, k, j)*fqyb(i, k, j)
              fqyb(i, k, j) = scale*fqyb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqy(i, k, j+1))
              scaleb = scaleb + fqy(i, k, j+1)*fqyb(i, k, j+1)
              fqyb(i, k, j+1) = scale*fqyb(i, k, j+1)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqx(i, k, j))
              scaleb = scaleb + fqx(i, k, j)*fqxb(i, k, j)
              fqxb(i, k, j) = scale*fqxb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqx(i+1, k, j))
              scaleb = scaleb + fqx(i+1, k, j)*fqxb(i+1, k, j)
              fqxb(i+1, k, j) = scale*fqxb(i+1, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(scale)
              temp47b12 = scaleb/(eps+flux_out(i,k,j))
              ph_lowb(i,k,j) = temp47b12
              flux_outb(i,k,j) = -(ph_low(i,k,j)*temp47b12/(eps+flux_out(i,k,j)))
            ELSE
              CALL POPREAL8(scale)
              flux_outb(i,k,j) = 0.0
              ph_lowb(i,k,j) = 0.0
            END IF
          END IF
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(ad_from55)
    CALL POPINTEGER4(ad_to55)
    DO j=ad_to55,ad_from55,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from54)
        CALL POPINTEGER4(ad_to54)
        DO i=ad_to54,ad_from54,-1
          CALL POPREAL8(flux_out(i,k,j))
          temp47b10 = dt*msftx(i, j)*msfty(i, j)*flux_outb(i,k,j)
          temp47b11 = msfty(i, j)*dt*rdzw(k)*flux_outb(i,k,j)
          max1b = rdx*temp47b10
          min74b = -(rdx*temp47b10)
          max53b = rdy*temp47b10
          min75b = -(rdy*temp47b10)
          min76b = temp47b11
          max54b = -temp47b11
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) fqzb(i, k, j) = fqzb(i, k, j) + max54b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqzb(i, k+1, j) = fqzb(i, k+1, j) + min76b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqyb(i, k, j) = fqyb(i, k, j) + min75b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqyb(i, k, j+1) = fqyb(i, k, j+1) + max53b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqxb(i, k, j) = fqxb(i, k, j) + min74b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqxb(i+1, k, j) = fqxb(i+1, k, j) + max1b
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(ad_from55)
    CALL POPINTEGER4(ad_to55)
    DO j=ad_to55,ad_from55,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from54)
        CALL POPINTEGER4(ad_to54)
        DO i=ad_to54,ad_from54,-1
          CALL POPREAL8(ph_low(i,k,j))
          temp47b8 = -(dt*msftx(i, j)*msfty(i, j)*ph_lowb(i,k,j))
          temp47b9 = -(dt*msfty(i, j)*rdzw(k)*ph_lowb(i,k,j))
          mu_oldb(i, j) = mu_oldb(i, j) + field_old(i, k, j)*ph_lowb(i,k,j)
          field_oldb(i, k, j) = field_oldb(i, k, j) + (mub(i, j)+mu_old(&
&            i, j))*ph_lowb(i,k,j)
          fqxlb(i+1, k, j) = fqxlb(i+1, k, j) + rdx*temp47b8
          fqxlb(i, k, j) = fqxlb(i, k, j) - rdx*temp47b8
          fqylb(i, k, j+1) = fqylb(i, k, j+1) + rdy*temp47b8
          fqylb(i, k, j) = fqylb(i, k, j) - rdy*temp47b8
          fqzlb(i, k+1, j) = fqzlb(i, k+1, j) + temp47b9
          fqzlb(i, k, j) = fqzlb(i, k, j) - temp47b9
        END DO
        CALL POPINTEGER4(i)
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 3) THEN
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from38)
      CALL POPINTEGER4(ad_to38)
      DO j=ad_to38,ad_from38,-1
        CALL POPINTEGER4(ad_from37)
        CALL POPINTEGER4(ad_to37)
        DO i=ad_to37,ad_from37,-1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp31b74 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp31b74
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp31b74
          fqzb(i, k, j) = 0.0
          temp31b75 = dz*mu*fqzlb(i, k, j)/dt
          min59b = 0.5*field_old(i, k-1, j)*temp31b75
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min59*&
&            temp31b75
          max40b = 0.5*field_old(i, k, j)*temp31b75
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max40*&
&            temp31b75
          mub0 = (0.5*(min59*field_old(i, k-1, j))+0.5*(max40*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max40)
            y90b = max40b
          ELSE
            CALL POPREAL8(max40)
            y90b = 0.0
          END IF
          crb = y90b
          abs90b = -y90b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs90b
          ELSE
            crb = crb - abs90b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min59)
            y39b = min59b
          ELSE
            CALL POPREAL8(min59)
            y39b = 0.0
          END IF
          crb = crb + y39b
          abs39b = y39b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs39b
          ELSE
            crb = crb - abs39b
          END IF
          temp31b70 = dt*crb/(dz*mu)
          velb = temp31b70
          mub0 = mub0 - vel*temp31b70/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = ktf - 1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp31b71 = vel*fqzb(i, k, j)
          temp31b72 = 7.*temp31b71/12.
          velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k&
&            +1, j)+field(i, k-2, j))/12.)*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp31b72
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + temp31b72
          fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp31b71/12.
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp31b71/12.
          fqzb(i, k, j) = 0.0
          temp31b73 = dz*mu*fqzlb(i, k, j)/dt
          min58b = 0.5*field_old(i, k-1, j)*temp31b73
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min58*&
&            temp31b73
          max39b = 0.5*field_old(i, k, j)*temp31b73
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max39*&
&            temp31b73
          mub0 = (0.5*(min58*field_old(i, k-1, j))+0.5*(max39*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max39)
            y89b = max39b
          ELSE
            CALL POPREAL8(max39)
            y89b = 0.0
          END IF
          crb = y89b
          abs89b = -y89b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs89b
          ELSE
            crb = crb - abs89b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min58)
            y38b = min58b
          ELSE
            CALL POPREAL8(min58)
            y38b = 0.0
          END IF
          crb = crb + y38b
          abs38b = y38b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs38b
          ELSE
            crb = crb - abs38b
          END IF
          temp31b66 = dt*crb/(dz*mu)
          velb = velb + temp31b66
          mub0 = mub0 - vel*temp31b66/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = kts + 2
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp31b67 = vel*fqzb(i, k, j)
          temp31b68 = 7.*temp31b67/12.
          velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k&
&            +1, j)+field(i, k-2, j))/12.)*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp31b68
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + temp31b68
          fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp31b67/12.
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp31b67/12.
          fqzb(i, k, j) = 0.0
          temp31b69 = dz*mu*fqzlb(i, k, j)/dt
          min57b = 0.5*field_old(i, k-1, j)*temp31b69
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min57*&
&            temp31b69
          max38b = 0.5*field_old(i, k, j)*temp31b69
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max38*&
&            temp31b69
          mub0 = (0.5*(min57*field_old(i, k-1, j))+0.5*(max38*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max38)
            y88b = max38b
          ELSE
            CALL POPREAL8(max38)
            y88b = 0.0
          END IF
          crb = y88b
          abs88b = -y88b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs88b
          ELSE
            crb = crb - abs88b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min57)
            y37b = min57b
          ELSE
            CALL POPREAL8(min57)
            y37b = 0.0
          END IF
          crb = crb + y37b
          abs37b = y37b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs37b
          ELSE
            crb = crb - abs37b
          END IF
          temp31b63 = dt*crb/(dz*mu)
          velb = velb + temp31b63
          mub0 = mub0 - vel*temp31b63/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = kts + 1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp31b64 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp31b64
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp31b64
          fqzb(i, k, j) = 0.0
          temp31b65 = dz*mu*fqzlb(i, k, j)/dt
          min56b = 0.5*field_old(i, k-1, j)*temp31b65
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min56*&
&            temp31b65
          max37b = 0.5*field_old(i, k, j)*temp31b65
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max37*&
&            temp31b65
          mub0 = (0.5*(min56*field_old(i, k-1, j))+0.5*(max37*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max37)
            y87b = max37b
          ELSE
            CALL POPREAL8(max37)
            y87b = 0.0
          END IF
          crb = y87b
          abs87b = -y87b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs87b
          ELSE
            crb = crb - abs87b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min56)
            y36b = min56b
          ELSE
            CALL POPREAL8(min56)
            y36b = 0.0
          END IF
          crb = crb + y36b
          abs36b = y36b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs36b
          ELSE
            crb = crb - abs36b
          END IF
          temp31b62 = dt*crb/(dz*mu)
          velb = temp31b62
          mub0 = mub0 - vel*temp31b62/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          CALL POPREAL8(dz)
          CALL POPINTEGER4(k)
        END DO
        DO k=ktf-2,kts+3,-1
          CALL POPINTEGER4(ad_from36)
          CALL POPINTEGER4(ad_to36)
          DO i=ad_to36,ad_from36,-1
            fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
            temp31b58 = vel*fqzb(i, k, j)
            temp31b59 = 37.*temp31b58/60.
            temp31b60 = -(2.*temp31b58/15.)
            velb = (37.*((field(i, k, j)+field(i, k-1, j))/60.)-2.*((&
&              field(i, k+1, j)+field(i, k-2, j))/15.)+(field(i, k+2, j)+&
&              field(i, k-3, j))/60.)*fqzb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp31b59
            fieldb(i, k-1, j) = fieldb(i, k-1, j) + temp31b59
            fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp31b60
            fieldb(i, k-2, j) = fieldb(i, k-2, j) + temp31b60
            fieldb(i, k+2, j) = fieldb(i, k+2, j) + temp31b58/60.
            fieldb(i, k-3, j) = fieldb(i, k-3, j) + temp31b58/60.
            fqzb(i, k, j) = 0.0
            temp31b61 = dz*mu*fqzlb(i, k, j)/dt
            min55b = 0.5*field_old(i, k-1, j)*temp31b61
            field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min55*&
&              temp31b61
            max36b = 0.5*field_old(i, k, j)*temp31b61
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max36*&
&              temp31b61
            mub0 = (0.5*(min55*field_old(i, k-1, j))+0.5*(max36*&
&              field_old(i, k, j)))*dz*fqzlb(i, k, j)/dt
            fqzlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max36)
              y86b = max36b
            ELSE
              CALL POPREAL8(max36)
              y86b = 0.0
            END IF
            crb = y86b
            abs86b = -y86b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs86b
            ELSE
              crb = crb - abs86b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min55)
              y35b = min55b
            ELSE
              CALL POPREAL8(min55)
              y35b = 0.0
            END IF
            crb = crb + y35b
            abs35b = y35b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs35b
            ELSE
              crb = crb - abs35b
            END IF
            temp31b57 = dt*crb/(dz*mu)
            velb = velb + temp31b57
            mub0 = mub0 - vel*temp31b57/mu
            CALL POPREAL8(vel)
            romb(i, k, j) = romb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*2*mub0
            CALL POPREAL8(dz)
          END DO
        END DO
        CALL POPINTEGER4(k)
        CALL POPINTEGER4(ad_from35)
        CALL POPINTEGER4(ad_to35)
        DO i=ad_to35,ad_from35,-1
          fqzlb(i, kde, j) = 0.0
          fqzb(i, kde, j) = 0.0
          fqzlb(i, 1, j) = 0.0
          fqzb(i, 1, j) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
    ELSE IF (branch .EQ. 1) THEN
      CALL POPINTEGER4(ad_from42)
      CALL POPINTEGER4(ad_to42)
      DO j=ad_to42,ad_from42,-1
        CALL POPINTEGER4(ad_from41)
        CALL POPINTEGER4(ad_to41)
        DO i=ad_to41,ad_from41,-1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp43b0 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b0
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b0
          fqzb(i, k, j) = 0.0
          temp43b1 = dz*mu*fqzlb(i, k, j)/dt
          min64b = 0.5*field_old(i, k-1, j)*temp43b1
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min64*&
&            temp43b1
          max45b = 0.5*field_old(i, k, j)*temp43b1
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max45*temp43b1
          mub0 = (0.5*(min64*field_old(i, k-1, j))+0.5*(max45*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max45)
            y95b = max45b
          ELSE
            CALL POPREAL8(max45)
            y95b = 0.0
          END IF
          crb = y95b
          abs95b = -y95b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs95b
          ELSE
            crb = crb - abs95b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min64)
            y44b = min64b
          ELSE
            CALL POPREAL8(min64)
            y44b = 0.0
          END IF
          crb = crb + y44b
          abs44b = y44b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs44b
          ELSE
            crb = crb - abs44b
          END IF
          temp43b = dt*crb/(dz*mu)
          velb = temp43b
          mub0 = mub0 - vel*temp43b/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = ktf - 1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp39 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k&
&            , j)-field(i, k-1, j))
          temp42 = SIGN(1., -vel)
          temp41 = temp42/12.
          temp40 = SIGN(1, time_step)
          temp39b0 = vel*fqzb(i, k, j)
          temp39b1 = 7.*temp39b0/12.
          temp39b2 = temp40*temp41*temp39b0
          velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k&
&            +1, j)+field(i, k-2, j))/12.+temp40*(temp41*temp39))*fqzb(i&
&            , k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp39b1 - 3.*temp39b2
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp39b2 + temp39b1
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp39b2 - temp39b0/&
&            12.
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp39b2 - temp39b0/&
&            12.
          fqzb(i, k, j) = 0.0
          temp39b3 = dz*mu*fqzlb(i, k, j)/dt
          min63b = 0.5*field_old(i, k-1, j)*temp39b3
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min63*&
&            temp39b3
          max44b = 0.5*field_old(i, k, j)*temp39b3
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max44*temp39b3
          mub0 = (0.5*(min63*field_old(i, k-1, j))+0.5*(max44*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max44)
            y94b = max44b
          ELSE
            CALL POPREAL8(max44)
            y94b = 0.0
          END IF
          crb = y94b
          abs94b = -y94b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs94b
          ELSE
            crb = crb - abs94b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min63)
            y43b = min63b
          ELSE
            CALL POPREAL8(min63)
            y43b = 0.0
          END IF
          crb = crb + y43b
          abs43b = y43b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs43b
          ELSE
            crb = crb - abs43b
          END IF
          temp39b = dt*crb/(dz*mu)
          velb = velb + temp39b
          mub0 = mub0 - vel*temp39b/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = kts + 2
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp35 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k&
&            , j)-field(i, k-1, j))
          temp38 = SIGN(1., -vel)
          temp37 = temp38/12.
          temp36 = SIGN(1, time_step)
          temp35b3 = vel*fqzb(i, k, j)
          temp35b4 = 7.*temp35b3/12.
          temp35b5 = temp36*temp37*temp35b3
          velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k&
&            +1, j)+field(i, k-2, j))/12.+temp36*(temp37*temp35))*fqzb(i&
&            , k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp35b4 - 3.*temp35b5
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp35b5 + temp35b4
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp35b5 - temp35b3/&
&            12.
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp35b5 - temp35b3/&
&            12.
          fqzb(i, k, j) = 0.0
          temp35b6 = dz*mu*fqzlb(i, k, j)/dt
          min62b = 0.5*field_old(i, k-1, j)*temp35b6
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min62*&
&            temp35b6
          max43b = 0.5*field_old(i, k, j)*temp35b6
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max43*temp35b6
          mub0 = (0.5*(min62*field_old(i, k-1, j))+0.5*(max43*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max43)
            y93b = max43b
          ELSE
            CALL POPREAL8(max43)
            y93b = 0.0
          END IF
          crb = y93b
          abs93b = -y93b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs93b
          ELSE
            crb = crb - abs93b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min62)
            y42b = min62b
          ELSE
            CALL POPREAL8(min62)
            y42b = 0.0
          END IF
          crb = crb + y42b
          abs42b = y42b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs42b
          ELSE
            crb = crb - abs42b
          END IF
          temp35b0 = dt*crb/(dz*mu)
          velb = velb + temp35b0
          mub0 = mub0 - vel*temp35b0/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = kts + 1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp35b1 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp35b1
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp35b1
          fqzb(i, k, j) = 0.0
          temp35b2 = dz*mu*fqzlb(i, k, j)/dt
          min61b = 0.5*field_old(i, k-1, j)*temp35b2
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min61*&
&            temp35b2
          max42b = 0.5*field_old(i, k, j)*temp35b2
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max42*temp35b2
          mub0 = (0.5*(min61*field_old(i, k-1, j))+0.5*(max42*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max42)
            y92b = max42b
          ELSE
            CALL POPREAL8(max42)
            y92b = 0.0
          END IF
          crb = y92b
          abs92b = -y92b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs92b
          ELSE
            crb = crb - abs92b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min61)
            y41b = min61b
          ELSE
            CALL POPREAL8(min61)
            y41b = 0.0
          END IF
          crb = crb + y41b
          abs41b = y41b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs41b
          ELSE
            crb = crb - abs41b
          END IF
          temp35b = dt*crb/(dz*mu)
          velb = temp35b
          mub0 = mub0 - vel*temp35b/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          CALL POPREAL8(dz)
          CALL POPINTEGER4(k)
        END DO
        DO k=ktf-2,kts+3,-1
          CALL POPINTEGER4(ad_from40)
          CALL POPINTEGER4(ad_to40)
          DO i=ad_to40,ad_from40,-1
            fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
            temp31 = field(i, k+2, j) - field(i, k-3, j) + 10.*(field(i&
&              , k, j)-field(i, k-1, j)) - 5.*(field(i, k+1, j)-field(i, &
&              k-2, j))
            temp34 = SIGN(1., -vel)
            temp33 = temp34/60.
            temp32 = SIGN(1, time_step)
            temp31b77 = vel*fqzb(i, k, j)
            temp31b78 = 37.*temp31b77/60.
            temp31b79 = -(2.*temp31b77/15.)
            temp31b80 = -(temp32*temp33*temp31b77)
            velb = (37.*((field(i, k, j)+field(i, k-1, j))/60.)-2.*((&
&              field(i, k+1, j)+field(i, k-2, j))/15.)+(field(i, k+2, j)+&
&              field(i, k-3, j))/60.-temp32*(temp33*temp31))*fqzb(i, k, j&
&              )
            fieldb(i, k, j) = fieldb(i, k, j) + 10.*temp31b80 + &
&              temp31b78
            fieldb(i, k-1, j) = fieldb(i, k-1, j) + temp31b78 - 10.*&
&              temp31b80
            fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp31b79 - 5.*&
&              temp31b80
            fieldb(i, k-2, j) = fieldb(i, k-2, j) + 5.*temp31b80 + &
&              temp31b79
            fieldb(i, k+2, j) = fieldb(i, k+2, j) + temp31b80 + &
&              temp31b77/60.
            fieldb(i, k-3, j) = fieldb(i, k-3, j) + temp31b77/60. - &
&              temp31b80
            fqzb(i, k, j) = 0.0
            temp31b81 = dz*mu*fqzlb(i, k, j)/dt
            min60b = 0.5*field_old(i, k-1, j)*temp31b81
            field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min60*&
&              temp31b81
            max41b = 0.5*field_old(i, k, j)*temp31b81
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max41*&
&              temp31b81
            mub0 = (0.5*(min60*field_old(i, k-1, j))+0.5*(max41*&
&              field_old(i, k, j)))*dz*fqzlb(i, k, j)/dt
            fqzlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max41)
              y91b = max41b
            ELSE
              CALL POPREAL8(max41)
              y91b = 0.0
            END IF
            crb = y91b
            abs91b = -y91b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs91b
            ELSE
              crb = crb - abs91b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min60)
              y40b = min60b
            ELSE
              CALL POPREAL8(min60)
              y40b = 0.0
            END IF
            crb = crb + y40b
            abs40b = y40b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs40b
            ELSE
              crb = crb - abs40b
            END IF
            temp31b76 = dt*crb/(dz*mu)
            velb = velb + temp31b76
            mub0 = mub0 - vel*temp31b76/mu
            CALL POPREAL8(vel)
            romb(i, k, j) = romb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*2*mub0
            CALL POPREAL8(dz)
          END DO
        END DO
        CALL POPINTEGER4(k)
        CALL POPINTEGER4(ad_from39)
        CALL POPINTEGER4(ad_to39)
        DO i=ad_to39,ad_from39,-1
          fqzlb(i, kde, j) = 0.0
          fqzb(i, kde, j) = 0.0
          fqzlb(i, 1, j) = 0.0
          fqzb(i, 1, j) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
    ELSE
      CALL POPINTEGER4(ad_from46)
      CALL POPINTEGER4(ad_to46)
      DO j=ad_to46,ad_from46,-1
        CALL POPINTEGER4(ad_from45)
        CALL POPINTEGER4(ad_to45)
        DO i=ad_to45,ad_from45,-1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp43b10 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b10
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b10
          fqzb(i, k, j) = 0.0
          temp43b11 = dz*mu*fqzlb(i, k, j)/dt
          min67b = 0.5*field_old(i, k-1, j)*temp43b11
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min67*&
&            temp43b11
          max48b = 0.5*field_old(i, k, j)*temp43b11
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max48*&
&            temp43b11
          mub0 = (0.5*(min67*field_old(i, k-1, j))+0.5*(max48*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max48)
            y98b = max48b
          ELSE
            CALL POPREAL8(max48)
            y98b = 0.0
          END IF
          crb = y98b
          abs98b = -y98b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs98b
          ELSE
            crb = crb - abs98b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min67)
            y47b = min67b
          ELSE
            CALL POPREAL8(min67)
            y47b = 0.0
          END IF
          crb = crb + y47b
          abs47b = y47b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs47b
          ELSE
            crb = crb - abs47b
          END IF
          temp43b7 = dt*crb/(dz*mu)
          velb = temp43b7
          mub0 = mub0 - vel*temp43b7/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          mu = 0.5*(mut(i, j)+mut(i, j))
          CALL POPREAL8(dz)
          k = kts + 1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp43b8 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp43b8
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp43b8
          fqzb(i, k, j) = 0.0
          temp43b9 = dz*mu*fqzlb(i, k, j)/dt
          min66b = 0.5*field_old(i, k-1, j)*temp43b9
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min66*&
&            temp43b9
          max47b = 0.5*field_old(i, k, j)*temp43b9
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max47*temp43b9
          mub0 = (0.5*(min66*field_old(i, k-1, j))+0.5*(max47*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max47)
            y97b = max47b
          ELSE
            CALL POPREAL8(max47)
            y97b = 0.0
          END IF
          crb = y97b
          abs97b = -y97b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs97b
          ELSE
            crb = crb - abs97b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min66)
            y46b = min66b
          ELSE
            CALL POPREAL8(min66)
            y46b = 0.0
          END IF
          crb = crb + y46b
          abs46b = y46b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs46b
          ELSE
            crb = crb - abs46b
          END IF
          temp43b6 = dt*crb/(dz*mu)
          velb = temp43b6
          mub0 = mub0 - vel*temp43b6/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          CALL POPREAL8(dz)
          CALL POPINTEGER4(k)
        END DO
        DO k=ktf-1,kts+2,-1
          CALL POPINTEGER4(ad_from44)
          CALL POPINTEGER4(ad_to44)
          DO i=ad_to44,ad_from44,-1
            fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
            temp43b3 = vel*fqzb(i, k, j)
            temp43b4 = 7.*temp43b3/12.
            velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i&
&              , k+1, j)+field(i, k-2, j))/12.)*fqzb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp43b4
            fieldb(i, k-1, j) = fieldb(i, k-1, j) + temp43b4
            fieldb(i, k+1, j) = fieldb(i, k+1, j) - temp43b3/12.
            fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp43b3/12.
            fqzb(i, k, j) = 0.0
            temp43b5 = dz*mu*fqzlb(i, k, j)/dt
            min65b = 0.5*field_old(i, k-1, j)*temp43b5
            field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min65*&
&              temp43b5
            max46b = 0.5*field_old(i, k, j)*temp43b5
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max46*&
&              temp43b5
            mub0 = (0.5*(min65*field_old(i, k-1, j))+0.5*(max46*&
&              field_old(i, k, j)))*dz*fqzlb(i, k, j)/dt
            fqzlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max46)
              y96b = max46b
            ELSE
              CALL POPREAL8(max46)
              y96b = 0.0
            END IF
            crb = y96b
            abs96b = -y96b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs96b
            ELSE
              crb = crb - abs96b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min65)
              y45b = min65b
            ELSE
              CALL POPREAL8(min65)
              y45b = 0.0
            END IF
            crb = crb + y45b
            abs45b = y45b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs45b
            ELSE
              crb = crb - abs45b
            END IF
            temp43b2 = dt*crb/(dz*mu)
            velb = velb + temp43b2
            mub0 = mub0 - vel*temp43b2/mu
            CALL POPREAL8(vel)
            romb(i, k, j) = romb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*2*mub0
            CALL POPREAL8(dz)
          END DO
        END DO
        CALL POPINTEGER4(k)
        CALL POPINTEGER4(ad_from43)
        CALL POPINTEGER4(ad_to43)
        DO i=ad_to43,ad_from43,-1
          fqzlb(i, kde, j) = 0.0
          fqzb(i, kde, j) = 0.0
          fqzlb(i, 1, j) = 0.0
          fqzb(i, 1, j) = 0.0
        END DO
        CALL POPINTEGER4(i)
      END DO
    END IF
  ELSE IF (branch .EQ. 3) THEN
    CALL POPINTEGER4(ad_from50)
    CALL POPINTEGER4(ad_to50)
    DO j=ad_to50,ad_from50,-1
      CALL POPINTEGER4(ad_from49)
      CALL POPINTEGER4(ad_to49)
      DO i=ad_to49,ad_from49,-1
        fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
        temp47b3 = rom(i, k, j)*fqzb(i, k, j)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*fqzb(i, k, j)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b3
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b3
        fqzb(i, k, j) = 0.0
        temp47b4 = dz*mu*fqzlb(i, k, j)/dt
        min70b = 0.5*field_old(i, k-1, j)*temp47b4
        field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min70*&
&          temp47b4
        max51b = 0.5*field_old(i, k, j)*temp47b4
        field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max51*temp47b4
        mub0 = (0.5*(min70*field_old(i, k-1, j))+0.5*(max51*field_old(i&
&          , k, j)))*dz*fqzlb(i, k, j)/dt
        fqzlb(i, k, j) = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(max51)
          y101b = max51b
        ELSE
          CALL POPREAL8(max51)
          y101b = 0.0
        END IF
        crb = y101b
        abs101b = -y101b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs101b
        ELSE
          crb = crb - abs101b
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(min70)
          y50b = min70b
        ELSE
          CALL POPREAL8(min70)
          y50b = 0.0
        END IF
        crb = crb + y50b
        abs50b = y50b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs50b
        ELSE
          crb = crb - abs50b
        END IF
        temp47b0 = dt*crb/(dz*mu)
        velb = temp47b0
        mub0 = mub0 - vel*temp47b0/mu
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + velb
        mutb(i, j) = mutb(i, j) + 0.5*2*mub0
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL POPREAL8(dz)
        k = kts + 1
        fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
        temp47b1 = rom(i, k, j)*fqzb(i, k, j)
        romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&          field(i, k-1, j))*fqzb(i, k, j)
        fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b1
        fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b1
        fqzb(i, k, j) = 0.0
        temp47b2 = dz*mu*fqzlb(i, k, j)/dt
        min69b = 0.5*field_old(i, k-1, j)*temp47b2
        field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min69*&
&          temp47b2
        max50b = 0.5*field_old(i, k, j)*temp47b2
        field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max50*temp47b2
        mub0 = (0.5*(min69*field_old(i, k-1, j))+0.5*(max50*field_old(i&
&          , k, j)))*dz*fqzlb(i, k, j)/dt
        fqzlb(i, k, j) = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(max50)
          y100b = max50b
        ELSE
          CALL POPREAL8(max50)
          y100b = 0.0
        END IF
        crb = y100b
        abs100b = -y100b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs100b
        ELSE
          crb = crb - abs100b
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(min69)
          y49b = min69b
        ELSE
          CALL POPREAL8(min69)
          y49b = 0.0
        END IF
        crb = crb + y49b
        abs49b = y49b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs49b
        ELSE
          crb = crb - abs49b
        END IF
        temp47b = dt*crb/(dz*mu)
        velb = temp47b
        mub0 = mub0 - vel*temp47b/mu
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + velb
        CALL POPREAL8(mu)
        mutb(i, j) = mutb(i, j) + 0.5*2*mub0
        CALL POPREAL8(dz)
        CALL POPINTEGER4(k)
      END DO
      DO k=ktf-1,kts+2,-1
        CALL POPINTEGER4(ad_from48)
        CALL POPINTEGER4(ad_to48)
        DO i=ad_to48,ad_from48,-1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp43 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k&
&            , j)-field(i, k-1, j))
          temp46 = SIGN(1., -vel)
          temp45 = temp46/12.
          temp44 = SIGN(1, time_step)
          temp43b13 = vel*fqzb(i, k, j)
          temp43b14 = 7.*temp43b13/12.
          temp43b15 = temp44*temp45*temp43b13
          velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k&
&            +1, j)+field(i, k-2, j))/12.+temp44*(temp45*temp43))*fqzb(i&
&            , k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp43b14 - 3.*temp43b15
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*temp43b15 + &
&            temp43b14
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + temp43b15 - temp43b13/&
&            12.
          fieldb(i, k-2, j) = fieldb(i, k-2, j) - temp43b15 - temp43b13/&
&            12.
          fqzb(i, k, j) = 0.0
          temp43b16 = dz*mu*fqzlb(i, k, j)/dt
          min68b = 0.5*field_old(i, k-1, j)*temp43b16
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min68*&
&            temp43b16
          max49b = 0.5*field_old(i, k, j)*temp43b16
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max49*&
&            temp43b16
          mub0 = (0.5*(min68*field_old(i, k-1, j))+0.5*(max49*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max49)
            y99b = max49b
          ELSE
            CALL POPREAL8(max49)
            y99b = 0.0
          END IF
          crb = y99b
          abs99b = -y99b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs99b
          ELSE
            crb = crb - abs99b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min68)
            y48b = min68b
          ELSE
            CALL POPREAL8(min68)
            y48b = 0.0
          END IF
          crb = crb + y48b
          abs48b = y48b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs48b
          ELSE
            crb = crb - abs48b
          END IF
          temp43b12 = dt*crb/(dz*mu)
          velb = velb + temp43b12
          mub0 = mub0 - vel*temp43b12/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          CALL POPREAL8(dz)
        END DO
      END DO
      CALL POPINTEGER4(k)
      CALL POPINTEGER4(ad_from47)
      CALL POPINTEGER4(ad_to47)
      DO i=ad_to47,ad_from47,-1
        fqzlb(i, kde, j) = 0.0
        fqzb(i, kde, j) = 0.0
        fqzlb(i, 1, j) = 0.0
        fqzb(i, 1, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  ELSE IF (branch .EQ. 4) THEN
    CALL POPINTEGER4(ad_from53)
    CALL POPINTEGER4(ad_to53)
    DO j=ad_to53,ad_from53,-1
      DO k=ktf,kts+1,-1
        CALL POPINTEGER4(ad_from52)
        CALL POPINTEGER4(ad_to52)
        DO i=ad_to52,ad_from52,-1
          fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
          temp47b6 = rom(i, k, j)*fqzb(i, k, j)
          romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&            field(i, k-1, j))*fqzb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*temp47b6
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*temp47b6
          fqzb(i, k, j) = 0.0
          temp47b7 = dz*mu*fqzlb(i, k, j)/dt
          min71b = 0.5*field_old(i, k-1, j)*temp47b7
          field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min71*&
&            temp47b7
          max52b = 0.5*field_old(i, k, j)*temp47b7
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max52*temp47b7
          mub0 = (0.5*(min71*field_old(i, k-1, j))+0.5*(max52*field_old(&
&            i, k, j)))*dz*fqzlb(i, k, j)/dt
          fqzlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max52)
            y102b = max52b
          ELSE
            CALL POPREAL8(max52)
            y102b = 0.0
          END IF
          crb = y102b
          abs102b = -y102b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs102b
          ELSE
            crb = crb - abs102b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min71)
            y51b = min71b
          ELSE
            CALL POPREAL8(min71)
            y51b = 0.0
          END IF
          crb = crb + y51b
          abs51b = y51b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs51b
          ELSE
            crb = crb - abs51b
          END IF
          temp47b5 = dt*crb/(dz*mu)
          velb = temp47b5
          mub0 = mub0 - vel*temp47b5/mu
          CALL POPREAL8(vel)
          romb(i, k, j) = romb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*2*mub0
          CALL POPREAL8(dz)
        END DO
      END DO
      CALL POPINTEGER4(ad_from51)
      CALL POPINTEGER4(ad_to51)
      DO i=ad_to51,ad_from51,-1
        fqzlb(i, kde, j) = 0.0
        fqzb(i, kde, j) = 0.0
        fqzlb(i, 1, j) = 0.0
        fqzb(i, 1, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  END IF
  CALL POPINTEGER4(j_end)
  CALL POPINTEGER4(i_end)
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from34)
    CALL POPINTEGER4(ad_to34)
    DO i=ad_to34,ad_from34,-1
      DO k=ktf,kts,-1
        temp31b56 = -(rdy*tendencyb(i, k, j_end))
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*&
&          temp31b56
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*temp31b56
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&          temp31b56
        fieldb(i, k, j_end) = fieldb(i, k, j_end) - rv(i, k, jte-1)*&
&          temp31b56
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - field(i, k, j_end)*&
&          temp31b56
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from33)
    CALL POPINTEGER4(ad_to33)
    DO i=ad_to33,ad_from33,-1
      DO k=ktf,kts,-1
        temp31b55 = -(rdy*tendencyb(i, k, jts))
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*temp31b55
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*temp31b55
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*temp31b55
        fieldb(i, k, jts) = fieldb(i, k, jts) + rv(i, k, jts+1)*&
&          temp31b55
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + field(i, k, jts)*temp31b55
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from32)
    CALL POPINTEGER4(ad_to32)
    DO i=ad_to32,ad_from32,-1
      DO k=ktf,kts,-1
        temp31b53 = -(rdy*tendencyb(i, k, j_end))
        temp31b54 = field(i, k, j_end)*temp31b53
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*&
&          temp31b53
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*temp31b53
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&          temp31b53
        fieldb(i, k, j_end) = fieldb(i, k, j_end) + (rv(i, k, jte)-rv(i&
&          , k, jte-1))*temp31b53
        rvb(i, k, jte) = rvb(i, k, jte) + temp31b54
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - temp31b54
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
          rvb(i, k, jte) = rvb(i, k, jte) + 0.5*vbb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from31)
    CALL POPINTEGER4(ad_to31)
    DO i=ad_to31,ad_from31,-1
      DO k=ktf,kts,-1
        temp31b51 = -(rdy*tendencyb(i, k, jts))
        temp31b52 = field(i, k, jts)*temp31b51
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*temp31b51
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*temp31b51
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*temp31b51
        fieldb(i, k, jts) = fieldb(i, k, jts) + (rv(i, k, jts+1)-rv(i, k&
&          , jts))*temp31b51
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + temp31b52
        rvb(i, k, jts) = rvb(i, k, jts) - temp31b52
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + 0.5*vbb
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from30)
    CALL POPINTEGER4(ad_to30)
    DO j=ad_to30,ad_from30,-1
      DO k=ktf,kts,-1
        temp31b49 = -(rdx*tendencyb(i_end, k, j))
        temp31b50 = field(i_end, k, j)*temp31b49
        ubb = (field_old(i_end, k, j)-field_old(i_end-1, k, j))*&
&          temp31b49
        field_oldb(i_end, k, j) = field_oldb(i_end, k, j) + ub*temp31b49
        field_oldb(i_end-1, k, j) = field_oldb(i_end-1, k, j) - ub*&
&          temp31b49
        fieldb(i_end, k, j) = fieldb(i_end, k, j) + (ru(ite, k, j)-ru(&
&          ite-1, k, j))*temp31b49
        rub(ite, k, j) = rub(ite, k, j) + temp31b50
        rub(ite-1, k, j) = rub(ite-1, k, j) - temp31b50
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite-1, k, j) = rub(ite-1, k, j) + 0.5*ubb
          rub(ite, k, j) = rub(ite, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from29)
    CALL POPINTEGER4(ad_to29)
    DO j=ad_to29,ad_from29,-1
      DO k=ktf,kts,-1
        temp31b47 = -(rdx*tendencyb(its, k, j))
        temp31b48 = field(its, k, j)*temp31b47
        ubb = (field_old(its+1, k, j)-field_old(its, k, j))*temp31b47
        field_oldb(its+1, k, j) = field_oldb(its+1, k, j) + ub*temp31b47
        field_oldb(its, k, j) = field_oldb(its, k, j) - ub*temp31b47
        fieldb(its, k, j) = fieldb(its, k, j) + (ru(its+1, k, j)-ru(its&
&          , k, j))*temp31b47
        rub(its+1, k, j) = rub(its+1, k, j) + temp31b48
        rub(its, k, j) = rub(its, k, j) - temp31b48
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + 0.5*ubb
          rub(its+1, k, j) = rub(its+1, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 3) THEN
    IF (branch .NE. 0) THEN
      IF (branch .EQ. 1) THEN
        CALL POPINTEGER4(ad_from20)
        CALL POPINTEGER4(ad_to20)
        DO j=ad_to20,ad_from20,-1
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from19)
            CALL POPINTEGER4(ad_to19)
            DO i=ad_to19,ad_from19,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b8 = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b8
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b8
              fqxb(i, k, j) = 0.0
              temp31b9 = dx*mu*fqxlb(i, k, j)/dt
              min52b = 0.5*field_old(i-1, k, j)*temp31b9
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min52*&
&                temp31b9
              max35b = 0.5*field_old(i, k, j)*temp31b9
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max35*&
&                temp31b9
              mub0 = (0.5*(min52*field_old(i-1, k, j))+0.5*(max35*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max35)
                y85b = max35b
              ELSE
                CALL POPREAL8(max35)
                y85b = 0.0
              END IF
              crb = y85b
              abs85b = -y85b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs85b
              ELSE
                crb = crb - abs85b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min52)
                y34b = min52b
              ELSE
                CALL POPREAL8(min52)
                y34b = 0.0
              END IF
              crb = crb + y34b
              abs34b = y34b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs34b
              ELSE
                crb = crb - abs34b
              END IF
              temp31b7 = dt*crb/(dx*mu)
              velb = temp31b7
              mub0 = mub0 - vel*temp31b7/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END DO
        END DO
        CALL POPINTEGER4(ad_from18)
        CALL POPINTEGER4(ad_to18)
        DO j=ad_to18,ad_from18,-1
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from17)
            CALL POPINTEGER4(ad_to17)
            DO i=ad_to17,ad_from17,-1
              fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
              temp31b5 = 0.5*rv(i, k, j)*fqyb(i, k, j)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b5
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b5
              fqyb(i, k, j) = 0.0
              temp31b6 = dy*mu*fqylb(i, k, j)/dt
              min51b = 0.5*field_old(i, k, j-1)*temp31b6
              field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min51*&
&                temp31b6
              max34b = 0.5*field_old(i, k, j)*temp31b6
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max34*&
&                temp31b6
              mub0 = (0.5*(min51*field_old(i, k, j-1))+0.5*(max34*&
&                field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
              fqylb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max34)
                y84b = max34b
              ELSE
                CALL POPREAL8(max34)
                y84b = 0.0
              END IF
              crb = y84b
              abs84b = -y84b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs84b
              ELSE
                crb = crb - abs84b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min51)
                y33b = min51b
              ELSE
                CALL POPREAL8(min51)
                y33b = 0.0
              END IF
              crb = crb + y33b
              abs33b = y33b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs33b
              ELSE
                crb = crb - abs33b
              END IF
              temp31b4 = dt*crb/(dy*mu)
              velb = temp31b4
              mub0 = mub0 - vel*temp31b4/mu
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
              CALL POPREAL8(dy)
            END DO
          END DO
        END DO
      ELSE
        CALL POPINTEGER4(ad_from16)
        CALL POPINTEGER4(ad_to16)
        DO j=ad_to16,ad_from16,-1
          CALL POPCONTROL2B(branch)
          IF (branch .NE. 0) THEN
            IF (branch .NE. 1) THEN
              DO k=ktf,kts,-1
                fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
                temp31b2 = 0.5*ru(i, k, j)*fqxb(i, k, j)
                rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(&
&                  i-1, k, j))*fqxb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp31b2
                fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b2
                fqxb(i, k, j) = 0.0
                temp31b3 = dx*mu*fqxlb(i, k, j)/dt
                min48b = 0.5*field_old(i-1, k, j)*temp31b3
                field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*&
&                  min48*temp31b3
                max33b = 0.5*field_old(i, k, j)*temp31b3
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max33*&
&                  temp31b3
                mub0 = (0.5*(min48*field_old(i-1, k, j))+0.5*(max33*&
&                  field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
                fqxlb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max33)
                  y83b = max33b
                ELSE
                  CALL POPREAL8(max33)
                  y83b = 0.0
                END IF
                crb = y83b
                abs83b = -y83b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs83b
                ELSE
                  crb = crb - abs83b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min48)
                  y32b = min48b
                ELSE
                  CALL POPREAL8(min48)
                  y32b = 0.0
                END IF
                crb = crb + y32b
                abs32b = y32b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs32b
                ELSE
                  crb = crb - abs32b
                END IF
                temp31b1 = dt*crb/(dx*mu)
                velb = temp31b1
                mub0 = mub0 - vel*temp31b1/mu
                CALL POPREAL8(vel)
                rub(i, k, j) = rub(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
                CALL POPREAL8(dx)
              END DO
              CALL POPINTEGER4(i)
            END IF
          END IF
          CALL POPCONTROL2B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b
              fqxb(i, k, j) = 0.0
              temp31b0 = dx*mu*fqxlb(i, k, j)/dt
              min47b = 0.5*field_old(i-1, k, j)*temp31b0
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min47*&
&                temp31b0
              max32b = 0.5*field_old(i, k, j)*temp31b0
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max32*&
&                temp31b0
              mub0 = (0.5*(min47*field_old(i-1, k, j))+0.5*(max32*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max32)
                y82b = max32b
              ELSE
                CALL POPREAL8(max32)
                y82b = 0.0
              END IF
              crb = y82b
              abs82b = -y82b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs82b
              ELSE
                crb = crb - abs82b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min47)
                y31b = min47b
              ELSE
                CALL POPREAL8(min47)
                y31b = 0.0
              END IF
              crb = crb + y31b
              abs31b = y31b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs31b
              ELSE
                crb = crb - abs31b
              END IF
              velb = dt*crb/dx
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb/mu
              mub0 = mub0 - ru(i, k, j)*velb/mu**2
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
            CALL POPINTEGER4(i)
          END IF
          DO k=ktf,kts,-1
            DO i=i_end_f,i_start_f,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp27 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&                , k, j)-field(i-1, k, j))
              temp30 = SIGN(1., vel)
              temp29 = temp30/12.
              temp28 = SIGN(1, time_step)
              temp27b6 = vel*fqxb(i, k, j)
              temp27b7 = 7.*temp27b6/12.
              temp27b8 = temp28*temp29*temp27b6
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&                i+1, k, j)+field(i-2, k, j))/12.+temp28*(temp29*temp27))&
&                *fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp27b7 - 3.*temp27b8
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp27b8 + &
&                temp27b7
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp27b8 - &
&                temp27b6/12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp27b8 - &
&                temp27b6/12.
              fqxb(i, k, j) = 0.0
              temp27b9 = dx*mu*fqxlb(i, k, j)/dt
              min46b = 0.5*field_old(i-1, k, j)*temp27b9
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min46*&
&                temp27b9
              max31b = 0.5*field_old(i, k, j)*temp27b9
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max31*&
&                temp27b9
              mub0 = (0.5*(min46*field_old(i-1, k, j))+0.5*(max31*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max31)
                y81b = max31b
              ELSE
                CALL POPREAL8(max31)
                y81b = 0.0
              END IF
              crb = y81b
              abs81b = -y81b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs81b
              ELSE
                crb = crb - abs81b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min46)
                y30b = min46b
              ELSE
                CALL POPREAL8(min46)
                y30b = 0.0
              END IF
              crb = crb + y30b
              abs30b = y30b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs30b
              ELSE
                crb = crb - abs30b
              END IF
              temp27b5 = dt*crb/(dx*mu)
              velb = velb + temp27b5
              mub0 = mub0 - vel*temp27b5/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
            CALL POPINTEGER4(i)
          END DO
        END DO
        CALL POPINTEGER4(ad_from15)
        CALL POPINTEGER4(ad_to15)
        DO j=ad_to15,ad_from15,-1
          CALL POPCONTROL2B(branch)
          IF (branch .LT. 2) THEN
            IF (branch .NE. 0) THEN
              DO k=ktf,kts,-1
                CALL POPINTEGER4(ad_from14)
                CALL POPINTEGER4(ad_to14)
                DO i=ad_to14,ad_from14,-1
                  fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                  temp27b3 = 0.5*rv(i, k, j)*fqyb(i, k, j)
                  rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+&
&                    field(i, k, j-1))*fqyb(i, k, j)
                  fieldb(i, k, j) = fieldb(i, k, j) + temp27b3
                  fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp27b3
                  fqyb(i, k, j) = 0.0
                  temp27b4 = dy*mu*fqylb(i, k, j)/dt
                  min43b = 0.5*field_old(i, k, j-1)*temp27b4
                  field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*&
&                    min43*temp27b4
                  max30b = 0.5*field_old(i, k, j)*temp27b4
                  field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max30*&
&                    temp27b4
                  mub0 = (0.5*(min43*field_old(i, k, j-1))+0.5*(max30*&
&                    field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                  fqylb(i, k, j) = 0.0
                  CALL POPCONTROL1B(branch)
                  IF (branch .EQ. 0) THEN
                    CALL POPREAL8(max30)
                    y80b = max30b
                  ELSE
                    CALL POPREAL8(max30)
                    y80b = 0.0
                  END IF
                  crb = y80b
                  abs80b = -y80b
                  CALL POPCONTROL1B(branch)
                  IF (branch .EQ. 0) THEN
                    crb = crb + abs80b
                  ELSE
                    crb = crb - abs80b
                  END IF
                  CALL POPCONTROL1B(branch)
                  IF (branch .EQ. 0) THEN
                    CALL POPREAL8(min43)
                    y29b = min43b
                  ELSE
                    CALL POPREAL8(min43)
                    y29b = 0.0
                  END IF
                  crb = crb + y29b
                  abs29b = y29b
                  CALL POPCONTROL1B(branch)
                  IF (branch .EQ. 0) THEN
                    crb = crb + abs29b
                  ELSE
                    crb = crb - abs29b
                  END IF
                  temp27b2 = dt*crb/(dy*mu)
                  velb = temp27b2
                  mub0 = mub0 - vel*temp27b2/mu
                  CALL POPREAL8(vel)
                  rvb(i, k, j) = rvb(i, k, j) + velb
                  CALL POPREAL8(mu)
                  mutb(i, j) = mutb(i, j) + 0.5*mub0
                  mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                  CALL POPREAL8(dy)
                END DO
              END DO
            END IF
          ELSE IF (branch .EQ. 2) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from13)
              CALL POPINTEGER4(ad_to13)
              DO i=ad_to13,ad_from13,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp27b0 = 0.5*rv(i, k, j)*fqyb(i, k, j)
                rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(&
&                  i, k, j-1))*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp27b0
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp27b0
                fqyb(i, k, j) = 0.0
                temp27b1 = dy*mu*fqylb(i, k, j)/dt
                min42b = 0.5*field_old(i, k, j-1)*temp27b1
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*&
&                  min42*temp27b1
                max29b = 0.5*field_old(i, k, j)*temp27b1
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max29*&
&                  temp27b1
                mub0 = (0.5*(min42*field_old(i, k, j-1))+0.5*(max29*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max29)
                  y79b = max29b
                ELSE
                  CALL POPREAL8(max29)
                  y79b = 0.0
                END IF
                crb = y79b
                abs79b = -y79b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs79b
                ELSE
                  crb = crb - abs79b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min42)
                  y28b = min42b
                ELSE
                  CALL POPREAL8(min42)
                  y28b = 0.0
                END IF
                crb = crb + y28b
                abs28b = y28b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs28b
                ELSE
                  crb = crb - abs28b
                END IF
                temp27b = dt*crb/(dy*mu)
                velb = temp27b
                mub0 = mub0 - vel*temp27b/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from12)
              CALL POPINTEGER4(ad_to12)
              DO i=ad_to12,ad_from12,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp23 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field&
&                  (i, k, j)-field(i, k, j-1))
                temp26 = SIGN(1., vel)
                temp25 = temp26/12.
                temp24 = SIGN(1, time_step)
                temp23b19 = vel*fqyb(i, k, j)
                temp23b20 = 7.*temp23b19/12.
                temp23b21 = temp24*temp25*temp23b19
                velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(&
&                  field(i, k, j+1)+field(i, k, j-2))/12.+temp24*(temp25*&
&                  temp23))*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp23b20 - 3.*&
&                  temp23b21
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp23b21 + &
&                  temp23b20
                fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp23b21 - &
&                  temp23b19/12.
                fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp23b21 - &
&                  temp23b19/12.
                fqyb(i, k, j) = 0.0
                temp23b22 = dy*mu*fqylb(i, k, j)/dt
                min41b = 0.5*field_old(i, k, j-1)*temp23b22
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*&
&                  min41*temp23b22
                max28b = 0.5*field_old(i, k, j)*temp23b22
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max28*&
&                  temp23b22
                mub0 = (0.5*(min41*field_old(i, k, j-1))+0.5*(max28*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max28)
                  y78b = max28b
                ELSE
                  CALL POPREAL8(max28)
                  y78b = 0.0
                END IF
                crb = y78b
                abs78b = -y78b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs78b
                ELSE
                  crb = crb - abs78b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min41)
                  y27b = min41b
                ELSE
                  CALL POPREAL8(min41)
                  y27b = 0.0
                END IF
                crb = crb + y27b
                abs27b = y27b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs27b
                ELSE
                  crb = crb - abs27b
                END IF
                temp23b18 = dt*crb/(dy*mu)
                velb = velb + temp23b18
                mub0 = mub0 - vel*temp23b18/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          END IF
        END DO
      END IF
    END IF
  ELSE IF (branch .EQ. 3) THEN
    CALL POPINTEGER4(ad_from11)
    CALL POPINTEGER4(ad_to11)
    DO j=ad_to11,ad_from11,-1
      CALL POPCONTROL2B(branch)
      IF (branch .NE. 0) THEN
        IF (branch .NE. 1) THEN
          DO k=ktf,kts,-1
            fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
            temp23b16 = 0.5*ru(i, k, j)*fqxb(i, k, j)
            rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-1&
&              , k, j))*fqxb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp23b16
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp23b16
            fqxb(i, k, j) = 0.0
            temp23b17 = dx*mu*fqxlb(i, k, j)/dt
            min38b = 0.5*field_old(i-1, k, j)*temp23b17
            field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min38*&
&              temp23b17
            max27b = 0.5*field_old(i, k, j)*temp23b17
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max27*&
&              temp23b17
            mub0 = (0.5*(min38*field_old(i-1, k, j))+0.5*(max27*&
&              field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
            fqxlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max27)
              y77b = max27b
            ELSE
              CALL POPREAL8(max27)
              y77b = 0.0
            END IF
            crb = y77b
            abs77b = -y77b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs77b
            ELSE
              crb = crb - abs77b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min38)
              y26b = min38b
            ELSE
              CALL POPREAL8(min38)
              y26b = 0.0
            END IF
            crb = crb + y26b
            abs26b = y26b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs26b
            ELSE
              crb = crb - abs26b
            END IF
            temp23b15 = dt*crb/(dx*mu)
            velb = temp23b15
            mub0 = mub0 - vel*temp23b15/mu
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
            CALL POPREAL8(dx)
          END DO
          CALL POPINTEGER4(i)
        END IF
      END IF
      CALL POPCONTROL2B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
          temp23b13 = 0.5*ru(i, k, j)*fqxb(i, k, j)
          rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-1, k&
&            , j))*fqxb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp23b13
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp23b13
          fqxb(i, k, j) = 0.0
          temp23b14 = dx*mu*fqxlb(i, k, j)/dt
          min37b = 0.5*field_old(i-1, k, j)*temp23b14
          field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min37*&
&            temp23b14
          max26b = 0.5*field_old(i, k, j)*temp23b14
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max26*&
&            temp23b14
          mub0 = (0.5*(min37*field_old(i-1, k, j))+0.5*(max26*field_old(&
&            i, k, j)))*dx*fqxlb(i, k, j)/dt
          fqxlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max26)
            y76b = max26b
          ELSE
            CALL POPREAL8(max26)
            y76b = 0.0
          END IF
          crb = y76b
          abs76b = -y76b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs76b
          ELSE
            crb = crb - abs76b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min37)
            y25b = min37b
          ELSE
            CALL POPREAL8(min37)
            y25b = 0.0
          END IF
          crb = crb + y25b
          abs25b = y25b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs25b
          ELSE
            crb = crb - abs25b
          END IF
          velb = dt*crb/dx
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + velb/mu
          mub0 = mub0 - ru(i, k, j)*velb/mu**2
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
          CALL POPREAL8(dx)
        END DO
        CALL POPINTEGER4(i)
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
          temp23b10 = vel*fqxb(i, k, j)
          temp23b11 = 7.*temp23b10/12.
          velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(i+1&
&            , k, j)+field(i-2, k, j))/12.)*fqxb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp23b11
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp23b11
          fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp23b10/12.
          fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp23b10/12.
          fqxb(i, k, j) = 0.0
          temp23b12 = dx*mu*fqxlb(i, k, j)/dt
          min36b = 0.5*field_old(i-1, k, j)*temp23b12
          field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min36*&
&            temp23b12
          max25b = 0.5*field_old(i, k, j)*temp23b12
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max25*&
&            temp23b12
          mub0 = (0.5*(min36*field_old(i-1, k, j))+0.5*(max25*field_old(&
&            i, k, j)))*dx*fqxlb(i, k, j)/dt
          fqxlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max25)
            y75b = max25b
          ELSE
            CALL POPREAL8(max25)
            y75b = 0.0
          END IF
          crb = y75b
          abs75b = -y75b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs75b
          ELSE
            crb = crb - abs75b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min36)
            y24b = min36b
          ELSE
            CALL POPREAL8(min36)
            y24b = 0.0
          END IF
          crb = crb + y24b
          abs24b = y24b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs24b
          ELSE
            crb = crb - abs24b
          END IF
          temp23b9 = dt*crb/(dx*mu)
          velb = velb + temp23b9
          mub0 = mub0 - vel*temp23b9/mu
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
          CALL POPREAL8(dx)
        END DO
        CALL POPINTEGER4(i)
      END DO
    END DO
    CALL POPINTEGER4(ad_from10)
    CALL POPINTEGER4(ad_to10)
    DO j=ad_to10,ad_from10,-1
      CALL POPCONTROL2B(branch)
      IF (branch .LT. 2) THEN
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from9)
            CALL POPINTEGER4(ad_to9)
            DO i=ad_to9,ad_from9,-1
              fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
              temp23b7 = 0.5*rv(i, k, j)*fqyb(i, k, j)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&                , k, j-1))*fqyb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp23b7
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp23b7
              fqyb(i, k, j) = 0.0
              temp23b8 = dy*mu*fqylb(i, k, j)/dt
              min33b = 0.5*field_old(i, k, j-1)*temp23b8
              field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min33*&
&                temp23b8
              max24b = 0.5*field_old(i, k, j)*temp23b8
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max24*&
&                temp23b8
              mub0 = (0.5*(min33*field_old(i, k, j-1))+0.5*(max24*&
&                field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
              fqylb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max24)
                y74b = max24b
              ELSE
                CALL POPREAL8(max24)
                y74b = 0.0
              END IF
              crb = y74b
              abs74b = -y74b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs74b
              ELSE
                crb = crb - abs74b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min33)
                y23b = min33b
              ELSE
                CALL POPREAL8(min33)
                y23b = 0.0
              END IF
              crb = crb + y23b
              abs23b = y23b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs23b
              ELSE
                crb = crb - abs23b
              END IF
              temp23b6 = dt*crb/(dy*mu)
              velb = temp23b6
              mub0 = mub0 - vel*temp23b6/mu
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
              CALL POPREAL8(dy)
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 2) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from8)
          CALL POPINTEGER4(ad_to8)
          DO i=ad_to8,ad_from8,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp23b4 = 0.5*rv(i, k, j)*fqyb(i, k, j)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&              , j-1))*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp23b4
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp23b4
            fqyb(i, k, j) = 0.0
            temp23b5 = dy*mu*fqylb(i, k, j)/dt
            min32b = 0.5*field_old(i, k, j-1)*temp23b5
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min32*&
&              temp23b5
            max23b = 0.5*field_old(i, k, j)*temp23b5
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max23*&
&              temp23b5
            mub0 = (0.5*(min32*field_old(i, k, j-1))+0.5*(max23*&
&              field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max23)
              y73b = max23b
            ELSE
              CALL POPREAL8(max23)
              y73b = 0.0
            END IF
            crb = y73b
            abs73b = -y73b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs73b
            ELSE
              crb = crb - abs73b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min32)
              y22b = min32b
            ELSE
              CALL POPREAL8(min32)
              y22b = 0.0
            END IF
            crb = crb + y22b
            abs22b = y22b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs22b
            ELSE
              crb = crb - abs22b
            END IF
            temp23b3 = dt*crb/(dy*mu)
            velb = temp23b3
            mub0 = mub0 - vel*temp23b3/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from7)
          CALL POPINTEGER4(ad_to7)
          DO i=ad_to7,ad_from7,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp23b0 = vel*fqyb(i, k, j)
            temp23b1 = 7.*temp23b0/12.
            velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(i&
&              , k, j+1)+field(i, k, j-2))/12.)*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp23b1
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp23b1
            fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp23b0/12.
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp23b0/12.
            fqyb(i, k, j) = 0.0
            temp23b2 = dy*mu*fqylb(i, k, j)/dt
            min31b = 0.5*field_old(i, k, j-1)*temp23b2
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min31*&
&              temp23b2
            max22b = 0.5*field_old(i, k, j)*temp23b2
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max22*&
&              temp23b2
            mub0 = (0.5*(min31*field_old(i, k, j-1))+0.5*(max22*&
&              field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max22)
              y72b = max22b
            ELSE
              CALL POPREAL8(max22)
              y72b = 0.0
            END IF
            crb = y72b
            abs72b = -y72b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs72b
            ELSE
              crb = crb - abs72b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min31)
              y21b = min31b
            ELSE
              CALL POPREAL8(min31)
              y21b = 0.0
            END IF
            crb = crb + y21b
            abs21b = y21b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs21b
            ELSE
              crb = crb - abs21b
            END IF
            temp23b = dt*crb/(dy*mu)
            velb = velb + temp23b
            mub0 = mub0 - vel*temp23b/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      END IF
    END DO
  ELSE IF (branch .EQ. 4) THEN
    CALL POPINTEGER4(ad_from6)
    CALL POPINTEGER4(ad_to6)
    DO j=ad_to6,ad_from6,-1
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to5)
        DO i=ad_to5,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp19 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&                , k, j)-field(i-1, k, j))
              temp22 = SIGN(1., vel)
              temp21 = temp22/12.
              temp20 = SIGN(1, time_step)
              temp19b3 = vel*fqxb(i, k, j)
              temp19b4 = 7.*temp19b3/12.
              temp19b5 = temp20*temp21*temp19b3
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&                i+1, k, j)+field(i-2, k, j))/12.+temp20*(temp21*temp19))&
&                *fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp19b4 - 3.*temp19b5
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp19b5 + &
&                temp19b4
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp19b5 - &
&                temp19b3/12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp19b5 - &
&                temp19b3/12.
              fqxb(i, k, j) = 0.0
              temp19b6 = dx*mu*fqxlb(i, k, j)/dt
              min28b = 0.5*field_old(i-1, k, j)*temp19b6
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min28*&
&                temp19b6
              max21b = 0.5*field_old(i, k, j)*temp19b6
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max21*&
&                temp19b6
              mub0 = (0.5*(min28*field_old(i-1, k, j))+0.5*(max21*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max21)
                y71b = max21b
              ELSE
                CALL POPREAL8(max21)
                y71b = 0.0
              END IF
              crb = y71b
              abs71b = -y71b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs71b
              ELSE
                crb = crb - abs71b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min28)
                y20b = min28b
              ELSE
                CALL POPREAL8(min28)
                y20b = 0.0
              END IF
              crb = crb + y20b
              abs20b = y20b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs20b
              ELSE
                crb = crb - abs20b
              END IF
              temp19b2 = dt*crb/(dx*mu)
              velb = velb + temp19b2
              mub0 = mub0 - vel*temp19b2/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp19b0 = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp19b0
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp19b0
              fqxb(i, k, j) = 0.0
              temp19b1 = dx*mu*fqxlb(i, k, j)/dt
              min27b = 0.5*field_old(i-1, k, j)*temp19b1
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min27*&
&                temp19b1
              max20b = 0.5*field_old(i, k, j)*temp19b1
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max20*&
&                temp19b1
              mub0 = (0.5*(min27*field_old(i-1, k, j))+0.5*(max20*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max20)
                y70b = max20b
              ELSE
                CALL POPREAL8(max20)
                y70b = 0.0
              END IF
              crb = y70b
              abs70b = -y70b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs70b
              ELSE
                crb = crb - abs70b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min27)
                y19b = min27b
              ELSE
                CALL POPREAL8(min27)
                y19b = 0.0
              END IF
              crb = crb + y19b
              abs19b = y19b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs19b
              ELSE
                crb = crb - abs19b
              END IF
              temp19b = dt*crb/(dx*mu)
              velb = temp19b
              mub0 = mub0 - vel*temp19b/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from5)
        DO i=i_start_f-1,ad_from5,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp15 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&                , k, j)-field(i-1, k, j))
              temp18 = SIGN(1., vel)
              temp17 = temp18/12.
              temp16 = SIGN(1, time_step)
              temp15b2 = vel*fqxb(i, k, j)
              temp15b3 = 7.*temp15b2/12.
              temp15b4 = temp16*temp17*temp15b2
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&                i+1, k, j)+field(i-2, k, j))/12.+temp16*(temp17*temp15))&
&                *fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp15b3 - 3.*temp15b4
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*temp15b4 + &
&                temp15b3
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp15b4 - &
&                temp15b2/12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp15b4 - &
&                temp15b2/12.
              fqxb(i, k, j) = 0.0
              temp15b5 = dx*mu*fqxlb(i, k, j)/dt
              min26b = 0.5*field_old(i-1, k, j)*temp15b5
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min26*&
&                temp15b5
              max19b = 0.5*field_old(i, k, j)*temp15b5
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max19*&
&                temp15b5
              mub0 = (0.5*(min26*field_old(i-1, k, j))+0.5*(max19*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max19)
                y69b = max19b
              ELSE
                CALL POPREAL8(max19)
                y69b = 0.0
              END IF
              crb = y69b
              abs69b = -y69b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs69b
              ELSE
                crb = crb - abs69b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min26)
                y18b = min26b
              ELSE
                CALL POPREAL8(min26)
                y18b = 0.0
              END IF
              crb = crb + y18b
              abs18b = y18b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs18b
              ELSE
                crb = crb - abs18b
              END IF
              temp15b1 = dt*crb/(dx*mu)
              velb = velb + temp15b1
              mub0 = mub0 - vel*temp15b1/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp15b = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp15b
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp15b
              fqxb(i, k, j) = 0.0
              temp15b0 = dx*mu*fqxlb(i, k, j)/dt
              min25b = 0.5*field_old(i-1, k, j)*temp15b0
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min25*&
&                temp15b0
              max18b = 0.5*field_old(i, k, j)*temp15b0
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max18*&
&                temp15b0
              mub0 = (0.5*(min25*field_old(i-1, k, j))+0.5*(max18*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max18)
                y68b = max18b
              ELSE
                CALL POPREAL8(max18)
                y68b = 0.0
              END IF
              crb = y68b
              abs68b = -y68b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs68b
              ELSE
                crb = crb - abs68b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min25)
                y17b = min25b
              ELSE
                CALL POPREAL8(min25)
                y17b = 0.0
              END IF
              crb = crb + y17b
              abs17b = y17b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs17b
              ELSE
                crb = crb - abs17b
              END IF
              velb = dt*crb/dx
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb/mu
              mub0 = mub0 - ru(i, k, j)*velb/mu**2
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
          temp11 = field(i+2, k, j) - field(i-3, k, j) + 10.*(field(i, k&
&            , j)-field(i-1, k, j)) - 5.*(field(i+1, k, j)-field(i-2, k, &
&            j))
          temp14 = SIGN(1., vel)
          temp13 = temp14/60.
          temp12 = SIGN(1, time_step)
          temp11b0 = vel*fqxb(i, k, j)
          temp11b1 = 37.*temp11b0/60.
          temp11b2 = -(2.*temp11b0/15.)
          temp11b3 = -(temp12*temp13*temp11b0)
          velb = (37.*((field(i, k, j)+field(i-1, k, j))/60.)-2.*((field&
&            (i+1, k, j)+field(i-2, k, j))/15.)+(field(i+2, k, j)+field(i&
&            -3, k, j))/60.-temp12*(temp13*temp11))*fqxb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + 10.*temp11b3 + temp11b1
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp11b1 - 10.*&
&            temp11b3
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp11b2 - 5.*temp11b3
          fieldb(i-2, k, j) = fieldb(i-2, k, j) + 5.*temp11b3 + temp11b2
          fieldb(i+2, k, j) = fieldb(i+2, k, j) + temp11b3 + temp11b0/&
&            60.
          fieldb(i-3, k, j) = fieldb(i-3, k, j) + temp11b0/60. - &
&            temp11b3
          fqxb(i, k, j) = 0.0
          temp11b4 = dx*mu*fqxlb(i, k, j)/dt
          min24b = 0.5*field_old(i-1, k, j)*temp11b4
          field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min24*&
&            temp11b4
          max17b = 0.5*field_old(i, k, j)*temp11b4
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max17*temp11b4
          mub0 = (0.5*(min24*field_old(i-1, k, j))+0.5*(max17*field_old(&
&            i, k, j)))*dx*fqxlb(i, k, j)/dt
          fqxlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max17)
            y67b = max17b
          ELSE
            CALL POPREAL8(max17)
            y67b = 0.0
          END IF
          crb = y67b
          abs67b = -y67b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs67b
          ELSE
            crb = crb - abs67b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min24)
            y16b = min24b
          ELSE
            CALL POPREAL8(min24)
            y16b = 0.0
          END IF
          crb = crb + y16b
          abs16b = y16b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs16b
          ELSE
            crb = crb - abs16b
          END IF
          temp11b = dt*crb/(dx*mu)
          velb = velb + temp11b
          mub0 = mub0 - vel*temp11b/mu
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
          CALL POPREAL8(dx)
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_from4)
    CALL POPINTEGER4(ad_to4)
    DO j=ad_to4,ad_from4,-1
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .NE. 0) THEN
          IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from3)
              CALL POPINTEGER4(ad_to3)
              DO i=ad_to3,ad_from3,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp7 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(&
&                  i, k, j)-field(i, k, j-1))
                temp10 = SIGN(1., vel)
                temp9 = temp10/12.
                temp8 = SIGN(1, time_step)
                temp7b3 = vel*fqyb(i, k, j)
                temp7b4 = 7.*temp7b3/12.
                temp7b5 = temp8*temp9*temp7b3
                velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(&
&                  field(i, k, j+1)+field(i, k, j-2))/12.+temp8*(temp9*&
&                  temp7))*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp7b4 - 3.*temp7b5
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp7b5 + &
&                  temp7b4
                fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp7b5 - &
&                  temp7b3/12.
                fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp7b5 - &
&                  temp7b3/12.
                fqyb(i, k, j) = 0.0
                temp7b6 = dy*mu*fqylb(i, k, j)/dt
                min21b = 0.5*field_old(i, k, j-1)*temp7b6
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*&
&                  min21*temp7b6
                max16b = 0.5*field_old(i, k, j)*temp7b6
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max16*&
&                  temp7b6
                mub0 = (0.5*(min21*field_old(i, k, j-1))+0.5*(max16*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max16)
                  y66b = max16b
                ELSE
                  CALL POPREAL8(max16)
                  y66b = 0.0
                END IF
                crb = y66b
                abs66b = -y66b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs66b
                ELSE
                  crb = crb - abs66b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min21)
                  y15b = min21b
                ELSE
                  CALL POPREAL8(min21)
                  y15b = 0.0
                END IF
                crb = crb + y15b
                abs15b = y15b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs15b
                ELSE
                  crb = crb - abs15b
                END IF
                temp7b2 = dt*crb/(dy*mu)
                velb = velb + temp7b2
                mub0 = mub0 - vel*temp7b2/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from2)
              CALL POPINTEGER4(ad_to2)
              DO i=ad_to2,ad_from2,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp7b0 = 0.5*rv(i, k, j)*fqyb(i, k, j)
                rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(&
&                  i, k, j-1))*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp7b0
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp7b0
                fqyb(i, k, j) = 0.0
                temp7b1 = dy*mu*fqylb(i, k, j)/dt
                min20b = 0.5*field_old(i, k, j-1)*temp7b1
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*&
&                  min20*temp7b1
                max15b = 0.5*field_old(i, k, j)*temp7b1
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max15*&
&                  temp7b1
                mub0 = (0.5*(min20*field_old(i, k, j-1))+0.5*(max15*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max15)
                  y65b = max15b
                ELSE
                  CALL POPREAL8(max15)
                  y65b = 0.0
                END IF
                crb = y65b
                abs65b = -y65b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs65b
                ELSE
                  crb = crb - abs65b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min20)
                  y14b = min20b
                ELSE
                  CALL POPREAL8(min20)
                  y14b = 0.0
                END IF
                crb = crb + y14b
                abs14b = y14b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs14b
                ELSE
                  crb = crb - abs14b
                END IF
                temp7b = dt*crb/(dy*mu)
                velb = temp7b
                mub0 = mub0 - vel*temp7b/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          END IF
        END IF
      ELSE IF (branch .EQ. 3) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from1)
          CALL POPINTEGER4(ad_to1)
          DO i=ad_to1,ad_from1,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp3 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i, k&
&              , j)-field(i, k, j-1))
            temp6 = SIGN(1., vel)
            temp5 = temp6/12.
            temp4 = SIGN(1, time_step)
            temp3b3 = vel*fqyb(i, k, j)
            temp3b4 = 7.*temp3b3/12.
            temp3b5 = temp4*temp5*temp3b3
            velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(i&
&              , k, j+1)+field(i, k, j-2))/12.+temp4*(temp5*temp3))*fqyb(&
&              i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp3b4 - 3.*temp3b5
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*temp3b5 + temp3b4
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp3b5 - temp3b3/&
&              12.
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp3b5 - temp3b3/&
&              12.
            fqyb(i, k, j) = 0.0
            temp3b6 = dy*mu*fqylb(i, k, j)/dt
            min19b = 0.5*field_old(i, k, j-1)*temp3b6
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min19*&
&              temp3b6
            max14b = 0.5*field_old(i, k, j)*temp3b6
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max14*&
&              temp3b6
            mub0 = (0.5*(min19*field_old(i, k, j-1))+0.5*(max14*&
&              field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max14)
              y64b = max14b
            ELSE
              CALL POPREAL8(max14)
              y64b = 0.0
            END IF
            crb = y64b
            abs64b = -y64b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs64b
            ELSE
              crb = crb - abs64b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min19)
              y13b = min19b
            ELSE
              CALL POPREAL8(min19)
              y13b = 0.0
            END IF
            crb = crb + y13b
            abs13b = y13b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs13b
            ELSE
              crb = crb - abs13b
            END IF
            temp3b2 = dt*crb/(dy*mu)
            velb = velb + temp3b2
            mub0 = mub0 - vel*temp3b2/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      ELSE IF (branch .EQ. 4) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from0)
          CALL POPINTEGER4(ad_to0)
          DO i=ad_to0,ad_from0,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp3b0 = 0.5*rv(i, k, j)*fqyb(i, k, j)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&              , j-1))*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp3b0
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp3b0
            fqyb(i, k, j) = 0.0
            temp3b1 = dy*mu*fqylb(i, k, j)/dt
            min18b = 0.5*field_old(i, k, j-1)*temp3b1
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min18*&
&              temp3b1
            max13b = 0.5*field_old(i, k, j)*temp3b1
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max13*&
&              temp3b1
            mub0 = (0.5*(min18*field_old(i, k, j-1))+0.5*(max13*&
&              field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max13)
              y63b = max13b
            ELSE
              CALL POPREAL8(max13)
              y63b = 0.0
            END IF
            crb = y63b
            abs63b = -y63b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs63b
            ELSE
              crb = crb - abs63b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min18)
              y12b = min18b
            ELSE
              CALL POPREAL8(min18)
              y12b = 0.0
            END IF
            crb = crb + y12b
            abs12b = y12b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs12b
            ELSE
              crb = crb - abs12b
            END IF
            temp3b = dt*crb/(dy*mu)
            velb = temp3b
            mub0 = mub0 - vel*temp3b/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from)
          CALL POPINTEGER4(ad_to)
          DO i=ad_to,ad_from,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp = field(i, k, j+2) - field(i, k, j-3) + 10.*(field(i, k&
&              , j)-field(i, k, j-1)) - 5.*(field(i, k, j+1)-field(i, k, &
&              j-2))
            temp2 = SIGN(1., vel)
            temp1 = temp2/60.
            temp0 = SIGN(1, time_step)
            tempb0 = vel*fqyb(i, k, j)
            tempb1 = 37.*tempb0/60.
            tempb2 = -(2.*tempb0/15.)
            tempb3 = -(temp0*temp1*tempb0)
            velb = (37.*((field(i, k, j)+field(i, k, j-1))/60.)-2.*((&
&              field(i, k, j+1)+field(i, k, j-2))/15.)+(field(i, k, j+2)+&
&              field(i, k, j-3))/60.-temp0*(temp1*temp))*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + 10.*tempb3 + tempb1
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + tempb1 - 10.*tempb3
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + tempb2 - 5.*tempb3
            fieldb(i, k, j-2) = fieldb(i, k, j-2) + 5.*tempb3 + tempb2
            fieldb(i, k, j+2) = fieldb(i, k, j+2) + tempb3 + tempb0/60.
            fieldb(i, k, j-3) = fieldb(i, k, j-3) + tempb0/60. - tempb3
            fqyb(i, k, j) = 0.0
            tempb4 = dy*mu*fqylb(i, k, j)/dt
            min17b = 0.5*field_old(i, k, j-1)*tempb4
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min17*&
&              tempb4
            max12b = 0.5*field_old(i, k, j)*tempb4
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max12*tempb4
            mub0 = (0.5*(min17*field_old(i, k, j-1))+0.5*(max12*&
&              field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max12)
              y62b = max12b
            ELSE
              CALL POPREAL8(max12)
              y62b = 0.0
            END IF
            crb = y62b
            abs62b = -y62b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs62b
            ELSE
              crb = crb - abs62b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min17)
              y11b = min17b
            ELSE
              CALL POPREAL8(min17)
              y11b = 0.0
            END IF
            crb = crb + y11b
            abs11b = y11b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs11b
            ELSE
              crb = crb - abs11b
            END IF
            tempb = dt*crb/(dy*mu)
            velb = velb + tempb
            mub0 = mub0 - vel*tempb/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      END IF
    END DO
  ELSE
    CALL POPINTEGER4(ad_from28)
    CALL POPINTEGER4(ad_to28)
    DO j=ad_to28,ad_from28,-1
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_to27)
        DO i=ad_to27,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b44 = vel*fqxb(i, k, j)
              temp31b45 = 7.*temp31b44/12.
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&                i+1, k, j)+field(i-2, k, j))/12.)*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b45
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b45
              fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp31b44/12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp31b44/12.
              fqxb(i, k, j) = 0.0
              temp31b46 = dx*mu*fqxlb(i, k, j)/dt
              min14b = 0.5*field_old(i-1, k, j)*temp31b46
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min14*&
&                temp31b46
              max11b = 0.5*field_old(i, k, j)*temp31b46
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max11*&
&                temp31b46
              mub0 = (0.5*(min14*field_old(i-1, k, j))+0.5*(max11*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max11)
                y61b = max11b
              ELSE
                CALL POPREAL8(max11)
                y61b = 0.0
              END IF
              crb = y61b
              abs61b = -y61b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs61b
              ELSE
                crb = crb - abs61b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min14)
                y10b = min14b
              ELSE
                CALL POPREAL8(min14)
                y10b = 0.0
              END IF
              crb = crb + y10b
              abs10b = y10b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs10b
              ELSE
                crb = crb - abs10b
              END IF
              temp31b43 = dt*crb/(dx*mu)
              velb = velb + temp31b43
              mub0 = mub0 - vel*temp31b43/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b41 = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b41
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b41
              fqxb(i, k, j) = 0.0
              temp31b42 = dx*mu*fqxlb(i, k, j)/dt
              min13b = 0.5*field_old(i-1, k, j)*temp31b42
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min13*&
&                temp31b42
              max10b = 0.5*field_old(i, k, j)*temp31b42
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max10*&
&                temp31b42
              mub0 = (0.5*(min13*field_old(i-1, k, j))+0.5*(max10*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max10)
                y60b = max10b
              ELSE
                CALL POPREAL8(max10)
                y60b = 0.0
              END IF
              crb = y60b
              abs60b = -y60b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs60b
              ELSE
                crb = crb - abs60b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min13)
                y9b = min13b
              ELSE
                CALL POPREAL8(min13)
                y9b = 0.0
              END IF
              crb = crb + y9b
              abs9b = y9b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs9b
              ELSE
                crb = crb - abs9b
              END IF
              temp31b40 = dt*crb/(dx*mu)
              velb = temp31b40
              mub0 = mub0 - vel*temp31b40/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from27)
        DO i=i_start_f-1,ad_from27,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b37 = vel*fqxb(i, k, j)
              temp31b38 = 7.*temp31b37/12.
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&                i+1, k, j)+field(i-2, k, j))/12.)*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b38
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b38
              fieldb(i+1, k, j) = fieldb(i+1, k, j) - temp31b37/12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - temp31b37/12.
              fqxb(i, k, j) = 0.0
              temp31b39 = dx*mu*fqxlb(i, k, j)/dt
              min12b = 0.5*field_old(i-1, k, j)*temp31b39
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min12*&
&                temp31b39
              max9b = 0.5*field_old(i, k, j)*temp31b39
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max9*&
&                temp31b39
              mub0 = (0.5*(min12*field_old(i-1, k, j))+0.5*(max9*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max9)
                y59b = max9b
              ELSE
                CALL POPREAL8(max9)
                y59b = 0.0
              END IF
              crb = y59b
              abs59b = -y59b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs59b
              ELSE
                crb = crb - abs59b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min12)
                y8b = min12b
              ELSE
                CALL POPREAL8(min12)
                y8b = 0.0
              END IF
              crb = crb + y8b
              abs8b = y8b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs8b
              ELSE
                crb = crb - abs8b
              END IF
              temp31b36 = dt*crb/(dx*mu)
              velb = velb + temp31b36
              mub0 = mub0 - vel*temp31b36/mu
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
              temp31b34 = 0.5*ru(i, k, j)*fqxb(i, k, j)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&                1, k, j))*fqxb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + temp31b34
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b34
              fqxb(i, k, j) = 0.0
              temp31b35 = dx*mu*fqxlb(i, k, j)/dt
              min11b = 0.5*field_old(i-1, k, j)*temp31b35
              field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min11*&
&                temp31b35
              max8b = 0.5*field_old(i, k, j)*temp31b35
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max8*&
&                temp31b35
              mub0 = (0.5*(min11*field_old(i-1, k, j))+0.5*(max8*&
&                field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
              fqxlb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max8)
                y58b = max8b
              ELSE
                CALL POPREAL8(max8)
                y58b = 0.0
              END IF
              crb = y58b
              abs58b = -y58b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs58b
              ELSE
                crb = crb - abs58b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min11)
                y7b = min11b
              ELSE
                CALL POPREAL8(min11)
                y7b = 0.0
              END IF
              crb = crb + y7b
              abs7b = y7b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs7b
              ELSE
                crb = crb - abs7b
              END IF
              velb = dt*crb/dx
              CALL POPREAL8(vel)
              rub(i, k, j) = rub(i, k, j) + velb/mu
              mub0 = mub0 - ru(i, k, j)*velb/mu**2
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
              CALL POPREAL8(dx)
            END DO
          END IF
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
          temp31b30 = vel*fqxb(i, k, j)
          temp31b31 = 37.*temp31b30/60.
          temp31b32 = -(2.*temp31b30/15.)
          velb = (37.*((field(i, k, j)+field(i-1, k, j))/60.)-2.*((field&
&            (i+1, k, j)+field(i-2, k, j))/15.)+(field(i+2, k, j)+field(i&
&            -3, k, j))/60.)*fqxb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + temp31b31
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + temp31b31
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + temp31b32
          fieldb(i-2, k, j) = fieldb(i-2, k, j) + temp31b32
          fieldb(i+2, k, j) = fieldb(i+2, k, j) + temp31b30/60.
          fieldb(i-3, k, j) = fieldb(i-3, k, j) + temp31b30/60.
          fqxb(i, k, j) = 0.0
          temp31b33 = dx*mu*fqxlb(i, k, j)/dt
          min10b = 0.5*field_old(i-1, k, j)*temp31b33
          field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min10*&
&            temp31b33
          max7b = 0.5*field_old(i, k, j)*temp31b33
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max7*temp31b33
          mub0 = (0.5*(min10*field_old(i-1, k, j))+0.5*(max7*field_old(i&
&            , k, j)))*dx*fqxlb(i, k, j)/dt
          fqxlb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max7)
            y57b = max7b
          ELSE
            CALL POPREAL8(max7)
            y57b = 0.0
          END IF
          crb = y57b
          abs57b = -y57b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs57b
          ELSE
            crb = crb - abs57b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min10)
            y6b = min10b
          ELSE
            CALL POPREAL8(min10)
            y6b = 0.0
          END IF
          crb = crb + y6b
          abs6b = y6b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs6b
          ELSE
            crb = crb - abs6b
          END IF
          temp31b29 = dt*crb/(dx*mu)
          velb = velb + temp31b29
          mub0 = mub0 - vel*temp31b29/mu
          CALL POPREAL8(vel)
          rub(i, k, j) = rub(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
          CALL POPREAL8(dx)
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_from26)
    CALL POPINTEGER4(ad_to26)
    DO j=ad_to26,ad_from26,-1
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .NE. 0) THEN
          IF (branch .EQ. 1) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from25)
              CALL POPINTEGER4(ad_to25)
              DO i=ad_to25,ad_from25,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp31b26 = vel*fqyb(i, k, j)
                temp31b27 = 7.*temp31b26/12.
                velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(&
&                  field(i, k, j+1)+field(i, k, j-2))/12.)*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp31b27
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b27
                fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp31b26/12.
                fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp31b26/12.
                fqyb(i, k, j) = 0.0
                temp31b28 = dy*mu*fqylb(i, k, j)/dt
                min7b = 0.5*field_old(i, k, j-1)*temp31b28
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min7&
&                  *temp31b28
                max6b = 0.5*field_old(i, k, j)*temp31b28
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max6*&
&                  temp31b28
                mub0 = (0.5*(min7*field_old(i, k, j-1))+0.5*(max6*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max6)
                  y56b = max6b
                ELSE
                  CALL POPREAL8(max6)
                  y56b = 0.0
                END IF
                crb = y56b
                abs56b = -y56b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs56b
                ELSE
                  crb = crb - abs56b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min7)
                  y5b = min7b
                ELSE
                  CALL POPREAL8(min7)
                  y5b = 0.0
                END IF
                crb = crb + y5b
                abs5b = y5b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs5b
                ELSE
                  crb = crb - abs5b
                END IF
                temp31b25 = dt*crb/(dy*mu)
                velb = velb + temp31b25
                mub0 = mub0 - vel*temp31b25/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from24)
              CALL POPINTEGER4(ad_to24)
              DO i=ad_to24,ad_from24,-1
                fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
                temp31b23 = 0.5*rv(i, k, j)*fqyb(i, k, j)
                rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(&
&                  i, k, j-1))*fqyb(i, k, j)
                fieldb(i, k, j) = fieldb(i, k, j) + temp31b23
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b23
                fqyb(i, k, j) = 0.0
                temp31b24 = dy*mu*fqylb(i, k, j)/dt
                min6b = 0.5*field_old(i, k, j-1)*temp31b24
                field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min6&
&                  *temp31b24
                max5b = 0.5*field_old(i, k, j)*temp31b24
                field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max5*&
&                  temp31b24
                mub0 = (0.5*(min6*field_old(i, k, j-1))+0.5*(max5*&
&                  field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
                fqylb(i, k, j) = 0.0
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(max5)
                  y55b = max5b
                ELSE
                  CALL POPREAL8(max5)
                  y55b = 0.0
                END IF
                crb = y55b
                abs55b = -y55b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs55b
                ELSE
                  crb = crb - abs55b
                END IF
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  CALL POPREAL8(min6)
                  y4b = min6b
                ELSE
                  CALL POPREAL8(min6)
                  y4b = 0.0
                END IF
                crb = crb + y4b
                abs4b = y4b
                CALL POPCONTROL1B(branch)
                IF (branch .EQ. 0) THEN
                  crb = crb + abs4b
                ELSE
                  crb = crb - abs4b
                END IF
                temp31b22 = dt*crb/(dy*mu)
                velb = temp31b22
                mub0 = mub0 - vel*temp31b22/mu
                CALL POPREAL8(vel)
                rvb(i, k, j) = rvb(i, k, j) + velb
                CALL POPREAL8(mu)
                mutb(i, j) = mutb(i, j) + 0.5*mub0
                mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
                CALL POPREAL8(dy)
              END DO
            END DO
          END IF
        END IF
      ELSE IF (branch .EQ. 3) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from23)
          CALL POPINTEGER4(ad_to23)
          DO i=ad_to23,ad_from23,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp31b19 = vel*fqyb(i, k, j)
            temp31b20 = 7.*temp31b19/12.
            velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(i&
&              , k, j+1)+field(i, k, j-2))/12.)*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp31b20
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b20
            fieldb(i, k, j+1) = fieldb(i, k, j+1) - temp31b19/12.
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - temp31b19/12.
            fqyb(i, k, j) = 0.0
            temp31b21 = dy*mu*fqylb(i, k, j)/dt
            min5b = 0.5*field_old(i, k, j-1)*temp31b21
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min5*&
&              temp31b21
            max4b = 0.5*field_old(i, k, j)*temp31b21
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max4*&
&              temp31b21
            mub0 = (0.5*(min5*field_old(i, k, j-1))+0.5*(max4*field_old(&
&              i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max4)
              y54b = max4b
            ELSE
              CALL POPREAL8(max4)
              y54b = 0.0
            END IF
            crb = y54b
            abs54b = -y54b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs54b
            ELSE
              crb = crb - abs54b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min5)
              y3b = min5b
            ELSE
              CALL POPREAL8(min5)
              y3b = 0.0
            END IF
            crb = crb + y3b
            abs3b = y3b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs3b
            ELSE
              crb = crb - abs3b
            END IF
            temp31b18 = dt*crb/(dy*mu)
            velb = velb + temp31b18
            mub0 = mub0 - vel*temp31b18/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      ELSE IF (branch .EQ. 4) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from22)
          CALL POPINTEGER4(ad_to22)
          DO i=ad_to22,ad_from22,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp31b16 = 0.5*rv(i, k, j)*fqyb(i, k, j)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&              , j-1))*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp31b16
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b16
            fqyb(i, k, j) = 0.0
            temp31b17 = dy*mu*fqylb(i, k, j)/dt
            min4b = 0.5*field_old(i, k, j-1)*temp31b17
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min4*&
&              temp31b17
            max3b = 0.5*field_old(i, k, j)*temp31b17
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max3*&
&              temp31b17
            mub0 = (0.5*(min4*field_old(i, k, j-1))+0.5*(max3*field_old(&
&              i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max3)
              y53b = max3b
            ELSE
              CALL POPREAL8(max3)
              y53b = 0.0
            END IF
            crb = y53b
            abs53b = -y53b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs53b
            ELSE
              crb = crb - abs53b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min4)
              y2b = min4b
            ELSE
              CALL POPREAL8(min4)
              y2b = 0.0
            END IF
            crb = crb + y2b
            abs2b = y2b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs2b
            ELSE
              crb = crb - abs2b
            END IF
            temp31b15 = dt*crb/(dy*mu)
            velb = temp31b15
            mub0 = mub0 - vel*temp31b15/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from21)
          CALL POPINTEGER4(ad_to21)
          DO i=ad_to21,ad_from21,-1
            fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
            temp31b11 = vel*fqyb(i, k, j)
            temp31b12 = 37.*temp31b11/60.
            temp31b13 = -(2.*temp31b11/15.)
            velb = (37.*((field(i, k, j)+field(i, k, j-1))/60.)-2.*((&
&              field(i, k, j+1)+field(i, k, j-2))/15.)+(field(i, k, j+2)+&
&              field(i, k, j-3))/60.)*fqyb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + temp31b12
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + temp31b12
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + temp31b13
            fieldb(i, k, j-2) = fieldb(i, k, j-2) + temp31b13
            fieldb(i, k, j+2) = fieldb(i, k, j+2) + temp31b11/60.
            fieldb(i, k, j-3) = fieldb(i, k, j-3) + temp31b11/60.
            fqyb(i, k, j) = 0.0
            temp31b14 = dy*mu*fqylb(i, k, j)/dt
            min3b = 0.5*field_old(i, k, j-1)*temp31b14
            field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min3*&
&              temp31b14
            max2b = 0.5*field_old(i, k, j)*temp31b14
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max2*&
&              temp31b14
            mub0 = (0.5*(min3*field_old(i, k, j-1))+0.5*(max2*field_old(&
&              i, k, j)))*dy*fqylb(i, k, j)/dt
            fqylb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max2)
              y52b = max2b
            ELSE
              CALL POPREAL8(max2)
              y52b = 0.0
            END IF
            crb = y52b
            abs52b = -y52b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs52b
            ELSE
              crb = crb - abs52b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min3)
              y1b = min3b
            ELSE
              CALL POPREAL8(min3)
              y1b = 0.0
            END IF
            crb = crb + y1b
            abs1b = y1b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs1b
            ELSE
              crb = crb - abs1b
            END IF
            temp31b10 = dt*crb/(dy*mu)
            velb = velb + temp31b10
            mub0 = mub0 - vel*temp31b10/mu
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
            CALL POPREAL8(dy)
          END DO
        END DO
      END IF
    END DO
  END IF
END SUBROUTINE A_ADVECT_SCALAR_PD

!        Generated by TAPENADE     (INRIA, Ecuador team)
!  Tapenade 3.12 (r6213) - 13 Oct 2016 10:54
!
!  Differentiation of advect_scalar_wenopd in reverse (adjoint) mode:
!   gradient     of useful results: rom field tendency ru rv mu_old
!                field_old mut
!   with respect to varying inputs: rom field tendency ru rv mu_old
!                field_old mut
!   RW status of diff variables: rom:incr field:incr tendency:in-out
!                ru:incr rv:incr mu_old:incr field_old:incr mut:incr
SUBROUTINE A_ADVECT_SCALAR_WENOPD(field, fieldb, field_old, field_oldb, &
& tendency, tendencyb, ru, rub, rv, rvb, rom, romb, mut, mutb, mub, &
& mu_old, mu_oldb, 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) :: fieldb, field_oldb, rub&
& , rvb, romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut, mub, mu_old
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb, mu_oldb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyb
  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 :: ubb, vbb, mub0
!  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) :: fqxb, fqyb, fqzb
  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) :: fqxlb, fqylb, &
& fqzlb
  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_outb, &
& ph_lowb
  REAL :: scale
  REAL :: scaleb
  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 :: qim2b, qim1b, qib, qip1b, qip2b
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
& sumwk
  DOUBLE PRECISION :: beta0b, beta1b, beta2b, f0b, f1b, f2b, wi0b, wi1b&
& , wi2b, sumwkb
  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 :: velb, crb
!      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.
  INTEGER :: min1
  INTEGER :: min2
  REAL :: min3
  REAL :: min3b
  REAL :: min4
  REAL :: min4b
  REAL :: min5
  REAL :: min5b
  REAL :: min6
  REAL :: min6b
  REAL :: min7
  REAL :: min7b
  INTEGER :: min8
  INTEGER :: min9
  REAL :: min10
  REAL :: min10b
  REAL :: min11
  REAL :: min11b
  REAL :: min12
  REAL :: min12b
  REAL :: min13
  REAL :: min13b
  REAL :: min14
  REAL :: min14b
  INTEGER :: min15
  INTEGER :: min16
  REAL :: min17
  REAL :: min17b
  REAL :: min18
  REAL :: min18b
  REAL :: min19
  REAL :: min19b
  REAL :: min20
  REAL :: min20b
  REAL :: min21
  REAL :: min21b
  INTEGER :: min22
  INTEGER :: min23
  REAL :: max1
  REAL :: max1b
  REAL :: abs0
  REAL :: abs0b
  REAL :: max2
  REAL :: max2b
  REAL :: abs1
  REAL :: abs1b
  REAL :: max3
  REAL :: max3b
  REAL :: abs2
  REAL :: abs2b
  REAL :: max4
  REAL :: max4b
  REAL :: abs3
  REAL :: abs3b
  REAL :: max5
  REAL :: max5b
  REAL :: abs4
  REAL :: abs4b
  REAL :: max6
  REAL :: max6b
  REAL :: abs5
  REAL :: abs5b
  REAL :: max7
  REAL :: max7b
  REAL :: abs6
  REAL :: abs6b
  REAL :: max8
  REAL :: max8b
  REAL :: abs7
  REAL :: abs7b
  REAL :: max9
  REAL :: max9b
  REAL :: abs8
  REAL :: abs8b
  REAL :: max10
  REAL :: max10b
  REAL :: abs9
  REAL :: abs9b
  REAL :: max11
  REAL :: max11b
  REAL :: abs10
  REAL :: abs10b
  REAL :: max12
  REAL :: max12b
  REAL :: abs11
  REAL :: abs11b
  REAL :: max13
  REAL :: max13b
  REAL :: abs12
  REAL :: abs12b
  REAL :: max14
  REAL :: max14b
  REAL :: abs13
  REAL :: abs13b
  REAL :: max15
  REAL :: max15b
  REAL :: abs14
  REAL :: abs14b
  REAL :: max16
  REAL :: max16b
  REAL :: min24
  REAL :: min24b
  REAL :: abs15
  REAL :: abs15b
  REAL :: abs16
  REAL :: abs16b
  REAL :: abs17
  REAL :: abs17b
  REAL :: abs18
  REAL :: abs18b
  REAL :: abs19
  REAL :: abs19b
  REAL :: abs20
  REAL :: abs20b
  REAL :: abs21
  REAL :: abs21b
  REAL :: abs22
  REAL :: abs22b
  REAL :: abs23
  REAL :: abs23b
  REAL :: abs24
  REAL :: abs24b
  REAL :: abs25
  REAL :: abs25b
  REAL :: abs26
  REAL :: abs26b
  REAL :: abs27
  REAL :: abs27b
  REAL :: abs28
  REAL :: abs28b
  REAL :: abs29
  REAL :: abs29b
  REAL :: max17
  REAL :: max17b
  REAL :: min25
  REAL :: min25b
  REAL :: min26
  REAL :: min26b
  REAL :: max18
  REAL :: max18b
  REAL :: tempb
  REAL :: y1b
  REAL :: y17b
  REAL :: tempb0
  DOUBLE PRECISION :: temp
  DOUBLE PRECISION :: temp0
  DOUBLE PRECISION :: temp1
  DOUBLE PRECISION :: tempb1
  DOUBLE PRECISION :: tempb2
  REAL :: tempb3
  REAL :: tempb4
  REAL :: tempb5
  REAL :: tempb6
  REAL :: tempb7
  REAL :: tempb8
  REAL :: tempb9
  REAL :: y2b
  REAL :: y18b
  REAL :: tempb10
  REAL :: tempb11
  REAL :: tempb12
  REAL :: y3b
  REAL :: y19b
  REAL :: temp2
  REAL :: temp3
  REAL :: temp4
  REAL :: temp5
  REAL :: tempb13
  REAL :: tempb14
  REAL :: tempb15
  REAL :: tempb16
  REAL :: tempb17
  REAL :: y4b
  REAL :: y20b
  REAL :: tempb18
  REAL :: tempb19
  REAL :: tempb20
  REAL :: y5b
  REAL :: y21b
  REAL :: temp6
  REAL :: temp7
  REAL :: temp8
  REAL :: temp9
  REAL :: tempb21
  REAL :: tempb22
  REAL :: tempb23
  REAL :: tempb24
  REAL :: tempb25
  REAL :: y6b
  REAL :: y22b
  REAL :: tempb26
  DOUBLE PRECISION :: temp10
  DOUBLE PRECISION :: temp11
  DOUBLE PRECISION :: temp12
  DOUBLE PRECISION :: tempb27
  DOUBLE PRECISION :: tempb28
  REAL :: tempb29
  REAL :: tempb30
  REAL :: tempb31
  REAL :: tempb32
  REAL :: tempb33
  REAL :: tempb34
  REAL :: y7b
  REAL :: y23b
  REAL :: tempb35
  REAL :: tempb36
  REAL :: tempb37
  REAL :: y8b
  REAL :: y24b
  REAL :: temp13
  REAL :: temp14
  REAL :: temp15
  REAL :: temp16
  REAL :: tempb38
  REAL :: tempb39
  REAL :: tempb40
  REAL :: tempb41
  REAL :: tempb42
  REAL :: y9b
  REAL :: y25b
  REAL :: tempb43
  REAL :: tempb44
  REAL :: tempb45
  REAL :: y10b
  REAL :: y26b
  REAL :: temp17
  REAL :: temp18
  REAL :: temp19
  REAL :: temp20
  REAL :: tempb46
  REAL :: tempb47
  REAL :: tempb48
  REAL :: tempb49
  REAL :: tempb50
  REAL :: tempb51
  REAL :: tempb52
  REAL :: tempb53
  REAL :: tempb54
  REAL :: tempb55
  REAL :: tempb56
  REAL :: tempb57
  REAL :: tempb58
  REAL :: tempb59
  REAL :: tempb60
  REAL :: y11b
  REAL :: y27b
  REAL :: tempb61
  DOUBLE PRECISION :: temp21
  DOUBLE PRECISION :: temp22
  DOUBLE PRECISION :: temp23
  DOUBLE PRECISION :: tempb62
  DOUBLE PRECISION :: tempb63
  REAL :: tempb64
  REAL :: tempb65
  REAL :: tempb66
  REAL :: tempb67
  REAL :: tempb68
  REAL :: tempb69
  REAL :: tempb70
  REAL :: y12b
  REAL :: y28b
  REAL :: tempb71
  REAL :: tempb72
  REAL :: tempb73
  REAL :: y13b
  REAL :: y29b
  REAL :: temp24
  REAL :: temp25
  REAL :: temp26
  REAL :: temp27
  REAL :: tempb74
  REAL :: tempb75
  REAL :: tempb76
  REAL :: tempb77
  REAL :: tempb78
  REAL :: y14b
  REAL :: y30b
  REAL :: temp28
  REAL :: temp29
  REAL :: temp30
  REAL :: temp31
  REAL :: tempb79
  REAL :: tempb80
  REAL :: tempb81
  REAL :: tempb82
  REAL :: tempb83
  REAL :: y15b
  REAL :: y31b
  REAL :: tempb84
  REAL :: tempb85
  REAL :: tempb86
  REAL :: tempb87
  REAL :: tempb88
  REAL :: tempb89
  REAL :: temp32
  REAL :: y16b
  REAL :: tempb90
  REAL :: tempb91
  REAL :: tempb92
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  INTEGER :: ad_from24
  INTEGER :: ad_to24
  INTEGER :: ad_from25
  INTEGER :: ad_to25
  INTEGER :: ad_from26
  INTEGER :: ad_to26
  REAL :: y29
  REAL :: y28
  REAL :: y27
  REAL :: y26
  REAL :: y25
  REAL :: y24
  REAL :: y23
  REAL :: y22
  REAL :: y21
  REAL :: y20
  REAL :: y19
  REAL :: y18
  REAL :: y17
  REAL :: y16
  REAL :: y15
  REAL :: y14
  REAL :: y13
  REAL :: y12
  REAL :: y11
  REAL :: y10
  REAL :: y31
  REAL :: y30
  REAL :: y9
  REAL :: y8
  REAL :: y7
  REAL :: y6
  REAL :: y5
  REAL :: y4
  REAL :: y3
  REAL :: y2
  REAL :: y1
! 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
!  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
      CALL PUSHCONTROL1B(1)
      i_start = ids
    ELSE
      CALL PUSHCONTROL1B(1)
      i_start = its - 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_xe) THEN
    IF (ite + 1 .GT. ide - 1) THEN
      CALL PUSHCONTROL1B(1)
      i_end = ide - 1
    ELSE
      CALL PUSHCONTROL1B(1)
      i_end = ite + 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds + 1) THEN
      CALL PUSHCONTROL1B(0)
      j_start = jds + 1
    ELSE
      CALL PUSHCONTROL1B(0)
      j_start = jts - 1
    END IF
    j_start_f = jds + 3
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 2) THEN
      CALL PUSHCONTROL1B(1)
      j_end = jde - 2
    ELSE
      CALL PUSHCONTROL1B(1)
      j_end = jte + 1
    END IF
    j_end_f = jde - 3
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  ad_from4 = j_start
!  compute fluxes, 5th order
j_loop_y_flux_5:DO j=ad_from4,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
      DO k=kts,ktf
        ad_from = i_start
        DO i=ad_from,i_end
! ADT eqn 48 d/dy
          CALL PUSHREAL8(dy)
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs0 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs0 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y1 = cr + abs0
          IF (1.0 .GT. y1) THEN
            CALL PUSHREAL8(min3)
            min3 = y1
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min3)
            min3 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs15 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs15 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y17 = cr - abs15
          IF (-1.0 .LT. y17) THEN
            CALL PUSHREAL8(max2)
            max2 = y17
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max2)
            max2 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          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
            CALL PUSHREAL8(qip2)
            qip2 = field(i, k, j+1)
            CALL PUSHREAL8(qip1)
            qip1 = field(i, k, j)
            CALL PUSHREAL8(qi)
            qi = field(i, k, j-1)
            CALL PUSHREAL8(qim1)
            qim1 = field(i, k, j-2)
            CALL PUSHREAL8(qim2)
            qim2 = field(i, k, j-3)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(qip2)
            qip2 = field(i, k, j-2)
            CALL PUSHREAL8(qip1)
            qip1 = field(i, k, j-1)
            CALL PUSHREAL8(qi)
            qi = field(i, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = field(i, k, j+1)
            CALL PUSHREAL8(qim2)
            qim2 = field(i, k, j+2)
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(f0)
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          CALL PUSHREAL8(f1)
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          CALL PUSHREAL8(f2)
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          CALL PUSHREAL8(beta0)
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&           qi)**2
          CALL PUSHREAL8(beta1)
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          CALL PUSHREAL8(beta2)
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&           qi)**2
          wi0 = gi0/(eps1+beta0)**pw
          wi1 = gi1/(eps1+beta1)**pw
          wi2 = gi2/(eps1+beta2)**pw
          sumwk = wi0 + wi1 + wi2
          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 )
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from)
      END DO
      CALL PUSHCONTROL3B(5)
    ELSE IF (j .EQ. jds + 1) THEN
! 2nd order flux next to south boundary
      DO k=kts,ktf
        ad_from0 = i_start
        DO i=ad_from0,i_end
! ADT eqn 48 d/dy
          CALL PUSHREAL8(dy)
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs1 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs1 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y2 = cr + abs1
          IF (1.0 .GT. y2) THEN
            CALL PUSHREAL8(min4)
            min4 = y2
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min4)
            min4 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs16 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs16 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y18 = cr - abs16
          IF (-1.0 .LT. y18) THEN
            CALL PUSHREAL8(max3)
            max3 = y18
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max3)
            max3 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min4*field_old(i, k, j-1)+0.5*&
&           max3*field_old(i, k, j))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&           ))
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from0)
      END DO
      CALL PUSHCONTROL3B(4)
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        ad_from1 = i_start
        DO i=ad_from1,i_end
! ADT eqn 48 d/dy
          CALL PUSHREAL8(dy)
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs2 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs2 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y3 = cr + abs2
          IF (1.0 .GT. y3) THEN
            CALL PUSHREAL8(min5)
            min5 = y3
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min5)
            min5 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs17 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs17 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y19 = cr - abs17
          IF (-1.0 .LT. y19) THEN
            CALL PUSHREAL8(max4)
            max4 = y19
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max4)
            max4 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min5*field_old(i, k, j-1)+0.5*&
&           max4*field_old(i, k, j))
          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))))
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from1)
      END DO
      CALL PUSHCONTROL3B(3)
    ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        ad_from2 = i_start
        DO i=ad_from2,i_end
! ADT eqn 48 d/dy
          CALL PUSHREAL8(dy)
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs3 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs3 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y4 = cr + abs3
          IF (1.0 .GT. y4) THEN
            CALL PUSHREAL8(min6)
            min6 = y4
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min6)
            min6 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs18 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs18 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y20 = cr - abs18
          IF (-1.0 .LT. y20) THEN
            CALL PUSHREAL8(max5)
            max5 = y20
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max5)
            max5 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min6*field_old(i, k, j-1)+0.5*&
&           max5*field_old(i, k, j))
          fqy(i, k, j) = 0.5*rv(i, k, j)*(field(i, k, j)+field(i, k, j-1&
&           ))
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from2)
      END DO
      CALL PUSHCONTROL3B(2)
    ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts,ktf
        ad_from3 = i_start
        DO i=ad_from3,i_end
! ADT eqn 48 d/dy
          CALL PUSHREAL8(dy)
          dy = 2./(msftx(i, j)+msftx(i, j-1))/rdy
          CALL PUSHREAL8(mu)
          mu = 0.5*(mut(i, j)+mut(i, j-1))
          CALL PUSHREAL8(vel)
          vel = rv(i, k, j)
          cr = vel*dt/dy/mu
          IF (cr .GE. 0.) THEN
            abs4 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs4 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y5 = cr + abs4
          IF (1.0 .GT. y5) THEN
            CALL PUSHREAL8(min7)
            min7 = y5
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(min7)
            min7 = 1.0
            CALL PUSHCONTROL1B(1)
          END IF
          IF (cr .GE. 0.) THEN
            abs19 = cr
            CALL PUSHCONTROL1B(0)
          ELSE
            abs19 = -cr
            CALL PUSHCONTROL1B(1)
          END IF
          y21 = cr - abs19
          IF (-1.0 .LT. y21) THEN
            CALL PUSHREAL8(max6)
            max6 = y21
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(max6)
            max6 = -1.0
            CALL PUSHCONTROL1B(1)
          END IF
          fqyl(i, k, j) = mu*(dy/dt)*(0.5*min7*field_old(i, k, j-1)+0.5*&
&           max6*field_old(i, k, j))
          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))))
          fqy(i, k, j) = fqy(i, k, j) - fqyl(i, k, j)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from3)
      END DO
      CALL PUSHCONTROL3B(1)
    ELSE
      CALL PUSHCONTROL3B(0)
    END IF
  END DO j_loop_y_flux_5
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from4)
!  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
      CALL PUSHCONTROL1B(1)
      j_start = jds
    ELSE
      CALL PUSHCONTROL1B(1)
      j_start = jts - 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 1) THEN
      CALL PUSHCONTROL1B(1)
      j_end = jde - 1
    ELSE
      CALL PUSHCONTROL1B(1)
      j_end = jte + 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_xs) THEN
    IF (ids + 1 .LT. its - 1) THEN
      CALL PUSHCONTROL1B(0)
      i_start = its - 1
    ELSE
      CALL PUSHCONTROL1B(0)
      i_start = ids + 1
    END IF
    i_start_f = ids + 3
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (degrade_xe) THEN
    IF (ide - 2 .GT. ite + 1) THEN
      CALL PUSHCONTROL1B(1)
      i_end = ite + 1
    ELSE
      CALL PUSHCONTROL1B(1)
      i_end = ide - 2
    END IF
    i_end_f = ide - 3
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  ad_from6 = j_start
!  compute fluxes
  DO j=ad_from6,j_end
!  5th order flux
    DO k=kts,ktf
      DO i=i_start_f,i_end_f
! ADT eqn 48 d/dx
        CALL PUSHREAL8(dx)
        dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i-1, j))
        CALL PUSHREAL8(vel)
        vel = ru(i, k, j)
        cr = vel*dt/dx/mu
        IF (cr .GE. 0.) THEN
          abs5 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs5 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y6 = cr + abs5
        IF (1.0 .GT. y6) THEN
          CALL PUSHREAL8(min10)
          min10 = y6
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min10)
          min10 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs20 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs20 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y22 = cr - abs20
        IF (-1.0 .LT. y22) THEN
          CALL PUSHREAL8(max7)
          max7 = y22
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max7)
          max7 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        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
          CALL PUSHREAL8(qip2)
          qip2 = field(i+1, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i, k, j)
          CALL PUSHREAL8(qi)
          qi = field(i-1, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i-2, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i-3, k, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = field(i-2, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i-1, k, j)
          CALL PUSHREAL8(qi)
          qi = field(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i+1, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i+2, k, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&         )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&         )**2
        wi0 = gi0/(eps1+beta0)**pw
        wi1 = gi1/(eps1+beta1)**pw
        wi2 = gi2/(eps1+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        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                             )
        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
      ad_from5 = i_start
      DO i=ad_from5,i_start_f-1
        IF (i .EQ. ids + 1) THEN
! second order
          DO k=kts,ktf
! ADT eqn 48 d/dx
            CALL PUSHREAL8(dx)
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)/mu
            cr = vel*dt/dx
            IF (cr .GE. 0.) THEN
              abs6 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs6 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y7 = cr + abs6
            IF (1.0 .GT. y7) THEN
              CALL PUSHREAL8(min11)
              min11 = y7
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min11)
              min11 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs21 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs21 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y23 = cr - abs21
            IF (-1.0 .LT. y23) THEN
              CALL PUSHREAL8(max8)
              max8 = y23
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max8)
              max8 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min11*field_old(i-1, k, j)+&
&             0.5*max8*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&             , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (i .EQ. ids + 2) THEN
! third order
          DO k=kts,ktf
! ADT eqn 48 d/dx
            CALL PUSHREAL8(dx)
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs7 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs7 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y8 = cr + abs7
            IF (1.0 .GT. y8) THEN
              CALL PUSHREAL8(min12)
              min12 = y8
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min12)
              min12 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs22 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs22 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y24 = cr - abs22
            IF (-1.0 .LT. y24) THEN
              CALL PUSHREAL8(max9)
              max9 = y24
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max9)
              max9 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min12*field_old(i-1, k, j)+&
&             0.5*max9*field_old(i, k, j))
            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))))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(ad_from5)
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    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
            CALL PUSHREAL8(dx)
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs8 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs8 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y9 = cr + abs8
            IF (1.0 .GT. y9) THEN
              CALL PUSHREAL8(min13)
              min13 = y9
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min13)
              min13 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs23 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs23 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y25 = cr - abs23
            IF (-1.0 .LT. y25) THEN
              CALL PUSHREAL8(max10)
              max10 = y25
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max10)
              max10 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min13*field_old(i-1, k, j)+&
&             0.5*max10*field_old(i, k, j))
            fqx(i, k, j) = 0.5*ru(i, k, j)*(field(i, k, j)+field(i-1, k&
&             , j))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        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
            CALL PUSHREAL8(dx)
            dx = 2./(msfty(i, j)+msfty(i-1, j))/rdx
            CALL PUSHREAL8(mu)
            mu = 0.5*(mut(i, j)+mut(i-1, j))
            CALL PUSHREAL8(vel)
            vel = ru(i, k, j)
            cr = vel*dt/dx/mu
            IF (cr .GE. 0.) THEN
              abs9 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs9 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y10 = cr + abs9
            IF (1.0 .GT. y10) THEN
              CALL PUSHREAL8(min14)
              min14 = y10
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(min14)
              min14 = 1.0
              CALL PUSHCONTROL1B(1)
            END IF
            IF (cr .GE. 0.) THEN
              abs24 = cr
              CALL PUSHCONTROL1B(0)
            ELSE
              abs24 = -cr
              CALL PUSHCONTROL1B(1)
            END IF
            y26 = cr - abs24
            IF (-1.0 .LT. y26) THEN
              CALL PUSHREAL8(max11)
              max11 = y26
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(max11)
              max11 = -1.0
              CALL PUSHCONTROL1B(1)
            END IF
            fqxl(i, k, j) = mu*(dx/dt)*(0.5*min14*field_old(i-1, k, j)+&
&             0.5*max11*field_old(i, k, j))
            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))))
            fqx(i, k, j) = fqx(i, k, j) - fqxl(i, k, j)
          END DO
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHCONTROL1B(1)
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from6)
! 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
    ad_from7 = j_start
    DO j=ad_from7,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from7)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from8 = j_start
    DO j=ad_from8,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from8)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from9 = i_start
    DO i=ad_from9,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from9)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from10 = i_start
    DO i=ad_from10,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from10)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jts .EQ. jds) THEN
    ad_from11 = i_start
! Assuming rv(i,k,jds) = 0.
    DO i=ad_from11,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jts+1) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*rv(i, k, jts+1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from11)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    ad_from12 = i_start
! Assuming rv(i,k,jde) = 0.
    DO i=ad_from12,i_end
      DO k=kts,ktf
        IF (0.5*rv(i, k, jte-1) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*rv(i, k, jte-1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from12)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
  CALL PUSHINTEGER4(i_end)
  i_end = min15 + 1
  j_start = jts - 1
  IF (jte .GT. jde - 1) THEN
    min16 = jde - 1
  ELSE
    min16 = jte
  END IF
  CALL PUSHINTEGER4(j_end)
  j_end = min16 + 1
!-- loop bounds for open or specified conditions
  IF (degrade_xs) THEN
    IF (its - 1 .LT. ids) THEN
      CALL PUSHCONTROL1B(1)
      i_start = ids
    ELSE
      CALL PUSHCONTROL1B(1)
      i_start = its - 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_xe) THEN
    IF (ite + 1 .GT. ide - 1) THEN
      CALL PUSHCONTROL1B(1)
      i_end = ide - 1
    ELSE
      CALL PUSHCONTROL1B(1)
      i_end = ite + 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_ys) THEN
    IF (jts - 1 .LT. jds) THEN
      CALL PUSHCONTROL1B(1)
      j_start = jds
    ELSE
      CALL PUSHCONTROL1B(1)
      j_start = jts - 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_ye) THEN
    IF (jte + 1 .GT. jde - 1) THEN
      CALL PUSHCONTROL1B(1)
      j_end = jde - 1
    ELSE
      CALL PUSHCONTROL1B(1)
      j_end = jte + 1
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  ad_from16 = j_start
!    vert_order_test : IF (vert_order == 6) THEN    
!    ELSE IF (vert_order == 5) THEN    
  DO j=ad_from16,j_end
    ad_from13 = i_start
    DO i=ad_from13,i_end
      fqz(i, 1, j) = 0.
      fqzl(i, 1, j) = 0.
      fqz(i, kde, j) = 0.
      fqzl(i, kde, j) = 0.
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from13)
    CALL PUSHINTEGER4(k)
    DO k=kts+3,ktf-2
      ad_from14 = i_start
      DO i=ad_from14,i_end
        CALL PUSHREAL8(dz)
        dz = 2./(rdzw(k)+rdzw(k-1))
        CALL PUSHREAL8(mu)
        mu = 0.5*(mut(i, j)+mut(i, j))
        CALL PUSHREAL8(vel)
        vel = rom(i, k, j)
        cr = vel*dt/dz/mu
        IF (cr .GE. 0.) THEN
          abs10 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs10 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y11 = cr + abs10
        IF (1.0 .GT. y11) THEN
          CALL PUSHREAL8(min17)
          min17 = y11
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(min17)
          min17 = 1.0
          CALL PUSHCONTROL1B(1)
        END IF
        IF (cr .GE. 0.) THEN
          abs25 = cr
          CALL PUSHCONTROL1B(0)
        ELSE
          abs25 = -cr
          CALL PUSHCONTROL1B(1)
        END IF
        y27 = cr - abs25
        IF (-1.0 .LT. y27) THEN
          CALL PUSHREAL8(max12)
          max12 = y27
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(max12)
          max12 = -1.0
          CALL PUSHCONTROL1B(1)
        END IF
        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
          CALL PUSHREAL8(qip2)
          qip2 = field(i, k+1, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i, k, j)
          CALL PUSHREAL8(qi)
          qi = field(i, k-1, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i, k-2, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i, k-3, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = field(i, k-2, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i, k-1, j)
          CALL PUSHREAL8(qi)
          qi = field(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i, k+1, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i, k+2, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&         )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&         )**2
        wi0 = gi0/(eps1+beta0)**pw
        wi1 = gi1/(eps1+beta1)**pw
        wi2 = gi2/(eps1+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        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 )
        fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from14)
    END DO
    ad_from15 = i_start
    DO i=ad_from15,i_end
      CALL PUSHINTEGER4(k)
      k = kts + 1
      CALL PUSHREAL8(dz)
      dz = 2./(rdzw(k)+rdzw(k-1))
      CALL PUSHREAL8(mu)
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL PUSHREAL8(vel)
      vel = rom(i, k, j)
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs11 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs11 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y12 = cr + abs11
      IF (1.0 .GT. y12) THEN
        CALL PUSHREAL8(min18)
        min18 = y12
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(min18)
        min18 = 1.0
        CALL PUSHCONTROL1B(1)
      END IF
      IF (cr .GE. 0.) THEN
        abs26 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs26 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y28 = cr - abs26
      IF (-1.0 .LT. y28) THEN
        CALL PUSHREAL8(max13)
        max13 = y28
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(max13)
        max13 = -1.0
        CALL PUSHCONTROL1B(1)
      END IF
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min18*field_old(i, k-1, j)+0.5*&
&       max13*field_old(i, k, j))
      fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&       , k-1, j))
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = kts + 2
      CALL PUSHREAL8(dz)
      dz = 2./(rdzw(k)+rdzw(k-1))
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL PUSHREAL8(vel)
      vel = rom(i, k, j)
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs12 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs12 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y13 = cr + abs12
      IF (1.0 .GT. y13) THEN
        CALL PUSHREAL8(min19)
        min19 = y13
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(min19)
        min19 = 1.0
        CALL PUSHCONTROL1B(1)
      END IF
      IF (cr .GE. 0.) THEN
        abs27 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs27 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y29 = cr - abs27
      IF (-1.0 .LT. y29) THEN
        CALL PUSHREAL8(max14)
        max14 = y29
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(max14)
        max14 = -1.0
        CALL PUSHCONTROL1B(1)
      END IF
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min19*field_old(i, k-1, j)+0.5*&
&       max14*field_old(i, k, j))
      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))))
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = ktf - 1
      CALL PUSHREAL8(dz)
      dz = 2./(rdzw(k)+rdzw(k-1))
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL PUSHREAL8(vel)
      vel = rom(i, k, j)
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs13 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs13 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y14 = cr + abs13
      IF (1.0 .GT. y14) THEN
        CALL PUSHREAL8(min20)
        min20 = y14
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(min20)
        min20 = 1.0
        CALL PUSHCONTROL1B(1)
      END IF
      IF (cr .GE. 0.) THEN
        abs28 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs28 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y30 = cr - abs28
      IF (-1.0 .LT. y30) THEN
        CALL PUSHREAL8(max15)
        max15 = y30
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(max15)
        max15 = -1.0
        CALL PUSHCONTROL1B(1)
      END IF
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min20*field_old(i, k-1, j)+0.5*&
&       max15*field_old(i, k, j))
      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))))
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
      k = ktf
      CALL PUSHREAL8(dz)
      dz = 2./(rdzw(k)+rdzw(k-1))
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL PUSHREAL8(vel)
      vel = rom(i, k, j)
      cr = vel*dt/dz/mu
      IF (cr .GE. 0.) THEN
        abs14 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs14 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y15 = cr + abs14
      IF (1.0 .GT. y15) THEN
        CALL PUSHREAL8(min21)
        min21 = y15
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(min21)
        min21 = 1.0
        CALL PUSHCONTROL1B(1)
      END IF
      IF (cr .GE. 0.) THEN
        abs29 = cr
        CALL PUSHCONTROL1B(0)
      ELSE
        abs29 = -cr
        CALL PUSHCONTROL1B(1)
      END IF
      y31 = cr - abs29
      IF (-1.0 .LT. y31) THEN
        CALL PUSHREAL8(max16)
        max16 = y31
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(max16)
        max16 = -1.0
        CALL PUSHCONTROL1B(1)
      END IF
      fqzl(i, k, j) = mu*(dz/dt)*(0.5*min21*field_old(i, k-1, j)+0.5*&
&       max16*field_old(i, k, j))
      fqz(i, k, j) = rom(i, k, j)*(fzm(k)*field(i, k, j)+fzp(k)*field(i&
&       , k-1, j))
      fqz(i, k, j) = fqz(i, k, j) - fqzl(i, k, j)
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from15)
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from16)
!   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
        CALL PUSHCONTROL1B(1)
        i_start = ids
      ELSE
        CALL PUSHCONTROL1B(1)
        i_start = its - 1
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    IF (degrade_xe) THEN
      IF (ite + 1 .GT. ide - 1) THEN
        CALL PUSHCONTROL1B(1)
        i_end = ide - 1
      ELSE
        CALL PUSHCONTROL1B(1)
        i_end = ite + 1
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    IF (degrade_ys) THEN
      IF (jts - 1 .LT. jds) THEN
        CALL PUSHCONTROL1B(1)
        j_start = jds
      ELSE
        CALL PUSHCONTROL1B(1)
        j_start = jts - 1
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    IF (degrade_ye) THEN
      IF (jte + 1 .GT. jde - 1) THEN
        CALL PUSHCONTROL1B(1)
        j_end = jde - 1
      ELSE
        CALL PUSHCONTROL1B(1)
        j_end = jte + 1
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    IF (config_flags%specified .OR. config_flags%nested) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          CALL PUSHCONTROL1B(1)
          i_start = ids + 1
        ELSE
          CALL PUSHCONTROL1B(1)
          i_start = its - 1
        END IF
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          CALL PUSHCONTROL1B(1)
          i_end = ide - 2
        ELSE
          CALL PUSHCONTROL1B(1)
          i_end = ite + 1
        END IF
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          CALL PUSHCONTROL1B(1)
          j_start = jds + 1
        ELSE
          CALL PUSHCONTROL1B(1)
          j_start = jts - 1
        END IF
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          CALL PUSHCONTROL2B(2)
          j_end = jde - 2
        ELSE
          CALL PUSHCONTROL2B(2)
          j_end = jte + 1
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
    IF (config_flags%open_xs) THEN
      IF (degrade_xs) THEN
        IF (its - 1 .LT. ids + 1) THEN
          CALL PUSHCONTROL2B(2)
          i_start = ids + 1
        ELSE
          CALL PUSHCONTROL2B(2)
          i_start = its - 1
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
    IF (config_flags%open_xe) THEN
      IF (degrade_xe) THEN
        IF (ite + 1 .GT. ide - 2) THEN
          CALL PUSHCONTROL2B(2)
          i_end = ide - 2
        ELSE
          CALL PUSHCONTROL2B(2)
          i_end = ite + 1
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
    IF (config_flags%open_ys) THEN
      IF (degrade_ys) THEN
        IF (jts - 1 .LT. jds + 1) THEN
          CALL PUSHCONTROL2B(2)
          j_start = jds + 1
        ELSE
          CALL PUSHCONTROL2B(2)
          j_start = jts - 1
        END IF
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
    IF (config_flags%open_ye) THEN
      IF (degrade_ye) THEN
        IF (jte + 1 .GT. jde - 2) THEN
          CALL PUSHCONTROL2B(2)
          j_end = jde - 2
        ELSE
          CALL PUSHCONTROL2B(2)
          j_end = jte + 1
        END IF
      ELSE
        CALL PUSHCONTROL2B(1)
      END IF
    ELSE
      CALL PUSHCONTROL2B(0)
    END IF
    ad_from18 = j_start
! 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=ad_from18,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from17 = i_start
        DO i=ad_from17,i_end
          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)))
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from17)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from18)
    ad_from20 = j_start
    DO j=ad_from20,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from19 = i_start
!DIR$ vector always
        DO i=ad_from19,i_end
          IF (0. .LT. fqx(i+1, k, j)) THEN
            max1 = fqx(i+1, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            max1 = 0.
          END IF
          IF (0. .GT. fqx(i, k, j)) THEN
            min24 = fqx(i, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min24 = 0.
          END IF
          IF (0. .LT. fqy(i, k, j+1)) THEN
            max17 = fqy(i, k, j+1)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            max17 = 0.
          END IF
          IF (0. .GT. fqy(i, k, j)) THEN
            min25 = fqy(i, k, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min25 = 0.
          END IF
          IF (0. .GT. fqz(i, k+1, j)) THEN
            min26 = fqz(i, k+1, j)
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
            min26 = 0.
          END IF
          IF (0. .LT. fqz(i, k, j)) THEN
            max18 = fqz(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
            max18 = 0.
          END IF
          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))
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from19)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from20)
    ad_from22 = j_start
    DO j=ad_from22,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from21 = i_start
!DIR$ vector always
        DO i=ad_from21,i_end
          IF (flux_out(i, k, j) .GT. ph_low(i, k, j)) THEN
            y16 = ph_low(i, k, j)/(flux_out(i, k, j)+eps)
            IF (0. .LT. y16) THEN
              CALL PUSHREAL8(scale)
              scale = y16
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(scale)
              scale = 0.
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqx(i+1, k, j) .GT. 0.) THEN
              CALL PUSHREAL8(fqx(i+1, k, j))
              fqx(i+1, k, j) = scale*fqx(i+1, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqx(i, k, j) .LT. 0.) THEN
              CALL PUSHREAL8(fqx(i, k, j))
              fqx(i, k, j) = scale*fqx(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqy(i, k, j+1) .GT. 0.) THEN
              CALL PUSHREAL8(fqy(i, k, j+1))
              fqy(i, k, j+1) = scale*fqy(i, k, j+1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqy(i, k, j) .LT. 0.) THEN
              CALL PUSHREAL8(fqy(i, k, j))
              fqy(i, k, j) = scale*fqy(i, k, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            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
              CALL PUSHREAL8(fqz(i, k+1, j))
              fqz(i, k+1, j) = scale*fqz(i, k+1, j)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
            IF (fqz(i, k, j) .GT. 0.) THEN
              CALL PUSHREAL8(fqz(i, k, j))
              fqz(i, k, j) = scale*fqz(i, k, j)
              CALL PUSHCONTROL2B(2)
            ELSE
              CALL PUSHCONTROL2B(1)
            END IF
          ELSE
            CALL PUSHCONTROL2B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from21)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from22)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
  ad_from24 = j_start
  DO j=ad_from24,j_end
    CALL PUSHINTEGER4(k)
    DO k=kts,ktf
      ad_from23 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from23)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from24)
! x flux divergence
!
  IF (degrade_xs) THEN
    IF (its .LT. ids + 1) THEN
      CALL PUSHCONTROL1B(1)
      i_start = ids + 1
    ELSE
      CALL PUSHCONTROL1B(1)
      i_start = its
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_xe) THEN
    IF (ite .GT. ide - 2) THEN
      CALL PUSHCONTROL1B(1)
      i_end = ide - 2
    ELSE
      CALL PUSHCONTROL1B(1)
      i_end = ite
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  ad_from26 = j_start
  DO j=ad_from26,j_end
    CALL PUSHINTEGER4(k)
    DO k=kts,ktf
      ad_from25 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from25)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from26)
! 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
      CALL PUSHCONTROL1B(1)
      j_start = jds + 1
    ELSE
      CALL PUSHCONTROL1B(1)
      j_start = jts
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  IF (degrade_ye) THEN
    IF (jte .GT. jde - 2) THEN
      CALL PUSHCONTROL1B(1)
      j_end = jde - 2
    ELSE
      CALL PUSHCONTROL1B(1)
      j_end = jte
    END IF
  ELSE
    CALL PUSHCONTROL1B(0)
  END IF
  DO j=j_start,j_end
    CALL PUSHINTEGER4(k)
  END DO
  fqylb = 0.0
  fqyb = 0.0
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        tempb92 = -(msftx(i, j)*rdy*tendencyb(i, k, j))
        fqyb(i, k, j+1) = fqyb(i, k, j+1) + tempb92
        fqyb(i, k, j) = fqyb(i, k, j) - tempb92
        fqylb(i, k, j+1) = fqylb(i, k, j+1) + tempb92
        fqylb(i, k, j) = fqylb(i, k, j) - tempb92
      END DO
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  fqxlb = 0.0
  fqxb = 0.0
  CALL POPINTEGER4(ad_from26)
  CALL POPINTEGER4(ad_to26)
  DO j=ad_to26,ad_from26,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from25)
      CALL POPINTEGER4(ad_to25)
      DO i=ad_to25,ad_from25,-1
        tempb91 = -(msftx(i, j)*rdx*tendencyb(i, k, j))
        fqxb(i+1, k, j) = fqxb(i+1, k, j) + tempb91
        fqxb(i, k, j) = fqxb(i, k, j) - tempb91
        fqxlb(i+1, k, j) = fqxlb(i+1, k, j) + tempb91
        fqxlb(i, k, j) = fqxlb(i, k, j) - tempb91
      END DO
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  fqzb = 0.0
  fqzlb = 0.0
  CALL POPINTEGER4(ad_from24)
  CALL POPINTEGER4(ad_to24)
  DO j=ad_to24,ad_from24,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from23)
      CALL POPINTEGER4(ad_to23)
      DO i=ad_to23,ad_from23,-1
        tempb90 = -(rdzw(k)*tendencyb(i, k, j))
        fqzb(i, k+1, j) = fqzb(i, k+1, j) + tempb90
        fqzb(i, k, j) = fqzb(i, k, j) - tempb90
        fqzlb(i, k+1, j) = fqzlb(i, k+1, j) + tempb90
        fqzlb(i, k, j) = fqzlb(i, k, j) - tempb90
      END DO
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    flux_outb = 0.0
    ph_lowb = 0.0
    CALL POPINTEGER4(ad_from22)
    CALL POPINTEGER4(ad_to22)
    DO j=ad_to22,ad_from22,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from21)
        CALL POPINTEGER4(ad_to21)
        DO i=ad_to21,ad_from21,-1
          CALL POPCONTROL2B(branch)
          IF (branch .NE. 0) THEN
            IF (branch .EQ. 1) THEN
              scaleb = 0.0
            ELSE
              CALL POPREAL8(fqz(i, k, j))
              scaleb = fqz(i, k, j)*fqzb(i, k, j)
              fqzb(i, k, j) = scale*fqzb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqz(i, k+1, j))
              scaleb = scaleb + fqz(i, k+1, j)*fqzb(i, k+1, j)
              fqzb(i, k+1, j) = scale*fqzb(i, k+1, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqy(i, k, j))
              scaleb = scaleb + fqy(i, k, j)*fqyb(i, k, j)
              fqyb(i, k, j) = scale*fqyb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqy(i, k, j+1))
              scaleb = scaleb + fqy(i, k, j+1)*fqyb(i, k, j+1)
              fqyb(i, k, j+1) = scale*fqyb(i, k, j+1)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqx(i, k, j))
              scaleb = scaleb + fqx(i, k, j)*fqxb(i, k, j)
              fqxb(i, k, j) = scale*fqxb(i, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(fqx(i+1, k, j))
              scaleb = scaleb + fqx(i+1, k, j)*fqxb(i+1, k, j)
              fqxb(i+1, k, j) = scale*fqxb(i+1, k, j)
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(scale)
              y16b = scaleb
            ELSE
              CALL POPREAL8(scale)
              y16b = 0.0
            END IF
            temp32 = eps + flux_out(i, k, j)
            ph_lowb(i, k, j) = ph_lowb(i, k, j) + y16b/temp32
            flux_outb(i, k, j) = flux_outb(i, k, j) - ph_low(i, k, j)*&
&             y16b/temp32**2
          END IF
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(ad_from20)
    CALL POPINTEGER4(ad_to20)
    DO j=ad_to20,ad_from20,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from19)
        CALL POPINTEGER4(ad_to19)
        DO i=ad_to19,ad_from19,-1
          tempb88 = dt*msftx(i, j)*msfty(i, j)*flux_outb(i, k, j)
          tempb89 = msfty(i, j)*dt*rdzw(k)*flux_outb(i, k, j)
          max1b = rdx*tempb88
          min24b = -(rdx*tempb88)
          max17b = rdy*tempb88
          min25b = -(rdy*tempb88)
          min26b = tempb89
          max18b = -tempb89
          flux_outb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) fqzb(i, k, j) = fqzb(i, k, j) + max18b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqzb(i, k+1, j) = fqzb(i, k+1, j) + min26b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqyb(i, k, j) = fqyb(i, k, j) + min25b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqyb(i, k, j+1) = fqyb(i, k, j+1) + max17b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqxb(i, k, j) = fqxb(i, k, j) + min24b
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) fqxb(i+1, k, j) = fqxb(i+1, k, j) + max1b
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(ad_from18)
    CALL POPINTEGER4(ad_to18)
    DO j=ad_to18,ad_from18,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from17)
        CALL POPINTEGER4(ad_to17)
        DO i=ad_to17,ad_from17,-1
          tempb86 = -(dt*msftx(i, j)*msfty(i, j)*ph_lowb(i, k, j))
          tempb87 = -(dt*msfty(i, j)*rdzw(k)*ph_lowb(i, k, j))
          mu_oldb(i, j) = mu_oldb(i, j) + field_old(i, k, j)*ph_lowb(i, &
&           k, j)
          field_oldb(i, k, j) = field_oldb(i, k, j) + (mub(i, j)+mu_old(&
&           i, j))*ph_lowb(i, k, j)
          fqxlb(i+1, k, j) = fqxlb(i+1, k, j) + rdx*tempb86
          fqxlb(i, k, j) = fqxlb(i, k, j) - rdx*tempb86
          fqylb(i, k, j+1) = fqylb(i, k, j+1) + rdy*tempb86
          fqylb(i, k, j) = fqylb(i, k, j) - rdy*tempb86
          fqzlb(i, k+1, j) = fqzlb(i, k+1, j) + tempb87
          fqzlb(i, k, j) = fqzlb(i, k, j) - tempb87
          ph_lowb(i, k, j) = 0.0
        END DO
      END DO
      CALL POPINTEGER4(k)
    END DO
    CALL POPCONTROL2B(branch)
    CALL POPCONTROL2B(branch)
    CALL POPCONTROL2B(branch)
    CALL POPCONTROL2B(branch)
    CALL POPCONTROL2B(branch)
    IF (branch .NE. 0) THEN
      IF (branch .EQ. 1) GOTO 100
    END IF
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
 100 CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
  END IF
  CALL POPINTEGER4(ad_from16)
  CALL POPINTEGER4(ad_to16)
  DO j=ad_to16,ad_from16,-1
    CALL POPINTEGER4(ad_from15)
    CALL POPINTEGER4(ad_to15)
    DO i=ad_to15,ad_from15,-1
      fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
      tempb84 = rom(i, k, j)*fqzb(i, k, j)
      romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&       field(i, k-1, j))*fqzb(i, k, j)
      fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*tempb84
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*tempb84
      fqzb(i, k, j) = 0.0
      tempb85 = dz*mu*fqzlb(i, k, j)/dt
      min21b = 0.5*field_old(i, k-1, j)*tempb85
      field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min21*tempb85
      max16b = 0.5*field_old(i, k, j)*tempb85
      field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max16*tempb85
      mub0 = (0.5*(min21*field_old(i, k-1, j))+0.5*(max16*field_old(i, k&
&       , j)))*dz*fqzlb(i, k, j)/dt
      fqzlb(i, k, j) = 0.0
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(max16)
        y31b = max16b
      ELSE
        CALL POPREAL8(max16)
        y31b = 0.0
      END IF
      crb = y31b
      abs29b = -y31b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs29b
      ELSE
        crb = crb - abs29b
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(min21)
        y15b = min21b
      ELSE
        CALL POPREAL8(min21)
        y15b = 0.0
      END IF
      crb = crb + y15b
      abs14b = y15b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs14b
      ELSE
        crb = crb - abs14b
      END IF
      tempb79 = dt*crb/(dz*mu)
      velb = tempb79
      mub0 = mub0 - vel*tempb79/mu
      CALL POPREAL8(vel)
      romb(i, k, j) = romb(i, k, j) + velb
      mutb(i, j) = mutb(i, j) + 0.5*2*mub0
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL POPREAL8(dz)
      k = ktf - 1
      fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
      temp28 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j)-&
&       field(i, k-1, j))
      temp31 = SIGN(1., -vel)
      temp30 = temp31/12.
      temp29 = SIGN(1, time_step)
      tempb80 = vel*fqzb(i, k, j)
      tempb81 = 7.*tempb80/12.
      tempb82 = temp29*temp30*tempb80
      velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k+1, &
&       j)+field(i, k-2, j))/12.+temp29*(temp30*temp28))*fqzb(i, k, j)
      fieldb(i, k, j) = fieldb(i, k, j) + tempb81 - 3.*tempb82
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*tempb82 + tempb81
      fieldb(i, k+1, j) = fieldb(i, k+1, j) + tempb82 - tempb80/12.
      fieldb(i, k-2, j) = fieldb(i, k-2, j) - tempb82 - tempb80/12.
      fqzb(i, k, j) = 0.0
      tempb83 = dz*mu*fqzlb(i, k, j)/dt
      min20b = 0.5*field_old(i, k-1, j)*tempb83
      field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min20*tempb83
      max15b = 0.5*field_old(i, k, j)*tempb83
      field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max15*tempb83
      mub0 = (0.5*(min20*field_old(i, k-1, j))+0.5*(max15*field_old(i, k&
&       , j)))*dz*fqzlb(i, k, j)/dt
      fqzlb(i, k, j) = 0.0
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(max15)
        y30b = max15b
      ELSE
        CALL POPREAL8(max15)
        y30b = 0.0
      END IF
      crb = y30b
      abs28b = -y30b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs28b
      ELSE
        crb = crb - abs28b
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(min20)
        y14b = min20b
      ELSE
        CALL POPREAL8(min20)
        y14b = 0.0
      END IF
      crb = crb + y14b
      abs13b = y14b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs13b
      ELSE
        crb = crb - abs13b
      END IF
      tempb74 = dt*crb/(dz*mu)
      velb = velb + tempb74
      mub0 = mub0 - vel*tempb74/mu
      CALL POPREAL8(vel)
      romb(i, k, j) = romb(i, k, j) + velb
      mutb(i, j) = mutb(i, j) + 0.5*2*mub0
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL POPREAL8(dz)
      k = kts + 2
      fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
      temp24 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j)-&
&       field(i, k-1, j))
      temp27 = SIGN(1., -vel)
      temp26 = temp27/12.
      temp25 = SIGN(1, time_step)
      tempb75 = vel*fqzb(i, k, j)
      tempb76 = 7.*tempb75/12.
      tempb77 = temp25*temp26*tempb75
      velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k+1, &
&       j)+field(i, k-2, j))/12.+temp25*(temp26*temp24))*fqzb(i, k, j)
      fieldb(i, k, j) = fieldb(i, k, j) + tempb76 - 3.*tempb77
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*tempb77 + tempb76
      fieldb(i, k+1, j) = fieldb(i, k+1, j) + tempb77 - tempb75/12.
      fieldb(i, k-2, j) = fieldb(i, k-2, j) - tempb77 - tempb75/12.
      fqzb(i, k, j) = 0.0
      tempb78 = dz*mu*fqzlb(i, k, j)/dt
      min19b = 0.5*field_old(i, k-1, j)*tempb78
      field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min19*tempb78
      max14b = 0.5*field_old(i, k, j)*tempb78
      field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max14*tempb78
      mub0 = (0.5*(min19*field_old(i, k-1, j))+0.5*(max14*field_old(i, k&
&       , j)))*dz*fqzlb(i, k, j)/dt
      fqzlb(i, k, j) = 0.0
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(max14)
        y29b = max14b
      ELSE
        CALL POPREAL8(max14)
        y29b = 0.0
      END IF
      crb = y29b
      abs27b = -y29b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs27b
      ELSE
        crb = crb - abs27b
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(min19)
        y13b = min19b
      ELSE
        CALL POPREAL8(min19)
        y13b = 0.0
      END IF
      crb = crb + y13b
      abs12b = y13b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs12b
      ELSE
        crb = crb - abs12b
      END IF
      tempb71 = dt*crb/(dz*mu)
      velb = velb + tempb71
      mub0 = mub0 - vel*tempb71/mu
      CALL POPREAL8(vel)
      romb(i, k, j) = romb(i, k, j) + velb
      mutb(i, j) = mutb(i, j) + 0.5*2*mub0
      mu = 0.5*(mut(i, j)+mut(i, j))
      CALL POPREAL8(dz)
      k = kts + 1
      fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
      tempb72 = rom(i, k, j)*fqzb(i, k, j)
      romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&       field(i, k-1, j))*fqzb(i, k, j)
      fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*tempb72
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*tempb72
      fqzb(i, k, j) = 0.0
      tempb73 = dz*mu*fqzlb(i, k, j)/dt
      min18b = 0.5*field_old(i, k-1, j)*tempb73
      field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min18*tempb73
      max13b = 0.5*field_old(i, k, j)*tempb73
      field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max13*tempb73
      mub0 = (0.5*(min18*field_old(i, k-1, j))+0.5*(max13*field_old(i, k&
&       , j)))*dz*fqzlb(i, k, j)/dt
      fqzlb(i, k, j) = 0.0
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(max13)
        y28b = max13b
      ELSE
        CALL POPREAL8(max13)
        y28b = 0.0
      END IF
      crb = y28b
      abs26b = -y28b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs26b
      ELSE
        crb = crb - abs26b
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(min18)
        y12b = min18b
      ELSE
        CALL POPREAL8(min18)
        y12b = 0.0
      END IF
      crb = crb + y12b
      abs11b = y12b
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        crb = crb + abs11b
      ELSE
        crb = crb - abs11b
      END IF
      tempb70 = dt*crb/(dz*mu)
      velb = tempb70
      mub0 = mub0 - vel*tempb70/mu
      CALL POPREAL8(vel)
      romb(i, k, j) = romb(i, k, j) + velb
      CALL POPREAL8(mu)
      mutb(i, j) = mutb(i, j) + 0.5*2*mub0
      CALL POPREAL8(dz)
      CALL POPINTEGER4(k)
    END DO
    DO k=ktf-2,kts+3,-1
      CALL POPINTEGER4(ad_from14)
      CALL POPINTEGER4(ad_to14)
      DO i=ad_to14,ad_from14,-1
        fqzlb(i, k, j) = fqzlb(i, k, j) - fqzb(i, k, j)
        wi0 = gi0/(eps1+beta0)**pw
        wi1 = gi1/(eps1+beta1)**pw
        wi2 = gi2/(eps1+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        tempb62 = vel*fqzb(i, k, j)/sumwk
        tempb63 = (wi0*f0+wi1*f1+wi2*f2)*fqzb(i, k, j)/sumwk
        f0b = wi0*tempb62
        f1b = wi1*tempb62
        f2b = wi2*tempb62
        velb = tempb63
        sumwkb = -(vel*tempb63/sumwk)
        wi0b = sumwkb + f0*tempb62
        wi1b = sumwkb + f1*tempb62
        wi2b = sumwkb + f2*tempb62
        fqzb(i, k, j) = 0.0
        temp23 = (eps1+beta2)**pw
        IF (eps1 + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps1+beta2)**(pw-1)*wi2b/temp23**2)
        END IF
        temp22 = (eps1+beta1)**pw
        IF (eps1 + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps1+beta1)**(pw-1)*wi1b/temp22**2)
        END IF
        temp21 = (eps1+beta0)**pw
        IF (eps1 + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps1+beta0)**(pw-1)*wi0b/temp21**2)
        END IF
        CALL POPREAL8(beta2)
        tempb64 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        tempb65 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = tempb65 - f2b/6. + tempb64
        CALL POPREAL8(beta1)
        tempb66 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        tempb69 = 2*(qim1-qip1)*beta1b/4.
        qip1b = tempb66 - tempb69 + f1b/3. + 5.*f2b/6. - 4.*tempb65 - 2.&
&         *tempb64
        CALL POPREAL8(beta0)
        tempb68 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        tempb67 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*tempb66 + 11.*f0b/6. + 5.*f1b/6. + 3.*tempb67 &
&         + tempb68 + 3.*tempb65 + tempb64
        qim1b = tempb69 - 4.*tempb67 - 7.*f0b/6. - f1b/6. - 2.*tempb68 +&
&         tempb66
        qim2b = f0b/3. + tempb67 + tempb68
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          fieldb(i, k-3, j) = fieldb(i, k-3, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i, k-2, j) = fieldb(i, k-2, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i, k, j) = fieldb(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          fieldb(i, k+2, j) = fieldb(i, k+2, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i, k, j) = fieldb(i, k, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i, k-2, j) = fieldb(i, k-2, j) + qip2b
        END IF
        tempb61 = dz*mu*fqzlb(i, k, j)/dt
        min17b = 0.5*field_old(i, k-1, j)*tempb61
        field_oldb(i, k-1, j) = field_oldb(i, k-1, j) + 0.5*min17*&
&         tempb61
        max12b = 0.5*field_old(i, k, j)*tempb61
        field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max12*tempb61
        mub0 = (0.5*(min17*field_old(i, k-1, j))+0.5*(max12*field_old(i&
&         , k, j)))*dz*fqzlb(i, k, j)/dt
        fqzlb(i, k, j) = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(max12)
          y27b = max12b
        ELSE
          CALL POPREAL8(max12)
          y27b = 0.0
        END IF
        crb = y27b
        abs25b = -y27b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs25b
        ELSE
          crb = crb - abs25b
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(min17)
          y11b = min17b
        ELSE
          CALL POPREAL8(min17)
          y11b = 0.0
        END IF
        crb = crb + y11b
        abs10b = y11b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs10b
        ELSE
          crb = crb - abs10b
        END IF
        tempb60 = dt*crb/(dz*mu)
        velb = velb + tempb60
        mub0 = mub0 - vel*tempb60/mu
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + velb
        CALL POPREAL8(mu)
        mutb(i, j) = mutb(i, j) + 0.5*2*mub0
        CALL POPREAL8(dz)
      END DO
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from13)
    CALL POPINTEGER4(ad_to13)
    DO i=ad_to13,ad_from13,-1
      fqzlb(i, kde, j) = 0.0
      fqzb(i, kde, j) = 0.0
      fqzlb(i, 1, j) = 0.0
      fqzb(i, 1, j) = 0.0
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPINTEGER4(j_end)
  CALL POPINTEGER4(i_end)
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from12)
    CALL POPINTEGER4(ad_to12)
    DO i=ad_to12,ad_from12,-1
      DO k=ktf,kts,-1
        tempb59 = -(rdy*tendencyb(i, k, j_end))
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*tempb59
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*tempb59
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&         tempb59
        fieldb(i, k, j_end) = fieldb(i, k, j_end) - rv(i, k, jte-1)*&
&         tempb59
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - field(i, k, j_end)*tempb59
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from11)
    CALL POPINTEGER4(ad_to11)
    DO i=ad_to11,ad_from11,-1
      DO k=ktf,kts,-1
        tempb58 = -(rdy*tendencyb(i, k, jts))
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*tempb58
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*tempb58
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*tempb58
        fieldb(i, k, jts) = fieldb(i, k, jts) + rv(i, k, jts+1)*tempb58
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + field(i, k, jts)*tempb58
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from10)
    CALL POPINTEGER4(ad_to10)
    DO i=ad_to10,ad_from10,-1
      DO k=ktf,kts,-1
        tempb56 = -(rdy*tendencyb(i, k, j_end))
        tempb57 = field(i, k, j_end)*tempb56
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*tempb56
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*tempb56
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&         tempb56
        fieldb(i, k, j_end) = fieldb(i, k, j_end) + (rv(i, k, jte)-rv(i&
&         , k, jte-1))*tempb56
        rvb(i, k, jte) = rvb(i, k, jte) + tempb57
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - tempb57
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
          rvb(i, k, jte) = rvb(i, k, jte) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from9)
    CALL POPINTEGER4(ad_to9)
    DO i=ad_to9,ad_from9,-1
      DO k=ktf,kts,-1
        tempb54 = -(rdy*tendencyb(i, k, jts))
        tempb55 = field(i, k, jts)*tempb54
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*tempb54
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*tempb54
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*tempb54
        fieldb(i, k, jts) = fieldb(i, k, jts) + (rv(i, k, jts+1)-rv(i, k&
&         , jts))*tempb54
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + tempb55
        rvb(i, k, jts) = rvb(i, k, jts) - tempb55
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + 0.5*vbb
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from8)
    CALL POPINTEGER4(ad_to8)
    DO j=ad_to8,ad_from8,-1
      DO k=ktf,kts,-1
        tempb52 = -(rdx*tendencyb(i_end, k, j))
        tempb53 = field(i_end, k, j)*tempb52
        ubb = (field_old(i_end, k, j)-field_old(i_end-1, k, j))*tempb52
        field_oldb(i_end, k, j) = field_oldb(i_end, k, j) + ub*tempb52
        field_oldb(i_end-1, k, j) = field_oldb(i_end-1, k, j) - ub*&
&         tempb52
        fieldb(i_end, k, j) = fieldb(i_end, k, j) + (ru(ite, k, j)-ru(&
&         ite-1, k, j))*tempb52
        rub(ite, k, j) = rub(ite, k, j) + tempb53
        rub(ite-1, k, j) = rub(ite-1, k, j) - tempb53
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite-1, k, j) = rub(ite-1, k, j) + 0.5*ubb
          rub(ite, k, j) = rub(ite, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from7)
    CALL POPINTEGER4(ad_to7)
    DO j=ad_to7,ad_from7,-1
      DO k=ktf,kts,-1
        tempb50 = -(rdx*tendencyb(its, k, j))
        tempb51 = field(its, k, j)*tempb50
        ubb = (field_old(its+1, k, j)-field_old(its, k, j))*tempb50
        field_oldb(its+1, k, j) = field_oldb(its+1, k, j) + ub*tempb50
        field_oldb(its, k, j) = field_oldb(its, k, j) - ub*tempb50
        fieldb(its, k, j) = fieldb(its, k, j) + (ru(its+1, k, j)-ru(its&
&         , k, j))*tempb50
        rub(its+1, k, j) = rub(its+1, k, j) + tempb51
        rub(its, k, j) = rub(its, k, j) - tempb51
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + 0.5*ubb
          rub(its+1, k, j) = rub(its+1, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPINTEGER4(ad_from6)
  CALL POPINTEGER4(ad_to6)
  DO j=ad_to6,ad_from6,-1
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      CALL POPINTEGER4(ad_to5)
      DO i=ad_to5,i_end_f+1,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
            temp17 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i, &
&             k, j)-field(i-1, k, j))
            temp20 = SIGN(1., vel)
            temp19 = temp20/12.
            temp18 = SIGN(1, time_step)
            tempb46 = vel*fqxb(i, k, j)
            tempb47 = 7.*tempb46/12.
            tempb48 = temp18*temp19*tempb46
            velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(i+&
&             1, k, j)+field(i-2, k, j))/12.+temp18*(temp19*temp17))*&
&             fqxb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb47 - 3.*tempb48
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*tempb48 + tempb47
            fieldb(i+1, k, j) = fieldb(i+1, k, j) + tempb48 - tempb46/&
&             12.
            fieldb(i-2, k, j) = fieldb(i-2, k, j) - tempb48 - tempb46/&
&             12.
            fqxb(i, k, j) = 0.0
            tempb49 = dx*mu*fqxlb(i, k, j)/dt
            min14b = 0.5*field_old(i-1, k, j)*tempb49
            field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min14*&
&             tempb49
            max11b = 0.5*field_old(i, k, j)*tempb49
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max11*&
&             tempb49
            mub0 = (0.5*(min14*field_old(i-1, k, j))+0.5*(max11*&
&             field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
            fqxlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max11)
              y26b = max11b
            ELSE
              CALL POPREAL8(max11)
              y26b = 0.0
            END IF
            crb = y26b
            abs24b = -y26b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs24b
            ELSE
              crb = crb - abs24b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min14)
              y10b = min14b
            ELSE
              CALL POPREAL8(min14)
              y10b = 0.0
            END IF
            crb = crb + y10b
            abs9b = y10b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs9b
            ELSE
              crb = crb - abs9b
            END IF
            tempb45 = dt*crb/(dx*mu)
            velb = velb + tempb45
            mub0 = mub0 - vel*tempb45/mu
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
            CALL POPREAL8(dx)
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
            tempb43 = 0.5*ru(i, k, j)*fqxb(i, k, j)
            rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-1&
&             , k, j))*fqxb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb43
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + tempb43
            fqxb(i, k, j) = 0.0
            tempb44 = dx*mu*fqxlb(i, k, j)/dt
            min13b = 0.5*field_old(i-1, k, j)*tempb44
            field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min13*&
&             tempb44
            max10b = 0.5*field_old(i, k, j)*tempb44
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max10*&
&             tempb44
            mub0 = (0.5*(min13*field_old(i-1, k, j))+0.5*(max10*&
&             field_old(i, k, j)))*dx*fqxlb(i, k, j)/dt
            fqxlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max10)
              y25b = max10b
            ELSE
              CALL POPREAL8(max10)
              y25b = 0.0
            END IF
            crb = y25b
            abs23b = -y25b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs23b
            ELSE
              crb = crb - abs23b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min13)
              y9b = min13b
            ELSE
              CALL POPREAL8(min13)
              y9b = 0.0
            END IF
            crb = crb + y9b
            abs8b = y9b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs8b
            ELSE
              crb = crb - abs8b
            END IF
            tempb42 = dt*crb/(dx*mu)
            velb = tempb42
            mub0 = mub0 - vel*tempb42/mu
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
            CALL POPREAL8(dx)
          END DO
        END IF
      END DO
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from5)
      DO i=i_start_f-1,ad_from5,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
            temp13 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i, &
&             k, j)-field(i-1, k, j))
            temp16 = SIGN(1., vel)
            temp15 = temp16/12.
            temp14 = SIGN(1, time_step)
            tempb38 = vel*fqxb(i, k, j)
            tempb39 = 7.*tempb38/12.
            tempb40 = temp14*temp15*tempb38
            velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(i+&
&             1, k, j)+field(i-2, k, j))/12.+temp14*(temp15*temp13))*&
&             fqxb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb39 - 3.*tempb40
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*tempb40 + tempb39
            fieldb(i+1, k, j) = fieldb(i+1, k, j) + tempb40 - tempb38/&
&             12.
            fieldb(i-2, k, j) = fieldb(i-2, k, j) - tempb40 - tempb38/&
&             12.
            fqxb(i, k, j) = 0.0
            tempb41 = dx*mu*fqxlb(i, k, j)/dt
            min12b = 0.5*field_old(i-1, k, j)*tempb41
            field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min12*&
&             tempb41
            max9b = 0.5*field_old(i, k, j)*tempb41
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max9*tempb41
            mub0 = (0.5*(min12*field_old(i-1, k, j))+0.5*(max9*field_old&
&             (i, k, j)))*dx*fqxlb(i, k, j)/dt
            fqxlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max9)
              y24b = max9b
            ELSE
              CALL POPREAL8(max9)
              y24b = 0.0
            END IF
            crb = y24b
            abs22b = -y24b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs22b
            ELSE
              crb = crb - abs22b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min12)
              y8b = min12b
            ELSE
              CALL POPREAL8(min12)
              y8b = 0.0
            END IF
            crb = crb + y8b
            abs7b = y8b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs7b
            ELSE
              crb = crb - abs7b
            END IF
            tempb37 = dt*crb/(dx*mu)
            velb = velb + tempb37
            mub0 = mub0 - vel*tempb37/mu
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + velb
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
            CALL POPREAL8(dx)
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
            tempb35 = 0.5*ru(i, k, j)*fqxb(i, k, j)
            rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-1&
&             , k, j))*fqxb(i, k, j)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb35
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + tempb35
            fqxb(i, k, j) = 0.0
            tempb36 = dx*mu*fqxlb(i, k, j)/dt
            min11b = 0.5*field_old(i-1, k, j)*tempb36
            field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min11*&
&             tempb36
            max8b = 0.5*field_old(i, k, j)*tempb36
            field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max8*tempb36
            mub0 = (0.5*(min11*field_old(i-1, k, j))+0.5*(max8*field_old&
&             (i, k, j)))*dx*fqxlb(i, k, j)/dt
            fqxlb(i, k, j) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(max8)
              y23b = max8b
            ELSE
              CALL POPREAL8(max8)
              y23b = 0.0
            END IF
            crb = y23b
            abs21b = -y23b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs21b
            ELSE
              crb = crb - abs21b
            END IF
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(min11)
              y7b = min11b
            ELSE
              CALL POPREAL8(min11)
              y7b = 0.0
            END IF
            crb = crb + y7b
            abs6b = y7b
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              crb = crb + abs6b
            ELSE
              crb = crb - abs6b
            END IF
            velb = dt*crb/dx
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + velb/mu
            mub0 = mub0 - ru(i, k, j)*velb/mu**2
            CALL POPREAL8(mu)
            mutb(i, j) = mutb(i, j) + 0.5*mub0
            mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
            CALL POPREAL8(dx)
          END DO
        END IF
      END DO
    END IF
    DO k=ktf,kts,-1
      DO i=i_end_f,i_start_f,-1
        fqxlb(i, k, j) = fqxlb(i, k, j) - fqxb(i, k, j)
        wi0 = gi0/(eps1+beta0)**pw
        wi1 = gi1/(eps1+beta1)**pw
        wi2 = gi2/(eps1+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        tempb27 = vel*fqxb(i, k, j)/sumwk
        tempb28 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k, j)/sumwk
        f0b = wi0*tempb27
        f1b = wi1*tempb27
        f2b = wi2*tempb27
        velb = tempb28
        sumwkb = -(vel*tempb28/sumwk)
        wi0b = sumwkb + f0*tempb27
        wi1b = sumwkb + f1*tempb27
        wi2b = sumwkb + f2*tempb27
        fqxb(i, k, j) = 0.0
        temp12 = (eps1+beta2)**pw
        IF (eps1 + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps1+beta2)**(pw-1)*wi2b/temp12**2)
        END IF
        temp11 = (eps1+beta1)**pw
        IF (eps1 + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps1+beta1)**(pw-1)*wi1b/temp11**2)
        END IF
        temp10 = (eps1+beta0)**pw
        IF (eps1 + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw&
&           ))) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps1+beta0)**(pw-1)*wi0b/temp10**2)
        END IF
        CALL POPREAL8(beta2)
        tempb29 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        tempb30 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = tempb30 - f2b/6. + tempb29
        CALL POPREAL8(beta1)
        tempb31 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        tempb34 = 2*(qim1-qip1)*beta1b/4.
        qip1b = tempb31 - tempb34 + f1b/3. + 5.*f2b/6. - 4.*tempb30 - 2.&
&         *tempb29
        CALL POPREAL8(beta0)
        tempb33 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        tempb32 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*tempb31 + 11.*f0b/6. + 5.*f1b/6. + 3.*tempb32 &
&         + tempb33 + 3.*tempb30 + tempb29
        qim1b = tempb34 - 4.*tempb32 - 7.*f0b/6. - f1b/6. - 2.*tempb33 +&
&         tempb31
        qim2b = f0b/3. + tempb32 + tempb33
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          fieldb(i-3, k, j) = fieldb(i-3, k, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i-2, k, j) = fieldb(i-2, k, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i, k, j) = fieldb(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          fieldb(i+2, k, j) = fieldb(i+2, k, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i, k, j) = fieldb(i, k, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i-2, k, j) = fieldb(i-2, k, j) + qip2b
        END IF
        tempb26 = dx*mu*fqxlb(i, k, j)/dt
        min10b = 0.5*field_old(i-1, k, j)*tempb26
        field_oldb(i-1, k, j) = field_oldb(i-1, k, j) + 0.5*min10*&
&         tempb26
        max7b = 0.5*field_old(i, k, j)*tempb26
        field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max7*tempb26
        mub0 = (0.5*(min10*field_old(i-1, k, j))+0.5*(max7*field_old(i, &
&         k, j)))*dx*fqxlb(i, k, j)/dt
        fqxlb(i, k, j) = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(max7)
          y22b = max7b
        ELSE
          CALL POPREAL8(max7)
          y22b = 0.0
        END IF
        crb = y22b
        abs20b = -y22b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs20b
        ELSE
          crb = crb - abs20b
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(min10)
          y6b = min10b
        ELSE
          CALL POPREAL8(min10)
          y6b = 0.0
        END IF
        crb = crb + y6b
        abs5b = y6b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          crb = crb + abs5b
        ELSE
          crb = crb - abs5b
        END IF
        tempb25 = dt*crb/(dx*mu)
        velb = velb + tempb25
        mub0 = mub0 - vel*tempb25/mu
        CALL POPREAL8(vel)
        rub(i, k, j) = rub(i, k, j) + velb
        CALL POPREAL8(mu)
        mutb(i, j) = mutb(i, j) + 0.5*mub0
        mutb(i-1, j) = mutb(i-1, j) + 0.5*mub0
        CALL POPREAL8(dx)
      END DO
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPINTEGER4(ad_from4)
  CALL POPINTEGER4(ad_to4)
  DO j=ad_to4,ad_from4,-1
    CALL POPCONTROL3B(branch)
    IF (branch .LT. 3) THEN
      IF (branch .NE. 0) THEN
        IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from3)
            CALL POPINTEGER4(ad_to3)
            DO i=ad_to3,ad_from3,-1
              fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
              temp6 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i&
&               , k, j)-field(i, k, j-1))
              temp9 = SIGN(1., vel)
              temp8 = temp9/12.
              temp7 = SIGN(1, time_step)
              tempb21 = vel*fqyb(i, k, j)
              tempb22 = 7.*tempb21/12.
              tempb23 = temp7*temp8*tempb21
              velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(&
&               i, k, j+1)+field(i, k, j-2))/12.+temp7*(temp8*temp6))*&
&               fqyb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb22 - 3.*tempb23
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*tempb23 + &
&               tempb22
              fieldb(i, k, j+1) = fieldb(i, k, j+1) + tempb23 - tempb21/&
&               12.
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - tempb23 - tempb21/&
&               12.
              fqyb(i, k, j) = 0.0
              tempb24 = dy*mu*fqylb(i, k, j)/dt
              min7b = 0.5*field_old(i, k, j-1)*tempb24
              field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min7*&
&               tempb24
              max6b = 0.5*field_old(i, k, j)*tempb24
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max6*&
&               tempb24
              mub0 = (0.5*(min7*field_old(i, k, j-1))+0.5*(max6*&
&               field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
              fqylb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max6)
                y21b = max6b
              ELSE
                CALL POPREAL8(max6)
                y21b = 0.0
              END IF
              crb = y21b
              abs19b = -y21b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs19b
              ELSE
                crb = crb - abs19b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min7)
                y5b = min7b
              ELSE
                CALL POPREAL8(min7)
                y5b = 0.0
              END IF
              crb = crb + y5b
              abs4b = y5b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs4b
              ELSE
                crb = crb - abs4b
              END IF
              tempb20 = dt*crb/(dy*mu)
              velb = velb + tempb20
              mub0 = mub0 - vel*tempb20/mu
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
              CALL POPREAL8(dy)
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from2)
            CALL POPINTEGER4(ad_to2)
            DO i=ad_to2,ad_from2,-1
              fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
              tempb18 = 0.5*rv(i, k, j)*fqyb(i, k, j)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&               , k, j-1))*fqyb(i, k, j)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb18
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + tempb18
              fqyb(i, k, j) = 0.0
              tempb19 = dy*mu*fqylb(i, k, j)/dt
              min6b = 0.5*field_old(i, k, j-1)*tempb19
              field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min6*&
&               tempb19
              max5b = 0.5*field_old(i, k, j)*tempb19
              field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max5*&
&               tempb19
              mub0 = (0.5*(min6*field_old(i, k, j-1))+0.5*(max5*&
&               field_old(i, k, j)))*dy*fqylb(i, k, j)/dt
              fqylb(i, k, j) = 0.0
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(max5)
                y20b = max5b
              ELSE
                CALL POPREAL8(max5)
                y20b = 0.0
              END IF
              crb = y20b
              abs18b = -y20b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs18b
              ELSE
                crb = crb - abs18b
              END IF
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(min6)
                y4b = min6b
              ELSE
                CALL POPREAL8(min6)
                y4b = 0.0
              END IF
              crb = crb + y4b
              abs3b = y4b
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                crb = crb + abs3b
              ELSE
                crb = crb - abs3b
              END IF
              tempb17 = dt*crb/(dy*mu)
              velb = tempb17
              mub0 = mub0 - vel*tempb17/mu
              CALL POPREAL8(vel)
              rvb(i, k, j) = rvb(i, k, j) + velb
              CALL POPREAL8(mu)
              mutb(i, j) = mutb(i, j) + 0.5*mub0
              mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
              CALL POPREAL8(dy)
            END DO
          END DO
        END IF
      END IF
    ELSE IF (branch .EQ. 3) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from1)
        CALL POPINTEGER4(ad_to1)
        DO i=ad_to1,ad_from1,-1
          fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
          temp2 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i, k, &
&           j)-field(i, k, j-1))
          temp5 = SIGN(1., vel)
          temp4 = temp5/12.
          temp3 = SIGN(1, time_step)
          tempb13 = vel*fqyb(i, k, j)
          tempb14 = 7.*tempb13/12.
          tempb15 = temp3*temp4*tempb13
          velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(i, k&
&           , j+1)+field(i, k, j-2))/12.+temp3*(temp4*temp2))*fqyb(i, k&
&           , j)
          fieldb(i, k, j) = fieldb(i, k, j) + tempb14 - 3.*tempb15
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*tempb15 + tempb14
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + tempb15 - tempb13/12.
          fieldb(i, k, j-2) = fieldb(i, k, j-2) - tempb15 - tempb13/12.
          fqyb(i, k, j) = 0.0
          tempb16 = dy*mu*fqylb(i, k, j)/dt
          min5b = 0.5*field_old(i, k, j-1)*tempb16
          field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min5*&
&           tempb16
          max4b = 0.5*field_old(i, k, j)*tempb16
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max4*tempb16
          mub0 = (0.5*(min5*field_old(i, k, j-1))+0.5*(max4*field_old(i&
&           , k, j)))*dy*fqylb(i, k, j)/dt
          fqylb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max4)
            y19b = max4b
          ELSE
            CALL POPREAL8(max4)
            y19b = 0.0
          END IF
          crb = y19b
          abs17b = -y19b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs17b
          ELSE
            crb = crb - abs17b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min5)
            y3b = min5b
          ELSE
            CALL POPREAL8(min5)
            y3b = 0.0
          END IF
          crb = crb + y3b
          abs2b = y3b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs2b
          ELSE
            crb = crb - abs2b
          END IF
          tempb12 = dt*crb/(dy*mu)
          velb = velb + tempb12
          mub0 = mub0 - vel*tempb12/mu
          CALL POPREAL8(vel)
          rvb(i, k, j) = rvb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
          CALL POPREAL8(dy)
        END DO
      END DO
    ELSE IF (branch .EQ. 4) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from0)
        CALL POPINTEGER4(ad_to0)
        DO i=ad_to0,ad_from0,-1
          fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
          tempb10 = 0.5*rv(i, k, j)*fqyb(i, k, j)
          rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k, &
&           j-1))*fqyb(i, k, j)
          fieldb(i, k, j) = fieldb(i, k, j) + tempb10
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + tempb10
          fqyb(i, k, j) = 0.0
          tempb11 = dy*mu*fqylb(i, k, j)/dt
          min4b = 0.5*field_old(i, k, j-1)*tempb11
          field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min4*&
&           tempb11
          max3b = 0.5*field_old(i, k, j)*tempb11
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max3*tempb11
          mub0 = (0.5*(min4*field_old(i, k, j-1))+0.5*(max3*field_old(i&
&           , k, j)))*dy*fqylb(i, k, j)/dt
          fqylb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max3)
            y18b = max3b
          ELSE
            CALL POPREAL8(max3)
            y18b = 0.0
          END IF
          crb = y18b
          abs16b = -y18b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs16b
          ELSE
            crb = crb - abs16b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min4)
            y2b = min4b
          ELSE
            CALL POPREAL8(min4)
            y2b = 0.0
          END IF
          crb = crb + y2b
          abs1b = y2b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs1b
          ELSE
            crb = crb - abs1b
          END IF
          tempb9 = dt*crb/(dy*mu)
          velb = tempb9
          mub0 = mub0 - vel*tempb9/mu
          CALL POPREAL8(vel)
          rvb(i, k, j) = rvb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
          CALL POPREAL8(dy)
        END DO
      END DO
    ELSE
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from)
        CALL POPINTEGER4(ad_to)
        DO i=ad_to,ad_from,-1
          fqylb(i, k, j) = fqylb(i, k, j) - fqyb(i, k, j)
          wi0 = gi0/(eps1+beta0)**pw
          wi1 = gi1/(eps1+beta1)**pw
          wi2 = gi2/(eps1+beta2)**pw
          sumwk = wi0 + wi1 + wi2
          tempb1 = vel*fqyb(i, k, j)/sumwk
          tempb2 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, j)/sumwk
          f0b = wi0*tempb1
          f1b = wi1*tempb1
          f2b = wi2*tempb1
          velb = tempb2
          sumwkb = -(vel*tempb2/sumwk)
          wi0b = sumwkb + f0*tempb1
          wi1b = sumwkb + f1*tempb1
          wi2b = sumwkb + f2*tempb1
          fqyb(i, k, j) = 0.0
          temp1 = (eps1+beta2)**pw
          IF (eps1 + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta2b = 0.0
          ELSE
            beta2b = -(gi2*pw*(eps1+beta2)**(pw-1)*wi2b/temp1**2)
          END IF
          temp0 = (eps1+beta1)**pw
          IF (eps1 + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta1b = 0.0
          ELSE
            beta1b = -(gi1*pw*(eps1+beta1)**(pw-1)*wi1b/temp0**2)
          END IF
          temp = (eps1+beta0)**pw
          IF (eps1 + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta0b = 0.0
          ELSE
            beta0b = -(gi0*pw*(eps1+beta0)**(pw-1)*wi0b/temp**2)
          END IF
          CALL POPREAL8(beta2)
          tempb3 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
          tempb4 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
          qip2b = tempb4 - f2b/6. + tempb3
          CALL POPREAL8(beta1)
          tempb5 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
          tempb8 = 2*(qim1-qip1)*beta1b/4.
          qip1b = tempb5 - tempb8 + f1b/3. + 5.*f2b/6. - 4.*tempb4 - 2.*&
&           tempb3
          CALL POPREAL8(beta0)
          tempb7 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
          tempb6 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
          qib = f2b/3. - 2.*tempb5 + 11.*f0b/6. + 5.*f1b/6. + 3.*tempb6 &
&           + tempb7 + 3.*tempb4 + tempb3
          qim1b = tempb8 - 4.*tempb6 - 7.*f0b/6. - f1b/6. - 2.*tempb7 + &
&           tempb5
          qim2b = f0b/3. + tempb6 + tempb7
          CALL POPREAL8(f2)
          CALL POPREAL8(f1)
          CALL POPREAL8(f0)
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(qim2)
            fieldb(i, k, j-3) = fieldb(i, k, j-3) + qim2b
            CALL POPREAL8(qim1)
            fieldb(i, k, j-2) = fieldb(i, k, j-2) + qim1b
            CALL POPREAL8(qi)
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + qib
            CALL POPREAL8(qip1)
            fieldb(i, k, j) = fieldb(i, k, j) + qip1b
            CALL POPREAL8(qip2)
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + qip2b
          ELSE
            CALL POPREAL8(qim2)
            fieldb(i, k, j+2) = fieldb(i, k, j+2) + qim2b
            CALL POPREAL8(qim1)
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + qim1b
            CALL POPREAL8(qi)
            fieldb(i, k, j) = fieldb(i, k, j) + qib
            CALL POPREAL8(qip1)
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + qip1b
            CALL POPREAL8(qip2)
            fieldb(i, k, j-2) = fieldb(i, k, j-2) + qip2b
          END IF
          tempb0 = dy*mu*fqylb(i, k, j)/dt
          min3b = 0.5*field_old(i, k, j-1)*tempb0
          field_oldb(i, k, j-1) = field_oldb(i, k, j-1) + 0.5*min3*&
&           tempb0
          max2b = 0.5*field_old(i, k, j)*tempb0
          field_oldb(i, k, j) = field_oldb(i, k, j) + 0.5*max2*tempb0
          mub0 = (0.5*(min3*field_old(i, k, j-1))+0.5*(max2*field_old(i&
&           , k, j)))*dy*fqylb(i, k, j)/dt
          fqylb(i, k, j) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(max2)
            y17b = max2b
          ELSE
            CALL POPREAL8(max2)
            y17b = 0.0
          END IF
          crb = y17b
          abs15b = -y17b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs15b
          ELSE
            crb = crb - abs15b
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(min3)
            y1b = min3b
          ELSE
            CALL POPREAL8(min3)
            y1b = 0.0
          END IF
          crb = crb + y1b
          abs0b = y1b
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            crb = crb + abs0b
          ELSE
            crb = crb - abs0b
          END IF
          tempb = dt*crb/(dy*mu)
          velb = velb + tempb
          mub0 = mub0 - vel*tempb/mu
          CALL POPREAL8(vel)
          rvb(i, k, j) = rvb(i, k, j) + velb
          CALL POPREAL8(mu)
          mutb(i, j) = mutb(i, j) + 0.5*mub0
          mutb(i, j-1) = mutb(i, j-1) + 0.5*mub0
          CALL POPREAL8(dy)
        END DO
      END DO
    END IF
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
END SUBROUTINE A_ADVECT_SCALAR_WENOPD

   SUBROUTINE a_advect_scalar_mono(field,a_field,field_old,a_field_old,tendency, &
   a_tendency,h_tendency,a_h_tendency,z_tendency,a_z_tendency,ru,a_ru,rv,a_rv,rom,a_rom,mut,a_mut,mub,mu_old,a_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)

!PART I: DECLARATION OF VARIABLES

   IMPLICIT NONE

   INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
   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,a_field,field_old,a_field_old, &
   ru,a_ru,rv,a_rv,rom,a_rom
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut,mub,mu_old,a_mu_old
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: h_tendency, z_tendency
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: a_h_tendency, a_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 :: ub,a_ub,vb,a_vb
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: fqx,a_fqx,fqy,a_fqy,fqz,a_fqz
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: fqxl,a_fqxl,fqyl,a_fqyl,fqzl,a_fqzl
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: qmin,a_qmin,qmax,a_qmax
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: scale_in,a_scale_in,scale_out,a_scale_out
   REAL :: ph_upwind,a_ph_upwind
   INTEGER :: horz_order,vert_order
   LOGICAL :: degrade_xs,degrade_ys
   LOGICAL :: degrade_xe,degrade_ye
   INTEGER :: jp1,jp0,jtmp
   REAL :: flux_out,a_flux_out,ph_low,a_ph_low,flux_in,a_flux_in,ph_hi,a_ph_hi,scale,a_scale
   REAL,PARAMETER :: eps =1.e-20
   REAL :: flux3,Diff_flux3,flux4,Diff_flux4,flux5,Diff_flux5,flux6,Diff_flux6,flux_upwind, &
   Diff_flux_upwind
   REAL :: q_im3,Diff_q_im3,q_im2,Diff_q_im2,q_im1,Diff_q_im1,q_i,Diff_q_i,q_ip1,Diff_q_ip1, &
   q_ip2,Diff_q_ip2,ua,Diff_ua,vel,a_vel,cr,Diff_cr,a_cr

   Diff_flux4(q_im2, Diff_q_im2,q_im1, Diff_q_im1,q_i, Diff_q_i,q_ip1, Diff_q_ip1, &
   ua, Diff_ua) =(7./12.)*(Diff_q_i +Diff_q_im1) -(1./12.)*(Diff_q_ip1 +Diff_q_im2)
   flux4(q_im2,q_im1,q_i,q_ip1,ua) =(7./12.)*(q_i +q_im1) -(1./12.)*(q_ip1 +q_im2)

   Diff_flux3(q_im2, Diff_q_im2,q_im1, Diff_q_im1,q_i, Diff_q_i,q_ip1, Diff_q_ip1, &
   ua, Diff_ua) =Diff_flux4(q_im2,Diff_q_im2,q_im1,Diff_q_im1,q_i,Diff_q_i,q_ip1, &
   Diff_q_ip1,ua,Diff_ua) +sign(1., ua) *(1./12.)*((Diff_q_ip1 -Diff_q_im2) &
   -3.*(Diff_q_i -Diff_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))

   Diff_flux6(q_im3, Diff_q_im3,q_im2, Diff_q_im2,q_im1, Diff_q_im1,q_i, Diff_q_i, &
   q_ip1, Diff_q_ip1,q_ip2, Diff_q_ip2,ua, Diff_ua) =(37./60.)*(Diff_q_i +Diff_q_im1) &
   -(2./15.)*(Diff_q_ip1 +Diff_q_im2) +(1./60.)*(Diff_q_ip2 +Diff_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)

   Diff_flux5(q_im3, Diff_q_im3,q_im2, Diff_q_im2,q_im1, Diff_q_im1,q_i, Diff_q_i, &
   q_ip1, Diff_q_ip1,q_ip2, Diff_q_ip2,ua, Diff_ua) =Diff_flux6(q_im3,Diff_q_im3,q_im2, &
   Diff_q_im2,q_im1,Diff_q_im1,q_i,Diff_q_i,q_ip1,Diff_q_ip1,q_ip2,Diff_q_ip2,ua, &
   Diff_ua) -sign(1., ua) *(1./60.)*((Diff_q_ip2 -Diff_q_im3) -5.*(Diff_q_ip1 - &
   Diff_q_im2) +10.*(Diff_q_i -Diff_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))

   Diff_flux_upwind(q_im1, Diff_q_im1,q_i, Diff_q_i,cr, Diff_cr) =0.5 *(1.+sign(1., cr)) &
  *Diff_q_im1 +0.5 *(1.-sign(1., cr))*Diff_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.

   REAL :: Keep_Lpb3_cr
   REAL :: Keep_Lpb7_ub
   REAL :: Keep_Lpb11_vb
   REAL :: Keep_Lpb21_vel
   REAL :: Keep_Lpb21_cr   
   INTEGER :: IX1,IX2,IX3

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
   Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,gwalls

   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Tmpv2400,Tmpv2401,Tmpv2402,Tmpv2403,Tmpv2404,Tmpv2405
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Tmpv600,Tmpv601,Tmpv602,Tmpv603
   REAL,DIMENSION(its-2:ite+2,kts:kte) :: Tmpv604,Tmpv605,Tmpv606,Tmpv607,Tmpv608, &
       Tmpv609,Tmpv6010,Tmpv6011,Tmpv6012,Tmpv6013,Tmpv6014,Tmpv6015,Tmpv6016, &
       Tmpv6017,Tmpv6018,Tmpv6019
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Tmpv700,Tmpv701,Tmpv702,Tmpv703
   REAL,DIMENSION(kts:kte,jts-2:jte+2) :: Tmpv704,Tmpv705,Tmpv706,Tmpv707,Tmpv708, &
       Tmpv709,Tmpv710,Tmpv711,Tmpv712,Tmpv713,Tmpv714,Tmpv715,Tmpv716, &
       Tmpv717,Tmpv718,Tmpv719
   REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Tmpv800,Tmpv801,Tmpv802,Tmpv803
   REAL,DIMENSION(its-2:ite+2,jts-2:jte+2) :: Tmpv804,Tmpv805,Tmpv806,Tmpv807,Tmpv808, &
       Tmpv809,Tmpv810,Tmpv811

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
     ktf=MIN(kte,kde-1)
     horz_order = config_flags%h_sca_adv_order
     vert_order = config_flags%v_sca_adv_order

     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.

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   a_ub =0.0
   a_vb =0.0

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqx(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqy(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqz(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqxl(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqyl(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_fqzl(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_qmin(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_qmax(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_scale_in(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jts-2, jte+2
   Do K1_ADJ =kts, kte
   Do K0_ADJ =its-2, ite+2
   a_scale_out(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   a_ph_upwind =0.0
   a_flux_out =0.0
   a_ph_low =0.0
   a_flux_in =0.0
   a_ph_hi =0.0
   a_scale =0.0
   a_vel =0.0
   a_cr =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[35]
   i_start = its
   i_end   = MIN(ite,ide-1)
   j_start = jts
   j_end   = MIN(jte,jde-1)

   IF(degrade_ys) j_start = MAX(jts,jds+1)
   IF(degrade_ye) j_end   = MIN(jte,jde-2)

   IF(tenddec) THEN
   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv1 =-rdy*msftx(i,j)*a_h_tendency(i,k,j)
   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_Tmpv1
   a_fqyl(i,k,j+1) =a_fqyl(i,k,j+1) +a_Tmpv1
   a_fqy(i,k,j+1) =a_fqy(i,k,j+1) +a_Tmpv1
   a_fqy(i,k,j) =a_fqy(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO
   ENDDO
   ENDIF

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv1 =-rdy*msftx(i,j)*a_tendency(i,k,j)
   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_Tmpv1
   a_fqyl(i,k,j+1) =a_fqyl(i,k,j+1) +a_Tmpv1
   a_fqy(i,k,j+1) =a_fqy(i,k,j+1) +a_Tmpv1
   a_fqy(i,k,j) =a_fqy(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

!LPB[30]
   i_start = its
   i_end   = MIN(ite,ide-1)
   j_start = jts
   j_end   = MIN(jte,jde-1)
   IF(degrade_xs) i_start = MAX(its,ids+1)
   IF(degrade_xe) i_end   = MIN(ite,ide-2)

   IF(tenddec) THEN
   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv1 =-rdx*msftx(i,j)*a_h_tendency(i,k,j)
   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_Tmpv1
   a_fqxl(i+1,k,j) =a_fqxl(i+1,k,j) +a_Tmpv1
   a_fqx(i+1,k,j) =a_fqx(i+1,k,j) +a_Tmpv1
   a_fqx(i,k,j) =a_fqx(i,k,j) -a_Tmpv1
   a_h_tendency(i,k,j) = 0.0
   ENDDO
   ENDDO
   ENDDO
   ENDIF

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv1 =-rdx*msftx(i,j)*a_tendency(i,k,j)
   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_Tmpv1
   a_fqxl(i+1,k,j) =a_fqxl(i+1,k,j) +a_Tmpv1
   a_fqx(i+1,k,j) =a_fqx(i+1,k,j) +a_Tmpv1
   a_fqx(i,k,j) =a_fqx(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

!LPB[25]
   i_start = its
   i_end   = MIN(ite,ide-1)
   j_start = jts
   j_end   = MIN(jte,jde-1)

   IF(tenddec) THEN
   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   gwalls=-rdzw(k)
   DO i =i_end, i_start, -1
   a_Tmpv1 =gwalls*a_z_tendency(i,k,j)
   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_Tmpv1
   a_fqzl(i,k+1,j) =a_fqzl(i,k+1,j) +a_Tmpv1
   a_fqz(i,k+1,j) =a_fqz(i,k+1,j) +a_Tmpv1
   a_fqz(i,k,j) =a_fqz(i,k,j) -a_Tmpv1
   a_z_tendency(i,k,j) = 0.0
   ENDDO
   ENDDO
   ENDDO
   ENDIF

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   gwalls=-rdzw(k)
   DO i =i_end, i_start, -1
   a_Tmpv1 =gwalls*a_tendency(i,k,j)
   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_Tmpv1
   a_fqzl(i,k+1,j) =a_fqzl(i,k+1,j) +a_Tmpv1
   a_fqz(i,k+1,j) =a_fqz(i,k+1,j) +a_Tmpv1
   a_fqz(i,k,j) =a_fqz(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

!LPB[1]
   qmin(its-2:ite+2,kts:kte,jts-2:jte+2) =field_old(its-2:ite+2,kts:kte,jts-2:jte+2)
   qmax(its-2:ite+2,kts:kte,jts-2:jte+2) =field_old(its-2:ite+2,kts:kte,jts-2:jte+2)
   scale_in(its-2:ite+2,kts:kte,jts-2:jte+2) =1.
   scale_out(its-2:ite+2,kts:kte,jts-2:jte+2) =1.
   fqx(its-2:ite+2,kts:kte,jts-2:jte+2) =0.
   fqy(its-2:ite+2,kts:kte,jts-2:jte+2) =0.
   fqz(its-2:ite+2,kts:kte,jts-2:jte+2) =0.
   fqxl(its-2:ite+2,kts:kte,jts-2:jte+2) =0.
   fqyl(its-2:ite+2,kts:kte,jts-2:jte+2) =0.
   fqzl(its-2:ite+2,kts:kte,jts-2:jte+2) =0.

!LPB[3]
   IF( horz_order == 5 ) THEN
   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
   vel =rv(i,k,j)
   cr =vel

   fqyl(i,k,j) =vel*flux_upwind(field_old(i,k,j-1),field_old(i,k,j),vel)
   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)

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

   IF(cr.gt. 0) THEN
   Tmpv600(i,k,j) = qmax(i,k,j)
   qmax(i,k,j) =amax1(qmax(i,k,j), field_old(i,k,j-1))

   Tmpv601(i,k,j) = qmin(i,k,j)
   qmin(i,k,j) =amin1(qmin(i,k,j), field_old(i,k,j-1))

   else

   Tmpv602(i,k,j-1) = qmax(i,k,j-1)
   qmax(i,k,j-1) =amax1(qmax(i,k,j-1), field_old(i,k,j))

   Tmpv603(i,k,j-1) = qmin(i,k,j-1)
   qmin(i,k,j-1) =amin1(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
   vel =rv(i,k,j)
   cr =vel

   fqyl(i,k,j) =vel*flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)
   fqy(i,k,j) =0.5*rv(i,k,j)*(field(i,k,j) +field(i,k,j-1))
   fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv604(i,k) = qmax(i,k,j)
   qmax(i,k,j) =amax1(qmax(i,k,j), field_old(i,k,j-1))

   Tmpv605(i,k) = qmin(i,k,j)
   qmin(i,k,j) =amin1(qmin(i,k,j), field_old(i,k,j-1))

   else

   Tmpv606(i,k) = qmax(i,k,j-1)
   qmax(i,k,j-1) =amax1(qmax(i,k,j-1), field_old(i,k,j))

   Tmpv607(i,k) = qmin(i,k,j-1)
   qmin(i,k,j-1) =amin1(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
   vel =rv(i,k,j)
   cr =vel

   fqyl(i,k,j) =vel*flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)
   fqy(i,k,j) =vel*flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)
   fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv608(i,k) = qmax(i,k,j)
   qmax(i,k,j) =max(qmax(i,k,j), field_old(i,k,j-1))

   Tmpv609(i,k) = qmin(i,k,j)
   qmin(i,k,j) =min(qmin(i,k,j), field_old(i,k,j-1))

   else

   Tmpv6010(i,k) = qmax(i,k,j-1)
   qmax(i,k,j-1) =max(qmax(i,k,j-1), field_old(i,k,j))

   Tmpv6011(i,k) = qmin(i,k,j-1)
   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
   vel =rv(i,k,j)
   cr =vel

   fqyl(i,k,j) =vel*flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)
   fqy(i,k,j) =0.5*rv(i,k,j)*(field(i,k,j) +field(i,k,j-1))
   fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv6012(i,k) = qmax(i,k,j)
   qmax(i,k,j) =max(qmax(i,k,j), field_old(i,k,j-1))

   Tmpv6013(i,k) = qmin(i,k,j)
   qmin(i,k,j) =min(qmin(i,k,j), field_old(i,k,j-1))

   else

   Tmpv6014(i,k) = qmax(i,k,j-1)
   qmax(i,k,j-1) =max(qmax(i,k,j-1), field_old(i,k,j))

   Tmpv6015(i,k) = qmin(i,k,j-1)
   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
   vel =rv(i,k,j)
   cr =vel

   fqyl(i,k,j) =vel*flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)
   fqy(i,k,j) =vel*flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)
   fqy(i,k,j) =fqy(i,k,j) -fqyl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv6016(i,k) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i,k,j-1))
   qmax(i,k,j) =Tmpv001

   Tmpv6017(i,k) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i,k,j-1))
   qmin(i,k,j) =Tmpv001

   else

   Tmpv6018(i,k) = qmax(i,k,j-1)
   qmax(i,k,j-1) =max(qmax(i,k,j-1), field_old(i,k,j))

   Tmpv6019(i,k) = qmin(i,k,j-1)
   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
   vel =ru(i,k,j)
   cr =vel

   fqxl(i,k,j) =vel*flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)

   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)

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

   IF(cr.gt. 0) THEN
   Tmpv700(i,k,j) = qmax(i,k,j)
   qmax(i,k,j) =max(qmax(i,k,j), field_old(i-1,k,j))

   Tmpv701(i,k,j) = qmin(i,k,j)
   qmin(i,k,j) =min(qmin(i,k,j), field_old(i-1,k,j))

   else
   Tmpv702(i-1,k,j) = qmax(i-1,k,j)
   qmax(i-1,k,j) =max(qmax(i-1,k,j), field_old(i,k,j))

   Tmpv703(i-1,k,j) = qmin(i-1,k,j)
   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
   vel =ru(i,k,j)
   cr =vel

   fqxl(i,k,j) =vel*flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)
   fqx(i,k,j) =0.5*(ru(i,k,j))*(field(i,k,j) +field(i-1,k,j))

   Tmpv001 =fqx(i,k,j) -fqxl(i,k,j)
   fqx(i,k,j) =Tmpv001

   IF(cr.gt. 0) THEN
   Tmpv704(k,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i-1,k,j))
   qmax(i,k,j) =Tmpv001

   Tmpv705(k,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i-1,k,j))
   qmin(i,k,j) =Tmpv001

   else
   Tmpv706(k,j) = qmax(i-1,k,j)
   Tmpv001 =max(qmax(i-1,k,j), field_old(i,k,j))
   qmax(i-1,k,j) =Tmpv001

   Tmpv707(k,j) = qmin(i-1,k,j)
   Tmpv001 =min(qmin(i-1,k,j), field_old(i,k,j))
   qmin(i-1,k,j) =Tmpv001

   end IF
   ENDDO
   ENDIF
   IF(i == ids+2) THEN

   DO k =kts, ktf
   vel =ru(i,k,j)
   cr =vel

   fqxl(i,k,j) =vel*flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)
   fqx(i,k,j) =vel*flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)
   fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv708(k,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i-1,k,j))
   qmax(i,k,j) =Tmpv001

   Tmpv709(k,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i-1,k,j))
   qmin(i,k,j) =Tmpv001

   else
   Tmpv710(k,j) = qmax(i-1,k,j)
   Tmpv001 =max(qmax(i-1,k,j), field_old(i,k,j))
   qmax(i-1,k,j) =Tmpv001

   Tmpv711(k,j) = qmin(i-1,k,j)
   Tmpv001 =min(qmin(i-1,k,j), field_old(i,k,j))
   qmin(i-1,k,j) =Tmpv001

   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
   vel =ru(i,k,j)
   cr =vel

   fqxl(i,k,j) =vel*flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)
   fqx(i,k,j) =0.5*(ru(i,k,j))*(field(i,k,j) +field(i-1,k,j))
   fqx(i,k,j) =fqx(i,k,j) -fqxl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv712(k,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i-1,k,j))
   qmax(i,k,j) =Tmpv001

   Tmpv713(k,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i-1,k,j))
   qmin(i,k,j) =Tmpv001

   else
   Tmpv714(k,j) = qmax(i-1,k,j)
   Tmpv001 =max(qmax(i-1,k,j), field_old(i,k,j))
   qmax(i-1,k,j) =Tmpv001

   Tmpv715(k,j) = qmin(i-1,k,j)
   Tmpv001 =min(qmin(i-1,k,j), field_old(i,k,j))
   qmin(i-1,k,j) =Tmpv001

   end IF
   ENDDO
   ENDIF
   IF( i == ide-2 ) THEN

   DO k =kts, ktf
   vel =ru(i,k,j)
   cr =vel

   Tmpv001 =flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)
   Tmpv002 =vel*Tmpv001
   fqxl(i,k,j) =Tmpv002

   Tmpv001 =flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)
   Tmpv002 =vel*Tmpv001
   fqx(i,k,j) =Tmpv002

   Tmpv001 =fqx(i,k,j) -fqxl(i,k,j)
   fqx(i,k,j) =Tmpv001

   IF(cr.gt. 0) THEN
   Tmpv716(k,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i-1,k,j))
   qmax(i,k,j) =Tmpv001

   Tmpv717(k,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i-1,k,j))
   qmin(i,k,j) =Tmpv001

   else
   Tmpv718(k,j) = qmax(i-1,k,j)
   Tmpv001 =max(qmax(i-1,k,j), field_old(i,k,j))
   qmax(i-1,k,j) =Tmpv001

   Tmpv719(k,j) = qmin(i-1,k,j)
   Tmpv001 =min(qmin(i-1,k,j), field_old(i,k,j))
   qmin(i-1,k,j) =Tmpv001

   end IF
   ENDDO
   ENDIF
   ENDDO
   ENDIF
   ENDDO

   ELSE

   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)

!LPB[22]

   IF(vert_order == 3) THEN
   DO j =j_start, j_end
   DO i =i_start, i_end
   fqz(i,1,j) =0.
   fqzl(i,1,j) =0.
   fqz(i,kde,j) =0.
   fqzl(i,kde,j) =0.
   ENDDO

   DO k =kts+2, ktf-1
   DO i =i_start, i_end
   vel =rom(i,k,j)
   cr =-vel

   fqzl(i,k,j) =vel*flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)
   fqz(i,k,j) =vel*flux3(field(i,k-2,j),field(i,k-1,j),field(i,k,j),field(i,k+1,j),-vel)
   fqz(i,k,j) =fqz(i,k,j) -fqzl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv800(i,k,j) = qmax(i,k,j)
   qmax(i,k,j) =max(qmax(i,k,j), field_old(i,k-1,j))

   Tmpv801(i,k,j) = qmin(i,k,j)
   qmin(i,k,j) =min(qmin(i,k,j), field_old(i,k-1,j))

   else

   Tmpv802(i,k-1,j) = qmax(i,k-1,j)
   qmax(i,k-1,j) =max(qmax(i,k-1,j), field_old(i,k,j))

   Tmpv803(i,k-1,j) = qmin(i,k-1,j)
   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
   vel =rom(i,k,j)
   cr =-vel

   fqzl(i,k,j) =vel*flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)
   fqz(i,k,j) =rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j))

   Tmpv001 =fqz(i,k,j) -fqzl(i,k,j)
   fqz(i,k,j) =Tmpv001

   IF(cr.gt. 0) THEN
   Tmpv804(i,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i,k-1,j))
   qmax(i,k,j) =Tmpv001

   Tmpv805(i,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i,k-1,j))
   qmin(i,k,j) =Tmpv001

   else
   Tmpv806(i,j) = qmax(i,k-1,j)
   Tmpv001 =max(qmax(i,k-1,j), field_old(i,k,j))
   qmax(i,k-1,j) =Tmpv001

   Tmpv807(i,j) = qmin(i,k-1,j)
   Tmpv001 =min(qmin(i,k-1,j), field_old(i,k,j))
   qmin(i,k-1,j) =Tmpv001

   end IF
   k =ktf
   vel =rom(i,k,j)
   cr =-vel

   fqzl(i,k,j) =vel*flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)
   fqz(i,k,j) =rom(i,k,j)*(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j))
   fqz(i,k,j) =fqz(i,k,j) -fqzl(i,k,j)

   IF(cr.gt. 0) THEN
   Tmpv808(i,j) = qmax(i,k,j)
   Tmpv001 =max(qmax(i,k,j), field_old(i,k-1,j))
   qmax(i,k,j) =Tmpv001

   Tmpv809(i,j) = qmin(i,k,j)
   Tmpv001 =min(qmin(i,k,j), field_old(i,k-1,j))
   qmin(i,k,j) =Tmpv001

   else

   Tmpv810(i,j) = qmax(i,k-1,j)
   qmax(i,k-1,j) =max(qmax(i,k-1,j), field_old(i,k,j))

   Tmpv811(i,j) = qmin(i,k-1,j)
   qmin(i,k-1,j) =min(qmin(i,k-1,j), field_old(i,k,j))

   end IF
   ENDDO
   ENDDO

   ELSE

   ENDIF

!LPB[23]
   IF(mono_limit) THEN
   i_start =its-1
   Tmpv001 =min(ite, ide-1) +1
   i_end =Tmpv001
   j_start =jts-1
   Tmpv001 =min(jte, jde-1) +1
   j_end =Tmpv001
   IF(degrade_xs) THEN
   i_start =max(its-1, ids)
   END IF
   IF(degrade_xe) THEN
   i_end =min(ite+1, ide-1)
   END IF
   IF(degrade_ys) THEN
   j_start =max(jts-1, jds)
   END IF
   IF(degrade_ye) THEN
   j_end =min(jte+1, jde-1)
   END IF
   IF(config_flags%specified .or. config_flags%nested) THEN
   IF(degrade_xs) THEN
   i_start =max(its-1, ids+1)
   END IF
   IF(degrade_xe) THEN
   i_end =min(ite+1, ide-2)
   END IF
   IF(degrade_ys) THEN
   j_start =max(jts-1, jds+1)
   END IF
   IF(degrade_ye) THEN
   j_end =min(jte+1, jde-2)
   END IF
   END IF
   IF(config_flags%open_xs) THEN
   IF(degrade_xs) THEN
   i_start =max(its-1, ids+1)
   END IF
   END IF
   IF(config_flags%open_xe) THEN
   IF(degrade_xe) THEN
   i_end =min(ite+1, ide-2)
   END IF
   END IF
   IF(config_flags%open_ys) THEN
   IF(degrade_ys) THEN
   j_start =max(jts-1, jds+1)
   END IF
   END IF
   IF(config_flags%open_ye) THEN
   IF(degrade_ye) THEN
   j_end =min(jte+1, jde-2)
   END IF
   END IF

   DO j =j_start, j_end
   DO k =kts, ktf
   DO i =i_start, i_end
   Tmpv001 =(mub(i,j) +mu_old(i,j))*field_old(i,k,j)
   Tmpv002 =fqxl(i+1,k,j) -fqxl(i,k,j)
   Tmpv003 =rdx*Tmpv002
   Tmpv004 =fqyl(i,k,j+1) -fqyl(i,k,j)
   Tmpv005 =rdy*Tmpv004
   Tmpv006 =Tmpv003 +Tmpv005
   Tmpv007 =msftx(i,j)*msfty(i,j)*Tmpv006
   Tmpv008 =fqzl(i,k+1,j) -fqzl(i,k,j)
   Tmpv009 =msfty(i,j)*rdzw(k)*Tmpv008
   ph_upwind =Tmpv001 -dt*(Tmpv007 +Tmpv009)

   Tmpv001 =min(0., fqx(i+1,k,j)) -max(0., fqx(i,k,j))
   Tmpv002 =rdx*Tmpv001
   Tmpv003 =min(0., fqy(i,k,j+1)) -max(0., fqy(i,k,j))
   Tmpv004 =rdy*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =(msftx(i,j)*msfty(i,j))*Tmpv005
   Tmpv007 =max(0., fqz(i,k+1,j)) -min(0., fqz(i,k,j))
   Tmpv008 =msfty(i,j)*rdzw(k)*Tmpv007
   Tmpv009 =Tmpv006 +Tmpv008
   Tmpv010 =-dt*Tmpv009
   flux_in =Tmpv010
   Tmpv2400(i,k,j) =flux_in

   Tmpv001 =mut(i,j)*qmax(i,k,j)
   Tmpv002 =Tmpv001 -ph_upwind
   ph_hi =Tmpv002
   Tmpv2401(i,k,j) =ph_hi

   IF( flux_in .gt. ph_hi ) THEN
   Tmpv001 =ph_hi/(flux_in +eps)
   Tmpv2402(i,k,j) =Tmpv001
   scale_in(i,k,j) =max(0., Tmpv2402(i,k,j))
   END IF

   Tmpv001 =max(0., fqx(i+1,k,j)) -min(0., fqx(i,k,j))
   Tmpv002 =rdx*Tmpv001
   Tmpv003 =max(0., fqy(i,k,j+1)) -min(0., fqy(i,k,j))
   Tmpv004 =rdy*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =(msftx(i,j)*msfty(i,j))*Tmpv005
   Tmpv007 =min(0., fqz(i,k+1,j)) -max(0., fqz(i,k,j))
   Tmpv008 =msfty(i,j)*rdzw(k)*Tmpv007
   Tmpv009 =Tmpv006 +Tmpv008
   Tmpv010 =dt*Tmpv009
   flux_out =Tmpv010
   Tmpv2403(i,k,j) =flux_out

   Tmpv001 =mut(i,j)*qmin(i,k,j)
   Tmpv002 =ph_upwind -Tmpv001
   ph_low =Tmpv002
   Tmpv2404(i,k,j) =ph_low

   IF( flux_out .gt. ph_low ) THEN
   Tmpv001 =ph_low/(flux_out +eps)
   Tmpv2405(i,k,j) =Tmpv001
   scale_out(i,k,j) =max(0., Tmpv2405(i,k,j))
   END IF

   ENDDO
   ENDDO
   ENDDO

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

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

   a_Tmpv2 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_Tmpv1 =fqz(i,k,j)*a_Tmpv2
   a_fqz(i,k,j) =a_fqz(i,k,j) +min(scale_in(i,k,j), scale_out(i,k-1,j))*a_Tmpv2
   a_scale_in(i,k,j) =a_scale_in(i,k,j)  +(1.0 -sign(1.0, scale_in(i,k,j)  &
   -scale_out(i,k-1,j)))*0.5*1.0*a_Tmpv1
   a_scale_out(i,k-1,j) =a_scale_out(i,k-1,j)  +(1.0 +sign(1.0, scale_in(i,k,j)  &
   -scale_out(i,k-1,j)))*0.5*1.0*a_Tmpv1

   ELSE

   a_Tmpv2 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_Tmpv1 =fqz(i,k,j)*a_Tmpv2
   a_fqz(i,k,j) =a_fqz(i,k,j) +min(scale_out(i,k,j), scale_in(i,k-1,j))*a_Tmpv2
   a_scale_out(i,k,j) =a_scale_out(i,k,j)  +(1.0 -sign(1.0, scale_out(i,k,j)  &
   -scale_in(i,k-1,j)))*0.5*1.0*a_Tmpv1
   a_scale_in(i,k-1,j) =a_scale_in(i,k-1,j)  +(1.0 +sign(1.0, scale_out(i,k,j)  &
   -scale_in(i,k-1,j)))*0.5*1.0*a_Tmpv1

   ENDIF
   ENDDO
   ENDDO
   ENDDO

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

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

   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_Tmpv1 =fqy(i,k,j)*a_Tmpv2
   a_fqy(i,k,j) =a_fqy(i,k,j) +min(scale_in(i,k,j), scale_out(i,k,j-1))*a_Tmpv2
   a_scale_in(i,k,j) =a_scale_in(i,k,j)  +(1.0 -sign(1.0, scale_in(i,k,j)  &
   -scale_out(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_scale_out(i,k,j-1) =a_scale_out(i,k,j-1)  +(1.0 +sign(1.0, scale_in(i,k,j)  &
   -scale_out(i,k,j-1)))*0.5*1.0*a_Tmpv1

   ELSE

   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_Tmpv1 =fqy(i,k,j)*a_Tmpv2
   a_fqy(i,k,j) =a_fqy(i,k,j) +min(scale_out(i,k,j), scale_in(i,k,j-1))*a_Tmpv2
   a_scale_out(i,k,j) =a_scale_out(i,k,j)  +(1.0 -sign(1.0, scale_out(i,k,j)  &
   -scale_in(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_scale_in(i,k,j-1) =a_scale_in(i,k,j-1)  +(1.0 +sign(1.0, scale_out(i,k,j)  &
   -scale_in(i,k,j-1)))*0.5*1.0*a_Tmpv1

   ENDIF
   ENDDO
   ENDDO
   ENDDO

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

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

   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_Tmpv1 =fqx(i,k,j)*a_Tmpv2
   a_fqx(i,k,j) =a_fqx(i,k,j) +min(scale_in(i,k,j), scale_out(i-1,k,j))*a_Tmpv2
   a_scale_in(i,k,j) =a_scale_in(i,k,j)  +(1.0 -sign(1.0, scale_in(i,k,j)  &
   -scale_out(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_scale_out(i-1,k,j) =a_scale_out(i-1,k,j)  +(1.0 +sign(1.0, scale_in(i,k,j)  &
   -scale_out(i-1,k,j)))*0.5*1.0*a_Tmpv1

   ELSE

   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_Tmpv1 =fqx(i,k,j)*a_Tmpv2
   a_fqx(i,k,j) =a_fqx(i,k,j) +min(scale_out(i,k,j), scale_in(i-1,k,j))*a_Tmpv2
   a_scale_out(i,k,j) =a_scale_out(i,k,j)  +(1.0 -sign(1.0, scale_out(i,k,j)  &
   -scale_in(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_scale_in(i-1,k,j) =a_scale_in(i-1,k,j)  +(1.0 +sign(1.0, scale_out(i,k,j)  &
   -scale_in(i-1,k,j)))*0.5*1.0*a_Tmpv1

   ENDIF

   ENDDO
   ENDDO
   ENDDO

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   flux_out = Tmpv2403(i,k,j)
   ph_low = Tmpv2404(i,k,j)

   IF( flux_out .gt. ph_low ) THEN
   a_Tmpv1 = (1.0 +(-1.0)*sign(1.0, 0. -Tmpv2405(i,k,j)))*0.5*a_scale_out(i,k,j)
   a_scale_out(i,k,j) =0.0
   a_ph_low =a_ph_low +a_Tmpv1/(flux_out +eps)
   a_flux_out =a_flux_out -ph_low/((flux_out +eps)*(flux_out +eps))*a_Tmpv1
   END IF

   a_Tmpv2 =a_ph_low
   a_ph_low =0.0
   a_ph_upwind =a_ph_upwind +a_Tmpv2
   a_Tmpv1 =-a_Tmpv2
   a_mut(i,j) =a_mut(i,j) +qmin(i,k,j)*a_Tmpv1
   a_qmin(i,k,j) =a_qmin(i,k,j) +mut(i,j)*a_Tmpv1

   a_Tmpv10 =a_flux_out
   a_flux_out =0.0
   a_Tmpv9 =dt*a_Tmpv10
   a_Tmpv6 =a_Tmpv9
   a_Tmpv8 =a_Tmpv9
   a_Tmpv7 =msfty(i,j)*rdzw(k)*a_Tmpv8
   a_fqz(i,k+1,j) =a_fqz(i,k+1,j) +(1.0 -(-1.0)*sign(1.0, 0. -fqz(i,k+1,j)))*0.5*a_Tmpv7
   a_fqz(i,k,j) =a_fqz(i,k,j) -(1.0 +(-1.0)*sign(1.0, 0. -fqz(i,k,j)))*0.5*a_Tmpv7
   a_Tmpv5 =(msftx(i,j)*msfty(i,j))*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =rdy*a_Tmpv4
   a_fqy(i,k,j+1) =a_fqy(i,k,j+1) +(1.0 +(-1.0)*sign(1.0, 0. -fqy(i,k,j+1)))*0.5*a_Tmpv3
   a_fqy(i,k,j) =a_fqy(i,k,j) -(1.0 -(-1.0)*sign(1.0, 0. -fqy(i,k,j)))*0.5*a_Tmpv3
   a_Tmpv1 =rdx*a_Tmpv2
   a_fqx(i+1,k,j) =a_fqx(i+1,k,j) +(1.0 +(-1.0)*sign(1.0, 0. -fqx(i+1,k,j)))*0.5*a_Tmpv1
   a_fqx(i,k,j) =a_fqx(i,k,j) -(1.0 -(-1.0)*sign(1.0, 0. -fqx(i,k,j)))*0.5*a_Tmpv1

   flux_in =Tmpv2400(i,k,j)
   ph_hi =Tmpv2401(i,k,j)

   IF( flux_in .gt. ph_hi ) THEN

   a_Tmpv1 = (1.0 +(-1.0)*sign(1.0, 0. -Tmpv2402(i,k,j)))*0.5*a_scale_in(i,k,j)
   a_scale_in(i,k,j) =0.0
   a_ph_hi =a_ph_hi +a_Tmpv1/(flux_in +eps)
   a_flux_in =a_flux_in -ph_hi/((flux_in +eps)*(flux_in +eps))*a_Tmpv1
   END IF

   a_Tmpv2 =a_ph_hi
   a_ph_hi =0.0
   a_Tmpv1 =a_Tmpv2
   a_ph_upwind =a_ph_upwind -a_Tmpv2
   a_mut(i,j) =a_mut(i,j) +qmax(i,k,j)*a_Tmpv1
   a_qmax(i,k,j) =a_qmax(i,k,j) +mut(i,j)*a_Tmpv1

   a_Tmpv10 =a_flux_in
   a_flux_in =0.0
   a_Tmpv9 =-dt*a_Tmpv10
   a_Tmpv6 =a_Tmpv9
   a_Tmpv8 =a_Tmpv9
   a_Tmpv7 =msfty(i,j)*rdzw(k)*a_Tmpv8
   a_fqz(i,k+1,j) =a_fqz(i,k+1,j) +(1.0 +(-1.0)*sign(1.0, 0. -fqz(i,k+1,j)))*0.5*a_Tmpv7
   a_fqz(i,k,j) =a_fqz(i,k,j) -(1.0 -(-1.0)*sign(1.0, 0. -fqz(i,k,j)))*0.5*a_Tmpv7
   a_Tmpv5 =(msftx(i,j)*msfty(i,j))*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =rdy*a_Tmpv4
   a_fqy(i,k,j+1) =a_fqy(i,k,j+1) +(1.0 -(-1.0)*sign(1.0, 0. -fqy(i,k,j+1)))*0.5*a_Tmpv3
   a_fqy(i,k,j) =a_fqy(i,k,j) -(1.0 +(-1.0)*sign(1.0, 0. -fqy(i,k,j)))*0.5*a_Tmpv3
   a_Tmpv1 =rdx*a_Tmpv2
   a_fqx(i+1,k,j) =a_fqx(i+1,k,j) +(1.0 -(-1.0)*sign(1.0, 0. -fqx(i+1,k,j)))*0.5*a_Tmpv1
   a_fqx(i,k,j) =a_fqx(i,k,j) -(1.0 +(-1.0)*sign(1.0, 0. -fqx(i,k,j)))*0.5*a_Tmpv1
   a_Tmpv12 =a_ph_upwind
   a_ph_upwind =0.0
   a_Tmpv1 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_Tmpv10 =dt*a_Tmpv11
   a_Tmpv7 =a_Tmpv10
   a_Tmpv9 =a_Tmpv10
   a_Tmpv8 =msfty(i,j)*rdzw(k)*a_Tmpv9
   a_fqzl(i,k+1,j) =a_fqzl(i,k+1,j) +a_Tmpv8
   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_Tmpv8
   a_Tmpv6 =msftx(i,j)*msfty(i,j)*a_Tmpv7
   a_Tmpv3 =a_Tmpv6
   a_Tmpv5 =a_Tmpv6
   a_Tmpv4 =rdy*a_Tmpv5
   a_fqyl(i,k,j+1) =a_fqyl(i,k,j+1) +a_Tmpv4
   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_Tmpv4
   a_Tmpv2 =rdx*a_Tmpv3
   a_fqxl(i+1,k,j) =a_fqxl(i+1,k,j) +a_Tmpv2
   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_Tmpv2
   a_mu_old(i,j) =a_mu_old(i,j) +field_old(i,k,j)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +(mub(i,j) +mu_old(i,j))*a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

   END IF

!LPB[22]

   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_end, j_start, -1
   DO i =i_end, i_start, -1
   k =ktf

   vel = rom(i,k,j)
   cr = -vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv808(i,j)
   qmin(i,k,j) = Tmpv809(i,j)

   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1
   else
   qmax(i,k-1,j) = Tmpv810(i,j)
   qmin(i,k-1,j) = Tmpv811(i,j)

   a_Tmpv1 =a_qmin(i,k-1,j)
   a_qmin(i,k-1,j) =0.0
   a_qmin(i,k-1,j) =a_qmin(i,k-1,j)  +(1.0 -sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k-1,j)
   a_qmax(i,k-1,j) =0.0
   a_qmax(i,k-1,j) =a_qmax(i,k-1,j)  +(1.0 +sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_Tmpv1 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_fqz(i,k,j) =a_fqz(i,k,j) +a_Tmpv1
   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_Tmpv1
   a_Tmpv2 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_rom(i,k,j) =a_rom(i,k,j) +(fzm(k)*field(i,k,j) +fzp(k)*field(i,k-1,j))*a_Tmpv2
   a_Tmpv1 =rom(i,k,j)*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +fzm(k)*a_Tmpv1
   a_field(i,k-1,j) =a_field(i,k-1,j) +fzp(k)*a_Tmpv1
   a_Tmpv2 =a_fqzl(i,k,j)
   a_fqzl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k-1,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel -a_cr
   a_cr =0.0

   a_rom(i,k,j) =a_rom(i,k,j) +a_vel
   a_vel =0.0

   k =kts+1

   vel = rom(i,k,j)
   cr = -vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv804(i,j)
   qmin(i,k,j) = Tmpv805(i,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k-1,j) = Tmpv806(i,j)
   qmin(i,k-1,j) = Tmpv807(i,j)

   a_Tmpv1 =a_qmin(i,k-1,j)
   a_qmin(i,k-1,j) =0.0
   a_qmin(i,k-1,j) =a_qmin(i,k-1,j)  +(1.0 -sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k-1,j)
   a_qmax(i,k-1,j) =0.0
   a_qmax(i,k-1,j) =a_qmax(i,k-1,j)  +(1.0 +sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF
   a_Tmpv1 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_fqz(i,k,j) =a_fqz(i,k,j) +a_Tmpv1
   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_Tmpv1
   a_Tmpv2 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_rom(i,k,j) =a_rom(i,k,j) +(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))*a_Tmpv2
   a_Tmpv1 =rom(i,k,j)*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +fzm(k)*a_Tmpv1
   a_field(i,k-1,j) =a_field(i,k-1,j) +fzp(k)*a_Tmpv1
   a_Tmpv2 =a_fqzl(i,k,j)
   a_fqzl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k-1,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel -a_cr
   a_cr =0.0

   a_rom(i,k,j) =a_rom(i,k,j) +a_vel
   a_vel =0.0
   ENDDO

   DO k =ktf-1, kts+2, -1
   DO i =i_end, i_start, -1
   vel = rom(i,k,j)
   cr = -vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv800(i,k,j)
   qmin(i,k,j) = Tmpv801(i,k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k-1,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k-1,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k-1,j) = Tmpv802(i,k-1,j)
   qmin(i,k-1,j) = Tmpv803(i,k-1,j)

   a_Tmpv1 =a_qmin(i,k-1,j)
   a_qmin(i,k-1,j) =0.0
   a_qmin(i,k-1,j) =a_qmin(i,k-1,j)  +(1.0 -sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k-1,j)
   a_qmax(i,k-1,j) =0.0
   a_qmax(i,k-1,j) =a_qmax(i,k-1,j)  +(1.0 +sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k-1,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqzl(i,k,j) =a_fqzl(i,k,j) -a_fqz(i,k,j)
   a_Tmpv2 =a_fqz(i,k,j)
   a_fqz(i,k,j) =0.0
   a_vel =a_vel +flux3(field(i,k-2,j),field(i,k-1,j),field(i,k,j),field(i,k+1,j),-vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel -Diff_flux3(field(i,k-2,j),0.0,field(i,k-1,j),0.0,field(i,k,j)  &
   ,0.0,field(i,k+1,j),0.0,-vel,1.0)*a_Tmpv1
   a_field(i,k+1,j) =a_field(i,k+1,j) +Diff_flux3(field(i,k-2,j),0.0,field(i,k-1,  &
   j),0.0,field(i,k,j),0.0,field(i,k+1,j),1.0,-vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux3(field(i,k-2,j),0.0,field(i,k-1,j)  &
   ,0.0,field(i,k,j),1.0,field(i,k+1,j),0.0,-vel,0.0)*a_Tmpv1
   a_field(i,k-1,j) =a_field(i,k-1,j) +Diff_flux3(field(i,k-2,j),0.0,field(i,k-1,  &
   j),1.0,field(i,k,j),0.0,field(i,k+1,j),0.0,-vel,0.0)*a_Tmpv1
   a_field(i,k-2,j) =a_field(i,k-2,j) +Diff_flux3(field(i,k-2,j),1.0,field(i,k-1,  &
   j),0.0,field(i,k,j),0.0,field(i,k+1,j),0.0,-vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqzl(i,k,j)
   a_fqzl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k-1,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k-1,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k-1,j) =a_field_old(i,k-1,j) +Diff_flux_upwind(field_old(i,k-1,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel -a_cr
   a_cr =0.0

   a_rom(i,k,j) =a_rom(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO

   DO i =i_end, i_start, -1
   a_fqzl(i,kde,j) =0.0
   a_fqz(i,kde,j) =0.0
   a_fqzl(i,1,j) =0.0
   a_fqz(i,1,j) =0.0
   ENDDO

   ENDDO

   ELSE
   ENDIF

!LPB[12]

   i_start =its
   i_end =min(ite, ide-1)
   j_start =jts
   j_end =min(jte, jde-1)

!LPB[11]

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

   DO i =i_end, i_start, -1
   DO k =ktf, kts, -1
   gwalls =0.5*(rv(i,k,jte-1) +rv(i,k,jte))
   vb =max(gwalls, 0.)
   a_Tmpv7 =a_tendency(i,k,j_end)
   a_tendency(i,k,j_end) =0.0
   a_tendency(i,k,j_end) =a_tendency(i,k,j_end) +a_Tmpv7
   a_Tmpv6 =-a_Tmpv7
   a_Tmpv5 =rdy*a_Tmpv6
   a_field(i,k,j_end) =a_field(i,k,j_end) +(rv(i,k,jte) -rv(i,k,jte-1))*a_Tmpv5
   a_Tmpv3 =field(i,k,j_end)*a_Tmpv5
   a_rv(i,k,jte) =a_rv(i,k,jte) +a_Tmpv3
   a_rv(i,k,jte-1) =a_rv(i,k,jte-1) -a_Tmpv3
   a_vb =a_vb +(field_old(i,k,j_end) -field_old(i,k,j_end-1))*a_Tmpv5
   a_Tmpv1 =vb*a_Tmpv5
   a_field_old(i,k,j_end) =a_field_old(i,k,j_end) +a_Tmpv1
   a_field_old(i,k,j_end-1) =a_field_old(i,k,j_end-1) -a_Tmpv1

   a_Tmpv2 = (1.0 +(1.0)*sign(1.0, gwalls-0.))*0.5*a_vb
   a_vb =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_rv(i,k,jte-1) =a_rv(i,k,jte-1) +a_Tmpv1
   a_rv(i,k,jte) =a_rv(i,k,jte) +a_Tmpv1
   ENDDO
   ENDDO

   ENDIF

!LPB[9]

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

   DO i =i_end, i_start, -1
   DO k =ktf, kts, -1
   gwalls =0.5*(rv(i,k,jts) +rv(i,k,jts+1))
   vb =min(gwalls, 0.)
   a_Tmpv7 =a_tendency(i,k,jts)
   a_tendency(i,k,jts) =0.0
   a_tendency(i,k,jts) =a_tendency(i,k,jts) +a_Tmpv7
   a_Tmpv5 =-rdy*a_Tmpv7
   a_field(i,k,jts) =a_field(i,k,jts) +(rv(i,k,jts+1) -rv(i,k,jts))*a_Tmpv5
   a_Tmpv3 =field(i,k,jts)*a_Tmpv5
   a_rv(i,k,jts+1) =a_rv(i,k,jts+1) +a_Tmpv3
   a_rv(i,k,jts) =a_rv(i,k,jts) -a_Tmpv3
   a_vb =a_vb +(field_old(i,k,jts+1) -field_old(i,k,jts))*a_Tmpv5
   a_Tmpv1 =vb*a_Tmpv5
   a_field_old(i,k,jts+1) =a_field_old(i,k,jts+1) +a_Tmpv1
   a_field_old(i,k,jts) =a_field_old(i,k,jts) -a_Tmpv1

   a_Tmpv2 = (1.0 -(1.0)*sign(1.0, gwalls-0.))*0.5*a_vb
   a_vb =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_rv(i,k,jts) =a_rv(i,k,jts) +a_Tmpv1
   a_rv(i,k,jts+1) =a_rv(i,k,jts+1) +a_Tmpv1
   ENDDO
   ENDDO

   ENDIF

!LPB[7]

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

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   gwalls=0.5*(ru(ite-1,k,j) +ru(ite,k,j))
   ub =max(gwalls, 0.)
   a_Tmpv7 =a_tendency(i_end,k,j)
   a_tendency(i_end,k,j) =0.0
   a_tendency(i_end,k,j) =a_tendency(i_end,k,j) +a_Tmpv7
   a_Tmpv6 =-a_Tmpv7
   a_Tmpv5 =rdx*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_field(i_end,k,j) =a_field(i_end,k,j) +(ru(ite,k,j) -ru(ite-1,k,j))*a_Tmpv4
   a_Tmpv3 =field(i_end,k,j)*a_Tmpv4
   a_ru(ite,k,j) =a_ru(ite,k,j) +a_Tmpv3
   a_ru(ite-1,k,j) =a_ru(ite-1,k,j) -a_Tmpv3
   a_ub =a_ub +(field_old(i_end,k,j) -field_old(i_end-1,k,j))*a_Tmpv2
   a_Tmpv1 =ub*a_Tmpv2
   a_field_old(i_end,k,j) =a_field_old(i_end,k,j) +a_Tmpv1
   a_field_old(i_end-1,k,j) =a_field_old(i_end-1,k,j) -a_Tmpv1

   a_Tmpv2 = (1.0 +(1.0)*sign(1.0, gwalls-0.))*0.5*a_ub
   a_ub =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_ru(ite-1,k,j) =a_ru(ite-1,k,j) +a_Tmpv1
   a_ru(ite,k,j) =a_ru(ite,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDIF

!LPB[5]

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

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   gwalls =0.5*(ru(its,k,j) +ru(its+1,k,j))
   ub =min(gwalls, 0.)
   a_Tmpv7 =a_tendency(its,k,j)
   a_tendency(its,k,j) =0.0
   a_tendency(its,k,j) =a_tendency(its,k,j) +a_Tmpv7
   a_Tmpv6 =-a_Tmpv7
   a_Tmpv5 =rdx*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_field(its,k,j) =a_field(its,k,j) +(ru(its+1,k,j) -ru(its,k,j))*a_Tmpv4
   a_Tmpv3 =field(its,k,j)*a_Tmpv4
   a_ru(its+1,k,j) =a_ru(its+1,k,j) +a_Tmpv3
   a_ru(its,k,j) =a_ru(its,k,j) -a_Tmpv3
   a_ub =a_ub +(field_old(its+1,k,j) -field_old(its,k,j))*a_Tmpv2
   a_Tmpv1 =ub*a_Tmpv2
   a_field_old(its+1,k,j) =a_field_old(its+1,k,j) +a_Tmpv1
   a_field_old(its,k,j) =a_field_old(its,k,j) -a_Tmpv1

   a_Tmpv2 = (1.0 -(1.0)*sign(1.0, gwalls -0.))*0.5*a_ub
   a_ub =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_ru(its,k,j) =a_ru(its,k,j) +a_Tmpv1
   a_ru(its+1,k,j) =a_ru(its+1,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDIF

!LPB[3]

   IF( horz_order == 5 ) THEN
   ktf=MIN(kte,kde-1)

   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_end, j_start, -1

   IF( degrade_xe ) THEN

   DO i =i_end+1, i_end_f+1, -1

   IF( i == ide-2 ) THEN

   DO k =ktf, kts, -1
   vel =ru(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv716(k,j)
   qmin(i,k,j) = Tmpv717(k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1

   ELSE

   qmax(i-1,k,j) = Tmpv718(k,j)
   qmin(i-1,k,j) = Tmpv719(k,j)

   a_Tmpv1 =a_qmin(i-1,k,j)
   a_qmin(i-1,k,j) =0.0
   a_qmin(i-1,k,j) =a_qmin(i-1,k,j)  +(1.0 -sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i-1,k,j)
   a_qmax(i-1,k,j) =0.0
   a_qmax(i-1,k,j) =a_qmax(i-1,k,j)  +(1.0 +sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   END IF

   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_fqx(i,k,j)
   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_vel =a_vel +flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,j),0.0,field(i,k,j)  &
   ,0.0,field(i+1,k,j),0.0,vel,1.0)*a_Tmpv1
   a_field(i+1,k,j) =a_field(i+1,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,  &
   j),0.0,field(i,k,j),0.0,field(i+1,k,j),1.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,j)  &
   ,0.0,field(i,k,j),1.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1
   a_field(i-1,k,j) =a_field(i-1,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,  &
   j),1.0,field(i,k,j),0.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1
   a_field(i-2,k,j) =a_field(i-2,k,j) +Diff_flux3(field(i-2,k,j),1.0,field(i-1,k,  &
   j),0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqxl(i,k,j)
   a_fqxl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i-1,k,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_ru(i,k,j) =a_ru(i,k,j) +a_vel
   a_vel =0.0
   ENDDO

   ENDIF

   IF( i == ide-1 ) THEN

   DO k =ktf, kts, -1
   vel =ru(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv712(k,j)
   qmin(i,k,j) = Tmpv713(k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i-1,k,j) = Tmpv714(k,j)
   qmin(i-1,k,j) = Tmpv715(k,j)

   a_Tmpv1 =a_qmin(i-1,k,j)
   a_qmin(i-1,k,j) =0.0
   a_qmin(i-1,k,j) =a_qmin(i-1,k,j)  +(1.0 -sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i-1,k,j)
   a_qmax(i-1,k,j) =0.0
   a_qmax(i-1,k,j) =a_qmax(i-1,k,j)  +(1.0 +sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_fqx(i,k,j)
   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_ru(i,k,j) =a_ru(i,k,j) +0.5*(field(i,k,j) +field(i-1,k,j))*a_Tmpv2
   a_Tmpv1 =0.5*(ru(i,k,j))*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv1
   a_field(i-1,k,j) =a_field(i-1,k,j) +a_Tmpv1
   a_Tmpv2 =a_fqxl(i,k,j)
   a_fqxl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i-1,k,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_ru(i,k,j) =a_ru(i,k,j) +a_vel
   a_vel =0.0
   ENDDO

   ENDIF
   ENDDO

   ENDIF

   IF( degrade_xs ) THEN

   DO i =i_start_f-1, i_start, -1

   IF(i == ids+2) THEN

   DO k =ktf, kts, -1
   vel =ru(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv708(k,j)
   qmin(i,k,j) = Tmpv709(k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i-1,k,j) = Tmpv710(k,j)
   qmin(i-1,k,j) = Tmpv711(k,j)

   a_Tmpv1 =a_qmin(i-1,k,j)
   a_qmin(i-1,k,j) =0.0
   a_qmin(i-1,k,j) =a_qmin(i-1,k,j)  +(1.0 -sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i-1,k,j)
   a_qmax(i-1,k,j) =0.0
   a_qmax(i-1,k,j) =a_qmax(i-1,k,j)  +(1.0 +sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_fqx(i,k,j)
   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_vel =a_vel +flux3(field(i-2,k,j),field(i-1,k,j),field(i,k,j),field(i+1,k,j),vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,j),0.0,field(i,k,j)  &
   ,0.0,field(i+1,k,j),0.0,vel,1.0)*a_Tmpv1
   a_field(i+1,k,j) =a_field(i+1,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,  &
   j),0.0,field(i,k,j),0.0,field(i+1,k,j),1.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,j)  &
   ,0.0,field(i,k,j),1.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1
   a_field(i-1,k,j) =a_field(i-1,k,j) +Diff_flux3(field(i-2,k,j),0.0,field(i-1,k,  &
   j),1.0,field(i,k,j),0.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1
   a_field(i-2,k,j) =a_field(i-2,k,j) +Diff_flux3(field(i-2,k,j),1.0,field(i-1,k,  &
   j),0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqxl(i,k,j)
   a_fqxl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i-1,k,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_ru(i,k,j) =a_ru(i,k,j) +a_vel
   a_vel =0.0
   ENDDO

   ENDIF

   IF(i == ids+1) THEN

   DO k =ktf, kts, -1
   vel =ru(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv704(k,j)
   qmin(i,k,j) = Tmpv705(k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i-1,k,j) = Tmpv706(k,j)
   qmin(i-1,k,j) = Tmpv707(k,j)

   a_Tmpv1 =a_qmin(i-1,k,j)
   a_qmin(i-1,k,j) =0.0
   a_qmin(i-1,k,j) =a_qmin(i-1,k,j)  +(1.0 -sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i-1,k,j)
   a_qmax(i-1,k,j) =0.0
   a_qmax(i-1,k,j) =a_qmax(i-1,k,j)  +(1.0 +sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_fqx(i,k,j)
   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_ru(i,k,j) =a_ru(i,k,j) +0.5*(field(i,k,j)+field(i-1,k,j))*a_Tmpv2
   a_Tmpv1 =0.5*(ru(i,k,j))*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv1
   a_field(i-1,k,j) =a_field(i-1,k,j) +a_Tmpv1
   a_Tmpv2 =a_fqxl(i,k,j)
   a_fqxl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i-1,k,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_ru(i,k,j) =a_ru(i,k,j) +a_vel
   a_vel =0.0
   ENDDO

   ENDIF
   ENDDO

   ENDIF

   DO k =ktf, kts, -1
   DO i =i_end_f, i_start_f, -1
   vel =ru(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv700(i,k,j)
   qmin(i,k,j) = Tmpv701(i,k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i-1,k,j)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i-1,k,j)))*0.5*1.0*a_Tmpv1

   else

   qmax(i-1,k,j) = Tmpv702(i-1,k,j)
   qmin(i-1,k,j) = Tmpv703(i-1,k,j)

   a_Tmpv1 =a_qmin(i-1,k,j)
   a_qmin(i-1,k,j) =0.0
   a_qmin(i-1,k,j) =a_qmin(i-1,k,j)  +(1.0 -sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i-1,k,j)
   a_qmax(i-1,k,j) =0.0
   a_qmax(i-1,k,j) =a_qmax(i-1,k,j)  +(1.0 +sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i-1,k,j)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqxl(i,k,j) =a_fqxl(i,k,j) -a_fqx(i,k,j)
   a_Tmpv2 =a_fqx(i,k,j)
   a_fqx(i,k,j) =0.0
   a_vel =a_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)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,j),0.0,field(i-1,k,j)  &
   ,0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,field(i+2,k,j),0.0,vel,1.0)*a_Tmpv1
   a_field(i+2,k,j) =a_field(i+2,k,j) +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,  &
   j),0.0,field(i-1,k,j),0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,field(i+2,k,j)  &
   ,1.0,vel,0.0)*a_Tmpv1
   a_field(i+1,k,j) =a_field(i+1,k,j) +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,  &
   j),0.0,field(i-1,k,j),0.0,field(i,k,j),0.0,field(i+1,k,j),1.0,field(i+2,k,j)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,j)  &
   ,0.0,field(i-1,k,j),0.0,field(i,k,j),1.0,field(i+1,k,j),0.0,field(i+2,k,j)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i-1,k,j) =a_field(i-1,k,j) +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,  &
   j),0.0,field(i-1,k,j),1.0,field(i,k,j),0.0,field(i+1,k,j),0.0,field(i+2,k,j)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i-2,k,j) =a_field(i-2,k,j) +Diff_flux5(field(i-3,k,j),0.0,field(i-2,k,  &
   j),1.0,field(i-1,k,j),0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,field(i+2,k,j)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i-3,k,j) =a_field(i-3,k,j) +Diff_flux5(field(i-3,k,j),1.0,field(i-2,k,  &
   j),0.0,field(i-1,k,j),0.0,field(i,k,j),0.0,field(i+1,k,j),0.0,field(i+2,k,j)  &
   ,0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqxl(i,k,j)
   a_fqxl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i-1,k,j),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i-1,k,j),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i-1,k,j) =a_field_old(i-1,k,j) +Diff_flux_upwind(field_old(i-1,k,j)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_ru(i,k,j) =a_ru(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO
   ENDDO

   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_end+1, j_start, -1

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

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   vel =rv(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv600(i,k,j)
   qmin(i,k,j) = Tmpv601(i,k,j)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k,j-1) = Tmpv602(i,k,j-1)
   qmin(i,k,j-1) = Tmpv603(i,k,j-1)

   a_Tmpv1 =a_qmin(i,k,j-1)
   a_qmin(i,k,j-1) =0.0
   a_qmin(i,k,j-1) =a_qmin(i,k,j-1)  +(1.0 -sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k,j-1)
   a_qmax(i,k,j-1) =0.0
   a_qmax(i,k,j-1) =a_qmax(i,k,j-1)  +(1.0 +sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_fqy(i,k,j)
   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_vel =a_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)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-2),0.0,field(i,k,j-1)  &
   ,0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,field(i,k,j+2),0.0,vel,1.0)*a_Tmpv1
   a_field(i,k,j+2) =a_field(i,k,j+2) +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-  &
   2),0.0,field(i,k,j-1),0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,field(i,k,j+2)  &
   ,1.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j+1) =a_field(i,k,j+1) +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-  &
   2),0.0,field(i,k,j-1),0.0,field(i,k,j),0.0,field(i,k,j+1),1.0,field(i,k,j+2)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-2)  &
   ,0.0,field(i,k,j-1),0.0,field(i,k,j),1.0,field(i,k,j+1),0.0,field(i,k,j+2)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-1) =a_field(i,k,j-1) +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-  &
   2),0.0,field(i,k,j-1),1.0,field(i,k,j),0.0,field(i,k,j+1),0.0,field(i,k,j+2)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-2) =a_field(i,k,j-2) +Diff_flux5(field(i,k,j-3),0.0,field(i,k,j-  &
   2),1.0,field(i,k,j-1),0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,field(i,k,j+2)  &
   ,0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-3) =a_field(i,k,j-3) +Diff_flux5(field(i,k,j-3),1.0,field(i,k,j-  &
   2),0.0,field(i,k,j-1),0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,field(i,k,j+2)  &
   ,0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqyl(i,k,j)
   a_fqyl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k,j-1),field_old(i,k,j),vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux_upwind(field_old(i,k,j-1),0.0,field_old(i,k,j)  &
   ,0.0,vel,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,0.0,field_old(i,k,j),1.0,vel,0.0)*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,1.0,field_old(i,k,j),0.0,vel,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_rv(i,k,j) =a_rv(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO

   ELSE IF( j == jds+1 ) THEN

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   vel =rv(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv604(i,k)
   qmin(i,k,j) = Tmpv605(i,k)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k,j-1) = Tmpv606(i,k)
   qmin(i,k,j-1) = Tmpv607(i,k)

   a_Tmpv1 =a_qmin(i,k,j-1)
   a_qmin(i,k,j-1) =0.0
   a_qmin(i,k,j-1) =a_qmin(i,k,j-1)  +(1.0 -sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k,j-1)
   a_qmax(i,k,j-1) =0.0
   a_qmax(i,k,j-1) =a_qmax(i,k,j-1)  +(1.0 +sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_fqy(i,k,j)
   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_rv(i,k,j) =a_rv(i,k,j) +0.5*(field(i,k,j) +field(i,k,j-1))*a_Tmpv2
   a_Tmpv1 =0.5*rv(i,k,j)*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv1
   a_field(i,k,j-1) =a_field(i,k,j-1) +a_Tmpv1
   a_Tmpv2 =a_fqyl(i,k,j)
   a_fqyl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k,j-1),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_rv(i,k,j) =a_rv(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO

   ELSE IF( j == jds+2 ) THEN

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   vel =rv(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv608(i,k)
   qmin(i,k,j) = Tmpv609(i,k)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k,j-1) = Tmpv6010(i,k)
   qmin(i,k,j-1) = Tmpv6011(i,k)

   a_Tmpv1 =a_qmin(i,k,j-1)
   a_qmin(i,k,j-1) =0.0
   a_qmin(i,k,j-1) =a_qmin(i,k,j-1)  +(1.0 -sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k,j-1)
   a_qmax(i,k,j-1) =0.0
   a_qmax(i,k,j-1) =a_qmax(i,k,j-1)  +(1.0 +sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_fqy(i,k,j)
   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_vel =a_vel +flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-1),0.0,field(i,k,j)  &
   ,0.0,field(i,k,j+1),0.0,vel,1.0)*a_Tmpv1
   a_field(i,k,j+1) =a_field(i,k,j+1) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-  &
   1),0.0,field(i,k,j),0.0,field(i,k,j+1),1.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-1)  &
   ,0.0,field(i,k,j),1.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-1) =a_field(i,k,j-1) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-  &
   1),1.0,field(i,k,j),0.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-2) =a_field(i,k,j-2) +Diff_flux3(field(i,k,j-2),1.0,field(i,k,j-  &
   1),0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqyl(i,k,j)
   a_fqyl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k,j-1),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_rv(i,k,j) =a_rv(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO

   ELSE IF( j == jde-1 ) THEN

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   vel =rv(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv6012(i,k)
   qmin(i,k,j) = Tmpv6013(i,k)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k,j-1) = Tmpv6014(i,k)
   qmin(i,k,j-1) = Tmpv6015(i,k)

   a_Tmpv1 =a_qmin(i,k,j-1)
   a_qmin(i,k,j-1) =0.0
   a_qmin(i,k,j-1) =a_qmin(i,k,j-1)  +(1.0 -sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k,j-1)
   a_qmax(i,k,j-1) =0.0
   a_qmax(i,k,j-1) =a_qmax(i,k,j-1)  +(1.0 +sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_fqy(i,k,j)
   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_rv(i,k,j) =a_rv(i,k,j) +0.5*(field(i,k,j) +field(i,k,j-1))*a_Tmpv2
   a_Tmpv1 =0.5*rv(i,k,j)*a_Tmpv2
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv1
   a_field(i,k,j-1) =a_field(i,k,j-1) +a_Tmpv1
   a_Tmpv2 =a_fqyl(i,k,j)
   a_fqyl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k,j-1),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_rv(i,k,j) =a_rv(i,k,j) +a_vel
   a_vel =0.0

   ENDDO
   ENDDO

   ELSE IF( j == jde-2 ) THEN

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   vel =rv(i,k,j)
   cr =vel

   IF(cr.gt. 0) THEN
   qmax(i,k,j) = Tmpv6016(i,k)
   qmin(i,k,j) = Tmpv6017(i,k)

   a_Tmpv1 =a_qmax(i,k,j)
   a_qmax(i,k,j) =0.0
   a_qmax(i,k,j) =a_qmax(i,k,j)  +(1.0 +sign(1.0, qmax(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 -sign(1.0, qmax(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmin(i,k,j)
   a_qmin(i,k,j) =0.0
   a_qmin(i,k,j) =a_qmin(i,k,j)  +(1.0 -sign(1.0, qmin(i,k,j) -field_old(i,k,j-1)  &
   ))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1)  +(1.0 +sign(1.0, qmin(i,k,j)  &
    -field_old(i,k,j-1)))*0.5*1.0*a_Tmpv1

   else

   qmax(i,k,j-1) = Tmpv6018(i,k)
   qmin(i,k,j-1) = Tmpv6019(i,k)

   a_Tmpv1 =a_qmin(i,k,j-1)
   a_qmin(i,k,j-1) =0.0
   a_qmin(i,k,j-1) =a_qmin(i,k,j-1)  +(1.0 -sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 +sign(1.0, qmin(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_Tmpv1 =a_qmax(i,k,j-1)
   a_qmax(i,k,j-1) =0.0
   a_qmax(i,k,j-1) =a_qmax(i,k,j-1)  +(1.0 +sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j)  +(1.0 -sign(1.0, qmax(i,k,j-1)  &
    -field_old(i,k,j)))*0.5*1.0*a_Tmpv1

   end IF

   a_fqyl(i,k,j) =a_fqyl(i,k,j) -a_fqy(i,k,j)
   a_Tmpv2 =a_fqy(i,k,j)
   a_fqy(i,k,j) =0.0
   a_vel =a_vel +flux3(field(i,k,j-2),field(i,k,j-1),field(i,k,j),field(i,k,j+1),vel)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_vel =a_vel +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-1),0.0,field(i,k,j)  &
   ,0.0,field(i,k,j+1),0.0,vel,1.0)*a_Tmpv1
   a_field(i,k,j+1) =a_field(i,k,j+1) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-  &
   1),0.0,field(i,k,j),0.0,field(i,k,j+1),1.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-1)  &
   ,0.0,field(i,k,j),1.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-1) =a_field(i,k,j-1) +Diff_flux3(field(i,k,j-2),0.0,field(i,k,j-  &
   1),1.0,field(i,k,j),0.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1
   a_field(i,k,j-2) =a_field(i,k,j-2) +Diff_flux3(field(i,k,j-2),1.0,field(i,k,j-  &
   1),0.0,field(i,k,j),0.0,field(i,k,j+1),0.0,vel,0.0)*a_Tmpv1

   a_Tmpv2 =a_fqyl(i,k,j)
   a_fqyl(i,k,j) =0.0
   a_vel =a_vel +flux_upwind(field_old(i,k,j-1),field_old(i,k,j),cr)*a_Tmpv2
   a_Tmpv1 =vel*a_Tmpv2
   a_cr =a_cr +Diff_flux_upwind(field_old(i,k,j-1),0.0,field_old(i,k,j)  &
   ,0.0,cr,1.0)*a_Tmpv1
   a_field_old(i,k,j) =a_field_old(i,k,j) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,0.0,field_old(i,k,j),1.0,cr,0.0)*a_Tmpv1
   a_field_old(i,k,j-1) =a_field_old(i,k,j-1) +Diff_flux_upwind(field_old(i,k,j-1)  &
   ,1.0,field_old(i,k,j),0.0,cr,0.0)*a_Tmpv1

   a_vel =a_vel +a_cr
   a_cr =0.0

   a_rv(i,k,j) =a_rv(i,k,j) +a_vel
   a_vel =0.0
   ENDDO
   ENDDO

   ENDIF
   ENDDO

   ENDIF

!LPB[1]

   DO j =jte+2, jts-2, -1
   DO k =kte, kts, -1
   DO i =ite+2, its-2, -1
   a_field_old(i,k,j) =a_field_old(i,k,j) +a_qmax(i,k,j)
   a_field_old(i,k,j) =a_field_old(i,k,j) +a_qmin(i,k,j)
   ENDDO
   ENDDO
   ENDDO

   END SUBROUTINE a_advect_scalar_mono

!        Generated by TAPENADE     (INRIA, Ecuador team)
!  Tapenade 3.12 (r6213) - 13 Oct 2016 10:54
!
!  Differentiation of advect_scalar_weno in reverse (adjoint) mode:
!   gradient     of useful results: rom field tendency ru rv field_old
!   with respect to varying inputs: rom field tendency ru rv field_old
!   RW status of diff variables: rom:incr field:incr tendency:in-out
!                ru:incr rv:incr field_old:incr
SUBROUTINE A_ADVECT_SCALAR_WENO(field, fieldb, field_old, field_oldb, &
& tendency, tendencyb, ru, rub, rv, rvb, rom, romb, 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) :: fieldb, field_oldb, rub&
& , rvb, romb
  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) :: tendencyb
  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 :: ubb, vbb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its-is:ite+1, kts:kte) :: fqx
  REAL, DIMENSION(its-is:ite+1, kts:kte) :: fqxb
!   REAL,  DIMENSION( its:ite+1, kts:kte  ) :: fqx
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: qim2b, qim1b, qib, qip1b, qip2b
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
& sumwk
  DOUBLE PRECISION :: beta0b, beta1b, beta2b, f0b, f1b, f2b, wi0b, wi1b&
& , wi2b, sumwkb
  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 :: velb
  LOGICAL :: specified
  DOUBLE PRECISION :: temp
  DOUBLE PRECISION :: temp0
  DOUBLE PRECISION :: temp1
  DOUBLE PRECISION :: tempb
  DOUBLE PRECISION :: tempb0
  REAL :: tempb1
  REAL :: tempb2
  REAL :: tempb3
  REAL :: tempb4
  REAL :: tempb5
  REAL :: tempb6
  REAL :: tempb7
  REAL :: temp2
  REAL :: temp3
  REAL :: temp4
  REAL :: tempb8
  REAL :: tempb9
  REAL :: tempb10
  REAL :: tempb11
  REAL :: temp5
  REAL :: temp6
  REAL :: temp7
  REAL :: tempb12
  REAL :: tempb13
  REAL :: tempb14
  DOUBLE PRECISION :: temp8
  DOUBLE PRECISION :: temp9
  DOUBLE PRECISION :: temp10
  DOUBLE PRECISION :: tempb15
  DOUBLE PRECISION :: tempb16
  REAL :: tempb17
  REAL :: tempb18
  REAL :: tempb19
  REAL :: tempb20
  REAL :: tempb21
  REAL :: tempb22
  REAL :: tempb23
  REAL :: temp11
  REAL :: temp12
  REAL :: temp13
  REAL :: tempb24
  REAL :: tempb25
  REAL :: tempb26
  REAL :: tempb27
  REAL :: temp14
  REAL :: temp15
  REAL :: temp16
  REAL :: tempb28
  REAL :: tempb29
  REAL :: tempb30
  REAL :: tempb31
  REAL :: tempb32
  REAL :: tempb33
  REAL :: tempb34
  REAL :: tempb35
  REAL :: tempb36
  REAL :: tempb37
  REAL :: tempb38
  DOUBLE PRECISION :: temp17
  DOUBLE PRECISION :: temp18
  DOUBLE PRECISION :: temp19
  DOUBLE PRECISION :: tempb39
  DOUBLE PRECISION :: tempb40
  REAL :: tempb41
  REAL :: tempb42
  REAL :: tempb43
  REAL :: tempb44
  REAL :: tempb45
  REAL :: tempb46
  REAL :: temp20
  REAL :: temp21
  REAL :: temp22
  REAL :: temp23
  REAL :: temp24
  REAL :: temp25
  REAL :: tempb47
  REAL :: tempb48
  REAL :: tempb49
  REAL :: tempb50
  REAL :: tempb51
  REAL :: tempb52
  REAL :: tempb53
  REAL :: tempb54
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  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
!  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
          CALL PUSHCONTROL1B(1)
          i_start = its
        ELSE
          CALL PUSHCONTROL1B(1)
          i_start = ids + 1
        END IF
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      IF (config_flags%open_xe .OR. specified) THEN
        IF (ide - 1 .GT. ite) THEN
          CALL PUSHCONTROL1B(1)
          i_end = ite
        ELSE
          CALL PUSHCONTROL1B(1)
          i_end = ide - 1
        END IF
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      IF (config_flags%periodic_x) i_start = its
      IF (config_flags%periodic_x) THEN
        CALL PUSHCONTROL1B(1)
        i_end = ite
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    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
        CALL PUSHCONTROL1B(0)
        j_start = jds + 1
      ELSE
        CALL PUSHCONTROL1B(0)
        j_start = jts
      END IF
      j_start_f = jds + 3
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (degrade_ye) THEN
      IF (jte .GT. jde - 2) THEN
        CALL PUSHCONTROL1B(0)
        j_end = jde - 2
      ELSE
        CALL PUSHCONTROL1B(0)
        j_end = jte
      END IF
      j_end_f = jde - 3
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (config_flags%polar) THEN
      IF (jte .GT. jde - 1) THEN
        CALL PUSHCONTROL1B(1)
        j_end = jde - 1
      ELSE
        CALL PUSHCONTROL1B(1)
        j_end = jte
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
!  compute fluxes, 5th or 6th order
    jp1 = 2
    jp0 = 1
    ad_from10 = j_start
j_loop_y_flux_5:DO j=ad_from10,j_end+1
      IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
        DO k=kts,ktf
          ad_from = i_start
          DO i=ad_from,i_end
!          vel = rv(i,k,j)
            vel = 0.5*(rv(i, k, j)+rv(i-is, k-ks, j-js))
            IF (vel*SIGN(1, time_step) .GE. 0.0) THEN
              CALL PUSHREAL8(qip2)
              qip2 = field(i, k, j+1)
              CALL PUSHREAL8(qip1)
              qip1 = field(i, k, j)
              CALL PUSHREAL8(qi)
              qi = field(i, k, j-1)
              CALL PUSHREAL8(qim1)
              qim1 = field(i, k, j-2)
              CALL PUSHREAL8(qim2)
              qim2 = field(i, k, j-3)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHREAL8(qip2)
              qip2 = field(i, k, j-2)
              CALL PUSHREAL8(qip1)
              qip1 = field(i, k, j-1)
              CALL PUSHREAL8(qi)
              qi = field(i, k, j)
              CALL PUSHREAL8(qim1)
              qim1 = field(i, k, j+1)
              CALL PUSHREAL8(qim2)
              qim2 = field(i, k, j+2)
              CALL PUSHCONTROL1B(1)
            END IF
            CALL PUSHREAL8(f0)
            f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
            CALL PUSHREAL8(f1)
            f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
            CALL PUSHREAL8(f2)
            f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
            CALL PUSHREAL8(beta0)
            beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+&
&             3.*qi)**2
            CALL PUSHREAL8(beta1)
            beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
            CALL PUSHREAL8(beta2)
            beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+&
&             3.*qi)**2
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHCONTROL3B(0)
      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
          ad_from0 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from0)
        END DO
        CALL PUSHCONTROL3B(1)
      ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
        DO k=kts,ktf
          ad_from1 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from1)
        END DO
        CALL PUSHCONTROL3B(2)
      ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
        DO k=kts,ktf
          ad_from2 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from2)
        END DO
        CALL PUSHCONTROL3B(3)
      ELSE IF (j .EQ. jde - 2) THEN
! 3rd or 4th order flux 2 in from north boundary
        DO k=kts,ktf
          ad_from3 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from3)
        END DO
        CALL PUSHCONTROL3B(4)
      ELSE
        CALL PUSHCONTROL3B(5)
      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
            ad_from4 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from4)
          END DO
          CALL PUSHCONTROL4B(0)
        ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
          DO k=kts,ktf
            ad_from5 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from5)
          END DO
          CALL PUSHCONTROL4B(1)
        ELSE IF (j .GT. j_start) THEN
! normal code
          DO k=kts,ktf
            ad_from6 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from6)
          END DO
          CALL PUSHCONTROL4B(2)
        ELSE
          CALL PUSHCONTROL4B(3)
        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
            ad_from7 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from7)
          END DO
          CALL PUSHCONTROL4B(4)
        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
            ad_from8 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from8)
          END DO
          CALL PUSHCONTROL4B(5)
        ELSE IF (j .GT. j_start) THEN
! normal code
          DO k=kts,ktf
            ad_from9 = i_start
            i = i_end + 1
            CALL PUSHINTEGER4(i - 1)
            CALL PUSHINTEGER4(ad_from9)
          END DO
          CALL PUSHCONTROL4B(6)
        ELSE
          CALL PUSHCONTROL4B(7)
        END IF
      ELSE
        CALL PUSHCONTROL4B(8)
      END IF
      jtmp = jp1
      CALL PUSHINTEGER4(jp1)
      jp1 = jp0
      CALL PUSHINTEGER4(jp0)
      jp0 = jtmp
    END DO j_loop_y_flux_5
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from10)
!  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
        CALL PUSHCONTROL1B(1)
        i_start_f = ids + 3
      ELSE
        CALL PUSHCONTROL1B(1)
        i_start_f = i_start + 2
      END IF
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    IF (degrade_xe) THEN
      IF (ide - 2 .GT. ite) THEN
        CALL PUSHCONTROL1B(1)
        i_end = ite
      ELSE
        CALL PUSHCONTROL1B(1)
        i_end = ide - 2
      END IF
      i_end_f = ide - 3
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    ad_from14 = j_start
!  compute fluxes
    DO j=ad_from14,j_end
!  5th or 6th order flux
      DO k=kts,ktf
        DO i=i_start_f,i_end_f
!          vel = ru(i,k,j)
          vel = 0.5*(ru(i, k, j)+ru(i-is, k-ks, j-js))
          IF (vel*SIGN(1, time_step) .GE. 0.0) THEN
            CALL PUSHREAL8(qip2)
            qip2 = field(i+1, k, j)
            CALL PUSHREAL8(qip1)
            qip1 = field(i, k, j)
            CALL PUSHREAL8(qi)
            qi = field(i-1, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = field(i-2, k, j)
            CALL PUSHREAL8(qim2)
            qim2 = field(i-3, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(qip2)
            qip2 = field(i-2, k, j)
            CALL PUSHREAL8(qip1)
            qip1 = field(i-1, k, j)
            CALL PUSHREAL8(qi)
            qi = field(i, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = field(i+1, k, j)
            CALL PUSHREAL8(qim2)
            qim2 = field(i+2, k, j)
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(f0)
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          CALL PUSHREAL8(f1)
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          CALL PUSHREAL8(f2)
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          CALL PUSHREAL8(beta0)
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&           qi)**2
          CALL PUSHREAL8(beta1)
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          CALL PUSHREAL8(beta2)
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&           qi)**2
        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
        ad_from11 = i_start
        DO i=ad_from11,i_start_f-1
          IF (i .EQ. ids + 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ids + 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(ad_from11)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      IF (degrade_xe) THEN
        DO i=i_end_f+1,i_end+1
          IF (i .EQ. ide - 1) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (i .EQ. ide - 2) THEN
            CALL PUSHCONTROL1B(1)
          ELSE
            CALL PUSHCONTROL1B(0)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
!  x flux-divergence into tendency
      IF (is .EQ. 0) THEN
        DO k=kts,ktf
          ad_from12 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from12)
        END DO
        CALL PUSHCONTROL2B(2)
      ELSE IF (is .EQ. 1) THEN
        DO k=kts,ktf
          ad_from13 = i_start
          i = i_end + 1
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from13)
        END DO
        CALL PUSHCONTROL2B(1)
      ELSE
        CALL PUSHCONTROL2B(0)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from14)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(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
    ad_from15 = j_start
    DO j=ad_from15,j_end
      DO k=kts,ktf
        IF (0.5*(ru(its, k, j)+ru(its+1, k, j)) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(its, k, j)+ru(its+1, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from15)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from16 = j_start
    DO j=ad_from16,j_end
      DO k=kts,ktf
        IF (0.5*(ru(ite-1, k, j)+ru(ite, k, j)) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = 0.5*(ru(ite-1, k, j)+ru(ite, k, j))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from16)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from17 = i_start
    DO i=ad_from17,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jts)+rv(i, k, jts+1)) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jts)+rv(i, k, jts+1))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from17)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from18 = i_start
    DO i=ad_from18,i_end
      DO k=kts,ktf
        IF (0.5*(rv(i, k, jte-1)+rv(i, k, jte)) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = 0.5*(rv(i, k, jte-1)+rv(i, k, jte))
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from18)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    CALL PUSHINTEGER4(j_end)
    j_end = jde - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(j_end)
    j_end = jte
    CALL PUSHCONTROL1B(1)
  END IF
  DO j=j_start,j_end
    DO k=kts+3,ktf-2
      DO i=i_start,i_end
!           vel = rom(i,k,j)
        vel = 0.5*(rom(i, k, j)+rom(i-is, k-ks, j-js))
        IF (-(vel*SIGN(1, time_step)) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = field(i, k+1, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i, k, j)
          CALL PUSHREAL8(qi)
          qi = field(i, k-1, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i, k-2, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i, k-3, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = field(i, k-2, j)
          CALL PUSHREAL8(qip1)
          qip1 = field(i, k-1, j)
          CALL PUSHREAL8(qi)
          qi = field(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = field(i, k+1, j)
          CALL PUSHREAL8(qim2)
          qim2 = field(i, k+2, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&         )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&         )**2
      END DO
    END DO
    CALL PUSHINTEGER4(k)
  END DO
  vfluxb = 0.0
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
        vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
      END DO
    END DO
    CALL POPINTEGER4(k)
    DO i=i_end,i_start,-1
      k = ktf
      tempb47 = rom(i, k, j)*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&       field(i, k-1, j))*vfluxb(i, k)
      fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*tempb47
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*tempb47
      vfluxb(i, k) = 0.0
      k = ktf - 1
      vel = rom(i, k, j)
      temp23 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j)-&
&       field(i, k-1, j))
      temp25 = SIGN(1., -vel)
      temp24 = temp25/12.
      tempb48 = vel*vfluxb(i, k)
      tempb49 = 7.*tempb48/12.
      tempb50 = temp24*tempb48
      velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k+1, &
&       j)+field(i, k-2, j))/12.+temp24*temp23)*vfluxb(i, k)
      fieldb(i, k, j) = fieldb(i, k, j) + tempb49 - 3.*tempb50
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*tempb50 + tempb49
      fieldb(i, k+1, j) = fieldb(i, k+1, j) + tempb50 - tempb48/12.
      fieldb(i, k-2, j) = fieldb(i, k-2, j) - tempb50 - tempb48/12.
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + velb
      k = kts + 2
      vel = rom(i, k, j)
      temp20 = field(i, k+1, j) - field(i, k-2, j) - 3.*(field(i, k, j)-&
&       field(i, k-1, j))
      temp22 = SIGN(1., -vel)
      temp21 = temp22/12.
      tempb51 = vel*vfluxb(i, k)
      tempb52 = 7.*tempb51/12.
      tempb53 = temp21*tempb51
      velb = (7.*((field(i, k, j)+field(i, k-1, j))/12.)-(field(i, k+1, &
&       j)+field(i, k-2, j))/12.+temp21*temp20)*vfluxb(i, k)
      fieldb(i, k, j) = fieldb(i, k, j) + tempb52 - 3.*tempb53
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + 3.*tempb53 + tempb52
      fieldb(i, k+1, j) = fieldb(i, k+1, j) + tempb53 - tempb51/12.
      fieldb(i, k-2, j) = fieldb(i, k-2, j) - tempb53 - tempb51/12.
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + velb
      k = kts + 1
      tempb54 = rom(i, k, j)*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + (fzm(k)*field(i, k, j)+fzp(k)*&
&       field(i, k-1, j))*vfluxb(i, k)
      fieldb(i, k, j) = fieldb(i, k, j) + fzm(k)*tempb54
      fieldb(i, k-1, j) = fieldb(i, k-1, j) + fzp(k)*tempb54
      vfluxb(i, k) = 0.0
    END DO
    DO k=ktf-2,kts+3,-1
      DO i=i_end,i_start,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(rom(i, k, j)+rom(i-is, k-ks, j-js))
        tempb39 = vel*vfluxb(i, k)/sumwk
        tempb40 = (wi0*f0+wi1*f1+wi2*f2)*vfluxb(i, k)/sumwk
        f0b = wi0*tempb39
        f1b = wi1*tempb39
        f2b = wi2*tempb39
        velb = tempb40
        sumwkb = -(vel*tempb40/sumwk)
        wi0b = sumwkb + f0*tempb39
        wi1b = sumwkb + f1*tempb39
        wi2b = sumwkb + f2*tempb39
        vfluxb(i, k) = 0.0
        temp19 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&           )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp19**2)
        END IF
        temp18 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&           )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp18**2)
        END IF
        temp17 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&           )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp17**2)
        END IF
        CALL POPREAL8(beta2)
        tempb41 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        tempb42 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = tempb42 - f2b/6. + tempb41
        CALL POPREAL8(beta1)
        tempb43 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        tempb46 = 2*(qim1-qip1)*beta1b/4.
        qip1b = tempb43 - tempb46 + f1b/3. + 5.*f2b/6. - 4.*tempb42 - 2.&
&         *tempb41
        CALL POPREAL8(beta0)
        tempb45 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        tempb44 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*tempb43 + 11.*f0b/6. + 5.*f1b/6. + 3.*tempb44 &
&         + tempb45 + 3.*tempb42 + tempb41
        qim1b = tempb46 - 4.*tempb44 - 7.*f0b/6. - f1b/6. - 2.*tempb45 +&
&         tempb43
        qim2b = f0b/3. + tempb44 + tempb45
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          fieldb(i, k-3, j) = fieldb(i, k-3, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i, k-2, j) = fieldb(i, k-2, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i, k, j) = fieldb(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          fieldb(i, k+2, j) = fieldb(i, k+2, j) + qim2b
          CALL POPREAL8(qim1)
          fieldb(i, k+1, j) = fieldb(i, k+1, j) + qim1b
          CALL POPREAL8(qi)
          fieldb(i, k, j) = fieldb(i, k, j) + qib
          CALL POPREAL8(qip1)
          fieldb(i, k-1, j) = fieldb(i, k-1, j) + qip1b
          CALL POPREAL8(qip2)
          fieldb(i, k-2, j) = fieldb(i, k-2, j) + qip2b
        END IF
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i-is, k-ks, j-js) = romb(i-is, k-ks, j-js) + 0.5*velb
      END DO
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(j_end)
  ELSE
    CALL POPINTEGER4(j_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from18)
    CALL POPINTEGER4(ad_to18)
    DO i=ad_to18,ad_from18,-1
      DO k=ktf,kts,-1
        tempb37 = -(rdy*tendencyb(i, k, j_end))
        tempb38 = field(i, k, j_end)*tempb37
        vbb = (field_old(i, k, j_end)-field_old(i, k, j_end-1))*tempb37
        field_oldb(i, k, j_end) = field_oldb(i, k, j_end) + vb*tempb37
        field_oldb(i, k, j_end-1) = field_oldb(i, k, j_end-1) - vb*&
&         tempb37
        fieldb(i, k, j_end) = fieldb(i, k, j_end) + (rv(i, k, jte)-rv(i&
&         , k, jte-1))*tempb37
        rvb(i, k, jte) = rvb(i, k, jte) + tempb38
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - tempb38
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte-1) = rvb(i, k, jte-1) + 0.5*vbb
          rvb(i, k, jte) = rvb(i, k, jte) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from17)
    CALL POPINTEGER4(ad_to17)
    DO i=ad_to17,ad_from17,-1
      DO k=ktf,kts,-1
        tempb35 = -(rdy*tendencyb(i, k, jts))
        tempb36 = field(i, k, jts)*tempb35
        vbb = (field_old(i, k, jts+1)-field_old(i, k, jts))*tempb35
        field_oldb(i, k, jts+1) = field_oldb(i, k, jts+1) + vb*tempb35
        field_oldb(i, k, jts) = field_oldb(i, k, jts) - vb*tempb35
        fieldb(i, k, jts) = fieldb(i, k, jts) + (rv(i, k, jts+1)-rv(i, k&
&         , jts))*tempb35
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + tempb36
        rvb(i, k, jts) = rvb(i, k, jts) - tempb36
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + 0.5*vbb
          rvb(i, k, jts+1) = rvb(i, k, jts+1) + 0.5*vbb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from16)
    CALL POPINTEGER4(ad_to16)
    DO j=ad_to16,ad_from16,-1
      DO k=ktf,kts,-1
        tempb33 = -(rdx*tendencyb(i_end, k, j))
        tempb34 = field(i_end, k, j)*tempb33
        ubb = (field_old(i_end, k, j)-field_old(i_end-1, k, j))*tempb33
        field_oldb(i_end, k, j) = field_oldb(i_end, k, j) + ub*tempb33
        field_oldb(i_end-1, k, j) = field_oldb(i_end-1, k, j) - ub*&
&         tempb33
        fieldb(i_end, k, j) = fieldb(i_end, k, j) + (ru(ite, k, j)-ru(&
&         ite-1, k, j))*tempb33
        rub(ite, k, j) = rub(ite, k, j) + tempb34
        rub(ite-1, k, j) = rub(ite-1, k, j) - tempb34
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite-1, k, j) = rub(ite-1, k, j) + 0.5*ubb
          rub(ite, k, j) = rub(ite, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from15)
    CALL POPINTEGER4(ad_to15)
    DO j=ad_to15,ad_from15,-1
      DO k=ktf,kts,-1
        tempb31 = -(rdx*tendencyb(its, k, j))
        tempb32 = field(its, k, j)*tempb31
        ubb = (field_old(its+1, k, j)-field_old(its, k, j))*tempb31
        field_oldb(its+1, k, j) = field_oldb(its+1, k, j) + ub*tempb31
        field_oldb(its, k, j) = field_oldb(its, k, j) - ub*tempb31
        fieldb(its, k, j) = fieldb(its, k, j) + (ru(its+1, k, j)-ru(its&
&         , k, j))*tempb31
        rub(its+1, k, j) = rub(its+1, k, j) + tempb32
        rub(its, k, j) = rub(its, k, j) - tempb32
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + 0.5*ubb
          rub(its+1, k, j) = rub(its+1, k, j) + 0.5*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    fqxb = 0.0
    CALL POPINTEGER4(ad_from14)
    CALL POPINTEGER4(ad_to14)
    DO j=ad_to14,ad_from14,-1
      CALL POPCONTROL2B(branch)
      IF (branch .NE. 0) THEN
        IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from13)
            CALL POPINTEGER4(ad_to13)
            DO i=ad_to13,ad_from13,-1
              mrdx = msfux(i, j)*rdx
              fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
              fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from12)
            CALL POPINTEGER4(ad_to12)
            DO i=ad_to12,ad_from12,-1
              mrdx = msftx(i, j)*rdx
              fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
              fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
            END DO
          END DO
        END IF
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_to11)
        DO i=ad_to11,i_end_f+1,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp14 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&               , k, j)-field(i-1, k, j))
              temp16 = SIGN(1., vel)
              temp15 = temp16/12.
              tempb28 = vel*fqxb(i, k)
              tempb29 = 7.*tempb28/12.
              tempb30 = temp15*tempb28
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&               i+1, k, j)+field(i-2, k, j))/12.+temp15*temp14)*fqxb(i, &
&               k)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb29 - 3.*tempb30
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*tempb30 + &
&               tempb29
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + tempb30 - tempb28/&
&               12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - tempb30 - tempb28/&
&               12.
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              tempb27 = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&               1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb27
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + tempb27
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from11)
        DO i=i_start_f-1,ad_from11,-1
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) THEN
            DO k=ktf,kts,-1
              vel = ru(i, k, j)
              temp11 = field(i+1, k, j) - field(i-2, k, j) - 3.*(field(i&
&               , k, j)-field(i-1, k, j))
              temp13 = SIGN(1., vel)
              temp12 = temp13/12.
              tempb24 = vel*fqxb(i, k)
              tempb25 = 7.*tempb24/12.
              tempb26 = temp12*tempb24
              velb = (7.*((field(i, k, j)+field(i-1, k, j))/12.)-(field(&
&               i+1, k, j)+field(i-2, k, j))/12.+temp12*temp11)*fqxb(i, &
&               k)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb25 - 3.*tempb26
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + 3.*tempb26 + &
&               tempb25
              fieldb(i+1, k, j) = fieldb(i+1, k, j) + tempb26 - tempb24/&
&               12.
              fieldb(i-2, k, j) = fieldb(i-2, k, j) - tempb26 - tempb24/&
&               12.
              fqxb(i, k) = 0.0
              rub(i, k, j) = rub(i, k, j) + velb
            END DO
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              tempb23 = 0.5*ru(i, k, j)*fqxb(i, k)
              rub(i, k, j) = rub(i, k, j) + 0.5*(field(i, k, j)+field(i-&
&               1, k, j))*fqxb(i, k)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb23
              fieldb(i-1, k, j) = fieldb(i-1, k, j) + tempb23
              fqxb(i, k) = 0.0
            END DO
          END IF
        END DO
      END IF
      DO k=ktf,kts,-1
        DO i=i_end_f,i_start_f,-1
          wi0 = gi0/(eps+beta0)**pw
          wi1 = gi1/(eps+beta1)**pw
          wi2 = gi2/(eps+beta2)**pw
          sumwk = wi0 + wi1 + wi2
          vel = 0.5*(ru(i, k, j)+ru(i-is, k-ks, j-js))
          tempb15 = vel*fqxb(i, k)/sumwk
          tempb16 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k)/sumwk
          f0b = wi0*tempb15
          f1b = wi1*tempb15
          f2b = wi2*tempb15
          velb = tempb16
          sumwkb = -(vel*tempb16/sumwk)
          wi0b = sumwkb + f0*tempb15
          wi1b = sumwkb + f1*tempb15
          wi2b = sumwkb + f2*tempb15
          fqxb(i, k) = 0.0
          temp10 = (eps+beta2)**pw
          IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta2b = 0.0
          ELSE
            beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp10**2)
          END IF
          temp9 = (eps+beta1)**pw
          IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta1b = 0.0
          ELSE
            beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp9**2)
          END IF
          temp8 = (eps+beta0)**pw
          IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&             pw))) THEN
            beta0b = 0.0
          ELSE
            beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp8**2)
          END IF
          CALL POPREAL8(beta2)
          tempb17 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
          tempb18 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
          qip2b = tempb18 - f2b/6. + tempb17
          CALL POPREAL8(beta1)
          tempb19 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
          tempb22 = 2*(qim1-qip1)*beta1b/4.
          qip1b = tempb19 - tempb22 + f1b/3. + 5.*f2b/6. - 4.*tempb18 - &
&           2.*tempb17
          CALL POPREAL8(beta0)
          tempb21 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
          tempb20 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
          qib = f2b/3. - 2.*tempb19 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&           tempb20 + tempb21 + 3.*tempb18 + tempb17
          qim1b = tempb22 - 4.*tempb20 - 7.*f0b/6. - f1b/6. - 2.*tempb21&
&           + tempb19
          qim2b = f0b/3. + tempb20 + tempb21
          CALL POPREAL8(f2)
          CALL POPREAL8(f1)
          CALL POPREAL8(f0)
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(qim2)
            fieldb(i-3, k, j) = fieldb(i-3, k, j) + qim2b
            CALL POPREAL8(qim1)
            fieldb(i-2, k, j) = fieldb(i-2, k, j) + qim1b
            CALL POPREAL8(qi)
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + qib
            CALL POPREAL8(qip1)
            fieldb(i, k, j) = fieldb(i, k, j) + qip1b
            CALL POPREAL8(qip2)
            fieldb(i+1, k, j) = fieldb(i+1, k, j) + qip2b
          ELSE
            CALL POPREAL8(qim2)
            fieldb(i+2, k, j) = fieldb(i+2, k, j) + qim2b
            CALL POPREAL8(qim1)
            fieldb(i+1, k, j) = fieldb(i+1, k, j) + qim1b
            CALL POPREAL8(qi)
            fieldb(i, k, j) = fieldb(i, k, j) + qib
            CALL POPREAL8(qip1)
            fieldb(i-1, k, j) = fieldb(i-1, k, j) + qip1b
            CALL POPREAL8(qip2)
            fieldb(i-2, k, j) = fieldb(i-2, k, j) + qip2b
          END IF
          rub(i, k, j) = rub(i, k, j) + 0.5*velb
          rub(i-is, k-ks, j-js) = rub(i-is, k-ks, j-js) + 0.5*velb
        END DO
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    fqyb = 0.0
    CALL POPINTEGER4(ad_from10)
    CALL POPINTEGER4(ad_to10)
    DO j=ad_to10,ad_from10,-1
      CALL POPINTEGER4(jp0)
      CALL POPINTEGER4(jp1)
      CALL POPCONTROL4B(branch)
      IF (branch .LT. 4) THEN
        IF (branch .LT. 2) THEN
          IF (branch .EQ. 0) THEN
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from4)
              CALL POPINTEGER4(ad_to4)
              DO i=ad_to4,ad_from4,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k&
&                 , j-1)
              END DO
            END DO
          ELSE
            DO k=ktf,kts,-1
              CALL POPINTEGER4(ad_from5)
              CALL POPINTEGER4(ad_to5)
              DO i=ad_to5,ad_from5,-1
                mrdy = msftx(i, j-1)*rdy
                fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k&
&                 , j-1)
              END DO
            END DO
          END IF
        ELSE IF (branch .EQ. 2) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from6)
            CALL POPINTEGER4(ad_to6)
            DO i=ad_to6,ad_from6,-1
              mrdy = msftx(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&               -1)
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&               -1)
            END DO
          END DO
        END IF
      ELSE IF (branch .LT. 6) THEN
        IF (branch .EQ. 4) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from7)
            CALL POPINTEGER4(ad_to7)
            DO i=ad_to7,ad_from7,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j&
&               -1)
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from8)
            CALL POPINTEGER4(ad_to8)
            DO i=ad_to8,ad_from8,-1
              mrdy = msfux(i, j-1)*rdy
              fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j&
&               -1)
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 6) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from9)
          CALL POPINTEGER4(ad_to9)
          DO i=ad_to9,ad_from9,-1
            mrdy = msfux(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&             )
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&             )
          END DO
        END DO
      END IF
      CALL POPCONTROL3B(branch)
      IF (branch .LT. 3) THEN
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from)
            CALL POPINTEGER4(ad_to)
            DO i=ad_to,ad_from,-1
              wi0 = gi0/(eps+beta0)**pw
              wi1 = gi1/(eps+beta1)**pw
              wi2 = gi2/(eps+beta2)**pw
              sumwk = wi0 + wi1 + wi2
              vel = 0.5*(rv(i, k, j)+rv(i-is, k-ks, j-js))
              tempb = vel*fqyb(i, k, jp1)/sumwk
              tempb0 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, jp1)/sumwk
              f0b = wi0*tempb
              f1b = wi1*tempb
              f2b = wi2*tempb
              velb = tempb0
              sumwkb = -(vel*tempb0/sumwk)
              wi0b = sumwkb + f0*tempb
              wi1b = sumwkb + f1*tempb
              wi2b = sumwkb + f2*tempb
              fqyb(i, k, jp1) = 0.0
              temp1 = (eps+beta2)**pw
              IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. &
&                 INT(pw))) THEN
                beta2b = 0.0
              ELSE
                beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp1**2)
              END IF
              temp0 = (eps+beta1)**pw
              IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. &
&                 INT(pw))) THEN
                beta1b = 0.0
              ELSE
                beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp0**2)
              END IF
              temp = (eps+beta0)**pw
              IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. &
&                 INT(pw))) THEN
                beta0b = 0.0
              ELSE
                beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp**2)
              END IF
              CALL POPREAL8(beta2)
              tempb1 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
              tempb2 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
              qip2b = tempb2 - f2b/6. + tempb1
              CALL POPREAL8(beta1)
              tempb3 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
              tempb6 = 2*(qim1-qip1)*beta1b/4.
              qip1b = tempb3 - tempb6 + f1b/3. + 5.*f2b/6. - 4.*tempb2 -&
&               2.*tempb1
              CALL POPREAL8(beta0)
              tempb5 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
              tempb4 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
              qib = f2b/3. - 2.*tempb3 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&               tempb4 + tempb5 + 3.*tempb2 + tempb1
              qim1b = tempb6 - 4.*tempb4 - 7.*f0b/6. - f1b/6. - 2.*&
&               tempb5 + tempb3
              qim2b = f0b/3. + tempb4 + tempb5
              CALL POPREAL8(f2)
              CALL POPREAL8(f1)
              CALL POPREAL8(f0)
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) THEN
                CALL POPREAL8(qim2)
                fieldb(i, k, j-3) = fieldb(i, k, j-3) + qim2b
                CALL POPREAL8(qim1)
                fieldb(i, k, j-2) = fieldb(i, k, j-2) + qim1b
                CALL POPREAL8(qi)
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + qib
                CALL POPREAL8(qip1)
                fieldb(i, k, j) = fieldb(i, k, j) + qip1b
                CALL POPREAL8(qip2)
                fieldb(i, k, j+1) = fieldb(i, k, j+1) + qip2b
              ELSE
                CALL POPREAL8(qim2)
                fieldb(i, k, j+2) = fieldb(i, k, j+2) + qim2b
                CALL POPREAL8(qim1)
                fieldb(i, k, j+1) = fieldb(i, k, j+1) + qim1b
                CALL POPREAL8(qi)
                fieldb(i, k, j) = fieldb(i, k, j) + qib
                CALL POPREAL8(qip1)
                fieldb(i, k, j-1) = fieldb(i, k, j-1) + qip1b
                CALL POPREAL8(qip2)
                fieldb(i, k, j-2) = fieldb(i, k, j-2) + qip2b
              END IF
              rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
              rvb(i-is, k-ks, j-js) = rvb(i-is, k-ks, j-js) + 0.5*velb
            END DO
          END DO
        ELSE IF (branch .EQ. 1) THEN
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from0)
            CALL POPINTEGER4(ad_to0)
            DO i=ad_to0,ad_from0,-1
              tempb7 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
              rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i&
&               , k, j-1))*fqyb(i, k, jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb7
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + tempb7
              fqyb(i, k, jp1) = 0.0
            END DO
          END DO
        ELSE
          DO k=ktf,kts,-1
            CALL POPINTEGER4(ad_from1)
            CALL POPINTEGER4(ad_to1)
            DO i=ad_to1,ad_from1,-1
              vel = rv(i, k, j)
              temp2 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i&
&               , k, j)-field(i, k, j-1))
              temp4 = SIGN(1., vel)
              temp3 = temp4/12.
              tempb8 = vel*fqyb(i, k, jp1)
              tempb9 = 7.*tempb8/12.
              tempb10 = temp3*tempb8
              velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(&
&               i, k, j+1)+field(i, k, j-2))/12.+temp3*temp2)*fqyb(i, k&
&               , jp1)
              fieldb(i, k, j) = fieldb(i, k, j) + tempb9 - 3.*tempb10
              fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*tempb10 + &
&               tempb9
              fieldb(i, k, j+1) = fieldb(i, k, j+1) + tempb10 - tempb8/&
&               12.
              fieldb(i, k, j-2) = fieldb(i, k, j-2) - tempb10 - tempb8/&
&               12.
              fqyb(i, k, jp1) = 0.0
              rvb(i, k, j) = rvb(i, k, j) + velb
            END DO
          END DO
        END IF
      ELSE IF (branch .EQ. 3) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from2)
          CALL POPINTEGER4(ad_to2)
          DO i=ad_to2,ad_from2,-1
            tempb11 = 0.5*rv(i, k, j)*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + 0.5*(field(i, k, j)+field(i, k&
&             , j-1))*fqyb(i, k, jp1)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb11
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + tempb11
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
      ELSE IF (branch .EQ. 4) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from3)
          CALL POPINTEGER4(ad_to3)
          DO i=ad_to3,ad_from3,-1
            vel = rv(i, k, j)
            temp5 = field(i, k, j+1) - field(i, k, j-2) - 3.*(field(i, k&
&             , j)-field(i, k, j-1))
            temp7 = SIGN(1., vel)
            temp6 = temp7/12.
            tempb12 = vel*fqyb(i, k, jp1)
            tempb13 = 7.*tempb12/12.
            tempb14 = temp6*tempb12
            velb = (7.*((field(i, k, j)+field(i, k, j-1))/12.)-(field(i&
&             , k, j+1)+field(i, k, j-2))/12.+temp6*temp5)*fqyb(i, k, &
&             jp1)
            fieldb(i, k, j) = fieldb(i, k, j) + tempb13 - 3.*tempb14
            fieldb(i, k, j-1) = fieldb(i, k, j-1) + 3.*tempb14 + tempb13
            fieldb(i, k, j+1) = fieldb(i, k, j+1) + tempb14 - tempb12/&
&             12.
            fieldb(i, k, j-2) = fieldb(i, k, j-2) - tempb14 - tempb12/&
&             12.
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + velb
          END DO
        END DO
      END IF
    END DO
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      CALL POPCONTROL1B(branch)
      CALL POPCONTROL1B(branch)
    END IF
  END IF
END SUBROUTINE A_ADVECT_SCALAR_WENO

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_u in reverse (adjoint) mode:
!   gradient     of useful results: rom u tendency u_old ru rv
!                mut
!   with respect to varying inputs: rom u tendency u_old ru rv
!                mut
!   RW status of diff variables: rom:incr u:incr tendency:in-out
!                u_old:incr ru:incr rv:incr mut:incr
SUBROUTINE A_ADVECT_WENO_U(u, ub0, u_old, u_oldb, tendency, tendencyb, &
&  ru, rub, rv, rvb, rom, romb, mut, mutb, 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) :: ub0, u_oldb, rub, rvb, &
&  romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyb
  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 :: qim2b, qim1b, qib, qip1b, qip2b
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0b, beta1b, beta2b, f0b, f1b, f2b, wi0b, wi1b&
&  , wi2b, sumwkb
  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 :: ubb, vbb, vwb, dvmb, dvpb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its - 1:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its-1:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: temp3
  INTEGER :: temp29
  REAL :: temp2
  REAL :: temp28
  DOUBLE PRECISION :: temp1
  REAL :: temp27
  DOUBLE PRECISION :: temp0
  DOUBLE PRECISION :: temp13b
  REAL :: temp26
  REAL :: temp21b
  INTEGER :: temp25
  REAL :: temp24
  DOUBLE PRECISION :: temp23
  DOUBLE PRECISION :: temp22
  DOUBLE PRECISION :: temp21
  REAL :: temp20
  REAL :: temp13b5
  REAL :: temp13b4
  DOUBLE PRECISION :: temp24b
  REAL :: temp13b3
  REAL :: temp32b
  REAL :: temp13b2
  REAL :: temp13b1
  DOUBLE PRECISION :: temp13b0
  REAL :: tempb4
  REAL :: temp21b10
  REAL :: tempb3
  REAL :: temp28b1
  REAL :: tempb2
  REAL :: temp28b0
  REAL :: tempb1
  REAL :: tempb0
  INTRINSIC MAX
  INTRINSIC SIGN
  REAL :: temp2b5
  REAL :: temp2b4
  REAL :: temp19
  REAL :: temp2b3
  INTEGER :: temp18
  REAL :: temp2b2
  REAL :: temp17
  REAL :: temp2b1
  REAL :: temp16
  DOUBLE PRECISION :: temp2b0
  REAL :: temp6b
  REAL :: temp15
  INTEGER :: temp14
  REAL :: temp13
  REAL :: temp21b9
  DOUBLE PRECISION :: temp12
  REAL :: temp21b8
  DOUBLE PRECISION :: temp11
  REAL :: temp21b7
  DOUBLE PRECISION :: temp10
  REAL :: temp21b6
  REAL :: temp21b5
  REAL :: temp21b4
  REAL :: temp21b3
  REAL :: temp21b2
  REAL :: temp21b1
  REAL :: temp21b0
  REAL :: tempb
  REAL :: temp24b5
  DOUBLE PRECISION :: temp2b
  REAL :: temp24b4
  REAL :: temp24b3
  REAL :: temp24b2
  REAL :: temp24b1
  DOUBLE PRECISION :: temp24b0
  REAL :: temp17b3
  REAL :: temp17b2
  REAL :: temp17b1
  REAL :: temp17b0
  REAL :: temp31
  REAL :: temp30
  REAL :: temp17b
  INTRINSIC MIN
  REAL :: temp28b
  REAL :: temp6b3
  REAL :: temp6b2
  REAL :: temp6b1
  DOUBLE PRECISION :: temp
  REAL :: temp6b0
  REAL :: temp9
  REAL :: temp10b4
  REAL :: temp32b0
  REAL :: temp8
  REAL :: temp10b3
  INTEGER :: temp7
  REAL :: temp10b
  REAL :: temp10b2
  REAL :: temp6
  REAL :: temp10b1
  REAL :: temp5
  REAL :: temp10b0
  REAL :: temp4
  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
!  set order for vertical and horzontal flux operators
  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
  ad_from7 = j_start
j_loop_y_flux_5:DO j=ad_from7,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
! use full stencil
      DO k=kts,ktf
        ad_from = i_start
        DO i=ad_from,i_end
          vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            CALL PUSHREAL8(qip2)
            qip2 = u(i, k, j+1)
            CALL PUSHREAL8(qip1)
            qip1 = u(i, k, j)
            CALL PUSHREAL8(qi)
            qi = u(i, k, j-1)
            CALL PUSHREAL8(qim1)
            qim1 = u(i, k, j-2)
            CALL PUSHREAL8(qim2)
            qim2 = u(i, k, j-3)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(qip2)
            qip2 = u(i, k, j-2)
            CALL PUSHREAL8(qip1)
            qip1 = u(i, k, j-1)
            CALL PUSHREAL8(qi)
            qi = u(i, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = u(i, k, j+1)
            CALL PUSHREAL8(qim2)
            qim2 = u(i, k, j+2)
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(f0)
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          CALL PUSHREAL8(f1)
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          CALL PUSHREAL8(f2)
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          CALL PUSHREAL8(beta0)
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          CALL PUSHREAL8(beta1)
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          CALL PUSHREAL8(beta2)
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from)
      END DO
      CALL PUSHCONTROL3B(0)
    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
        ad_from0 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from0)
      END DO
      CALL PUSHCONTROL3B(1)
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        ad_from1 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from1)
      END DO
      CALL PUSHCONTROL3B(2)
    ELSE IF (j .EQ. jde - 1) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        ad_from2 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from2)
      END DO
      CALL PUSHCONTROL3B(3)
    ELSE IF (j .EQ. jde - 2) THEN
! 3rd order flux 2 in from north boundary
      DO k=kts,ktf
        ad_from3 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from3)
      END DO
      CALL PUSHCONTROL3B(4)
    ELSE
      CALL PUSHCONTROL3B(5)
    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
        ad_from4 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from4)
      END DO
      CALL PUSHCONTROL2B(0)
    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
        ad_from5 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from5)
      END DO
      CALL PUSHCONTROL2B(1)
    ELSE IF (j .GT. j_start) THEN
! normal code
      DO k=kts,ktf
        ad_from6 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from6)
      END DO
      CALL PUSHCONTROL2B(2)
    ELSE
      CALL PUSHCONTROL2B(3)
    END IF
    jtmp = jp1
    CALL PUSHINTEGER4(jp1)
    jp1 = jp0
    CALL PUSHINTEGER4(jp0)
    jp0 = jtmp
  END DO j_loop_y_flux_5
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from7)
!  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
  END IF
  ad_from9 = j_start
!  compute fluxes
  DO j=ad_from9,j_end
!  5th or 6th order flux
    DO k=kts,ktf
      CALL PUSHINTEGER4(i)
      DO i=i_start_f,i_end_f
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = u(i+1, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = u(i, k, j)
          CALL PUSHREAL8(qi)
          qi = u(i-1, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = u(i-2, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = u(i-3, k, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = u(i-2, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = u(i-1, k, j)
          CALL PUSHREAL8(qi)
          qi = u(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = u(i+1, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = u(i+2, k, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      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
        CALL PUSHINTEGER4(i)
! second order flux next to the boundary
        i = ids + 1
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i-1, k, j)
          IF (specified .AND. u(i, k, j) .LT. 0.) THEN
            ub = u(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHCONTROL1B(1)
      END IF
      CALL PUSHINTEGER4(i)
      i = ids + 2
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (degrade_xe) THEN
      IF (i_end .EQ. ide - 1) THEN
        CALL PUSHINTEGER4(i)
! second order flux next to the boundary
        i = ide
        DO k=kts,ktf
          CALL PUSHREAL8(ub)
          ub = u(i, k, j)
          IF (specified .AND. u(i-1, k, j) .GT. 0.) THEN
            ub = u(i-1, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      DO k=kts,ktf
        CALL PUSHINTEGER4(i)
      END DO
      CALL PUSHCONTROL1B(1)
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
!  x flux-divergence into tendency
    DO k=kts,ktf
      ad_from8 = i_start
      CALL PUSHINTEGER4(i)
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from8)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from9)
!  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
    ad_from10 = j_start
    DO j=ad_from10,j_end
      DO k=kts,ktf
        IF (ru(its, k, j) - cb*mut(its, j) .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = ru(its, k, j) - cb*mut(its, j)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from10)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  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
    ad_from11 = j_start
    DO j=ad_from11,j_end
      DO k=kts,ktf
        IF (ru(ite, k, j) + cb*mut(ite-1, j) .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = ru(ite, k, j) + cb*mut(ite-1, j)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from11)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(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) 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
    ad_from12 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from12,i_end
      CALL PUSHREAL8(mrdy)
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jts)*rdy
      IF (imax .GT. i) THEN
        CALL PUSHINTEGER4(ip)
        ip = i
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(ip)
        ip = imax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (imin .LT. i - 1) THEN
        CALL PUSHINTEGER4(im)
        im = i - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(im)
        im = imin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        vw = 0.5*(rv(ip, k, jts)+rv(im, k, jts))
        IF (vw .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from12)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from13 = i_start
    CALL PUSHINTEGER4(i)
    DO i=ad_from13,i_end
      CALL PUSHREAL8(mrdy)
! ADT eqn 44, 2nd term on RHS
      mrdy = msfux(i, jte-1)*rdy
      IF (imax .GT. i) THEN
        CALL PUSHINTEGER4(ip)
        ip = i
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(ip)
        ip = imax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (imin .LT. i - 1) THEN
        CALL PUSHINTEGER4(im)
        im = i - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(im)
        im = imin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        vw = 0.5*(rv(ip, k, jte)+rv(im, k, jte))
        IF (vw .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from13)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
!   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
      CALL PUSHINTEGER4(i)
      DO i=i_start,i_end
        vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = u(i, k+1, j)
          CALL PUSHREAL8(qip1)
          qip1 = u(i, k, j)
          CALL PUSHREAL8(qi)
          qi = u(i, k-1, j)
          CALL PUSHREAL8(qim1)
          qim1 = u(i, k-2, j)
          CALL PUSHREAL8(qim2)
          qim2 = u(i, k-3, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = u(i, k-2, j)
          CALL PUSHREAL8(qip1)
          qip1 = u(i, k-1, j)
          CALL PUSHREAL8(qi)
          qi = u(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = u(i, k+1, j)
          CALL PUSHREAL8(qim2)
          qim2 = u(i, k+2, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      END DO
    END DO
    CALL PUSHINTEGER4(i)
    CALL PUSHINTEGER4(k)
  END DO
  vfluxb = 0.0
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k+1) = vfluxb(i, k+1) - rdzw(k)*tendencyb(i, k, j)
        vfluxb(i, k) = vfluxb(i, k) + rdzw(k)*tendencyb(i, k, j)
      END DO
    END DO
    CALL POPINTEGER4(k)
    DO i=i_end,i_start,-1
      k = ktf
      temp32b = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i, k)
      temp32b0 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp32b
      romb(i-1, k, j) = romb(i-1, k, j) + temp32b
      ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp32b0
      ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp32b0
      vfluxb(i, k) = 0.0
      k = ktf - 1
      vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
      temp28 = u(i, k+1, j) - u(i, k-2, j) - 3.*(u(i, k, j)-u(i, k-1, j)&
&        )
      temp31 = SIGN(1., -vel)
      temp30 = temp31/12.0
      temp29 = SIGN(1, time_step)
      temp28b = vel*vfluxb(i, k)
      temp28b0 = temp28b/12.0
      temp28b1 = temp29*temp30*temp28b
      velb = ((7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))/&
&        12.0+temp29*(temp30*temp28))*vfluxb(i, k)
      ub0(i, k, j) = ub0(i, k, j) + 7.*temp28b0 - 3.*temp28b1
      ub0(i, k-1, j) = ub0(i, k-1, j) + 3.*temp28b1 + 7.*temp28b0
      ub0(i, k+1, j) = ub0(i, k+1, j) + temp28b1 - temp28b0
      ub0(i, k-2, j) = ub0(i, k-2, j) - temp28b1 - temp28b0
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
      k = kts + 2
      vel = 0.5*(rom(i, k, j)+rom(i-1, k, j))
      temp24 = u(i, k+1, j) - u(i, k-2, j) - 3.*(u(i, k, j)-u(i, k-1, j)&
&        )
      temp27 = SIGN(1., -vel)
      temp26 = temp27/12.0
      temp25 = SIGN(1, time_step)
      temp24b1 = vel*vfluxb(i, k)
      temp24b2 = temp24b1/12.0
      temp24b3 = temp25*temp26*temp24b1
      velb = ((7.*(u(i, k, j)+u(i, k-1, j))-u(i, k+1, j)-u(i, k-2, j))/&
&        12.0+temp25*(temp26*temp24))*vfluxb(i, k)
      ub0(i, k, j) = ub0(i, k, j) + 7.*temp24b2 - 3.*temp24b3
      ub0(i, k-1, j) = ub0(i, k-1, j) + 3.*temp24b3 + 7.*temp24b2
      ub0(i, k+1, j) = ub0(i, k+1, j) + temp24b3 - temp24b2
      ub0(i, k-2, j) = ub0(i, k-2, j) - temp24b3 - temp24b2
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
      k = kts + 1
      temp24b4 = 0.5*(fzm(k)*u(i, k, j)+fzp(k)*u(i, k-1, j))*vfluxb(i, k&
&        )
      temp24b5 = 0.5*(rom(i, k, j)+rom(i-1, k, j))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp24b4
      romb(i-1, k, j) = romb(i-1, k, j) + temp24b4
      ub0(i, k, j) = ub0(i, k, j) + fzm(k)*temp24b5
      ub0(i, k-1, j) = ub0(i, k-1, j) + fzp(k)*temp24b5
      vfluxb(i, k) = 0.0
    END DO
    CALL POPINTEGER4(i)
    DO k=ktf-2,kts+3,-1
      DO i=i_end,i_start,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(rom(i-1, k, j)+rom(i, k, j))
        temp24b = vel*vfluxb(i, k)/sumwk
        temp24b0 = (wi0*f0+wi1*f1+wi2*f2)*vfluxb(i, k)/sumwk
        f0b = wi0*temp24b
        f1b = wi1*temp24b
        f2b = wi2*temp24b
        velb = temp24b0
        sumwkb = -(vel*temp24b0/sumwk)
        wi0b = sumwkb + f0*temp24b
        wi1b = sumwkb + f1*temp24b
        wi2b = sumwkb + f2*temp24b
        vfluxb(i, k) = 0.0
        temp23 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp23**2)
        END IF
        temp22 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp22**2)
        END IF
        temp21 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp21**2)
        END IF
        CALL POPREAL8(beta2)
        temp21b5 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp21b6 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp21b6 - f2b/6. + temp21b5
        CALL POPREAL8(beta1)
        temp21b7 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp21b10 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp21b7 - temp21b10 + f1b/3. + 5.*f2b/6. - 4.*temp21b6 &
&          - 2.*temp21b5
        CALL POPREAL8(beta0)
        temp21b9 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp21b8 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp21b7 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp21b8 + temp21b9 + 3.*temp21b6 + temp21b5
        qim1b = temp21b10 - 4.*temp21b8 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp21b9 + temp21b7
        qim2b = f0b/3. + temp21b8 + temp21b9
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          ub0(i, k-3, j) = ub0(i, k-3, j) + qim2b
          CALL POPREAL8(qim1)
          ub0(i, k-2, j) = ub0(i, k-2, j) + qim1b
          CALL POPREAL8(qi)
          ub0(i, k-1, j) = ub0(i, k-1, j) + qib
          CALL POPREAL8(qip1)
          ub0(i, k, j) = ub0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          ub0(i, k+1, j) = ub0(i, k+1, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          ub0(i, k+2, j) = ub0(i, k+2, j) + qim2b
          CALL POPREAL8(qim1)
          ub0(i, k+1, j) = ub0(i, k+1, j) + qim1b
          CALL POPREAL8(qi)
          ub0(i, k, j) = ub0(i, k, j) + qib
          CALL POPREAL8(qip1)
          ub0(i, k-1, j) = ub0(i, k-1, j) + qip1b
          CALL POPREAL8(qip2)
          ub0(i, k-2, j) = ub0(i, k-2, j) + qip2b
        END IF
        romb(i-1, k, j) = romb(i-1, k, j) + 0.5*velb
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
      END DO
      CALL POPINTEGER4(i)
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from13)
    CALL POPINTEGER4(ad_to13)
    DO i=ad_to13,ad_from13,-1
      DO k=ktf,kts,-1
        dvm = rv(ip, k, jte) - rv(ip, k, jte-1)
        dvp = rv(im, k, jte) - rv(im, k, jte-1)
        temp21b3 = -(mrdy*tendencyb(i, k, jte-1))
        temp21b4 = 0.5*u(i, k, jte-1)*temp21b3
        vbb = (u_old(i, k, jte-1)-u_old(i, k, jte-2))*temp21b3
        u_oldb(i, k, jte-1) = u_oldb(i, k, jte-1) + vb*temp21b3
        u_oldb(i, k, jte-2) = u_oldb(i, k, jte-2) - vb*temp21b3
        ub0(i, k, jte-1) = ub0(i, k, jte-1) + 0.5*(dvm+dvp)*temp21b3
        dvmb = temp21b4
        dvpb = temp21b4
        rvb(im, k, jte) = rvb(im, k, jte) + dvpb
        rvb(im, k, jte-1) = rvb(im, k, jte-1) - dvpb
        rvb(ip, k, jte) = rvb(ip, k, jte) + dvmb
        rvb(ip, k, jte-1) = rvb(ip, k, jte-1) - dvmb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        rvb(ip, k, jte) = rvb(ip, k, jte) + 0.5*vwb
        rvb(im, k, jte) = rvb(im, k, jte) + 0.5*vwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(im)
      ELSE
        CALL POPINTEGER4(im)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ip)
      ELSE
        CALL POPINTEGER4(ip)
      END IF
      CALL POPREAL8(mrdy)
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from12)
    CALL POPINTEGER4(ad_to12)
    DO i=ad_to12,ad_from12,-1
      DO k=ktf,kts,-1
        dvm = rv(ip, k, jts+1) - rv(ip, k, jts)
        dvp = rv(im, k, jts+1) - rv(im, k, jts)
        temp21b1 = -(mrdy*tendencyb(i, k, jts))
        temp21b2 = 0.5*u(i, k, jts)*temp21b1
        vbb = (u_old(i, k, jts+1)-u_old(i, k, jts))*temp21b1
        u_oldb(i, k, jts+1) = u_oldb(i, k, jts+1) + vb*temp21b1
        u_oldb(i, k, jts) = u_oldb(i, k, jts) - vb*temp21b1
        ub0(i, k, jts) = ub0(i, k, jts) + 0.5*(dvm+dvp)*temp21b1
        dvmb = temp21b2
        dvpb = temp21b2
        rvb(im, k, jts+1) = rvb(im, k, jts+1) + dvpb
        rvb(im, k, jts) = rvb(im, k, jts) - dvpb
        rvb(ip, k, jts+1) = rvb(ip, k, jts+1) + dvmb
        rvb(ip, k, jts) = rvb(ip, k, jts) - dvmb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        rvb(ip, k, jts) = rvb(ip, k, jts) + 0.5*vwb
        rvb(im, k, jts) = rvb(im, k, jts) + 0.5*vwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(im)
      ELSE
        CALL POPINTEGER4(im)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ip)
      ELSE
        CALL POPINTEGER4(ip)
      END IF
      CALL POPREAL8(mrdy)
    END DO
    CALL POPINTEGER4(i)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from11)
    CALL POPINTEGER4(ad_to11)
    DO j=ad_to11,ad_from11,-1
      DO k=ktf,kts,-1
        temp21b0 = -(rdx*tendencyb(ite, k, j))
        ubb = (u_old(ite, k, j)-u_old(ite-1, k, j))*temp21b0
        u_oldb(ite, k, j) = u_oldb(ite, k, j) + ub*temp21b0
        u_oldb(ite-1, k, j) = u_oldb(ite-1, k, j) - ub*temp21b0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(ite, k, j) = rub(ite, k, j) + ubb
          mutb(ite-1, j) = mutb(ite-1, j) + cb*ubb
        END IF
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from10)
    CALL POPINTEGER4(ad_to10)
    DO j=ad_to10,ad_from10,-1
      DO k=ktf,kts,-1
        temp21b = -(rdx*tendencyb(its, k, j))
        ubb = (u_old(its+1, k, j)-u_old(its, k, j))*temp21b
        u_oldb(its+1, k, j) = u_oldb(its+1, k, j) + ub*temp21b
        u_oldb(its, k, j) = u_oldb(its, k, j) - ub*temp21b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
        ELSE
          CALL POPREAL8(ub)
          rub(its, k, j) = rub(its, k, j) + ubb
          mutb(its, j) = mutb(its, j) - cb*ubb
        END IF
      END DO
    END DO
  END IF
  fqxb = 0.0
  CALL POPINTEGER4(ad_from9)
  CALL POPINTEGER4(ad_to9)
  DO j=ad_to9,ad_from9,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from8)
      CALL POPINTEGER4(ad_to8)
      DO i=ad_to8,ad_from8,-1
        mrdx = msfux(i, j)*rdx
        fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
        fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
      END DO
      CALL POPINTEGER4(i)
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      DO k=ktf,kts,-1
        i = ide - 1
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        temp17 = u(i+1, k, j) - u(i-2, k, j) - 3.*(u(i, k, j)-u(i-1, k, &
&          j))
        temp20 = SIGN(1., vel)
        temp19 = temp20/12.0
        temp18 = SIGN(1, time_step)
        temp17b1 = vel*fqxb(i, k)
        temp17b2 = temp17b1/12.0
        temp17b3 = temp18*temp19*temp17b1
        velb = ((7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, j))&
&          /12.0+temp18*(temp19*temp17))*fqxb(i, k)
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp17b2 - 3.*temp17b3
        ub0(i-1, k, j) = ub0(i-1, k, j) + 3.*temp17b3 + 7.*temp17b2
        ub0(i+1, k, j) = ub0(i+1, k, j) + temp17b3 - temp17b2
        ub0(i-2, k, j) = ub0(i-2, k, j) - temp17b3 - temp17b2
        fqxb(i, k) = 0.0
        rub(i, k, j) = rub(i, k, j) + 0.5*velb
        rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
        CALL POPINTEGER4(i)
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        DO k=ktf,kts,-1
          temp17b = 0.25*(u(i-1, k, j)+ub)*fqxb(i, k)
          temp17b0 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
          rub(i, k, j) = rub(i, k, j) + temp17b
          rub(i-1, k, j) = rub(i-1, k, j) + temp17b
          ub0(i-1, k, j) = ub0(i-1, k, j) + temp17b0
          ubb = temp17b0
          fqxb(i, k) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i, k, j) = ub0(i, k, j) + ubb
        END DO
        CALL POPINTEGER4(i)
      END IF
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,kts,-1
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        temp13 = u(i+1, k, j) - u(i-2, k, j) - 3.*(u(i, k, j)-u(i-1, k, &
&          j))
        temp16 = SIGN(1., vel)
        temp15 = temp16/12.0
        temp14 = SIGN(1, time_step)
        temp13b3 = vel*fqxb(i, k)
        temp13b4 = temp13b3/12.0
        temp13b5 = temp14*temp15*temp13b3
        velb = ((7.*(u(i, k, j)+u(i-1, k, j))-u(i+1, k, j)-u(i-2, k, j))&
&          /12.0+temp14*(temp15*temp13))*fqxb(i, k)
        ub0(i, k, j) = ub0(i, k, j) + 7.*temp13b4 - 3.*temp13b5
        ub0(i-1, k, j) = ub0(i-1, k, j) + 3.*temp13b5 + 7.*temp13b4
        ub0(i+1, k, j) = ub0(i+1, k, j) + temp13b5 - temp13b4
        ub0(i-2, k, j) = ub0(i-2, k, j) - temp13b5 - temp13b4
        fqxb(i, k) = 0.0
        rub(i, k, j) = rub(i, k, j) + 0.5*velb
        rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
      END DO
      CALL POPINTEGER4(i)
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          temp13b1 = 0.25*(u(i, k, j)+ub)*fqxb(i, k)
          temp13b2 = 0.25*(ru(i, k, j)+ru(i-1, k, j))*fqxb(i, k)
          rub(i, k, j) = rub(i, k, j) + temp13b1
          rub(i-1, k, j) = rub(i-1, k, j) + temp13b1
          ub0(i, k, j) = ub0(i, k, j) + temp13b2
          ubb = temp13b2
          fqxb(i, k) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            ub0(i, k, j) = ub0(i, k, j) + ubb
            ubb = 0.0
          END IF
          CALL POPREAL8(ub)
          ub0(i-1, k, j) = ub0(i-1, k, j) + ubb
        END DO
        CALL POPINTEGER4(i)
      END IF
    END IF
    DO k=ktf,kts,-1
      DO i=i_end_f,i_start_f,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(ru(i, k, j)+ru(i-1, k, j))
        temp13b = vel*fqxb(i, k)/sumwk
        temp13b0 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k)/sumwk
        f0b = wi0*temp13b
        f1b = wi1*temp13b
        f2b = wi2*temp13b
        velb = temp13b0
        sumwkb = -(vel*temp13b0/sumwk)
        wi0b = sumwkb + f0*temp13b
        wi1b = sumwkb + f1*temp13b
        wi2b = sumwkb + f2*temp13b
        fqxb(i, k) = 0.0
        temp12 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp12**2)
        END IF
        temp11 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp11**2)
        END IF
        temp10 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp10**2)
        END IF
        CALL POPREAL8(beta2)
        temp10b = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp10b0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp10b0 - f2b/6. + temp10b
        CALL POPREAL8(beta1)
        temp10b1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp10b4 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp10b1 - temp10b4 + f1b/3. + 5.*f2b/6. - 4.*temp10b0 -&
&          2.*temp10b
        CALL POPREAL8(beta0)
        temp10b3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp10b2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp10b1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp10b2 + temp10b3 + 3.*temp10b0 + temp10b
        qim1b = temp10b4 - 4.*temp10b2 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp10b3 + temp10b1
        qim2b = f0b/3. + temp10b2 + temp10b3
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          ub0(i-3, k, j) = ub0(i-3, k, j) + qim2b
          CALL POPREAL8(qim1)
          ub0(i-2, k, j) = ub0(i-2, k, j) + qim1b
          CALL POPREAL8(qi)
          ub0(i-1, k, j) = ub0(i-1, k, j) + qib
          CALL POPREAL8(qip1)
          ub0(i, k, j) = ub0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          ub0(i+1, k, j) = ub0(i+1, k, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          ub0(i+2, k, j) = ub0(i+2, k, j) + qim2b
          CALL POPREAL8(qim1)
          ub0(i+1, k, j) = ub0(i+1, k, j) + qim1b
          CALL POPREAL8(qi)
          ub0(i, k, j) = ub0(i, k, j) + qib
          CALL POPREAL8(qip1)
          ub0(i-1, k, j) = ub0(i-1, k, j) + qip1b
          CALL POPREAL8(qip2)
          ub0(i-2, k, j) = ub0(i-2, k, j) + qip2b
        END IF
        rub(i, k, j) = rub(i, k, j) + 0.5*velb
        rub(i-1, k, j) = rub(i-1, k, j) + 0.5*velb
      END DO
      CALL POPINTEGER4(i)
    END DO
  END DO
  fqyb = 0.0
  CALL POPINTEGER4(ad_from7)
  CALL POPINTEGER4(ad_to7)
  DO j=ad_to7,ad_from7,-1
    CALL POPINTEGER4(jp0)
    CALL POPINTEGER4(jp1)
    CALL POPCONTROL2B(branch)
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from4)
          CALL POPINTEGER4(ad_to4)
          DO i=ad_to4,ad_from4,-1
            mrdy = msfux(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from5)
          CALL POPINTEGER4(ad_to5)
          DO i=ad_to5,ad_from5,-1
            mrdy = msfux(i, j-1)*rdy
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
      END IF
    ELSE IF (branch .EQ. 2) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from6)
        CALL POPINTEGER4(ad_to6)
        DO i=ad_to6,ad_from6,-1
          mrdy = msfux(i, j-1)*rdy
          fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1)
          fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1)
        END DO
      END DO
    END IF
    CALL POPCONTROL3B(branch)
    IF (branch .LT. 3) THEN
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from)
          CALL POPINTEGER4(ad_to)
          DO i=ad_to,ad_from,-1
            wi0 = gi0/(eps+beta0)**pw
            wi1 = gi1/(eps+beta1)**pw
            wi2 = gi2/(eps+beta2)**pw
            sumwk = wi0 + wi1 + wi2
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            temp2b = vel*fqyb(i, k, jp1)/sumwk
            temp2b0 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, jp1)/sumwk
            f0b = wi0*temp2b
            f1b = wi1*temp2b
            f2b = wi2*temp2b
            velb = temp2b0
            sumwkb = -(vel*temp2b0/sumwk)
            wi0b = sumwkb + f0*temp2b
            wi1b = sumwkb + f1*temp2b
            wi2b = sumwkb + f2*temp2b
            fqyb(i, k, jp1) = 0.0
            temp1 = (eps+beta2)**pw
            IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta2b = 0.0
            ELSE
              beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp1**2)
            END IF
            temp0 = (eps+beta1)**pw
            IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta1b = 0.0
            ELSE
              beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp0**2)
            END IF
            temp = (eps+beta0)**pw
            IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta0b = 0.0
            ELSE
              beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp**2)
            END IF
            CALL POPREAL8(beta2)
            tempb = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
            tempb0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
            qip2b = tempb0 - f2b/6. + tempb
            CALL POPREAL8(beta1)
            tempb1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
            tempb4 = 2*(qim1-qip1)*beta1b/4.
            qip1b = tempb1 - tempb4 + f1b/3. + 5.*f2b/6. - 4.*tempb0 - &
&              2.*tempb
            CALL POPREAL8(beta0)
            tempb3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
            tempb2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
            qib = f2b/3. - 2.*tempb1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&              tempb2 + tempb3 + 3.*tempb0 + tempb
            qim1b = tempb4 - 4.*tempb2 - 7.*f0b/6. - f1b/6. - 2.*tempb3 &
&              + tempb1
            qim2b = f0b/3. + tempb2 + tempb3
            CALL POPREAL8(f2)
            CALL POPREAL8(f1)
            CALL POPREAL8(f0)
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(qim2)
              ub0(i, k, j-3) = ub0(i, k, j-3) + qim2b
              CALL POPREAL8(qim1)
              ub0(i, k, j-2) = ub0(i, k, j-2) + qim1b
              CALL POPREAL8(qi)
              ub0(i, k, j-1) = ub0(i, k, j-1) + qib
              CALL POPREAL8(qip1)
              ub0(i, k, j) = ub0(i, k, j) + qip1b
              CALL POPREAL8(qip2)
              ub0(i, k, j+1) = ub0(i, k, j+1) + qip2b
            ELSE
              CALL POPREAL8(qim2)
              ub0(i, k, j+2) = ub0(i, k, j+2) + qim2b
              CALL POPREAL8(qim1)
              ub0(i, k, j+1) = ub0(i, k, j+1) + qim1b
              CALL POPREAL8(qi)
              ub0(i, k, j) = ub0(i, k, j) + qib
              CALL POPREAL8(qip1)
              ub0(i, k, j-1) = ub0(i, k, j-1) + qip1b
              CALL POPREAL8(qip2)
              ub0(i, k, j-2) = ub0(i, k, j-2) + qip2b
            END IF
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
          END DO
        END DO
      ELSE IF (branch .EQ. 1) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from0)
          CALL POPINTEGER4(ad_to0)
          DO i=ad_to0,ad_from0,-1
            temp2b1 = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
            temp2b2 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + temp2b1
            rvb(i-1, k, j) = rvb(i-1, k, j) + temp2b1
            ub0(i, k, j) = ub0(i, k, j) + temp2b2
            ub0(i, k, j-1) = ub0(i, k, j-1) + temp2b2
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from1)
          CALL POPINTEGER4(ad_to1)
          DO i=ad_to1,ad_from1,-1
            vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
            temp2 = u(i, k, j+1) - u(i, k, j-2) - 3.*(u(i, k, j)-u(i, k&
&              , j-1))
            temp5 = SIGN(1., vel)
            temp4 = temp5/12.0
            temp3 = SIGN(1, time_step)
            temp2b3 = vel*fqyb(i, k, jp1)
            temp2b4 = temp2b3/12.0
            temp2b5 = temp3*temp4*temp2b3
            velb = ((7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k, j&
&              -2))/12.0+temp3*(temp4*temp2))*fqyb(i, k, jp1)
            ub0(i, k, j) = ub0(i, k, j) + 7.*temp2b4 - 3.*temp2b5
            ub0(i, k, j-1) = ub0(i, k, j-1) + 3.*temp2b5 + 7.*temp2b4
            ub0(i, k, j+1) = ub0(i, k, j+1) + temp2b5 - temp2b4
            ub0(i, k, j-2) = ub0(i, k, j-2) - temp2b5 - temp2b4
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
          END DO
        END DO
      END IF
    ELSE IF (branch .EQ. 3) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from2)
        CALL POPINTEGER4(ad_to2)
        DO i=ad_to2,ad_from2,-1
          temp6b = 0.25*(u(i, k, j)+u(i, k, j-1))*fqyb(i, k, jp1)
          temp6b0 = 0.25*(rv(i, k, j)+rv(i-1, k, j))*fqyb(i, k, jp1)
          rvb(i, k, j) = rvb(i, k, j) + temp6b
          rvb(i-1, k, j) = rvb(i-1, k, j) + temp6b
          ub0(i, k, j) = ub0(i, k, j) + temp6b0
          ub0(i, k, j-1) = ub0(i, k, j-1) + temp6b0
          fqyb(i, k, jp1) = 0.0
        END DO
      END DO
    ELSE IF (branch .EQ. 4) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from3)
        CALL POPINTEGER4(ad_to3)
        DO i=ad_to3,ad_from3,-1
          vel = 0.5*(rv(i, k, j)+rv(i-1, k, j))
          temp6 = u(i, k, j+1) - u(i, k, j-2) - 3.*(u(i, k, j)-u(i, k, j&
&            -1))
          temp9 = SIGN(1., vel)
          temp8 = temp9/12.0
          temp7 = SIGN(1, time_step)
          temp6b1 = vel*fqyb(i, k, jp1)
          temp6b2 = temp6b1/12.0
          temp6b3 = temp7*temp8*temp6b1
          velb = ((7.*(u(i, k, j)+u(i, k, j-1))-u(i, k, j+1)-u(i, k, j-2&
&            ))/12.0+temp7*(temp8*temp6))*fqyb(i, k, jp1)
          ub0(i, k, j) = ub0(i, k, j) + 7.*temp6b2 - 3.*temp6b3
          ub0(i, k, j-1) = ub0(i, k, j-1) + 3.*temp6b3 + 7.*temp6b2
          ub0(i, k, j+1) = ub0(i, k, j+1) + temp6b3 - temp6b2
          ub0(i, k, j-2) = ub0(i, k, j-2) - temp6b3 - temp6b2
          fqyb(i, k, jp1) = 0.0
          rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
          rvb(i-1, k, j) = rvb(i-1, k, j) + 0.5*velb
        END DO
      END DO
    END IF
  END DO
END SUBROUTINE A_ADVECT_WENO_U

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_v in reverse (adjoint) mode:
!   gradient     of useful results: rom tendency v v_old ru rv
!                mut
!   with respect to varying inputs: rom tendency v v_old ru rv
!                mut
!   RW status of diff variables: rom:incr tendency:in-out v:incr
!                v_old:incr ru:incr rv:incr mut:incr
SUBROUTINE A_ADVECT_WENO_V(v, vb0, v_old, v_oldb, tendency, tendencyb, &
&  ru, rub, rv, rvb, rom, romb, mut, mutb, 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) :: vb0, v_oldb, rub, rvb, &
&  romb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendencyb
  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 :: qim2b, qim1b, qib, qip1b, qip2b
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0b, beta1b, beta2b, f0b, f1b, f2b, wi0b, wi1b&
&  , wi2b, sumwkb
  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 :: ubb, vbb, uwb, dupb, dumb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  REAL, DIMENSION(its:ite + 1, kts:kte) :: fqx
  REAL, DIMENSION(its:ite+1, kts:kte) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: temp3
  INTEGER :: temp29
  REAL :: temp2
  REAL :: temp28
  DOUBLE PRECISION :: temp1
  REAL :: temp27
  DOUBLE PRECISION :: temp0
  DOUBLE PRECISION :: temp13b
  REAL :: temp26
  REAL :: temp21b
  INTEGER :: temp25
  REAL :: temp24
  DOUBLE PRECISION :: temp23
  DOUBLE PRECISION :: temp22
  DOUBLE PRECISION :: temp21
  REAL :: temp20
  REAL :: temp13b5
  REAL :: temp13b4
  DOUBLE PRECISION :: temp24b
  REAL :: temp13b3
  REAL :: temp32b
  REAL :: temp13b2
  REAL :: temp13b1
  DOUBLE PRECISION :: temp13b0
  REAL :: tempb4
  REAL :: temp21b10
  REAL :: tempb3
  REAL :: temp28b1
  REAL :: tempb2
  REAL :: temp28b0
  REAL :: tempb1
  REAL :: tempb0
  INTRINSIC MAX
  INTRINSIC SIGN
  REAL :: temp2b5
  REAL :: temp2b4
  REAL :: temp19
  REAL :: temp2b3
  INTEGER :: temp18
  REAL :: temp2b2
  REAL :: temp17
  REAL :: temp2b1
  REAL :: temp16
  DOUBLE PRECISION :: temp2b0
  REAL :: temp6b
  REAL :: temp15
  INTEGER :: temp14
  REAL :: temp13
  REAL :: temp21b9
  DOUBLE PRECISION :: temp12
  REAL :: temp21b8
  DOUBLE PRECISION :: temp11
  REAL :: temp21b7
  DOUBLE PRECISION :: temp10
  REAL :: temp21b6
  REAL :: temp21b5
  REAL :: temp21b4
  REAL :: temp21b3
  REAL :: temp21b2
  REAL :: temp21b1
  REAL :: temp21b0
  REAL :: tempb
  REAL :: temp24b5
  DOUBLE PRECISION :: temp2b
  REAL :: temp24b4
  REAL :: temp24b3
  REAL :: temp24b2
  REAL :: temp24b1
  DOUBLE PRECISION :: temp24b0
  REAL :: temp17b3
  REAL :: temp17b2
  REAL :: temp17b1
  REAL :: temp17b0
  REAL :: temp31
  REAL :: temp30
  REAL :: temp17b
  INTRINSIC MIN
  REAL :: temp28b
  REAL :: temp6b3
  REAL :: temp6b2
  REAL :: temp6b1
  DOUBLE PRECISION :: temp
  REAL :: temp6b0
  REAL :: temp32b1
  REAL :: temp9
  REAL :: temp10b4
  REAL :: temp32b0
  REAL :: temp8
  REAL :: temp10b3
  INTEGER :: temp7
  REAL :: temp10b
  REAL :: temp10b2
  REAL :: temp6
  REAL :: temp10b1
  REAL :: temp5
  REAL :: temp10b0
  REAL :: temp4
  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
!  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
  ad_from7 = j_start
j_loop_y_flux_5:DO j=ad_from7,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
      DO k=kts,ktf
        ad_from = i_start
        DO i=ad_from,i_end
          vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            CALL PUSHREAL8(qip2)
            qip2 = v(i, k, j+1)
            CALL PUSHREAL8(qip1)
            qip1 = v(i, k, j)
            CALL PUSHREAL8(qi)
            qi = v(i, k, j-1)
            CALL PUSHREAL8(qim1)
            qim1 = v(i, k, j-2)
            CALL PUSHREAL8(qim2)
            qim2 = v(i, k, j-3)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(qip2)
            qip2 = v(i, k, j-2)
            CALL PUSHREAL8(qip1)
            qip1 = v(i, k, j-1)
            CALL PUSHREAL8(qi)
            qi = v(i, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = v(i, k, j+1)
            CALL PUSHREAL8(qim2)
            qim2 = v(i, k, j+2)
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(f0)
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          CALL PUSHREAL8(f1)
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          CALL PUSHREAL8(f2)
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          CALL PUSHREAL8(beta0)
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          CALL PUSHREAL8(beta1)
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          CALL PUSHREAL8(beta2)
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from)
      END DO
      CALL PUSHCONTROL3B(0)
    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
        ad_from0 = i_start
        DO i=ad_from0,i_end
          CALL PUSHREAL8(vb)
          vb = v(i, k, j-1)
          IF (specified .AND. v(i, k, j) .LT. 0.) THEN
            vb = v(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from0)
      END DO
      CALL PUSHCONTROL3B(1)
    ELSE IF (j .EQ. jds + 2) THEN
! third of 4th order flux 2 in from south boundary
      DO k=kts,ktf
        ad_from1 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from1)
      END DO
      CALL PUSHCONTROL3B(2)
    ELSE IF (j .EQ. jde) THEN
! 2nd order flux next to north boundary
      DO k=kts,ktf
        ad_from2 = i_start
        DO i=ad_from2,i_end
          CALL PUSHREAL8(vb)
          vb = v(i, k, j)
          IF (specified .AND. v(i, k, j-1) .GT. 0.) THEN
            vb = v(i, k, j-1)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from2)
      END DO
      CALL PUSHCONTROL3B(3)
    ELSE IF (j .EQ. jde - 1) THEN
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts,ktf
        ad_from3 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from3)
      END DO
      CALL PUSHCONTROL3B(4)
    ELSE
      CALL PUSHCONTROL3B(5)
    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
        ad_from4 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from4)
      END DO
      CALL PUSHCONTROL2B(0)
    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
        ad_from5 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from5)
      END DO
      CALL PUSHCONTROL2B(1)
    ELSE IF (j .GT. j_start) THEN
! Normal code
      DO k=kts,ktf
        ad_from6 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from6)
      END DO
      CALL PUSHCONTROL2B(2)
    ELSE
      CALL PUSHCONTROL2B(3)
    END IF
    jtmp = jp1
    CALL PUSHINTEGER4(jp1)
    jp1 = jp0
    CALL PUSHINTEGER4(jp0)
    jp0 = jtmp
  END DO j_loop_y_flux_5
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from7)
!  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
  END IF
  ad_from10 = j_start
!  compute fluxes
  DO j=ad_from10,j_end
!  5th or 6th order flux
    DO k=kts,ktf
      DO i=i_start_f,i_end_f
        vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = v(i+1, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = v(i, k, j)
          CALL PUSHREAL8(qi)
          qi = v(i-1, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = v(i-2, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = v(i-3, k, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = v(i-2, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = v(i-1, k, j)
          CALL PUSHREAL8(qi)
          qi = v(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = v(i+1, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = v(i+2, k, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      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
      ad_from8 = i_start
      DO i=ad_from8,i_start_f-1
        IF (i .EQ. ids + 1) THEN
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (i .EQ. ids + 2) THEN
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(ad_from8)
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (degrade_xe) THEN
      DO i=i_end_f+1,i_end+1
        IF (i .EQ. ide - 1) THEN
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (i .EQ. ide - 2) THEN
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHCONTROL1B(1)
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
!  x flux-divergence into tendency
    DO k=kts,ktf
      ad_from9 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from9)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from10)
!  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
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%polar .AND. jte .EQ. jde) THEN
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  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
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    END IF
    ad_from11 = i_start
    DO i=ad_from11,i_end
      DO k=kts,ktf
        IF (rv(i, k, jts) - cb*mut(i, jts) .GT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = rv(i, k, jts) - cb*mut(i, jts)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from11)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    i_start = its
    IF (ite .GT. ide - 1) THEN
      CALL PUSHINTEGER4(i_end)
      i_end = ide - 1
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHINTEGER4(i_end)
      i_end = ite
      CALL PUSHCONTROL1B(1)
    END IF
    ad_from12 = i_start
    DO i=ad_from12,i_end
      DO k=kts,ktf
        IF (rv(i, k, jte) + cb*mut(i, jte-1) .LT. 0.) THEN
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = rv(i, k, jte) + cb*mut(i, jte-1)
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from12)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(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
  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
    ad_from13 = j_start
    DO j=ad_from13,j_end
      CALL PUSHREAL8(mrdx)
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(its, j)*rdx
      IF (jmax .GT. j) THEN
        CALL PUSHINTEGER4(jp)
        jp = j
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jp)
        jp = jmax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jmin .LT. j - 1) THEN
        CALL PUSHINTEGER4(jm)
        jm = j - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jm)
        jm = jmin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        uw = 0.5*(ru(its, k, jp)+ru(its, k, jm))
        IF (uw .GT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from13)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from14 = j_start
    DO j=ad_from14,j_end
      CALL PUSHREAL8(mrdx)
! ADT eqn 45, 1st term on RHS
      mrdx = msfvy(ite-1, j)*rdx
      IF (jmax .GT. j) THEN
        CALL PUSHINTEGER4(jp)
        jp = j
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jp)
        jp = jmax
        CALL PUSHCONTROL1B(1)
      END IF
      IF (jmin .LT. j - 1) THEN
        CALL PUSHINTEGER4(jm)
        jm = j - 1
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHINTEGER4(jm)
        jm = jmin
        CALL PUSHCONTROL1B(1)
      END IF
      DO k=kts,ktf
        uw = 0.5*(ru(ite, k, jp)+ru(ite, k, jm))
        IF (uw .LT. 0.) THEN
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from14)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  j_end = jte
! 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
!    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
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = v(i, k+1, j)
          CALL PUSHREAL8(qip1)
          qip1 = v(i, k, j)
          CALL PUSHREAL8(qi)
          qi = v(i, k-1, j)
          CALL PUSHREAL8(qim1)
          qim1 = v(i, k-2, j)
          CALL PUSHREAL8(qim2)
          qim2 = v(i, k-3, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = v(i, k-2, j)
          CALL PUSHREAL8(qip1)
          qip1 = v(i, k-1, j)
          CALL PUSHREAL8(qi)
          qi = v(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = v(i, k+1, j)
          CALL PUSHREAL8(qim2)
          qim2 = v(i, k+2, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      END DO
    END DO
    CALL PUSHINTEGER4(k)
  END DO
  vfluxb = 0.0
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        temp32b1 = -(msfvy(i, j)*rdzw(k)*tendencyb(i, k, j)/msfvx(i, j))
        vfluxb(i, k+1) = vfluxb(i, k+1) + temp32b1
        vfluxb(i, k) = vfluxb(i, k) - temp32b1
      END DO
    END DO
    CALL POPINTEGER4(k)
    DO i=i_end,i_start,-1
      k = ktf
      temp32b = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i, k)
      temp32b0 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp32b
      romb(i, k, j-1) = romb(i, k, j-1) + temp32b
      vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp32b0
      vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp32b0
      vfluxb(i, k) = 0.0
      k = ktf - 1
      vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
      temp28 = v(i, k+1, j) - v(i, k-2, j) - 3.*(v(i, k, j)-v(i, k-1, j)&
&        )
      temp31 = SIGN(1., -vel)
      temp30 = temp31/12.0
      temp29 = SIGN(1, time_step)
      temp28b = vel*vfluxb(i, k)
      temp28b0 = temp28b/12.0
      temp28b1 = temp29*temp30*temp28b
      velb = ((7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))/&
&        12.0+temp29*(temp30*temp28))*vfluxb(i, k)
      vb0(i, k, j) = vb0(i, k, j) + 7.*temp28b0 - 3.*temp28b1
      vb0(i, k-1, j) = vb0(i, k-1, j) + 3.*temp28b1 + 7.*temp28b0
      vb0(i, k+1, j) = vb0(i, k+1, j) + temp28b1 - temp28b0
      vb0(i, k-2, j) = vb0(i, k-2, j) - temp28b1 - temp28b0
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
      k = kts + 2
      vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
      temp24 = v(i, k+1, j) - v(i, k-2, j) - 3.*(v(i, k, j)-v(i, k-1, j)&
&        )
      temp27 = SIGN(1., -vel)
      temp26 = temp27/12.0
      temp25 = SIGN(1, time_step)
      temp24b1 = vel*vfluxb(i, k)
      temp24b2 = temp24b1/12.0
      temp24b3 = temp25*temp26*temp24b1
      velb = ((7.*(v(i, k, j)+v(i, k-1, j))-v(i, k+1, j)-v(i, k-2, j))/&
&        12.0+temp25*(temp26*temp24))*vfluxb(i, k)
      vb0(i, k, j) = vb0(i, k, j) + 7.*temp24b2 - 3.*temp24b3
      vb0(i, k-1, j) = vb0(i, k-1, j) + 3.*temp24b3 + 7.*temp24b2
      vb0(i, k+1, j) = vb0(i, k+1, j) + temp24b3 - temp24b2
      vb0(i, k-2, j) = vb0(i, k-2, j) - temp24b3 - temp24b2
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
      k = kts + 1
      temp24b4 = 0.5*(fzm(k)*v(i, k, j)+fzp(k)*v(i, k-1, j))*vfluxb(i, k&
&        )
      temp24b5 = 0.5*(rom(i, k, j)+rom(i, k, j-1))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp24b4
      romb(i, k, j-1) = romb(i, k, j-1) + temp24b4
      vb0(i, k, j) = vb0(i, k, j) + fzm(k)*temp24b5
      vb0(i, k-1, j) = vb0(i, k-1, j) + fzp(k)*temp24b5
      vfluxb(i, k) = 0.0
    END DO
    DO k=ktf-2,kts+3,-1
      DO i=i_end,i_start,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(rom(i, k, j)+rom(i, k, j-1))
        temp24b = vel*vfluxb(i, k)/sumwk
        temp24b0 = (wi0*f0+wi1*f1+wi2*f2)*vfluxb(i, k)/sumwk
        f0b = wi0*temp24b
        f1b = wi1*temp24b
        f2b = wi2*temp24b
        velb = temp24b0
        sumwkb = -(vel*temp24b0/sumwk)
        wi0b = sumwkb + f0*temp24b
        wi1b = sumwkb + f1*temp24b
        wi2b = sumwkb + f2*temp24b
        vfluxb(i, k) = 0.0
        temp23 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp23**2)
        END IF
        temp22 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp22**2)
        END IF
        temp21 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp21**2)
        END IF
        CALL POPREAL8(beta2)
        temp21b5 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp21b6 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp21b6 - f2b/6. + temp21b5
        CALL POPREAL8(beta1)
        temp21b7 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp21b10 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp21b7 - temp21b10 + f1b/3. + 5.*f2b/6. - 4.*temp21b6 &
&          - 2.*temp21b5
        CALL POPREAL8(beta0)
        temp21b9 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp21b8 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp21b7 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp21b8 + temp21b9 + 3.*temp21b6 + temp21b5
        qim1b = temp21b10 - 4.*temp21b8 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp21b9 + temp21b7
        qim2b = f0b/3. + temp21b8 + temp21b9
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          vb0(i, k-3, j) = vb0(i, k-3, j) + qim2b
          CALL POPREAL8(qim1)
          vb0(i, k-2, j) = vb0(i, k-2, j) + qim1b
          CALL POPREAL8(qi)
          vb0(i, k-1, j) = vb0(i, k-1, j) + qib
          CALL POPREAL8(qip1)
          vb0(i, k, j) = vb0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          vb0(i, k+1, j) = vb0(i, k+1, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          vb0(i, k+2, j) = vb0(i, k+2, j) + qim2b
          CALL POPREAL8(qim1)
          vb0(i, k+1, j) = vb0(i, k+1, j) + qim1b
          CALL POPREAL8(qi)
          vb0(i, k, j) = vb0(i, k, j) + qib
          CALL POPREAL8(qip1)
          vb0(i, k-1, j) = vb0(i, k-1, j) + qip1b
          CALL POPREAL8(qip2)
          vb0(i, k-2, j) = vb0(i, k-2, j) + qip2b
        END IF
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k, j-1) = romb(i, k, j-1) + 0.5*velb
      END DO
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from14)
    CALL POPINTEGER4(ad_to14)
    DO j=ad_to14,ad_from14,-1
      DO k=ktf,kts,-1
        dum = ru(ite, k, jm) - ru(ite-1, k, jm)
        dup = ru(ite, k, jp) - ru(ite-1, k, jp)
        temp21b3 = -(mrdx*tendencyb(ite-1, k, j))
        temp21b4 = 0.5*v(ite-1, k, j)*temp21b3
        ubb = (v_old(ite-1, k, j)-v_old(ite-2, k, j))*temp21b3
        v_oldb(ite-1, k, j) = v_oldb(ite-1, k, j) + ub*temp21b3
        v_oldb(ite-2, k, j) = v_oldb(ite-2, k, j) - ub*temp21b3
        vb0(ite-1, k, j) = vb0(ite-1, k, j) + 0.5*(dup+dum)*temp21b3
        dupb = temp21b4
        dumb = temp21b4
        rub(ite, k, jm) = rub(ite, k, jm) + dumb
        rub(ite-1, k, jm) = rub(ite-1, k, jm) - dumb
        rub(ite, k, jp) = rub(ite, k, jp) + dupb
        rub(ite-1, k, jp) = rub(ite-1, k, jp) - dupb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        rub(ite, k, jp) = rub(ite, k, jp) + 0.5*uwb
        rub(ite, k, jm) = rub(ite, k, jm) + 0.5*uwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jm)
      ELSE
        CALL POPINTEGER4(jm)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jp)
      ELSE
        CALL POPINTEGER4(jp)
      END IF
      CALL POPREAL8(mrdx)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from13)
    CALL POPINTEGER4(ad_to13)
    DO j=ad_to13,ad_from13,-1
      DO k=ktf,kts,-1
        dum = ru(its+1, k, jm) - ru(its, k, jm)
        dup = ru(its+1, k, jp) - ru(its, k, jp)
        temp21b1 = -(mrdx*tendencyb(its, k, j))
        temp21b2 = 0.5*v(its, k, j)*temp21b1
        ubb = (v_old(its+1, k, j)-v_old(its, k, j))*temp21b1
        v_oldb(its+1, k, j) = v_oldb(its+1, k, j) + ub*temp21b1
        v_oldb(its, k, j) = v_oldb(its, k, j) - ub*temp21b1
        vb0(its, k, j) = vb0(its, k, j) + 0.5*(dup+dum)*temp21b1
        dupb = temp21b2
        dumb = temp21b2
        rub(its+1, k, jm) = rub(its+1, k, jm) + dumb
        rub(its, k, jm) = rub(its, k, jm) - dumb
        rub(its+1, k, jp) = rub(its+1, k, jp) + dupb
        rub(its, k, jp) = rub(its, k, jp) - dupb
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        rub(its, k, jp) = rub(its, k, jp) + 0.5*uwb
        rub(its, k, jm) = rub(its, k, jm) + 0.5*uwb
      END DO
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jm)
      ELSE
        CALL POPINTEGER4(jm)
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(jp)
      ELSE
        CALL POPINTEGER4(jp)
      END IF
      CALL POPREAL8(mrdx)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from12)
    CALL POPINTEGER4(ad_to12)
    DO i=ad_to12,ad_from12,-1
      DO k=ktf,kts,-1
        temp21b0 = -(rdy*tendencyb(i, k, jte))
        vbb = (v_old(i, k, jte)-v_old(i, k, jte-1))*temp21b0
        v_oldb(i, k, jte) = v_oldb(i, k, jte) + vb*temp21b0
        v_oldb(i, k, jte-1) = v_oldb(i, k, jte-1) - vb*temp21b0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jte) = rvb(i, k, jte) + vbb
          mutb(i, jte-1) = mutb(i, jte-1) + cb*vbb
        END IF
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(i_end)
    ELSE
      CALL POPINTEGER4(i_end)
    END IF
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from11)
    CALL POPINTEGER4(ad_to11)
    DO i=ad_to11,ad_from11,-1
      DO k=ktf,kts,-1
        temp21b = -(rdy*tendencyb(i, k, jts))
        vbb = (v_old(i, k, jts+1)-v_old(i, k, jts))*temp21b
        v_oldb(i, k, jts+1) = v_oldb(i, k, jts+1) + vb*temp21b
        v_oldb(i, k, jts) = v_oldb(i, k, jts) - vb*temp21b
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
        ELSE
          CALL POPREAL8(vb)
          rvb(i, k, jts) = rvb(i, k, jts) + vbb
          mutb(i, jts) = mutb(i, jts) - cb*vbb
        END IF
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(i_end)
    ELSE
      CALL POPINTEGER4(i_end)
    END IF
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO i=ite,its,-1
      DO k=ktf,kts,-1
        tendencyb(i, k, jte) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO i=ite,its,-1
      DO k=ktf,kts,-1
        tendencyb(i, k, jts) = 0.0
      END DO
    END DO
  END IF
  fqxb = 0.0
  CALL POPINTEGER4(ad_from10)
  CALL POPINTEGER4(ad_to10)
  DO j=ad_to10,ad_from10,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from9)
      CALL POPINTEGER4(ad_to9)
      DO i=ad_to9,ad_from9,-1
        mrdx = msfvy(i, j)*rdx
        fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
        fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      CALL POPINTEGER4(ad_to8)
      DO i=ad_to8,i_end_f+1,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            temp17 = v(i+1, k, j) - v(i-2, k, j) - 3.*(v(i, k, j)-v(i-1&
&              , k, j))
            temp20 = SIGN(1., vel)
            temp19 = temp20/12.0
            temp18 = SIGN(1, time_step)
            temp17b1 = vel*fqxb(i, k)
            temp17b2 = temp17b1/12.0
            temp17b3 = temp18*temp19*temp17b1
            velb = ((7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2, k&
&              , j))/12.0+temp18*(temp19*temp17))*fqxb(i, k)
            vb0(i, k, j) = vb0(i, k, j) + 7.*temp17b2 - 3.*temp17b3
            vb0(i-1, k, j) = vb0(i-1, k, j) + 3.*temp17b3 + 7.*temp17b2
            vb0(i+1, k, j) = vb0(i+1, k, j) + temp17b3 - temp17b2
            vb0(i-2, k, j) = vb0(i-2, k, j) - temp17b3 - temp17b2
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp17b = 0.25*(v(i_end+1, k, j)+v(i_end, k, j))*fqxb(i, k)
            temp17b0 = 0.25*(ru(i_end+1, k, j)+ru(i_end+1, k, j-1))*fqxb&
&              (i, k)
            rub(i_end+1, k, j) = rub(i_end+1, k, j) + temp17b
            rub(i_end+1, k, j-1) = rub(i_end+1, k, j-1) + temp17b
            vb0(i_end+1, k, j) = vb0(i_end+1, k, j) + temp17b0
            vb0(i_end, k, j) = vb0(i_end, k, j) + temp17b0
            fqxb(i, k) = 0.0
          END DO
        END IF
      END DO
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from8)
      DO i=i_start_f-1,ad_from8,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          DO k=ktf,kts,-1
            vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
            temp13 = v(i+1, k, j) - v(i-2, k, j) - 3.*(v(i, k, j)-v(i-1&
&              , k, j))
            temp16 = SIGN(1., vel)
            temp15 = temp16/12.0
            temp14 = SIGN(1, time_step)
            temp13b3 = vel*fqxb(i, k)
            temp13b4 = temp13b3/12.0
            temp13b5 = temp14*temp15*temp13b3
            velb = ((7.*(v(i, k, j)+v(i-1, k, j))-v(i+1, k, j)-v(i-2, k&
&              , j))/12.0+temp14*(temp15*temp13))*fqxb(i, k)
            vb0(i, k, j) = vb0(i, k, j) + 7.*temp13b4 - 3.*temp13b5
            vb0(i-1, k, j) = vb0(i-1, k, j) + 3.*temp13b5 + 7.*temp13b4
            vb0(i+1, k, j) = vb0(i+1, k, j) + temp13b5 - temp13b4
            vb0(i-2, k, j) = vb0(i-2, k, j) - temp13b5 - temp13b4
            fqxb(i, k) = 0.0
            rub(i, k, j) = rub(i, k, j) + 0.5*velb
            rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
          END DO
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          DO k=ktf,kts,-1
            temp13b1 = 0.25*(v(i, k, j)+v(i-1, k, j))*fqxb(i, k)
            temp13b2 = 0.25*(ru(i, k, j)+ru(i, k, j-1))*fqxb(i, k)
            rub(i, k, j) = rub(i, k, j) + temp13b1
            rub(i, k, j-1) = rub(i, k, j-1) + temp13b1
            vb0(i, k, j) = vb0(i, k, j) + temp13b2
            vb0(i-1, k, j) = vb0(i-1, k, j) + temp13b2
            fqxb(i, k) = 0.0
          END DO
        END IF
      END DO
    END IF
    DO k=ktf,kts,-1
      DO i=i_end_f,i_start_f,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(ru(i, k, j)+ru(i, k, j-1))
        temp13b = vel*fqxb(i, k)/sumwk
        temp13b0 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k)/sumwk
        f0b = wi0*temp13b
        f1b = wi1*temp13b
        f2b = wi2*temp13b
        velb = temp13b0
        sumwkb = -(vel*temp13b0/sumwk)
        wi0b = sumwkb + f0*temp13b
        wi1b = sumwkb + f1*temp13b
        wi2b = sumwkb + f2*temp13b
        fqxb(i, k) = 0.0
        temp12 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp12**2)
        END IF
        temp11 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp11**2)
        END IF
        temp10 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp10**2)
        END IF
        CALL POPREAL8(beta2)
        temp10b = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp10b0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp10b0 - f2b/6. + temp10b
        CALL POPREAL8(beta1)
        temp10b1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp10b4 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp10b1 - temp10b4 + f1b/3. + 5.*f2b/6. - 4.*temp10b0 -&
&          2.*temp10b
        CALL POPREAL8(beta0)
        temp10b3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp10b2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp10b1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp10b2 + temp10b3 + 3.*temp10b0 + temp10b
        qim1b = temp10b4 - 4.*temp10b2 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp10b3 + temp10b1
        qim2b = f0b/3. + temp10b2 + temp10b3
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          vb0(i-3, k, j) = vb0(i-3, k, j) + qim2b
          CALL POPREAL8(qim1)
          vb0(i-2, k, j) = vb0(i-2, k, j) + qim1b
          CALL POPREAL8(qi)
          vb0(i-1, k, j) = vb0(i-1, k, j) + qib
          CALL POPREAL8(qip1)
          vb0(i, k, j) = vb0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          vb0(i+1, k, j) = vb0(i+1, k, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          vb0(i+2, k, j) = vb0(i+2, k, j) + qim2b
          CALL POPREAL8(qim1)
          vb0(i+1, k, j) = vb0(i+1, k, j) + qim1b
          CALL POPREAL8(qi)
          vb0(i, k, j) = vb0(i, k, j) + qib
          CALL POPREAL8(qip1)
          vb0(i-1, k, j) = vb0(i-1, k, j) + qip1b
          CALL POPREAL8(qip2)
          vb0(i-2, k, j) = vb0(i-2, k, j) + qip2b
        END IF
        rub(i, k, j) = rub(i, k, j) + 0.5*velb
        rub(i, k, j-1) = rub(i, k, j-1) + 0.5*velb
      END DO
    END DO
  END DO
  fqyb = 0.0
  CALL POPINTEGER4(ad_from7)
  CALL POPINTEGER4(ad_to7)
  DO j=ad_to7,ad_from7,-1
    CALL POPINTEGER4(jp0)
    CALL POPINTEGER4(jp1)
    CALL POPCONTROL2B(branch)
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from4)
          CALL POPINTEGER4(ad_to4)
          DO i=ad_to4,ad_from4,-1
            tendencyb(i, k, j-1) = 0.0
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from5)
          CALL POPINTEGER4(ad_to5)
          DO i=ad_to5,ad_from5,-1
            tendencyb(i, k, j-1) = 0.0
          END DO
        END DO
      END IF
    ELSE IF (branch .EQ. 2) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from6)
        CALL POPINTEGER4(ad_to6)
        DO i=ad_to6,ad_from6,-1
          mrdy = msfvy(i, j-1)*rdy
          fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1)
          fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1)
        END DO
      END DO
    END IF
    CALL POPCONTROL3B(branch)
    IF (branch .LT. 3) THEN
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from)
          CALL POPINTEGER4(ad_to)
          DO i=ad_to,ad_from,-1
            wi0 = gi0/(eps+beta0)**pw
            wi1 = gi1/(eps+beta1)**pw
            wi2 = gi2/(eps+beta2)**pw
            sumwk = wi0 + wi1 + wi2
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            temp2b = vel*fqyb(i, k, jp1)/sumwk
            temp2b0 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, jp1)/sumwk
            f0b = wi0*temp2b
            f1b = wi1*temp2b
            f2b = wi2*temp2b
            velb = temp2b0
            sumwkb = -(vel*temp2b0/sumwk)
            wi0b = sumwkb + f0*temp2b
            wi1b = sumwkb + f1*temp2b
            wi2b = sumwkb + f2*temp2b
            fqyb(i, k, jp1) = 0.0
            temp1 = (eps+beta2)**pw
            IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta2b = 0.0
            ELSE
              beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp1**2)
            END IF
            temp0 = (eps+beta1)**pw
            IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta1b = 0.0
            ELSE
              beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp0**2)
            END IF
            temp = (eps+beta0)**pw
            IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta0b = 0.0
            ELSE
              beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp**2)
            END IF
            CALL POPREAL8(beta2)
            tempb = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
            tempb0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
            qip2b = tempb0 - f2b/6. + tempb
            CALL POPREAL8(beta1)
            tempb1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
            tempb4 = 2*(qim1-qip1)*beta1b/4.
            qip1b = tempb1 - tempb4 + f1b/3. + 5.*f2b/6. - 4.*tempb0 - &
&              2.*tempb
            CALL POPREAL8(beta0)
            tempb3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
            tempb2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
            qib = f2b/3. - 2.*tempb1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&              tempb2 + tempb3 + 3.*tempb0 + tempb
            qim1b = tempb4 - 4.*tempb2 - 7.*f0b/6. - f1b/6. - 2.*tempb3 &
&              + tempb1
            qim2b = f0b/3. + tempb2 + tempb3
            CALL POPREAL8(f2)
            CALL POPREAL8(f1)
            CALL POPREAL8(f0)
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(qim2)
              vb0(i, k, j-3) = vb0(i, k, j-3) + qim2b
              CALL POPREAL8(qim1)
              vb0(i, k, j-2) = vb0(i, k, j-2) + qim1b
              CALL POPREAL8(qi)
              vb0(i, k, j-1) = vb0(i, k, j-1) + qib
              CALL POPREAL8(qip1)
              vb0(i, k, j) = vb0(i, k, j) + qip1b
              CALL POPREAL8(qip2)
              vb0(i, k, j+1) = vb0(i, k, j+1) + qip2b
            ELSE
              CALL POPREAL8(qim2)
              vb0(i, k, j+2) = vb0(i, k, j+2) + qim2b
              CALL POPREAL8(qim1)
              vb0(i, k, j+1) = vb0(i, k, j+1) + qim1b
              CALL POPREAL8(qi)
              vb0(i, k, j) = vb0(i, k, j) + qib
              CALL POPREAL8(qip1)
              vb0(i, k, j-1) = vb0(i, k, j-1) + qip1b
              CALL POPREAL8(qip2)
              vb0(i, k, j-2) = vb0(i, k, j-2) + qip2b
            END IF
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
          END DO
        END DO
      ELSE IF (branch .EQ. 1) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from0)
          CALL POPINTEGER4(ad_to0)
          DO i=ad_to0,ad_from0,-1
            temp2b1 = 0.25*(v(i, k, j)+vb)*fqyb(i, k, jp1)
            temp2b2 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + temp2b1
            rvb(i, k, j-1) = rvb(i, k, j-1) + temp2b1
            vb0(i, k, j) = vb0(i, k, j) + temp2b2
            vbb = temp2b2
            fqyb(i, k, jp1) = 0.0
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              vb0(i, k, j) = vb0(i, k, j) + vbb
              vbb = 0.0
            END IF
            CALL POPREAL8(vb)
            vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
          END DO
        END DO
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from1)
          CALL POPINTEGER4(ad_to1)
          DO i=ad_to1,ad_from1,-1
            vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
            temp2 = v(i, k, j+1) - v(i, k, j-2) - 3.*(v(i, k, j)-v(i, k&
&              , j-1))
            temp5 = SIGN(1., vel)
            temp4 = temp5/12.0
            temp3 = SIGN(1, time_step)
            temp2b3 = vel*fqyb(i, k, jp1)
            temp2b4 = temp2b3/12.0
            temp2b5 = temp3*temp4*temp2b3
            velb = ((7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k, j&
&              -2))/12.0+temp3*(temp4*temp2))*fqyb(i, k, jp1)
            vb0(i, k, j) = vb0(i, k, j) + 7.*temp2b4 - 3.*temp2b5
            vb0(i, k, j-1) = vb0(i, k, j-1) + 3.*temp2b5 + 7.*temp2b4
            vb0(i, k, j+1) = vb0(i, k, j+1) + temp2b5 - temp2b4
            vb0(i, k, j-2) = vb0(i, k, j-2) - temp2b5 - temp2b4
            fqyb(i, k, jp1) = 0.0
            rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
            rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
          END DO
        END DO
      END IF
    ELSE IF (branch .EQ. 3) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from2)
        CALL POPINTEGER4(ad_to2)
        DO i=ad_to2,ad_from2,-1
          temp6b = 0.25*(vb+v(i, k, j-1))*fqyb(i, k, jp1)
          temp6b0 = 0.25*(rv(i, k, j)+rv(i, k, j-1))*fqyb(i, k, jp1)
          rvb(i, k, j) = rvb(i, k, j) + temp6b
          rvb(i, k, j-1) = rvb(i, k, j-1) + temp6b
          vbb = temp6b0
          vb0(i, k, j-1) = vb0(i, k, j-1) + temp6b0
          fqyb(i, k, jp1) = 0.0
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            vb0(i, k, j-1) = vb0(i, k, j-1) + vbb
            vbb = 0.0
          END IF
          CALL POPREAL8(vb)
          vb0(i, k, j) = vb0(i, k, j) + vbb
        END DO
      END DO
    ELSE IF (branch .EQ. 4) THEN
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_from3)
        CALL POPINTEGER4(ad_to3)
        DO i=ad_to3,ad_from3,-1
          vel = 0.5*(rv(i, k, j)+rv(i, k, j-1))
          temp6 = v(i, k, j+1) - v(i, k, j-2) - 3.*(v(i, k, j)-v(i, k, j&
&            -1))
          temp9 = SIGN(1., vel)
          temp8 = temp9/12.0
          temp7 = SIGN(1, time_step)
          temp6b1 = vel*fqyb(i, k, jp1)
          temp6b2 = temp6b1/12.0
          temp6b3 = temp7*temp8*temp6b1
          velb = ((7.*(v(i, k, j)+v(i, k, j-1))-v(i, k, j+1)-v(i, k, j-2&
&            ))/12.0+temp7*(temp8*temp6))*fqyb(i, k, jp1)
          vb0(i, k, j) = vb0(i, k, j) + 7.*temp6b2 - 3.*temp6b3
          vb0(i, k, j-1) = vb0(i, k, j-1) + 3.*temp6b3 + 7.*temp6b2
          vb0(i, k, j+1) = vb0(i, k, j+1) + temp6b3 - temp6b2
          vb0(i, k, j-2) = vb0(i, k, j-2) - temp6b3 - temp6b2
          fqyb(i, k, jp1) = 0.0
          rvb(i, k, j) = rvb(i, k, j) + 0.5*velb
          rvb(i, k, j-1) = rvb(i, k, j-1) + 0.5*velb
        END DO
      END DO
    END IF
  END DO
END SUBROUTINE A_ADVECT_WENO_V

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4165) - 21 sep 2011 20:54
!
!  Differentiation of advect_weno_w in reverse (adjoint) mode:
!   gradient     of useful results: rom tendency w ru rv w_old
!   with respect to varying inputs: rom tendency w ru rv w_old
!   RW status of diff variables: rom:incr tendency:in-out w:incr
!                ru:incr rv:incr w_old:incr
SUBROUTINE A_ADVECT_WENO_W(w, wb0, w_old, w_oldb, tendency, tendencyb, &
&  ru, rub, rv, rvb, rom, romb, 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) :: wb0, w_oldb, rub, rvb, &
&  romb
  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) :: tendencyb
  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 :: ubb, vbb, uwb, vwb
  REAL, DIMENSION(its:ite, kts:kte) :: vflux
  REAL, DIMENSION(its:ite, kts:kte) :: vfluxb
  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 :: qim2b, qim1b, qib, qip1b, qip2b
  DOUBLE PRECISION :: beta0, beta1, beta2, f0, f1, f2, wi0, wi1, wi2, &
&  sumwk
  DOUBLE PRECISION :: beta0b, beta1b, beta2b, f0b, f1b, f2b, wi0b, wi1b&
&  , wi2b, sumwkb
  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) :: fqxb
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqy
  REAL, DIMENSION(its:ite, kts:kte, 2) :: fqyb
  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 :: velb
  LOGICAL :: specified
  INTEGER :: branch
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_from2
  INTEGER :: ad_to2
  INTEGER :: ad_from3
  INTEGER :: ad_to3
  INTEGER :: ad_from4
  INTEGER :: ad_to4
  INTEGER :: ad_from5
  INTEGER :: ad_to5
  INTEGER :: ad_from6
  INTEGER :: ad_to6
  INTEGER :: ad_from7
  INTEGER :: ad_to7
  INTEGER :: ad_from8
  INTEGER :: ad_to8
  INTEGER :: ad_from9
  INTEGER :: ad_to9
  INTEGER :: ad_from10
  INTEGER :: ad_to10
  INTEGER :: ad_from11
  INTEGER :: ad_to11
  INTEGER :: ad_from12
  INTEGER :: ad_to12
  INTEGER :: ad_from13
  INTEGER :: ad_to13
  INTEGER :: ad_from14
  INTEGER :: ad_to14
  INTEGER :: ad_from15
  INTEGER :: ad_to15
  INTEGER :: ad_from16
  INTEGER :: ad_to16
  INTEGER :: ad_from17
  INTEGER :: ad_to17
  INTEGER :: ad_from18
  INTEGER :: ad_to18
  INTEGER :: ad_from19
  INTEGER :: ad_to19
  INTEGER :: ad_from20
  INTEGER :: ad_to20
  INTEGER :: ad_from21
  INTEGER :: ad_to21
  INTEGER :: ad_from22
  INTEGER :: ad_to22
  INTEGER :: ad_from23
  INTEGER :: ad_to23
  DOUBLE PRECISION :: temp3
  REAL :: temp29
  REAL :: temp43b40
  DOUBLE PRECISION :: temp2
  INTEGER :: temp28
  DOUBLE PRECISION :: temp1
  REAL :: temp27
  DOUBLE PRECISION :: temp0
  REAL :: temp13b
  DOUBLE PRECISION :: temp26
  REAL :: temp21b
  DOUBLE PRECISION :: temp25
  DOUBLE PRECISION :: temp24
  DOUBLE PRECISION :: temp23
  REAL :: temp35b5
  REAL :: temp9b1
  DOUBLE PRECISION :: temp22
  REAL :: temp35b4
  REAL :: temp9b0
  DOUBLE PRECISION :: temp21
  REAL :: temp35b3
  REAL :: temp20
  REAL :: temp35b2
  REAL :: temp13b5
  REAL :: temp35b1
  REAL :: temp13b4
  DOUBLE PRECISION :: temp24b
  REAL :: temp35b0
  REAL :: temp13b3
  REAL :: temp13b2
  REAL :: temp53
  REAL :: temp13b1
  REAL :: temp52
  REAL :: temp13b0
  INTEGER :: temp51
  REAL :: temp50
  REAL :: tempb4
  REAL :: tempb3
  DOUBLE PRECISION :: temp27b
  REAL :: tempb2
  REAL :: temp35b
  REAL :: tempb1
  REAL :: temp43b
  REAL :: tempb0
  REAL :: temp43b39
  INTRINSIC MAX
  REAL :: temp43b38
  REAL :: temp43b37
  REAL :: temp43b36
  INTRINSIC SIGN
  REAL :: temp43b35
  REAL :: temp43b34
  DOUBLE PRECISION :: temp46b
  REAL :: temp43b33
  REAL :: temp54b
  REAL :: temp2b6
  REAL :: temp43b32
  REAL :: temp2b5
  REAL :: temp43b31
  REAL :: temp2b4
  REAL :: temp19
  REAL :: temp43b30
  REAL :: temp2b3
  INTEGER :: temp18
  REAL :: temp2b2
  REAL :: temp17
  REAL :: temp43b9
  REAL :: temp50b1
  REAL :: temp2b1
  REAL :: temp16
  REAL :: temp43b8
  REAL :: temp50b0
  DOUBLE PRECISION :: temp2b0
  REAL :: temp15
  REAL :: temp43b7
  INTEGER :: temp14
  REAL :: temp43b6
  REAL :: temp13
  REAL :: temp43b5
  REAL :: temp12
  REAL :: temp43b4
  REAL :: temp49
  REAL :: temp11
  REAL :: temp43b3
  REAL :: temp48
  INTEGER :: temp10
  REAL :: temp43b2
  INTEGER :: temp47
  REAL :: temp43b1
  REAL :: temp46
  REAL :: temp9b
  REAL :: temp21b4
  REAL :: temp43b0
  DOUBLE PRECISION :: temp45
  REAL :: temp21b3
  REAL :: temp31b
  DOUBLE PRECISION :: temp44
  REAL :: temp21b2
  DOUBLE PRECISION :: temp43
  REAL :: temp5b7
  REAL :: temp21b1
  REAL :: temp42
  REAL :: temp5b6
  REAL :: temp21b0
  REAL :: temp41
  REAL :: temp5b5
  INTEGER :: temp40
  REAL :: temp5b4
  REAL :: temp5b3
  REAL :: temp5b2
  REAL :: temp5b1
  DOUBLE PRECISION :: temp5b0
  REAL :: temp50b
  REAL :: tempb
  REAL :: temp43b29
  REAL :: temp31b1
  REAL :: temp43b28
  REAL :: temp46b5
  REAL :: temp31b0
  REAL :: temp43b27
  REAL :: temp46b4
  REAL :: temp43b26
  REAL :: temp46b3
  REAL :: temp24b6
  REAL :: temp43b25
  REAL :: temp46b2
  REAL :: temp24b5
  REAL :: temp43b24
  REAL :: temp46b1
  DOUBLE PRECISION :: temp2b
  REAL :: temp24b4
  REAL :: temp43b23
  DOUBLE PRECISION :: temp46b0
  REAL :: temp24b3
  REAL :: temp43b22
  REAL :: temp24b2
  REAL :: temp43b21
  REAL :: temp24b1
  REAL :: temp43b20
  DOUBLE PRECISION :: temp24b0
  DOUBLE PRECISION :: temp5b
  REAL :: temp39b1
  REAL :: temp39b0
  REAL :: temp39
  REAL :: temp17b1
  REAL :: temp38
  REAL :: temp17b0
  REAL :: temp37
  INTEGER :: temp36
  REAL :: temp27b7
  REAL :: temp35
  REAL :: temp27b6
  REAL :: temp34
  REAL :: temp27b5
  REAL :: temp33
  REAL :: temp27b4
  INTEGER :: temp32
  REAL :: temp27b3
  REAL :: temp31
  REAL :: temp27b2
  REAL :: temp30
  REAL :: temp17b
  REAL :: temp27b1
  DOUBLE PRECISION :: temp27b0
  REAL :: temp43b19
  INTRINSIC MIN
  REAL :: temp43b18
  REAL :: temp43b17
  REAL :: temp43b16
  REAL :: temp43b15
  REAL :: temp43b14
  REAL :: temp43b13
  REAL :: temp54b0
  DOUBLE PRECISION :: temp
  REAL :: temp43b12
  REAL :: temp43b11
  REAL :: temp43b10
  REAL :: temp9
  REAL :: temp8
  REAL :: temp39b
  REAL :: temp7
  INTEGER :: temp6
  REAL :: temp5
  DOUBLE PRECISION :: temp4
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
!  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
  ad_from12 = j_start
j_loop_y_flux_5:DO j=ad_from12,j_end+1
    IF (j .GE. j_start_f .AND. j .LE. j_end_f) THEN
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        ad_from = i_start
        DO i=ad_from,i_end
          CALL PUSHREAL8(vel)
          vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
          IF (vel*sign(1,time_step) .GE. 0.0) THEN
            CALL PUSHREAL8(qip2)
            qip2 = w(i, k, j+1)
            CALL PUSHREAL8(qip1)
            qip1 = w(i, k, j)
            CALL PUSHREAL8(qi)
            qi = w(i, k, j-1)
            CALL PUSHREAL8(qim1)
            qim1 = w(i, k, j-2)
            CALL PUSHREAL8(qim2)
            qim2 = w(i, k, j-3)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHREAL8(qip2)
            qip2 = w(i, k, j-2)
            CALL PUSHREAL8(qip1)
            qip1 = w(i, k, j-1)
            CALL PUSHREAL8(qi)
            qi = w(i, k, j)
            CALL PUSHREAL8(qim1)
            qim1 = w(i, k, j+1)
            CALL PUSHREAL8(qim2)
            qim2 = w(i, k, j+2)
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(f0)
          f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
          CALL PUSHREAL8(f1)
          f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
          CALL PUSHREAL8(f2)
          f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
          CALL PUSHREAL8(beta0)
          beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*&
&            qi)**2
          CALL PUSHREAL8(beta1)
          beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
          CALL PUSHREAL8(beta2)
          beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*&
&            qi)**2
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from)
      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
      ad_from0 = i_start
      DO i=ad_from0,i_end
        CALL PUSHREAL8(vel)
        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
          CALL PUSHREAL8(qip2)
          qip2 = w(i, k, j+1)
          CALL PUSHREAL8(qip1)
          qip1 = w(i, k, j)
          CALL PUSHREAL8(qi)
          qi = w(i, k, j-1)
          CALL PUSHREAL8(qim1)
          qim1 = w(i, k, j-2)
          CALL PUSHREAL8(qim2)
          qim2 = w(i, k, j-3)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = w(i, k, j-2)
          CALL PUSHREAL8(qip1)
          qip1 = w(i, k, j-1)
          CALL PUSHREAL8(qi)
          qi = w(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = w(i, k, j+1)
          CALL PUSHREAL8(qim2)
          qim2 = w(i, k, j+2)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from0)
      CALL PUSHCONTROL3B(0)
    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 )
      CALL PUSHINTEGER4(k)
! 2nd order flux next to south boundary
      DO k=kts+1,ktf
        ad_from1 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from1)
      END DO
      k = ktf + 1
      ad_from2 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from2)
      CALL PUSHCONTROL3B(1)
    ELSE IF (j .EQ. jds + 2) THEN
      CALL PUSHINTEGER4(k)
! third of 4th order flux 2 in from south boundary
      DO k=kts+1,ktf
        ad_from3 = i_start
        DO i=ad_from3,i_end
          CALL PUSHREAL8(vel)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from3)
      END DO
      k = ktf + 1
      ad_from4 = i_start
      DO i=ad_from4,i_end
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from4)
      CALL PUSHCONTROL3B(2)
    ELSE IF (j .EQ. jde - 1) THEN
      CALL PUSHINTEGER4(k)
! 2nd order flux next to north boundary
      DO k=kts+1,ktf
        ad_from5 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from5)
      END DO
      k = ktf + 1
      ad_from6 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from6)
      CALL PUSHCONTROL3B(3)
    ELSE IF (j .EQ. jde - 2) THEN
      CALL PUSHINTEGER4(k)
! 3rd or 4th order flux 2 in from north boundary
      DO k=kts+1,ktf
        ad_from7 = i_start
        DO i=ad_from7,i_end
          CALL PUSHREAL8(vel)
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from7)
      END DO
      k = ktf + 1
      ad_from8 = i_start
      DO i=ad_from8,i_end
        CALL PUSHREAL8(vel)
        vel = (2.-fzm(k-1))*rv(i, k-1, j) - fzp(k-1)*rv(i, k-2, j)
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from8)
      CALL PUSHCONTROL3B(4)
    ELSE
      CALL PUSHCONTROL3B(5)
    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
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from9 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from9)
      END DO
      CALL PUSHCONTROL2B(0)
    ELSE IF (config_flags%polar .AND. j .EQ. jde) THEN
      CALL PUSHINTEGER4(k)
      DO k=kts,ktf
        ad_from10 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from10)
      END DO
      CALL PUSHCONTROL2B(1)
    ELSE IF (j .GT. j_start) THEN
! normal code
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf+1
        ad_from11 = i_start
        i = i_end + 1
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from11)
      END DO
      CALL PUSHCONTROL2B(2)
    ELSE
      CALL PUSHCONTROL2B(3)
    END IF
    jtmp = jp1
    CALL PUSHINTEGER4(jp1)
    jp1 = jp0
    CALL PUSHINTEGER4(jp0)
    jp0 = jtmp
  END DO j_loop_y_flux_5
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from12)
!  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
  END IF
  ad_from15 = j_start
!  compute fluxes
  DO j=ad_from15,j_end
    CALL PUSHINTEGER4(k)
!  5th or 6th order flux
    DO k=kts+1,ktf
      DO i=i_start_f,i_end_f
        CALL PUSHREAL8(vel)
        vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
        IF (vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = w(i+1, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = w(i, k, j)
          CALL PUSHREAL8(qi)
          qi = w(i-1, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = w(i-2, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = w(i-3, k, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = w(i-2, k, j)
          CALL PUSHREAL8(qip1)
          qip1 = w(i-1, k, j)
          CALL PUSHREAL8(qi)
          qi = w(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = w(i+1, k, j)
          CALL PUSHREAL8(qim2)
          qim2 = w(i+2, k, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      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
      CALL PUSHREAL8(vel)
      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
        CALL PUSHREAL8(qip2)
        qip2 = w(i+1, k, j)
        CALL PUSHREAL8(qip1)
        qip1 = w(i, k, j)
        CALL PUSHREAL8(qi)
        qi = w(i-1, k, j)
        CALL PUSHREAL8(qim1)
        qim1 = w(i-2, k, j)
        CALL PUSHREAL8(qim2)
        qim2 = w(i-3, k, j)
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(qip2)
        qip2 = w(i-2, k, j)
        CALL PUSHREAL8(qip1)
        qip1 = w(i-1, k, j)
        CALL PUSHREAL8(qi)
        qi = w(i, k, j)
        CALL PUSHREAL8(qim1)
        qim1 = w(i+1, k, j)
        CALL PUSHREAL8(qim2)
        qim2 = w(i+2, k, j)
        CALL PUSHCONTROL1B(1)
      END IF
      CALL PUSHREAL8(f0)
      f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
      CALL PUSHREAL8(f1)
      f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
      CALL PUSHREAL8(f2)
      f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
      CALL PUSHREAL8(beta0)
      beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi)&
&        **2
      CALL PUSHREAL8(beta1)
      beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
      CALL PUSHREAL8(beta2)
      beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi)&
&        **2
    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
      ad_from13 = i_start
      DO i=ad_from13,i_start_f-1
        IF (i .EQ. ids + 1) THEN
          CALL PUSHINTEGER4(k)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (i .EQ. ids + 2) THEN
          CALL PUSHINTEGER4(k)
! third order
          DO k=kts+1,ktf
            CALL PUSHREAL8(vel)
          END DO
          k = ktf + 1
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(ad_from13)
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (degrade_xe) THEN
      DO i=i_end_f+1,i_end+1
        IF (i .EQ. ide - 1) THEN
          CALL PUSHINTEGER4(k)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (i .EQ. ide - 2) THEN
          CALL PUSHINTEGER4(k)
! third order flux one in from the boundary
          DO k=kts+1,ktf
            CALL PUSHREAL8(vel)
          END DO
          k = ktf + 1
          CALL PUSHREAL8(vel)
          vel = (2.-fzm(k-1))*ru(i, k-1, j) - fzp(k-1)*ru(i, k-2, j)
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHCONTROL1B(1)
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    CALL PUSHINTEGER4(k)
!  x flux-divergence into tendency
    DO k=kts+1,ktf+1
      ad_from14 = i_start
      i = i_end + 1
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from14)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from15)
!  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
    ad_from16 = j_start
    DO j=ad_from16,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from16)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from17 = j_start
    DO j=ad_from17,j_end
      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
        CALL PUSHREAL8(ub)
        ub = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(ub)
        ub = uw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from17)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_xe .AND. ite .EQ. ide) THEN
    ad_from18 = j_start
    DO j=ad_from18,j_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(ub)
          ub = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(ub)
          ub = uw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from18)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from19 = j_start
    DO j=ad_from19,j_end
      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
        CALL PUSHREAL8(ub)
        ub = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(ub)
        ub = uw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHINTEGER4(ad_from19)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ys .AND. jts .EQ. jds) THEN
    ad_from20 = i_start
    DO i=ad_from20,i_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from20)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from21 = i_start
    DO i=ad_from21,i_end
      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
        CALL PUSHREAL8(vb)
        vb = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(vb)
        vb = vw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from21)
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%open_ye .AND. jte .EQ. jde) THEN
    ad_from22 = i_start
    DO i=ad_from22,i_end
      CALL PUSHINTEGER4(k)
      DO k=kts+1,ktf
        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
          CALL PUSHREAL8(vb)
          vb = 0.
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(vb)
          vb = vw
          CALL PUSHCONTROL1B(1)
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from22)
    CALL PUSHINTEGER4(k)
    k = ktf + 1
    ad_from23 = i_start
    DO i=ad_from23,i_end
      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
        CALL PUSHREAL8(vb)
        vb = 0.
        CALL PUSHCONTROL1B(0)
      ELSE
        CALL PUSHREAL8(vb)
        vb = vw
        CALL PUSHCONTROL1B(1)
      END IF
    END DO
    CALL PUSHINTEGER4(i - 1)
    CALL PUSHINTEGER4(ad_from23)
    CALL PUSHCONTROL1B(1)
  ELSE
    CALL PUSHCONTROL1B(0)
  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
    CALL PUSHINTEGER4(i_end)
    i_end = ide - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(i_end)
    i_end = ite
    CALL PUSHCONTROL1B(1)
  END IF
  j_start = jts
  IF (jte .GT. jde - 1) THEN
    CALL PUSHINTEGER4(j_end)
    j_end = jde - 1
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHINTEGER4(j_end)
    j_end = jte
    CALL PUSHCONTROL1B(1)
  END IF
!    vert_order_test : IF (vert_order == 6) THEN    
! ELSE IF (vert_order == 5) THEN    
  DO j=j_start,j_end
    CALL PUSHINTEGER4(k)
    DO k=kts+3,ktf-1
      DO i=i_start,i_end
        CALL PUSHREAL8(vel)
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        IF (-vel*sign(1,time_step) .GE. 0.0) THEN
          CALL PUSHREAL8(qip2)
          qip2 = w(i, k+1, j)
          CALL PUSHREAL8(qip1)
          qip1 = w(i, k, j)
          CALL PUSHREAL8(qi)
          qi = w(i, k-1, j)
          CALL PUSHREAL8(qim1)
          qim1 = w(i, k-2, j)
          CALL PUSHREAL8(qim2)
          qim2 = w(i, k-3, j)
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHREAL8(qip2)
          qip2 = w(i, k-2, j)
          CALL PUSHREAL8(qip1)
          qip1 = w(i, k-1, j)
          CALL PUSHREAL8(qi)
          qi = w(i, k, j)
          CALL PUSHREAL8(qim1)
          qim1 = w(i, k+1, j)
          CALL PUSHREAL8(qim2)
          qim2 = w(i, k+2, j)
          CALL PUSHCONTROL1B(1)
        END IF
        CALL PUSHREAL8(f0)
        f0 = 1./3.*qim2 - 7./6.*qim1 + 11./6.*qi
        CALL PUSHREAL8(f1)
        f1 = -(1./6.*qim1) + 5./6.*qi + 1./3.*qip1
        CALL PUSHREAL8(f2)
        f2 = 1./3.*qi + 5./6.*qip1 - 1./6.*qip2
        CALL PUSHREAL8(beta0)
        beta0 = 13./12.*(qim2-2.*qim1+qi)**2 + 1./4.*(qim2-4.*qim1+3.*qi&
&          )**2
        CALL PUSHREAL8(beta1)
        beta1 = 13./12.*(qim1-2.*qi+qip1)**2 + 1./4.*(qim1-qip1)**2
        CALL PUSHREAL8(beta2)
        beta2 = 13./12.*(qi-2.*qip1+qip2)**2 + 1./4.*(qip2-4.*qip1+3.*qi&
&          )**2
      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
      CALL PUSHREAL8(vel)
    END DO
    CALL PUSHINTEGER4(k)
! pick up flux contribution for w at the lid, wcs. 13 march 2004
    k = ktf + 1
  END DO
  vfluxb = 0.0
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      vfluxb(i, k) = vfluxb(i, k) + rdzu(k-1)*2.*tendencyb(i, k, j)
    END DO
    DO k=ktf,kts+1,-1
      DO i=i_end,i_start,-1
        vfluxb(i, k+1) = vfluxb(i, k+1) - rdzu(k)*tendencyb(i, k, j)
        vfluxb(i, k) = vfluxb(i, k) + rdzu(k)*tendencyb(i, k, j)
      END DO
    END DO
    CALL POPINTEGER4(k)
    DO i=i_end,i_start,-1
      k = ktf + 1
      temp54b = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
      temp54b0 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp54b
      romb(i, k-1, j) = romb(i, k-1, j) + temp54b
      wb0(i, k, j) = wb0(i, k, j) + temp54b0
      wb0(i, k-1, j) = wb0(i, k-1, j) + temp54b0
      vfluxb(i, k) = 0.0
      k = ktf
      vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
      temp50 = w(i, k+1, j) - w(i, k-2, j) - 3.*(w(i, k, j)-w(i, k-1, j)&
&        )
      temp53 = SIGN(1., -vel)
      temp52 = temp53/12.0
      temp51 = SIGN(1, time_step)
      temp50b = vel*vfluxb(i, k)
      temp50b0 = temp50b/12.0
      temp50b1 = temp51*temp52*temp50b
      velb = ((7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))/&
&        12.0+temp51*(temp52*temp50))*vfluxb(i, k)
      wb0(i, k, j) = wb0(i, k, j) + 7.*temp50b0 - 3.*temp50b1
      wb0(i, k-1, j) = wb0(i, k-1, j) + 3.*temp50b1 + 7.*temp50b0
      wb0(i, k+1, j) = wb0(i, k+1, j) + temp50b1 - temp50b0
      wb0(i, k-2, j) = wb0(i, k-2, j) - temp50b1 - temp50b0
      vfluxb(i, k) = 0.0
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
      k = kts + 2
      vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
      temp46 = w(i, k+1, j) - w(i, k-2, j) - 3.*(w(i, k, j)-w(i, k-1, j)&
&        )
      temp49 = SIGN(1., -vel)
      temp48 = temp49/12.0
      temp47 = SIGN(1, time_step)
      temp46b1 = vel*vfluxb(i, k)
      temp46b2 = temp46b1/12.0
      temp46b3 = temp47*temp48*temp46b1
      velb = ((7.*(w(i, k, j)+w(i, k-1, j))-w(i, k+1, j)-w(i, k-2, j))/&
&        12.0+temp47*(temp48*temp46))*vfluxb(i, k)
      wb0(i, k, j) = wb0(i, k, j) + 7.*temp46b2 - 3.*temp46b3
      wb0(i, k-1, j) = wb0(i, k-1, j) + 3.*temp46b3 + 7.*temp46b2
      wb0(i, k+1, j) = wb0(i, k+1, j) + temp46b3 - temp46b2
      wb0(i, k-2, j) = wb0(i, k-2, j) - temp46b3 - temp46b2
      vfluxb(i, k) = 0.0
      CALL POPREAL8(vel)
      romb(i, k, j) = romb(i, k, j) + 0.5*velb
      romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
      k = kts + 1
      temp46b4 = 0.25*(w(i, k, j)+w(i, k-1, j))*vfluxb(i, k)
      temp46b5 = 0.25*(rom(i, k, j)+rom(i, k-1, j))*vfluxb(i, k)
      romb(i, k, j) = romb(i, k, j) + temp46b4
      romb(i, k-1, j) = romb(i, k-1, j) + temp46b4
      wb0(i, k, j) = wb0(i, k, j) + temp46b5
      wb0(i, k-1, j) = wb0(i, k-1, j) + temp46b5
      vfluxb(i, k) = 0.0
    END DO
    DO k=ktf-1,kts+3,-1
      DO i=i_end,i_start,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = 0.5*(rom(i, k, j)+rom(i, k-1, j))
        temp46b = vel*vfluxb(i, k)/sumwk
        temp46b0 = (wi0*f0+wi1*f1+wi2*f2)*vfluxb(i, k)/sumwk
        f0b = wi0*temp46b
        f1b = wi1*temp46b
        f2b = wi2*temp46b
        velb = temp46b0
        sumwkb = -(vel*temp46b0/sumwk)
        wi0b = sumwkb + f0*temp46b
        wi1b = sumwkb + f1*temp46b
        wi2b = sumwkb + f2*temp46b
        vfluxb(i, k) = 0.0
        temp45 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp45**2)
        END IF
        temp44 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp44**2)
        END IF
        temp43 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp43**2)
        END IF
        CALL POPREAL8(beta2)
        temp43b35 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp43b36 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp43b36 - f2b/6. + temp43b35
        CALL POPREAL8(beta1)
        temp43b37 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp43b40 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp43b37 - temp43b40 + f1b/3. + 5.*f2b/6. - 4.*&
&          temp43b36 - 2.*temp43b35
        CALL POPREAL8(beta0)
        temp43b39 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp43b38 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp43b37 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp43b38 + temp43b39 + 3.*temp43b36 + temp43b35
        qim1b = temp43b40 - 4.*temp43b38 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp43b39 + temp43b37
        qim2b = f0b/3. + temp43b38 + temp43b39
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          wb0(i, k-3, j) = wb0(i, k-3, j) + qim2b
          CALL POPREAL8(qim1)
          wb0(i, k-2, j) = wb0(i, k-2, j) + qim1b
          CALL POPREAL8(qi)
          wb0(i, k-1, j) = wb0(i, k-1, j) + qib
          CALL POPREAL8(qip1)
          wb0(i, k, j) = wb0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          wb0(i, k+1, j) = wb0(i, k+1, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          wb0(i, k+2, j) = wb0(i, k+2, j) + qim2b
          CALL POPREAL8(qim1)
          wb0(i, k+1, j) = wb0(i, k+1, j) + qim1b
          CALL POPREAL8(qi)
          wb0(i, k, j) = wb0(i, k, j) + qib
          CALL POPREAL8(qip1)
          wb0(i, k-1, j) = wb0(i, k-1, j) + qip1b
          CALL POPREAL8(qip2)
          wb0(i, k-2, j) = wb0(i, k-2, j) + qip2b
        END IF
        CALL POPREAL8(vel)
        romb(i, k, j) = romb(i, k, j) + 0.5*velb
        romb(i, k-1, j) = romb(i, k-1, j) + 0.5*velb
      END DO
    END DO
    CALL POPINTEGER4(k)
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(j_end)
  ELSE
    CALL POPINTEGER4(j_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(i_end)
  ELSE
    CALL POPINTEGER4(i_end)
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .NE. 0) THEN
    CALL POPINTEGER4(ad_from23)
    CALL POPINTEGER4(ad_to23)
    DO i=ad_to23,ad_from23,-1
      temp43b31 = -(rdy*tendencyb(i, k, j_end))
      temp43b32 = w(i, k, j_end)*temp43b31
      temp43b33 = (2.-fzm(k-1))*temp43b32
      temp43b34 = -(fzp(k-1)*temp43b32)
      vbb = (w_old(i, k, j_end)-w_old(i, k, j_end-1))*temp43b31
      w_oldb(i, k, j_end) = w_oldb(i, k, j_end) + vb*temp43b31
      w_oldb(i, k, j_end-1) = w_oldb(i, k, j_end-1) - vb*temp43b31
      wb0(i, k, j_end) = wb0(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)))*temp43b31
      rvb(i, k-1, jte) = rvb(i, k-1, jte) + temp43b33
      rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) - temp43b33
      rvb(i, k-2, jte) = rvb(i, k-2, jte) + temp43b34
      rvb(i, k-2, jte-1) = rvb(i, k-2, jte-1) - temp43b34
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(vb)
        vwb = 0.0
      ELSE
        CALL POPREAL8(vb)
        vwb = vbb
      END IF
      temp43b29 = 0.5*(2.-fzm(k-1))*vwb
      temp43b30 = -(0.5*fzp(k-1)*vwb)
      rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) + temp43b29
      rvb(i, k-1, jte) = rvb(i, k-1, jte) + temp43b29
      rvb(i, k-2, jte-1) = rvb(i, k-2, jte-1) + temp43b30
      rvb(i, k-2, jte) = rvb(i, k-2, jte) + temp43b30
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from22)
    CALL POPINTEGER4(ad_to22)
    DO i=ad_to22,ad_from22,-1
      DO k=ktf,kts+1,-1
        temp43b27 = -(rdy*tendencyb(i, k, j_end))
        temp43b28 = w(i, k, j_end)*temp43b27
        vbb = (w_old(i, k, j_end)-w_old(i, k, j_end-1))*temp43b27
        w_oldb(i, k, j_end) = w_oldb(i, k, j_end) + vb*temp43b27
        w_oldb(i, k, j_end-1) = w_oldb(i, k, j_end-1) - vb*temp43b27
        wb0(i, k, j_end) = wb0(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)))*&
&          temp43b27
        rvb(i, k, jte) = rvb(i, k, jte) + fzm(k)*temp43b28
        rvb(i, k, jte-1) = rvb(i, k, jte-1) - fzm(k)*temp43b28
        rvb(i, k-1, jte) = rvb(i, k-1, jte) + fzp(k)*temp43b28
        rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) - fzp(k)*temp43b28
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        temp43b26 = 0.5*vwb
        rvb(i, k, jte-1) = rvb(i, k, jte-1) + fzm(k)*temp43b26
        rvb(i, k, jte) = rvb(i, k, jte) + fzm(k)*temp43b26
        rvb(i, k-1, jte-1) = rvb(i, k-1, jte-1) + fzp(k)*temp43b26
        rvb(i, k-1, jte) = rvb(i, k-1, jte) + fzp(k)*temp43b26
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from21)
    CALL POPINTEGER4(ad_to21)
    DO i=ad_to21,ad_from21,-1
      temp43b22 = -(rdy*tendencyb(i, k, jts))
      temp43b23 = w(i, k, jts)*temp43b22
      temp43b24 = (2.-fzm(k-1))*temp43b23
      temp43b25 = -(fzp(k-1)*temp43b23)
      vbb = (w_old(i, k, jts+1)-w_old(i, k, jts))*temp43b22
      w_oldb(i, k, jts+1) = w_oldb(i, k, jts+1) + vb*temp43b22
      w_oldb(i, k, jts) = w_oldb(i, k, jts) - vb*temp43b22
      wb0(i, k, jts) = wb0(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)))&
&        *temp43b22
      rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + temp43b24
      rvb(i, k-1, jts) = rvb(i, k-1, jts) - temp43b24
      rvb(i, k-2, jts+1) = rvb(i, k-2, jts+1) + temp43b25
      rvb(i, k-2, jts) = rvb(i, k-2, jts) - temp43b25
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(vb)
        vwb = 0.0
      ELSE
        CALL POPREAL8(vb)
        vwb = vbb
      END IF
      temp43b20 = 0.5*(2.-fzm(k-1))*vwb
      temp43b21 = -(0.5*fzp(k-1)*vwb)
      rvb(i, k-1, jts) = rvb(i, k-1, jts) + temp43b20
      rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + temp43b20
      rvb(i, k-2, jts) = rvb(i, k-2, jts) + temp43b21
      rvb(i, k-2, jts+1) = rvb(i, k-2, jts+1) + temp43b21
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from20)
    CALL POPINTEGER4(ad_to20)
    DO i=ad_to20,ad_from20,-1
      DO k=ktf,kts+1,-1
        temp43b18 = -(rdy*tendencyb(i, k, jts))
        temp43b19 = w(i, k, jts)*temp43b18
        vbb = (w_old(i, k, jts+1)-w_old(i, k, jts))*temp43b18
        w_oldb(i, k, jts+1) = w_oldb(i, k, jts+1) + vb*temp43b18
        w_oldb(i, k, jts) = w_oldb(i, k, jts) - vb*temp43b18
        wb0(i, k, jts) = wb0(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)))*&
&          temp43b18
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + fzm(k)*temp43b19
        rvb(i, k, jts) = rvb(i, k, jts) - fzm(k)*temp43b19
        rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + fzp(k)*temp43b19
        rvb(i, k-1, jts) = rvb(i, k-1, jts) - fzp(k)*temp43b19
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(vb)
          vwb = 0.0
        ELSE
          CALL POPREAL8(vb)
          vwb = vbb
        END IF
        temp43b17 = 0.5*vwb
        rvb(i, k, jts) = rvb(i, k, jts) + fzm(k)*temp43b17
        rvb(i, k, jts+1) = rvb(i, k, jts+1) + fzm(k)*temp43b17
        rvb(i, k-1, jts) = rvb(i, k-1, jts) + fzp(k)*temp43b17
        rvb(i, k-1, jts+1) = rvb(i, k-1, jts+1) + fzp(k)*temp43b17
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from19)
    CALL POPINTEGER4(ad_to19)
    DO j=ad_to19,ad_from19,-1
      temp43b13 = -(rdx*tendencyb(i_end, k, j))
      temp43b14 = w(i_end, k, j)*temp43b13
      temp43b15 = (2.-fzm(k-1))*temp43b14
      temp43b16 = -(fzp(k-1)*temp43b14)
      ubb = (w_old(i_end, k, j)-w_old(i_end-1, k, j))*temp43b13
      w_oldb(i_end, k, j) = w_oldb(i_end, k, j) + ub*temp43b13
      w_oldb(i_end-1, k, j) = w_oldb(i_end-1, k, j) - ub*temp43b13
      wb0(i_end, k, j) = wb0(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)))*temp43b13
      rub(ite, k-1, j) = rub(ite, k-1, j) + temp43b15
      rub(ite-1, k-1, j) = rub(ite-1, k-1, j) - temp43b15
      rub(ite, k-2, j) = rub(ite, k-2, j) + temp43b16
      rub(ite-1, k-2, j) = rub(ite-1, k-2, j) - temp43b16
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(ub)
        uwb = 0.0
      ELSE
        CALL POPREAL8(ub)
        uwb = ubb
      END IF
      temp43b11 = 0.5*(2.-fzm(k-1))*uwb
      temp43b12 = -(0.5*fzp(k-1)*uwb)
      rub(ite-1, k-1, j) = rub(ite-1, k-1, j) + temp43b11
      rub(ite, k-1, j) = rub(ite, k-1, j) + temp43b11
      rub(ite-1, k-2, j) = rub(ite-1, k-2, j) + temp43b12
      rub(ite, k-2, j) = rub(ite, k-2, j) + temp43b12
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from18)
    CALL POPINTEGER4(ad_to18)
    DO j=ad_to18,ad_from18,-1
      DO k=ktf,kts+1,-1
        temp43b9 = -(rdx*tendencyb(i_end, k, j))
        temp43b10 = w(i_end, k, j)*temp43b9
        ubb = (w_old(i_end, k, j)-w_old(i_end-1, k, j))*temp43b9
        w_oldb(i_end, k, j) = w_oldb(i_end, k, j) + ub*temp43b9
        w_oldb(i_end-1, k, j) = w_oldb(i_end-1, k, j) - ub*temp43b9
        wb0(i_end, k, j) = wb0(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)))*&
&          temp43b9
        rub(ite, k, j) = rub(ite, k, j) + fzm(k)*temp43b10
        rub(ite-1, k, j) = rub(ite-1, k, j) - fzm(k)*temp43b10
        rub(ite, k-1, j) = rub(ite, k-1, j) + fzp(k)*temp43b10
        rub(ite-1, k-1, j) = rub(ite-1, k-1, j) - fzp(k)*temp43b10
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        temp43b8 = 0.5*uwb
        rub(ite-1, k, j) = rub(ite-1, k, j) + fzm(k)*temp43b8
        rub(ite, k, j) = rub(ite, k, j) + fzm(k)*temp43b8
        rub(ite-1, k-1, j) = rub(ite-1, k-1, j) + fzp(k)*temp43b8
        rub(ite, k-1, j) = rub(ite, k-1, j) + fzp(k)*temp43b8
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    CALL POPINTEGER4(ad_from17)
    CALL POPINTEGER4(ad_to17)
    DO j=ad_to17,ad_from17,-1
      temp43b4 = -(rdx*tendencyb(its, k, j))
      temp43b5 = w(its, k, j)*temp43b4
      temp43b6 = (2.-fzm(k-1))*temp43b5
      temp43b7 = -(fzp(k-1)*temp43b5)
      ubb = (w_old(its+1, k, j)-w_old(its, k, j))*temp43b4
      w_oldb(its+1, k, j) = w_oldb(its+1, k, j) + ub*temp43b4
      w_oldb(its, k, j) = w_oldb(its, k, j) - ub*temp43b4
      wb0(its, k, j) = wb0(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)))&
&        *temp43b4
      rub(its+1, k-1, j) = rub(its+1, k-1, j) + temp43b6
      rub(its, k-1, j) = rub(its, k-1, j) - temp43b6
      rub(its+1, k-2, j) = rub(its+1, k-2, j) + temp43b7
      rub(its, k-2, j) = rub(its, k-2, j) - temp43b7
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(ub)
        uwb = 0.0
      ELSE
        CALL POPREAL8(ub)
        uwb = ubb
      END IF
      temp43b2 = 0.5*(2.-fzm(k-1))*uwb
      temp43b3 = -(0.5*fzp(k-1)*uwb)
      rub(its, k-1, j) = rub(its, k-1, j) + temp43b2
      rub(its+1, k-1, j) = rub(its+1, k-1, j) + temp43b2
      rub(its, k-2, j) = rub(its, k-2, j) + temp43b3
      rub(its+1, k-2, j) = rub(its+1, k-2, j) + temp43b3
    END DO
    CALL POPINTEGER4(k)
    CALL POPINTEGER4(ad_from16)
    CALL POPINTEGER4(ad_to16)
    DO j=ad_to16,ad_from16,-1
      DO k=ktf,kts+1,-1
        temp43b0 = -(rdx*tendencyb(its, k, j))
        temp43b1 = w(its, k, j)*temp43b0
        ubb = (w_old(its+1, k, j)-w_old(its, k, j))*temp43b0
        w_oldb(its+1, k, j) = w_oldb(its+1, k, j) + ub*temp43b0
        w_oldb(its, k, j) = w_oldb(its, k, j) - ub*temp43b0
        wb0(its, k, j) = wb0(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)))*&
&          temp43b0
        rub(its+1, k, j) = rub(its+1, k, j) + fzm(k)*temp43b1
        rub(its, k, j) = rub(its, k, j) - fzm(k)*temp43b1
        rub(its+1, k-1, j) = rub(its+1, k-1, j) + fzp(k)*temp43b1
        rub(its, k-1, j) = rub(its, k-1, j) - fzp(k)*temp43b1
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(ub)
          uwb = 0.0
        ELSE
          CALL POPREAL8(ub)
          uwb = ubb
        END IF
        temp43b = 0.5*uwb
        rub(its, k, j) = rub(its, k, j) + fzm(k)*temp43b
        rub(its+1, k, j) = rub(its+1, k, j) + fzm(k)*temp43b
        rub(its, k-1, j) = rub(its, k-1, j) + fzp(k)*temp43b
        rub(its+1, k-1, j) = rub(its+1, k-1, j) + fzp(k)*temp43b
      END DO
      CALL POPINTEGER4(k)
    END DO
  END IF
  fqxb = 0.0
  CALL POPINTEGER4(ad_from15)
  CALL POPINTEGER4(ad_to15)
  DO j=ad_to15,ad_from15,-1
    DO k=ktf+1,kts+1,-1
      CALL POPINTEGER4(ad_from14)
      CALL POPINTEGER4(ad_to14)
      DO i=ad_to14,ad_from14,-1
        mrdx = msftx(i, j)*rdx
        fqxb(i+1, k) = fqxb(i+1, k) - mrdx*tendencyb(i, k, j)
        fqxb(i, k) = fqxb(i, k) + mrdx*tendencyb(i, k, j)
      END DO
    END DO
    CALL POPINTEGER4(k)
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      CALL POPINTEGER4(ad_to13)
      DO i=ad_to13,i_end_f+1,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          k = ktf + 1
          temp39 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1, k&
&            , j))
          temp42 = SIGN(1., vel)
          temp41 = temp42/12.0
          temp40 = SIGN(1, time_step)
          temp39b = vel*fqxb(i, k)
          temp39b0 = temp39b/12.0
          temp39b1 = temp40*temp41*temp39b
          velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, j&
&            ))/12.0+temp40*(temp41*temp39))*fqxb(i, k)
          wb0(i, k, j) = wb0(i, k, j) + 7.*temp39b0 - 3.*temp39b1
          wb0(i-1, k, j) = wb0(i-1, k, j) + 3.*temp39b1 + 7.*temp39b0
          wb0(i+1, k, j) = wb0(i+1, k, j) + temp39b1 - temp39b0
          wb0(i-2, k, j) = wb0(i-2, k, j) - temp39b1 - temp39b0
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
          DO k=ktf,kts+1,-1
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            temp35 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1&
&              , k, j))
            temp38 = SIGN(1., vel)
            temp37 = temp38/12.0
            temp36 = SIGN(1, time_step)
            temp35b3 = vel*fqxb(i, k)
            temp35b4 = temp35b3/12.0
            temp35b5 = temp36*temp37*temp35b3
            velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&              , j))/12.0+temp36*(temp37*temp35))*fqxb(i, k)
            wb0(i, k, j) = wb0(i, k, j) + 7.*temp35b4 - 3.*temp35b5
            wb0(i-1, k, j) = wb0(i-1, k, j) + 3.*temp35b5 + 7.*temp35b4
            wb0(i+1, k, j) = wb0(i+1, k, j) + temp35b5 - temp35b4
            wb0(i-2, k, j) = wb0(i-2, k, j) - temp35b5 - temp35b4
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          k = ktf + 1
          temp35b1 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
          temp35b2 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-2&
&            , j))*fqxb(i, k)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp35b1
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp35b1
          wb0(i, k, j) = wb0(i, k, j) + temp35b2
          wb0(i-1, k, j) = wb0(i-1, k, j) + temp35b2
          fqxb(i, k) = 0.0
          DO k=ktf,kts+1,-1
            temp35b = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp35b0 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&              fqxb(i, k)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*temp35b
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp35b
            wb0(i, k, j) = wb0(i, k, j) + temp35b0
            wb0(i-1, k, j) = wb0(i-1, k, j) + temp35b0
            fqxb(i, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
      END DO
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_from13)
      DO i=i_start_f-1,ad_from13,-1
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          k = ktf + 1
          temp31 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1, k&
&            , j))
          temp34 = SIGN(1., vel)
          temp33 = temp34/12.0
          temp32 = SIGN(1, time_step)
          temp31b = vel*fqxb(i, k)
          temp31b0 = temp31b/12.0
          temp31b1 = temp32*temp33*temp31b
          velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k, j&
&            ))/12.0+temp32*(temp33*temp31))*fqxb(i, k)
          wb0(i, k, j) = wb0(i, k, j) + 7.*temp31b0 - 3.*temp31b1
          wb0(i-1, k, j) = wb0(i-1, k, j) + 3.*temp31b1 + 7.*temp31b0
          wb0(i+1, k, j) = wb0(i+1, k, j) + temp31b1 - temp31b0
          wb0(i-2, k, j) = wb0(i-2, k, j) - temp31b1 - temp31b0
          fqxb(i, k) = 0.0
          CALL POPREAL8(vel)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
          DO k=ktf,kts+1,-1
            vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
            temp27 = w(i+1, k, j) - w(i-2, k, j) - 3.*(w(i, k, j)-w(i-1&
&              , k, j))
            temp30 = SIGN(1., vel)
            temp29 = temp30/12.0
            temp28 = SIGN(1, time_step)
            temp27b5 = vel*fqxb(i, k)
            temp27b6 = temp27b5/12.0
            temp27b7 = temp28*temp29*temp27b5
            velb = ((7.*(w(i, k, j)+w(i-1, k, j))-w(i+1, k, j)-w(i-2, k&
&              , j))/12.0+temp28*(temp29*temp27))*fqxb(i, k)
            wb0(i, k, j) = wb0(i, k, j) + 7.*temp27b6 - 3.*temp27b7
            wb0(i-1, k, j) = wb0(i-1, k, j) + 3.*temp27b7 + 7.*temp27b6
            wb0(i+1, k, j) = wb0(i+1, k, j) + temp27b7 - temp27b6
            wb0(i-2, k, j) = wb0(i-2, k, j) - temp27b7 - temp27b6
            fqxb(i, k) = 0.0
            CALL POPREAL8(vel)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
          END DO
          CALL POPINTEGER4(k)
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          k = ktf + 1
          temp27b3 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
          temp27b4 = 0.5*((2.-fzm(k-1))*ru(i, k-1, j)-fzp(k-1)*ru(i, k-2&
&            , j))*fqxb(i, k)
          rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*temp27b3
          rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*temp27b3
          wb0(i, k, j) = wb0(i, k, j) + temp27b4
          wb0(i-1, k, j) = wb0(i-1, k, j) + temp27b4
          fqxb(i, k) = 0.0
          DO k=ktf,kts+1,-1
            temp27b1 = 0.5*(w(i, k, j)+w(i-1, k, j))*fqxb(i, k)
            temp27b2 = 0.5*(fzm(k)*ru(i, k, j)+fzp(k)*ru(i, k-1, j))*&
&              fqxb(i, k)
            rub(i, k, j) = rub(i, k, j) + fzm(k)*temp27b1
            rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp27b1
            wb0(i, k, j) = wb0(i, k, j) + temp27b2
            wb0(i-1, k, j) = wb0(i-1, k, j) + temp27b2
            fqxb(i, k) = 0.0
          END DO
          CALL POPINTEGER4(k)
        END IF
      END DO
    END IF
    k = ktf + 1
    DO i=i_end_f,i_start_f,-1
      wi0 = gi0/(eps+beta0)**pw
      wi1 = gi1/(eps+beta1)**pw
      wi2 = gi2/(eps+beta2)**pw
      sumwk = wi0 + wi1 + wi2
      temp27b = vel*fqxb(i, k)/sumwk
      temp27b0 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k)/sumwk
      f0b = wi0*temp27b
      f1b = wi1*temp27b
      f2b = wi2*temp27b
      velb = temp27b0
      sumwkb = -(vel*temp27b0/sumwk)
      wi0b = sumwkb + f0*temp27b
      wi1b = sumwkb + f1*temp27b
      wi2b = sumwkb + f2*temp27b
      fqxb(i, k) = 0.0
      temp26 = (eps+beta2)**pw
      IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw))&
&      ) THEN
        beta2b = 0.0
      ELSE
        beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp26**2)
      END IF
      temp25 = (eps+beta1)**pw
      IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw))&
&      ) THEN
        beta1b = 0.0
      ELSE
        beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp25**2)
      END IF
      temp24 = (eps+beta0)**pw
      IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw))&
&      ) THEN
        beta0b = 0.0
      ELSE
        beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp24**2)
      END IF
      CALL POPREAL8(beta2)
      temp24b1 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
      temp24b2 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
      qip2b = temp24b2 - f2b/6. + temp24b1
      CALL POPREAL8(beta1)
      temp24b3 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
      temp24b6 = 2*(qim1-qip1)*beta1b/4.
      qip1b = temp24b3 - temp24b6 + f1b/3. + 5.*f2b/6. - 4.*temp24b2 - &
&        2.*temp24b1
      CALL POPREAL8(beta0)
      temp24b5 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
      temp24b4 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
      qib = f2b/3. - 2.*temp24b3 + 11.*f0b/6. + 5.*f1b/6. + 3.*temp24b4 &
&        + temp24b5 + 3.*temp24b2 + temp24b1
      qim1b = temp24b6 - 4.*temp24b4 - 7.*f0b/6. - f1b/6. - 2.*temp24b5 &
&        + temp24b3
      qim2b = f0b/3. + temp24b4 + temp24b5
      CALL POPREAL8(f2)
      CALL POPREAL8(f1)
      CALL POPREAL8(f0)
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(qim2)
        wb0(i-3, k, j) = wb0(i-3, k, j) + qim2b
        CALL POPREAL8(qim1)
        wb0(i-2, k, j) = wb0(i-2, k, j) + qim1b
        CALL POPREAL8(qi)
        wb0(i-1, k, j) = wb0(i-1, k, j) + qib
        CALL POPREAL8(qip1)
        wb0(i, k, j) = wb0(i, k, j) + qip1b
        CALL POPREAL8(qip2)
        wb0(i+1, k, j) = wb0(i+1, k, j) + qip2b
      ELSE
        CALL POPREAL8(qim2)
        wb0(i+2, k, j) = wb0(i+2, k, j) + qim2b
        CALL POPREAL8(qim1)
        wb0(i+1, k, j) = wb0(i+1, k, j) + qim1b
        CALL POPREAL8(qi)
        wb0(i, k, j) = wb0(i, k, j) + qib
        CALL POPREAL8(qip1)
        wb0(i-1, k, j) = wb0(i-1, k, j) + qip1b
        CALL POPREAL8(qip2)
        wb0(i-2, k, j) = wb0(i-2, k, j) + qip2b
      END IF
      CALL POPREAL8(vel)
      rub(i, k-1, j) = rub(i, k-1, j) + (2.-fzm(k-1))*velb
      rub(i, k-2, j) = rub(i, k-2, j) - fzp(k-1)*velb
    END DO
    DO k=ktf,kts+1,-1
      DO i=i_end_f,i_start_f,-1
        wi0 = gi0/(eps+beta0)**pw
        wi1 = gi1/(eps+beta1)**pw
        wi2 = gi2/(eps+beta2)**pw
        sumwk = wi0 + wi1 + wi2
        vel = fzm(k)*ru(i, k, j) + fzp(k)*ru(i, k-1, j)
        temp24b = vel*fqxb(i, k)/sumwk
        temp24b0 = (wi0*f0+wi1*f1+wi2*f2)*fqxb(i, k)/sumwk
        f0b = wi0*temp24b
        f1b = wi1*temp24b
        f2b = wi2*temp24b
        velb = temp24b0
        sumwkb = -(vel*temp24b0/sumwk)
        wi0b = sumwkb + f0*temp24b
        wi1b = sumwkb + f1*temp24b
        wi2b = sumwkb + f2*temp24b
        fqxb(i, k) = 0.0
        temp23 = (eps+beta2)**pw
        IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta2b = 0.0
        ELSE
          beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp23**2)
        END IF
        temp22 = (eps+beta1)**pw
        IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta1b = 0.0
        ELSE
          beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp22**2)
        END IF
        temp21 = (eps+beta0)**pw
        IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(pw)&
&            )) THEN
          beta0b = 0.0
        ELSE
          beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp21**2)
        END IF
        CALL POPREAL8(beta2)
        temp21b = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
        temp21b0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
        qip2b = temp21b0 - f2b/6. + temp21b
        CALL POPREAL8(beta1)
        temp21b1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
        temp21b4 = 2*(qim1-qip1)*beta1b/4.
        qip1b = temp21b1 - temp21b4 + f1b/3. + 5.*f2b/6. - 4.*temp21b0 -&
&          2.*temp21b
        CALL POPREAL8(beta0)
        temp21b3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
        temp21b2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
        qib = f2b/3. - 2.*temp21b1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&          temp21b2 + temp21b3 + 3.*temp21b0 + temp21b
        qim1b = temp21b4 - 4.*temp21b2 - 7.*f0b/6. - f1b/6. - 2.*&
&          temp21b3 + temp21b1
        qim2b = f0b/3. + temp21b2 + temp21b3
        CALL POPREAL8(f2)
        CALL POPREAL8(f1)
        CALL POPREAL8(f0)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPREAL8(qim2)
          wb0(i-3, k, j) = wb0(i-3, k, j) + qim2b
          CALL POPREAL8(qim1)
          wb0(i-2, k, j) = wb0(i-2, k, j) + qim1b
          CALL POPREAL8(qi)
          wb0(i-1, k, j) = wb0(i-1, k, j) + qib
          CALL POPREAL8(qip1)
          wb0(i, k, j) = wb0(i, k, j) + qip1b
          CALL POPREAL8(qip2)
          wb0(i+1, k, j) = wb0(i+1, k, j) + qip2b
        ELSE
          CALL POPREAL8(qim2)
          wb0(i+2, k, j) = wb0(i+2, k, j) + qim2b
          CALL POPREAL8(qim1)
          wb0(i+1, k, j) = wb0(i+1, k, j) + qim1b
          CALL POPREAL8(qi)
          wb0(i, k, j) = wb0(i, k, j) + qib
          CALL POPREAL8(qip1)
          wb0(i-1, k, j) = wb0(i-1, k, j) + qip1b
          CALL POPREAL8(qip2)
          wb0(i-2, k, j) = wb0(i-2, k, j) + qip2b
        END IF
        CALL POPREAL8(vel)
        rub(i, k, j) = rub(i, k, j) + fzm(k)*velb
        rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*velb
      END DO
    END DO
    CALL POPINTEGER4(k)
  END DO
  fqyb = 0.0
  CALL POPINTEGER4(ad_from12)
  CALL POPINTEGER4(ad_to12)
  DO j=ad_to12,ad_from12,-1
    CALL POPINTEGER4(jp0)
    CALL POPINTEGER4(jp1)
    CALL POPCONTROL2B(branch)
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) THEN
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from9)
          CALL POPINTEGER4(ad_to9)
          DO i=ad_to9,ad_from9,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
        CALL POPINTEGER4(k)
      ELSE
        DO k=ktf,kts,-1
          CALL POPINTEGER4(ad_from10)
          CALL POPINTEGER4(ad_to10)
          DO i=ad_to10,ad_from10,-1
            mrdy = msftx(i, j-1)*rdy
            fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1&
&              )
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
    ELSE IF (branch .EQ. 2) THEN
      DO k=ktf+1,kts+1,-1
        CALL POPINTEGER4(ad_from11)
        CALL POPINTEGER4(ad_to11)
        DO i=ad_to11,ad_from11,-1
          mrdy = msftx(i, j-1)*rdy
          fqyb(i, k, jp1) = fqyb(i, k, jp1) - mrdy*tendencyb(i, k, j-1)
          fqyb(i, k, jp0) = fqyb(i, k, jp0) + mrdy*tendencyb(i, k, j-1)
        END DO
      END DO
      CALL POPINTEGER4(k)
    END IF
    CALL POPCONTROL3B(branch)
    IF (branch .LT. 3) THEN
      IF (branch .EQ. 0) THEN
        CALL POPINTEGER4(ad_from0)
        CALL POPINTEGER4(ad_to0)
        DO i=ad_to0,ad_from0,-1
          wi0 = gi0/(eps+beta0)**pw
          wi1 = gi1/(eps+beta1)**pw
          wi2 = gi2/(eps+beta2)**pw
          sumwk = wi0 + wi1 + wi2
          temp5b = vel*fqyb(i, k, jp1)/sumwk
          temp5b0 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, jp1)/sumwk
          f0b = wi0*temp5b
          f1b = wi1*temp5b
          f2b = wi2*temp5b
          velb = temp5b0
          sumwkb = -(vel*temp5b0/sumwk)
          wi0b = sumwkb + f0*temp5b
          wi1b = sumwkb + f1*temp5b
          wi2b = sumwkb + f2*temp5b
          fqyb(i, k, jp1) = 0.0
          temp4 = (eps+beta2)**pw
          IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&              pw))) THEN
            beta2b = 0.0
          ELSE
            beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp4**2)
          END IF
          temp3 = (eps+beta1)**pw
          IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&              pw))) THEN
            beta1b = 0.0
          ELSE
            beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp3**2)
          END IF
          temp2 = (eps+beta0)**pw
          IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT(&
&              pw))) THEN
            beta0b = 0.0
          ELSE
            beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp2**2)
          END IF
          CALL POPREAL8(beta2)
          temp2b1 = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
          temp2b2 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
          qip2b = temp2b2 - f2b/6. + temp2b1
          CALL POPREAL8(beta1)
          temp2b3 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
          temp2b6 = 2*(qim1-qip1)*beta1b/4.
          qip1b = temp2b3 - temp2b6 + f1b/3. + 5.*f2b/6. - 4.*temp2b2 - &
&            2.*temp2b1
          CALL POPREAL8(beta0)
          temp2b5 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
          temp2b4 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
          qib = f2b/3. - 2.*temp2b3 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&            temp2b4 + temp2b5 + 3.*temp2b2 + temp2b1
          qim1b = temp2b6 - 4.*temp2b4 - 7.*f0b/6. - f1b/6. - 2.*temp2b5&
&            + temp2b3
          qim2b = f0b/3. + temp2b4 + temp2b5
          CALL POPREAL8(f2)
          CALL POPREAL8(f1)
          CALL POPREAL8(f0)
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            CALL POPREAL8(qim2)
            wb0(i, k, j-3) = wb0(i, k, j-3) + qim2b
            CALL POPREAL8(qim1)
            wb0(i, k, j-2) = wb0(i, k, j-2) + qim1b
            CALL POPREAL8(qi)
            wb0(i, k, j-1) = wb0(i, k, j-1) + qib
            CALL POPREAL8(qip1)
            wb0(i, k, j) = wb0(i, k, j) + qip1b
            CALL POPREAL8(qip2)
            wb0(i, k, j+1) = wb0(i, k, j+1) + qip2b
          ELSE
            CALL POPREAL8(qim2)
            wb0(i, k, j+2) = wb0(i, k, j+2) + qim2b
            CALL POPREAL8(qim1)
            wb0(i, k, j+1) = wb0(i, k, j+1) + qim1b
            CALL POPREAL8(qi)
            wb0(i, k, j) = wb0(i, k, j) + qib
            CALL POPREAL8(qip1)
            wb0(i, k, j-1) = wb0(i, k, j-1) + qip1b
            CALL POPREAL8(qip2)
            wb0(i, k, j-2) = wb0(i, k, j-2) + qip2b
          END IF
          CALL POPREAL8(vel)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from)
          CALL POPINTEGER4(ad_to)
          DO i=ad_to,ad_from,-1
            wi0 = gi0/(eps+beta0)**pw
            wi1 = gi1/(eps+beta1)**pw
            wi2 = gi2/(eps+beta2)**pw
            sumwk = wi0 + wi1 + wi2
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            temp2b = vel*fqyb(i, k, jp1)/sumwk
            temp2b0 = (wi0*f0+wi1*f1+wi2*f2)*fqyb(i, k, jp1)/sumwk
            f0b = wi0*temp2b
            f1b = wi1*temp2b
            f2b = wi2*temp2b
            velb = temp2b0
            sumwkb = -(vel*temp2b0/sumwk)
            wi0b = sumwkb + f0*temp2b
            wi1b = sumwkb + f1*temp2b
            wi2b = sumwkb + f2*temp2b
            fqyb(i, k, jp1) = 0.0
            temp1 = (eps+beta2)**pw
            IF (eps + beta2 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta2b = 0.0
            ELSE
              beta2b = -(gi2*pw*(eps+beta2)**(pw-1)*wi2b/temp1**2)
            END IF
            temp0 = (eps+beta1)**pw
            IF (eps + beta1 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta1b = 0.0
            ELSE
              beta1b = -(gi1*pw*(eps+beta1)**(pw-1)*wi1b/temp0**2)
            END IF
            temp = (eps+beta0)**pw
            IF (eps + beta0 .LE. 0.0 .AND. (pw .EQ. 0.0 .OR. pw .NE. INT&
&                (pw))) THEN
              beta0b = 0.0
            ELSE
              beta0b = -(gi0*pw*(eps+beta0)**(pw-1)*wi0b/temp**2)
            END IF
            CALL POPREAL8(beta2)
            tempb = 13.*2*(qi-2.*qip1+qip2)*beta2b/12.
            tempb0 = 2*(qip2-4.*qip1+3.*qi)*beta2b/4.
            qip2b = tempb0 - f2b/6. + tempb
            CALL POPREAL8(beta1)
            tempb1 = 13.*2*(qim1-2.*qi+qip1)*beta1b/12.
            tempb4 = 2*(qim1-qip1)*beta1b/4.
            qip1b = tempb1 - tempb4 + f1b/3. + 5.*f2b/6. - 4.*tempb0 - &
&              2.*tempb
            CALL POPREAL8(beta0)
            tempb3 = 13.*2*(qim2-2.*qim1+qi)*beta0b/12.
            tempb2 = 2*(qim2-4.*qim1+3.*qi)*beta0b/4.
            qib = f2b/3. - 2.*tempb1 + 11.*f0b/6. + 5.*f1b/6. + 3.*&
&              tempb2 + tempb3 + 3.*tempb0 + tempb
            qim1b = tempb4 - 4.*tempb2 - 7.*f0b/6. - f1b/6. - 2.*tempb3 &
&              + tempb1
            qim2b = f0b/3. + tempb2 + tempb3
            CALL POPREAL8(f2)
            CALL POPREAL8(f1)
            CALL POPREAL8(f0)
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPREAL8(qim2)
              wb0(i, k, j-3) = wb0(i, k, j-3) + qim2b
              CALL POPREAL8(qim1)
              wb0(i, k, j-2) = wb0(i, k, j-2) + qim1b
              CALL POPREAL8(qi)
              wb0(i, k, j-1) = wb0(i, k, j-1) + qib
              CALL POPREAL8(qip1)
              wb0(i, k, j) = wb0(i, k, j) + qip1b
              CALL POPREAL8(qip2)
              wb0(i, k, j+1) = wb0(i, k, j+1) + qip2b
            ELSE
              CALL POPREAL8(qim2)
              wb0(i, k, j+2) = wb0(i, k, j+2) + qim2b
              CALL POPREAL8(qim1)
              wb0(i, k, j+1) = wb0(i, k, j+1) + qim1b
              CALL POPREAL8(qi)
              wb0(i, k, j) = wb0(i, k, j) + qib
              CALL POPREAL8(qip1)
              wb0(i, k, j-1) = wb0(i, k, j-1) + qip1b
              CALL POPREAL8(qip2)
              wb0(i, k, j-2) = wb0(i, k, j-2) + qip2b
            END IF
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
        CALL POPINTEGER4(k)
      ELSE IF (branch .EQ. 1) THEN
        CALL POPINTEGER4(ad_from2)
        CALL POPINTEGER4(ad_to2)
        DO i=ad_to2,ad_from2,-1
          temp5b3 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
          temp5b4 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2&
&            , j))*fqyb(i, k, jp1)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp5b3
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp5b3
          wb0(i, k, j) = wb0(i, k, j) + temp5b4
          wb0(i, k, j-1) = wb0(i, k, j-1) + temp5b4
          fqyb(i, k, jp1) = 0.0
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from1)
          CALL POPINTEGER4(ad_to1)
          DO i=ad_to1,ad_from1,-1
            temp5b1 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
            temp5b2 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*fqyb&
&              (i, k, jp1)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp5b1
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp5b1
            wb0(i, k, j) = wb0(i, k, j) + temp5b2
            wb0(i, k, j-1) = wb0(i, k, j-1) + temp5b2
            fqyb(i, k, jp1) = 0.0
          END DO
        END DO
        CALL POPINTEGER4(k)
      ELSE
        CALL POPINTEGER4(ad_from4)
        CALL POPINTEGER4(ad_to4)
        DO i=ad_to4,ad_from4,-1
          temp9 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k, j&
&            -1))
          temp12 = SIGN(1., vel)
          temp11 = temp12/12.0
          temp10 = SIGN(1, time_step)
          temp9b = vel*fqyb(i, k, jp1)
          temp9b0 = temp9b/12.0
          temp9b1 = temp10*temp11*temp9b
          velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-2&
&            ))/12.0+temp10*(temp11*temp9))*fqyb(i, k, jp1)
          wb0(i, k, j) = wb0(i, k, j) + 7.*temp9b0 - 3.*temp9b1
          wb0(i, k, j-1) = wb0(i, k, j-1) + 3.*temp9b1 + 7.*temp9b0
          wb0(i, k, j+1) = wb0(i, k, j+1) + temp9b1 - temp9b0
          wb0(i, k, j-2) = wb0(i, k, j-2) - temp9b1 - temp9b0
          fqyb(i, k, jp1) = 0.0
          CALL POPREAL8(vel)
          rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
          rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
        END DO
        DO k=ktf,kts+1,-1
          CALL POPINTEGER4(ad_from3)
          CALL POPINTEGER4(ad_to3)
          DO i=ad_to3,ad_from3,-1
            vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
            temp5 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k&
&              , j-1))
            temp8 = SIGN(1., vel)
            temp7 = temp8/12.0
            temp6 = SIGN(1, time_step)
            temp5b5 = vel*fqyb(i, k, jp1)
            temp5b6 = temp5b5/12.0
            temp5b7 = temp6*temp7*temp5b5
            velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j&
&              -2))/12.0+temp6*(temp7*temp5))*fqyb(i, k, jp1)
            wb0(i, k, j) = wb0(i, k, j) + 7.*temp5b6 - 3.*temp5b7
            wb0(i, k, j-1) = wb0(i, k, j-1) + 3.*temp5b7 + 7.*temp5b6
            wb0(i, k, j+1) = wb0(i, k, j+1) + temp5b7 - temp5b6
            wb0(i, k, j-2) = wb0(i, k, j-2) - temp5b7 - temp5b6
            fqyb(i, k, jp1) = 0.0
            CALL POPREAL8(vel)
            rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
            rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
          END DO
        END DO
        CALL POPINTEGER4(k)
      END IF
    ELSE IF (branch .EQ. 3) THEN
      CALL POPINTEGER4(ad_from6)
      CALL POPINTEGER4(ad_to6)
      DO i=ad_to6,ad_from6,-1
        temp13b1 = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
        temp13b2 = 0.5*((2.-fzm(k-1))*rv(i, k-1, j)-fzp(k-1)*rv(i, k-2, &
&          j))*fqyb(i, k, jp1)
        rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*temp13b1
        rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*temp13b1
        wb0(i, k, j) = wb0(i, k, j) + temp13b2
        wb0(i, k, j-1) = wb0(i, k, j-1) + temp13b2
        fqyb(i, k, jp1) = 0.0
      END DO
      DO k=ktf,kts+1,-1
        CALL POPINTEGER4(ad_from5)
        CALL POPINTEGER4(ad_to5)
        DO i=ad_to5,ad_from5,-1
          temp13b = 0.5*(w(i, k, j)+w(i, k, j-1))*fqyb(i, k, jp1)
          temp13b0 = 0.5*(fzm(k)*rv(i, k, j)+fzp(k)*rv(i, k-1, j))*fqyb(&
&            i, k, jp1)
          rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp13b
          rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp13b
          wb0(i, k, j) = wb0(i, k, j) + temp13b0
          wb0(i, k, j-1) = wb0(i, k, j-1) + temp13b0
          fqyb(i, k, jp1) = 0.0
        END DO
      END DO
      CALL POPINTEGER4(k)
    ELSE IF (branch .EQ. 4) THEN
      CALL POPINTEGER4(ad_from8)
      CALL POPINTEGER4(ad_to8)
      DO i=ad_to8,ad_from8,-1
        temp17 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k, j-&
&          1))
        temp20 = SIGN(1., vel)
        temp19 = temp20/12.0
        temp18 = SIGN(1, time_step)
        temp17b = vel*fqyb(i, k, jp1)
        temp17b0 = temp17b/12.0
        temp17b1 = temp18*temp19*temp17b
        velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-2))&
&          /12.0+temp18*(temp19*temp17))*fqyb(i, k, jp1)
        wb0(i, k, j) = wb0(i, k, j) + 7.*temp17b0 - 3.*temp17b1
        wb0(i, k, j-1) = wb0(i, k, j-1) + 3.*temp17b1 + 7.*temp17b0
        wb0(i, k, j+1) = wb0(i, k, j+1) + temp17b1 - temp17b0
        wb0(i, k, j-2) = wb0(i, k, j-2) - temp17b1 - temp17b0
        fqyb(i, k, jp1) = 0.0
        CALL POPREAL8(vel)
        rvb(i, k-1, j) = rvb(i, k-1, j) + (2.-fzm(k-1))*velb
        rvb(i, k-2, j) = rvb(i, k-2, j) - fzp(k-1)*velb
      END DO
      DO k=ktf,kts+1,-1
        CALL POPINTEGER4(ad_from7)
        CALL POPINTEGER4(ad_to7)
        DO i=ad_to7,ad_from7,-1
          vel = fzm(k)*rv(i, k, j) + fzp(k)*rv(i, k-1, j)
          temp13 = w(i, k, j+1) - w(i, k, j-2) - 3.*(w(i, k, j)-w(i, k, &
&            j-1))
          temp16 = SIGN(1., vel)
          temp15 = temp16/12.0
          temp14 = SIGN(1, time_step)
          temp13b3 = vel*fqyb(i, k, jp1)
          temp13b4 = temp13b3/12.0
          temp13b5 = temp14*temp15*temp13b3
          velb = ((7.*(w(i, k, j)+w(i, k, j-1))-w(i, k, j+1)-w(i, k, j-2&
&            ))/12.0+temp14*(temp15*temp13))*fqyb(i, k, jp1)
          wb0(i, k, j) = wb0(i, k, j) + 7.*temp13b4 - 3.*temp13b5
          wb0(i, k, j-1) = wb0(i, k, j-1) + 3.*temp13b5 + 7.*temp13b4
          wb0(i, k, j+1) = wb0(i, k, j+1) + temp13b5 - temp13b4
          wb0(i, k, j-2) = wb0(i, k, j-2) - temp13b5 - temp13b4
          fqyb(i, k, jp1) = 0.0
          CALL POPREAL8(vel)
          rvb(i, k, j) = rvb(i, k, j) + fzm(k)*velb
          rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*velb
        END DO
      END DO
      CALL POPINTEGER4(k)
    END IF
  END DO
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
  CALL POPCONTROL1B(branch)
END SUBROUTINE A_ADVECT_WENO_W

END MODULE a_module_advect_em

