! ======================================================================================
! This file was generated by the version 4.3.6 of ADG on 07/13/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_big_step_utilities_em

   USE module_model_constants
   USE module_state_description, only: p_qg, p_qs, p_qi, gdscheme, tiedtkescheme, ntiedtkescheme, &
   kfetascheme, mskfscheme, g3scheme, p_qv, param_first_scalar, p_qr, p_qc, DFI_FWD
   USE module_configure, ONLY : grid_config_rec_type
   USE module_wrf_error
#ifndef DOUBLE_PRECISION
#   define VPOWX vspowx
#   define VPOW  vspow
#else
#   define VPOWX vpowx
#   define VPOW  vpow
#endif

CONTAINS

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of calc_mu_uv in reverse (adjoint) mode:
!   gradient     of useful results: muu muv mu
!   with respect to varying inputs: muu muv mu
!   RW status of diff variables: muu:in-out muv:in-out mu:incr
SUBROUTINE A_CALC_MU_UV(config_flags, mub0, muub, &
&  muvb, 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, jms:jme) :: muub, muvb
  REAL, DIMENSION(ims:ime, jms:jme) :: mub0
!  local stuff
  INTEGER :: i, j, itf, jtf, im, jm
  INTEGER :: ad_to
  INTEGER :: ad_to0
  INTEGER :: ad_to1
  INTEGER :: ad_to2
  INTEGER :: ad_to3
  INTEGER :: ad_to4
  INTEGER :: ad_to5
  INTEGER :: ad_to6
  INTEGER :: ad_to7
  INTEGER :: ad_to8
  INTEGER :: ad_to9
  INTEGER :: ad_to10
  INTEGER :: branch
!<DESCRIPTION>
!
!  calc_mu_uv calculates the full column dry-air mass at the staggered
!  horizontal velocity points (u,v) and places the results in muu and muv.
!  This routine uses the reference state (mub) and perturbation state (mu)
!
!</DESCRIPTION>
  itf = ite
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  IF (its .NE. ids .AND. ite .NE. ide) THEN
    DO j=jts,jtf
      i = itf + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHCONTROL3B(4)
  ELSE IF (its .EQ. ids .AND. ite .NE. ide) THEN
    DO j=jts,jtf
      i = itf + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
    CALL PUSHINTEGER4(j - 1)
    i = its
    im = its
    IF (config_flags%periodic_x) im = its - 1
    j = jtf + 1
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHCONTROL3B(3)
  ELSE IF (its .NE. ids .AND. ite .EQ. ide) THEN
    DO j=jts,jtf
      i = itf
      CALL PUSHINTEGER4(i - 1)
    END DO
    CALL PUSHINTEGER4(j - 1)
    i = ite
    im = ite - 1
    IF (config_flags%periodic_x) im = ite
    j = jtf + 1
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHCONTROL3B(2)
  ELSE IF (its .EQ. ids .AND. ite .EQ. ide) THEN
    DO j=jts,jtf
      i = itf
      CALL PUSHINTEGER4(i - 1)
    END DO
    CALL PUSHINTEGER4(j - 1)
    im = its
    IF (config_flags%periodic_x) im = its - 1
    j = jtf + 1
    CALL PUSHINTEGER4(j - 1)
    i = ite
    CALL PUSHINTEGER4(im)
    im = ite - 1
    IF (config_flags%periodic_x) im = ite
    j = jtf + 1
    CALL PUSHINTEGER4(j - 1)
    CALL PUSHCONTROL3B(1)
  ELSE
    CALL PUSHCONTROL3B(0)
  END IF
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  jtf = jte
  IF (jts .NE. jds .AND. jte .NE. jde) THEN
    DO j=jts,jtf
      CALL PUSHINTEGER4(i)
    END DO
    DO j=jtf,jts,-1
      DO i=itf,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
        mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
        muvb(i, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  ELSE IF (jts .EQ. jds .AND. jte .NE. jde) THEN
    DO j=jts+1,jtf
      CALL PUSHINTEGER4(i)
    END DO
    j = jts
    jm = jts
    IF (config_flags%periodic_y) jm = jts - 1
    CALL PUSHINTEGER4(i)
    DO i=itf,its,-1
      mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
      mub0(i, jm) = mub0(i, jm) + 0.5*muvb(i, j)
      muvb(i, j) = 0.0
    END DO
    CALL POPINTEGER4(i)
    DO j=jtf,jts+1,-1
      DO i=itf,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
        mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
        muvb(i, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  ELSE IF (jts .NE. jds .AND. jte .EQ. jde) THEN
    DO j=jts,jtf-1
      CALL PUSHINTEGER4(i)
    END DO
    j = jte
    jm = jte - 1
    IF (config_flags%periodic_y) jm = jte
    CALL PUSHINTEGER4(i)
    DO i=itf,its,-1
      mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
      mub0(i, jm) = mub0(i, jm) + 0.5*muvb(i, j)
      muvb(i, j) = 0.0
    END DO
    CALL POPINTEGER4(i)
    DO j=jtf-1,jts,-1
      DO i=itf,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
        mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
        muvb(i, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  ELSE IF (jts .EQ. jds .AND. jte .EQ. jde) THEN
    DO j=jts+1,jtf-1
      CALL PUSHINTEGER4(i)
    END DO
    jm = jts
    IF (config_flags%periodic_y) jm = jts - 1
    CALL PUSHINTEGER4(i)
    j = jte
    CALL PUSHINTEGER4(jm)
    jm = jte - 1
    IF (config_flags%periodic_y) jm = jte
    DO i=itf,its,-1
      mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
      mub0(i, jm) = mub0(i, jm) + 0.5*muvb(i, j)
      muvb(i, j) = 0.0
    END DO
    CALL POPINTEGER4(jm)
    j = jts
    DO i=itf,its,-1
      mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
      mub0(i, jm) = mub0(i, jm) + 0.5*muvb(i, j)
      muvb(i, j) = 0.0
    END DO
    CALL POPINTEGER4(i)
    DO j=jtf-1,jts+1,-1
      DO i=itf,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muvb(i, j)
        mub0(i, j-1) = mub0(i, j-1) + 0.5*muvb(i, j)
        muvb(i, j) = 0.0
      END DO
      CALL POPINTEGER4(i)
    END DO
  END IF
  CALL POPCONTROL3B(branch)
  IF (branch .LT. 2) THEN
    IF (branch .NE. 0) THEN
      CALL POPINTEGER4(ad_to8)
      DO j=ad_to8,jts,-1
        mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
        mub0(im, j) = mub0(im, j) + 0.5*muub(i, j)
        muub(i, j) = 0.0
      END DO
      CALL POPINTEGER4(im)
      i = its
      CALL POPINTEGER4(ad_to7)
      DO j=ad_to7,jts,-1
        mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
        mub0(im, j) = mub0(im, j) + 0.5*muub(i, j)
        muub(i, j) = 0.0
      END DO
      CALL POPINTEGER4(ad_to6)
      DO j=ad_to6,jts,-1
        CALL POPINTEGER4(ad_to5)
        DO i=ad_to5,its+1,-1
          mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
          mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
          muub(i, j) = 0.0
        END DO
      END DO
    END IF
  ELSE IF (branch .EQ. 2) THEN
    CALL POPINTEGER4(ad_to4)
    DO j=ad_to4,jts,-1
      mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
      mub0(im, j) = mub0(im, j) + 0.5*muub(i, j)
      muub(i, j) = 0.0
    END DO
    CALL POPINTEGER4(ad_to3)
    DO j=ad_to3,jts,-1
      CALL POPINTEGER4(ad_to2)
      DO i=ad_to2,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
        mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
        muub(i, j) = 0.0
      END DO
    END DO
  ELSE IF (branch .EQ. 3) THEN
    CALL POPINTEGER4(ad_to1)
    DO j=ad_to1,jts,-1
      mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
      mub0(im, j) = mub0(im, j) + 0.5*muub(i, j)
      muub(i, j) = 0.0
    END DO
    CALL POPINTEGER4(ad_to0)
    DO j=ad_to0,jts,-1
      CALL POPINTEGER4(ad_to)
      DO i=ad_to,its+1,-1
        mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
        mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
        muub(i, j) = 0.0
      END DO
    END DO
  ELSE
    CALL POPINTEGER4(ad_to10)
    DO j=ad_to10,jts,-1
      CALL POPINTEGER4(ad_to9)
      DO i=ad_to9,its,-1
        mub0(i, j) = mub0(i, j) + 0.5*muub(i, j)
        mub0(i-1, j) = mub0(i-1, j) + 0.5*muub(i, j)
        muub(i, j) = 0.0
      END DO
    END DO
  END IF
END SUBROUTINE A_CALC_MU_UV

   SUBROUTINE a_calc_mu_uv_1(config_flags,mu,a_mu,muu,a_muu,muv,a_muv,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
   INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv
   REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
   INTEGER :: i,j,itf,jtf,im,jm

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!      IF      ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN

!         if(config_flags%periodic_x) im = its-1

!         if(config_flags%periodic_x) im = ite

!         if(config_flags%periodic_x) im = its-1

!         if(config_flags%periodic_x) im = ite

!      IF      ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN

!         if(config_flags%periodic_y) jm = jts-1

!         if(config_flags%periodic_y) jm = jte

!         if(config_flags%periodic_y) jm = jts-1

!         if(config_flags%periodic_y) jm = jte

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]

!  IF( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN
!  DO j =jts, jtf
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,j-1)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  ELSE IF( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN
!  DO j =jts+1, jtf
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,j-1)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  j =jts
!  jm =jts
!  IF(config_flags%periodic_y) THEN
!  jm =jts-1
!  END IF
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,jm)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO

!  ELSE IF( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN
!  DO j =jts, jtf-1
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,j-1)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  j =jte
!  jm =jte-1
!  IF(config_flags%periodic_y) THEN
!  jm =jte
!  END IF
!  DO i =its, itf
!  Tmpv001 =mu(i,j-1) +mu(i,jm)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO

!  ELSE IF( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN
!  DO j =jts+1, jtf-1
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,j-1)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  j =jts
!  jm =jts
!  IF(config_flags%periodic_y) THEN
!  jm =jts-1
!  END IF
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i,jm)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO

!  j =jte
!  jm =jte-1
!  IF(config_flags%periodic_y) THEN
!  jm =jte
!  END IF
!  DO i =its, itf
!  Tmpv001 =mu(i,j-1) +mu(i,jm)
!  Tmpv002 =0.5*Tmpv001
!  muv(i,j) =Tmpv002

!  ENDDO

!  END IF

!  Added by Ning Pan, 2010-07-17
   itf =min(ite,ide-1)
   jtf =jte

   IF( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN

   DO j =jtf, jts, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN

!  Added by Ning Pan, 2010-07-17
   j =jts
   jm =jts
   IF(config_flags%periodic_y) jm =jts-1

   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,jm) =a_mu(i,jm) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_y) THEN

!   END IF

   DO j =jtf, jts+1, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN

!  Added by Ning Pan, 2010-07-17
   j =jte
   jm =jte-1
   IF(config_flags%periodic_y) jm =jte

   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   a_mu(i,jm) =a_mu(i,jm) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_y) THEN

!   END IF

   DO j =jtf-1, jts, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN

!  Added by Ning Pan, 2010-07-17
   j =jte
   jm =jte-1
   IF(config_flags%periodic_y) jm =jte

   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   a_mu(i,jm) =a_mu(i,jm) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_y) THEN

!   END IF

   j =jts
   jm =jts
   IF(config_flags%periodic_y) jm =jts-1

   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,jm) =a_mu(i,jm) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_y) THEN

!   END IF

   DO j =jtf-1, jts+1, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[2]
!  itf =min(ite, ide-1)
!  jtf =jte

!LPB[1]

!  IF( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN
!  DO j =jts, jtf
!  DO i =its, itf
!  Tmpv001 =mu(i,j) +mu(i-1,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  ELSE IF( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN
!  DO j =jts, jtf
!  DO i =its+1, itf
!  Tmpv001 =mu(i,j) +mu(i-1,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  i =its
!  im =its
!  IF(config_flags%periodic_x) THEN
!  im =its-1
!  END IF
!  DO j =jts, jtf
!  Tmpv001 =mu(i,j) +mu(im,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO

!  ELSE IF( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN
!  DO j =jts, jtf
!  DO i =its, itf-1
!  Tmpv001 =mu(i,j) +mu(i-1,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  i =ite
!  im =ite-1
!  IF(config_flags%periodic_x) THEN
!  im =ite
!  END IF
!  DO j =jts, jtf
!  Tmpv001 =mu(i-1,j) +mu(im,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO

!  ELSE IF( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN
!  DO j =jts, jtf
!  DO i =its+1, itf-1
!  Tmpv001 =mu(i,j) +mu(i-1,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO
!  ENDDO
!  i =its
!  im =its
!  IF(config_flags%periodic_x) THEN
!  im =its-1
!  END IF
!  DO j =jts, jtf
!  Tmpv001 =mu(i,j) +mu(im,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO

!  i =ite
!  im =ite-1
!  IF(config_flags%periodic_x) THEN
!  im =ite
!  END IF
!  DO j =jts, jtf
!  Tmpv001 =mu(i-1,j) +mu(im,j)
!  Tmpv002 =0.5*Tmpv001
!  muu(i,j) =Tmpv002

!  ENDDO

!  END IF

!  Added by Ning Pan, 2010-07-17
   itf =ite
   jtf =min(jte,jde-1)

   IF( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN

   DO j =jtf, jts, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN

!  Added by Ning Pan, 2010-07-17
   i =its
   im =its
   IF(config_flags%periodic_x) im =its-1

   DO j =jtf, jts, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(im,j) =a_mu(im,j) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_x) THEN

!   END IF

   DO j =jtf, jts, -1
   DO i =itf, its+1, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN

!  Added by Ning Pan, 2010-07-17
   i =ite
   im =ite-1
   IF(config_flags%periodic_x) im =ite

   DO j =jtf, jts, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   a_mu(im,j) =a_mu(im,j) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_x) THEN

!   END IF

   DO j =jtf, jts, -1
   DO i =itf-1, its, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ELSE IF( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN

!  Added by Ning Pan, 2010-07-17
   i =ite
   im =ite-1
   IF(config_flags%periodic_x) im =ite

   DO j =jtf, jts, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   a_mu(im,j) =a_mu(im,j) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_x) THEN

!   END IF

!  Added by Ning Pan, 2010-07-17
   i =its
   im =its
   IF(config_flags%periodic_x) im =its-1

   DO j =jtf, jts, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(im,j) =a_mu(im,j) +a_Tmpv1
   ENDDO

!  Remarked by Ning Pan, 2010-07-17
!   IF(config_flags%periodic_x) THEN

!   END IF

   DO j =jtf, jts, -1
   DO i =itf-1, its+1, -1
   a_Tmpv2 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[0]
!  itf =ite
!  jtf =min(jte, jde-1)

   END SUBROUTINE a_calc_mu_uv_1

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of couple_momentum in reverse (adjoint) mode:
!   gradient     of useful results: u v w ru rv rw mut muu muv
!   with respect to varying inputs: u v w ru rv rw mut muu muv
!   RW status of diff variables: u:incr v:incr w:incr ru:in-out
!                rv:in-out rw:in-out mut:incr muu:incr muv:incr
! Map scale factor comments for this routine:
! Locally not changed, but sent the correct map scale factors
! from module_em (msfuy, msfvx, msfty)
SUBROUTINE A_COUPLE_MOMENTUM(muu, muub, rub, u, ub, msfu, muv, muvb&
&  , rvb, v, vb, msfv, msfv_inv, mut, mutb, rwb, w, wb, msft, ids&
&  , ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts&
&  , jte, kts, kte)
  IMPLICIT NONE
! Input data
  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) :: rub, rvb, rwb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: muu, muv, mut
  REAL, DIMENSION(ims:ime, jms:jme) :: muub, muvb, mutb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfu, msfv, msft, &
&  msfv_inv
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u, v, w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ub, vb, wb
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: ad_to
  INTEGER :: ad_to0
  INTEGER :: ad_to1
  INTEGER :: ad_to2
  REAL :: tempb
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  itf = ite
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  DO j=jts,jtf
    DO k=kts,ktf
      i = itf + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  jtf = jte
  DO j=jts,jtf
    DO k=kts,ktf
      i = itf + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  DO j=jtf,jts,-1
    DO k=kte,kts,-1
      DO i=itf,its,-1
        wb(i, k, j) = wb(i, k, j) + mut(i, j)*rwb(i, k, j)/msft(i, j)
        mutb(i, j) = mutb(i, j) + w(i, k, j)*rwb(i, k, j)/msft(i, j)
        rwb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  CALL POPINTEGER4(ad_to2)
  DO j=ad_to2,jts,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_to1)
      DO i=ad_to1,its,-1
        tempb = msfv_inv(i, j)*rvb(i, k, j)
        vb(i, k, j) = vb(i, k, j) + muv(i, j)*tempb
        muvb(i, j) = muvb(i, j) + v(i, k, j)*tempb
        rvb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  CALL POPINTEGER4(ad_to0)
  DO j=ad_to0,jts,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_to)
      DO i=ad_to,its,-1
        ub(i, k, j) = ub(i, k, j) + muu(i, j)*rub(i, k, j)/msfu(i, j)
        muub(i, j) = muub(i, j) + u(i, k, j)*rub(i, k, j)/msfu(i, j)
        rub(i, k, j) = 0.0
      END DO
    END DO
  END DO
END SUBROUTINE A_COUPLE_MOMENTUM

   SUBROUTINE a_calc_ww_cp(u,a_u,v,a_v,mup,a_mup,mub,ww,a_ww,rdx,rdy,msftx, &
   msfty,msfux,msfuy,msfvx,msfvx_inv,msfvy,dnw,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
   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) :: u,a_u,v,a_v
   REAL,DIMENSION(ims:ime,jms:jme) :: mup,a_mup,mub,msftx,msfty,msfux,msfuy,msfvx, &
   msfvy,msfvx_inv
   REAL,DIMENSION(kms:kme) :: dnw
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ww,a_ww
   REAL :: rdx,rdy
   INTEGER :: i,j,k,itf,jtf,ktf
   REAL,DIMENSION(its:ite) :: dmdt,a_dmdt
   REAL,DIMENSION(its:ite,kts:kte) :: divv,a_divv
   REAL,DIMENSION(its:ite+1,jts:jte+1) :: muu,a_muu,muv,a_muv

   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

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]

       jtf=MIN(jte,jde-1)
       ktf=MIN(kte,kde-1)  
       itf=MIN(ite,ide-1)

!LPB[1]
         DO j=jts,jtf

         DO i=its,min(ite+1,ide)
           muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfuy(i,j)
         ENDDO

         ENDDO

!LPB[2]
         DO j=jts,min(jte+1,jde)

         DO i=its,itf
           muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))*msfvx_inv(i,j)
         ENDDO

         ENDDO

!!LPB[3]
!         DO j=jts,jtf

!           DO i=its,ite
!             dmdt(i) = 0.
!             ww(i,1,j) = 0.
!             ww(i,kte,j) = 0.
!           ENDDO

!           DO k=kts,ktf
!           DO i=its,itf
!             divv(i,k) = msftx(i,j)*dnw(k)*( rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j) &
!   *u(i,k,j))    &
!                                           +rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j))   )
!             dmdt(i) = dmdt(i) + divv(i,k)
!           ENDDO
!           ENDDO

!           DO k=2,ktf
!           DO i=its,itf
!              ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*dmdt(i) - divv(i,k-1)
!           ENDDO
!           ENDDO

!        ENDDO

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K0_ADJ =its, ite
   a_dmdt(K0_ADJ) =0.0
   End Do

   Do K1_ADJ =kts, kte
   Do K0_ADJ =its, ite
   a_divv(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

   Do K1_ADJ =jts, jte+1
   Do K0_ADJ =its, ite+1
   a_muu(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

   Do K1_ADJ =jts, jte+1
   Do K0_ADJ =its, ite+1
   a_muv(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

!PART IV: REVERSE/BACKWARD ACCUMULATIONS


!LPB[3]
   DO j =jtf, jts, -1

! Remarked by Ning Pan, 2010-08-31 : not need to recalculate
!   DO i =its, ite
!   dmdt(i) =0.

!   ww(i,1,j) =0.

!   ww(i,kte,j) =0.

!   ENDDO

!   DO k =kts, ktf
!   DO i =its, itf
!   Tmpv001 =muu(i+1,j)*u(i+1,k,j)
!   Tmpv002 =muu(i,j)*u(i,k,j)
!   Tmpv003 =Tmpv001 -Tmpv002
!   Tmpv004 =rdx*Tmpv003
!   Tmpv005 =muv(i,j+1)*v(i,k,j+1)
!   Tmpv006 =muv(i,j)*v(i,k,j)
!   Tmpv007 =Tmpv005 -Tmpv006
!   Tmpv008 =rdy*Tmpv007
!   Tmpv009 =Tmpv004 +Tmpv008
!   Tmpv010 =msftx(i,j)*dnw(k)*Tmpv009
!!  divv(i,k) =Tmpv010

!   Tmpv001 =dmdt(i) +divv(i,k)
!!  dmdt(i) =Tmpv001

!   ENDDO
!   ENDDO
!   DO k =2, ktf
!   DO i =its, itf
!   Tmpv001 =ww(i,k-1,j) -dnw(k-1)*dmdt(i)
!   Tmpv002 =Tmpv001 -divv(i,k-1)
!!  ww(i,k,j) =Tmpv002

!   ENDDO
!   ENDDO

   DO k =ktf, 2, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_ww(i,k,j)
   a_ww(i,k,j) =0.0
   a_Tmpv1 =a_Tmpv2
   a_divv(i,k-1) =a_divv(i,k-1) -a_Tmpv2
   a_ww(i,k-1,j) =a_ww(i,k-1,j) +a_Tmpv1
   a_dmdt(i) =a_dmdt(i) -dnw(k-1)*a_Tmpv1
   ENDDO
   ENDDO

   DO k =ktf, kts, -1
   DO i =itf, its, -1
   a_Tmpv1 =a_dmdt(i)
   a_dmdt(i) =0.0
   a_dmdt(i) =a_dmdt(i) +a_Tmpv1
   a_divv(i,k) =a_divv(i,k) +a_Tmpv1
   a_Tmpv10 =a_divv(i,k)
   a_divv(i,k) =0.0
   a_Tmpv9 =msftx(i,j)*dnw(k)*a_Tmpv10
   a_Tmpv4 =a_Tmpv9
   a_Tmpv8 =a_Tmpv9
   a_Tmpv7 =rdy*a_Tmpv8
   a_Tmpv5 =a_Tmpv7
   a_Tmpv6 =-a_Tmpv7
   a_muv(i,j) =a_muv(i,j) +v(i,k,j)*a_Tmpv6
   a_v(i,k,j) =a_v(i,k,j) +muv(i,j)*a_Tmpv6
   a_muv(i,j+1) =a_muv(i,j+1) +v(i,k,j+1)*a_Tmpv5
   a_v(i,k,j+1) =a_v(i,k,j+1) +muv(i,j+1)*a_Tmpv5
   a_Tmpv3 =rdx*a_Tmpv4
   a_Tmpv1 =a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
   a_muu(i,j) =a_muu(i,j) +u(i,k,j)*a_Tmpv2
   a_u(i,k,j) =a_u(i,k,j) +muu(i,j)*a_Tmpv2
   a_muu(i+1,j) =a_muu(i+1,j) +u(i+1,k,j)*a_Tmpv1
   a_u(i+1,k,j) =a_u(i+1,k,j) +muu(i+1,j)*a_Tmpv1
   ENDDO
   ENDDO

   DO i =ite, its, -1
   a_ww(i,kte,j) =0.0
   a_ww(i,1,j) =0.0
   a_dmdt(i) =0.0
   ENDDO

   ENDDO

!LPB[2]
   DO j =min(jte+1, jde), jts, -1

!  DO i =its, itf
!  Tmpv001 =mup(i,j) +mub(i,j) +mup(i,j-1)
!  Tmpv002 =Tmpv001 +mub(i,j-1)
!  Tmpv003 =0.5*Tmpv002
!  Tmpv004 =Tmpv003*msfvx_inv(i,j)
!  muv(i,j) =Tmpv004

!  ENDDO

   DO i =itf, its, -1
   a_Tmpv4 =a_muv(i,j)
   a_muv(i,j) =0.0
   a_Tmpv3 =msfvx_inv(i,j)*a_Tmpv4
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mup(i,j) =a_mup(i,j) +a_Tmpv1
   a_mup(i,j-1) =a_mup(i,j-1) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[1]
   DO j =jtf, jts, -1

!  DO i =its, min(ite+1, ide)
!  Tmpv001 =mup(i,j) +mub(i,j) +mup(i-1,j)
!  Tmpv002 =Tmpv001 +mub(i-1,j)
!  Tmpv003 =0.5*Tmpv002
!  Tmpv004 =Tmpv003/msfuy(i,j)
!  muu(i,j) =Tmpv004

!  ENDDO

   DO i =min(ite+1, ide), its, -1
   a_Tmpv4 =a_muu(i,j)
   a_muu(i,j) =0.0
   a_Tmpv3 =a_Tmpv4/msfuy(i,j)
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mup(i,j) =a_mup(i,j) +a_Tmpv1
   a_mup(i-1,j) =a_mup(i-1,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[0]
!  jtf =min(jte, jde-1)
!  ktf =min(kte, kde-1)
!  itf =min(ite, ide-1)

   END SUBROUTINE a_calc_ww_cp

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of calc_cq in reverse (adjoint) mode:
!   gradient     of useful results: cqu cqv cqw moist
!   with respect to varying inputs: cqu cqv cqw moist
!   RW status of diff variables: cqu:in-out cqv:in-out cqw:in-out
!                moist:incr
SUBROUTINE A_CALC_CQ(moist, moistb, cqu, cqub, cqv, cqvb, cqw, cqwb, &
&  n_moist, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, &
&  its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  INTEGER, INTENT(IN) :: n_moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(IN) :: &
&  moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist) :: moistb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: cqu, cqv, cqw
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: cqub, cqvb, cqwb
! Local stuff
! Changes from Larry Meadows, Intel Corp.  Improve vectorization of this routine
  REAL :: qtot(its:ite)
  REAL :: qtotb(its:ite)
  INTEGER :: i, j, k, itf, jtf, ktf, ispe
  INTEGER :: ad_to
  INTEGER :: ad_to0
  INTEGER :: ad_to1
  INTEGER :: ad_to2
  INTEGER :: ad_to3
  INTEGER :: ad_to4
  INTEGER :: ad_to5
  INTEGER :: ad_to6
  INTEGER :: ad_to7
  INTEGER :: ad_to8
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  IF (n_moist .GE. param_first_scalar) THEN
    itf = ite
    IF (jte .GT. jde - 1) THEN
      jtf = jde - 1
    ELSE
      jtf = jte
    END IF
    DO j=jts,jtf
      DO k=kts,ktf
        CALL PUSHREAL8ARRAY(qtot, ite - its + 1)
        qtot = 0.
        DO ispe=param_first_scalar,n_moist
          DO i=its,itf
            qtot(i) = qtot(i) + moist(i, k, j, ispe) + moist(i-1, k, j, &
&              ispe)
          END DO
          CALL PUSHINTEGER4(i - 1)
        END DO
        i = itf + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    IF (ite .GT. ide - 1) THEN
      itf = ide - 1
    ELSE
      itf = ite
    END IF
    jtf = jte
    DO j=jts,jtf
      DO k=kts,ktf
        CALL PUSHREAL8ARRAY(qtot, ite - its + 1)
        qtot = 0.
        DO ispe=param_first_scalar,n_moist
          DO i=its,itf
            qtot(i) = qtot(i) + moist(i, k, j, ispe) + moist(i, k, j-1, &
&              ispe)
          END DO
          CALL PUSHINTEGER4(i - 1)
        END DO
        i = itf + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    IF (ite .GT. ide - 1) THEN
      itf = ide - 1
    ELSE
      itf = ite
    END IF
    IF (jte .GT. jde - 1) THEN
      jtf = jde - 1
    ELSE
      jtf = jte
    END IF
    DO j=jtf,jts,-1
      DO k=ktf,kts+1,-1
        qtotb = 0.0
        DO i=itf,its,-1
          qtotb(i) = qtotb(i) + 0.5*cqwb(i, k, j)
          cqwb(i, k, j) = 0.0
        END DO
        DO ispe=n_moist,param_first_scalar,-1
          DO i=itf,its,-1
            moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + qtotb(i)
            moistb(i, k-1, j, ispe) = moistb(i, k-1, j, ispe) + qtotb(i)
          END DO
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_to8)
    DO j=ad_to8,jts,-1
      DO k=ktf,kts,-1
        qtotb = 0.0
        CALL POPINTEGER4(ad_to7)
        DO i=ad_to7,its,-1
          qtotb(i) = qtotb(i) - 0.5*cqvb(i, k, j)/(0.5*qtot(i)+1.)**2
          cqvb(i, k, j) = 0.0
        END DO
        DO ispe=n_moist,param_first_scalar,-1
          CALL POPINTEGER4(ad_to6)
          DO i=ad_to6,its,-1
            moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + qtotb(i)
            moistb(i, k, j-1, ispe) = moistb(i, k, j-1, ispe) + qtotb(i)
          END DO
        END DO
        CALL POPREAL8ARRAY(qtot, ite - its + 1)
      END DO
    END DO
    CALL POPINTEGER4(ad_to5)
    DO j=ad_to5,jts,-1
      DO k=ktf,kts,-1
        qtotb = 0.0
        CALL POPINTEGER4(ad_to4)
        DO i=ad_to4,its,-1
          qtotb(i) = qtotb(i) - 0.5*cqub(i, k, j)/(0.5*qtot(i)+1.)**2
          cqub(i, k, j) = 0.0
        END DO
        DO ispe=n_moist,param_first_scalar,-1
          CALL POPINTEGER4(ad_to3)
          DO i=ad_to3,its,-1
            moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + qtotb(i)
            moistb(i-1, k, j, ispe) = moistb(i-1, k, j, ispe) + qtotb(i)
          END DO
        END DO
        CALL POPREAL8ARRAY(qtot, ite - its + 1)
      END DO
    END DO
  ELSE
    itf = ite
    IF (jte .GT. jde - 1) THEN
      jtf = jde - 1
    ELSE
      jtf = jte
    END IF
    DO j=jts,jtf
      DO k=kts,ktf
        i = itf + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    IF (ite .GT. ide - 1) THEN
      itf = ide - 1
    ELSE
      itf = ite
    END IF
    jtf = jte
    DO j=jts,jtf
      DO k=kts,ktf
        i = itf + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHINTEGER4(j - 1)
    IF (ite .GT. ide - 1) THEN
      itf = ide - 1
    ELSE
      itf = ite
    END IF
    IF (jte .GT. jde - 1) THEN
      jtf = jde - 1
    ELSE
      jtf = jte
    END IF
    DO j=jtf,jts,-1
      DO k=ktf,kts+1,-1
        DO i=itf,its,-1
          cqwb(i, k, j) = 0.0
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_to2)
    DO j=ad_to2,jts,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_to1)
        DO i=ad_to1,its,-1
          cqvb(i, k, j) = 0.0
        END DO
      END DO
    END DO
    CALL POPINTEGER4(ad_to0)
    DO j=ad_to0,jts,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_to)
        DO i=ad_to,its,-1
          cqub(i, k, j) = 0.0
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_CALC_CQ

   SUBROUTINE a_calc_alt(alt,a_alt,al,a_al,alb,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
   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) :: alb,al,a_al
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: alt,a_alt
   INTEGER :: i,j,k,itf,jtf,ktf

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

   ! Added by Ning Pan, 2010-07-13
   itf =min(ite,ide-1)
   jtf =min(jte,jde-1)
   ktf =min(kte,kde-1)

!LPB[1]
   DO j =jtf, jts, -1

!  DO k =kts, ktf
!  DO i =its, itf
!  alt(i,k,j) =al(i,k,j) +alb(i,k,j)

!  ENDDO
!  ENDDO

   DO k =ktf, kts, -1
   DO i =itf, its, -1
   a_al(i,k,j) =a_al(i,k,j) +a_alt(i,k,j)
   a_alt(i,k,j) =0.0
   ENDDO
   ENDDO

   ENDDO

!LPB[0]
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)
!  ktf =min(kte, kde-1)

   END SUBROUTINE a_calc_alt

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of calc_p_rho_phi in reverse (adjoint) mode:
!   gradient     of useful results: p al t muts ph moist mu
!   with respect to varying inputs: p al t muts ph moist mu
!   RW status of diff variables: p:in-out al:in-out t:incr muts:incr
!                ph:in-out moist:incr mu:incr
SUBROUTINE A_CALC_P_RHO_PHI(moist, moistb, n_moist, hypsometric_opt, al&
&  , alb0, alb, mu, mub, muts, mutsb, ph, phb0, phb, p, pb0, pb, t, tb, &
&  p0, t0, ptop, znu, znw, dnw, rdnw, rdn, non_hydrostatic, ids, ide, jds&
&  , jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
&  , kte)
  IMPLICIT NONE
! Input data
  LOGICAL, INTENT(IN) :: non_hydrostatic
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  INTEGER, INTENT(IN) :: n_moist
  INTEGER, INTENT(IN) :: hypsometric_opt
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: alb, pb, t
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: tb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(IN) :: &
&  moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist) :: moistb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: al, p
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: alb0, pb0
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: ph, phb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: phb0
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mu, muts
  REAL, DIMENSION(ims:ime, jms:jme) :: mub, mutsb
  REAL, DIMENSION(kms:kme), INTENT(IN) :: znu, znw, dnw, rdnw, rdn
  REAL, INTENT(IN) :: t0, p0, ptop
! Local stuff
  INTEGER :: i, j, k, itf, jtf, ktf, ispe
  REAL :: qvf, qtot, qf1, qf2
  REAL :: qvfb, qtotb, qf1b
  REAL, DIMENSION(its:ite) :: temp, cpovcv_v
  REAL, DIMENSION(its:ite) :: tempb
  REAL :: pfu, phm, pfd
  REAL :: pfub, phmb, pfdb
  INTEGER :: arg1
  INTEGER :: branch
  REAL :: temp3
  REAL :: temp2
  REAL :: temp1
  REAL :: temp0
  REAL :: temp16b
  REAL :: temp0b
  REAL :: temp3b
  REAL :: temp18
  REAL :: temp17
  REAL :: temp12b
  REAL :: temp16
  REAL :: temp6b
  REAL :: temp15
  REAL :: temp14
  REAL :: temp13
  REAL :: temp12
  REAL :: temp11
  REAL :: temp10
  REAL :: temp0b0
  REAL :: temp8b0
  REAL :: temp14b
  REAL :: temp8b
  REAL :: temp3b0
  REAL :: temp12b2
  REAL :: temp12b1
  REAL :: temp12b0
  REAL :: temp6b0
  REAL :: temp9
  REAL :: temp8
  REAL :: temp7
  REAL :: temp10b
  REAL :: temp6
  REAL :: temp10b1
  REAL :: temp5
  REAL :: temp10b0
  REAL :: temp4
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
!#ifndef INTELMKL
  cpovcv_v = cpovcv
!#endif
  IF (non_hydrostatic) THEN
    IF (hypsometric_opt .EQ. 1) THEN
      DO j=jts,jtf
        DO k=kts,ktf
          DO i=its,itf
            al(i, k, j) = -(1./muts(i, j)*(alb(i, k, j)*mu(i, j)+rdnw(k)&
&              *(ph(i, k+1, j)-ph(i, k, j))))
          END DO
        END DO
      END DO
      CALL PUSHCONTROL2B(0)
    ELSE IF (hypsometric_opt .EQ. 2) THEN
! The relation used to get specific volume, al, is: al = -dZ/dp,
! where dp = mut * d(eta). The pressure depth, dp, is replaced with
! p*(dp/p) ~ p*LOG((p+0.5dp)/(p-0.5dp)). Difference between dp and p*dLOG(p)
! is as follows: p*dLOG(p) - dp = 1/12*(dp/p)**3 + 1/90*(dp/p)**5 + ...
! Therefore, p*dLOG(p) is always larger than dp and the difference is
! in proportion to dp/p. TKW, 02/16/2010
      DO j=jts,jtf
        DO k=kts,ktf
          DO i=its,itf
            pfu = muts(i, j)*znw(k+1) + ptop
            pfd = muts(i, j)*znw(k) + ptop
            phm = muts(i, j)*znu(k) + ptop
            al(i, k, j) = (ph(i, k+1, j)-ph(i, k, j)+phb(i, k+1, j)-phb(&
&              i, k, j))/phm/LOG(pfd/pfu) - alb(i, k, j)
          END DO
        END DO
      END DO
      CALL PUSHCONTROL2B(1)
    ELSE
      CALL PUSHCONTROL2B(2)
    END IF
    IF (n_moist .GE. param_first_scalar) THEN
      DO j=jts,jtf
        DO k=kts,ktf
          DO i=its,itf
            qvf = 1. + rvovrd*moist(i, k, j, p_qv)
            CALL PUSHREAL8(temp(i))
            temp(i) = r_d*(t0+t(i, k, j))*qvf/(p0*(al(i, k, j)+alb(i, k&
&              , j)))
          END DO
        END DO
      END DO
      tempb = 0.0
      DO j=jtf,jts,-1
        DO k=ktf,kts,-1
          DO i=itf,its,-1
            pb0(i, k, j) = p0*pb0(i, k, j)
          END DO
          arg1 = itf - its + 1
          CALL A_VPOW(p(its, k, j), pb0(its, k, j), temp(its), tempb(its&
&                ), cpovcv_v(its), arg1)
          DO i=itf,its,-1
            qvf = 1. + rvovrd*moist(i, k, j, p_qv)
            CALL POPREAL8(temp(i))
            temp15 = p0*(alb(i, k, j)+al(i, k, j))
            temp14 = t0 + t(i, k, j)
            temp14b = r_d*tempb(i)/temp15
            tb(i, k, j) = tb(i, k, j) + qvf*temp14b
            qvfb = temp14*temp14b
            alb0(i, k, j) = alb0(i, k, j) - temp14*qvf*p0*temp14b/temp15
            tempb(i) = 0.0
            moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + rvovrd*qvfb
          END DO
        END DO
      END DO
    ELSE
      DO j=jtf,jts,-1
        DO k=ktf,kts,-1
          DO i=itf,its,-1
            temp18 = p0*(alb(i, k, j)+al(i, k, j))
            temp17 = t0 + t(i, k, j)
            temp16 = temp17/temp18
            IF (r_d*temp16 .LE. 0.0 .AND. (cpovcv .EQ. 0.0 .OR. cpovcv &
&                .NE. INT(cpovcv))) THEN
              temp16b = 0.0
            ELSE
              temp16b = r_d*cpovcv*(r_d*temp16)**(cpovcv-1)*p0*pb0(i, k&
&                , j)/temp18
            END IF
            tb(i, k, j) = tb(i, k, j) + temp16b
            alb0(i, k, j) = alb0(i, k, j) - temp16*p0*temp16b
            pb0(i, k, j) = 0.0
          END DO
        END DO
      END DO
    END IF
    CALL POPCONTROL2B(branch)
    IF (branch .EQ. 0) THEN
      DO j=jtf,jts,-1
        DO k=ktf,kts,-1
          DO i=itf,its,-1
            temp12b = -(alb0(i, k, j)/muts(i, j))
            mub(i, j) = mub(i, j) + alb(i, k, j)*temp12b
            phb0(i, k+1, j) = phb0(i, k+1, j) + rdnw(k)*temp12b
            phb0(i, k, j) = phb0(i, k, j) - rdnw(k)*temp12b
            mutsb(i, j) = mutsb(i, j) - (alb(i, k, j)*mu(i, j)+rdnw(k)*(&
&              ph(i, k+1, j)-ph(i, k, j)))*temp12b/muts(i, j)
            alb0(i, k, j) = 0.0
          END DO
        END DO
      END DO
    ELSE IF (branch .EQ. 1) THEN
      DO j=jtf,jts,-1
        DO k=ktf,kts,-1
          DO i=itf,its,-1
            pfu = muts(i, j)*znw(k+1) + ptop
            phm = muts(i, j)*znu(k) + ptop
            pfd = muts(i, j)*znw(k) + ptop
            temp12 = pfd/pfu
            temp13 = LOG(temp12)
            temp12b0 = alb0(i, k, j)/(phm*temp13)
            temp12b1 = -((phb(i, k+1, j)-phb(i, k, j)+ph(i, k+1, j)-ph(i&
&              , k, j))*temp12b0/(phm*temp13))
            temp12b2 = phm*temp12b1/(temp12*pfu)
            phb0(i, k+1, j) = phb0(i, k+1, j) + temp12b0
            phb0(i, k, j) = phb0(i, k, j) - temp12b0
            phmb = temp13*temp12b1
            pfdb = temp12b2
            pfub = -(temp12*temp12b2)
            alb0(i, k, j) = 0.0
            mutsb(i, j) = mutsb(i, j) + znw(k)*pfdb + znw(k+1)*pfub + &
&              znu(k)*phmb
          END DO
        END DO
      END DO
    END IF
  ELSE
!  hydrostatic pressure, al, and ph1 calc; WCS, 5 sept 2001
    IF (n_moist .GE. param_first_scalar) THEN
      DO j=jts,jtf
! top layer
        k = ktf
        DO i=its,itf
          qtot = 0.
          DO ispe=param_first_scalar,n_moist
            qtot = qtot + moist(i, k, j, ispe)
          END DO
          qf2 = 1.
          CALL PUSHREAL8(qf1)
          qf1 = qtot*qf2
          p(i, k, j) = -(0.5*(mu(i, j)+qf1*muts(i, j))/rdnw(k)/qf2)
          qvf = 1. + rvovrd*moist(i, k, j, p_qv)
          al(i, k, j) = r_d/p1000mb*(t(i, k, j)+t0)*qvf*((p(i, k, j)+pb(&
&            i, k, j))/p1000mb)**cvpm - alb(i, k, j)
        END DO
        CALL PUSHINTEGER4(k)
! remaining layers, integrate down
        DO k=ktf-1,kts,-1
          DO i=its,itf
            qtot = 0.
            DO ispe=param_first_scalar,n_moist
              qtot = qtot + 0.5*(moist(i, k, j, ispe)+moist(i, k+1, j, &
&                ispe))
            END DO
            qf2 = 1.
            CALL PUSHREAL8(qf1)
            qf1 = qtot*qf2
            CALL PUSHREAL8(p(i, k, j))
            p(i, k, j) = p(i, k+1, j) - (mu(i, j)+qf1*muts(i, j))/qf2/&
&              rdn(k+1)
            qvf = 1. + rvovrd*moist(i, k, j, p_qv)
            al(i, k, j) = r_d/p1000mb*(t(i, k, j)+t0)*qvf*((p(i, k, j)+&
&              pb(i, k, j))/p1000mb)**cvpm - alb(i, k, j)
          END DO
        END DO
      END DO
      CALL PUSHCONTROL1B(0)
    ELSE
      DO j=jts,jtf
! top layer
        k = ktf
        DO i=its,itf
          qtot = 0.
          qf2 = 1.
          qf1 = qtot*qf2
          p(i, k, j) = -(0.5*(mu(i, j)+qf1*muts(i, j))/rdnw(k)/qf2)
          qvf = 1.
          al(i, k, j) = r_d/p1000mb*(t(i, k, j)+t0)*qvf*((p(i, k, j)+pb(&
&            i, k, j))/p1000mb)**cvpm - alb(i, k, j)
        END DO
        CALL PUSHINTEGER4(k)
! remaining layers, integrate down
        DO k=ktf-1,kts,-1
          DO i=its,itf
            qtot = 0.
            qf2 = 1.
            qf1 = qtot*qf2
            CALL PUSHREAL8(p(i, k, j))
            p(i, k, j) = p(i, k+1, j) - (mu(i, j)+qf1*muts(i, j))/qf2/&
&              rdn(k+1)
            qvf = 1.
            al(i, k, j) = r_d/p1000mb*(t(i, k, j)+t0)*qvf*((p(i, k, j)+&
&              pb(i, k, j))/p1000mb)**cvpm - alb(i, k, j)
          END DO
        END DO
      END DO
      CALL PUSHCONTROL1B(1)
    END IF
    IF (hypsometric_opt .EQ. 1) THEN
      DO j=jtf,jts,-1
        DO k=ktf+1,2,-1
          DO i=itf,its,-1
            temp10b = -(dnw(k-1)*phb0(i, k, j))
            phb0(i, k-1, j) = phb0(i, k-1, j) + phb0(i, k, j)
            mutsb(i, j) = mutsb(i, j) + al(i, k-1, j)*temp10b
            alb0(i, k-1, j) = alb0(i, k-1, j) + muts(i, j)*temp10b
            mub(i, j) = mub(i, j) + alb(i, k-1, j)*temp10b
            phb0(i, k, j) = 0.0
          END DO
        END DO
      END DO
    ELSE
      DO j=jtf,jts,-1
        DO k=ktf+1,kts+1,-1
          DO i=itf,its,-1
            pfu = muts(i, j)*znw(k) + ptop
            phm = muts(i, j)*znu(k-1) + ptop
            pfd = muts(i, j)*znw(k-1) + ptop
            temp10 = pfd/pfu
            temp10b0 = LOG(temp10)*phb0(i, k, j)
            temp11 = alb(i, k-1, j) + al(i, k-1, j)
            temp10b1 = temp11*phm*phb0(i, k, j)/(temp10*pfu)
            phb0(i, k-1, j) = phb0(i, k-1, j) + phb0(i, k, j)
            alb0(i, k-1, j) = alb0(i, k-1, j) + phm*temp10b0
            phmb = temp11*temp10b0
            pfdb = temp10b1
            pfub = -(temp10*temp10b1)
            phb0(i, k, j) = 0.0
            mutsb(i, j) = mutsb(i, j) + znw(k-1)*pfdb + znw(k)*pfub + &
&              znu(k-1)*phmb
          END DO
        END DO
        DO i=itf,its,-1
          phb0(i, kts, j) = 0.0
        END DO
      END DO
    END IF
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO j=jtf,jts,-1
        DO k=kts,ktf-1,1
          DO i=itf,its,-1
            qvf = 1. + rvovrd*moist(i, k, j, p_qv)
            temp5 = pb(i, k, j) + p(i, k, j)
            temp4 = temp5/p1000mb
            temp3 = t0 + t(i, k, j)
            temp3b = r_d*temp4**cvpm*alb0(i, k, j)
            tb(i, k, j) = tb(i, k, j) + qvf*temp3b/p1000mb
            qvfb = temp3*temp3b/p1000mb
            IF (.NOT.(temp4 .LE. 0.0 .AND. (cvpm .EQ. 0.0 .OR. cvpm .NE.&
&                INT(cvpm)))) pb0(i, k, j) = pb0(i, k, j) + cvpm*temp4**(&
&                cvpm-1)*temp3*qvf*r_d*alb0(i, k, j)/p1000mb**2
            alb0(i, k, j) = 0.0
            moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + rvovrd*qvfb
            qf2 = 1.
            CALL POPREAL8(p(i, k, j))
            temp3b0 = -(pb0(i, k, j)/(qf2*rdn(k+1)))
            pb0(i, k+1, j) = pb0(i, k+1, j) + pb0(i, k, j)
            mub(i, j) = mub(i, j) + temp3b0
            qf1b = muts(i, j)*temp3b0
            mutsb(i, j) = mutsb(i, j) + qf1*temp3b0
            pb0(i, k, j) = 0.0
            CALL POPREAL8(qf1)
            qtotb = qf2*qf1b
            DO ispe=n_moist,param_first_scalar,-1
              moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + 0.5*qtotb
              moistb(i, k+1, j, ispe) = moistb(i, k+1, j, ispe) + 0.5*&
&                qtotb
            END DO
          END DO
        END DO
        CALL POPINTEGER4(k)
        DO i=itf,its,-1
          qvf = 1. + rvovrd*moist(i, k, j, p_qv)
          temp2 = pb(i, k, j) + p(i, k, j)
          temp1 = temp2/p1000mb
          temp0 = t0 + t(i, k, j)
          temp0b = r_d*temp1**cvpm*alb0(i, k, j)
          tb(i, k, j) = tb(i, k, j) + qvf*temp0b/p1000mb
          qvfb = temp0*temp0b/p1000mb
          IF (.NOT.(temp1 .LE. 0.0 .AND. (cvpm .EQ. 0.0 .OR. cvpm .NE. &
&              INT(cvpm)))) pb0(i, k, j) = pb0(i, k, j) + cvpm*temp1**(&
&              cvpm-1)*temp0*qvf*r_d*alb0(i, k, j)/p1000mb**2
          alb0(i, k, j) = 0.0
          moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + rvovrd*qvfb
          qf2 = 1.
          temp0b0 = -(0.5*pb0(i, k, j)/(rdnw(k)*qf2))
          mub(i, j) = mub(i, j) + temp0b0
          qf1b = muts(i, j)*temp0b0
          mutsb(i, j) = mutsb(i, j) + qf1*temp0b0
          pb0(i, k, j) = 0.0
          CALL POPREAL8(qf1)
          qtotb = qf2*qf1b
          DO ispe=n_moist,param_first_scalar,-1
            moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + qtotb
          END DO
        END DO
      END DO
    ELSE
      DO j=jtf,jts,-1
        DO k=kts,ktf-1,1
          DO i=itf,its,-1
            qvf = 1.
            temp9 = pb(i, k, j) + p(i, k, j)
            temp8 = temp9/p1000mb
            temp8b = r_d*qvf*alb0(i, k, j)
            tb(i, k, j) = tb(i, k, j) + temp8**cvpm*temp8b/p1000mb
            IF (.NOT.(temp8 .LE. 0.0 .AND. (cvpm .EQ. 0.0 .OR. cvpm .NE.&
&                INT(cvpm)))) pb0(i, k, j) = pb0(i, k, j) + cvpm*temp8**(&
&                cvpm-1)*(t0+t(i, k, j))*temp8b/p1000mb**2
            alb0(i, k, j) = 0.0
            qf2 = 1.
            qtot = 0.
            qf1 = qtot*qf2
            CALL POPREAL8(p(i, k, j))
            temp8b0 = -(pb0(i, k, j)/(qf2*rdn(k+1)))
            pb0(i, k+1, j) = pb0(i, k+1, j) + pb0(i, k, j)
            mub(i, j) = mub(i, j) + temp8b0
            mutsb(i, j) = mutsb(i, j) + qf1*temp8b0
            pb0(i, k, j) = 0.0
          END DO
        END DO
        CALL POPINTEGER4(k)
        DO i=itf,its,-1
          qvf = 1.
          temp7 = pb(i, k, j) + p(i, k, j)
          temp6 = temp7/p1000mb
          temp6b = r_d*qvf*alb0(i, k, j)
          tb(i, k, j) = tb(i, k, j) + temp6**cvpm*temp6b/p1000mb
          IF (.NOT.(temp6 .LE. 0.0 .AND. (cvpm .EQ. 0.0 .OR. cvpm .NE. &
&              INT(cvpm)))) pb0(i, k, j) = pb0(i, k, j) + cvpm*temp6**(&
&              cvpm-1)*(t0+t(i, k, j))*temp6b/p1000mb**2
          alb0(i, k, j) = 0.0
          qf2 = 1.
          qtot = 0.
          qf1 = qtot*qf2
          temp6b0 = -(0.5*pb0(i, k, j)/(rdnw(k)*qf2))
          mub(i, j) = mub(i, j) + temp6b0
          mutsb(i, j) = mutsb(i, j) + qf1*temp6b0
          pb0(i, k, j) = 0.0
        END DO
      END DO
    END IF
  END IF
END SUBROUTINE A_CALC_P_RHO_PHI

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of vpow in reverse (adjoint) mode:
!   gradient     of useful results: y z
!   with respect to varying inputs: y z
SUBROUTINE A_VPOW(z, zb, y, yb, x, n)
  IMPLICIT NONE
  REAL :: x(*), y(*), z(*)
  REAL :: yb(*), zb(*)
  INTEGER :: j
  INTEGER :: n
  DO j=n,1,-1
    IF (.NOT.(y(j) .LE. 0.0 .AND. (x(j) .EQ. 0.0 .OR. x(j) .NE. INT(x(j)&
&        )))) yb(j) = yb(j) + x(j)*y(j)**(x(j)-1)*zb(j)
    zb(j) = 0.0_8
  END DO
END SUBROUTINE A_VPOW

   SUBROUTINE a_calc_php(php,a_php,ph,a_ph,phb,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
   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) :: phb,ph,a_ph
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: php,a_php
   INTEGER :: i,j,k,itf,jtf,ktf

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

   ! Added by Ning Pan, 2010-07-13
   itf =min(ite,ide-1)
   jtf =min(jte,jde-1)
   ktf =min(kte,kde-1)

!LPB[1]
   DO j =jtf, jts, -1

!  DO k =kts, ktf
!  DO i =its, itf
!  Tmpv001 =phb(i,k,j)+phb(i,k+1,j) +ph(i,k,j) +ph(i,k+1,j)
!  Tmpv002 =0.5*Tmpv001
!  php(i,k,j) =Tmpv002

!  ENDDO
!  ENDDO

   DO k =ktf, kts, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_php(i,k,j)
   a_php(i,k,j) =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[0]
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)
!  ktf =min(kte, kde-1)

   END SUBROUTINE a_calc_php

   SUBROUTINE a_diagnose_w(ph_tend,a_ph_tend,ph_new,a_ph_new,ph_old,a_ph_old,w, &
   a_w,mu,a_mu,dt,u,a_u,v,a_v,ht,cf1,cf2,cf3,rdx,rdy,msftx,msfty,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
   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) :: ph_tend,a_ph_tend,ph_new,a_ph_new, &
   ph_old,a_ph_old,u,a_u,v,a_v
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: w,a_w
   REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu,ht,msftx,msfty
   REAL :: dt,cf1,cf2,cf3,rdx,rdy
   INTEGER :: i,j,k,itf,jtf

   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,a_Tmpv13,Tmpv013, &
   a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      itf=MIN(ite,ide-1)
      jtf=MIN(jte,jde-1)

!!LPB[1]
!      DO j = jts, jtf

!        DO i = its, itf
!            w(i,1,j)=  msfty(i,j)*.5*rdy*(                        &
!                              (ht(i,j+1)-ht(i,j  ))               &
!             *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))      &
!                             +(ht(i,j  )-ht(i,j-1))               &
!             *(cf1*v(i,1,j  )+cf2*v(i,2,j  )+cf3*v(i,3,j  ))  )   &
!                    +msftx(i,j)*.5*rdx*(                          &
!                              (ht(i+1,j)-ht(i,j  ))               &
!             *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))      &
!                             +(ht(i,j  )-ht(i-1,j))               &
!             *(cf1*u(i  ,1,j)+cf2*u(i  ,2,j)+cf3*u(i  ,3,j))  )
!        ENDDO

!        DO k = 2, kte
!        DO i = its, itf
!          w(i,k,j) =  msfty(i,j)*(  (ph_new(i,k,j)-ph_old(i,k,j))/dt         &
!                                  - ph_tend(i,k,j)/mu(i,j)        )/g 
!        ENDDO
!        ENDDO

!      ENDDO

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[1]
   DO j =jtf, jts, -1

   DO i =its, itf
   Tmpv001 =cf1*v(i,1,j+1) +cf2*v(i,2,j+1)
   Tmpv002 =Tmpv001 +cf3*v(i,3,j+1)
   Tmpv003 =(ht(i,j+1)-ht(i,j))*Tmpv002
   Tmpv004 =cf1*v(i,1,j) +cf2*v(i,2,j)
   Tmpv005 =Tmpv004 +cf3*v(i,3,j)
   Tmpv006 =(ht(i,j)-ht(i,j-1))*Tmpv005
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =msfty(i,j)*.5*rdy*Tmpv007
   Tmpv009 =cf1*u(i+1,1,j) +cf2*u(i+1,2,j)
   Tmpv010 =Tmpv009 +cf3*u(i+1,3,j)
   Tmpv011 =(ht(i+1,j)-ht(i,j))*Tmpv010
   Tmpv012 =cf1*u(i,1,j) +cf2*u(i,2,j)
   Tmpv013 =Tmpv012 +cf3*u(i,3,j)
   Tmpv014 =(ht(i,j)-ht(i-1,j))*Tmpv013
   Tmpv015 =Tmpv011 +Tmpv014
   Tmpv016 =msftx(i,j)*.5*rdx*Tmpv015
   Tmpv017 =Tmpv008 +Tmpv016
!  w(i,1,j) =Tmpv017

   ENDDO

   DO k =2, kte
   DO i =its, itf
   Tmpv001 =ph_new(i,k,j) -ph_old(i,k,j)
   Tmpv002 =Tmpv001/dt
   Tmpv003 =ph_tend(i,k,j)/mu(i,j)
   Tmpv004 =Tmpv002 -Tmpv003
   Tmpv005 =msfty(i,j)*Tmpv004
   Tmpv006 =Tmpv005/g
!  w(i,k,j) =Tmpv006

   ENDDO
   ENDDO

   DO k =kte, 2, -1
   DO i =itf, its, -1
   a_Tmpv6 =a_w(i,k,j)
   a_w(i,k,j) =0.0
   a_Tmpv5 =a_Tmpv6/g
   a_Tmpv4 =msfty(i,j)*a_Tmpv5
   a_Tmpv2 =a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv3/mu(i,j)
   a_mu(i,j) =a_mu(i,j) -ph_tend(i,k,j)/(mu(i,j)*mu(i,j))*a_Tmpv3
   a_Tmpv1 =a_Tmpv2/dt
   a_ph_new(i,k,j) =a_ph_new(i,k,j) +a_Tmpv1
   a_ph_old(i,k,j) =a_ph_old(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO

   DO i =itf, its, -1
   a_Tmpv17 =a_w(i,1,j)
   a_w(i,1,j) =0.0
   a_Tmpv8 =a_Tmpv17
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =msftx(i,j)*.5*rdx*a_Tmpv16
   a_Tmpv11 =a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_Tmpv13 =(ht(i,j)-ht(i-1,j))*a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_u(i,3,j) =a_u(i,3,j) +cf3*a_Tmpv13
   a_u(i,1,j) =a_u(i,1,j) +cf1*a_Tmpv12
   a_u(i,2,j) =a_u(i,2,j) +cf2*a_Tmpv12
   a_Tmpv10 =(ht(i+1,j)-ht(i,j))*a_Tmpv11
   a_Tmpv9 =a_Tmpv10
   a_u(i+1,3,j) =a_u(i+1,3,j) +cf3*a_Tmpv10
   a_u(i+1,1,j) =a_u(i+1,1,j) +cf1*a_Tmpv9
   a_u(i+1,2,j) =a_u(i+1,2,j) +cf2*a_Tmpv9
   a_Tmpv7 =msfty(i,j)*.5*rdy*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =(ht(i,j)-ht(i,j-1))*a_Tmpv6
   a_Tmpv4 =a_Tmpv5
   a_v(i,3,j) =a_v(i,3,j) +cf3*a_Tmpv5
   a_v(i,1,j) =a_v(i,1,j) +cf1*a_Tmpv4
   a_v(i,2,j) =a_v(i,2,j) +cf2*a_Tmpv4
   a_Tmpv2 =(ht(i,j+1)-ht(i,j))*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_v(i,3,j+1) =a_v(i,3,j+1) +cf3*a_Tmpv2
   a_v(i,1,j+1) =a_v(i,1,j+1) +cf1*a_Tmpv1
   a_v(i,2,j+1) =a_v(i,2,j+1) +cf2*a_Tmpv1
   ENDDO

   ENDDO

!LPB[0]
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)

   END SUBROUTINE a_diagnose_w

   SUBROUTINE a_rhs_ph(ph_tend,a_ph_tend,u,a_u,v,a_v,ww,a_ww,ph,a_ph,ph_old, &
   a_ph_old,phb,w,a_w,mut,a_mut,muu,a_muu,muv,a_muv,fnm,fnp,rdnw,cfn,cfn1,rdx, &
   rdy,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,non_hydrostatic,config_flags,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
   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) :: u,a_u,v,a_v,ww,a_ww,ph,a_ph, &
   ph_old,a_ph_old,phb,w,a_w
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ph_tend,a_ph_tend
   REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv,mut,a_mut,msfux,msfuy, &
   msfvx,msfvy,msftx,msfty,msfvx_inv
   REAL,DIMENSION(kms:kme) :: rdnw,fnm,fnp
   REAL :: cfn,cfn1,rdx,rdy
   LOGICAL :: non_hydrostatic
   INTEGER :: i,j,k,itf,jtf,ktf,kz,i_start,j_start
   REAL :: ur,a_ur,ul,a_ul,ub,a_ub,vr,a_vr,vl,a_vl,vb,a_vb
   REAL,DIMENSION(its:ite,kts:kte) :: wdwn,a_wdwn
   INTEGER :: advective_order
   LOGICAL :: specified

   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,a_Tmpv13,Tmpv013, &
   a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
   a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019,a_Tmpv20,Tmpv020,a_Tmpv21,Tmpv021
!REVISED BY WALLS
   REAL,DIMENSION(min0(its,jts):max0(MAX(ite,ide-1),MAX(jte,jde-1))) :: Tmpv200
   REAL,DIMENSION(min0(its,jts):max0(MAX(ite,ide-1),MAX(jte,jde-1))) :: Tmpv201
   REAL,DIMENSION(min0(its,jts):max0(MAX(ite,ide-1),MAX(jte,jde-1))) :: Tmpv202
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv203
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv204
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv205
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv206
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv207
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv208
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv209
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2010
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2011
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2012
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2013
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2014
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2015
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2016
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2017
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2018
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2019
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2020
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2021
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2022
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2023
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2024
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2025
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2026
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2027
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2028
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2029
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2030
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2031
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2032
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2033
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2034
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2035
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2036
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2037
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2038
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2039
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2040
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2041
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2042
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv2043
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2044
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2045
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2046
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2047
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2048
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2049
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2050
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2051
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2052
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2053
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2054
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2055
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2056
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2057
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2058
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2059
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2060
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2061
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2062
   REAL,DIMENSION(jts:MAX(jte,jde-1)) :: Tmpv2063
   REAL,DIMENSION(min0(its,2):max0(MAX(ite,ide-1),kde-1),min0(2,jts+1,jts) &
   :max0(kte,MAX(jte,jde-1)-2,kde,MAX(jte,jde-1))) :: Tmpv300
   REAL,DIMENSION(min0(its,2):max0(MAX(ite,ide-1),kde-1),min0(2,jts+1,jts) &
   :max0(kte,MAX(jte,jde-1)-2,kde,MAX(jte,jde-1))) :: Tmpv301
   REAL,DIMENSION(min0(its,2):max0(MAX(ite,ide-1),kde-1),min0(jts+1,2,jts) &
   :max0(MAX(jte,jde-1)-2,kde,MAX(jte,jde-1))) :: Tmpv302
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+1:MAX(jte,jde-1)) :: Tmpv303
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+1:MAX(jte,jde-1)) :: Tmpv304
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+1:MAX(jte,jde-1)) :: Tmpv305
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv306
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv307
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv308
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv309
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3010
   REAL,DIMENSION(its+1:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3011
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+2:MAX(jte,jde-1)) :: Tmpv3012
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+2:MAX(jte,jde-1)) :: Tmpv3013
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+2:MAX(jte,jde-1)) :: Tmpv3014
   REAL,DIMENSION(its:MAX(ite,ide-1),jts+2:MAX(jte,jde-1)) :: Tmpv3015
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3016
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3017
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3018
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3019
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3020
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3021
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3022
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3023
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3024
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3025
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3026
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3027
   REAL,DIMENSION(its+2:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3028
   REAL,DIMENSION(its+2:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3029
   REAL,DIMENSION(its+2:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3030
   REAL,DIMENSION(its+2:MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3031
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3032
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3033
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3034
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3035
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3036
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3037
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3038
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3039
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3040
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3041
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3042
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3043
   REAL,DIMENSION(its:MAX(ite,ide-1),MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv3044
   REAL,DIMENSION(its:MAX(ite,ide-1),MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv3045
   REAL,DIMENSION(its:MAX(ite,ide-1),MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv3046
   REAL,DIMENSION(its:MAX(ite,ide-1),MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv3047
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3048
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3049
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3050
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3051
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3052
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3053
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3054
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3055
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3056
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3057
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3058
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3059
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3060
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3061
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3062
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3063
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3064
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3065
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3066
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1) :: Tmpv3067
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3068
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3069
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3070
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),jts:MAX(jte,jde-1)) :: Tmpv3071
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3072
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3073
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3074
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3075
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3076
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3077
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3078
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3079
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3080
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3081
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3082
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3083
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3084
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3085
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3086
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3087
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3088
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3089
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3090
   REAL,DIMENSION(2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv3091
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv400
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv401
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv402
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv403
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv404
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+1:MAX(jte,jde-1)) :: Tmpv405
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv406
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv407
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv408
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv409
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4010
   REAL,DIMENSION(its+1:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4011
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+2:MAX(jte,jde-1)) :: Tmpv4012
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+2:MAX(jte,jde-1)) :: Tmpv4013
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+2:MAX(jte,jde-1)) :: Tmpv4014
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,jts+2:MAX(jte,jde-1)) :: Tmpv4015
   REAL,DIMENSION(its+2:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4016
   REAL,DIMENSION(its+2:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4017
   REAL,DIMENSION(its+2:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4018
   REAL,DIMENSION(its+2:MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4019
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv4020
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv4021
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv4022
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kte-1,MIN(jts,jds+3):MAX(jte,jde-1)) :: Tmpv4023
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4024
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4025
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4026
   REAL,DIMENSION(MIN(its,ids+3):MAX(ite,ide-1),2:kte-1,jts:MAX(jte,jde-1)) :: Tmpv4027

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

!LPB[2]
      advective_order = config_flags%h_sca_adv_order 
      itf=MIN(ite,ide-1)
      jtf=MIN(jte,jde-1)
      ktf=MIN(kte,kde-1)

! Remarked by Ning Pan, 2010-07-20: LPB[3]-LPB[14] are useless
!!LPB[3]
!      DO j = jts, jtf

!        DO k = 2, kte
!        DO i = its, itf
!             wdwn(i,k) = .5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)                 &
!                           *(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
!        ENDDO
!        ENDDO

!        DO k = 2, kte-1
!        DO i = its, itf
!              ph_tend(i,k,j) = ph_tend(i,k,j)                             &
!                                - (fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k))
!        ENDDO
!        ENDDO

!      ENDDO

!LPB[4]

!LPB[5]
!   IF (non_hydrostatic) THEN

!      DO j = jts, jtf
!        DO i = its, itf
!           ph_tend(i,kde,j) = 0.
!        ENDDO

!        DO k = 2, kte
!        DO i = its, itf
!           ph_tend(i,k,j) = ph_tend(i,k,j) + mut(i,j)*g*w(i,k,j)/msfty(i,j)
!        ENDDO
!        ENDDO
!      ENDDO

!   END IF

!LPB[6]

!LPB[7]

!   IF (advective_order <= 2) THEN

!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+1

!   IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-2

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*            &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*     &
!                     (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))     &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*     &
!                     (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                         &
!!     &
!                     ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!   *      &
!                      (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))                &
!!     &
!                      +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) &
!   *      &
!                      (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
!        ENDDO
!      ENDDO
!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF ( (config_flags%open_xs .or. specified) .and. its == ids ) i_start = its+1

!   IF ( (config_flags%open_xe .or. specified) .and. ite == ide ) itf = itf-2

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*           &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*    &
!                     (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))    &
!                     +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*    &
!                     (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                         &
!!     &
!                     ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!   *      &
!                      (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))                &
!!     &
!                      +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j) &
!   *      &
!                      (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
!        ENDDO
!      ENDDO
!      ELSE IF (advective_order <= 4) THEN
!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+2

!   IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-3

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*(                       &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                  &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ))* (1./12.) &
!   *(     &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*(                        &
!!               &
!                    ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!!                     &
!                     +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  )) &
!   * (1./12.)*(     &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!!               &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!!               &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!!               &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!      ENDDO
!   IF ( (config_flags%open_ys .or. specified) .and. jts <= jds+1 )  THEN

!        j = jds+1

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*            &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*     &
!                     (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))     &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*     &
!                     (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                         &
!!     &
!                     ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!   *      &
!                      (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))                &
!!     &
!                      +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) &
!   *      &
!                      (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_ye .or. specified) .and. jte >= jde-2 )  THEN

!        j = jde-2

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*            &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*     &
!                     (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))     &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*     &
!                     (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                         &
!!     &
!                     ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!   *      &
!                      (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))                &
!!     &
!                      +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) &
!   *      &
!                      (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
!        ENDDO
!      END IF
!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+2

!   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-3

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                      &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)                 &
!                     +muu(i,j  )*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j) )* (1./12.)*(   &
!                       8.*(ph(i+1,k,j)-ph(i-1,k,j))                                     &
!                         -(ph(i+2,k,j)-ph(i-2,k,j))                                     &
!                      +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                   &
!                         -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                        &
!!               &
!                    ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!!                     &
!                     +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(i  ,j) ) &
!   * (1./12.)*(    &
!                       8.*(ph(i+1,k,j)-ph(i-1,k,j))                                      &
!!               &
!                         -(ph(i+2,k,j)-ph(i-2,k,j))                                      &
!!               &
!                      +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                    &
!!               &
!                         -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
!        ENDDO
!      ENDDO
!   IF ( (config_flags%open_xs .or. specified) .and. its <= ids+1 ) THEN

!        i = ids + 1

!        DO j = j_start, jtf
!        DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*           &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*    &
!                     (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))    &
!                     +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*    &
!                     (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
!        ENDDO
!        ENDDO
!        k = kte

!        DO j = j_start, jtf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                         &
!!     &
!                     ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!   *      &
!                      (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))                &
!!     &
!                      +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j) &
!   *      &
!                      (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_xe .or. specified) .and. ite >= ide-2 ) THEN

!        i = ide-2

!        DO j = j_start, jtf
!        DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*           &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*    &
!                     (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))    &
!                     +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*    &
!                     (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
!        ENDDO
!        ENDDO
!        k = kte

!        DO j = j_start, jtf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                         &
!!     &
!                     ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!   *      &
!                      (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))                &
!!     &
!                      +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j) &
!   *      &
!                      (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
!        ENDDO
!      END IF
!      ELSE IF (advective_order <= 6) THEN
!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+3)

!   IF (config_flags%open_ye .or. specified ) jtf     = min(jtf,jde-4)

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                      &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                  &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ) )* (1./60.) &
!   *(    &
!                      45.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!                      -9.*(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!                         +(ph(i,k,j+3)-ph(i,k,j-3))                                      &
!                     +45.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!                      -9.*(phb(i,k,j+2)-phb(i,k,j-2))                                    &
!                         +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                       &
!!               &
!                    ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!!                     &
!                     +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) ) &
!   * (1./60.)*(    &
!                      45.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!!               &
!                      -9.*(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!!               &
!                         +(ph(i,k,j+3)-ph(i,k,j-3))                                      &
!!               &
!                     +45.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!!               &
!                      -9.*(phb(i,k,j+2)-phb(i,k,j-2))                                    &
!!               &
!                         +(phb(i,k,j+3)-phb(i,k,j-3))  )   )                
!        ENDDO
!      ENDDO
!   IF ( (config_flags%open_ys .or. specified) .and. jts <= jds+2 .and. jds+2 <= jte ) &
!  THEN

!        j = jds+2

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                      &
!!     &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                  &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  ) )* (1./12.) &
!   *(    &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                       &
!!             &
!                    ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!!                   &
!                     +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j) ) &
!   * (1./12.)*(    &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!!             &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!!             &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!!             &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!      END IF
!   IF ( (config_flags%open_ye .or. specified) .and. jts <= jde-3 .and. jde-3 <= jte ) &
!  THEN

!        j = jde-3

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* (                    &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)                &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j) )* (1./12.)*(    &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                    &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                    &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                  &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* (                       &
!!             &
!                    ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!!                   &
!                     +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j) ) &
!   * (1./12.)*(    &
!                       8.*(ph(i,k,j+1)-ph(i,k,j-1))                                      &
!!             &
!                         -(ph(i,k,j+2)-ph(i,k,j-2))                                      &
!!             &
!                      +8.*(phb(i,k,j+1)-phb(i,k,j-1))                                    &
!!             &
!                         -(phb(i,k,j+2)-phb(i,k,j-2))  )   )                
!        ENDDO
!      END IF
!   IF ( (config_flags%open_ys .or. specified) .and. jts <= jds+1 .and. jds+1 <= jte ) &
!  THEN

!        j = jds+1

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*            &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*     &
!                     (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))     &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*     &
!                     (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                         &
!!     &
!                     ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!   *      &
!                      (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))                &
!!     &
!                      +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) &
!   *      &
!                      (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_ye .or. specified) .and. jts <= jde-2 .and. jde-2 <= jte ) &
!  THEN

!        j = jde-2

!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*            &
!                    ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)*     &
!                     (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))     &
!                     +muv(i,j  )*(v(i,k,j  )+v(i,k-1,j  ))*msfvy(i,j  )*     &
!                     (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1)) )
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*                         &
!!     &
!                     ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) &
!   *      &
!                      (phb(i,k,j+1)-phb(i,k,j  )+ph(i,k,j+1)-ph(i,k,j  ))                &
!!     &
!                      +muv(i,j  )*(cfn*v(i,k-1,j  )+cfn1*v(i,k-2,j  ))*msfvy(i,j  ) &
!   *      &
!                      (phb(i,k,j  )-phb(i,k,j-1)+ph(i,k,j  )-ph(i,k,j-1))              )
!        ENDDO
!      END IF
!      i_start = its
!      j_start = jts
!      itf=MIN(ite,ide-1)
!      jtf=MIN(jte,jde-1)
!   IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+3)

!   IF (config_flags%open_xe .or. specified ) itf     = min(itf,ide-4)

!      DO j = j_start, jtf
!        DO k = 2, kte-1
!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                     &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)                &
!                     +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./60.)*(    &
!                      45.*(ph(i+1,k,j)-ph(i-1,k,j))                                    &
!                      -9.*(ph(i+2,k,j)-ph(i-2,k,j))                                    &
!                         +(ph(i+3,k,j)-ph(i-3,k,j))                                    &
!                     +45.*(phb(i+1,k,j)-phb(i-1,k,j))                                  &
!                      -9.*(phb(i+2,k,j)-phb(i-2,k,j))                                  &
!                         +(phb(i+3,k,j)-phb(i-3,k,j))  )   )                
!        ENDDO
!        ENDDO
!        k = kte

!        DO i = i_start, itf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                        &
!!           &
!                    ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!!                 &
!                     +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) ) &
!   * (1./60.)*(    &
!                      45.*(ph(i+1,k,j)-ph(i-1,k,j))                                      &
!!           &
!                      -9.*(ph(i+2,k,j)-ph(i-2,k,j))                                      &
!!           &
!                         +(ph(i+3,k,j)-ph(i-3,k,j))                                      &
!!           &
!                     +45.*(phb(i+1,k,j)-phb(i-1,k,j))                                    &
!!           &
!                      -9.*(phb(i+2,k,j)-phb(i-2,k,j))                                    &
!!           &
!                         +(phb(i+3,k,j)-phb(i-3,k,j))  )     )
!        ENDDO
!      ENDDO
!   IF ( (config_flags%open_xs) .and. its <= ids+2 .and. ids+2 <= ite ) THEN

!        i = ids + 2

!        DO j = j_start, jtf
!          DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                     &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)                &
!                     +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./12.)*(    &
!                       8.*(ph(i+1,k,j)-ph(i-1,k,j))                                    &
!                         -(ph(i+2,k,j)-ph(i-2,k,j))                                    &
!                      +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                  &
!                         -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
!          ENDDO
!          k = kte
!          ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                         &
!!          &
!                   ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!!                 &
!                    +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) ) &
!   * (1./12.)*(    &
!                      8.*(ph(i+1,k,j)-ph(i-1,k,j))                                       &
!!          &
!                        -(ph(i+2,k,j)-ph(i-2,k,j))                                       &
!!          &
!                     +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                     &
!!          &
!                        -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_xe) .and. its <= ide-3 .and. ide-3 <= ite ) THEN

!        i = ide-3

!        DO j = j_start, jtf
!          DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*(                     &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)                &
!                     +muu(i,j  )*(u(i,k,j  )+u(i,k-1,j  ))*msfux(i,j) )* (1./12.)*(    &
!                       8.*(ph(i+1,k,j)-ph(i-1,k,j))                                    &
!                         -(ph(i+2,k,j)-ph(i-2,k,j))                                    &
!                      +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                  &
!                         -(phb(i+2,k,j)-phb(i-2,k,j))  )   )                
!          ENDDO
!          k = kte
!          ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*(                         &
!!          &
!                   ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!!                 &
!                    +muu(i,j  )*(cfn*u(i  ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) ) &
!   * (1./12.)*(    &
!                      8.*(ph(i+1,k,j)-ph(i-1,k,j))                                       &
!!          &
!                        -(ph(i+2,k,j)-ph(i-2,k,j))                                       &
!!          &
!                     +8.*(phb(i+1,k,j)-phb(i-1,k,j))                                     &
!!          &
!                        -(phb(i+2,k,j)-phb(i-2,k,j))  )     )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_xs .or. specified) .and. its <= ids+1 .and. ids+1 <= ite ) &
! THEN

!        i = ids + 1

!        DO j = j_start, jtf
!        DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*           &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*    &
!                     (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))    &
!                     +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*    &
!                     (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
!        ENDDO
!        ENDDO
!        k = kte

!        DO j = j_start, jtf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                         &
!!     &
!                     ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!   *      &
!                      (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))                &
!!     &
!                      +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j) &
!   *      &
!                      (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
!        ENDDO
!      END IF
!   IF ( (config_flags%open_xe .or. specified) .and. its <= ide-2 .and. ide-2 <= ite ) &
! THEN

!        i = ide-2

!        DO j = j_start, jtf
!        DO k = 2, kte-1
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*           &
!                    ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)*    &
!                     (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))    &
!                     +muu(i  ,j)*(u(i  ,k,j)+u(i  ,k-1,j))*msfux(i  ,j)*    &
!                     (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))  )
!        ENDDO
!        ENDDO
!        k = kte

!        DO j = j_start, jtf
!           ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*                         &
!!     &
!                     ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) &
!   *      &
!                      (phb(i+1,k,j)-phb(i  ,k,j)+ph(i+1,k,j)-ph(i  ,k,j))                &
!!     &
!                      +muu(i  ,j)*(cfn*u(i  ,k-1,j)+cfn1*u(i  ,k-2,j))*msfux(  i,j) &
!   *      &
!                      (phb(i  ,k,j)-phb(i-1,k,j)+ph(i  ,k,j)-ph(i-1,k,j))             )
!        ENDDO
!      END IF

!   END IF

!LPB[8]

!      i_start = its
!      itf=MIN(ite,ide-1)

!LPB[9]
!   IF ( (config_flags%open_ys) .and. jts == jds ) THEN

!        j=jts

!        DO k=2,kde
!          kz = min(k,kde-1)

!          DO i = its,itf
!            vb =.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j  ))      &
!                    +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j  )) )
!            vl=amin1(vb,0.)
!            ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(        &
!                                 +vl*(ph_old(i,k,j+1)-ph_old(i,k,j)))
!          ENDDO
!        ENDDO

!   END IF

!LPB[10]

!LPB[11]

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

!        j=jte-1

!        DO k=2,kde
!          kz = min(k,kde-1)

!          DO i = its,itf
!           vb=.5*( fnm(kz)*(v(i,kz  ,j+1)+v(i,kz  ,j))     &
!                  +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)) )
!           vr=amax1(vb,0.)
!           ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*(        &
!                      +vr*(ph_old(i,k,j)-ph_old(i,k,j-1)))
!          ENDDO
!        ENDDO

!   END IF

!LPB[12]

!      j_start = its
!      jtf=MIN(jte,jde-1)

!LPB[13]
!   IF ( (config_flags%open_xs) .and. its == ids ) THEN

!        i=its

!        DO j = jts,jtf
!          DO k=2,kde-1
!            kz = k
!            ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))       &
!                    +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
!            ul=amin1(ub,0.)
!            ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j) &
!   *(         &
!                                 +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
!          ENDDO
!            k = kde
!            kz = k
!            ub =.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i  ,kz  ,j))       &
!                    +fnp(kz)*(u(i+1,kz-1,j)+u(i  ,kz-1,j)) )
!            ul=amin1(ub,0.)
!            ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j) &
!   *(         &
!                                 +ul*(ph_old(i+1,k,j)-ph_old(i,k,j)))
!        ENDDO

!   END IF

!!LPB[14]

!!LPB[15]
!   
!   IF ( (config_flags%open_xe) .and. ite == ide ) THEN

!        i = ite-1

!        DO j = jts,jtf
!          DO k=2,kde-1
!           kz = k
!           ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))    &
!                  +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
!           ur=amax1(ub,0.)
!           ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*(   &
!                      +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
!          ENDDO
!           k = kde    
!           kz = k-1
!           ub=.5*( fnm(kz)*(u(i+1,kz  ,j)+u(i,kz  ,j))     &
!                  +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) )
!           ur=amax1(ub,0.)
!           ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*(    &
!                      +ur*(ph_old(i,k,j)-ph_old(i-1,k,j)))
!        ENDDO

!   END IF

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   a_ur =0.0
   a_ul =0.0
   a_ub =0.0
   a_vr =0.0
   a_vl =0.0
   a_vb =0.0

   Do K1_ADJ =kts, kte
   Do K0_ADJ =its, ite
   a_wdwn(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

! Added by Ning Pan, 2010-07-20
   j_start =its
   jtf =min(jte, jde-1)

!LPB[15]
   IF( (config_flags%open_xe) .and. ite == ide ) THEN
   i =ite-1
   DO j =jts, jtf
   DO k =2, kde-1
   kz =k
   Tmpv001 =u(i+1,kz,j) +u(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =u(i+1,kz-1,j) +u(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   ub =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv300(k,j) =ur
!   ur =max(ub, 0.)
   Tmpv300(k,j) =ub
   ur =amax1(ub, 0.)

   Tmpv001 =ph_old(i,k,j) -ph_old(i-1,k,j)
   Tmpv301(k,j) =Tmpv001
   Tmpv002 =ur*Tmpv301(k,j)
   Tmpv302(k,j) =+Tmpv002
!   Tmpv003 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*Tmpv302(k,j)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO
   k =kde
   kz =k-1
   Tmpv001 =u(i+1,kz,j) +u(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =u(i+1,kz-1,j) +u(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   ub =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv200(j) =ur
!   ur =max(ub, 0.)
   Tmpv200(j) =ub
   ur =amax1(ub, 0.)

   Tmpv001 =ph_old(i,k,j) -ph_old(i-1,k,j)
   Tmpv201(j) =Tmpv001
   Tmpv002 =ur*Tmpv201(j)
   Tmpv202(j) =+Tmpv002
!   Tmpv003 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*Tmpv202(j)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO

   END IF

   IF( (config_flags%open_xe) .and. ite == ide ) THEN
!  Added by Ning Pan, 2010-07-20 
   i =ite-1

   DO j =jtf, jts, -1
!  Added by Ning Pan, 2010-07-20 
   k =kde
   kz =k-1
   ub =Tmpv200(j)
   ur =amax1(ub, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +(msftx(i,j)/msfty(i,j))*rdx*Tmpv202(j)*a_Tmpv3
   a_Tmpv2 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*a_Tmpv3
   a_ur =a_ur +Tmpv201(j)*a_Tmpv2
   a_Tmpv1 =ur*a_Tmpv2
   a_ph_old(i,k,j) =a_ph_old(i,k,j) +a_Tmpv1
   a_ph_old(i-1,k,j) =a_ph_old(i-1,k,j) -a_Tmpv1

!   ur =Tmpv200(j)  ! Remarked by Ning Pan, 2010-07-20

   a_ub =a_ub +(1.0 +(1.0)*sign(1.0, ub -0.))*0.5*a_ur
   a_ur =0.0
   a_Tmpv6 =a_ub
   a_ub =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_u(i+1,kz-1,j) =a_u(i+1,kz-1,j) +a_Tmpv3
   a_u(i,kz-1,j) =a_u(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_u(i+1,kz,j) =a_u(i+1,kz,j) +a_Tmpv1
   a_u(i,kz,j) =a_u(i,kz,j) +a_Tmpv1
   DO k =kde-1, 2, -1
! Added by Ning Pan, 2010-07-20
   kz =k
   ub =Tmpv300(k,j)
   ur =amax1(ub, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +(msftx(i,j)/msfty(i,j))*rdx*Tmpv302(k,j)*a_Tmpv3
   a_Tmpv2 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*a_Tmpv3
   a_ur =a_ur +Tmpv301(k,j)*a_Tmpv2
   a_Tmpv1 =ur*a_Tmpv2
   a_ph_old(i,k,j) =a_ph_old(i,k,j) +a_Tmpv1
   a_ph_old(i-1,k,j) =a_ph_old(i-1,k,j) -a_Tmpv1

!   ur =Tmpv300(k,j)  ! Remarked by Ning Pan, 2010-07-20

   a_ub =a_ub +(1.0 +(1.0)*sign(1.0, ub -0.))*0.5*a_ur
   a_ur =0.0
   a_Tmpv6 =a_ub
   a_ub =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_u(i+1,kz-1,j) =a_u(i+1,kz-1,j) +a_Tmpv3
   a_u(i,kz-1,j) =a_u(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_u(i+1,kz,j) =a_u(i+1,kz,j) +a_Tmpv1
   a_u(i,kz,j) =a_u(i,kz,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[14]

!LPB[13]

   IF( (config_flags%open_xs) .and. its == ids ) THEN
   i =its
   DO j =jts, jtf
   DO k =2, kde-1
   kz =k
   Tmpv001 =u(i+1,kz,j) +u(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =u(i+1,kz-1,j) +u(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   ub =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv300(k,j) =ul
!   ul =min(ub, 0.)
   Tmpv300(k,j) =ub
   ul =amin1(ub, 0.)

   Tmpv001 =ph_old(i+1,k,j) -ph_old(i,k,j)
   Tmpv301(k,j) =Tmpv001
   Tmpv002 =ul*Tmpv301(k,j)
   Tmpv302(k,j) =+Tmpv002
!   Tmpv003 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*Tmpv302(k,j)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO
   k =kde
   kz =k
   Tmpv001 =u(i+1,kz,j) +u(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =u(i+1,kz-1,j) +u(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   ub =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv200(j) =ul
!   ul =min(ub, 0.)
   Tmpv200(j) =ub
   ul =amin1(ub, 0.)

   Tmpv001 =ph_old(i+1,k,j) -ph_old(i,k,j)
   Tmpv201(j) =Tmpv001
   Tmpv002 =ul*Tmpv201(j)
   Tmpv202(j) =+Tmpv002
!   Tmpv003 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*Tmpv202(j)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO

   END IF

   IF( (config_flags%open_xs) .and. its == ids ) THEN
!  Added by Ning Pan, 2010-07-20 
   i =its

   DO j =jtf, jts, -1
!  Added by Ning Pan, 2010-07-20 
   k =kde
   kz =k
   ub =Tmpv200(j)
   ul =amin1(ub, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +(msftx(i,j)/msfty(i,j))*rdx*Tmpv202(j)*a_Tmpv3
   a_Tmpv2 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*a_Tmpv3
   a_ul =a_ul +Tmpv201(j)*a_Tmpv2
   a_Tmpv1 =ul*a_Tmpv2
   a_ph_old(i+1,k,j) =a_ph_old(i+1,k,j) +a_Tmpv1
   a_ph_old(i,k,j) =a_ph_old(i,k,j) -a_Tmpv1

!   ul =Tmpv200(j)  ! Remarked by Ning Pan, 2010-07-20

   a_ub =a_ub +(1.0 -(1.0)*sign(1.0, ub -0.))*0.5*a_ul
   a_ul =0.0
   a_Tmpv6 =a_ub
   a_ub =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_u(i+1,kz-1,j) =a_u(i+1,kz-1,j) +a_Tmpv3
   a_u(i,kz-1,j) =a_u(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_u(i+1,kz,j) =a_u(i+1,kz,j) +a_Tmpv1
   a_u(i,kz,j) =a_u(i,kz,j) +a_Tmpv1
   DO k =kde-1, 2, -1
! Added by Ning Pan, 2010-07-20
   kz =k
   ub =Tmpv300(k,j)
   ul =amin1(ub, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +(msftx(i,j)/msfty(i,j))*rdx*Tmpv302(k,j)*a_Tmpv3
   a_Tmpv2 =(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*a_Tmpv3
   a_ul =a_ul +Tmpv301(k,j)*a_Tmpv2
   a_Tmpv1 =ul*a_Tmpv2
   a_ph_old(i+1,k,j) =a_ph_old(i+1,k,j) +a_Tmpv1
   a_ph_old(i,k,j) =a_ph_old(i,k,j) -a_Tmpv1

!   ul =Tmpv300(k,j)  ! Remarked by Ning Pan, 2010-07-20

   a_ub =a_ub +(1.0 -(1.0)*sign(1.0, ub -0.))*0.5*a_ul
   a_ul =0.0
   a_Tmpv6 =a_ub
   a_ub =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_u(i+1,kz-1,j) =a_u(i+1,kz-1,j) +a_Tmpv3
   a_u(i,kz-1,j) =a_u(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_u(i+1,kz,j) =a_u(i+1,kz,j) +a_Tmpv1
   a_u(i,kz,j) =a_u(i,kz,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[12]
!  j_start =its
!  jtf =min(jte, jde-1)

!LPB[11]
! Added by Ning Pan, 2010-07-20
   i_start =its
   itf =min(ite,ide-1)

   IF( (config_flags%open_ye) .and. jte == jde ) THEN
   j =jte-1
   DO k =2, kde
   kz =min(k, kde-1)

   DO i =its, itf
   Tmpv001 =v(i,kz,j+1) +v(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =v(i,kz-1,j+1) +v(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   vb =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv300(i,k) =vr
!   vr =max(vb, 0.)
   Tmpv300(i,k) =vb
   vr =amax1(vb, 0.)

   Tmpv001 =ph_old(i,k,j) -ph_old(i,k,j-1)
   Tmpv301(i,k) =Tmpv001
   Tmpv002 =vr*Tmpv301(i,k)
   Tmpv302(i,k) =+Tmpv002
!   Tmpv003 =rdy*mut(i,j)*Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO
   ENDDO
   END IF

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

   j =jte-1  ! Added by Ning Pan, 2010-07-20
   DO k =kde, 2, -1
   kz =min(k, kde-1)  ! Added by Ning Pan, 2010-07-20

   DO i =itf, its, -1
! Added by Ning Pan, 2010-07-20
   vb =Tmpv300(i,k)
   vr =amax1(vb, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +rdy*Tmpv302(i,k)*a_Tmpv3
   a_Tmpv2 =rdy*mut(i,j)*a_Tmpv3
   a_vr =a_vr +Tmpv301(i,k)*a_Tmpv2
   a_Tmpv1 =vr*a_Tmpv2
   a_ph_old(i,k,j) =a_ph_old(i,k,j) +a_Tmpv1
   a_ph_old(i,k,j-1) =a_ph_old(i,k,j-1) -a_Tmpv1

!   vr =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-07-20

   a_vb =a_vb +(1.0 +(1.0)*sign(1.0, vb -0.))*0.5*a_vr
   a_vr =0.0
   a_Tmpv6 =a_vb
   a_vb =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_v(i,kz-1,j+1) =a_v(i,kz-1,j+1) +a_Tmpv3
   a_v(i,kz-1,j) =a_v(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_v(i,kz,j+1) =a_v(i,kz,j+1) +a_Tmpv1
   a_v(i,kz,j) =a_v(i,kz,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[10]

!LPB[9]

   IF( (config_flags%open_ys) .and. jts == jds ) THEN
   j =jts
   DO k =2, kde
   kz =min(k, kde-1)

   DO i =its, itf
   Tmpv001 =v(i,kz,j+1) +v(i,kz,j)
   Tmpv002 =fnm(kz)*Tmpv001
   Tmpv003 =v(i,kz-1,j+1) +v(i,kz-1,j)
   Tmpv004 =fnp(kz)*Tmpv003
   Tmpv005 =Tmpv002 +Tmpv004
   Tmpv006 =.5*Tmpv005
   vb =Tmpv006  ! Removed remark by Ning Pan, 2010-07-20

! Revised by Ning Pan, 2010-07-20
!   Tmpv300(i,k) =vl
!   vl =min(vb, 0.)
   Tmpv300(i,k) =vb
   vl =amin1(vb, 0.)

   Tmpv001 =ph_old(i,k,j+1) -ph_old(i,k,j)
   Tmpv301(i,k) =Tmpv001
   Tmpv002 =vl*Tmpv301(i,k)
   Tmpv302(i,k) =+Tmpv002
!   Tmpv003 =rdy*mut(i,j)*Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-07-20
!   Tmpv004 =ph_tend(i,k,j) -Tmpv003  ! Remarked by Ning Pan, 2010-07-20
!  ph_tend(i,k,j) =Tmpv004

   ENDDO
   ENDDO
   END IF

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

   j =jts  ! Added by Ning Pan, 2010-07-20
   DO k =kde, 2, -1
   kz =min(k, kde-1)  ! Added by Ning Pan, 2010-07-20

   DO i =itf, its, -1
! Added by Ning Pan, 2010-07-20
   vb =Tmpv300(i,k)
   vl =amin1(vb, 0.)

   a_Tmpv4 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_mut(i,j) =a_mut(i,j) +rdy*Tmpv302(i,k)*a_Tmpv3
   a_Tmpv2 =rdy*mut(i,j)*a_Tmpv3
   a_vl =a_vl +Tmpv301(i,k)*a_Tmpv2
   a_Tmpv1 =vl*a_Tmpv2
   a_ph_old(i,k,j+1) =a_ph_old(i,k,j+1) +a_Tmpv1
   a_ph_old(i,k,j) =a_ph_old(i,k,j) -a_Tmpv1

!   vl =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-07-20

   a_vb =a_vb +(1.0 -(1.0)*sign(1.0, vb -0.))*0.5*a_vl
   a_vl =0.0
   a_Tmpv6 =a_vb
   a_vb =0.0
   a_Tmpv5 =.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fnp(kz)*a_Tmpv4
   a_v(i,kz-1,j+1) =a_v(i,kz-1,j+1) +a_Tmpv3
   a_v(i,kz-1,j) =a_v(i,kz-1,j) +a_Tmpv3
   a_Tmpv1 =fnm(kz)*a_Tmpv2
   a_v(i,kz,j+1) =a_v(i,kz,j+1) +a_Tmpv1
   a_v(i,kz,j) =a_v(i,kz,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

!LPB[8]
!  i_start =its
!  itf =min(ite, ide-1)

!LPB[7]

   IF(advective_order <= 2) THEN
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF( (config_flags%open_ys .or. specified) .and. jts == jds ) THEN
   j_start =jts+1
   END IF
   IF( (config_flags%open_ye .or. specified) .and. jte == jde ) THEN
   jtf =jtf-2
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv400(i,k,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv400(i,k,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv401(i,k,j) =Tmpv003
   Tmpv402(i,k,j) =Tmpv004
   Tmpv005 =Tmpv401(i,k,j)*Tmpv402(i,k,j)
   Tmpv006 =v(i,k,j) +v(i,k-1,j)
   Tmpv403(i,k,j) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv403(i,k,j)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv404(i,k,j) =Tmpv008
   Tmpv405(i,k,j) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv404(i,k,j)*Tmpv405(i,k,j)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.25*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv300(i,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv300(i,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv301(i,j) =Tmpv003
   Tmpv302(i,j) =Tmpv004
   Tmpv005 =Tmpv301(i,j)*Tmpv302(i,j)
   Tmpv006 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv303(i,j) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv303(i,j)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv304(i,j) =Tmpv008
   Tmpv305(i,j) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv304(i,j)*Tmpv305(i,j)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.5*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF( (config_flags%open_xs .or. specified) .and. its == ids ) THEN
   i_start =its+1
   END IF
   IF( (config_flags%open_xe .or. specified) .and. ite == ide ) THEN
   itf =itf-2
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv406(i,k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv406(i,k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv407(i,k,j) =Tmpv003
   Tmpv408(i,k,j) =Tmpv004
   Tmpv005 =Tmpv407(i,k,j)*Tmpv408(i,k,j)
   Tmpv006 =u(i,k,j) +u(i,k-1,j)
   Tmpv409(i,k,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv409(i,k,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv4010(i,k,j) =Tmpv008
   Tmpv4011(i,k,j) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv4010(i,k,j)*Tmpv4011(i,k,j)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.25*rdx/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv306(i,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv306(i,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv307(i,j) =Tmpv003
   Tmpv308(i,j) =Tmpv004
   Tmpv005 =Tmpv307(i,j)*Tmpv308(i,j)
   Tmpv006 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv309(i,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv309(i,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv3010(i,j) =Tmpv008
   Tmpv3011(i,j) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv3010(i,j)*Tmpv3011(i,j)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.5*rdx/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   ELSE IF(advective_order <= 4) THEN
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF( (config_flags%open_ys .or. specified) .and. jts == jds ) THEN
   j_start =jts+2
   END IF
   IF( (config_flags%open_ye .or. specified) .and. jte == jde ) THEN
   jtf =jtf-3
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv4012(i,k,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv4012(i,k,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =v(i,k,j) +v(i,k-1,j)
   Tmpv4013(i,k,j) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv4013(i,k,j)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv4014(i,k,j) =Tmpv008
   Tmpv4015(i,k,j) =Tmpv014
! Remarked by Ning Pan, 2010-07-20
!   Tmpv015 =Tmpv4014(i,k,j)*Tmpv4015(i,k,j)
!   Tmpv016 =(0.25*rdy/msfty(i,j))*Tmpv015
!   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv3012(i,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3012(i,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv3013(i,j) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv3013(i,j)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv3014(i,j) =Tmpv008
   Tmpv3015(i,j) =Tmpv014
! Remarked by Ning Pan, 2010-07-20
!   Tmpv015 =Tmpv3014(i,j)*Tmpv3015(i,j)
!   Tmpv016 =(0.5*rdy/msfty(i,j))*Tmpv015
!   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+1 ) THEN
   j =jds+1
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3016(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3016(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv3017(i,k) =Tmpv003
   Tmpv3018(i,k) =Tmpv004
   Tmpv005 =Tmpv3017(i,k)*Tmpv3018(i,k)
   Tmpv006 =v(i,k,j) +v(i,k-1,j)
   Tmpv3019(i,k) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv3019(i,k)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv3020(i,k) =Tmpv008
   Tmpv3021(i,k) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv3020(i,k)*Tmpv3021(i,k)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.25*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv200(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv200(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv201(i) =Tmpv003
   Tmpv202(i) =Tmpv004
   Tmpv005 =Tmpv201(i)*Tmpv202(i)
   Tmpv006 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv203(i) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv203(i)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv204(i) =Tmpv008
   Tmpv205(i) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv204(i)*Tmpv205(i)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.5*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   IF( (config_flags%open_ye .or. specified) .and. jte >= jde-2 ) THEN
   j =jde-2
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3022(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3022(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv3023(i,k) =Tmpv003
   Tmpv3024(i,k) =Tmpv004
   Tmpv005 =Tmpv3023(i,k)*Tmpv3024(i,k)
   Tmpv006 =v(i,k,j) +v(i,k-1,j)
   Tmpv3025(i,k) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv3025(i,k)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv3026(i,k) =Tmpv008
   Tmpv3027(i,k) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv3026(i,k)*Tmpv3027(i,k)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.25*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv206(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv206(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv207(i) =Tmpv003
   Tmpv208(i) =Tmpv004
   Tmpv005 =Tmpv207(i)*Tmpv208(i)
   Tmpv006 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv209(i) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv209(i)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv2010(i) =Tmpv008
   Tmpv2011(i) =Tmpv009
! Remarked by Ning Pan, 2010-07-20
!   Tmpv010 =Tmpv2010(i)*Tmpv2011(i)
!   Tmpv011 =Tmpv005 +Tmpv010
!   Tmpv012 =(0.5*rdy/msfty(i,j))*Tmpv011
!   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF( (config_flags%open_xs) .and. its == ids ) THEN
   i_start =its+2
   END IF
   IF( (config_flags%open_xe) .and. ite == ide ) THEN
   itf =itf-3
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv4016(i,k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv4016(i,k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =u(i,k,j) +u(i,k-1,j)
   Tmpv4017(i,k,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv4017(i,k,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv4018(i,k,j) =Tmpv008
   Tmpv4019(i,k,j) =Tmpv014
! Remarked by Ning Pan, 2010-07-20
!   Tmpv015 =Tmpv4018(i,k,j)*Tmpv4019(i,k,j)
!   Tmpv016 =(0.25*rdx/msfty(i,j))*Tmpv015
!   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv3028(i,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3028(i,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv3029(i,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv3029(i,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv3030(i,j) =Tmpv008
   Tmpv3031(i,j) =Tmpv014
! Remarked by Ning Pan, 2010-07-20
!   Tmpv015 =Tmpv3030(i,j)*Tmpv3031(i,j)
!   Tmpv016 =(0.5*rdx/msfty(i,j))*Tmpv015
!   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   IF( (config_flags%open_xs .or. specified) .and. its <= ids+1 ) THEN
   i =ids+1
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3032(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3032(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv3033(k,j) =Tmpv003
   Tmpv3034(k,j) =Tmpv004
   Tmpv005 =Tmpv3033(k,j)*Tmpv3034(k,j)
   Tmpv006 =u(i,k,j) +u(i,k-1,j)
   Tmpv3035(k,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv3035(k,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv3036(k,j) =Tmpv008
   Tmpv3037(k,j) =Tmpv009
   Tmpv010 =Tmpv3036(k,j)*Tmpv3037(k,j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO j =j_start, jtf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2012(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2012(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv2013(j) =Tmpv003
   Tmpv2014(j) =Tmpv004
   Tmpv005 =Tmpv2013(j)*Tmpv2014(j)
   Tmpv006 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2015(j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv2015(j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv2016(j) =Tmpv008
   Tmpv2017(j) =Tmpv009
   Tmpv010 =Tmpv2016(j)*Tmpv2017(j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   IF( (config_flags%open_xe .or. specified) .and. ite >= ide-2 ) THEN
   i =ide-2
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3038(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3038(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv3039(k,j) =Tmpv003
   Tmpv3040(k,j) =Tmpv004
   Tmpv005 =Tmpv3039(k,j)*Tmpv3040(k,j)
   Tmpv006 =u(i,k,j) +u(i,k-1,j)
   Tmpv3041(k,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv3041(k,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv3042(k,j) =Tmpv008
   Tmpv3043(k,j) =Tmpv009
   Tmpv010 =Tmpv3042(k,j)*Tmpv3043(k,j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO j =j_start, jtf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2018(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2018(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv2019(j) =Tmpv003
   Tmpv2020(j) =Tmpv004
   Tmpv005 =Tmpv2019(j)*Tmpv2020(j)
   Tmpv006 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2021(j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv2021(j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv2022(j) =Tmpv008
   Tmpv2023(j) =Tmpv009
   Tmpv010 =Tmpv2022(j)*Tmpv2023(j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   ELSE IF(advective_order <= 6) THEN
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF(config_flags%open_ys .or. specified ) THEN
   j_start =max(jts, jds+3)
   END IF
   IF(config_flags%open_ye .or. specified ) THEN
   jtf =min(jtf, jde-4)
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv4020(i,k,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv4020(i,k,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =v(i,k,j) +v(i,k-1,j)
   Tmpv4021(i,k,j) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv4021(i,k,j)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./60.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =45.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =9.*Tmpv011
   Tmpv013 =Tmpv010 -Tmpv012
   Tmpv014 =ph(i,k,j+3) -ph(i,k,j-3)
   Tmpv015 =Tmpv013 +Tmpv014
   Tmpv016 =Tmpv015 +45.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv017 =Tmpv016 -9.*(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv018 =Tmpv017 +(phb(i,k,j+3)-phb(i,k,j-3))
   Tmpv4022(i,k,j) =Tmpv008
   Tmpv4023(i,k,j) =Tmpv018
   Tmpv019 =Tmpv4022(i,k,j)*Tmpv4023(i,k,j)
   Tmpv020 =(0.25*rdy/msfty(i,j))*Tmpv019
   Tmpv021 =ph_tend(i,k,j) -Tmpv020
!  ph_tend(i,k,j) =Tmpv021

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv3044(i,j) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3044(i,j)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv3045(i,j) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv3045(i,j)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./60.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =45.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =9.*Tmpv011
   Tmpv013 =Tmpv010 -Tmpv012
   Tmpv014 =ph(i,k,j+3) -ph(i,k,j-3)
   Tmpv015 =Tmpv013 +Tmpv014
   Tmpv016 =Tmpv015 +45.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv017 =Tmpv016 -9.*(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv018 =Tmpv017 +(phb(i,k,j+3)-phb(i,k,j-3))
   Tmpv3046(i,j) =Tmpv008
   Tmpv3047(i,j) =Tmpv018
   Tmpv019 =Tmpv3046(i,j)*Tmpv3047(i,j)
   Tmpv020 =(0.5*rdy/msfty(i,j))*Tmpv019
   Tmpv021 =ph_tend(i,k,j) -Tmpv020
!  ph_tend(i,k,j) =Tmpv021

   ENDDO
   ENDDO
   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+2 .and. jds+2 <= jte ) THEN
   j =jds+2
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3048(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3048(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =v(i,k,j) +v(i,k-1,j)
   Tmpv3049(i,k) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv3049(i,k)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv3050(i,k) =Tmpv008
   Tmpv3051(i,k) =Tmpv014
   Tmpv015 =Tmpv3050(i,k)*Tmpv3051(i,k)
   Tmpv016 =(0.25*rdy/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv2024(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv2024(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv2025(i) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv2025(i)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv2026(i) =Tmpv008
   Tmpv2027(i) =Tmpv014
   Tmpv015 =Tmpv2026(i)*Tmpv2027(i)
   Tmpv016 =(0.5*rdy/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO

   END IF
   IF( (config_flags%open_ye .or. specified) .and. jts <= jde-3 .and. jde-3 <= jte ) THEN
   j =jde-3
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3052(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3052(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =v(i,k,j) +v(i,k-1,j)
   Tmpv3053(i,k) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv3053(i,k)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv3054(i,k) =Tmpv008
   Tmpv3055(i,k) =Tmpv014
   Tmpv015 =Tmpv3054(i,k)*Tmpv3055(i,k)
   Tmpv016 =(0.25*rdy/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv2028(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv2028(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv2029(i) =Tmpv004
   Tmpv005 =muv(i,j)*Tmpv2029(i)
   Tmpv006 =Tmpv005*msfvy(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i,k,j+1) -ph(i,k,j-1)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i,k,j+2) -ph(i,k,j-2)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i,k,j+1)-phb(i,k,j-1))
   Tmpv014 =Tmpv013 -(phb(i,k,j+2)-phb(i,k,j-2))
   Tmpv2030(i) =Tmpv008
   Tmpv2031(i) =Tmpv014
   Tmpv015 =Tmpv2030(i)*Tmpv2031(i)
   Tmpv016 =(0.5*rdy/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO

   END IF
   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+1 .and. jds+1 <= jte ) THEN
   j =jds+1
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3056(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3056(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv3057(i,k) =Tmpv003
   Tmpv3058(i,k) =Tmpv004
   Tmpv005 =Tmpv3057(i,k)*Tmpv3058(i,k)
   Tmpv006 =v(i,k,j) +v(i,k-1,j)
   Tmpv3059(i,k) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv3059(i,k)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv3060(i,k) =Tmpv008
   Tmpv3061(i,k) =Tmpv009
   Tmpv010 =Tmpv3060(i,k)*Tmpv3061(i,k)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdy/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv2032(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv2032(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv2033(i) =Tmpv003
   Tmpv2034(i) =Tmpv004
   Tmpv005 =Tmpv2033(i)*Tmpv2034(i)
   Tmpv006 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv2035(i) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv2035(i)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv2036(i) =Tmpv008
   Tmpv2037(i) =Tmpv009
   Tmpv010 =Tmpv2036(i)*Tmpv2037(i)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdy/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   IF( (config_flags%open_ye .or. specified) .and. jts <= jde-2 .and. jde-2 <= jte ) THEN
   j =jde-2
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =v(i,k,j+1) +v(i,k-1,j+1)
   Tmpv3062(i,k) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv3062(i,k)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv3063(i,k) =Tmpv003
   Tmpv3064(i,k) =Tmpv004
   Tmpv005 =Tmpv3063(i,k)*Tmpv3064(i,k)
   Tmpv006 =v(i,k,j) +v(i,k-1,j)
   Tmpv3065(i,k) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv3065(i,k)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv3066(i,k) =Tmpv008
   Tmpv3067(i,k) =Tmpv009
   Tmpv010 =Tmpv3066(i,k)*Tmpv3067(i,k)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdy/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO i =i_start, itf
   Tmpv001 =cfn*v(i,k-1,j+1) +cfn1*v(i,k-2,j+1)
   Tmpv2038(i) =Tmpv001
   Tmpv002 =muv(i,j+1)*Tmpv2038(i)
   Tmpv003 =Tmpv002*msfvy(i,j+1)
   Tmpv004 =phb(i,k,j+1)-phb(i,k,j) +ph(i,k,j+1) -ph(i,k,j)
   Tmpv2039(i) =Tmpv003
   Tmpv2040(i) =Tmpv004
   Tmpv005 =Tmpv2039(i)*Tmpv2040(i)
   Tmpv006 =cfn*v(i,k-1,j) +cfn1*v(i,k-2,j)
   Tmpv2041(i) =Tmpv006
   Tmpv007 =muv(i,j)*Tmpv2041(i)
   Tmpv008 =Tmpv007*msfvy(i,j)
   Tmpv009 =phb(i,k,j)-phb(i,k,j-1) +ph(i,k,j) -ph(i,k,j-1)
   Tmpv2042(i) =Tmpv008
   Tmpv2043(i) =Tmpv009
   Tmpv010 =Tmpv2042(i)*Tmpv2043(i)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdy/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   i_start =its
   j_start =jts
   itf =min(ite, ide-1)
   jtf =min(jte, jde-1)
   IF(config_flags%open_xs .or. specified ) THEN
   i_start =max(its, ids+3)
   END IF
   IF(config_flags%open_xe .or. specified ) THEN
   itf =min(itf, ide-4)
   END IF
   DO j =j_start, jtf
   DO k =2, kte-1
   DO i =i_start, itf
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv4024(i,k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv4024(i,k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =u(i,k,j) +u(i,k-1,j)
   Tmpv4025(i,k,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv4025(i,k,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./60.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =45.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =9.*Tmpv011
   Tmpv013 =Tmpv010 -Tmpv012
   Tmpv014 =ph(i+3,k,j) -ph(i-3,k,j)
   Tmpv015 =Tmpv013 +Tmpv014
   Tmpv016 =Tmpv015 +45.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv017 =Tmpv016 -9.*(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv018 =Tmpv017 +(phb(i+3,k,j)-phb(i-3,k,j))
   Tmpv4026(i,k,j) =Tmpv008
   Tmpv4027(i,k,j) =Tmpv018
   Tmpv019 =Tmpv4026(i,k,j)*Tmpv4027(i,k,j)
   Tmpv020 =(0.25*rdx/msfty(i,j))*Tmpv019
   Tmpv021 =ph_tend(i,k,j) -Tmpv020
!  ph_tend(i,k,j) =Tmpv021

   ENDDO
   ENDDO
   k =kte

   DO i =i_start, itf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv3068(i,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3068(i,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv3069(i,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv3069(i,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./60.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =45.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =9.*Tmpv011
   Tmpv013 =Tmpv010 -Tmpv012
   Tmpv014 =ph(i+3,k,j) -ph(i-3,k,j)
   Tmpv015 =Tmpv013 +Tmpv014
   Tmpv016 =Tmpv015 +45.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv017 =Tmpv016 -9.*(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv018 =Tmpv017 +(phb(i+3,k,j)-phb(i-3,k,j))
   Tmpv3070(i,j) =Tmpv008
   Tmpv3071(i,j) =Tmpv018
   Tmpv019 =Tmpv3070(i,j)*Tmpv3071(i,j)
   Tmpv020 =(0.5*rdx/msfty(i,j))*Tmpv019
   Tmpv021 =ph_tend(i,k,j) -Tmpv020
!  ph_tend(i,k,j) =Tmpv021

   ENDDO
   ENDDO
   IF( (config_flags%open_xs) .and. its <= ids+2 .and. ids+2 <= ite ) THEN
   i =ids+2
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3072(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3072(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =u(i,k,j) +u(i,k-1,j)
   Tmpv3073(k,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv3073(k,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv3074(k,j) =Tmpv008
   Tmpv3075(k,j) =Tmpv014
   Tmpv015 =Tmpv3074(k,j)*Tmpv3075(k,j)
   Tmpv016 =(0.25*rdx/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   k =kte
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2044(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2044(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2045(j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv2045(j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv2046(j) =Tmpv008
   Tmpv2047(j) =Tmpv014
   Tmpv015 =Tmpv2046(j)*Tmpv2047(j)
   Tmpv016 =(0.5*rdx/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO

   END IF
   IF( (config_flags%open_xe) .and. its <= ide-3 .and. ide-3 <= ite ) THEN
   i =ide-3
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3076(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3076(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =u(i,k,j) +u(i,k-1,j)
   Tmpv3077(k,j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv3077(k,j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv3078(k,j) =Tmpv008
   Tmpv3079(k,j) =Tmpv014
   Tmpv015 =Tmpv3078(k,j)*Tmpv3079(k,j)
   Tmpv016 =(0.25*rdx/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO
   k =kte
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2048(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2048(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2049(j) =Tmpv004
   Tmpv005 =muu(i,j)*Tmpv2049(j)
   Tmpv006 =Tmpv005*msfux(i,j)
   Tmpv007 =Tmpv003 +Tmpv006
   Tmpv008 =Tmpv007*(1./12.)
   Tmpv009 =ph(i+1,k,j) -ph(i-1,k,j)
   Tmpv010 =8.*Tmpv009
   Tmpv011 =ph(i+2,k,j) -ph(i-2,k,j)
   Tmpv012 =Tmpv010 -Tmpv011
   Tmpv013 =Tmpv012 +8.*(phb(i+1,k,j)-phb(i-1,k,j))
   Tmpv014 =Tmpv013 -(phb(i+2,k,j)-phb(i-2,k,j))
   Tmpv2050(j) =Tmpv008
   Tmpv2051(j) =Tmpv014
   Tmpv015 =Tmpv2050(j)*Tmpv2051(j)
   Tmpv016 =(0.5*rdx/msfty(i,j))*Tmpv015
   Tmpv017 =ph_tend(i,k,j) -Tmpv016
!  ph_tend(i,k,j) =Tmpv017

   ENDDO

   END IF
   IF( (config_flags%open_xs .or. specified) .and. its <= ids+1 .and. ids+1 <= ite ) THEN
   i =ids+1
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3080(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3080(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv3081(k,j) =Tmpv003
   Tmpv3082(k,j) =Tmpv004
   Tmpv005 =Tmpv3081(k,j)*Tmpv3082(k,j)
   Tmpv006 =u(i,k,j) +u(i,k-1,j)
   Tmpv3083(k,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv3083(k,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv3084(k,j) =Tmpv008
   Tmpv3085(k,j) =Tmpv009
   Tmpv010 =Tmpv3084(k,j)*Tmpv3085(k,j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO j =j_start, jtf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2052(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2052(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv2053(j) =Tmpv003
   Tmpv2054(j) =Tmpv004
   Tmpv005 =Tmpv2053(j)*Tmpv2054(j)
   Tmpv006 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2055(j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv2055(j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv2056(j) =Tmpv008
   Tmpv2057(j) =Tmpv009
   Tmpv010 =Tmpv2056(j)*Tmpv2057(j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   IF( (config_flags%open_xe .or. specified) .and. its <= ide-2 .and. ide-2 <= ite ) THEN
   i =ide-2
   DO j =j_start, jtf
   DO k =2, kte-1
   Tmpv001 =u(i+1,k,j) +u(i+1,k-1,j)
   Tmpv3086(k,j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv3086(k,j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv3087(k,j) =Tmpv003
   Tmpv3088(k,j) =Tmpv004
   Tmpv005 =Tmpv3087(k,j)*Tmpv3088(k,j)
   Tmpv006 =u(i,k,j) +u(i,k-1,j)
   Tmpv3089(k,j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv3089(k,j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv3090(k,j) =Tmpv008
   Tmpv3091(k,j) =Tmpv009
   Tmpv010 =Tmpv3090(k,j)*Tmpv3091(k,j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.25*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO
   ENDDO
   k =kte
   DO j =j_start, jtf
   Tmpv001 =cfn*u(i+1,k-1,j) +cfn1*u(i+1,k-2,j)
   Tmpv2058(j) =Tmpv001
   Tmpv002 =muu(i+1,j)*Tmpv2058(j)
   Tmpv003 =Tmpv002*msfux(i+1,j)
   Tmpv004 =phb(i+1,k,j)-phb(i,k,j) +ph(i+1,k,j) -ph(i,k,j)
   Tmpv2059(j) =Tmpv003
   Tmpv2060(j) =Tmpv004
   Tmpv005 =Tmpv2059(j)*Tmpv2060(j)
   Tmpv006 =cfn*u(i,k-1,j) +cfn1*u(i,k-2,j)
   Tmpv2061(j) =Tmpv006
   Tmpv007 =muu(i,j)*Tmpv2061(j)
   Tmpv008 =Tmpv007*msfux(i,j)
   Tmpv009 =phb(i,k,j)-phb(i-1,k,j) +ph(i,k,j) -ph(i-1,k,j)
   Tmpv2062(j) =Tmpv008
   Tmpv2063(j) =Tmpv009
   Tmpv010 =Tmpv2062(j)*Tmpv2063(j)
   Tmpv011 =Tmpv005 +Tmpv010
   Tmpv012 =(0.5*rdx/msfty(i,j))*Tmpv011
   Tmpv013 =ph_tend(i,k,j) -Tmpv012
!  ph_tend(i,k,j) =Tmpv013

   ENDDO

   END IF
   END IF

   IF(advective_order <= 2) THEN

! Added by Ning Pan, 2010-07-20
!  x (u) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF ( (config_flags%open_xs .or. specified) .and. its == ids ) i_start = its+1
   IF ( (config_flags%open_xe .or. specified) .and. ite == ide ) itf = itf-2
 
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3011(i,j)*a_Tmpv10
   a_Tmpv9 =Tmpv3010(i,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv309(i,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv308(i,j)*a_Tmpv5
   a_Tmpv4 =Tmpv307(i,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv306(i,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv4011(i,k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv4010(i,k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv409(i,k,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv6
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv408(i,k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv407(i,k,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv406(i,k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF( (config_flags%open_xe .or. specified) .and. ite == ide ) THEN

!   END IF

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

!   END IF

! Added by Ning Pan, 2010-07-20
!  y (v) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+1
   IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-2

   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv305(i,j)*a_Tmpv10
   a_Tmpv9 =Tmpv304(i,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv303(i,j)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv302(i,j)*a_Tmpv5
   a_Tmpv4 =Tmpv301(i,j)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv300(i,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv405(i,k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv404(i,k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv403(i,k,j)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv6
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv402(i,k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv401(i,k,j)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv400(i,k,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF( (config_flags%open_ye .or. specified) .and. jte == jde ) THEN

!   END IF

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

!   END IF

   ELSE IF(advective_order <= 4) THEN

! Added by Ning Pan, 2010-07-20
!  x (u) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+2
   IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-3

   IF( (config_flags%open_xe .or. specified) .and. ite >= ide-2 ) THEN

   i = ide-2  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2023(j)*a_Tmpv10
   a_Tmpv9 =Tmpv2022(j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv2021(j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2020(j)*a_Tmpv5
   a_Tmpv4 =Tmpv2019(j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2018(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO j =jtf, j_start, -1
   DO k =kte-1, 2, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3043(k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv3042(k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv3041(k,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv6
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3040(k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv3039(k,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3038(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_xs .or. specified) .and. its <= ids+1 ) THEN

! Added by Ning Pan, 2010-07-20
   i = ids + 1  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2017(j)*a_Tmpv10
   a_Tmpv9 =Tmpv2016(j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv2015(j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2014(j)*a_Tmpv5
   a_Tmpv4 =Tmpv2013(j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2012(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO

   DO j =jtf, j_start, -1
   DO k =kte-1, 2, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3037(k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv3036(k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv3035(k,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv6
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3034(k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv3033(k,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3032(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO
!   DO j =jtf, j_start, -1
!   a_Tmpv13 =a_ph_tend(i,k,j)
!   a_ph_tend(i,k,j) =0.0
!   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
!   a_Tmpv12 =-a_Tmpv13
!   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
!   a_Tmpv5 =a_Tmpv11
!   a_Tmpv10 =a_Tmpv11
!   a_Tmpv8 =Tmpv2017(j)*a_Tmpv10
!   a_Tmpv9 =Tmpv2016(j)*a_Tmpv10
!   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
!   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
!   a_Tmpv7 =msfux(i,j)*a_Tmpv8
!   a_muu(i,j) =a_muu(i,j) +Tmpv2015(j)*a_Tmpv7
!   a_Tmpv6 =muu(i,j)*a_Tmpv7
!   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
!   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
!   a_Tmpv3 =Tmpv2014(j)*a_Tmpv5
!   a_Tmpv4 =Tmpv2013(j)*a_Tmpv5
!   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
!   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
!   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
!   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2012(j)*a_Tmpv2
!   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
!   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
!   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
!   ENDDO

   END IF

   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3031(i,j)*a_Tmpv15
   a_Tmpv14 =Tmpv3030(i,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv3029(i,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv4
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3028(i,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv4019(i,k,j)*a_Tmpv15
   a_Tmpv14 =Tmpv4018(i,k,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv4017(i,k,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv4
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv4016(i,k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF( (config_flags%open_xe) .and. ite == ide ) THEN

!   END IF

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

!   END IF

! Added by Ning Pan, 2010-07-20
!  y (v) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+2
   IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-3

   IF( (config_flags%open_ye .or. specified) .and. jte >= jde-2 ) THEN

   j = jde-2  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2011(i)*a_Tmpv10
   a_Tmpv9 =Tmpv2010(i)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv209(i)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv208(i)*a_Tmpv5
   a_Tmpv4 =Tmpv207(i)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv206(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3027(i,k)*a_Tmpv10
   a_Tmpv9 =Tmpv3026(i,k)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv3025(i,k)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv6
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3024(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv3023(i,k)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3022(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+1 ) THEN

   j = jds+1  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv205(i)*a_Tmpv10
   a_Tmpv9 =Tmpv204(i)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv203(i)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv202(i)*a_Tmpv5
   a_Tmpv4 =Tmpv201(i)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv200(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO

   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3021(i,k)*a_Tmpv10
   a_Tmpv9 =Tmpv3020(i,k)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv3019(i,k)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv6
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3018(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv3017(i,k)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3016(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO
! Remarked by Ning Pan, 2010-07-20
!   DO i =itf, i_start, -1
!   a_Tmpv13 =a_ph_tend(i,k,j)
!   a_ph_tend(i,k,j) =0.0
!   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
!   a_Tmpv12 =-a_Tmpv13
!   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
!   a_Tmpv5 =a_Tmpv11
!   a_Tmpv10 =a_Tmpv11
!   a_Tmpv8 =Tmpv205(i)*a_Tmpv10
!   a_Tmpv9 =Tmpv204(i)*a_Tmpv10
!   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
!   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
!   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
!   a_muv(i,j) =a_muv(i,j) +Tmpv203(i)*a_Tmpv7
!   a_Tmpv6 =muv(i,j)*a_Tmpv7
!   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
!   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
!   a_Tmpv3 =Tmpv202(i)*a_Tmpv5
!   a_Tmpv4 =Tmpv201(i)*a_Tmpv5
!   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
!   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
!   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
!   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv200(i)*a_Tmpv2
!   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
!   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
!   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
!   ENDDO

   END IF
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3015(i,j)*a_Tmpv15
   a_Tmpv14 =Tmpv3014(i,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv3013(i,j)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv4
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3012(i,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv4015(i,k,j)*a_Tmpv15
   a_Tmpv14 =Tmpv4014(i,k,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv4013(i,k,j)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv4
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv4012(i,k,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF( (config_flags%open_ye .or. specified) .and. jte == jde ) THEN

!   END IF

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

!   END IF

   ELSE IF(advective_order <= 6) THEN

! Added by Ning Pan, 2010-07-20
!  x (u) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+3)
   IF (config_flags%open_xe .or. specified ) itf     = min(itf,ide-4)

   IF( (config_flags%open_xe .or. specified) .and. its <= ide-2 .and. ide-2 <= ite ) THEN

   i = ide-2  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2063(j)*a_Tmpv10
   a_Tmpv9 =Tmpv2062(j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv2061(j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2060(j)*a_Tmpv5
   a_Tmpv4 =Tmpv2059(j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2058(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO j =jtf, j_start, -1
   DO k =kte-1, 2, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3091(k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv3090(k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv3089(k,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv6
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3088(k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv3087(k,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3086(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_xs .or. specified) .and. its <= ids+1 .and. ids+1 <= ite ) THEN

   i = ids + 1  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2057(j)*a_Tmpv10
   a_Tmpv9 =Tmpv2056(j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv2055(j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv6
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2054(j)*a_Tmpv5
   a_Tmpv4 =Tmpv2053(j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2052(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO j =jtf, j_start, -1
   DO k =kte-1, 2, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdx/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3085(k,j)*a_Tmpv10
   a_Tmpv9 =Tmpv3084(k,j)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =msfux(i,j)*a_Tmpv8
   a_muu(i,j) =a_muu(i,j) +Tmpv3083(k,j)*a_Tmpv7
   a_Tmpv6 =muu(i,j)*a_Tmpv7
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv6
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3082(k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv3081(k,j)*a_Tmpv5
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3080(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_xe) .and. its <= ide-3 .and. ide-3 <= ite ) THEN

   i = ide-3  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv2051(j)*a_Tmpv15
   a_Tmpv14 =Tmpv2050(j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv2049(j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv4
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2048(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   DO k =kte-1, 2, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3079(k,j)*a_Tmpv15
   a_Tmpv14 =Tmpv3078(k,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv3077(k,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv4
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3076(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_xs) .and. its <= ids+2 .and. ids+2 <= ite ) THEN

   i = ids + 2  ! Added by Ning Pan, 2010-07-20
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv2047(j)*a_Tmpv15
   a_Tmpv14 =Tmpv2046(j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv2045(j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv4
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv2044(j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   DO k =kte-1, 2, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdx/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3075(k,j)*a_Tmpv15
   a_Tmpv14 =Tmpv3074(k,j)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv3073(k,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv4
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3072(k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   END IF
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv21 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv21
   a_Tmpv20 =-a_Tmpv21
   a_Tmpv19 =(0.5*rdx/msfty(i,j))*a_Tmpv20
   a_Tmpv8 =Tmpv3071(i,j)*a_Tmpv19
   a_Tmpv18 =Tmpv3070(i,j)*a_Tmpv19
   a_Tmpv17 =a_Tmpv18
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =a_Tmpv16
   a_Tmpv13 =a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_ph(i+3,k,j) =a_ph(i+3,k,j) +a_Tmpv14
   a_ph(i-3,k,j) =a_ph(i-3,k,j) -a_Tmpv14
   a_Tmpv10 =a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =9.*a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =45.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./60.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv3069(i,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k-1,j) =a_u(i,k-1,j) +cfn*a_Tmpv4
   a_u(i,k-2,j) =a_u(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv3068(i,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +cfn*a_Tmpv1
   a_u(i+1,k-2,j) =a_u(i+1,k-2,j) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv21 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv21
   a_Tmpv20 =-a_Tmpv21
   a_Tmpv19 =(0.25*rdx/msfty(i,j))*a_Tmpv20
   a_Tmpv8 =Tmpv4027(i,k,j)*a_Tmpv19
   a_Tmpv18 =Tmpv4026(i,k,j)*a_Tmpv19
   a_Tmpv17 =a_Tmpv18
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =a_Tmpv16
   a_Tmpv13 =a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_ph(i+3,k,j) =a_ph(i+3,k,j) +a_Tmpv14
   a_ph(i-3,k,j) =a_ph(i-3,k,j) -a_Tmpv14
   a_Tmpv10 =a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =9.*a_Tmpv12
   a_ph(i+2,k,j) =a_ph(i+2,k,j) +a_Tmpv11
   a_ph(i-2,k,j) =a_ph(i-2,k,j) -a_Tmpv11
   a_Tmpv9 =45.*a_Tmpv10
   a_ph(i+1,k,j) =a_ph(i+1,k,j) +a_Tmpv9
   a_ph(i-1,k,j) =a_ph(i-1,k,j) -a_Tmpv9
   a_Tmpv7 =(1./60.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfux(i,j)*a_Tmpv6
   a_muu(i,j) =a_muu(i,j) +Tmpv4025(i,k,j)*a_Tmpv5
   a_Tmpv4 =muu(i,j)*a_Tmpv5
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv4
   a_u(i,k-1,j) =a_u(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfux(i+1,j)*a_Tmpv3
   a_muu(i+1,j) =a_muu(i+1,j) +Tmpv4024(i,k,j)*a_Tmpv2
   a_Tmpv1 =muu(i+1,j)*a_Tmpv2
   a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
   a_u(i+1,k-1,j) =a_u(i+1,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF(config_flags%open_xe .or. specified ) THEN

!   END IF

!   IF(config_flags%open_xs .or. specified ) THEN

!   END IF

! Added by Ning Pan, 2010-07-20
!  y (v) advection
   i_start = its
   j_start = jts
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+3)
   IF (config_flags%open_ye .or. specified ) jtf     = min(jtf,jde-4)

   IF( (config_flags%open_ye .or. specified) .and. jts <= jde-2 .and. jde-2 <= jte ) THEN

   j = jde-2  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2043(i)*a_Tmpv10
   a_Tmpv9 =Tmpv2042(i)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv2041(i)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2040(i)*a_Tmpv5
   a_Tmpv4 =Tmpv2039(i)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv2038(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3067(i,k)*a_Tmpv10
   a_Tmpv9 =Tmpv3066(i,k)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv3065(i,k)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv6
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3064(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv3063(i,k)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3062(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+1 .and. jds+1 <= jte ) THEN

   j = jds+1  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.5*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv2037(i)*a_Tmpv10
   a_Tmpv9 =Tmpv2036(i)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv2035(i)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv6
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv6
   a_Tmpv3 =Tmpv2034(i)*a_Tmpv5
   a_Tmpv4 =Tmpv2033(i)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv2032(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv13 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(0.25*rdy/msfty(i,j))*a_Tmpv12
   a_Tmpv5 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv8 =Tmpv3061(i,k)*a_Tmpv10
   a_Tmpv9 =Tmpv3060(i,k)*a_Tmpv10
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =msfvy(i,j)*a_Tmpv8
   a_muv(i,j) =a_muv(i,j) +Tmpv3059(i,k)*a_Tmpv7
   a_Tmpv6 =muv(i,j)*a_Tmpv7
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv6
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv6
   a_Tmpv3 =Tmpv3058(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv3057(i,k)*a_Tmpv5
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) -a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3056(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_ye .or. specified) .and. jts <= jde-3 .and. jde-3 <= jte ) THEN

   j = jde-3  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv2031(i)*a_Tmpv15
   a_Tmpv14 =Tmpv2030(i)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv2029(i)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv4
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv2028(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3055(i,k)*a_Tmpv15
   a_Tmpv14 =Tmpv3054(i,k)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv3053(i,k)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv4
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3052(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO

   END IF

   IF( (config_flags%open_ys .or. specified) .and. jts <= jds+2 .and. jds+2 <= jte ) THEN

   j = jds+2  ! Added by Ning Pan, 2010-07-20
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.5*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv2027(i)*a_Tmpv15
   a_Tmpv14 =Tmpv2026(i)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv2025(i)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv4
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv2024(i)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO

   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv17 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
   a_Tmpv16 =-a_Tmpv17
   a_Tmpv15 =(0.25*rdy/msfty(i,j))*a_Tmpv16
   a_Tmpv8 =Tmpv3051(i,k)*a_Tmpv15
   a_Tmpv14 =Tmpv3050(i,k)*a_Tmpv15
   a_Tmpv13 =a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv10 =a_Tmpv12
   a_Tmpv11 =-a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =8.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./12.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv3049(i,k)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv4
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3048(i,k)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO
!   DO i =itf, i_start, -1
!   a_Tmpv17 =a_ph_tend(i,k,j)
!   a_ph_tend(i,k,j) =0.0
!   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv17
!   a_Tmpv16 =-a_Tmpv17
!   a_Tmpv15 =(0.5*rdy/msfty(i,j))*a_Tmpv16
!   a_Tmpv8 =Tmpv2027(i)*a_Tmpv15
!   a_Tmpv14 =Tmpv2026(i)*a_Tmpv15
!   a_Tmpv13 =a_Tmpv14
!   a_Tmpv12 =a_Tmpv13
!   a_Tmpv10 =a_Tmpv12
!   a_Tmpv11 =-a_Tmpv12
!   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
!   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
!   a_Tmpv9 =8.*a_Tmpv10
!   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
!   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
!   a_Tmpv7 =(1./12.)*a_Tmpv8
!   a_Tmpv3 =a_Tmpv7
!   a_Tmpv6 =a_Tmpv7
!   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
!   a_muv(i,j) =a_muv(i,j) +Tmpv2025(i)*a_Tmpv5
!   a_Tmpv4 =muv(i,j)*a_Tmpv5
!   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv4
!   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv4
!   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
!   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv2024(i)*a_Tmpv2
!   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
!   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
!   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
!   ENDDO

   END IF
   DO j =jtf, j_start, -1
   k = kte  ! Added by Ning Pan, 2010-07-20
   DO i =itf, i_start, -1
   a_Tmpv21 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv21
   a_Tmpv20 =-a_Tmpv21
   a_Tmpv19 =(0.5*rdy/msfty(i,j))*a_Tmpv20
   a_Tmpv8 =Tmpv3047(i,j)*a_Tmpv19
   a_Tmpv18 =Tmpv3046(i,j)*a_Tmpv19
   a_Tmpv17 =a_Tmpv18
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =a_Tmpv16
   a_Tmpv13 =a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_ph(i,k,j+3) =a_ph(i,k,j+3) +a_Tmpv14
   a_ph(i,k,j-3) =a_ph(i,k,j-3) -a_Tmpv14
   a_Tmpv10 =a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =9.*a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =45.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./60.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv3045(i,j)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k-1,j) =a_v(i,k-1,j) +cfn*a_Tmpv4
   a_v(i,k-2,j) =a_v(i,k-2,j) +cfn1*a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv3044(i,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +cfn*a_Tmpv1
   a_v(i,k-2,j+1) =a_v(i,k-2,j+1) +cfn1*a_Tmpv1
   ENDDO
   DO k =kte-1, 2, -1
   DO i =itf, i_start, -1
   a_Tmpv21 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv21
   a_Tmpv20 =-a_Tmpv21
   a_Tmpv19 =(0.25*rdy/msfty(i,j))*a_Tmpv20
   a_Tmpv8 =Tmpv4023(i,k,j)*a_Tmpv19
   a_Tmpv18 =Tmpv4022(i,k,j)*a_Tmpv19
   a_Tmpv17 =a_Tmpv18
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =a_Tmpv16
   a_Tmpv13 =a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_ph(i,k,j+3) =a_ph(i,k,j+3) +a_Tmpv14
   a_ph(i,k,j-3) =a_ph(i,k,j-3) -a_Tmpv14
   a_Tmpv10 =a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =9.*a_Tmpv12
   a_ph(i,k,j+2) =a_ph(i,k,j+2) +a_Tmpv11
   a_ph(i,k,j-2) =a_ph(i,k,j-2) -a_Tmpv11
   a_Tmpv9 =45.*a_Tmpv10
   a_ph(i,k,j+1) =a_ph(i,k,j+1) +a_Tmpv9
   a_ph(i,k,j-1) =a_ph(i,k,j-1) -a_Tmpv9
   a_Tmpv7 =(1./60.)*a_Tmpv8
   a_Tmpv3 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =msfvy(i,j)*a_Tmpv6
   a_muv(i,j) =a_muv(i,j) +Tmpv4021(i,k,j)*a_Tmpv5
   a_Tmpv4 =muv(i,j)*a_Tmpv5
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv4
   a_v(i,k-1,j) =a_v(i,k-1,j) +a_Tmpv4
   a_Tmpv2 =msfvy(i,j+1)*a_Tmpv3
   a_muv(i,j+1) =a_muv(i,j+1) +Tmpv4020(i,k,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j+1)*a_Tmpv2
   a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
   a_v(i,k-1,j+1) =a_v(i,k-1,j+1) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

! Remarked by Ning Pan, 2010-07-20
!   IF(config_flags%open_ye .or. specified ) THEN

!   END IF

!   IF(config_flags%open_ys .or. specified ) THEN

!   END IF

   END IF

!LPB[6]

!LPB[5]
!   IF(non_hydrostatic) THEN
!   DO j =jts, jtf
!   DO i =its, itf
!   ph_tend(i,kde,j) =0.

!   ENDDO

!   DO k =2, kte
!   DO i =its, itf
!   Tmpv001 =mut(i,j)*g*w(i,k,j)
!   Tmpv002 =Tmpv001/msfty(i,j)
!   Tmpv003 =ph_tend(i,k,j) +Tmpv002
!!  ph_tend(i,k,j) =Tmpv003

!   ENDDO
!   ENDDO
!   ENDDO
!   END IF

! Added by Ning Pan, 2010-07-20
   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
 
   IF(non_hydrostatic) THEN

   DO j =jtf, jts, -1
   DO k =kte, 2, -1
   DO i =itf, its, -1
   a_Tmpv3 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv3
   a_Tmpv2 =a_Tmpv3
   a_Tmpv1 =a_Tmpv2/msfty(i,j)
   a_mut(i,j) =a_mut(i,j) +g*w(i,k,j)*a_Tmpv1
   a_w(i,k,j) =a_w(i,k,j) +mut(i,j)*g*a_Tmpv1
   ENDDO
   ENDDO
   DO i =itf, its, -1
   a_ph_tend(i,kde,j) =0.0
   ENDDO
   ENDDO

   END IF

!LPB[4]

!LPB[3]
   DO j =jtf, jts, -1

   DO k =2, kte
   DO i =its, itf
   Tmpv001 =ww(i,k,j) +ww(i,k-1,j)
   Tmpv002 =.5*Tmpv001
   Tmpv003 =Tmpv002*rdnw(k-1)
   Tmpv004 =ph(i,k,j) -ph(i,k-1,j)
   Tmpv005 =Tmpv004 +phb(i,k,j)
   Tmpv006 =Tmpv005 -phb(i,k-1,j)
   Tmpv300(i,k) =Tmpv003
   Tmpv301(i,k) =Tmpv006
   Tmpv007 =Tmpv300(i,k)*Tmpv301(i,k)
!  wdwn(i,k) =Tmpv007

   ENDDO
   ENDDO
! Remarked by Ning Pan, 2010-07-20
!   DO k =2, kte-1
!   DO i =its, itf
!   Tmpv001 =fnm(k)*wdwn(i,k+1) +fnp(k)*wdwn(i,k)
!   Tmpv002 =ph_tend(i,k,j) -Tmpv001
!!  ph_tend(i,k,j) =Tmpv002

!   ENDDO
!   ENDDO

   DO k =kte-1, 2, -1
   DO i =itf, its, -1
   a_Tmpv2 =a_ph_tend(i,k,j)
   a_ph_tend(i,k,j) =0.0
   a_ph_tend(i,k,j) =a_ph_tend(i,k,j) +a_Tmpv2
   a_Tmpv1 =-a_Tmpv2
   a_wdwn(i,k+1) =a_wdwn(i,k+1) +fnm(k)*a_Tmpv1
   a_wdwn(i,k) =a_wdwn(i,k) +fnp(k)*a_Tmpv1
   ENDDO
   ENDDO

   DO k =kte, 2, -1
   DO i =itf, its, -1
   a_Tmpv7 =a_wdwn(i,k)
   a_wdwn(i,k) =0.0
   a_Tmpv3 =Tmpv301(i,k)*a_Tmpv7
   a_Tmpv6 =Tmpv300(i,k)*a_Tmpv7
   a_Tmpv5 =a_Tmpv6
   a_Tmpv4 =a_Tmpv5
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv4
   a_ph(i,k-1,j) =a_ph(i,k-1,j) -a_Tmpv4
   a_Tmpv2 =rdnw(k-1)*a_Tmpv3
   a_Tmpv1 =.5*a_Tmpv2
   a_ww(i,k,j) =a_ww(i,k,j) +a_Tmpv1
   a_ww(i,k-1,j) =a_ww(i,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[2]
!  advective_order =config_flags%h_sca_adv_order
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)
!  ktf =min(kte, kde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_rhs_ph

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of horizontal_pressure_gradient in reverse (adjoint) mode:
!   gradient     of useful results: p al ru_tend cqu cqv php rv_tend
!                ph alt muu muv mu
!   with respect to varying inputs: p al ru_tend cqu cqv php rv_tend
!                ph alt muu muv mu
!   RW status of diff variables: p:incr al:incr ru_tend:in-out
!                cqu:incr cqv:incr php:incr rv_tend:in-out ph:incr
!                alt:incr muu:incr muv:incr mu:incr
SUBROUTINE A_HORIZONTAL_PRESSURE_GRADIENT(ru_tend, ru_tendb, rv_tend, &
&  rv_tendb, ph, phb, alt, altb, p, pb0, pb, al, alb, php, phpb, cqu, &
&  cqub, cqv, cqvb, muu, muub, muv, muvb, mu, mub, fnm, fnp, rdnw, cf1, &
&  cf2, cf3, cfn, cfn1, rdx, rdy, msfux, msfuy, msfvx, msfvy, msftx, msfty, &
&  config_flags, non_hydrostatic, top_lid, 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
  LOGICAL, INTENT(IN) :: non_hydrostatic, top_lid
  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) :: ph, alt, al&
&  , p, pb, php, cqu, cqv
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: phb, altb, alb, pb0, &
&  phpb, cqub, cqvb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: ru_tend, &
&  rv_tend
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ru_tendb, rv_tendb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: muu, muv, mu, msfux, &
&  msfuy, msfvx, msfvy, msftx, msfty
  REAL, DIMENSION(ims:ime, jms:jme) :: muub, muvb, mub
  REAL, DIMENSION(kms:kme), INTENT(IN) :: rdnw, fnm, fnp
  REAL, INTENT(IN) :: rdx, rdy, cf1, cf2, cf3, cfn, cfn1
  INTEGER :: i, j, k, itf, jtf, ktf, i_start, j_start
  REAL, DIMENSION(ims:ime, kms:kme) :: dpn
  REAL, DIMENSION(ims:ime, kms:kme) :: dpnb
  REAL :: dpx, dpy
  REAL :: dpxb, dpyb
  LOGICAL :: specified
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_from1
  INTEGER :: ad_to1
  INTEGER :: ad_to2
  INTEGER :: ad_from2
  INTEGER :: ad_to3
  INTEGER :: ad_to4
  INTEGER :: ad_from3
  INTEGER :: ad_to5
  INTEGER :: ad_to6
  INTEGER :: branch
  INTEGER :: ad_from4
  INTEGER :: ad_to7
  REAL :: temp3
  REAL :: temp2
  REAL :: temp1
  REAL :: temp0
  REAL :: tempb3
  REAL :: tempb2
  REAL :: tempb1
  REAL :: tempb0
  REAL :: temp2b3
  REAL :: temp2b2
  REAL :: temp2b1
  REAL :: temp2b0
  REAL :: temp10
  REAL :: temp5b3
  REAL :: temp5b2
  REAL :: temp5b1
  REAL :: temp5b0
  REAL :: tempb
  REAL :: temp2b
  REAL :: temp5b
  REAL :: temp8b3
  REAL :: temp8b2
  REAL :: temp8b1
  REAL :: temp8b0
  REAL :: temp8b
  INTRINSIC MIN
  REAL :: temp
  REAL :: temp9
  REAL :: temp8
  REAL :: temp7
  REAL :: temp6
  REAL :: temp5
  REAL :: temp4
!<DESCRIPTION>
!
!  horizontal_pressure_gradient calculates the 
!  horizontal pressure gradient terms for the large-timestep tendency 
!  in the horizontal momentum equations (u,v).
!
!</DESCRIPTION>
  specified = .false.
  IF (config_flags%specified .OR. config_flags%nested) specified = &
&      .true.
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  jtf = jte
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  i_start = its
  j_start = jts
  IF ((((config_flags%open_ys .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jts .EQ. jds) j_start = jts + 1
  IF ((((config_flags%open_ye .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jte .EQ. jde) jtf = jtf - 1
  ad_from4 = j_start
  DO j=ad_from4,jtf
    IF (non_hydrostatic) THEN
      k = 1
      ad_from = i_start
      DO i=ad_from,itf
        CALL PUSHREAL8(dpn(i, k))
        dpn(i, k) = .5*(cf1*(p(i, k, j-1)+p(i, k, j))+cf2*(p(i, k+1, j-1&
&          )+p(i, k+1, j))+cf3*(p(i, k+2, j-1)+p(i, k+2, j)))
        CALL PUSHREAL8(dpn(i, kde))
        dpn(i, kde) = 0.
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from)
      IF (top_lid) THEN
        ad_from0 = i_start
        DO i=ad_from0,itf
          CALL PUSHREAL8(dpn(i, kde))
!commented out for bug fix, Jan 2016
!          dpn(i, kde) = .5*(cf1*(p(i, kde-1, j-1)+p(i, kde-1, j))+cf2*(p&
!&            (i, kde-2, j-1)+p(i, kde-2, j))+cf3*(p(i, kde-3, j-1)+p(i, &
!&            kde-3, j)))
           dpn(i,kde) = .5*( cfn *(p(i,kde-1,j-1)+p(i,kde-1,j))   &
                            +cfn1*(p(i,kde-2,j-1)+p(i,kde-2,j)) )
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from0)
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
      DO k=2,ktf
        ad_from1 = i_start
        DO i=ad_from1,itf
          CALL PUSHREAL8(dpn(i, k))
          dpn(i, k) = .5*(fnm(k)*(p(i, k, j-1)+p(i, k, j))+fnp(k)*(p(i, &
&            k-1, j-1)+p(i, k-1, j)))
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from1)
      END DO
      CALL PUSHINTEGER4(k - 1)
!       ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy
!       [alt, al are 1/rho terms; muv, mu are NOT coupled]
      DO k=1,ktf
        ad_from2 = i_start
        DO i=ad_from2,itf
          CALL PUSHREAL8(dpy)
! Here are mu dp/dy terms 1-3 
          dpy = msfvy(i, j)/msfvx(i, j)*.5*rdy*muv(i, j)*(ph(i, k+1, j)-&
&            ph(i, k+1, j-1)+ph(i, k, j)-ph(i, k, j-1)+(alt(i, k, j)+alt(&
&            i, k, j-1))*(p(i, k, j)-p(i, k, j-1))+(al(i, k, j)+al(i, k, &
&            j-1))*(pb(i, k, j)-pb(i, k, j-1)))
! Here is mu dp/dy term 4 
          dpy = dpy + msfvy(i, j)/msfvx(i, j)*rdy*(php(i, k, j)-php(i, k&
&            , j-1))*(rdnw(k)*(dpn(i, k+1)-dpn(i, k))-.5*(mu(i, j-1)+mu(i&
&            , j)))
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from2)
      END DO
      CALL PUSHINTEGER4(k - 1)
      CALL PUSHCONTROL1B(1)
    ELSE
!       ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy
!       [alt, al are 1/rho terms; muv, mu are NOT coupled]
      DO k=1,ktf
        ad_from3 = i_start
        DO i=ad_from3,itf
          CALL PUSHREAL8(dpy)
! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic
          dpy = msfvy(i, j)/msfvx(i, j)*.5*rdy*muv(i, j)*(ph(i, k+1, j)-&
&            ph(i, k+1, j-1)+ph(i, k, j)-ph(i, k, j-1)+(alt(i, k, j)+alt(&
&            i, k, j-1))*(p(i, k, j)-p(i, k, j-1))+(al(i, k, j)+al(i, k, &
&            j-1))*(pb(i, k, j)-pb(i, k, j-1)))
        END DO
        CALL PUSHINTEGER4(i - 1)
        CALL PUSHINTEGER4(ad_from3)
      END DO
      CALL PUSHINTEGER4(k - 1)
      CALL PUSHCONTROL1B(0)
    END IF
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from4)
!  now the east-west (x) pressure gradient
  itf = ite
  IF (jte .GT. jde - 1) THEN
    jtf = jde - 1
  ELSE
    jtf = jte
  END IF
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  i_start = its
  j_start = jts
  IF (((config_flags%open_xs .OR. specified) .OR. config_flags%nested) &
&      .AND. its .EQ. ids) i_start = its + 1
  IF (((config_flags%open_xe .OR. specified) .OR. config_flags%nested) &
&      .AND. ite .EQ. ide) itf = itf - 1
  IF (config_flags%periodic_x) i_start = its
  IF (config_flags%periodic_x) itf = ite
  DO j=j_start,jtf
    IF (non_hydrostatic) THEN
      k = 1
      DO i=i_start,itf
        CALL PUSHREAL8(dpn(i, k))
        dpn(i, k) = .5*(cf1*(p(i-1, k, j)+p(i, k, j))+cf2*(p(i-1, k+1, j&
&          )+p(i, k+1, j))+cf3*(p(i-1, k+2, j)+p(i, k+2, j)))
        CALL PUSHREAL8(dpn(i, kde))
        dpn(i, kde) = 0.
      END DO
      IF (top_lid) THEN
        DO i=i_start,itf
          CALL PUSHREAL8(dpn(i, kde))
!commented out for bug fix, Jan 2016
!          dpn(i, kde) = .5*(cf1*(p(i-1, kde-1, j)+p(i, kde-1, j))+cf2*(p&
!&            (i-1, kde-2, j)+p(i, kde-2, j))+cf3*(p(i-1, kde-3, j)+p(i, &
!&            kde-3, j)))
           dpn(i,kde) = .5*( cfn *(p(i-1,kde-1,j)+p(i,kde-1,j))   &
                            +cfn1*(p(i-1,kde-2,j)+p(i,kde-2,j)) )
        END DO
        CALL PUSHCONTROL1B(1)
      ELSE
        CALL PUSHCONTROL1B(0)
      END IF
      CALL PUSHINTEGER4(k)
      DO k=2,ktf
        DO i=i_start,itf
          CALL PUSHREAL8(dpn(i, k))
          dpn(i, k) = .5*(fnm(k)*(p(i-1, k, j)+p(i, k, j))+fnp(k)*(p(i-1&
&            , k-1, j)+p(i, k-1, j)))
        END DO
      END DO
! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx
! [alt, al are 1/rho terms; muu, mu are NOT coupled]
      DO k=1,ktf
        DO i=i_start,itf
          CALL PUSHREAL8(dpx)
! Here are mu dp/dy terms 1-3
          dpx = msfux(i, j)/msfuy(i, j)*.5*rdx*muu(i, j)*(ph(i, k+1, j)-&
&            ph(i-1, k+1, j)+ph(i, k, j)-ph(i-1, k, j)+(alt(i, k, j)+alt(&
&            i-1, k, j))*(p(i, k, j)-p(i-1, k, j))+(al(i, k, j)+al(i-1, k&
&            , j))*(pb(i, k, j)-pb(i-1, k, j)))
! Here is mu dp/dy term 4
          dpx = dpx + msfux(i, j)/msfuy(i, j)*rdx*(php(i, k, j)-php(i-1&
&            , k, j))*(rdnw(k)*(dpn(i, k+1)-dpn(i, k))-.5*(mu(i-1, j)+mu(&
&            i, j)))
        END DO
      END DO
      CALL PUSHCONTROL1B(1)
    ELSE
!       ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx
!       [alt, al are 1/rho terms; muu, mu are NOT coupled]
      DO k=1,ktf
        DO i=i_start,itf
          CALL PUSHREAL8(dpx)
! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic
          dpx = msfux(i, j)/msfuy(i, j)*.5*rdx*muu(i, j)*(ph(i, k+1, j)-&
&            ph(i-1, k+1, j)+ph(i, k, j)-ph(i-1, k, j)+(alt(i, k, j)+alt(&
&            i-1, k, j))*(p(i, k, j)-p(i-1, k, j))+(al(i, k, j)+al(i-1, k&
&            , j))*(pb(i, k, j)-pb(i-1, k, j)))
        END DO
      END DO
      CALL PUSHCONTROL1B(0)
    END IF
  END DO
  dpnb = 0.0
  DO j=jtf,j_start,-1
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      DO k=ktf,1,-1
        DO i=itf,i_start,-1
          dpxb = -(ru_tendb(i, k, j))
          CALL POPREAL8(dpx)
          temp10 = pb(i, k, j) - pb(i-1, k, j)
          temp9 = p(i, k, j) - p(i-1, k, j)
          temp8 = alt(i, k, j) + alt(i-1, k, j)
          temp8b2 = msfux(i, j)*rdx*.5*dpxb
          temp8b3 = muu(i, j)*temp8b2/msfuy(i, j)
          phb(i, k+1, j) = phb(i, k+1, j) + temp8b3
          phb(i-1, k+1, j) = phb(i-1, k+1, j) - temp8b3
          phb(i, k, j) = phb(i, k, j) + temp8b3
          altb(i, k, j) = altb(i, k, j) + temp9*temp8b3
          altb(i-1, k, j) = altb(i-1, k, j) + temp9*temp8b3
          pb0(i, k, j) = pb0(i, k, j) + temp8*temp8b3
          pb0(i-1, k, j) = pb0(i-1, k, j) - temp8*temp8b3
          phb(i-1, k, j) = phb(i-1, k, j) - temp8b3
          alb(i, k, j) = alb(i, k, j) + temp10*temp8b3
          alb(i-1, k, j) = alb(i-1, k, j) + temp10*temp8b3
          muub(i, j) = muub(i, j) + (ph(i, k+1, j)-ph(i-1, k+1, j)+ph(i&
&            , k, j)+temp8*temp9-ph(i-1, k, j)+temp10*(al(i, k, j)+al(i-1&
&            , k, j)))*temp8b2/msfuy(i, j)
        END DO
      END DO
    ELSE
      DO k=ktf,1,-1
        DO i=itf,i_start,-1
          cqub(i, k, j) = cqub(i, k, j) - dpx*ru_tendb(i, k, j)
          dpxb = -(cqu(i, k, j)*ru_tendb(i, k, j))
          temp8b = msfux(i, j)*rdx*dpxb
          temp8b0 = (rdnw(k)*(dpn(i, k+1)-dpn(i, k))-.5*(mu(i-1, j)+mu(i&
&            , j)))*temp8b/msfuy(i, j)
          temp8b1 = (php(i, k, j)-php(i-1, k, j))*temp8b/msfuy(i, j)
          phpb(i, k, j) = phpb(i, k, j) + temp8b0
          phpb(i-1, k, j) = phpb(i-1, k, j) - temp8b0
          dpnb(i, k+1) = dpnb(i, k+1) + rdnw(k)*temp8b1
          dpnb(i, k) = dpnb(i, k) - rdnw(k)*temp8b1
          mub(i-1, j) = mub(i-1, j) - .5*temp8b1
          mub(i, j) = mub(i, j) - .5*temp8b1
          CALL POPREAL8(dpx)
          temp7 = pb(i, k, j) - pb(i-1, k, j)
          temp6 = p(i, k, j) - p(i-1, k, j)
          temp5 = alt(i, k, j) + alt(i-1, k, j)
          temp5b2 = msfux(i, j)*rdx*.5*dpxb
          temp5b3 = muu(i, j)*temp5b2/msfuy(i, j)
          phb(i, k+1, j) = phb(i, k+1, j) + temp5b3
          phb(i-1, k+1, j) = phb(i-1, k+1, j) - temp5b3
          phb(i, k, j) = phb(i, k, j) + temp5b3
          altb(i, k, j) = altb(i, k, j) + temp6*temp5b3
          altb(i-1, k, j) = altb(i-1, k, j) + temp6*temp5b3
          pb0(i, k, j) = pb0(i, k, j) + temp5*temp5b3
          pb0(i-1, k, j) = pb0(i-1, k, j) - temp5*temp5b3
          phb(i-1, k, j) = phb(i-1, k, j) - temp5b3
          alb(i, k, j) = alb(i, k, j) + temp7*temp5b3
          alb(i-1, k, j) = alb(i-1, k, j) + temp7*temp5b3
          muub(i, j) = muub(i, j) + (ph(i, k+1, j)-ph(i-1, k+1, j)+ph(i&
&            , k, j)+temp5*temp6-ph(i-1, k, j)+temp7*(al(i, k, j)+al(i-1&
&            , k, j)))*temp5b2/msfuy(i, j)
        END DO
      END DO
      DO k=ktf,2,-1
        DO i=itf,i_start,-1
          CALL POPREAL8(dpn(i, k))
          temp5b1 = .5*dpnb(i, k)
          pb0(i-1, k, j) = pb0(i-1, k, j) + fnm(k)*temp5b1
          pb0(i, k, j) = pb0(i, k, j) + fnm(k)*temp5b1
          pb0(i-1, k-1, j) = pb0(i-1, k-1, j) + fnp(k)*temp5b1
          pb0(i, k-1, j) = pb0(i, k-1, j) + fnp(k)*temp5b1
          dpnb(i, k) = 0.0
        END DO
      END DO
      CALL POPINTEGER4(k)
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        DO i=itf,i_start,-1
          CALL POPREAL8(dpn(i, kde))
          temp5b0 = .5*dpnb(i, kde)
          pb0(i-1, kde-1, j) = pb0(i-1, kde-1, j) + cf1*temp5b0
          pb0(i, kde-1, j) = pb0(i, kde-1, j) + cf1*temp5b0
          pb0(i-1, kde-2, j) = pb0(i-1, kde-2, j) + cf2*temp5b0
          pb0(i, kde-2, j) = pb0(i, kde-2, j) + cf2*temp5b0
          pb0(i-1, kde-3, j) = pb0(i-1, kde-3, j) + cf3*temp5b0
          pb0(i, kde-3, j) = pb0(i, kde-3, j) + cf3*temp5b0
          dpnb(i, kde) = 0.0
        END DO
      END IF
      k = 1
      DO i=itf,i_start,-1
        CALL POPREAL8(dpn(i, kde))
        dpnb(i, kde) = 0.0
        CALL POPREAL8(dpn(i, k))
        temp5b = .5*dpnb(i, k)
        pb0(i-1, k, j) = pb0(i-1, k, j) + cf1*temp5b
        pb0(i, k, j) = pb0(i, k, j) + cf1*temp5b
        pb0(i-1, k+1, j) = pb0(i-1, k+1, j) + cf2*temp5b
        pb0(i, k+1, j) = pb0(i, k+1, j) + cf2*temp5b
        pb0(i-1, k+2, j) = pb0(i-1, k+2, j) + cf3*temp5b
        pb0(i, k+2, j) = pb0(i, k+2, j) + cf3*temp5b
        dpnb(i, k) = 0.0
      END DO
    END IF
  END DO
  CALL POPINTEGER4(ad_from4)
  CALL POPINTEGER4(ad_to7)
  DO j=ad_to7,ad_from4,-1
    CALL POPCONTROL1B(branch)
    IF (branch .EQ. 0) THEN
      CALL POPINTEGER4(ad_to6)
      DO k=ad_to6,1,-1
        CALL POPINTEGER4(ad_from3)
        CALL POPINTEGER4(ad_to5)
        DO i=ad_to5,ad_from3,-1
          dpyb = -(rv_tendb(i, k, j))
          CALL POPREAL8(dpy)
          temp4 = pb(i, k, j) - pb(i, k, j-1)
          temp3 = p(i, k, j) - p(i, k, j-1)
          temp2 = alt(i, k, j) + alt(i, k, j-1)
          temp2b2 = msfvy(i, j)*rdy*.5*dpyb
          temp2b3 = muv(i, j)*temp2b2/msfvx(i, j)
          phb(i, k+1, j) = phb(i, k+1, j) + temp2b3
          phb(i, k+1, j-1) = phb(i, k+1, j-1) - temp2b3
          phb(i, k, j) = phb(i, k, j) + temp2b3
          altb(i, k, j) = altb(i, k, j) + temp3*temp2b3
          altb(i, k, j-1) = altb(i, k, j-1) + temp3*temp2b3
          pb0(i, k, j) = pb0(i, k, j) + temp2*temp2b3
          pb0(i, k, j-1) = pb0(i, k, j-1) - temp2*temp2b3
          phb(i, k, j-1) = phb(i, k, j-1) - temp2b3
          alb(i, k, j) = alb(i, k, j) + temp4*temp2b3
          alb(i, k, j-1) = alb(i, k, j-1) + temp4*temp2b3
          muvb(i, j) = muvb(i, j) + (ph(i, k+1, j)-ph(i, k+1, j-1)+ph(i&
&            , k, j)+temp2*temp3-ph(i, k, j-1)+temp4*(al(i, k, j)+al(i, k&
&            , j-1)))*temp2b2/msfvx(i, j)
        END DO
      END DO
    ELSE
      CALL POPINTEGER4(ad_to4)
      DO k=ad_to4,1,-1
        CALL POPINTEGER4(ad_from2)
        CALL POPINTEGER4(ad_to3)
        DO i=ad_to3,ad_from2,-1
          cqvb(i, k, j) = cqvb(i, k, j) - dpy*rv_tendb(i, k, j)
          dpyb = -(cqv(i, k, j)*rv_tendb(i, k, j))
          temp2b = msfvy(i, j)*rdy*dpyb
          temp2b0 = (rdnw(k)*(dpn(i, k+1)-dpn(i, k))-.5*(mu(i, j-1)+mu(i&
&            , j)))*temp2b/msfvx(i, j)
          temp2b1 = (php(i, k, j)-php(i, k, j-1))*temp2b/msfvx(i, j)
          phpb(i, k, j) = phpb(i, k, j) + temp2b0
          phpb(i, k, j-1) = phpb(i, k, j-1) - temp2b0
          dpnb(i, k+1) = dpnb(i, k+1) + rdnw(k)*temp2b1
          dpnb(i, k) = dpnb(i, k) - rdnw(k)*temp2b1
          mub(i, j-1) = mub(i, j-1) - .5*temp2b1
          mub(i, j) = mub(i, j) - .5*temp2b1
          CALL POPREAL8(dpy)
          temp1 = pb(i, k, j) - pb(i, k, j-1)
          temp0 = p(i, k, j) - p(i, k, j-1)
          temp = alt(i, k, j) + alt(i, k, j-1)
          tempb2 = msfvy(i, j)*rdy*.5*dpyb
          tempb3 = muv(i, j)*tempb2/msfvx(i, j)
          phb(i, k+1, j) = phb(i, k+1, j) + tempb3
          phb(i, k+1, j-1) = phb(i, k+1, j-1) - tempb3
          phb(i, k, j) = phb(i, k, j) + tempb3
          altb(i, k, j) = altb(i, k, j) + temp0*tempb3
          altb(i, k, j-1) = altb(i, k, j-1) + temp0*tempb3
          pb0(i, k, j) = pb0(i, k, j) + temp*tempb3
          pb0(i, k, j-1) = pb0(i, k, j-1) - temp*tempb3
          phb(i, k, j-1) = phb(i, k, j-1) - tempb3
          alb(i, k, j) = alb(i, k, j) + temp1*tempb3
          alb(i, k, j-1) = alb(i, k, j-1) + temp1*tempb3
          muvb(i, j) = muvb(i, j) + (ph(i, k+1, j)-ph(i, k+1, j-1)+ph(i&
&            , k, j)+temp*temp0-ph(i, k, j-1)+temp1*(al(i, k, j)+al(i, k&
&            , j-1)))*tempb2/msfvx(i, j)
        END DO
      END DO
      CALL POPINTEGER4(ad_to2)
      DO k=ad_to2,2,-1
        CALL POPINTEGER4(ad_from1)
        CALL POPINTEGER4(ad_to1)
        DO i=ad_to1,ad_from1,-1
          CALL POPREAL8(dpn(i, k))
          tempb1 = .5*dpnb(i, k)
          pb0(i, k, j-1) = pb0(i, k, j-1) + fnm(k)*tempb1
          pb0(i, k, j) = pb0(i, k, j) + fnm(k)*tempb1
          pb0(i, k-1, j-1) = pb0(i, k-1, j-1) + fnp(k)*tempb1
          pb0(i, k-1, j) = pb0(i, k-1, j) + fnp(k)*tempb1
          dpnb(i, k) = 0.0
        END DO
      END DO
      CALL POPINTEGER4(k)
      CALL POPCONTROL1B(branch)
      IF (branch .NE. 0) THEN
        CALL POPINTEGER4(ad_from0)
        CALL POPINTEGER4(ad_to0)
        DO i=ad_to0,ad_from0,-1
          CALL POPREAL8(dpn(i, kde))
          tempb0 = .5*dpnb(i, kde)
          pb0(i, kde-1, j-1) = pb0(i, kde-1, j-1) + cf1*tempb0
          pb0(i, kde-1, j) = pb0(i, kde-1, j) + cf1*tempb0
          pb0(i, kde-2, j-1) = pb0(i, kde-2, j-1) + cf2*tempb0
          pb0(i, kde-2, j) = pb0(i, kde-2, j) + cf2*tempb0
          pb0(i, kde-3, j-1) = pb0(i, kde-3, j-1) + cf3*tempb0
          pb0(i, kde-3, j) = pb0(i, kde-3, j) + cf3*tempb0
          dpnb(i, kde) = 0.0
        END DO
      END IF
      k = 1
      CALL POPINTEGER4(ad_from)
      CALL POPINTEGER4(ad_to)
      DO i=ad_to,ad_from,-1
        CALL POPREAL8(dpn(i, kde))
        dpnb(i, kde) = 0.0
        CALL POPREAL8(dpn(i, k))
        tempb = .5*dpnb(i, k)
        pb0(i, k, j-1) = pb0(i, k, j-1) + cf1*tempb
        pb0(i, k, j) = pb0(i, k, j) + cf1*tempb
        pb0(i, k+1, j-1) = pb0(i, k+1, j-1) + cf2*tempb
        pb0(i, k+1, j) = pb0(i, k+1, j) + cf2*tempb
        pb0(i, k+2, j-1) = pb0(i, k+2, j-1) + cf3*tempb
        pb0(i, k+2, j) = pb0(i, k+2, j) + cf3*tempb
        dpnb(i, k) = 0.0
      END DO
    END IF
  END DO
END SUBROUTINE A_HORIZONTAL_PRESSURE_GRADIENT

   SUBROUTINE a_pg_buoy_w(rw_tend,a_rw_tend,p,a_p,cqw,a_cqw,mu,a_mu,mub,rdnw, &
   rdn,g,msftx,msfty,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
   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) :: p,a_p
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: cqw,a_cqw
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rw_tend,a_rw_tend
   REAL,DIMENSION(ims:ime,jms:jme) :: mub,mu,a_mu,msftx,msfty
   REAL,DIMENSION(kms:kme) :: rdnw,rdn
   REAL :: g
   INTEGER :: itf,jtf,i,j,k
   REAL :: cq1,a_cq1,cq2,a_cq2

!  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_cqw   
   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006
   REAL,DIMENSION(its:MAX(ite,ide-1)) :: Tmpv200
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kde-1) :: Tmpv300
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kde-1) :: Tmpv301
   REAL,DIMENSION(its:MAX(ite,ide-1),2:kde-1) :: Tmpv302

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      itf=MIN(ite,ide-1)
      jtf=MIN(jte,jde-1)

!!LPB[1]
!      DO j = jts,jtf

!!      DO k=2, kde-1
!!      DO i=its, min(ite,ide-1)
!    !  Keep_Lpb1_cqw(i,k,j) =cqw(i,k,j)
!!      END DO
!!      END DO

!        k=kde

!        DO i=its,itf
!          cq1 = 1./(1.+cqw(i,k-1,j))
!          cq2 = cqw(i,k-1,j)*cq1
!          rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*(        &
!                           cq1*2.*rdnw(k-1)*(  -p(i,k-1,j))    &
!                           -mu(i,j)-cq2*mub(i,j)            )
!        END DO

!        DO k = 2, kde-1
!        DO i = its,itf
!         cq1 = 1./(1.+cqw(i,k,j))
!         cq2 = cqw(i,k,j)*cq1
!         cqw(i,k,j) = cq1
!         rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*(        &
!                          cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j))    &
!                          -mu(i,j)-cq2*mub(i,j)            )
!        END DO
!        ENDDO           

!      ENDDO

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   a_cq1 =0.0
   a_cq2 =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[1]
   DO j =jtf, jts, -1

!  DO k=2, kde-1
!  DO i=its, min(ite,ide-1)
!  cqw(i,k,j) =Keep_Lpb1_cqw(i,k,j)
!  END DO
!  END DO

   k =kde
   DO i =its, itf
! Revised by Ning Pan, 2010-07-21
!   Tmpv200(i) =cq1
!   cq1 =1./(1. +cqw(i,k-1,j))
   cq1 =1./(1. +cqw(i,k-1,j))
   Tmpv200(i) =cq1

!   Tmpv001 =cqw(i,k-1,j)*cq1  ! Remarked by Ning Pan, 2010-07-21
!  cq2 =Tmpv001

! Remarked by Ning Pan, 2010-07-21
!   Tmpv001 =cq1*2.*rdnw(k-1)*(-p(i,k-1,j))
!   Tmpv002 =Tmpv001 -mu(i,j)
!   Tmpv003 =Tmpv002 -cq2*mub(i,j)
!   Tmpv004 =(1./msfty(i,j))*g*Tmpv003
!   Tmpv005 =rw_tend(i,k,j) +Tmpv004
!!  rw_tend(i,k,j) =Tmpv005

   ENDDO

   DO k =2, kde-1
   DO i =its, itf
! Revised by Ning Pan, 2010-07-21
!   Tmpv300(i,k) =cq1
!   cq1 =1./(1. +cqw(i,k,j))
   cq1 =1./(1. +cqw(i,k,j))
   Tmpv300(i,k) =cq1

!   Tmpv001 =cqw(i,k,j)*cq1  ! Remarked by Ning Pan, 2010-07-21
!  cq2 =Tmpv001

! Remarked by Ning Pan, 2010-07-21
!   Tmpv301(i,k) =cqw(i,k,j)
!   cqw(i,k,j) =cq1

   Tmpv001 =p(i,k,j) -p(i,k-1,j)
   Tmpv302(i,k) =Tmpv001
! Remarked by Ning Pan, 2010-07-21
!   Tmpv002 =cq1*rdn(k)*Tmpv302(i,k)
!   Tmpv003 =Tmpv002 -mu(i,j)
!   Tmpv004 =Tmpv003 -cq2*mub(i,j)
!   Tmpv005 =(1./msfty(i,j))*g*Tmpv004
!   Tmpv006 =rw_tend(i,k,j) +Tmpv005
!!  rw_tend(i,k,j) =Tmpv006

   ENDDO
   ENDDO

   DO k =kde-1, 2, -1
   DO i =itf, its, -1
   cq1 =Tmpv300(i,k)  ! Added by Ning Pan, 2010-07-21

   a_Tmpv6 =a_rw_tend(i,k,j)
   a_rw_tend(i,k,j) =0.0
   a_rw_tend(i,k,j) =a_rw_tend(i,k,j) +a_Tmpv6
   a_Tmpv5 =a_Tmpv6
   a_Tmpv4 =(1./msfty(i,j))*g*a_Tmpv5
   a_Tmpv3 =a_Tmpv4
   a_cq2 =a_cq2 -mub(i,j)*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_mu(i,j) =a_mu(i,j) -a_Tmpv3
   a_cq1 =a_cq1 +rdn(k)*Tmpv302(i,k)*a_Tmpv2
   a_Tmpv1 =cq1*rdn(k)*a_Tmpv2
   a_p(i,k,j) =a_p(i,k,j) +a_Tmpv1
   a_p(i,k-1,j) =a_p(i,k-1,j) -a_Tmpv1

!   cqw(i,k,j) =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-07-21

   a_cq1 =a_cq1 +a_cqw(i,k,j)
   a_cqw(i,k,j) =0.0
   a_Tmpv1 =a_cq2
   a_cq2 =0.0
   a_cqw(i,k,j) =a_cqw(i,k,j) +cq1*a_Tmpv1
   a_cq1 =a_cq1 +cqw(i,k,j)*a_Tmpv1

!   cq1 =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-07-21

   a_cqw(i,k,j) =a_cqw(i,k,j) -1./((1. +cqw(i,k,j))*(1. +cqw(i,k,j)))*a_cq1
   a_cq1 =0.0
   ENDDO
   ENDDO

   k=kde  ! Added by Ning Pan, 2010-07-21
   DO i =itf, its, -1
   cq1 =Tmpv200(i)  ! Added by Ning Pan, 2010-07-21

   a_Tmpv5 =a_rw_tend(i,k,j)
   a_rw_tend(i,k,j) =0.0
   a_rw_tend(i,k,j) =a_rw_tend(i,k,j) +a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =(1./msfty(i,j))*g*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_cq2 =a_cq2 -mub(i,j)*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mu(i,j) =a_mu(i,j) -a_Tmpv2
   a_cq1 =a_cq1 +2.*rdnw(k-1)*(-p(i,k-1,j))*a_Tmpv1
   a_p(i,k-1,j) =a_p(i,k-1,j) -1.0*cq1*2.*rdnw(k-1)*a_Tmpv1
   a_Tmpv1 =a_cq2
   a_cq2 =0.0
   a_cqw(i,k-1,j) =a_cqw(i,k-1,j) +cq1*a_Tmpv1
   a_cq1 =a_cq1 +cqw(i,k-1,j)*a_Tmpv1

!   cq1 =Tmpv200(i)  ! Remarkded by Ning Pan, 2010-07-21

   a_cqw(i,k-1,j) =a_cqw(i,k-1,j) -1./((1. +cqw(i,k-1,j))*(1. +cqw(i,k-1,j)))*a_cq1
   a_cq1 =0.0
   ENDDO

   ENDDO

!LPB[0]
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)

   END SUBROUTINE a_pg_buoy_w

! Revised by Ning Pan, 2010-07-21
!   SUBROUTINE a_w_damp(rw_tend,a_rw_tend,max_vert_cfl,a_max_vert_cfl, &
!   max_horiz_cfl,a_max_horiz_cfl,u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw, &
   SUBROUTINE a_w_damp(rw_tend,a_rw_tend,max_vert_cfl, &
   max_horiz_cfl,u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw, &
   rdx,rdy,msfux,msfuy,msfvx,msfvy,dt,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
   jme,kms,kme,its,ite,jts,jte,kts,kte)

!PART I: DECLARATION OF VARIABLES

   USE module_llxy

   IMPLICIT NONE

   INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
   TYPE(grid_config_rec_type) :: config_flags
   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) :: u,a_u,v,a_v,ww,a_ww,w,a_w
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rw_tend,a_rw_tend
! Revised by Ning Pan, 2010-07-21
!   REAL :: max_vert_cfl,a_max_vert_cfl
!   REAL :: max_horiz_cfl,a_max_horiz_cfl
   REAL :: max_vert_cfl
   REAL :: max_horiz_cfl
   REAL :: horiz_cfl,a_horiz_cfl
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut
   REAL,DIMENSION(kms:kme) :: rdnw
   REAL :: dt
   REAL :: rdx,rdy
   REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy
   REAL,DIMENSION(ims:ime,jms:jme) :: msfvx,msfvy
! Revised by Ning Pan, 2010-07-21
!   REAL :: vert_cfl,a_vert_cfl,cf_n,a_cf_n,cf_d,a_cf_d,maxdub,a_maxdub,maxdeta, &
!   a_maxdeta
   REAL :: vert_cfl,a_vert_cfl,cf_n,a_cf_n,cf_d,a_cf_d,maxdub,maxdeta
   INTEGER :: itf,jtf,i,j,k,maxi,maxj,maxk
   INTEGER :: some
   CHARACTER*512 :: temp
   CHARACTER (LEN=256) :: time_str
   CHARACTER (LEN=256) :: grid_str
   integer :: total
! Revised by Ning Pan, 2010-07-21
!   REAL :: msfuxt,a_msfuxt,msfxffl,a_msfxffl
   REAL :: msfuxt,msfxffl

! Revised by Ning Pan, 2010-07-21
!   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
   REAL :: a_Tmpv1,Tmpv1
! Remarked by Ning Pan, 2010-07-21
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv400
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv401
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv402
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv403
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv404
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv405
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv406
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv407
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv408
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv409
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv4010
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv4011
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv4012
!   REAL,DIMENSION(its:min(ite,ide-1),2:kde-1,jts:min(jte,jde-1)) :: Tmpv4013

!DELETED BY WALLS
!#if 1
!#else
!#endif
!This line is fail to be recognized
!              CALL wrf_debug ( 100 , TRIM(temp) )  ! Remarked by Ning Pan, 2010-07-21
!#if 1
!#else
!#endif
!This line is fail to be recognized
!              CALL wrf_debug ( 100 , TRIM(temp) )  ! Remarked by Ning Pan, 2010-07-21
!This line is fail to be recognized
!        CALL get_current_time_string( time_str )  ! Remarked by Ning Pan, 2010-07-21
!This line is fail to be recognized
!        CALL get_current_grid_name( grid_str )  ! Remarked by Ning Pan, 2010-07-21
!This line is fail to be recognized
!        CALL wrf_debug ( 0 , TRIM(wrf_err_message) )  ! Remarked by Ning Pan, 2010-07-21
!This line is fail to be recognized
!        CALL wrf_debug ( 0 , TRIM(wrf_err_message) )  ! Remarked by Ning Pan, 2010-07-21

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      itf=MIN(ite,ide-1)
      jtf=MIN(jte,jde-1)
      some = 0
      max_vert_cfl = 0.
      max_horiz_cfl = 0.
      total = 0

!LPB[1]
   IF(config_flags%polar) then

        msfxffl = 1.0/COS(config_flags%fft_filter_lat*degrad) 

   END IF

!LPB[2]

!!LPB[3]
!   
!   IF ( config_flags%w_damping == 1 ) THEN

!        DO j = jts,jtf
!        DO k = 2, kde-1
!        DO i = its,itf
!        IF(config_flags%polar) then

!              msfuxt = MIN(msfux(i,j), msfxffl)
!           ELSE
!              msfuxt = msfux(i,j)
!           END IF
!           vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
!        IF ( vert_cfl > max_vert_cfl ) THEN

!              max_vert_cfl = vert_cfl 
!    maxi = i 
!    maxj = j 
!    maxk = k 
!              maxdub = w(i,k,j) 
!    maxdeta = -1./rdnw(k)
!           ENDIF
!           horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt),                           &
!     &
!                abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
!        if (horiz_cfl > max_horiz_cfl) then

!              max_horiz_cfl = horiz_cfl
!           endif
!        if(vert_cfl .gt. w_beta)then

!           cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
!           cf_d = abs(mut(i,j))
!        if(cf_n .gt. cf_d*w_beta )then

!              WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
!           if ( vert_cfl > 2. ) some = some + 1

!              rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(vert_cfl- &
!   w_beta)*mut(i,j)
!           endif
!        END DO
!        ENDDO
!        ENDDO
!      ELSE

!        DO j = jts,jtf
!        DO k = 2, kde-1
!        DO i = its,itf
!        IF(config_flags%polar) then

!              msfuxt = MIN(msfux(i,j), msfxffl)
!           ELSE
!              msfuxt = msfux(i,j)
!           END IF
!           vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
!        IF ( vert_cfl > max_vert_cfl ) THEN

!              max_vert_cfl = vert_cfl 
!    maxi = i 
!    maxj = j 
!    maxk = k 
!              maxdub = w(i,k,j) 
!    maxdeta = -1./rdnw(k)
!           ENDIF
!           horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt),                           &
!     &
!                abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
!        if (horiz_cfl > max_horiz_cfl) then

!              max_horiz_cfl = horiz_cfl
!           endif
!        if(vert_cfl .gt. w_beta)then

!           cf_n = abs(ww(i,k,j)*rdnw(k)*dt)
!           cf_d = abs(mut(i,j))
!        if(cf_n .gt. cf_d*w_beta )then

!              WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
!           if ( vert_cfl > 2. ) some = some + 1

!           endif
!        END DO
!        ENDDO
!        ENDDO
!      ENDIF
!   IF ( some .GT. 0 ) THEN

!        WRITE(wrf_err_message,*)some,                                              &
!               ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM( &
!   time_str)//' hours'
!        WRITE(wrf_err_message,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' vert_cfl,w,d(eta) &
!   =',max_vert_cfl,   &
!                                maxdub,maxdeta
!      ENDIF

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

!REVISED BY WALLS
!  a_PROJ_GAUSS =0.0
!  a_PROJ_CYL =0.0
!  a_PROJ_CASSINI =0.0
!  a_PROJ_ROTLL =0.0
   a_horiz_cfl =0.0
   a_vert_cfl =0.0
   a_cf_n =0.0
   a_cf_d =0.0
   a_Tmpv1 = 0.0  ! Added by Ning Pan, 2010-07-21
! Remarked by Ning Pan, 2010-07-21
!   a_maxdub =0.0
!   a_maxdeta =0.0
!   a_msfuxt =0.0
!   a_msfxffl =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]
! Reconstructed by Ning Pan, 2010-07-21
   IF( config_flags%w_damping == 1 ) THEN
     DO j =jts, jtf
     DO k =2, kde-1
     DO i =its, itf

       IF(config_flags%polar) THEN
         msfuxt =min(msfux(i,j), msfxffl)
       ELSE
         msfuxt =msfux(i,j)
       END IF

       vert_cfl =abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
       IF( vert_cfl > max_vert_cfl ) THEN
         max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k 
         maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
       ENDIF

       horiz_cfl =max( abs(u(i,k,j) * rdx * msfuxt * dt), &
                       abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
       IF(horiz_cfl > max_horiz_cfl) THEN
         max_horiz_cfl =horiz_cfl
       ENDIF

       IF(vert_cfl .gt. w_beta) THEN
         WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
         CALL wrf_debug ( 100 , TRIM(temp) )
         IF( vert_cfl > 2. ) some =some+1

         a_Tmpv1 = -a_rw_tend(i,k,j)
         a_vert_cfl = a_vert_cfl + sign(1., w(i,k,j)) *w_alpha*(a_Tmpv1)*mut(i,j)
         a_mut(i,j) = a_mut(i,j) + sign(1., w(i,k,j)) *w_alpha*(vert_cfl -w_beta)*a_Tmpv1
         a_Tmpv1 = 0.0 
       ENDIF

!       a_v(i,k,j) =a_v(i,k,j) - sign(1.0,v(i,k,j)*rdy*msfvy(i,j)*dt)*a_horiz_cfl*rdy*msfvy(i,j)*dt &
!                                    *sign(1.0, abs(Tmpv1*dt)-(abs(v(i,k,j)*rdy*msfvy(i,j)*dt)))*0.5
!       a_Tmpv1 =a_Tmpv1 + sign(1.0, Tmpv1*dt)*a_horiz_cfl*dt &
!                              *sign(1.0, abs(Tmpv1*dt)-(abs(v(i,k,j)*rdy*msfvy(i,j)*dt)))*0.5
!       a_v(i,k,j) =a_v(i,k,j) + sign(1.0, v(i,k,j)*rdy*msfvy(i,j)*dt)*a_horiz_cfl*rdy*msfvy(i,j)*dt*0.5
!       a_Tmpv1 =a_Tmpv1 + sign(1.0, Tmpv1*dt)*a_horiz_cfl*dt*0.5
!       a_horiz_cfl =0.0
!       a_u(i,k,j) =a_u(i,k,j) + a_Tmpv1*rdx*msfuxt
!       a_Tmpv1 =0.0

       Tmpv1 =ww(i,k,j)/mut(i,j)
       a_Tmpv1 = a_Tmpv1 + sign(1.0, Tmpv1*rdnw(k)*dt)*a_vert_cfl*rdnw(k)*dt
       a_vert_cfl = 0.0
       a_mut(i,j) = a_mut(i,j) - a_Tmpv1*ww(i,k,j)/(mut(i,j)*mut(i,j))
       a_ww(i,k,j) = a_ww(i,k,j) + a_Tmpv1/mut(i,j)
       a_Tmpv1 = 0.0
     ENDDO
     ENDDO
     ENDDO
   ELSE
     DO j =jts, jtf
     DO k =2, kde-1
     DO i =its, itf
       IF(config_flags%polar) THEN
         msfuxt =min(msfux(i,j), msfxffl)
       ELSE
         msfuxt =msfux(i,j)
       END IF

       vert_cfl =abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt)
       IF( vert_cfl > max_vert_cfl ) THEN
         max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k 
         maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k)
       ENDIF

       horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt), &
                        abs(v(i,k,j) * rdy * msfvy(i,j) * dt) )
       IF(horiz_cfl > max_horiz_cfl) THEN
         max_horiz_cfl =horiz_cfl
       ENDIF

       IF(vert_cfl .gt. w_beta) THEN
         WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k)
         CALL wrf_debug ( 100 , TRIM(temp) )
         IF( vert_cfl > 2. ) some =some+1
       ENDIF
     ENDDO
     ENDDO
     ENDDO
   ENDIF

   IF ( some .GT. 0 ) THEN
     CALL get_current_time_string( time_str )
     CALL get_current_grid_name( grid_str )
     WRITE(temp,*)some,                                            &
            ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM(time_str)//' hours'
     CALL wrf_debug ( 0 , TRIM(temp) )
     WRITE(temp,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' vert_cfl,w,d(eta)=',max_vert_cfl, &
                             maxdub,maxdeta
     CALL wrf_debug ( 0 , TRIM(temp) )
   ENDIF

!DELETED BY WALLS
!   IF( config_flags%w_damping == 1 ) THEN
!   DO j =jts, jtf
!   DO k =2, kde-1
!   DO i =its, itf
!   IF(config_flags%polar) THEN
!   Tmpv400(i,k,j) =msfuxt
!   msfuxt =min(msfux(i,j), msfxffl)
!
!   ELSE
!   Tmpv401(i,k,j) =msfuxt
!   msfuxt =msfux(i,j)
!
!   END IF
!   Tmpv001 =ww(i,k,j)/mut(i,j)
!   Tmpv002 =Tmpv001*rdnw(k)
!   Tmpv003 =Tmpv002*dt
!   Tmpv402(i,k,j) =Tmpv003
!   Tmpv004 =abs(Tmpv402(i,k,j))
!   Tmpv403(i,k,j) =vert_cfl
!   vert_cfl =Tmpv004
!
!   IF( vert_cfl > max_vert_cfl ) THEN
!!  max_vert_cfl =vert_cfl
!
!   maxi =i
!   maxj =j
!   maxk =k
!!  maxdub =w(i,k,j)
!
!   maxdeta =-1./rdnw(k)
!
!   ENDIF
!   Tmpv001 =u(i,k,j)*rdx*msfuxt
!   Tmpv002 =Tmpv001*dt
!   Tmpv404(i,k,j) =Tmpv002
!   Tmpv003 =abs(Tmpv404(i,k,j))
!   Tmpv405(i,k,j) =Tmpv003
!   Tmpv406(i,k,j) =Tmpv405(i,k,j)
!   Tmpv004 =max(Tmpv406(i,k,j), abs(v(i,k,j)*rdy*msfvy(i,j)*dt))
!!  horiz_cfl =Tmpv004
!
!   IF(horiz_cfl > max_horiz_cfl) THEN
!!  max_horiz_cfl =horiz_cfl
!
!DELETED BY WALLS
!   endif
!   IF(vert_cfl .gt. w_beta) THEN
!!  cf_n =abs(ww(i,k,j)*rdnw(k)*dt)

!!  cf_d =abs(mut(i,j))

!   IF(cf_n .gt. cf_d*w_beta ) THEN
!   IF( vert_cfl > 2. ) THEN
!   some =some+1
!   END IF
!   Tmpv001 =sign(1., w(i,k,j))*w_alpha*(vert_cfl -w_beta)*mut(i,j)
!   Tmpv002 =rw_tend(i,k,j) -Tmpv001
!!  rw_tend(i,k,j) =Tmpv002

!   endif
!   ENDDO
!   ENDDO
!   ENDDO
!   ELSE
!   DO j =jts, jtf
!   DO k =2, kde-1
!   DO i =its, itf
!   IF(config_flags%polar) THEN
!   Tmpv407(i,k,j) =msfuxt
!   msfuxt =min(msfux(i,j), msfxffl)

!   ELSE
!   Tmpv408(i,k,j) =msfuxt
!   msfuxt =msfux(i,j)

!   END IF
!   Tmpv001 =ww(i,k,j)/mut(i,j)
!   Tmpv002 =Tmpv001*rdnw(k)
!   Tmpv003 =Tmpv002*dt
!   Tmpv409(i,k,j) =Tmpv003
!   Tmpv004 =abs(Tmpv409(i,k,j))
!   Tmpv4010(i,k,j) =vert_cfl
!   vert_cfl =Tmpv004

!   IF( vert_cfl > max_vert_cfl ) THEN
!!  max_vert_cfl =vert_cfl

!   maxi =i
!   maxj =j
!   maxk =k
!!  maxdub =w(i,k,j)

!   maxdeta =-1./rdnw(k)

!   ENDIF
!   Tmpv001 =u(i,k,j)*rdx*msfuxt
!   Tmpv002 =Tmpv001*dt
!   Tmpv4011(i,k,j) =Tmpv002
!   Tmpv003 =abs(Tmpv4011(i,k,j))
!   Tmpv4012(i,k,j) =Tmpv003
!   Tmpv4013(i,k,j) =Tmpv4012(i,k,j)
!   Tmpv004 =max(Tmpv4013(i,k,j), abs(v(i,k,j)*rdy*msfvy(i,j)*dt))
!  horiz_cfl =Tmpv004

!   IF(horiz_cfl > max_horiz_cfl) THEN
!!  max_horiz_cfl =horiz_cfl

!   endif
!   IF(vert_cfl .gt. w_beta) THEN
!!  cf_n =abs(ww(i,k,j)*rdnw(k)*dt)

!!  cf_d =abs(mut(i,j))

!   IF(cf_n .gt. cf_d*w_beta ) THEN
!   IF( vert_cfl > 2. ) THEN
!   some =some+1
!   END IF
!   endif
!   ENDDO
!   ENDDO
!   ENDDO
!   ENDIF
!!   IF( some .GT. 0 ) THEN
!   ENDIF
!
!!WARNING: DEADLY ERRORS OCCUR IN ADJOINT ACCUMULATING PROCESS.
!WARNING: DEADLY ERRORS OCCUR IN ADJOINT ACCUMULATING PROCESS.
!
!LPB[2]

!LPB[1]

!  IF(config_flags%polar) THEN
!  msfxffl =1.0/cos(config_flags%fft_filter_lat*degrad)

!  END IF

!   IF(config_flags%polar) THEN  ! Remarked by Ning Pan, 2010-07-21

!STOP  ! Remarked by Ning Pan, 2010-07-21
!DELETED BY WALLS
!  a_config_flags%fft_filter_lat =a_config_flags%fft_filter_lat +1.0*degrad*sin(  &
!  config_flags%fft_filter_lat*degrad)/(cos(config_flags%fft_filter_lat*degrad)  &
!  *cos(config_flags%fft_filter_lat*degrad))*a_msfxffl
!   a_msfxffl =0.0  ! Remarked by Ning Pan, 2010-07-21

!   END IF  ! Remarked by Ning Pan, 2010-07-21

!LPB[0]
!  itf =min(ite, ide-1)
!  jtf =min(jte, jde-1)
!  some =0
!  max_vert_cfl =0.

!  max_horiz_cfl =0.

!  total =0

! Remarked by Ning Pan, 2010-07-21
!   a_max_horiz_cfl =0.0
!   a_max_vert_cfl =0.0

   END SUBROUTINE a_w_damp

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of horizontal_diffusion in reverse (adjoint) mode:
!   gradient     of useful results: field tendency xkmhd mu
!   with respect to varying inputs: field tendency xkmhd mu
!   RW status of diff variables: field:incr tendency:in-out xkmhd:incr
!                mu:incr
SUBROUTINE A_HORIZONTAL_DIFFUSION(name, field, fieldb, tendency, &
&  tendencyb, mu, mub, config_flags, msfux, msfuy, msfvx, msfvx_inv, &
&  msfvy, msftx, msfty, khdif, xkmhd, xkmhdb, rdx, rdy, 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
  CHARACTER(len=1), INTENT(IN) :: name
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: field, xkmhd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: fieldb, xkmhdb
  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) :: mu
  REAL, DIMENSION(ims:ime, jms:jme) :: mub
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvx_inv, msfvy, msftx, msfty
  REAL, INTENT(IN) :: rdx, rdy, khdif
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  REAL :: mrdx, mkrdxm, mkrdxp, mrdy, mkrdym, mkrdyp
  REAL :: mkrdxmb, mkrdxpb, mkrdymb, mkrdypb
  LOGICAL :: specified
  REAL :: temp2
  REAL :: temp1
  REAL :: temp1b33
  REAL :: temp0
  REAL :: temp1b32
  REAL :: temp1b31
  REAL :: temp1b30
  REAL :: tempb1
  REAL :: temp0b
  REAL :: tempb0
  REAL :: temp1b29
  REAL :: temp1b28
  REAL :: temp3b
  REAL :: temp1b27
  REAL :: temp1b26
  REAL :: temp1b25
  REAL :: temp1b24
  REAL :: temp1b23
  REAL :: temp1b22
  REAL :: temp2b1
  REAL :: temp1b21
  REAL :: temp2b0
  REAL :: temp1b20
  REAL :: tempb
  REAL :: temp0b1
  REAL :: temp0b0
  REAL :: temp1b19
  REAL :: temp1b18
  REAL :: temp2b
  REAL :: temp1b17
  REAL :: temp1b16
  REAL :: temp1b15
  REAL :: temp1b14
  REAL :: temp1b13
  REAL :: temp1b12
  REAL :: temp1b11
  REAL :: temp1b10
  REAL :: temp3b0
  REAL :: temp1b9
  REAL :: temp1b8
  REAL :: temp1b7
  REAL :: temp1b
  REAL :: temp1b6
  REAL :: temp
  REAL :: temp1b5
  REAL :: temp1b4
  REAL :: temp1b3
  REAL :: temp1b2
  REAL :: temp1b1
  REAL :: temp1b0
!<DESCRIPTION>
!
!  horizontal_diffusion computes the horizontal diffusion tendency
!  on model horizontal coordinate surfaces.
!
!</DESCRIPTION>
  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
  IF (name .EQ. 'u') 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 .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%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
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) i_end = ite
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(mkrdxm)
! The interior is grad: (m_x*d/dx), the exterior is div: (m_x*m_y*d/dx(/m_y))
! setting up different averagings of m^2 partial d/dX and m^2 partial d/dY
          mkrdxm = msftx(i-1, j)/msfty(i-1, j)*mu(i-1, j)*xkmhd(i-1, k, &
&            j)*rdx
          CALL PUSHREAL8(mkrdxp)
          mkrdxp = msftx(i, j)/msfty(i, j)*mu(i, j)*xkmhd(i, k, j)*rdx
          CALL PUSHREAL8(mkrdym)
          mkrdym = (msfuy(i, j)+msfuy(i, j-1))/(msfux(i, j)+msfux(i, j-1&
&            ))*0.25*(mu(i, j)+mu(i, j-1)+mu(i-1, j-1)+mu(i-1, j))*0.25*(&
&            xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i-1, k, j-1)+xkmhd(i-1&
&            , k, j))*rdy
          CALL PUSHREAL8(mkrdyp)
          mkrdyp = (msfuy(i, j)+msfuy(i, j+1))/(msfux(i, j)+msfux(i, j+1&
&            ))*0.25*(mu(i, j)+mu(i, j+1)+mu(i-1, j+1)+mu(i-1, j))*0.25*(&
&            xkmhd(i, k, j)+xkmhd(i, k, j+1)+xkmhd(i-1, k, j+1)+xkmhd(i-1&
&            , k, j))*rdy
! need to do four-corners (t) for diffusion coefficient as there are
! no values at u,v points
! msfuy - has to be y as part of d/dY
!         has to be u as we're at a u point
! correctly averaged version of rho~ * m^2 * 
!    [partial d/dX(partial du^/dX) + partial d/dY(partial du^/dY)]
        END DO
      END DO
    END DO
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          mrdx = msfux(i, j)*msfuy(i, j)*rdx
          mrdy = msfux(i, j)*msfuy(i, j)*rdy
          temp3b = mrdx*tendencyb(i, k, j)
          temp3b0 = mrdy*tendencyb(i, k, j)
          mkrdxpb = (field(i+1, k, j)-field(i, k, j))*temp3b
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + mkrdxp*temp3b
          fieldb(i, k, j) = fieldb(i, k, j) + (-mkrdym-mkrdyp)*temp3b0 +&
&            (-mkrdxm-mkrdxp)*temp3b
          mkrdxmb = -((field(i, k, j)-field(i-1, k, j))*temp3b)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + mkrdxm*temp3b
          mkrdypb = (field(i, k, j+1)-field(i, k, j))*temp3b0
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + mkrdyp*temp3b0
          mkrdymb = -((field(i, k, j)-field(i, k, j-1))*temp3b0)
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + mkrdym*temp3b0
          CALL POPREAL8(mkrdyp)
          temp2 = msfux(i, j) + msfux(i, j+1)
          temp2b = (msfuy(i, j)+msfuy(i, j+1))*rdy*0.25**2*mkrdypb
          temp2b0 = (xkmhd(i, k, j)+xkmhd(i, k, j+1)+xkmhd(i-1, k, j+1)+&
&            xkmhd(i-1, k, j))*temp2b/temp2
          temp2b1 = (mu(i, j)+mu(i, j+1)+mu(i-1, j+1)+mu(i-1, j))*temp2b&
&            /temp2
          mub(i, j) = mub(i, j) + temp2b0
          mub(i, j+1) = mub(i, j+1) + temp2b0
          mub(i-1, j+1) = mub(i-1, j+1) + temp2b0
          mub(i-1, j) = mub(i-1, j) + temp2b0
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp2b1
          xkmhdb(i, k, j+1) = xkmhdb(i, k, j+1) + temp2b1
          xkmhdb(i-1, k, j+1) = xkmhdb(i-1, k, j+1) + temp2b1
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + temp2b1
          CALL POPREAL8(mkrdym)
          temp1 = msfux(i, j) + msfux(i, j-1)
          temp1b29 = (msfuy(i, j)+msfuy(i, j-1))*rdy*0.25**2*mkrdymb
          temp1b30 = (xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i-1, k, j-1)&
&            +xkmhd(i-1, k, j))*temp1b29/temp1
          temp1b31 = (mu(i, j)+mu(i, j-1)+mu(i-1, j-1)+mu(i-1, j))*&
&            temp1b29/temp1
          mub(i, j) = mub(i, j) + temp1b30
          mub(i, j-1) = mub(i, j-1) + temp1b30
          mub(i-1, j-1) = mub(i-1, j-1) + temp1b30
          mub(i-1, j) = mub(i-1, j) + temp1b30
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b31
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + temp1b31
          xkmhdb(i-1, k, j-1) = xkmhdb(i-1, k, j-1) + temp1b31
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + temp1b31
          CALL POPREAL8(mkrdxp)
          temp1b32 = msftx(i, j)*rdx*mkrdxpb
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + mu(i, j)*temp1b32/msfty(i&
&            , j)
          mub(i, j) = mub(i, j) + xkmhd(i, k, j)*temp1b32/msfty(i, j)
          CALL POPREAL8(mkrdxm)
          temp1b33 = msftx(i-1, j)*rdx*mkrdxmb
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + mu(i-1, j)*temp1b33/&
&            msfty(i-1, j)
          mub(i-1, j) = mub(i-1, j) + xkmhd(i-1, k, j)*temp1b33/msfty(i-&
&            1, j)
        END DO
      END DO
    END DO
  ELSE IF (name .EQ. 'v') 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_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
    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 - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jds + 1 .LT. jts) THEN
        j_start = jts
      ELSE
        j_start = jds + 1
      END IF
    END IF
    IF (config_flags%polar) THEN
      IF (jde - 1 .GT. jte) THEN
        j_end = jte
      ELSE
        j_end = jde - 1
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(mkrdxm)
          mkrdxm = (msfvx(i, j)+msfvx(i-1, j))/(msfvy(i, j)+msfvy(i-1, j&
&            ))*0.25*(mu(i, j)+mu(i, j-1)+mu(i-1, j-1)+mu(i-1, j))*0.25*(&
&            xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i-1, k, j-1)+xkmhd(i-1&
&            , k, j))*rdx
          CALL PUSHREAL8(mkrdxp)
          mkrdxp = (msfvx(i, j)+msfvx(i+1, j))/(msfvy(i, j)+msfvy(i+1, j&
&            ))*0.25*(mu(i, j)+mu(i, j-1)+mu(i+1, j-1)+mu(i+1, j))*0.25*(&
&            xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i+1, k, j-1)+xkmhd(i+1&
&            , k, j))*rdx
        END DO
      END DO
    END DO
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          mkrdym = msfty(i, j-1)/msftx(i, j-1)*xkmhd(i, k, j-1)*rdy
          mkrdyp = msfty(i, j)/msftx(i, j)*xkmhd(i, k, j)*rdy
          mrdx = msfvx(i, j)*msfvy(i, j)*rdx
          mrdy = msfvx(i, j)*msfvy(i, j)*rdy
          temp1b = mrdx*tendencyb(i, k, j)
          temp1b0 = mrdy*tendencyb(i, k, j)
          mkrdxpb = (field(i+1, k, j)-field(i, k, j))*temp1b
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + mkrdxp*temp1b
          fieldb(i, k, j) = fieldb(i, k, j) + (-mkrdym-mkrdyp)*temp1b0 +&
&            (-mkrdxm-mkrdxp)*temp1b
          mkrdxmb = -((field(i, k, j)-field(i-1, k, j))*temp1b)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + mkrdxm*temp1b
          mkrdypb = (field(i, k, j+1)-field(i, k, j))*temp1b0
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + mkrdyp*temp1b0
          mkrdymb = -((field(i, k, j)-field(i, k, j-1))*temp1b0)
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + mkrdym*temp1b0
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + msfty(i, j)*rdy*mkrdypb/&
&            msftx(i, j)
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + msfty(i, j-1)*rdy*&
&            mkrdymb/msftx(i, j-1)
          CALL POPREAL8(mkrdxp)
          temp0 = msfvy(i, j) + msfvy(i+1, j)
          temp0b = (msfvx(i, j)+msfvx(i+1, j))*rdx*0.25**2*mkrdxpb
          temp0b0 = (xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i+1, k, j-1)+&
&            xkmhd(i+1, k, j))*temp0b/temp0
          temp0b1 = (mu(i, j)+mu(i, j-1)+mu(i+1, j-1)+mu(i+1, j))*temp0b&
&            /temp0
          mub(i, j) = mub(i, j) + temp0b0
          mub(i, j-1) = mub(i, j-1) + temp0b0
          mub(i+1, j-1) = mub(i+1, j-1) + temp0b0
          mub(i+1, j) = mub(i+1, j) + temp0b0
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp0b1
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + temp0b1
          xkmhdb(i+1, k, j-1) = xkmhdb(i+1, k, j-1) + temp0b1
          xkmhdb(i+1, k, j) = xkmhdb(i+1, k, j) + temp0b1
          CALL POPREAL8(mkrdxm)
          temp = msfvy(i, j) + msfvy(i-1, j)
          tempb = (msfvx(i, j)+msfvx(i-1, j))*rdx*0.25**2*mkrdxmb
          tempb0 = (xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i-1, k, j-1)+&
&            xkmhd(i-1, k, j))*tempb/temp
          tempb1 = (mu(i, j)+mu(i, j-1)+mu(i-1, j-1)+mu(i-1, j))*tempb/&
&            temp
          mub(i, j) = mub(i, j) + tempb0
          mub(i, j-1) = mub(i, j-1) + tempb0
          mub(i-1, j-1) = mub(i-1, j-1) + tempb0
          mub(i-1, j) = mub(i-1, j) + tempb0
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + tempb1
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + tempb1
          xkmhdb(i-1, k, j-1) = xkmhdb(i-1, k, j-1) + tempb1
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + tempb1
        END DO
      END DO
    END DO
  ELSE IF (name .EQ. 'w') 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 (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
    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
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts+1,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(mkrdxm)
          mkrdxm = msfux(i, j)/msfuy(i, j)*0.25*(mu(i, j)+mu(i-1, j)+mu(&
&            i, j)+mu(i-1, j))*0.25*(xkmhd(i, k, j)+xkmhd(i-1, k, j)+&
&            xkmhd(i, k-1, j)+xkmhd(i-1, k-1, j))*rdx
          CALL PUSHREAL8(mkrdxp)
          mkrdxp = msfux(i+1, j)/msfuy(i+1, j)*0.25*(mu(i+1, j)+mu(i, j)&
&            +mu(i+1, j)+mu(i, j))*0.25*(xkmhd(i+1, k, j)+xkmhd(i, k, j)+&
&            xkmhd(i+1, k-1, j)+xkmhd(i, k-1, j))*rdx
          CALL PUSHREAL8(mkrdym)
!         mkrdym=(msfvy(i,j)/msfvx(i,j))*   &
          mkrdym = msfvy(i, j)*msfvx_inv(i, j)*0.25*(mu(i, j)+mu(i, j-1)&
&            +mu(i, j)+mu(i, j-1))*0.25*(xkmhd(i, k, j)+xkmhd(i, k, j-1)+&
&            xkmhd(i, k-1, j)+xkmhd(i, k-1, j-1))*rdy
          CALL PUSHREAL8(mkrdyp)
!         mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*   &
          mkrdyp = msfvy(i, j+1)*msfvx_inv(i, j+1)*0.25*(mu(i, j+1)+mu(i&
&            , j)+mu(i, j+1)+mu(i, j))*0.25*(xkmhd(i, k, j+1)+xkmhd(i, k&
&            , j)+xkmhd(i, k-1, j+1)+xkmhd(i, k-1, j))*rdy
        END DO
      END DO
    END DO
    DO j=j_end,j_start,-1
      DO k=ktf,kts+1,-1
        DO i=i_end,i_start,-1
          mrdx = msftx(i, j)*msfty(i, j)*rdx
          mrdy = msftx(i, j)*msfty(i, j)*rdy
          temp1b1 = mrdx*tendencyb(i, k, j)
          temp1b2 = mrdy*tendencyb(i, k, j)
          mkrdxpb = (field(i+1, k, j)-field(i, k, j))*temp1b1
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + mkrdxp*temp1b1
          fieldb(i, k, j) = fieldb(i, k, j) + (-mkrdym-mkrdyp)*temp1b2 +&
&            (-mkrdxm-mkrdxp)*temp1b1
          mkrdxmb = -((field(i, k, j)-field(i-1, k, j))*temp1b1)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + mkrdxm*temp1b1
          mkrdypb = (field(i, k, j+1)-field(i, k, j))*temp1b2
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + mkrdyp*temp1b2
          mkrdymb = -((field(i, k, j)-field(i, k, j-1))*temp1b2)
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + mkrdym*temp1b2
          CALL POPREAL8(mkrdyp)
          temp1b3 = msfvy(i, j+1)*msfvx_inv(i, j+1)*rdy*0.25**2*mkrdypb
          temp1b4 = (xkmhd(i, k, j+1)+xkmhd(i, k, j)+xkmhd(i, k-1, j+1)+&
&            xkmhd(i, k-1, j))*temp1b3
          temp1b5 = (2*mu(i, j+1)+2*mu(i, j))*temp1b3
          mub(i, j+1) = mub(i, j+1) + 2*temp1b4
          xkmhdb(i, k, j+1) = xkmhdb(i, k, j+1) + temp1b5
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b5
          xkmhdb(i, k-1, j+1) = xkmhdb(i, k-1, j+1) + temp1b5
          xkmhdb(i, k-1, j) = xkmhdb(i, k-1, j) + temp1b5
          CALL POPREAL8(mkrdym)
          temp1b7 = msfvy(i, j)*msfvx_inv(i, j)*rdy*0.25**2*mkrdymb
          temp1b6 = (xkmhd(i, k, j)+xkmhd(i, k, j-1)+xkmhd(i, k-1, j)+&
&            xkmhd(i, k-1, j-1))*temp1b7
          mub(i, j) = mub(i, j) + 2*temp1b6 + 2*temp1b4
          temp1b8 = (2*mu(i, j)+2*mu(i, j-1))*temp1b7
          mub(i, j-1) = mub(i, j-1) + 2*temp1b6
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b8
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + temp1b8
          xkmhdb(i, k-1, j) = xkmhdb(i, k-1, j) + temp1b8
          xkmhdb(i, k-1, j-1) = xkmhdb(i, k-1, j-1) + temp1b8
          CALL POPREAL8(mkrdxp)
          temp1b9 = msfux(i+1, j)*rdx*0.25**2*mkrdxpb
          temp1b10 = (xkmhd(i+1, k, j)+xkmhd(i, k, j)+xkmhd(i+1, k-1, j)&
&            +xkmhd(i, k-1, j))*temp1b9/msfuy(i+1, j)
          temp1b11 = (2*mu(i+1, j)+2*mu(i, j))*temp1b9/msfuy(i+1, j)
          mub(i+1, j) = mub(i+1, j) + 2*temp1b10
          xkmhdb(i+1, k, j) = xkmhdb(i+1, k, j) + temp1b11
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b11
          xkmhdb(i+1, k-1, j) = xkmhdb(i+1, k-1, j) + temp1b11
          xkmhdb(i, k-1, j) = xkmhdb(i, k-1, j) + temp1b11
          CALL POPREAL8(mkrdxm)
          temp1b13 = msfux(i, j)*rdx*0.25**2*mkrdxmb
          temp1b12 = (xkmhd(i, k, j)+xkmhd(i-1, k, j)+xkmhd(i, k-1, j)+&
&            xkmhd(i-1, k-1, j))*temp1b13/msfuy(i, j)
          mub(i, j) = mub(i, j) + 2*temp1b12 + 2*temp1b10
          temp1b14 = (2*mu(i, j)+2*mu(i-1, j))*temp1b13/msfuy(i, j)
          mub(i-1, j) = mub(i-1, j) + 2*temp1b12
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b14
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + temp1b14
          xkmhdb(i, k-1, j) = xkmhdb(i, k-1, j) + temp1b14
          xkmhdb(i-1, k-1, j) = xkmhdb(i-1, k-1, j) + temp1b14
        END DO
      END DO
    END DO
  ELSE
    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 .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
    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
    IF (config_flags%periodic_x) i_start = its
    IF (config_flags%periodic_x) THEN
      IF (ite .GT. ide - 1) THEN
        i_end = ide - 1
      ELSE
        i_end = ite
      END IF
    END IF
    DO j=j_start,j_end
      DO k=kts,ktf
        DO i=i_start,i_end
          CALL PUSHREAL8(mkrdxm)
          mkrdxm = msfux(i, j)/msfuy(i, j)*0.5*(xkmhd(i, k, j)+xkmhd(i-1&
&            , k, j))*0.5*(mu(i, j)+mu(i-1, j))*rdx
          CALL PUSHREAL8(mkrdxp)
          mkrdxp = msfux(i+1, j)/msfuy(i+1, j)*0.5*(xkmhd(i+1, k, j)+&
&            xkmhd(i, k, j))*0.5*(mu(i+1, j)+mu(i, j))*rdx
          CALL PUSHREAL8(mkrdym)
!         mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy
          mkrdym = msfvy(i, j)*msfvx_inv(i, j)*0.5*(xkmhd(i, k, j)+xkmhd&
&            (i, k, j-1))*0.5*(mu(i, j)+mu(i, j-1))*rdy
          CALL PUSHREAL8(mkrdyp)
!         mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy
          mkrdyp = msfvy(i, j+1)*msfvx_inv(i, j+1)*0.5*(xkmhd(i, k, j+1)&
&            +xkmhd(i, k, j))*0.5*(mu(i, j+1)+mu(i, j))*rdy
        END DO
      END DO
    END DO
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          mrdx = msftx(i, j)*msfty(i, j)*rdx
          mrdy = msftx(i, j)*msfty(i, j)*rdy
          temp1b15 = mrdx*tendencyb(i, k, j)
          temp1b16 = mrdy*tendencyb(i, k, j)
          mkrdxpb = (field(i+1, k, j)-field(i, k, j))*temp1b15
          fieldb(i+1, k, j) = fieldb(i+1, k, j) + mkrdxp*temp1b15
          fieldb(i, k, j) = fieldb(i, k, j) + (-mkrdym-mkrdyp)*temp1b16 &
&            + (-mkrdxm-mkrdxp)*temp1b15
          mkrdxmb = -((field(i, k, j)-field(i-1, k, j))*temp1b15)
          fieldb(i-1, k, j) = fieldb(i-1, k, j) + mkrdxm*temp1b15
          mkrdypb = (field(i, k, j+1)-field(i, k, j))*temp1b16
          fieldb(i, k, j+1) = fieldb(i, k, j+1) + mkrdyp*temp1b16
          mkrdymb = -((field(i, k, j)-field(i, k, j-1))*temp1b16)
          fieldb(i, k, j-1) = fieldb(i, k, j-1) + mkrdym*temp1b16
          CALL POPREAL8(mkrdyp)
          temp1b17 = msfvy(i, j+1)*msfvx_inv(i, j+1)*rdy*0.5**2*mkrdypb
          temp1b18 = (mu(i, j+1)+mu(i, j))*temp1b17
          temp1b19 = (xkmhd(i, k, j+1)+xkmhd(i, k, j))*temp1b17
          xkmhdb(i, k, j+1) = xkmhdb(i, k, j+1) + temp1b18
          mub(i, j+1) = mub(i, j+1) + temp1b19
          CALL POPREAL8(mkrdym)
          temp1b22 = msfvy(i, j)*msfvx_inv(i, j)*rdy*0.5**2*mkrdymb
          temp1b20 = (mu(i, j)+mu(i, j-1))*temp1b22
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b20 + temp1b18
          temp1b21 = (xkmhd(i, k, j)+xkmhd(i, k, j-1))*temp1b22
          mub(i, j) = mub(i, j) + temp1b21 + temp1b19
          xkmhdb(i, k, j-1) = xkmhdb(i, k, j-1) + temp1b20
          mub(i, j-1) = mub(i, j-1) + temp1b21
          CALL POPREAL8(mkrdxp)
          temp1b23 = msfux(i+1, j)*rdx*0.5**2*mkrdxpb
          temp1b24 = (mu(i+1, j)+mu(i, j))*temp1b23/msfuy(i+1, j)
          temp1b25 = (xkmhd(i+1, k, j)+xkmhd(i, k, j))*temp1b23/msfuy(i+&
&            1, j)
          xkmhdb(i+1, k, j) = xkmhdb(i+1, k, j) + temp1b24
          mub(i+1, j) = mub(i+1, j) + temp1b25
          CALL POPREAL8(mkrdxm)
          temp1b28 = msfux(i, j)*rdx*0.5**2*mkrdxmb
          temp1b26 = (mu(i, j)+mu(i-1, j))*temp1b28/msfuy(i, j)
          xkmhdb(i, k, j) = xkmhdb(i, k, j) + temp1b26 + temp1b24
          temp1b27 = (xkmhd(i, k, j)+xkmhd(i-1, k, j))*temp1b28/msfuy(i&
&            , j)
          mub(i, j) = mub(i, j) + temp1b27 + temp1b25
          xkmhdb(i-1, k, j) = xkmhdb(i-1, k, j) + temp1b26
          mub(i-1, j) = mub(i-1, j) + temp1b27
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_HORIZONTAL_DIFFUSION

   SUBROUTINE a_horizontal_diffusion_3dmp(name,field,a_field,tendency,a_tendency, &
   mu,a_mu,config_flags,base_3d,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif, &
   xkmhd,a_xkmhd,rdx,rdy,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
   INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   CHARACTER (LEN=1) :: name
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: field,a_field,xkmhd,a_xkmhd,base_3d
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
   REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty
   REAL :: rdx,rdy,khdif
   INTEGER :: i,j,k,itf,jtf,ktf
   INTEGER :: i_start,i_end,j_start,j_end
! Revised by Ning Pan, 2010-07-23
!   REAL :: mrdx,a_mrdx,mkrdxm,a_mkrdxm,mkrdxp,a_mkrdxp,mrdy,a_mrdy,mkrdym, &
   REAL :: mrdx,mkrdxm,a_mkrdxm,mkrdxp,a_mkrdxp,mrdy,mkrdym, &
   a_mkrdym,mkrdyp,a_mkrdyp
   LOGICAL :: specified

   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,a_Tmpv13,Tmpv013, &
   a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
   a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019,a_Tmpv20,Tmpv020,a_Tmpv21,Tmpv021,a_Tmpv22,Tmpv022
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv301
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv302
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv303
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv304
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv305
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv306
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv307
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv308
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv309
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3010
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3011
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3012
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3013
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3014
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3015
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3016
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3017
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3018
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv3019

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]

      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

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

!LPB[3]
      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)

!LPB[4]

!LPB[5]
      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-2,ite)

!LPB[6]

!LPB[7]
      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)

!LPB[8]

!LPB[9]
      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-2,jte)

!LPB[10]

!LPB[11]
      IF ( config_flags%periodic_x ) i_start = its

!LPB[12]

!LPB[13]
      IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)

!!LPB[14]
!         DO j = j_start, j_end

!         DO k=kts,ktf
!         DO i = i_start, i_end
!            mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j)) &
!   *0.5*(mu(i,j)+mu(i-1,j))*rdx
!            mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j)) &
!   *0.5*(mu(i+1,j)+mu(i,j))*rdx
!            mrdx=msftx(i,j)*msfty(i,j)*rdx
!            mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1)) &
!   *0.5*(mu(i,j)+mu(i,j-1))*rdy
!            mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j)) &
!   *0.5*(mu(i,j+1)+mu(i,j))*rdy
!            mrdy=msftx(i,j)*msfty(i,j)*rdy
!               tendency(i,k,j)=tendency(i,k,j)+(                          &
!                       mrdx*( mkrdxp*(   field(i+1,k,j)  -field(i  ,k,j)        &
!                                      -base_3d(i+1,k,j)+base_3d(i  ,k,j) )      &
!                             -mkrdxm*(   field(i  ,k,j)  -field(i-1,k,j)        &
!                                      -base_3d(i  ,k,j)+base_3d(i-1,k,j) )  )   &
!                      +mrdy*( mkrdyp*(   field(i,k,j+1)  -field(i,k,j  )        &
!                                      -base_3d(i,k,j+1)+base_3d(i,k,j  ) )      &
!                             -mkrdym*(   field(i,k,j  )  -field(i,k,j-1)        &
!                                      -base_3d(i,k,j  )+base_3d(i,k,j-1) )  )   &
!                                                                            ) 
!         ENDDO
!         ENDDO

!         ENDDO

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

!   a_mrdx =0.0  ! Remarked by Ning Pan, 2010-07-23
   a_mkrdxm =0.0
   a_mkrdxp =0.0
!   a_mrdy =0.0  ! Remarked by Ning Pan, 2010-07-23
   a_mkrdym =0.0
   a_mkrdyp =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[14]
   DO j =j_end, j_start, -1

   DO k =kts, ktf
   DO i =i_start, i_end
   Tmpv001 =xkmhd(i,k,j) +xkmhd(i-1,k,j)
   Tmpv002 =(msfux(i,j)/msfuy(i,j))*0.5*Tmpv001
   Tmpv003 =Tmpv002*0.5
   Tmpv004 =mu(i,j) +mu(i-1,j)
   Tmpv300(i,k) =Tmpv003
   Tmpv301(i,k) =Tmpv004
   Tmpv005 =Tmpv300(i,k)*Tmpv301(i,k)
   Tmpv006 =Tmpv005*rdx
! Revised by Ning Pan, 2010-07-23
!   Tmpv302(i,k) =mkrdxm
!   mkrdxm =Tmpv006
   mkrdxm =Tmpv006
   Tmpv302(i,k) =mkrdxm

   Tmpv001 =xkmhd(i+1,k,j) +xkmhd(i,k,j)
   Tmpv002 =(msfux(i+1,j)/msfuy(i+1,j))*0.5*Tmpv001
   Tmpv003 =Tmpv002*0.5
   Tmpv004 =mu(i+1,j) +mu(i,j)
   Tmpv303(i,k) =Tmpv003
   Tmpv304(i,k) =Tmpv004
   Tmpv005 =Tmpv303(i,k)*Tmpv304(i,k)
   Tmpv006 =Tmpv005*rdx
! Revised by Ning Pan, 2010-07-23
!   Tmpv305(i,k) =mkrdxp
!   mkrdxp =Tmpv006
   mkrdxp =Tmpv006
   Tmpv305(i,k) =mkrdxp

! Revised by Ning Pan, 2010-07-23
!   Tmpv306(i,k) =mrdx
!   mrdx =msftx(i,j)*msfty(i,j)*rdx
   mrdx =msftx(i,j)*msfty(i,j)*rdx
   Tmpv306(i,k) =mrdx

   Tmpv001 =xkmhd(i,k,j) +xkmhd(i,k,j-1)
   Tmpv002 =(msfvy(i,j)*msfvx_inv(i,j))*0.5*Tmpv001
   Tmpv003 =Tmpv002*0.5
   Tmpv004 =mu(i,j) +mu(i,j-1)
   Tmpv307(i,k) =Tmpv003
   Tmpv308(i,k) =Tmpv004
   Tmpv005 =Tmpv307(i,k)*Tmpv308(i,k)
   Tmpv006 =Tmpv005*rdy
! Revised by Ning Pan, 2010-07-23
!   Tmpv309(i,k) =mkrdym
!   mkrdym =Tmpv006
   mkrdym =Tmpv006
   Tmpv309(i,k) =mkrdym

   Tmpv001 =xkmhd(i,k,j+1) +xkmhd(i,k,j)
   Tmpv002 =(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*Tmpv001
   Tmpv003 =Tmpv002*0.5
   Tmpv004 =mu(i,j+1) +mu(i,j)
   Tmpv3010(i,k) =Tmpv003
   Tmpv3011(i,k) =Tmpv004
   Tmpv005 =Tmpv3010(i,k)*Tmpv3011(i,k)
   Tmpv006 =Tmpv005*rdy
! Revised by Ning Pan, 2010-07-23
!   Tmpv3012(i,k) =mkrdyp
!   mkrdyp =Tmpv006
   mkrdyp =Tmpv006
   Tmpv3012(i,k) =mkrdyp

! Revised by Ning Pan, 2010-07-23
!   Tmpv3013(i,k) =mrdy
!   mrdy =msftx(i,j)*msfty(i,j)*rdy
   mrdy =msftx(i,j)*msfty(i,j)*rdy
   Tmpv3013(i,k) =mrdy

   Tmpv001 =field(i+1,k,j) -field(i,k,j)
   Tmpv002 =Tmpv001 -base_3d(i+1,k,j)
   Tmpv003 =Tmpv002 +base_3d(i,k,j)
   Tmpv3014(i,k) =Tmpv003
   Tmpv004 =mkrdxp*Tmpv3014(i,k)
   Tmpv005 =field(i,k,j) -field(i-1,k,j)
   Tmpv006 =Tmpv005 -base_3d(i,k,j)
   Tmpv007 =Tmpv006 +base_3d(i-1,k,j)
   Tmpv3015(i,k) =Tmpv007
   Tmpv008 =mkrdxm*Tmpv3015(i,k)
   Tmpv009 =Tmpv004 -Tmpv008
   Tmpv3016(i,k) =Tmpv009
   Tmpv010 =mrdx*Tmpv3016(i,k)
   Tmpv011 =field(i,k,j+1) -field(i,k,j)
   Tmpv012 =Tmpv011 -base_3d(i,k,j+1)
   Tmpv013 =Tmpv012 +base_3d(i,k,j)
   Tmpv3017(i,k) =Tmpv013
   Tmpv014 =mkrdyp*Tmpv3017(i,k)
   Tmpv015 =field(i,k,j) -field(i,k,j-1)
   Tmpv016 =Tmpv015 -base_3d(i,k,j)
   Tmpv017 =Tmpv016 +base_3d(i,k,j-1)
   Tmpv3018(i,k) =Tmpv017
   Tmpv018 =mkrdym*Tmpv3018(i,k)
   Tmpv019 =Tmpv014 -Tmpv018
   Tmpv3019(i,k) =Tmpv019
! Remarked by Ning Pan, 2010-07-23
!   Tmpv020 =mrdy*Tmpv3019(i,k)
!   Tmpv021 =Tmpv010 +Tmpv020
!   Tmpv022 =tendency(i,k,j) +Tmpv021
!!  tendency(i,k,j) =Tmpv022

   ENDDO
   ENDDO

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
! Added by Ning Pan, 2010-07-23
   mkrdxm = Tmpv302(i,k)
   mkrdxp = Tmpv305(i,k)
   mrdx = Tmpv306(i,k)
   mkrdym = Tmpv309(i,k)
   mkrdyp = Tmpv3012(i,k)
   mrdy = Tmpv3013(i,k)

   a_Tmpv22 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv22
   a_Tmpv21 =a_Tmpv22
   a_Tmpv10 =a_Tmpv21
   a_Tmpv20 =a_Tmpv21
!   a_mrdy =a_mrdy +Tmpv3019(i,k)*a_Tmpv20  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv19 =mrdy*a_Tmpv20
   a_Tmpv14 =a_Tmpv19
   a_Tmpv18 =-a_Tmpv19
   a_mkrdym =a_mkrdym +Tmpv3018(i,k)*a_Tmpv18
   a_Tmpv17 =mkrdym*a_Tmpv18
   a_Tmpv16 =a_Tmpv17
   a_Tmpv15 =a_Tmpv16
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv15
   a_field(i,k,j-1) =a_field(i,k,j-1) -a_Tmpv15
   a_mkrdyp =a_mkrdyp +Tmpv3017(i,k)*a_Tmpv14
   a_Tmpv13 =mkrdyp*a_Tmpv14
   a_Tmpv12 =a_Tmpv13
   a_Tmpv11 =a_Tmpv12
   a_field(i,k,j+1) =a_field(i,k,j+1) +a_Tmpv11
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv11
!   a_mrdx =a_mrdx +Tmpv3016(i,k)*a_Tmpv10  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv9 =mrdx*a_Tmpv10
   a_Tmpv4 =a_Tmpv9
   a_Tmpv8 =-a_Tmpv9
   a_mkrdxm =a_mkrdxm +Tmpv3015(i,k)*a_Tmpv8
   a_Tmpv7 =mkrdxm*a_Tmpv8
   a_Tmpv6 =a_Tmpv7
   a_Tmpv5 =a_Tmpv6
   a_field(i,k,j) =a_field(i,k,j) +a_Tmpv5
   a_field(i-1,k,j) =a_field(i-1,k,j) -a_Tmpv5
   a_mkrdxp =a_mkrdxp +Tmpv3014(i,k)*a_Tmpv4
   a_Tmpv3 =mkrdxp*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_field(i+1,k,j) =a_field(i+1,k,j) +a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv1

!   mrdy =Tmpv3013(i,k)  ! Remarked by Ning Pan, 2010-07-23

!   a_mrdy =0.0  ! Remarked by Ning Pan, 2010-07-23

!   mkrdyp =Tmpv3012(i,k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv6 =a_mkrdyp
   a_mkrdyp =0.0
   a_Tmpv5 =rdy*a_Tmpv6
   a_Tmpv3 =Tmpv3011(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv3010(i,k)*a_Tmpv5
   a_mu(i,j+1) =a_mu(i,j+1) +a_Tmpv4
   a_mu(i,j) =a_mu(i,j) +a_Tmpv4
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*a_Tmpv2
   a_xkmhd(i,k,j+1) =a_xkmhd(i,k,j+1) +a_Tmpv1
   a_xkmhd(i,k,j) =a_xkmhd(i,k,j) +a_Tmpv1

!   mkrdym =Tmpv309(i,k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv6 =a_mkrdym
   a_mkrdym =0.0
   a_Tmpv5 =rdy*a_Tmpv6
   a_Tmpv3 =Tmpv308(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv307(i,k)*a_Tmpv5
   a_mu(i,j) =a_mu(i,j) +a_Tmpv4
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv4
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =(msfvy(i,j)*msfvx_inv(i,j))*0.5*a_Tmpv2
   a_xkmhd(i,k,j) =a_xkmhd(i,k,j) +a_Tmpv1
   a_xkmhd(i,k,j-1) =a_xkmhd(i,k,j-1) +a_Tmpv1

!   mrdx =Tmpv306(i,k)  ! Remarked by Ning Pan, 2010-07-23

!   a_mrdx =0.0  ! Remarked by Ning Pan, 2010-07-23

!   mkrdxp =Tmpv305(i,k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv6 =a_mkrdxp
   a_mkrdxp =0.0
   a_Tmpv5 =rdx*a_Tmpv6
   a_Tmpv3 =Tmpv304(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv303(i,k)*a_Tmpv5
   a_mu(i+1,j) =a_mu(i+1,j) +a_Tmpv4
   a_mu(i,j) =a_mu(i,j) +a_Tmpv4
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =(msfux(i+1,j)/msfuy(i+1,j))*0.5*a_Tmpv2
   a_xkmhd(i+1,k,j) =a_xkmhd(i+1,k,j) +a_Tmpv1
   a_xkmhd(i,k,j) =a_xkmhd(i,k,j) +a_Tmpv1

!   mkrdxm =Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv6 =a_mkrdxm
   a_mkrdxm =0.0
   a_Tmpv5 =rdx*a_Tmpv6
   a_Tmpv3 =Tmpv301(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv300(i,k)*a_Tmpv5
   a_mu(i,j) =a_mu(i,j) +a_Tmpv4
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv4
   a_Tmpv2 =0.5*a_Tmpv3
   a_Tmpv1 =(msfux(i,j)/msfuy(i,j))*0.5*a_Tmpv2
   a_xkmhd(i,k,j) =a_xkmhd(i,k,j) +a_Tmpv1
   a_xkmhd(i-1,k,j) =a_xkmhd(i-1,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[13]

!  IF( config_flags%periodic_x ) THEN
!  i_end =min(ite, ide-1)
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[12]

!LPB[11]

!  IF( config_flags%periodic_x ) THEN
!  i_start =its
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[10]

!LPB[9]

!  IF( config_flags%open_ye .or. specified ) THEN
!  j_end =min(jde-2, jte)
!  END IF

!  IF( config_flags%open_ye .or. specified ) THEN

!  END IF

!LPB[8]

!LPB[7]

!  IF( config_flags%open_ys .or. specified ) THEN
!  j_start =max(jds+1, jts)
!  END IF

!  IF( config_flags%open_ys .or. specified ) THEN

!  END IF

!LPB[6]

!LPB[5]

!  IF( config_flags%open_xe .or. specified ) THEN
!  i_end =min(ide-2, ite)
!  END IF

!  IF( config_flags%open_xe .or. specified ) THEN

!  END IF

!LPB[4]

!LPB[3]

!  IF( config_flags%open_xs .or. specified ) THEN
!  i_start =max(ids+1, its)
!  END IF

!  IF( config_flags%open_xs .or. specified ) THEN

!  END IF

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =min(ite, ide-1)
!  j_start =jts
!  j_end =min(jte, jde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_horizontal_diffusion_3dmp

   SUBROUTINE a_vertical_diffusion(name,field,a_field,tendency,a_tendency, &
   config_flags,alt,a_alt,mut,a_mut,rdn,rdnw,kvdif,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
   INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   CHARACTER (LEN=1) :: name
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: field,a_field,alt,a_alt
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut
   REAL,DIMENSION(kms:kme) :: rdn,rdnw
   REAL :: kvdif
   INTEGER :: i,j,k,itf,jtf,ktf
   INTEGER :: i_start,i_end,j_start,j_end
!   REAL,DIMENSION(its:ite,jts:jte) :: vfluxm,a_vfluxm,vfluxp,a_vfluxp,zz,a_zz  ! Remarked by Ning Pan, 2010-07-23
   REAL,DIMENSION(its:ite,0:kte+1) :: vflux,a_vflux
!   REAL :: rdz,a_rdz  ! Remarked by Ning Pan, 2010-07-23
   LOGICAL :: specified

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1)-1,jts:MAX(jte,jde-1)) :: Tmpv400
   REAL,DIMENSION(its:MAX(ite,ide-1),kts+1:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv401
   REAL,DIMENSION(its:MAX(ite,ide-1),kts+1:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv402
   REAL,DIMENSION(its:MAX(ite,ide-1),kts+1:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv403
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1)-1,jts:MAX(jte,jde-1)) :: Tmpv404
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1)-1,jts:MAX(jte,jde-1)) :: Tmpv405
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv406
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv407
   REAL,DIMENSION(its:MAX(ite,ide-1),kts:MAX(kte,kde-1),jts:MAX(jte,jde-1)) :: Tmpv408

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

!LPB[2]
      ktf=MIN(kte,kde-1)

!!LPB[3]
!   IF (name .EQ. 'w')THEN

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

!   j_loop_w : DO j = j_start, j_end
!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!             vflux(i,k)= (kvdif/alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts+1,ktf
!          DO i = i_start, i_end
!               tendency(i,k,j)=tendency(i,k,j)                                           &
!                                 +rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))) &
!       &
!                                            *(vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO
!       ENDDO j_loop_w
!      ELSE IF(name .EQ. 'm')THEN
!        i_start = its
!        i_end   = MIN(ite,ide-1)
!        j_start = jts
!        j_end   = MIN(jte,jde-1)

!   j_loop_s : DO j = j_start, j_end
!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))     &
!                     *(field(i,k+1,j)-field(i,k,j))
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,0)=vflux(i,1)
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts,ktf
!          DO i = i_start, i_end
!            tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)    &
!                   *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO
!    ENDDO j_loop_s

!   ENDIF

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

! Remarked by Ning Pan, 2010-07-23
!   Do K1_ADJ =jts, jte
!   Do K0_ADJ =its, ite
!   a_vfluxm(K0_ADJ,K1_ADJ) =0.0
!   End Do
!   End Do

!   Do K1_ADJ =jts, jte
!   Do K0_ADJ =its, ite
!   a_vfluxp(K0_ADJ,K1_ADJ) =0.0
!   End Do
!   End Do

!   Do K1_ADJ =jts, jte
!   Do K0_ADJ =its, ite
!   a_zz(K0_ADJ,K1_ADJ) =0.0
!   End Do
!   End Do

   Do K1_ADJ =0, kte+1
   Do K0_ADJ =its, ite
   a_vflux(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

!   a_rdz =0.0  ! Remarked by Ning Pan, 2010-07-23

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]

   IF(name .EQ. 'w') THEN
   i_start =its
   i_end =min(ite, ide-1)
   j_start =jts
   j_end =min(jte, jde-1)
   DO j =j_start, j_end
   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =field(i,k+1,j) -field(i,k,j)
   Tmpv400(i,k,j) =Tmpv001
   Tmpv002 =(kvdif/alt(i,k,j))*rdnw(k)*Tmpv400(i,k,j)
   vflux(i,k) =Tmpv002

   ENDDO
   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts+1, ktf
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i,k-1,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv401(i,k,j) =Tmpv002
   Tmpv003 =rdn(k)*g*g/mut(i,j)/Tmpv401(i,k,j)
   Tmpv004 =vflux(i,k) -vflux(i,k-1)
   Tmpv402(i,k,j) =Tmpv003
   Tmpv403(i,k,j) =Tmpv004
! Remarked by Ning Pan, 2010-07-23
!   Tmpv005 =Tmpv402(i,k,j)*Tmpv403(i,k,j)
!   Tmpv006 =tendency(i,k,j) +Tmpv005
!!  tendency(i,k,j) =Tmpv006

   ENDDO
   ENDDO
   ENDDO
   ELSE IF(name .EQ. 'm') THEN
   i_start =its
   i_end =min(ite, ide-1)
   j_start =jts
   j_end =min(jte, jde-1)
   DO j =j_start, j_end
   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i,k+1,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv408(i,k,j) =Tmpv002  ! Added by Ning Pan, 2010-07-23
   Tmpv003 =kvdif*rdn(k+1)/Tmpv002
   Tmpv004 =field(i,k+1,j) -field(i,k,j)
   Tmpv404(i,k,j) =Tmpv003
   Tmpv405(i,k,j) =Tmpv004
   Tmpv005 =Tmpv404(i,k,j)*Tmpv405(i,k,j)
   vflux(i,k) =Tmpv005

   ENDDO
   ENDDO

   DO i =i_start, i_end
   vflux(i,0) =vflux(i,1)

   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts, ktf
   DO i =i_start, i_end
   Tmpv001 =g*g/mut(i,j)/alt(i,k,j)
   Tmpv002 =Tmpv001*rdnw(k)
   Tmpv003 =vflux(i,k) -vflux(i,k-1)
   Tmpv406(i,k,j) =Tmpv002
   Tmpv407(i,k,j) =Tmpv003
! Remarked by Ning Pan, 2010-07-23
!   Tmpv004 =Tmpv406(i,k,j)*Tmpv407(i,k,j)
!   Tmpv005 =tendency(i,k,j) +Tmpv004
!!  tendency(i,k,j) =Tmpv005

   ENDDO
   ENDDO
   ENDDO
   ENDIF

   IF(name .EQ. 'w') THEN

   DO j =j_end, j_start, -1
   DO k =ktf, kts+1, -1
   DO i =i_end, i_start, -1
   a_Tmpv6 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv6
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =Tmpv403(i,k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv402(i,k,j)*a_Tmpv5
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv4
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv4
   a_mut(i,j) =a_mut(i,j) -rdn(k)*g*g/(mut(i,j)*mut(i,j))/Tmpv401(i,k,j)*a_Tmpv3
   a_Tmpv2 =-rdn(k)*g*g/mut(i,j)/(Tmpv401(i,k,j)*Tmpv401(i,k,j))*a_Tmpv3
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i,k-1,j) =a_alt(i,k-1,j) +a_Tmpv1
   ENDDO
   ENDDO
   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO
   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv2 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_alt(i,k,j) =a_alt(i,k,j) -kvdif/(alt(i,k,j)*alt(i,k,j))*rdnw(k)  &
   *Tmpv400(i,k,j)*a_Tmpv2
   a_Tmpv1 =(kvdif/alt(i,k,j))*rdnw(k)*a_Tmpv2
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

   ELSE IF(name .EQ. 'm') THEN

   DO j =j_end, j_start, -1
   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv5 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv2 =Tmpv407(i,k,j)*a_Tmpv4
   a_Tmpv3 =Tmpv406(i,k,j)*a_Tmpv4
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv3
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv3
   a_Tmpv1 =rdnw(k)*a_Tmpv2
   a_mut(i,j) =a_mut(i,j) -g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*a_Tmpv1
   a_alt(i,k,j) =a_alt(i,k,j) -g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*a_Tmpv1
   ENDDO
   ENDDO
   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO
   DO i =i_end, i_start, -1
   a_vflux(i,1) =a_vflux(i,1) +a_vflux(i,0)
   a_vflux(i,0) =0.0
   ENDDO
   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv5 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_Tmpv3 =Tmpv405(i,k,j)*a_Tmpv5
   a_Tmpv4 =Tmpv404(i,k,j)*a_Tmpv5
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv4
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv4
! Revised by Ning Pan, 2010-07-23
!   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv002*Tmpv002)
   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv408(i,k,j)*Tmpv408(i,k,j))
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i,k+1,j) =a_alt(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO
   ENDDO

   ENDIF

!LPB[2]
!  ktf =min(kte, kde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_vertical_diffusion

   SUBROUTINE a_vertical_diffusion_mp(field,a_field,tendency,a_tendency, &
   config_flags,base,alt,a_alt,mut,a_mut,rdn,rdnw,kvdif,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
   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,alt,a_alt
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut
   REAL,DIMENSION(kms:kme) :: rdn,rdnw,base
   REAL :: kvdif
   INTEGER :: i,j,k,itf,jtf,ktf
   INTEGER :: i_start,i_end,j_start,j_end
   REAL,DIMENSION(its:ite,0:kte+1) :: vflux,a_vflux
!   REAL :: rdz,a_rdz  ! Remarked by Ning Pan, 2010-07-25
   LOGICAL :: specified

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv300
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv301
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv302
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv303
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv304  ! Added by Ning Pan, 2010-07-25

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]

      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

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

!!LPB[3]
!   j_loop_s : DO j = j_start, j_end

!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))     &
!                       *(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,0)=vflux(i,1)
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts,ktf
!          DO i = i_start, i_end
!            tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)    &
!                   *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO

!    ENDDO j_loop_s

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K1_ADJ =0, kte+1
   Do K0_ADJ =its, ite
   a_vflux(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

!   a_rdz =0.0  ! Remarked by Ning Pan, 2010-07-25

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]
   DO j =j_end, j_start, -1

   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i,k+1,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv304(i,k) =Tmpv002  ! Added by Ning Pan, 2010-07-25
   Tmpv003 =kvdif*rdn(k+1)/Tmpv002
   Tmpv004 =field(i,k+1,j) -field(i,k,j)
   Tmpv005 =Tmpv004 -base(k+1)
   Tmpv006 =Tmpv005 +base(k)
   Tmpv300(i,k) =Tmpv003
   Tmpv301(i,k) =Tmpv006
   Tmpv007 =Tmpv300(i,k)*Tmpv301(i,k)
   vflux(i,k) =Tmpv007

   ENDDO
   ENDDO
   DO i =i_start, i_end
   vflux(i,0) =vflux(i,1)

   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts, ktf
   DO i =i_start, i_end
   Tmpv001 =g*g/mut(i,j)/alt(i,k,j)
   Tmpv002 =Tmpv001*rdnw(k)
   Tmpv003 =vflux(i,k) -vflux(i,k-1)
   Tmpv302(i,k) =Tmpv002
   Tmpv303(i,k) =Tmpv003
! Remarked by Ning Pan, 2010-07-25
!   Tmpv004 =Tmpv302(i,k)*Tmpv303(i,k)
!   Tmpv005 =tendency(i,k,j) +Tmpv004
!!  tendency(i,k,j) =Tmpv005

   ENDDO
   ENDDO

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv5 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv2 =Tmpv303(i,k)*a_Tmpv4
   a_Tmpv3 =Tmpv302(i,k)*a_Tmpv4
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv3
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv3
   a_Tmpv1 =rdnw(k)*a_Tmpv2
   a_mut(i,j) =a_mut(i,j) -g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*a_Tmpv1
   a_alt(i,k,j) =a_alt(i,k,j) -g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*a_Tmpv1
   ENDDO
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,1) =a_vflux(i,1) +a_vflux(i,0)
   a_vflux(i,0) =0.0
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv7 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_Tmpv3 =Tmpv301(i,k)*a_Tmpv7
   a_Tmpv6 =Tmpv300(i,k)*a_Tmpv7
   a_Tmpv5 =a_Tmpv6
   a_Tmpv4 =a_Tmpv5
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv4
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv4
! Revised by Ning Pan, 2010-07-25
!   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv002*Tmpv002)
   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv304(i,k)*Tmpv304(i,k))
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i,k+1,j) =a_alt(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =min(ite, ide-1)
!  j_start =jts
!  j_end =min(jte, jde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_vertical_diffusion_mp

   SUBROUTINE a_vertical_diffusion_3dmp(field,a_field,tendency,a_tendency, &
   config_flags,base_3d,alt,a_alt,mut,a_mut,rdn,rdnw,kvdif,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
   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,alt,a_alt,base_3d
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut
   REAL,DIMENSION(kms:kme) :: rdn,rdnw
   REAL :: kvdif
   INTEGER :: i,j,k,itf,jtf,ktf
   INTEGER :: i_start,i_end,j_start,j_end
   REAL,DIMENSION(its:ite,0:kte+1) :: vflux,a_vflux
!   REAL :: rdz,a_rdz  ! Remarked by Ning Pan, 2010-07-23
   LOGICAL :: specified

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv300
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv301
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv302
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv303
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv304  ! Added by Ning Pan, 2010-07-23

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

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

!!LPB[3]
!   j_loop_s : DO j = j_start, j_end

!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))     &
!                       *(   field(i,k+1,j)  -field(i,k,j)                 &
!                         -base_3d(i,k+1,j)+base_3d(i,k,j) )
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,0)=vflux(i,1)
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts,ktf
!          DO i = i_start, i_end
!            tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)    &
!                   *rdnw(k)*(vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO

!    ENDDO j_loop_s

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K1_ADJ =0, kte+1
   Do K0_ADJ =its, ite
   a_vflux(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

!   a_rdz =0.0  ! Remarked by Ning Pan, 2010-07-23

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]
   DO j =j_end, j_start, -1

   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i,k+1,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv304(i,k) =Tmpv002
   Tmpv003 =kvdif*rdn(k+1)/Tmpv002
   Tmpv004 =field(i,k+1,j) -field(i,k,j)
   Tmpv005 =Tmpv004 -base_3d(i,k+1,j)
   Tmpv006 =Tmpv005 +base_3d(i,k,j)
   Tmpv300(i,k) =Tmpv003
   Tmpv301(i,k) =Tmpv006
   Tmpv007 =Tmpv300(i,k)*Tmpv301(i,k)
   vflux(i,k) =Tmpv007

   ENDDO
   ENDDO
   DO i =i_start, i_end
   vflux(i,0) =vflux(i,1)

   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts, ktf
   DO i =i_start, i_end
   Tmpv001 =g*g/mut(i,j)/alt(i,k,j)
   Tmpv002 =Tmpv001*rdnw(k)
   Tmpv003 =vflux(i,k) -vflux(i,k-1)
   Tmpv302(i,k) =Tmpv002
   Tmpv303(i,k) =Tmpv003
! Remarked by Ning Pan, 2010-07-23
!   Tmpv004 =Tmpv302(i,k)*Tmpv303(i,k)
!   Tmpv005 =tendency(i,k,j) +Tmpv004
!!  tendency(i,k,j) =Tmpv005

   ENDDO
   ENDDO

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv5 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv2 =Tmpv303(i,k)*a_Tmpv4
   a_Tmpv3 =Tmpv302(i,k)*a_Tmpv4
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv3
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv3
   a_Tmpv1 =rdnw(k)*a_Tmpv2
   a_mut(i,j) =a_mut(i,j) -g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*a_Tmpv1
   a_alt(i,k,j) =a_alt(i,k,j) -g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*a_Tmpv1
   ENDDO
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,1) =a_vflux(i,1) +a_vflux(i,0)
   a_vflux(i,0) =0.0
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv7 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_Tmpv3 =Tmpv301(i,k)*a_Tmpv7
   a_Tmpv6 =Tmpv300(i,k)*a_Tmpv7
   a_Tmpv5 =a_Tmpv6
   a_Tmpv4 =a_Tmpv5
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv4
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv4
! Revised by Ning Pan, 2010-07-23
!   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv002*Tmpv002)
   a_Tmpv2 =-(kvdif*rdn(k+1))*a_Tmpv3/(Tmpv304(i,k)*Tmpv304(i,k))
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i,k+1,j) =a_alt(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =min(ite, ide-1)
!  j_start =jts
!  j_end =min(jte, jde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_vertical_diffusion_3dmp

   SUBROUTINE a_vertical_diffusion_u(field,a_field,tendency,a_tendency, &
   config_flags,u_base,alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,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
   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,alt,a_alt
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu
   REAL,DIMENSION(kms:kme) :: rdn,rdnw,u_base
   REAL :: kvdif
   INTEGER :: i,j,k,itf,jtf,ktf
   INTEGER :: i_start,i_end,j_start,j_end
   REAL,DIMENSION(its:ite,0:kte+1) :: vflux,a_vflux
!   REAL :: rdz,a_rdz,zz,a_zz  ! Remarked by Ning Pan, 2010-07-23
   LOGICAL :: specified

   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
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv300
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv301
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv302
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv303
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv304
   REAL,DIMENSION(its:ite,kts:min(kte,kde-1)-1) :: Tmpv305  ! Added by Ning Pan, 2010-07-23

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

!LPB[2]
      ktf=MIN(kte,kde-1)
         i_start = its
         i_end   = ite
         j_start = jts
         j_end   = MIN(jte,jde-1)

!LPB[3]
      IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its)

!LPB[4]

!LPB[5]
      IF ( config_flags%open_xe .or. specified ) i_end   = MIN(ide-1,ite)

!LPB[6]

!LPB[7]
      IF ( config_flags%periodic_x ) i_start = its

!LPB[8]

!LPB[9]
      IF ( config_flags%periodic_x ) i_end = ite

!!LPB[10]
!   j_loop_u : DO j = j_start, j_end

!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i  ,k  ,j)        &
!                                           +alt(i-1,k  ,j)        &
!                                           +alt(i  ,k+1,j)        &
!                                           +alt(i-1,k+1,j) ) )    &
!                                *(field(i,k+1,j)-field(i,k,j)     &
!                                  -u_base(k+1)   +u_base(k)  )
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,0)=vflux(i,1)
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            tendency(i,k,j)=tendency(i,k,j)+                               &
!                   g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))*   &
!                                 (vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO

!    ENDDO j_loop_u

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K1_ADJ =0, kte+1
   Do K0_ADJ =its, ite
   a_vflux(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

! Remarked by Ning Pan, 2010-07-23
!   a_rdz =0.0
!   a_zz =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[10]
   DO j =j_end, j_start, -1

   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i-1,k,j)
   Tmpv002 =Tmpv001 +alt(i,k+1,j)
   Tmpv003 =Tmpv002 +alt(i-1,k+1,j)
   Tmpv004 =0.25*Tmpv003
   Tmpv305(i,k) =Tmpv004  ! Added by Ning Pan, 2010-07-23
   Tmpv005 =kvdif*rdn(k+1)/Tmpv004
   Tmpv006 =field(i,k+1,j) -field(i,k,j)
   Tmpv007 =Tmpv006 -u_base(k+1)
   Tmpv008 =Tmpv007 +u_base(k)
   Tmpv300(i,k) =Tmpv005
   Tmpv301(i,k) =Tmpv008
   Tmpv009 =Tmpv300(i,k)*Tmpv301(i,k)
   vflux(i,k) =Tmpv009

   ENDDO
   ENDDO
   DO i =i_start, i_end
   vflux(i,0) =vflux(i,1)

   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i-1,k,j) +alt(i,k,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv302(i,k) =Tmpv002
   Tmpv003 =g*g*rdnw(k)/muu(i,j)/Tmpv302(i,k)
   Tmpv004 =vflux(i,k) -vflux(i,k-1)
   Tmpv303(i,k) =Tmpv003
   Tmpv304(i,k) =Tmpv004
! Remarked by Ning Pan, 2010-07-23
!   Tmpv005 =Tmpv303(i,k)*Tmpv304(i,k)
!   Tmpv006 =tendency(i,k,j) +Tmpv005
!!  tendency(i,k,j) =Tmpv006

   ENDDO
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv6 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv6
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =Tmpv304(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv303(i,k)*a_Tmpv5
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv4
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv4
   a_muu(i,j) =a_muu(i,j) -g*g*rdnw(k)/(muu(i,j)*muu(i,j))/Tmpv302(i,k)*a_Tmpv3
   a_Tmpv2 =-g*g*rdnw(k)/muu(i,j)/(Tmpv302(i,k)*Tmpv302(i,k))*a_Tmpv3
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i-1,k,j) =a_alt(i-1,k,j) +a_Tmpv1
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,1) =a_vflux(i,1) +a_vflux(i,0)
   a_vflux(i,0) =0.0
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv9 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_Tmpv5 =Tmpv301(i,k)*a_Tmpv9
   a_Tmpv8 =Tmpv300(i,k)*a_Tmpv9
   a_Tmpv7 =a_Tmpv8
   a_Tmpv6 =a_Tmpv7
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv6
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv6
! Revised by Ning Pan, 2010-07-23
!   a_Tmpv4 =-(kvdif*rdn(k+1))*a_Tmpv5/(Tmpv004*Tmpv004)
   a_Tmpv4 =-(kvdif*rdn(k+1))*a_Tmpv5/(Tmpv305(i,k)*Tmpv305(i,k))
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_alt(i-1,k+1,j) =a_alt(i-1,k+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_alt(i,k+1,j) =a_alt(i,k+1,j) +a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i-1,k,j) =a_alt(i-1,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[9]

!  IF( config_flags%periodic_x ) THEN
!  i_end =ite
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[8]

!LPB[7]

!  IF( config_flags%periodic_x ) THEN
!  i_start =its
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[6]

!LPB[5]

!  IF( config_flags%open_xe .or. specified ) THEN
!  i_end =min(ide-1, ite)
!  END IF

!  IF( config_flags%open_xe .or. specified ) THEN

!  END IF

!LPB[4]

!LPB[3]

!  IF( config_flags%open_xs .or. specified ) THEN
!  i_start =max(ids+1, its)
!  END IF

!  IF( config_flags%open_xs .or. specified ) THEN

!  END IF

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =ite
!  j_start =jts
!  j_end =min(jte, jde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_vertical_diffusion_u

   SUBROUTINE a_vertical_diffusion_v(field,a_field,tendency,a_tendency, &
   config_flags,v_base,alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,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
   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,alt,a_alt
   REAL,DIMENSION(kms:kme) :: rdn,rdnw,v_base
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,jms:jme) :: muv,a_muv
   REAL :: kvdif
   INTEGER :: i,j,k,itf,jtf,ktf,jm1
   INTEGER :: i_start,i_end,j_start,j_end
   REAL,DIMENSION(its:ite,0:kte+1) :: vflux,a_vflux
!   REAL :: rdz,a_rdz,zz,a_zz  ! Remarked by Ning Pan, 2010-07-23
   LOGICAL :: specified

   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
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv300
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv301
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv302
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv303
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv304
   REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv305  ! Added by Ning Pan, 2010-07-23

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

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

!LPB[3]
      IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts)

!LPB[4]

!LPB[5]
      IF ( config_flags%open_ye .or. specified ) j_end   = MIN(jde-1,jte)

!!LPB[6]
!   j_loop_v : DO j = j_start, j_end

!        jm1 = j-1

!        DO k=kts,ktf-1
!          DO i = i_start, i_end
!            vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i,k  ,j  )        &
!                                           +alt(i,k  ,jm1)        &
!                                           +alt(i,k+1,j  )        &
!                                           +alt(i,k+1,jm1) ) )    &
!                                *(field(i,k+1,j)-field(i,k,j)     &
!                                  -v_base(k+1)   +v_base(k)  )
!          ENDDO
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,0)=vflux(i,1)
!        ENDDO

!        DO i = i_start, i_end
!          vflux(i,ktf)=0.
!        ENDDO

!        DO k=kts,ktf-1
!          DO i = i_start, i_end 
!            tendency(i,k,j)=tendency(i,k,j)+                                &
!                   g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*    &
!                                 (vflux(i,k)-vflux(i,k-1))
!          ENDDO
!        ENDDO

!    ENDDO j_loop_v

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K1_ADJ =0, kte+1
   Do K0_ADJ =its, ite
   a_vflux(K0_ADJ,K1_ADJ) =0.0
   End Do
   End Do

! Remarked by Ning Pan, 2010-07-23
!   a_rdz =0.0
!   a_zz =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[6]
   DO j =j_end, j_start, -1

   jm1 =j-1
   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,j) +alt(i,k,jm1)
   Tmpv002 =Tmpv001 +alt(i,k+1,j)
   Tmpv003 =Tmpv002 +alt(i,k+1,jm1)
   Tmpv004 =0.25*Tmpv003
   Tmpv305(i,k) =Tmpv004  ! Added by Ning Pan, 2010-07-23
   Tmpv005 =kvdif*rdn(k+1)/Tmpv004
   Tmpv006 =field(i,k+1,j) -field(i,k,j)
   Tmpv007 =Tmpv006 -v_base(k+1)
   Tmpv008 =Tmpv007 +v_base(k)
   Tmpv300(i,k) =Tmpv005
   Tmpv301(i,k) =Tmpv008
   Tmpv009 =Tmpv300(i,k)*Tmpv301(i,k)
   vflux(i,k) =Tmpv009

   ENDDO
   ENDDO
   DO i =i_start, i_end
   vflux(i,0) =vflux(i,1)

   ENDDO

   DO i =i_start, i_end
   vflux(i,ktf) =0.

   ENDDO

   DO k =kts, ktf-1
   DO i =i_start, i_end
   Tmpv001 =alt(i,k,jm1) +alt(i,k,j)
   Tmpv002 =0.5*Tmpv001
   Tmpv302(i,k) =Tmpv002
   Tmpv003 =g*g*rdnw(k)/muv(i,j)/Tmpv302(i,k)
   Tmpv004 =vflux(i,k) -vflux(i,k-1)
   Tmpv303(i,k) =Tmpv003
   Tmpv304(i,k) =Tmpv004
! Remarked by Ning Pan, 2010-07-23
!   Tmpv005 =Tmpv303(i,k)*Tmpv304(i,k)
!   Tmpv006 =tendency(i,k,j) +Tmpv005
!!  tendency(i,k,j) =Tmpv006

   ENDDO
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv6 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv6
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =Tmpv304(i,k)*a_Tmpv5
   a_Tmpv4 =Tmpv303(i,k)*a_Tmpv5
   a_vflux(i,k) =a_vflux(i,k) +a_Tmpv4
   a_vflux(i,k-1) =a_vflux(i,k-1) -a_Tmpv4
   a_muv(i,j) =a_muv(i,j) -g*g*rdnw(k)/(muv(i,j)*muv(i,j))/Tmpv302(i,k)*a_Tmpv3
   a_Tmpv2 =-g*g*rdnw(k)/muv(i,j)/(Tmpv302(i,k)*Tmpv302(i,k))*a_Tmpv3
   a_Tmpv1 =0.5*a_Tmpv2
   a_alt(i,k,jm1) =a_alt(i,k,jm1) +a_Tmpv1
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,ktf) =0.0
   ENDDO

   DO i =i_end, i_start, -1
   a_vflux(i,1) =a_vflux(i,1) +a_vflux(i,0)
   a_vflux(i,0) =0.0
   ENDDO

   DO k =ktf-1, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv9 =a_vflux(i,k)
   a_vflux(i,k) =0.0
   a_Tmpv5 =Tmpv301(i,k)*a_Tmpv9
   a_Tmpv8 =Tmpv300(i,k)*a_Tmpv9
   a_Tmpv7 =a_Tmpv8
   a_Tmpv6 =a_Tmpv7
   a_field(i,k+1,j) =a_field(i,k+1,j) +a_Tmpv6
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv6
! Revised by Ning Pan, 2010-07-23
!   a_Tmpv4 =-(kvdif*rdn(k+1))*a_Tmpv5/(Tmpv004*Tmpv004)
   a_Tmpv4 =-(kvdif*rdn(k+1))*a_Tmpv5/(Tmpv305(i,k)*Tmpv305(i,k))
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_alt(i,k+1,jm1) =a_alt(i,k+1,jm1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_alt(i,k+1,j) =a_alt(i,k+1,j) +a_Tmpv2
   a_alt(i,k,j) =a_alt(i,k,j) +a_Tmpv1
   a_alt(i,k,jm1) =a_alt(i,k,jm1) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[5]

!  IF( config_flags%open_ye .or. specified ) THEN
!  j_end =min(jde-1, jte)
!  END IF

!  IF( config_flags%open_ye .or. specified ) THEN

!  END IF

!LPB[4]

!LPB[3]

!  IF( config_flags%open_ys .or. specified ) THEN
!  j_start =max(jds+1, jts)
!  END IF

!  IF( config_flags%open_ys .or. specified ) THEN

!  END IF

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =min(ite, ide-1)
!  j_start =jts
!  j_end =min(jte, jde-1)

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_vertical_diffusion_v

SUBROUTINE a_calculate_full ( a_rfield, a_rfieldp, &
                              ids, ide, jds, jde, kds, kde, &
                              ims, ime, jms, jme, kms, kme, &
                              its, ite, jts, jte, kts, kte )

   IMPLICIT NONE
   
   ! Input data
   
   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(INOUT) :: a_rfieldp
   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: a_rfield
   
   ! Local indices.
   
   INTEGER :: i, j, k, itf, jtf, ktf
   
!<DESCRIPTION>
!
!  calculate_full
!  calculates full 3D field from pertubation and base field.
!
!</DESCRIPTION>

   itf=MIN(ite,ide-1)
   jtf=MIN(jte,jde-1)
   ktf=MIN(kte,kde-1)

   DO j=jts,jtf
   DO k=kts,ktf
   DO i=its,itf
      a_rfieldp(i,k,j)=a_rfieldp(i,k,j) + a_rfield(i,k,j)
      a_rfield(i,k,j)=0.
   ENDDO
   ENDDO
   ENDDO

END SUBROUTINE a_calculate_full

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of coriolis in reverse (adjoint) mode:
!   gradient     of useful results: ru_tend rw_tend ru rv rw rv_tend
!   with respect to varying inputs: ru_tend rw_tend ru rv rw rv_tend
!   RW status of diff variables: ru_tend:in-out rw_tend:in-out
!                ru:incr rv:incr rw:incr rv_tend:in-out
SUBROUTINE A_CORIOLIS(ru, rub, rv, rvb, rw, rwb, ru_tend, ru_tendb, &
&  rv_tend, rv_tendb, rw_tend, rw_tendb, config_flags, msftx, msfty, &
&  msfux, msfuy, msfvx, msfvy, f, e, sina, cosa, fzm, fzp, 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(INOUT) :: ru_tend, &
&  rv_tend, rw_tend
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ru_tendb, rv_tendb, &
&  rw_tendb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ru, rv, rw
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rub, rvb, rwb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: f, e, sina, cosa
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp
! Local indices.
  INTEGER :: i, j, k, ktf
  INTEGER :: i_start, i_end, j_start, j_end
  LOGICAL :: specified
  INTEGER :: ad_to
  INTEGER :: ad_to0
  INTEGER :: min4
  INTEGER :: min3
  INTEGER :: min2
  INTEGER :: min1
  REAL :: tempb5
  REAL :: tempb4
  REAL :: tempb3
  REAL :: tempb2
  REAL :: tempb1
  REAL :: tempb0
  REAL :: tempb
!<DESCRIPTION>
!
!  coriolis calculates the large timestep tendency terms in the 
!  u, v, and w momentum equations arise from the coriolis force.
!
!</DESCRIPTION>
  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
! coriolis for u-momentum equation
!  Notes on map scale factor
!  cosa, sina are related to rotating the coordinate frame if desired
!  generally sina=0, cosa=1
!  ADT eqn 44, RHS terms 6 and 7: -2 mu w omega cos(lat)/my
!                                + 2 mu v omega sin(lat)/my
!  Define f=2 omega sin(lat), e=2 omega cos(lat)
!   => terms are: -e mu w / my + f mu v / my
!  rv = mu v / mx ; rw = mu w / my
!   => terms are: -e rw + f rv *mx / my
  i_start = its
  i_end = ite
  IF ((config_flags%open_xs .OR. specified) .OR. config_flags%nested) &
&  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) .OR. config_flags%nested) &
&  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 (jte .GT. jde - 1) THEN
    min1 = jde - 1
  ELSE
    min1 = jte
  END IF
! boundary loops for coriolis not needed for open bdy  (commented out 20100611 JD)
!  IF ( (config_flags%open_xs) .and. (its == ids) ) THEN
!    DO k=kts,ktf
!  
!      ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j))   &
!        *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) &
!            - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) &
!        *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
!    ENDDO
!  ENDIF
!  IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN
!    DO k=kts,ktf
!  
!      ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) &
!        *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) &
!            - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) &
!        *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
!    ENDDO
!  ENDIF
!  coriolis term for v-momentum equation
!  Notes on map scale factors
!  ADT eqn 45, RHS terms 6 and 6b [0 for sina=0]: -2 mu u omega sin(lat)/mx + ?
!  Define f=2 omega sin(lat), e=2 omega cos(lat)
!   => terms are: -f mu u / mx
!  ru = mu u / my ; rw = mu w / my
!   => terms are: -f ru *my / mx + ?
  j_start = jts
  j_end = jte
  IF (((config_flags%open_ys .OR. specified) .OR. config_flags%nested) &
&      .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%nested) &
&      .OR. config_flags%polar) THEN
    IF (jde - 1 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1
    END IF
  END IF
! boundary loops for coriolis not needed for open bdy  (commented out 20100611 JD)
!  IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN
!    DO k=kts,ktf
!    DO i=its,MIN(ide-1,ite)
!  
!       rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts))    &
!        *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))   &
!            + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))   &
!            *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
!    ENDDO
!    ENDDO
!  ENDIF
  DO j=j_start,j_end
    DO k=kts,ktf
      IF (ide - 1 .GT. ite) THEN
        min2 = ite
      ELSE
        min2 = ide - 1
      END IF
      i = min2 + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
  END DO
  IF (jte .GT. jde - 1) THEN
    min3 = jde - 1
  ELSE
    min3 = jte
  END IF
! boundary loops for coriolis not needed for open bdy  (commented out 20100611 JD)
!  IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN
!    DO k=kts,ktf
!    DO i=its,MIN(ide-1,ite)
!  
!       rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1))        &
!        *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))   &
!            + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))   &
!            *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
!    ENDDO
!    ENDDO
!  ENDIF
! coriolis term for w-mometum 
! Notes on map scale factors
! ADT eqn 46/my, RHS terms 5 and 5b [0 for sina=0]: 2 mu u omega cos(lat)/my +?
! Define e=2 omega cos(lat)
!  => terms are: e mu u / my + ???
! ru = mu u / my ; ru = mu v / mx
!  => terms are: e ru + ???
  DO j=jts,min3
    DO k=kts+1,ktf
      IF (ite .GT. ide - 1) THEN
        min4 = ide - 1
      ELSE
        min4 = ite
      END IF
      i = min4 + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
  END DO
  DO j=min3,jts,-1
    DO k=ktf,kts+1,-1
      CALL POPINTEGER4(ad_to0)
      DO i=ad_to0,its,-1
        tempb3 = e(i, j)*rw_tendb(i, k, j)
        tempb4 = cosa(i, j)*0.5*tempb3
        tempb5 = -(msftx(i, j)*0.5*sina(i, j)*tempb3/msfty(i, j))
        rub(i, k, j) = rub(i, k, j) + fzm(k)*tempb4
        rub(i+1, k, j) = rub(i+1, k, j) + fzm(k)*tempb4
        rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*tempb4
        rub(i+1, k-1, j) = rub(i+1, k-1, j) + fzp(k)*tempb4
        rvb(i, k, j) = rvb(i, k, j) + fzm(k)*tempb5
        rvb(i, k, j+1) = rvb(i, k, j+1) + fzm(k)*tempb5
        rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*tempb5
        rvb(i, k-1, j+1) = rvb(i, k-1, j+1) + fzp(k)*tempb5
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_to)
      DO i=ad_to,its,-1
        tempb1 = -(msfvy(i, j)*0.25*0.5*(f(i, j)+f(i, j-1))*rv_tendb(i, &
&          k, j)/msfvx(i, j))
        tempb2 = (e(i, j)+e(i, j-1))*(sina(i, j)+sina(i, j-1))*msfvy(i, &
&          j)*0.5**2*0.25*rv_tendb(i, k, j)/msfvx(i, j)
        rub(i, k, j) = rub(i, k, j) + tempb1
        rub(i+1, k, j) = rub(i+1, k, j) + tempb1
        rub(i, k, j-1) = rub(i, k, j-1) + tempb1
        rub(i+1, k, j-1) = rub(i+1, k, j-1) + tempb1
        rwb(i, k+1, j-1) = rwb(i, k+1, j-1) + tempb2
        rwb(i, k, j-1) = rwb(i, k, j-1) + tempb2
        rwb(i, k+1, j) = rwb(i, k+1, j) + tempb2
        rwb(i, k, j) = rwb(i, k, j) + tempb2
      END DO
    END DO
  END DO
  DO j=min1,jts,-1
    DO k=ktf,kts,-1
      DO i=i_end,i_start,-1
        tempb = msfux(i, j)*0.25*0.5*(f(i, j)+f(i-1, j))*ru_tendb(i, k, &
&          j)/msfuy(i, j)
        tempb0 = -((e(i, j)+e(i-1, j))*0.5**2*0.25*(cosa(i, j)+cosa(i-1&
&          , j))*ru_tendb(i, k, j))
        rvb(i-1, k, j+1) = rvb(i-1, k, j+1) + tempb
        rvb(i, k, j+1) = rvb(i, k, j+1) + tempb
        rvb(i-1, k, j) = rvb(i-1, k, j) + tempb
        rvb(i, k, j) = rvb(i, k, j) + tempb
        rwb(i-1, k+1, j) = rwb(i-1, k+1, j) + tempb0
        rwb(i-1, k, j) = rwb(i-1, k, j) + tempb0
        rwb(i, k+1, j) = rwb(i, k+1, j) + tempb0
        rwb(i, k, j) = rwb(i, k, j) + tempb0
      END DO
    END DO
  END DO
END SUBROUTINE A_CORIOLIS

   SUBROUTINE a_perturbation_coriolis(ru_in,a_ru_in,rv_in,a_rv_in,rw,a_rw, &
   ru_tend,a_ru_tend,rv_tend,a_rv_tend,rw_tend,a_rw_tend,config_flags,u_base, &
   v_base,z_base,muu,a_muu,muv,a_muv,phb,ph,a_ph,msftx,msfty,msfux,msfuy,msfvx, &
   msfvy,f,e,sina,cosa,fzm,fzp,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
   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) :: ru_tend,a_ru_tend,rv_tend,a_rv_tend, &
   rw_tend,a_rw_tend
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_in,a_ru_in,rv_in,a_rv_in,rw,a_rw, &
   ph,a_ph,phb
   REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty
   REAL,DIMENSION(ims:ime,jms:jme) :: f,e,sina,cosa
   REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv
   REAL,DIMENSION(kms:kme) :: fzm,fzp
   REAL,DIMENSION(kms:kme) :: u_base,v_base,z_base
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv
   REAL :: z_at_u,a_z_at_u,z_at_v,a_z_at_v,wkp1,a_wkp1,wk,a_wk,wkm1,a_wkm1
   INTEGER :: i,j,k,ktf
   INTEGER :: i_start,i_end,j_start,j_end
   LOGICAL :: specified

!REVISED BY WALLS
!  REAL,DIMENSION(jts:Tmpv001) :: Keep_Lpb11_wkp1
   REAL,DIMENSION(jts:jme) :: Keep_Lpb11_wkp1
   REAL,DIMENSION(jts:jme) :: Keep_Lpb11_wk
   REAL,DIMENSION(jts:jme) :: Keep_Lpb11_wkm1   
   REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb17_wkp1   
   REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb17_wkm1   
   REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb17_wk   
!  REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb18_wkp1   
!  REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb18_wk   
!  REAL,DIMENSION(max(jds+1,jts)-1:min(jde-1,jte)) :: Keep_Lpb18_wkm1   
   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,a_Tmpv13,Tmpv013, &
   a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015
!REVISED BY WALLS
!  REAL,DIMENSION(min0(its-1,its):ite) :: Tmpv200
   REAL,DIMENSION(min0(its-1,its):ite) :: Tmpv200
   REAL,DIMENSION(min0(its-1,its):ite) :: Tmpv201
   REAL,DIMENSION(min0(its-1,its):ite,kts+1:min(kte,kde-1)-1) :: Tmpv300
! Added by Ning Pan, 2010-07-22
   REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts:min(jte,jde-1)+1) :: Tmpv400
   REAL,DIMENSION(its-1:ite,kts:min(kte,kde-1),jts:min(jte,jde-1)+1) :: Tmpv401
   REAL,DIMENSION(its:min(ite,ide-1)+1,kts:min(kte,kde-1),jts-1:jte) :: Tmpv500
   REAL,DIMENSION(its:min(ite,ide-1)+1,kts:min(kte,kde-1),jts-1:jte) :: Tmpv501

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
      specified = .false.

!LPB[1]
   if(config_flags%specified .or. config_flags%nested) specified = .true.

!LPB[2]
      ktf=MIN(kte,kde-1)

      i_start = its
      i_end   = ite

!LPB[3]
   IF ( config_flags%open_xs .or. specified .or.   &
        config_flags%nested) i_start = MAX(ids+1,its)

!LPB[4]

!LPB[5]
   IF ( config_flags%open_xe .or. specified .or.   &
        config_flags%nested) i_end   = MIN(ide-1,ite)

!LPB[6]

!LPB[7]
      IF ( config_flags%periodic_x ) i_start = its

!LPB[8]

!LPB[9]
      IF ( config_flags%periodic_x ) i_end = ite

!LPB[10]
      DO j = jts, MIN(jte,jde-1)+1

      DO k=kts+1,ktf-1
      DO i = i_start-1, i_end
        z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )    &
                       +phb(i,k,j-1)+phb(i,k+1,j-1)    &
                       +ph(i,k,j  )+ph(i,k+1,j  )      &
                       +ph(i,k,j-1)+ph(i,k+1,j-1))/g
        wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
        wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
        wk   = 1.-wkp1-wkm1

! Revised by Ning Pan, 2010-07-22 
!        rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(              &
!                                     wkm1*v_base(k-1)      &
!                                    +wk  *v_base(k  )      &
!                                    +wkp1*v_base(k+1)   )
        Tmpv001 =wkm1*v_base(k-1) +wk*v_base(k)
        Tmpv002 =Tmpv001 +wkp1*v_base(k+1)
        Tmpv400(i,k,j) =Tmpv002
        Tmpv003 =muv(i,j)*Tmpv400(i,k,j)
        Tmpv004 =rv_in(i,k,j) -Tmpv003
        rv(i,k,j) =Tmpv004
        Tmpv401(i,k,j) =z_at_v

      ENDDO
      ENDDO

      ENDDO

!LPB[11]
      DO j = jts, MIN(jte,jde-1)+1

! Remarked by Ning Pan, 2010-07-22
!       Keep_Lpb11_wkp1(j) =wkp1
!       Keep_Lpb11_wk(j) =wk
!       Keep_Lpb11_wkm1(j) =wkm1

      DO i = i_start-1, i_end
        k = kts
        z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )    &
                       +phb(i,k,j-1)+phb(i,k+1,j-1)    &
                       +ph(i,k,j  )+ph(i,k+1,j  )      &
                       +ph(i,k,j-1)+ph(i,k+1,j-1))/g
        wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
        wk   = 1.-wkp1
! Revised by Ning Pan, 2010-07-22
!        rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(              &
!                                    +wk  *v_base(k  )      &
!                                    +wkp1*v_base(k+1)   )
        Tmpv001 =+wk*v_base(k) +wkp1*v_base(k+1)
        Tmpv400(i,k,j) =Tmpv001
        Tmpv002 =muv(i,j)*Tmpv400(i,k,j)
        Tmpv003 =rv_in(i,k,j) -Tmpv002
        rv(i,k,j) =Tmpv003
        Tmpv401(i,k,j) =z_at_v

        k = ktf
        z_at_v = 0.25*( phb(i,k,j  )+phb(i,k+1,j  )    &
                       +phb(i,k,j-1)+phb(i,k+1,j-1)    &
                       +ph(i,k,j  )+ph(i,k+1,j  )      &
                       +ph(i,k,j-1)+ph(i,k+1,j-1))/g
        wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
        wk   = 1.-wkm1
! Revised by Ning Pan, 2010-07-22
!        rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*(              &
!                                     wkm1*v_base(k-1)      &
!                                    +wk  *v_base(k  )   )
        Tmpv001 =wkm1*v_base(k-1) +wk*v_base(k)
        Tmpv400(i,k,j) =Tmpv001
        Tmpv002 =muv(i,j)*Tmpv400(i,k,j)
        Tmpv003 =rv_in(i,k,j) -Tmpv002
        rv(i,k,j) =Tmpv003
        Tmpv401(i,k,j) =z_at_v

      ENDDO

      ENDDO

! Remarked by Ning Pan, 2010-07-22: LPB[12] is useless
!LPB[12]
!      DO j = jts, MIN(jte,jde-1)

!      DO k=kts,ktf
!        DO i = i_start, i_end
!          ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) &
!REVISED! BY WALLS
!!     &
!            *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))   &
!                - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j))   &
!            *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
!        ENDDO
!      ENDDO
!   IF ( (config_flags%open_xs) .and. (its == ids) ) THEN

!        DO k=kts,ktf
!          ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j) &
!   +f(its,j))     &
!            *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j))   &
!                - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j))   &
!            *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
!        ENDDO
!      ENDIF
!   IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN

!        DO k=kts,ktf
!          ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1, &
!   j)+f(ite-1,j))   &
!            *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j))   &
!                - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j))   &
!            *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j))
!        ENDDO
!      ENDIF

!      ENDDO

!LPB[13]
      j_start = jts
      j_end   = jte

!LPB[14]
   IF ( config_flags%open_ys .or. specified .or.   &
        config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts)

!LPB[15]

!LPB[16]
   IF ( config_flags%open_ye .or. specified .or.   &
        config_flags%nested .or. config_flags%polar) j_end   = MIN(jde-1,jte)

!LPB[17]
      DO j = j_start-1,j_end

! Remarked by Ning Pan, 2010-07-22
!       Keep_Lpb17_wkp1(j) =wkp1
!       Keep_Lpb17_wkm1(j) =wkm1
!       Keep_Lpb17_wk(j) =wk

      DO k=kts+1,ktf-1
      DO i = its, MIN(ite,ide-1)+1
        z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)    &
                       +phb(i-1,k,j)+phb(i-1,k+1,j)    &
                       +ph(i  ,k,j)+ph(i  ,k+1,j)      &
                       +ph(i-1,k,j)+ph(i-1,k+1,j))/g
        wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
        wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
        wk   = 1.-wkp1-wkm1
! Revised by Ning Pan, 2010-07-22
!        ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(              &
!                                     wkm1*u_base(k-1)      &
!                                    +wk  *u_base(k  )      &
!                                    +wkp1*u_base(k+1)   )
        Tmpv001 =wkm1*u_base(k-1) +wk*u_base(k)
        Tmpv002 =Tmpv001 +wkp1*u_base(k+1)
        Tmpv500(i,k,j) =Tmpv002
        Tmpv003 =muu(i,j)*Tmpv500(i,k,j)
        Tmpv004 =ru_in(i,k,j) -Tmpv003
        ru(i,k,j) =Tmpv004
        Tmpv501(i,k,j) =z_at_u

      ENDDO
      ENDDO

      ENDDO

!!LPB[18]
      DO j = j_start-1,j_end

    !  Keep_Lpb18_wkp1(j) =wkp1
    !  Keep_Lpb18_wk(j) =wk
    !  Keep_Lpb18_wkm1(j) =wkm1

      DO i = its, MIN(ite,ide-1)+1
        k = kts
        z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)    &
                       +phb(i-1,k,j)+phb(i-1,k+1,j)    &
                       +ph(i  ,k,j)+ph(i  ,k+1,j)      &
                       +ph(i-1,k,j)+ph(i-1,k+1,j))/g
        wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
        wk   = 1.-wkp1
! Revised by Ning Pan, 2010-07-22
!        ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(              &
!                                    +wk  *u_base(k  )      &
!                                    +wkp1*u_base(k+1)   )
        Tmpv001 =+wk*u_base(k) +wkp1*u_base(k+1)
        Tmpv500(i,k,j) =Tmpv001
        Tmpv002 =muu(i,j)*Tmpv500(i,k,j)
        Tmpv003 =ru_in(i,k,j) -Tmpv002
        ru(i,k,j) =Tmpv003
        Tmpv501(i,k,j) =z_at_u

        k = ktf
        z_at_u = 0.25*( phb(i  ,k,j)+phb(i  ,k+1,j)    &
                       +phb(i-1,k,j)+phb(i-1,k+1,j)    &
                       +ph(i  ,k,j)+ph(i  ,k+1,j)      &
                       +ph(i-1,k,j)+ph(i-1,k+1,j))/g
        wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
        wk   = 1.-wkm1
! Revised by Ning Pan, 2010-07-22
!        ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*(              &
!                                     wkm1*u_base(k-1)      &
!                                    +wk  *u_base(k  )   )
        Tmpv001 =wkm1*u_base(k-1) +wk*u_base(k)
        Tmpv500(i,k,j) =Tmpv001
        Tmpv002 =muu(i,j)*Tmpv500(i,k,j)
        Tmpv003 =ru_in(i,k,j) -Tmpv002
        ru(i,k,j) =Tmpv003
        Tmpv501(i,k,j) =z_at_u

      ENDDO

      ENDDO

!!LPB[19]

! Remarked by Ning Pan, 2010-07-22: LPB[20]-[24] are useless
!!LPB[20]
!   IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN

!        DO k=kts,ktf
!        DO i=its,MIN(ide-1,ite)
!           rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts) &
!   +f(i,jts))      &
!            *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))     &
!                + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts) &
!   +sina(i,jts))     &
!                *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) 
!        ENDDO
!        ENDDO

!   ENDIF

!!LPB[21]
!      DO j=j_start, j_end

!   
!      DO k=kts,ktf
!      DO i=its,MIN(ide-1,ite)
!         rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1)) &
!         &
!          *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))   &
!              + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j) &
!   +sina(i,j-1))   &
!              *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) 
!      ENDDO
!      ENDDO

!      ENDDO

!!LPB[22]

!!LPB[23]
!   IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN

!        DO k=kts,ktf
!        DO i=its,MIN(ide-1,ite)
!           rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte)) &
!   *0.5*(f(i,jte-1)+f(i,jte-1))          &
!            *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1))     &
!                + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i, &
!   jte-1)+sina(i,jte-1))     &
!                *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) 
!        ENDDO
!        ENDDO

!   ENDIF

!!LPB[24]
!      DO j=jts,MIN(jte, jde-1)

!   
!      DO k=kts+1,ktf
!      DO i=its,MIN(ite, ide-1)
!          rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)*             &
!             (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))   &
!             +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))             &
!             -(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))   &
!             +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
!      ENDDO
!      ENDDO

!      ENDDO

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   Do K2_ADJ =jms, jme
   Do K1_ADJ =kms, kme
   Do K0_ADJ =ims, ime
   a_ru(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   Do K2_ADJ =jms, jme
   Do K1_ADJ =kms, kme
   Do K0_ADJ =ims, ime
   a_rv(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
   End Do
   End Do
   End Do

   a_z_at_u =0.0
   a_z_at_v =0.0
   a_wkp1 =0.0
   a_wk =0.0
   a_wkm1 =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[24]
!  coriolis term for w-momentum equation
   DO j =min(jte, jde-1), jts, -1

!  DO k =kts+1, ktf
!  DO i =its, min(ite, ide-1)
!  Tmpv001 =ru(i,k,j) +ru(i+1,k,j)
!  Tmpv002 =fzm(k)*Tmpv001
!  Tmpv003 =ru(i,k-1,j) +ru(i+1,k-1,j)
!  Tmpv004 =fzp(k)*Tmpv003
!  Tmpv005 =Tmpv002 +Tmpv004
!  Tmpv006 =cosa(i,j)*0.5*Tmpv005
!  Tmpv007 =rv(i,k,j) +rv(i,k,j+1)
!  Tmpv008 =fzm(k)*Tmpv007
!  Tmpv009 =rv(i,k-1,j) +rv(i,k-1,j+1)
!  Tmpv010 =fzp(k)*Tmpv009
!  Tmpv011 =Tmpv008 +Tmpv010
!  Tmpv012 =(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*Tmpv011
!  Tmpv013 =Tmpv006 -Tmpv012
!  Tmpv014 =e(i,j)*Tmpv013
!  Tmpv015 =rw_tend(i,k,j) +Tmpv014
!  rw_tend(i,k,j) =Tmpv015

!  ENDDO
!  ENDDO

   DO k =ktf, kts+1, -1
   DO i =min(ite, ide-1), its, -1
   a_Tmpv15 =a_rw_tend(i,k,j)
   a_rw_tend(i,k,j) =0.0
   a_rw_tend(i,k,j) =a_rw_tend(i,k,j) +a_Tmpv15
   a_Tmpv14 =a_Tmpv15
   a_Tmpv13 =e(i,j)*a_Tmpv14
   a_Tmpv6 =a_Tmpv13
   a_Tmpv12 =-a_Tmpv13
   a_Tmpv11 =(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*a_Tmpv12
   a_Tmpv8 =a_Tmpv11
   a_Tmpv10 =a_Tmpv11
   a_Tmpv9 =fzp(k)*a_Tmpv10
   a_rv(i,k-1,j) =a_rv(i,k-1,j) +a_Tmpv9
   a_rv(i,k-1,j+1) =a_rv(i,k-1,j+1) +a_Tmpv9
   a_Tmpv7 =fzm(k)*a_Tmpv8
   a_rv(i,k,j) =a_rv(i,k,j) +a_Tmpv7
   a_rv(i,k,j+1) =a_rv(i,k,j+1) +a_Tmpv7
   a_Tmpv5 =cosa(i,j)*0.5*a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =fzp(k)*a_Tmpv4
   a_ru(i,k-1,j) =a_ru(i,k-1,j) +a_Tmpv3
   a_ru(i+1,k-1,j) =a_ru(i+1,k-1,j) +a_Tmpv3
   a_Tmpv1 =fzm(k)*a_Tmpv2
   a_ru(i,k,j) =a_ru(i,k,j) +a_Tmpv1
   a_ru(i+1,k,j) =a_ru(i+1,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[23]

!  IF( (config_flags%open_ye) .and. (jte == jde) ) THEN
!  DO k =kts, ktf
!  DO i =its, min(ide-1, ite)
!  Tmpv001 =ru(i,k,jte-1) +ru(i+1,k,jte-1)
!  Tmpv002 =Tmpv001 +ru(i,k,jte-1)
!  Tmpv003 =Tmpv002 +ru(i+1,k,jte-1)
!  Tmpv004 =(msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1))*0.25*Tmpv003
!  Tmpv005 =rv_tend(i,k,jte) -Tmpv004
!  Tmpv006 =rw(i,k+1,jte-1) +rw(i,k,jte-1)
!  Tmpv007 =Tmpv006 +rw(i,k+1,jte-1)
!  Tmpv008 =Tmpv007 +rw(i,k,jte-1)
!  Tmpv009 =(msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))*0.25*Tmpv008
!  Tmpv010 =Tmpv005 +Tmpv009
!  rv_tend(i,k,jte) =Tmpv010

!  ENDDO
!  ENDDO
!  ENDIF

! Added by Ning Pan, 2010-07-22
!  coriolis term for v-momentum equation
   j_start = jts
   j_end   = jte
   IF ( config_flags%open_ys .or. specified .or. &
        config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts)
   IF ( config_flags%open_ye .or. specified .or. &
        config_flags%nested .or. config_flags%polar) j_end   = MIN(jde-1,jte)

! boundary loops for coriolis not needed for open bdy  (commented out 20100611 XZ)
!   IF( (config_flags%open_ye) .and. (jte == jde) ) THEN

!   DO k =ktf, kts, -1
!   DO i =min(ide-1, ite), its, -1
!   a_Tmpv10 =a_rv_tend(i,k,jte)
!   a_rv_tend(i,k,jte) =0.0
!   a_Tmpv5 =a_Tmpv10
!   a_Tmpv9 =a_Tmpv10
!   a_Tmpv8 =(msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,  &
!   jte-1)+sina(i,jte-1))*0.25*a_Tmpv9
!   a_Tmpv7 =a_Tmpv8
!   a_rw(i,k,jte-1) =a_rw(i,k,jte-1) +a_Tmpv8
!   a_Tmpv6 =a_Tmpv7
!   a_rw(i,k+1,jte-1) =a_rw(i,k+1,jte-1) +a_Tmpv7
!   a_rw(i,k+1,jte-1) =a_rw(i,k+1,jte-1) +a_Tmpv6
!   a_rw(i,k,jte-1) =a_rw(i,k,jte-1) +a_Tmpv6
!   a_rv_tend(i,k,jte) =a_rv_tend(i,k,jte) +a_Tmpv5
!   a_Tmpv4 =-a_Tmpv5
!   a_Tmpv3 =(msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1))*0.25*a_Tmpv4
!   a_Tmpv2 =a_Tmpv3
!   a_ru(i+1,k,jte-1) =a_ru(i+1,k,jte-1) +a_Tmpv3
!   a_Tmpv1 =a_Tmpv2
!   a_ru(i,k,jte-1) =a_ru(i,k,jte-1) +a_Tmpv2
!   a_ru(i,k,jte-1) =a_ru(i,k,jte-1) +a_Tmpv1
!   a_ru(i+1,k,jte-1) =a_ru(i+1,k,jte-1) +a_Tmpv1
!   ENDDO
!   ENDDO

!   ENDIF

!LPB[22]

!LPB[21]
   DO j =j_end, j_start, -1

!  DO k =kts, ktf
!  DO i =its, min(ide-1, ite)
!  Tmpv001 =ru(i,k,j) +ru(i+1,k,j)
!  Tmpv002 =Tmpv001 +ru(i,k,j-1)
!  Tmpv003 =Tmpv002 +ru(i+1,k,j-1)
!  Tmpv004 =(msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1))*0.25*Tmpv003
!  Tmpv005 =rv_tend(i,k,j) -Tmpv004
!  Tmpv006 =rw(i,k+1,j-1) +rw(i,k,j-1)
!  Tmpv007 =Tmpv006 +rw(i,k+1,j)
!  Tmpv008 =Tmpv007 +rw(i,k,j)
!  Tmpv009 =(msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1))*0.25*Tmpv008
!  Tmpv010 =Tmpv005 +Tmpv009
!  rv_tend(i,k,j) =Tmpv010

!  ENDDO
!  ENDDO

   DO k =ktf, kts, -1
   DO i =min(ide-1, ite), its, -1
   a_Tmpv10 =a_rv_tend(i,k,j)
   a_rv_tend(i,k,j) =0.0
   a_Tmpv5 =a_Tmpv10
   a_Tmpv9 =a_Tmpv10
   a_Tmpv8 =(msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)  &
   +sina(i,j-1))*0.25*a_Tmpv9
   a_Tmpv7 =a_Tmpv8
   a_rw(i,k,j) =a_rw(i,k,j) +a_Tmpv8
   a_Tmpv6 =a_Tmpv7
   a_rw(i,k+1,j) =a_rw(i,k+1,j) +a_Tmpv7
   a_rw(i,k+1,j-1) =a_rw(i,k+1,j-1) +a_Tmpv6
   a_rw(i,k,j-1) =a_rw(i,k,j-1) +a_Tmpv6
   a_rv_tend(i,k,j) =a_rv_tend(i,k,j) +a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv3 =(msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1))*0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ru(i+1,k,j-1) =a_ru(i+1,k,j-1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ru(i,k,j-1) =a_ru(i,k,j-1) +a_Tmpv2
   a_ru(i,k,j) =a_ru(i,k,j) +a_Tmpv1
   a_ru(i+1,k,j) =a_ru(i+1,k,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[20]

!  IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
!  DO k =kts, ktf
!  DO i =its, min(ide-1, ite)
!  Tmpv001 =ru(i,k,jts) +ru(i+1,k,jts)
!  Tmpv002 =Tmpv001 +ru(i,k,jts)
!  Tmpv003 =Tmpv002 +ru(i+1,k,jts)
!  Tmpv004 =(msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts))*0.25*Tmpv003
!  Tmpv005 =rv_tend(i,k,jts) -Tmpv004
!  Tmpv006 =rw(i,k+1,jts) +rw(i,k,jts)
!  Tmpv007 =Tmpv006 +rw(i,k+1,jts)
!  Tmpv008 =Tmpv007 +rw(i,k,jts)
!  Tmpv009 =(msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))*0.25*Tmpv008
!  Tmpv010 =Tmpv005 +Tmpv009
!  rv_tend(i,k,jts) =Tmpv010

!  ENDDO
!  ENDDO
!  ENDIF

! boundary loops for coriolis not needed for open bdy  (commented out 20100611 XZ)
!   IF( (config_flags%open_ys) .and. (jts == jds) ) THEN

!   DO k =ktf, kts, -1
!   DO i =min(ide-1, ite), its, -1
!   a_Tmpv10 =a_rv_tend(i,k,jts)
!   a_rv_tend(i,k,jts) =0.0
!   a_Tmpv5 =a_Tmpv10
!   a_Tmpv9 =a_Tmpv10
!   a_Tmpv8 =(msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)  &
!   +sina(i,jts))*0.25*a_Tmpv9
!   a_Tmpv7 =a_Tmpv8
!   a_rw(i,k,jts) =a_rw(i,k,jts) +a_Tmpv8
!   a_Tmpv6 =a_Tmpv7
!   a_rw(i,k+1,jts) =a_rw(i,k+1,jts) +a_Tmpv7
!   a_rw(i,k+1,jts) =a_rw(i,k+1,jts) +a_Tmpv6
!   a_rw(i,k,jts) =a_rw(i,k,jts) +a_Tmpv6
!   a_rv_tend(i,k,jts) =a_rv_tend(i,k,jts) +a_Tmpv5
!   a_Tmpv4 =-a_Tmpv5
!   a_Tmpv3 =(msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts))*0.25*a_Tmpv4
!   a_Tmpv2 =a_Tmpv3
!   a_ru(i+1,k,jts) =a_ru(i+1,k,jts) +a_Tmpv3
!   a_Tmpv1 =a_Tmpv2
!   a_ru(i,k,jts) =a_ru(i,k,jts) +a_Tmpv2
!   a_ru(i,k,jts) =a_ru(i,k,jts) +a_Tmpv1
!   a_ru(i+1,k,jts) =a_ru(i+1,k,jts) +a_Tmpv1
!   ENDDO
!   ENDDO
!
!   ENDIF

!LPB[19]

!LPB[18]
   DO j =j_end, j_start-1, -1

!  wkp1 =Keep_Lpb18_wkp1(j)
!  wk =Keep_Lpb18_wk(j)
!  wkm1 =Keep_Lpb18_wkm1(j)

! Remarked by Ning Pan, 2010-07-22: redundant recalculation
!   DO i =its, Tmpv001
!   k =kts
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i-1,k,j)
!   Tmpv003 =Tmpv002 +ph(i-1,k+1,j)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_u =Tmpv005

!   wkp1 =min(1., max(0., z_at_u -z_base(k))/(z_base(k+1)-z_base(k)))

!   wk =1. -wkp1

!   Tmpv001 =+wk*u_base(k) +wkp1*u_base(k+1)
!   Tmpv200(i) =Tmpv001
!   Tmpv002 =muu(i,j)*Tmpv200(i)
!   Tmpv003 =ru_in(i,k,j) -Tmpv002
!!  ru(i,k,j) =Tmpv003

!   k =ktf
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i-1,k,j)
!   Tmpv003 =Tmpv002 +ph(i-1,k+1,j)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_u =Tmpv005

!   wkm1 =min(1., max(0., z_base(k) -z_at_u)/(z_base(k)-z_base(k-1)))

!   wk =1. -wkm1

!   Tmpv001 =wkm1*u_base(k-1) +wk*u_base(k)
!   Tmpv201(i) =Tmpv001
!   Tmpv002 =muu(i,j)*Tmpv201(i)
!   Tmpv003 =ru_in(i,k,j) -Tmpv002
!!  ru(i,k,j) =Tmpv003

!   ENDDO

! Revised by Ning Pan, 2010-07-22
!   DO i =Tmpv001, its, -1
   DO i =MIN(ite,ide-1)+1, its, -1

!STOP  ! Remarked by Ning Pan, 2010-07-22
!REVISED BY WALLS
!  0.0 =a_Tmpv1
! Added by Ning Pan, 2010-07-22
   k = ktf
   z_at_u = Tmpv501(i,k,j)

   a_Tmpv3 =a_ru(i,k,j)
   a_ru(i,k,j) =0.0
   a_ru_in(i,k,j) =a_ru_in(i,k,j) +a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
! Revised by Ning Pan, 2010-07-22
!   a_muu(i,j) =a_muu(i,j) +Tmpv201(i)*a_Tmpv2
   a_muu(i,j) =a_muu(i,j) +Tmpv500(i,k,j)*a_Tmpv2
   a_Tmpv1 =muu(i,j)*a_Tmpv2
   a_wkm1 =a_wkm1 +u_base(k-1)*a_Tmpv1
   a_wk =a_wk +u_base(k)*a_Tmpv1
   a_wkm1 =a_wkm1 -a_wk
   a_wk =0.0
   a_z_at_u =a_z_at_u +((-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_u))  &
   *0.5/(z_base(k)-z_base(k-1)) -(-(-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_u))  &
   *0.5/(z_base(k)-z_base(k-1)))*sign(1.0, 1. -max(0., z_base(k) -z_at_u)/(z_base(k)  &
   -z_base(k-1))))*0.5*a_wkm1
   a_wkm1 =0.0
   a_Tmpv5 =a_z_at_u
   a_z_at_u =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i-1,k+1,j) =a_ph(i-1,k+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i-1,k,j) =a_ph(i-1,k,j) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1

! Added by Ning Pan, 2010-07-22
   k = kts
   z_at_u = Tmpv501(i,k,j)

   a_Tmpv3 =a_ru(i,k,j)
   a_ru(i,k,j) =0.0
   a_ru_in(i,k,j) =a_ru_in(i,k,j) +a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
! Revised by Ning Pan, 2010-07-22
!   a_muu(i,j) =a_muu(i,j) +Tmpv200(i)*a_Tmpv2
   a_muu(i,j) =a_muu(i,j) +Tmpv500(i,k,j)*a_Tmpv2
   a_Tmpv1 =muu(i,j)*a_Tmpv2
   a_wk =a_wk +u_base(k)*a_Tmpv1
   a_wkp1 =a_wkp1 +u_base(k+1)*a_Tmpv1
   a_wkp1 =a_wkp1 -a_wk
   a_wk =0.0
   a_z_at_u =a_z_at_u +((1.0 +(-1.0)*sign(1.0, 0. -z_at_u -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)) -(-(1.0 +(-1.0)*sign(1.0, 0. -z_at_u -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)))*sign(1.0, 1. -max(0., z_at_u -z_base(k))/(z_base(k+1)  &
   -z_base(k))))*0.5*a_wkp1
   a_wkp1 =0.0
   a_Tmpv5 =a_z_at_u
   a_z_at_u =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i-1,k+1,j) =a_ph(i-1,k+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i-1,k,j) =a_ph(i-1,k,j) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[17]
   DO j =j_end, j_start-1, -1

! Remarked by Ning Pan, 2010-07-22: redundant recalculation
!   wkp1 =Keep_Lpb17_wkp1(j)
!   wkm1 =Keep_Lpb17_wkm1(j)
!   wk =Keep_Lpb17_wk(j)

!   DO k =kts+1, ktf-1
!   DO i =its, Tmpv001
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i-1,k,j)
!   Tmpv003 =Tmpv002 +ph(i-1,k+1,j)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_u =Tmpv005

!   wkp1 =min(1., max(0., z_at_u -z_base(k))/(z_base(k+1)-z_base(k)))

!   wkm1 =min(1., max(0., z_base(k) -z_at_u)/(z_base(k)-z_base(k-1)))

!   Tmpv001 =1. -wkp1 -wkm1
!   wk =Tmpv001

!   Tmpv001 =wkm1*u_base(k-1) +wk*u_base(k)
!   Tmpv002 =Tmpv001 +wkp1*u_base(k+1)
!   Tmpv300(i,k) =Tmpv002
!   Tmpv003 =muu(i,j)*Tmpv300(i,k)
!   Tmpv004 =ru_in(i,k,j) -Tmpv003
!!  ru(i,k,j) =Tmpv004

!   ENDDO
!   ENDDO

   DO k =ktf-1, kts+1, -1
! Revised by Ning Pan, 2010-07-22
!   DO i =Tmpv001, its, -1
   DO i =MIN(ite,ide-1)+1, its, -1

!STOP  ! Remarked by Ning Pan, 2010-07-22
!REVISED BY WALLS
!  0.0 =a_Tmpv1
   z_at_u = Tmpv501(i,k,j)  ! Added by Ning Pan, 2010-07-22
   a_Tmpv4 =a_ru(i,k,j)
   a_ru(i,k,j) =0.0
   a_ru_in(i,k,j) =a_ru_in(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
! Revised by Ning Pan, 2010-07-22
!   a_muu(i,j) =a_muu(i,j) +Tmpv300(i,k)*a_Tmpv3
   a_muu(i,j) =a_muu(i,j) +Tmpv500(i,k,j)*a_Tmpv3
   a_Tmpv2 =muu(i,j)*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_wkp1 =a_wkp1 +u_base(k+1)*a_Tmpv2
   a_wkm1 =a_wkm1 +u_base(k-1)*a_Tmpv1
   a_wk =a_wk +u_base(k)*a_Tmpv1
   a_Tmpv1 =a_wk
   a_wk =0.0
   a_wkp1 =a_wkp1 -a_Tmpv1
   a_wkm1 =a_wkm1 -a_Tmpv1
!REVISED BY WALLS
!  a_z_at_u =a_z_at_u +((-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_u))  &
   a_z_at_u =a_z_at_u +((-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_u))  &
   *0.5/(z_base(k)-z_base(k-1)) -(-(-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_u))  &
   *0.5/(z_base(k)-z_base(k-1)))*sign(1.0, 1. -max(0., z_base(k) -z_at_u)/(z_base(k)  &
   -z_base(k-1))))*0.5*a_wkm1
   a_wkm1 =0.0
   a_z_at_u =a_z_at_u +((1.0 +(-1.0)*sign(1.0, 0. -z_at_u -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)) -(-(1.0 +(-1.0)*sign(1.0, 0. -z_at_u -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)))*sign(1.0, 1. -max(0., z_at_u -z_base(k))/(z_base(k+1)  &
   -z_base(k))))*0.5*a_wkp1
   a_wkp1 =0.0
   a_Tmpv5 =a_z_at_u
   a_z_at_u =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i-1,k+1,j) =a_ph(i-1,k+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i-1,k,j) =a_ph(i-1,k,j) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[16]

!  IF( config_flags%open_ye .or. specified .or.  	        config_flags%nested .or. config_flags%polar) THEN
!  j_end =min(jde-1, jte)
!  END IF

!  IF( config_flags%open_ye .or. specified .or.   &
!           config_flags%nested .or. config_flags%polar) THEN

!  END IF

!LPB[15]

!LPB[14]

!  IF( config_flags%open_ys .or. specified .or.  	        config_flags%nested .or. config_flags%polar) THEN
!  j_start =max(jds+1, jts)
!  END IF

!  IF( config_flags%open_ys .or. specified .or.   &
!           config_flags%nested .or. config_flags%polar) THEN

!  END IF

!LPB[13]
!  j_start =jts
!  j_end =jte

! Added by Ning Pan, 2010-07-22
! coriolis for u-momentum equation
   i_start = its
   i_end   = ite
   IF ( config_flags%open_xs .or. specified .or. &
        config_flags%nested) i_start = MAX(ids+1,its)
   IF ( config_flags%open_xe .or. specified .or. &
        config_flags%nested) i_end   = MIN(ide-1,ite)
      IF ( config_flags%periodic_x ) i_start = its
      IF ( config_flags%periodic_x ) i_end = ite

!!LPB[12]
   DO j =min(jte, jde-1), jts, -1

!  DO k =kts, ktf
!  DO i =i_start, i_end
!  Tmpv001 =rv(i-1,k,j+1) +rv(i,k,j+1)
!  Tmpv002 =Tmpv001 +rv(i-1,k,j)
!  Tmpv003 =Tmpv002 +rv(i,k,j)
!  Tmpv004 =(msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j))*0.25*Tmpv003
!  Tmpv005 =ru_tend(i,k,j) +Tmpv004
!  Tmpv006 =rw(i-1,k+1,j) +rw(i-1,k,j)
!  Tmpv007 =Tmpv006 +rw(i,k+1,j)
!  Tmpv008 =Tmpv007 +rw(i,k,j)
!  Tmpv009 =0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j))*0.25*Tmpv008
!  Tmpv010 =Tmpv005 -Tmpv009
!  ru_tend(i,k,j) =Tmpv010

!  ENDDO
!  ENDDO
!  IF( (config_flags%open_xs) .and. (its == ids) ) THEN
!  DO k =kts, ktf
!  Tmpv001 =rv(its,k,j+1) +rv(its,k,j+1) +rv(its,k,j)
!  Tmpv002 =Tmpv001 +rv(its,k,j)
!  Tmpv003 =(msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j))*0.25*Tmpv002
!  Tmpv004 =ru_tend(its,k,j) +Tmpv003
!  Tmpv005 =rw(its,k+1,j) +rw(its,k,j)
!  Tmpv006 =Tmpv005 +rw(its,k+1,j)
!  Tmpv007 =Tmpv006 +rw(its,k,j)
!  Tmpv008 =0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j))*0.25*Tmpv007
!  Tmpv009 =Tmpv004 -Tmpv008
!  ru_tend(its,k,j) =Tmpv009

!  ENDDO

!  ENDIF
!  IF( (config_flags%open_xe) .and. (ite == ide) ) THEN
!  DO k =kts, ktf
!  Tmpv001 =rv(ite-1,k,j+1) +rv(ite-1,k,j+1) +rv(ite-1,k,j)
!  Tmpv002 =Tmpv001 +rv(ite-1,k,j)
!  Tmpv003 =(msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j))*0.25*Tmpv002
!  Tmpv004 =ru_tend(ite,k,j) +Tmpv003
!  Tmpv005 =rw(ite-1,k+1,j) +rw(ite-1,k,j)
!  Tmpv006 =Tmpv005 +rw(ite-1,k+1,j)
!  Tmpv007 =Tmpv006 +rw(ite-1,k,j)
!  Tmpv008 =0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j))*0.25*Tmpv007
!  Tmpv009 =Tmpv004 -Tmpv008
!  ru_tend(ite,k,j) =Tmpv009

!  ENDDO

!  ENDIF

! boundary loops for coriolis not needed for open bdy  (commented out 20100611 XZ)
!  IF( (config_flags%open_xe) .and. (ite == ide) ) THEN

!  DO k =ktf, kts, -1
!  a_Tmpv9 =a_ru_tend(ite,k,j)
!  a_ru_tend(ite,k,j) =0.0
!  a_Tmpv4 =a_Tmpv9
!  a_Tmpv8 =-a_Tmpv9
!  a_Tmpv7 =0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j))*0.25*a_Tmpv8
!  a_Tmpv6 =a_Tmpv7
!  a_rw(ite-1,k,j) =a_rw(ite-1,k,j) +a_Tmpv7
!  a_Tmpv5 =a_Tmpv6
!  a_rw(ite-1,k+1,j) =a_rw(ite-1,k+1,j) +a_Tmpv6
!  a_rw(ite-1,k+1,j) =a_rw(ite-1,k+1,j) +a_Tmpv5
!  a_rw(ite-1,k,j) =a_rw(ite-1,k,j) +a_Tmpv5
!  a_ru_tend(ite,k,j) =a_ru_tend(ite,k,j) +a_Tmpv4
!  a_Tmpv3 =a_Tmpv4
!  a_Tmpv2 =(msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j))*0.25*a_Tmpv3
!  a_Tmpv1 =a_Tmpv2
!  a_rv(ite-1,k,j) =a_rv(ite-1,k,j) +a_Tmpv2
!  a_rv(ite-1,k,j+1) =a_rv(ite-1,k,j+1) +(1.0 +1.0)*a_Tmpv1
!  a_rv(ite-1,k,j) =a_rv(ite-1,k,j) +a_Tmpv1
!  ENDDO

!  ENDIF

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

!  DO k =ktf, kts, -1
!  a_Tmpv9 =a_ru_tend(its,k,j)
!  a_ru_tend(its,k,j) =0.0
!  a_Tmpv4 =a_Tmpv9
!  a_Tmpv8 =-a_Tmpv9
!  a_Tmpv7 =0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j))*0.25*a_Tmpv8
!  a_Tmpv6 =a_Tmpv7
!  a_rw(its,k,j) =a_rw(its,k,j) +a_Tmpv7
!  a_Tmpv5 =a_Tmpv6
!  a_rw(its,k+1,j) =a_rw(its,k+1,j) +a_Tmpv6
!  a_rw(its,k+1,j) =a_rw(its,k+1,j) +a_Tmpv5
!  a_rw(its,k,j) =a_rw(its,k,j) +a_Tmpv5
!  a_ru_tend(its,k,j) =a_ru_tend(its,k,j) +a_Tmpv4
!  a_Tmpv3 =a_Tmpv4
!  a_Tmpv2 =(msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j))*0.25*a_Tmpv3
!  a_Tmpv1 =a_Tmpv2
!  a_rv(its,k,j) =a_rv(its,k,j) +a_Tmpv2
!  a_rv(its,k,j+1) =a_rv(its,k,j+1) +(1.0 +1.0)*a_Tmpv1
!  a_rv(its,k,j) =a_rv(its,k,j) +a_Tmpv1
!  ENDDO

!  ENDIF

   DO k =ktf, kts, -1
   DO i =i_end, i_start, -1
   a_Tmpv10 =a_ru_tend(i,k,j)
   a_ru_tend(i,k,j) =0.0
   a_Tmpv5 =a_Tmpv10
   a_Tmpv9 =-a_Tmpv10
   a_Tmpv8 =0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j))*0.25*a_Tmpv9
   a_Tmpv7 =a_Tmpv8
   a_rw(i,k,j) =a_rw(i,k,j) +a_Tmpv8
   a_Tmpv6 =a_Tmpv7
   a_rw(i,k+1,j) =a_rw(i,k+1,j) +a_Tmpv7
   a_rw(i-1,k+1,j) =a_rw(i-1,k+1,j) +a_Tmpv6
   a_rw(i-1,k,j) =a_rw(i-1,k,j) +a_Tmpv6
   a_ru_tend(i,k,j) =a_ru_tend(i,k,j) +a_Tmpv5
   a_Tmpv4 =a_Tmpv5
   a_Tmpv3 =(msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j))*0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_rv(i,k,j) =a_rv(i,k,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_rv(i-1,k,j) =a_rv(i-1,k,j) +a_Tmpv2
   a_rv(i-1,k,j+1) =a_rv(i-1,k,j+1) +a_Tmpv1
   a_rv(i,k,j+1) =a_rv(i,k,j+1) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[11]
! Revised by Ning Pan, 2010-07-22
!   DO j =Tmpv001, jts, -1
   DO j =MIN(jte,jde-1)+1, jts, -1

! Remarked by Ning Pan, 2010-07-22: redundant recalculation
!   wkp1 =Keep_Lpb11_wkp1(j)
!   wk =Keep_Lpb11_wk(j)
!   wkm1 =Keep_Lpb11_wkm1(j)

!   DO i =i_start-1, i_end
!   k =kts
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i,k,j-1)
!   Tmpv003 =Tmpv002 +ph(i,k+1,j-1)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_v =Tmpv005

!   wkp1 =min(1., max(0., z_at_v -z_base(k))/(z_base(k+1)-z_base(k)))

!   wk =1. -wkp1

!   Tmpv001 =+wk*v_base(k) +wkp1*v_base(k+1)
!   Tmpv200(i) =Tmpv001
!   Tmpv002 =muv(i,j)*Tmpv200(i)
!   Tmpv003 =rv_in(i,k,j) -Tmpv002
!!  rv(i,k,j) =Tmpv003

!   k =ktf
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i,k,j-1)
!   Tmpv003 =Tmpv002 +ph(i,k+1,j-1)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_v =Tmpv005

!   wkm1 =min(1., max(0., z_base(k) -z_at_v)/(z_base(k)-z_base(k-1)))

!   wk =1. -wkm1

!   Tmpv001 =wkm1*v_base(k-1) +wk*v_base(k)
!   Tmpv201(i) =Tmpv001
!   Tmpv002 =muv(i,j)*Tmpv201(i)
!   Tmpv003 =rv_in(i,k,j) -Tmpv002
!!  rv(i,k,j) =Tmpv003

!   ENDDO

   DO i =i_end, i_start-1, -1
! Added by Ning Pan, 2010-07-22
   k = ktf
   z_at_v = Tmpv401(i,k,j)

   a_Tmpv3 =a_rv(i,k,j)
   a_rv(i,k,j) =0.0
   a_rv_in(i,k,j) =a_rv_in(i,k,j) +a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
! Revised by Ning Pan, 2010-07-22
!   a_muv(i,j) =a_muv(i,j) +Tmpv201(i)*a_Tmpv2
   a_muv(i,j) =a_muv(i,j) +Tmpv400(i,k,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j)*a_Tmpv2
   a_wkm1 =a_wkm1 +v_base(k-1)*a_Tmpv1
   a_wk =a_wk +v_base(k)*a_Tmpv1
   a_wkm1 =a_wkm1 -a_wk
   a_wk =0.0
   a_z_at_v =a_z_at_v +((-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_v))  &
   *0.5/(z_base(k)-z_base(k-1)) -(-(-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_v))  &
   *0.5/(z_base(k)-z_base(k-1)))*sign(1.0, 1. -max(0., z_base(k) -z_at_v)/(z_base(k)  &
   -z_base(k-1))))*0.5*a_wkm1
   a_wkm1 =0.0
   a_Tmpv5 =a_z_at_v
   a_z_at_v =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i,k+1,j-1) =a_ph(i,k+1,j-1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i,k,j-1) =a_ph(i,k,j-1) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1

! Added by Ning Pan, 2010-07-22
   k = kts
   z_at_v = Tmpv401(i,k,j)

   a_Tmpv3 =a_rv(i,k,j)
   a_rv(i,k,j) =0.0
   a_rv_in(i,k,j) =a_rv_in(i,k,j) +a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
! Revised by Ning Pan, 2010-07-22
!   a_muv(i,j) =a_muv(i,j) +Tmpv200(i)*a_Tmpv2
   a_muv(i,j) =a_muv(i,j) +Tmpv400(i,k,j)*a_Tmpv2
   a_Tmpv1 =muv(i,j)*a_Tmpv2
   a_wk =a_wk +v_base(k)*a_Tmpv1
   a_wkp1 =a_wkp1 +v_base(k+1)*a_Tmpv1
   a_wkp1 =a_wkp1 -a_wk
   a_wk =0.0
   a_z_at_v =a_z_at_v +((1.0 +(-1.0)*sign(1.0, 0. -z_at_v -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)) -(-(1.0 +(-1.0)*sign(1.0, 0. -z_at_v -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)))*sign(1.0, 1. -max(0., z_at_v -z_base(k))/(z_base(k+1)  &
   -z_base(k))))*0.5*a_wkp1
   a_wkp1 =0.0
   a_Tmpv5 =a_z_at_v
   a_z_at_v =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i,k+1,j-1) =a_ph(i,k+1,j-1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i,k,j-1) =a_ph(i,k,j-1) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[10]
! Revised by Ning Pan, 2010-07-22
!   DO j =Tmpv001, jts, -1
   DO j =MIN(jte,jde-1)+1, jts, -1

! Remarked by Ning Pan, 2010-07-22: redundant recalculation
!   DO k =kts+1, ktf-1
!   DO i =i_start-1, i_end
!   Tmpv001 =phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1) +ph(i,k,j) +ph(i,k+1,j)
!   Tmpv002 =Tmpv001 +ph(i,k,j-1)
!   Tmpv003 =Tmpv002 +ph(i,k+1,j-1)
!   Tmpv004 =0.25*Tmpv003
!   Tmpv005 =Tmpv004/g
!!  z_at_v =Tmpv005

!   wkp1 =min(1., max(0., z_at_v -z_base(k))/(z_base(k+1)-z_base(k)))

!   wkm1 =min(1., max(0., z_base(k) -z_at_v)/(z_base(k)-z_base(k-1)))

!   Tmpv001 =1. -wkp1 -wkm1
!   wk =Tmpv001

!   Tmpv001 =wkm1*v_base(k-1) +wk*v_base(k)
!   Tmpv002 =Tmpv001 +wkp1*v_base(k+1)
!   Tmpv300(i,k) =Tmpv002
!   Tmpv003 =muv(i,j)*Tmpv300(i,k)
!   Tmpv004 =rv_in(i,k,j) -Tmpv003
!!  rv(i,k,j) =Tmpv004

!   ENDDO
!   ENDDO

   DO k =ktf-1, kts+1, -1
   DO i =i_end, i_start-1, -1
   z_at_v = Tmpv401(i,k,j)  ! Added by Ning Pan, 2010-07-22
   a_Tmpv4 =a_rv(i,k,j)
   a_rv(i,k,j) =0.0
   a_rv_in(i,k,j) =a_rv_in(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
! Revised by Ning Pan, 2010-07-22
!   a_muv(i,j) =a_muv(i,j) +Tmpv300(i,k)*a_Tmpv3
   a_muv(i,j) =a_muv(i,j) +Tmpv400(i,k,j)*a_Tmpv3
   a_Tmpv2 =muv(i,j)*a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_wkp1 =a_wkp1 +v_base(k+1)*a_Tmpv2
   a_wkm1 =a_wkm1 +v_base(k-1)*a_Tmpv1
   a_wk =a_wk +v_base(k)*a_Tmpv1
   a_Tmpv1 =a_wk
   a_wk =0.0
   a_wkp1 =a_wkp1 -a_Tmpv1
   a_wkm1 =a_wkm1 -a_Tmpv1
   a_z_at_v =a_z_at_v +((-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_v))  &
   *0.5/(z_base(k)-z_base(k-1)) -(-(-1.0 +(1.0)*sign(1.0, 0. -z_base(k) -z_at_v))  &
   *0.5/(z_base(k)-z_base(k-1)))*sign(1.0, 1. -max(0., z_base(k) -z_at_v)/(z_base(k)  &
   -z_base(k-1))))*0.5*a_wkm1
   a_wkm1 =0.0
   a_z_at_v =a_z_at_v +((1.0 +(-1.0)*sign(1.0, 0. -z_at_v -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)) -(-(1.0 +(-1.0)*sign(1.0, 0. -z_at_v -z_base(k)))  &
   *0.5/(z_base(k+1)-z_base(k)))*sign(1.0, 1. -max(0., z_at_v -z_base(k))/(z_base(k+1)  &
   -z_base(k))))*0.5*a_wkp1
   a_wkp1 =0.0
   a_Tmpv5 =a_z_at_v
   a_z_at_v =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i,k+1,j-1) =a_ph(i,k+1,j-1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i,k,j-1) =a_ph(i,k,j-1) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv1
   ENDDO
   ENDDO

   ENDDO

!LPB[9]

!  IF( config_flags%periodic_x ) THEN
!  i_end =ite
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[8]

!LPB[7]

!  IF( config_flags%periodic_x ) THEN
!  i_start =its
!  END IF

!  IF( config_flags%periodic_x ) THEN

!  END IF

!LPB[6]

!LPB[5]

!  IF( config_flags%open_xe .or. specified .or.  	        config_flags%nested) THEN
!  i_end =min(ide-1, ite)
!  END IF

!  IF( config_flags%open_xe .or. specified .or.   &
!           config_flags%nested) THEN

!  END IF

!LPB[4]

!LPB[3]

!  IF( config_flags%open_xs .or. specified .or.  	        config_flags%nested) THEN
!  i_start =max(ids+1, its)
!  END IF

!  IF( config_flags%open_xs .or. specified .or.   &
!           config_flags%nested) THEN

!  END IF

!LPB[2]
!  ktf =min(kte, kde-1)
!  i_start =its
!  i_end =ite

!LPB[1]

!  IF(config_flags%specified .or. config_flags%nested) THEN
!  specified =.true.
!  END IF

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

!  END IF

!LPB[0]
!  specified =.false.

   END SUBROUTINE a_perturbation_coriolis

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of curvature in reverse (adjoint) mode:
!   gradient     of useful results: u v ru_tend rw_tend ru rv rw
!                rv_tend
!   with respect to varying inputs: u v ru_tend rw_tend ru rv rw
!                rv_tend
!   RW status of diff variables: u:incr v:incr ru_tend:in-out rw_tend:in-out
!                ru:incr rv:incr rw:incr rv_tend:in-out
SUBROUTINE A_CURVATURE(ru, rub, rv, rvb, rw, rwb, u, ub, v, vb, w, &
&  ru_tend, ru_tendb, rv_tend, rv_tendb, rw_tend, rw_tendb, config_flags&
&  , msfux, msfuy, msfvx, msfvy, msftx, msfty, xlat, fzm, fzp, rdx, rdy, &
&  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(INOUT) :: ru_tend, &
&  rv_tend, rw_tend
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ru_tendb, rv_tendb, &
&  rw_tendb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ru, rv, rw, &
&  u, v, w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rub, rvb, rwb, ub, vb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msfux, msfuy, msfvx, &
&  msfvy, msftx, msfty, xlat
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp
  REAL, INTENT(IN) :: rdx, rdy
! Local data
!   INTEGER :: i, j, k, itf, jtf, ktf, kp1, im, ip, jm, jp
  INTEGER :: i, j, k, itf, jtf, ktf
  INTEGER :: i_start, i_end, j_start, j_end
!   INTEGER :: irmin, irmax, jrmin, jrmax
  REAL, DIMENSION(its - 1:ite, kts:kte, jts - 1:jte) :: vxgm
  REAL, DIMENSION(its-1:ite, kts:kte, jts-1:jte) :: vxgmb
  LOGICAL :: specified
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  INTEGER :: ad_to0
  INTEGER :: ad_to1
  INTEGER :: ad_to2
  INTEGER :: ad_to3
  INTEGER :: ad_from1
  INTEGER :: branch
  INTEGER :: min6
  INTEGER :: min5
  INTEGER :: min4
  INTEGER :: min3
  INTEGER :: min2
  INTEGER :: min1
  REAL :: tempb3
  REAL :: tempb2
  REAL :: tempb1
  REAL :: tempb0
  REAL :: temp0b
  REAL :: temp0b9
  REAL :: temp0b8
  REAL :: temp0b19
  REAL :: temp0b7
  REAL :: temp0b18
  REAL :: temp0b6
  REAL :: temp0b17
  REAL :: temp0b5
  REAL :: temp0b16
  REAL :: tempb
  REAL :: temp0b4
  REAL :: temp0b15
  REAL :: temp0b3
  REAL :: temp0b14
  REAL :: temp0b2
  REAL :: temp0b13
  REAL :: temp0b1
  REAL :: temp0b12
  REAL :: temp0b0
  REAL :: temp0b11
  REAL :: temp0b10
  REAL :: temp
  INTEGER :: max1
!<DESCRIPTION>
!
!  curvature calculates the large timestep tendency terms in the 
!  u, v, and w momentum equations arise from the curvature terms.  
!
!</DESCRIPTION>
  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
!   irmin = ims
!   irmax = ime
!   jrmin = jms
!   jrmax = jme
!   IF ( config_flags%open_xs ) irmin = ids
!   IF ( config_flags%open_xe ) irmax = ide-1
!   IF ( config_flags%open_ys ) jrmin = jds
!   IF ( config_flags%open_ye ) jrmax = jde-1
! Define v cross grad m at scalar points - vxgm(i,j)
  i_start = its - 1
  i_end = ite
  j_start = jts - 1
  j_end = jte
  IF (((config_flags%open_xs .OR. specified) .OR. config_flags%nested) &
&      .AND. its .EQ. ids) i_start = its
  IF (((config_flags%open_xe .OR. specified) .OR. config_flags%nested) &
&      .AND. ite .EQ. ide) i_end = ite - 1
  IF ((((config_flags%open_ys .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jts .EQ. jds) j_start = jts
  IF ((((config_flags%open_ye .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jte .EQ. jde) j_end = jte - 1
  IF (config_flags%periodic_x) i_start = its - 1
  IF (config_flags%periodic_x) i_end = ite
  ad_from0 = j_start
  DO j=ad_from0,j_end
    DO k=kts,ktf
      ad_from = i_start
      DO i=ad_from,i_end
!     Map scale factor notes:
!     msf...y is constant everywhere for cylindrical map projection
!     msf...x varies with y only
!     But we know that this is not = 0 for cylindrical,
!     therefore use msfvX in 1st line
!     which => by symmetry use msfuY in 2nd line - ???  
        vxgm(i, k, j) = 0.5*(u(i, k, j)+u(i+1, k, j))*(msfvx(i, j+1)-&
&          msfvx(i, j))*rdy - 0.5*(v(i, k, j)+v(i, k, j+1))*(msfuy(i+1, j&
&          )-msfuy(i, j))*rdx
      END DO
      CALL PUSHINTEGER4(i - 1)
      CALL PUSHINTEGER4(ad_from)
    END DO
  END DO
  CALL PUSHINTEGER4(j - 1)
  CALL PUSHINTEGER4(ad_from0)
!  Pick up the boundary rows for open (radiation) lateral b.c.
!  Rather crude at present, we are assuming there is no
!    variation in this term at the boundary.
  IF (((config_flags%open_xs .OR. (specified .AND. (.NOT.config_flags%&
&      periodic_x))) .OR. config_flags%nested) .AND. its .EQ. ids) THEN
    DO j=jts,jte-1
      DO k=kts,ktf
        vxgm(its-1, k, j) = vxgm(its, k, j)
      END DO
    END DO
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (((config_flags%open_xe .OR. (specified .AND. (.NOT.config_flags%&
&      periodic_x))) .OR. config_flags%nested) .AND. ite .EQ. ide) THEN
    DO j=jts,jte-1
      DO k=kts,ktf
        vxgm(ite, k, j) = vxgm(ite-1, k, j)
      END DO
    END DO
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
!  Polar boundary condition:
!  The following change is needed in case one tries using the vxgm route with
!  polar B.C.'s in the future, but not needed if 'tan' used
  IF ((((config_flags%open_ys .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jts .EQ. jds) THEN
    DO k=kts,ktf
      DO i=its-1,ite
        vxgm(i, k, jts-1) = vxgm(i, k, jts)
      END DO
    END DO
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
!  Polar boundary condition:
!  The following change is needed in case one tries using the vxgm route with
!  polar B.C.'s in the future, but not needed if 'tan' used
  IF ((((config_flags%open_ye .OR. specified) .OR. config_flags%nested) &
&      .OR. config_flags%polar) .AND. jte .EQ. jde) THEN
    DO k=kts,ktf
      DO i=its-1,ite
        vxgm(i, k, jte) = vxgm(i, k, jte-1)
      END DO
    END DO
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
!  curvature term for u momentum eqn.
!  Map scale factor notes:
!  ADT eqn 44, RHS terms 4 and 5, in cylindrical: mu u v tan(lat)/(a my)
!                                               - mu u w /(a my)
!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
!   => terms are:
!  (mx/my)*u rv tan(lat) / a - u rw / a = (u/a)*[(mx/my) rv tan(lat) - rw]
!  ru v tan(lat) / a - u rw / a
!  xlat defined with end points half grid space from pole,
!  hence are on u latitude points
  i_start = its
  IF ((config_flags%open_xs .OR. specified) .OR. config_flags%nested) &
&  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) .OR. config_flags%nested) &
&  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
!  Polar boundary condition
  IF (config_flags%map_proj .EQ. 6 .OR. config_flags%polar) THEN
    IF (jde - 1 .GT. jte) THEN
      min1 = jte
    ELSE
      min1 = jde - 1
    END IF
    CALL PUSHCONTROL1B(0)
  ELSE
    IF (jde - 1 .GT. jte) THEN
      min2 = jte
    ELSE
      min2 = jde - 1
    END IF
    CALL PUSHCONTROL1B(1)
  END IF
!  curvature term for v momentum eqn.
!  Map scale factor notes
!  ADT eqn 45, RHS terms 4 and 5, in cylindrical:  - mu u*u tan(lat)/(a mx)
!                                               - mu v w /(a mx)
!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
!  terms are:
!  - (my/mx)*u ru tan(lat) / a - (my/mx)*v rw / a 
!  = - [my/(mx*a)]*[u ru tan(lat) + v rw]
!  - (1/a)*[(my/mx)*u ru tan(lat) + w rv]
!  xlat defined with end points half grid space from pole, hence are on
!  u latitude points => av here
!
!  in original wrf, there was a sign error for the rw contribution
  j_start = jts
  IF (((config_flags%open_ys .OR. specified) .OR. config_flags%nested) &
&      .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%nested) &
&      .OR. config_flags%polar) THEN
    IF (jde - 1 .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1
    END IF
  END IF
  IF (config_flags%map_proj .EQ. 6 .OR. config_flags%polar) THEN
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ite .GT. ide - 1) THEN
          min3 = ide - 1
        ELSE
          min3 = ite
        END IF
        i = min3 + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHCONTROL1B(1)
  ELSE
! normal code
    DO j=j_start,j_end
      DO k=kts,ktf
        IF (ite .GT. ide - 1) THEN
          min4 = ide - 1
        ELSE
          min4 = ite
        END IF
        i = min4 + 1
        CALL PUSHINTEGER4(i - 1)
      END DO
    END DO
    CALL PUSHCONTROL1B(0)
  END IF
  IF (jte .GT. jde - 1) THEN
    min5 = jde - 1
  ELSE
    min5 = jte
  END IF
!  curvature term for vertical momentum eqn.
!  Notes on map scale factors:
!  ADT eqn 46, RHS term 4: [mu/(a my)]*[u*u + v*v]
!  ru = mu u / my ; rw = mu w / my ; rv = mu v / mx
!  terms are: u ru / a + (mx/my)v rv / a
  DO j=jts,min5
    IF (2 .LT. kts) THEN
      max1 = kts
    ELSE
      max1 = 2
    END IF
    ad_from1 = max1
    DO k=ad_from1,ktf
      IF (ite .GT. ide - 1) THEN
        min6 = ide - 1
      ELSE
        min6 = ite
      END IF
      i = min6 + 1
      CALL PUSHINTEGER4(i - 1)
    END DO
    CALL PUSHINTEGER4(ad_from1)
  END DO
  DO j=min5,jts,-1
    CALL POPINTEGER4(ad_from1)
    DO k=ktf,ad_from1,-1
      CALL POPINTEGER4(ad_to3)
      DO i=ad_to3,its,-1
        temp0b14 = reradius*0.5**2*rw_tendb(i, k, j)
        temp0b15 = (fzm(k)*(u(i, k, j)+u(i+1, k, j))+fzp(k)*(u(i, k-1, j&
&          )+u(i+1, k-1, j)))*temp0b14
        temp0b16 = (fzm(k)*(ru(i, k, j)+ru(i+1, k, j))+fzp(k)*(ru(i, k-1&
&          , j)+ru(i+1, k-1, j)))*temp0b14
        temp0b17 = reradius*msftx(i, j)*0.5**2*rw_tendb(i, k, j)
        temp0b18 = (fzm(k)*(v(i, k, j)+v(i, k, j+1))+fzp(k)*(v(i, k-1, j&
&          )+v(i, k-1, j+1)))*temp0b17/msfty(i, j)
        temp0b19 = (fzm(k)*(rv(i, k, j)+rv(i, k, j+1))+fzp(k)*(rv(i, k-1&
&          , j)+rv(i, k-1, j+1)))*temp0b17/msfty(i, j)
        rub(i, k, j) = rub(i, k, j) + fzm(k)*temp0b15
        rub(i+1, k, j) = rub(i+1, k, j) + fzm(k)*temp0b15
        rub(i, k-1, j) = rub(i, k-1, j) + fzp(k)*temp0b15
        rub(i+1, k-1, j) = rub(i+1, k-1, j) + fzp(k)*temp0b15
        ub(i, k, j) = ub(i, k, j) + fzm(k)*temp0b16
        ub(i+1, k, j) = ub(i+1, k, j) + fzm(k)*temp0b16
        ub(i, k-1, j) = ub(i, k-1, j) + fzp(k)*temp0b16
        ub(i+1, k-1, j) = ub(i+1, k-1, j) + fzp(k)*temp0b16
        rvb(i, k, j) = rvb(i, k, j) + fzm(k)*temp0b18
        rvb(i, k, j+1) = rvb(i, k, j+1) + fzm(k)*temp0b18
        rvb(i, k-1, j) = rvb(i, k-1, j) + fzp(k)*temp0b18
        rvb(i, k-1, j+1) = rvb(i, k-1, j+1) + fzp(k)*temp0b18
        vb(i, k, j) = vb(i, k, j) + fzm(k)*temp0b19
        vb(i, k, j+1) = vb(i, k, j+1) + fzm(k)*temp0b19
        vb(i, k-1, j) = vb(i, k-1, j) + fzp(k)*temp0b19
        vb(i, k-1, j+1) = vb(i, k-1, j+1) + fzp(k)*temp0b19
      END DO
    END DO
  END DO
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    vxgmb = 0.0
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_to2)
        DO i=ad_to2,its,-1
          temp0b9 = -(0.25*0.5*rv_tendb(i, k, j))
          temp0b10 = (ru(i, k, j)+ru(i+1, k, j)+ru(i, k, j-1)+ru(i+1, k&
&            , j-1))*temp0b9
          temp0b11 = (vxgm(i, k, j)+vxgm(i, k, j-1))*temp0b9
          temp0b12 = -(msfvy(i, j)*reradius*0.25*rv_tendb(i, k, j))
          temp0b13 = v(i, k, j)*temp0b12/msfvx(i, j)
          vxgmb(i, k, j) = vxgmb(i, k, j) + temp0b10
          vxgmb(i, k, j-1) = vxgmb(i, k, j-1) + temp0b10
          rub(i, k, j) = rub(i, k, j) + temp0b11
          rub(i+1, k, j) = rub(i+1, k, j) + temp0b11
          rub(i, k, j-1) = rub(i, k, j-1) + temp0b11
          rub(i+1, k, j-1) = rub(i+1, k, j-1) + temp0b11
          vb(i, k, j) = vb(i, k, j) + (rw(i, k+1, j-1)+rw(i, k, j-1)+rw(&
&            i, k+1, j)+rw(i, k, j))*temp0b12/msfvx(i, j)
          rwb(i, k+1, j-1) = rwb(i, k+1, j-1) + temp0b13
          rwb(i, k, j-1) = rwb(i, k, j-1) + temp0b13
          rwb(i, k+1, j) = rwb(i, k+1, j) + temp0b13
          rwb(i, k, j) = rwb(i, k, j) + temp0b13
        END DO
      END DO
    END DO
  ELSE
    DO j=j_end,j_start,-1
      DO k=ktf,kts,-1
        CALL POPINTEGER4(ad_to1)
        DO i=ad_to1,its,-1
          temp0b4 = -(msfvy(i, j)*reradius*rv_tendb(i, k, j)/msfvx(i, j)&
&            )
          temp0b5 = TAN((xlat(i, j)+xlat(i, j-1))*(degrad*0.5))*0.25**2*&
&            temp0b4
          temp0b6 = (ru(i, k, j)+ru(i+1, k, j)+ru(i, k, j-1)+ru(i+1, k, &
&            j-1))*temp0b5
          temp0b7 = (u(i, k, j)+u(i+1, k, j)+u(i, k, j-1)+u(i+1, k, j-1)&
&            )*temp0b5
          temp0b8 = 0.25*v(i, k, j)*temp0b4
          ub(i, k, j) = ub(i, k, j) + temp0b6
          ub(i+1, k, j) = ub(i+1, k, j) + temp0b6
          ub(i, k, j-1) = ub(i, k, j-1) + temp0b6
          ub(i+1, k, j-1) = ub(i+1, k, j-1) + temp0b6
          rub(i, k, j) = rub(i, k, j) + temp0b7
          rub(i+1, k, j) = rub(i+1, k, j) + temp0b7
          rub(i, k, j-1) = rub(i, k, j-1) + temp0b7
          rub(i+1, k, j-1) = rub(i+1, k, j-1) + temp0b7
          vb(i, k, j) = vb(i, k, j) + 0.25*(rw(i, k+1, j-1)+rw(i, k, j-1&
&            )+rw(i, k+1, j)+rw(i, k, j))*temp0b4
          rwb(i, k+1, j-1) = rwb(i, k+1, j-1) + temp0b8
          rwb(i, k, j-1) = rwb(i, k, j-1) + temp0b8
          rwb(i, k+1, j) = rwb(i, k+1, j) + temp0b8
          rwb(i, k, j) = rwb(i, k, j) + temp0b8
        END DO
      END DO
    END DO
    vxgmb = 0.0
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=min1,jts,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp = 0.25*msfux(i, j)*TAN(xlat(i, j)*degrad)
          tempb1 = reradius*u(i, k, j)*ru_tendb(i, k, j)
          tempb2 = temp*tempb1/msfuy(i, j)
          tempb3 = -(0.25*tempb1)
          ub(i, k, j) = ub(i, k, j) + reradius*(temp*((rv(i-1, k, j+1)+&
&            rv(i, k, j+1)+rv(i-1, k, j)+rv(i, k, j))/msfuy(i, j))-0.25*(&
&            rw(i-1, k+1, j)+rw(i-1, k, j)+rw(i, k+1, j)+rw(i, k, j)))*&
&            ru_tendb(i, k, j)
          rvb(i-1, k, j+1) = rvb(i-1, k, j+1) + tempb2
          rvb(i, k, j+1) = rvb(i, k, j+1) + tempb2
          rvb(i-1, k, j) = rvb(i-1, k, j) + tempb2
          rvb(i, k, j) = rvb(i, k, j) + tempb2
          rwb(i-1, k+1, j) = rwb(i-1, k+1, j) + tempb3
          rwb(i-1, k, j) = rwb(i-1, k, j) + tempb3
          rwb(i, k+1, j) = rwb(i, k+1, j) + tempb3
          rwb(i, k, j) = rwb(i, k, j) + tempb3
        END DO
      END DO
    END DO
  ELSE
    DO j=min2,jts,-1
      DO k=ktf,kts,-1
        DO i=i_end,i_start,-1
          temp0b = 0.25*0.5*ru_tendb(i, k, j)
          temp0b0 = (rv(i-1, k, j+1)+rv(i, k, j+1)+rv(i-1, k, j)+rv(i, k&
&            , j))*temp0b
          temp0b1 = (vxgm(i, k, j)+vxgm(i-1, k, j))*temp0b
          temp0b2 = -(reradius*0.25*ru_tendb(i, k, j))
          temp0b3 = u(i, k, j)*temp0b2
          vxgmb(i, k, j) = vxgmb(i, k, j) + temp0b0
          vxgmb(i-1, k, j) = vxgmb(i-1, k, j) + temp0b0
          rvb(i-1, k, j+1) = rvb(i-1, k, j+1) + temp0b1
          rvb(i, k, j+1) = rvb(i, k, j+1) + temp0b1
          rvb(i-1, k, j) = rvb(i-1, k, j) + temp0b1
          rvb(i, k, j) = rvb(i, k, j) + temp0b1
          ub(i, k, j) = ub(i, k, j) + (rw(i-1, k+1, j)+rw(i-1, k, j)+rw(&
&            i, k+1, j)+rw(i, k, j))*temp0b2
          rwb(i-1, k+1, j) = rwb(i-1, k+1, j) + temp0b3
          rwb(i-1, k, j) = rwb(i-1, k, j) + temp0b3
          rwb(i, k+1, j) = rwb(i, k+1, j) + temp0b3
          rwb(i, k, j) = rwb(i, k, j) + temp0b3
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO k=ktf,kts,-1
      DO i=ite,its-1,-1
        vxgmb(i, k, jte-1) = vxgmb(i, k, jte-1) + vxgmb(i, k, jte)
        vxgmb(i, k, jte) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO k=ktf,kts,-1
      DO i=ite,its-1,-1
        vxgmb(i, k, jts) = vxgmb(i, k, jts) + vxgmb(i, k, jts-1)
        vxgmb(i, k, jts-1) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=jte-1,jts,-1
      DO k=ktf,kts,-1
        vxgmb(ite-1, k, j) = vxgmb(ite-1, k, j) + vxgmb(ite, k, j)
        vxgmb(ite, k, j) = 0.0
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=jte-1,jts,-1
      DO k=ktf,kts,-1
        vxgmb(its, k, j) = vxgmb(its, k, j) + vxgmb(its-1, k, j)
        vxgmb(its-1, k, j) = 0.0
      END DO
    END DO
  END IF
  CALL POPINTEGER4(ad_from0)
  CALL POPINTEGER4(ad_to0)
  DO j=ad_to0,ad_from0,-1
    DO k=ktf,kts,-1
      CALL POPINTEGER4(ad_from)
      CALL POPINTEGER4(ad_to)
      DO i=ad_to,ad_from,-1
        tempb = (msfvx(i, j+1)-msfvx(i, j))*rdy*0.5*vxgmb(i, k, j)
        tempb0 = -((msfuy(i+1, j)-msfuy(i, j))*rdx*0.5*vxgmb(i, k, j))
        ub(i, k, j) = ub(i, k, j) + tempb
        ub(i+1, k, j) = ub(i+1, k, j) + tempb
        vb(i, k, j) = vb(i, k, j) + tempb0
        vb(i, k, j+1) = vb(i, k, j+1) + tempb0
        vxgmb(i, k, j) = 0.0
      END DO
    END DO
  END DO
END SUBROUTINE A_CURVATURE

   SUBROUTINE a_zero_tend(a_tendency,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
   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) :: a_tendency
   INTEGER :: i,j,k,itf,jtf,ktf

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[0]
   DO j =jte, jts, -1

!  DO k =kts, kte
!  DO i =its, ite
!  tendency(i,k,j) =0.

!  ENDDO
!  ENDDO

   DO k =kte, kts, -1
   DO i =ite, its, -1
   a_tendency(i,k,j) =0.0
   ENDDO
   ENDDO

   ENDDO

   END SUBROUTINE a_zero_tend

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4343) - 10 Feb 2012 10:52
!
!  Differentiation of zero_tend2d in reverse (adjoint) mode:
!   gradient     of useful results: tendency
!   with respect to varying inputs: tendency
!   RW status of diff variables: tendency:in-out
SUBROUTINE A_ZERO_TEND2D(tendencyb, ids, ide, jds, jde, kds, &
&  kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Input data
  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, jms:jme), INTENT(INOUT) :: tendencyb
! Local data
  INTEGER :: i, j, k, itf, jtf, ktf
  DO j=jte,jts,-1
    DO i=ite,its,-1
      tendencyb(i, j) = 0.0
    END DO
  END DO
END SUBROUTINE A_ZERO_TEND2D

   SUBROUTINE a_zero_pole(field,a_field,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
   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
   INTEGER :: i,k

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!REVISED BY WALLS, BIG ERRORS
!  IF (jts == jds) THEN

!  IF (jte == jde) THEN

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]

!  IF(jte == jde) THEN
!  DO k =kts, kte
!  DO i =its-1, ite+1
!  field(i,k,jte) =0.

!  ENDDO
!  ENDDO
!  END IF

   IF(jte == jde) THEN

   DO k =kte, kts, -1
   DO i =ite+1, its-1, -1
   a_field(i,k,jte) =0.0
   ENDDO
   ENDDO

   END IF

!LPB[2]

!LPB[1]

!  IF(jts == jds) THEN
!  DO k =kts, kte
!  DO i =its-1, ite+1
!  field(i,k,jts) =0.

!  ENDDO
!  ENDDO
!  END IF

   IF(jts == jds) THEN

   DO k =kte, kts, -1
   DO i =ite+1, its-1, -1
   a_field(i,k,jts) =0.0
   ENDDO
   ENDDO

   END IF

!LPB[0]

   END SUBROUTINE a_zero_pole

   SUBROUTINE a_pole_point_bc(field,a_field,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
   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
   INTEGER :: i,k

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!REVISED BY WALLS, BIG ERROR
!  IF (jts == jds) THEN

!  IF (jte == jde) THEN

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[3]

!  IF(jte == jde) THEN
!  DO k =kts, kte
!  DO i =its, ite
!  field(i,k,jte) =field(i,k,jte-1)

!  ENDDO
!  ENDDO
!  END IF

   IF(jte == jde) THEN

   DO k =kte, kts, -1
   DO i =ite, its, -1
   a_field(i,k,jte-1) =a_field(i,k,jte-1) +a_field(i,k,jte)
   a_field(i,k,jte) =0.0
   ENDDO
   ENDDO

   END IF

!LPB[2]

!LPB[1]

!  IF(jts == jds) THEN
!  DO k =kts, kte
!  DO i =its, ite
!  field(i,k,jts) =field(i,k,jts+1)

!  ENDDO
!  ENDDO
!  END IF

   IF(jts == jds) THEN

   DO k =kte, kts, -1
   DO i =ite, its, -1
   a_field(i,k,jts+1) =a_field(i,k,jts+1) +a_field(i,k,jts)
   a_field(i,k,jts) =0.0
   ENDDO
   ENDDO

   END IF

!LPB[0]

   END SUBROUTINE a_pole_point_bc

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of phy_prep in reverse (adjoint) mode:
!   gradient     of useful results: rthndgdten rublten v_phy rqvndgdten
!                rthraten p rqccuten t rthcuten u v rqicuten z
!                th_phy rthften rvndgdten rqscuten t8w rqrshten
!                rqvshten rucuten pi_phy rvshten rqvblten rvblten
!                rphndgdten t_phy rqcshten rqvften rthshten rqgshten
!                p_hyd_w rqishten p_phy rqcblten moist ph rthblten
!                u_phy rqrcuten rqiblten alt rqsshten rqvcuten
!                p8w z_at_w rho rvcuten p_hyd rushten muu muv rundgdten
!                mu dz8w
!   with respect to varying inputs: rthndgdten rublten v_phy rqvndgdten
!                rthraten p rqccuten t rthcuten u v rqicuten z
!                th_phy rthften rvndgdten rqscuten t8w rqrshten
!                rqvshten rucuten pi_phy rvshten rqvblten rvblten
!                rphndgdten t_phy rqcshten rqvften rthshten rqgshten
!                p_hyd_w rqishten p_phy rqcblten moist ph rthblten
!                u_phy rqrcuten rqiblten alt rqsshten rqvcuten
!                p8w z_at_w rho rvcuten p_hyd rushten muu muv rundgdten
!                mu dz8w
!   RW status of diff variables: rthndgdten:in-out rublten:in-out
!                v_phy:in-out rqvndgdten:in-out rthraten:in-out
!                p:incr rqccuten:in-out t:incr rthcuten:in-out
!                u:incr v:incr rqicuten:in-out z:in-out th_phy:in-out
!                rthften:in-out rvndgdten:in-out rqscuten:in-out
!                t8w:in-out rqrshten:in-out rqvshten:in-out rucuten:in-out
!                pi_phy:in-out rvshten:in-out rqvblten:in-out rvblten:in-out
!                rphndgdten:in-out t_phy:in-out rqcshten:in-out
!                rqvften:in-out rthshten:in-out rqgshten:in-out
!                p_hyd_w:in-out rqishten:in-out p_phy:in-out rqcblten:in-out
!                moist:incr ph:incr rthblten:in-out u_phy:in-out
!                rqrcuten:in-out rqiblten:in-out alt:incr rqsshten:in-out
!                rqvcuten:in-out p8w:in-out z_at_w:in-out rho:in-out
!                rvcuten:in-out p_hyd:in-out rushten:in-out muu:incr
!                muv:incr rundgdten:in-out mu:incr dz8w:in-out
! input
! input
! input
! output
! output
! output
! output
! params
!01/2017 decoupling mu in A_PHY_PREP is moved to A_PHY_PREP_part2
SUBROUTINE A_PHY_PREP_part2(config_flags, mu, mub, muu, muub, muv, muvb, &
&  rthraten, rthratenb, rthblten, &
&  rthbltenb, rublten, rubltenb, rvblten, rvbltenb, rqvblten, rqvbltenb, &
&  rqcblten, rqcbltenb, rqiblten, rqibltenb, rucuten, rucutenb, rvcuten, &
&  rvcutenb, rthcuten, rthcutenb, rqvcuten, rqvcutenb, rqccuten, &
&  rqccutenb, rqrcuten, rqrcutenb, rqicuten, rqicutenb, rqscuten, &
&  rqscutenb, rushten, rushtenb, rvshten, rvshtenb, rthshten, rthshtenb, &
&  rqvshten, rqvshtenb, rqcshten, rqcshtenb, rqrshten, rqrshtenb, &
&  rqishten, rqishtenb, rqsshten, rqsshtenb, rqgshten, rqgshtenb, rthften&
&  , rthftenb, rqvften, rqvftenb, rundgdten, rundgdtenb, rvndgdten, &
&  rvndgdtenb, rthndgdten, rthndgdtenb, rphndgdten, rphndgdtenb, &
&  rqvndgdten, rqvndgdtenb, rmundgdten, ids, ide, jds, jde, kds, kde, ims&
&  , ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
!----------------------------------------------------------------------
  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, jms:jme), INTENT(IN) :: mu, muu, muv
  REAL, DIMENSION(ims:ime, jms:jme) :: mub, muub, muvb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthraten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rthratenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten, &
&  rvcuten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, &
&  rushten, rvshten, rthshten, rqvshten, rqcshten, rqrshten, rqishten, &
&  rqsshten, rqgshten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rucutenb, rvcutenb, &
&  rthcutenb, rqvcutenb, rqccutenb, rqrcutenb, rqicutenb, rqscutenb, &
&  rushtenb, rvshtenb, rthshtenb, rqvshtenb, rqcshtenb, rqrshtenb, &
&  rqishtenb, rqsshtenb, rqgshtenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
&  rvblten, rthblten, rqvblten, rqcblten, rqiblten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rubltenb, rvbltenb, &
&  rthbltenb, rqvbltenb, rqcbltenb, rqibltenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthften, &
&  rqvften
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rthftenb, rqvftenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rundgdten&
&  , rvndgdten, rthndgdten, rphndgdten, rqvndgdten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rundgdtenb, rvndgdtenb, &
&  rthndgdtenb, rphndgdtenb, rqvndgdtenb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rmundgdten
  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, &
&  j_startv
  INTEGER :: i, j, k
  INTEGER :: branch
  REAL :: temp1b29
  REAL :: temp1b28
  REAL :: temp1b27
  REAL :: temp1b26
  REAL :: temp1b25
  REAL :: temp1b24
  REAL :: temp1b23
  REAL :: temp1b22
  REAL :: temp1b21
  REAL :: temp1b20
  REAL :: temp1b19
  REAL :: temp1b18
  REAL :: temp1b17
  REAL :: temp1b16
  REAL :: temp1b15
  REAL :: temp1b14
  REAL :: temp1b13
  REAL :: temp1b12
  REAL :: temp1b11
  REAL :: temp1b10
  REAL :: temp1b9
  REAL :: temp1b8
  REAL :: temp1b7
  REAL :: temp1b6
  REAL :: temp1b5
  REAL :: temp1b4
  REAL :: temp1b3
  REAL :: temp1b2
  REAL :: temp1b1
  REAL :: temp1b0
  REAL :: temp1b
!-----------------------------------------------------------------------
!<DESCRIPTION>
!
!  phys_prep_part2 decouples the physics tendencies from
!  the column dry-air mass (the physics routines expect to see/update the
!  uncoupled tendencies).
!
!</DESCRIPTION>
!  set up loop bounds for this grid's boundary conditions
  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
  k_start = kts
  IF (kte .GT. kde - 1) THEN
    k_end = kde - 1
  ELSE
    k_end = kte
  END IF
! decouple all physics tendencies
  IF (config_flags%ra_lw_physics .GT. 0 .OR. config_flags%ra_sw_physics &
&      .GT. 0) THEN
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  IF (config_flags%cu_physics .GT. 0) THEN
    IF (p_qv .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qc .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qr .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qi .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qs .GE. param_first_scalar) THEN
      CALL PUSHCONTROL2B(0)
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
  ELSE
    CALL PUSHCONTROL2B(2)
  END IF
  IF (config_flags%shcu_physics .GT. 0) THEN
    IF (p_qv .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qc .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qr .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qi .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qs .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qg .GE. param_first_scalar) THEN
      CALL PUSHCONTROL2B(0)
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
  ELSE
    CALL PUSHCONTROL2B(2)
  END IF
  IF (config_flags%bl_pbl_physics .GT. 0) THEN
    IF (p_qv .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qc .GE. param_first_scalar) THEN
      CALL PUSHCONTROL1B(0)
    ELSE
      CALL PUSHCONTROL1B(1)
    END IF
    IF (p_qi .GE. param_first_scalar) THEN
      CALL PUSHCONTROL2B(0)
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
  ELSE
    CALL PUSHCONTROL2B(2)
  END IF
!  decouple advective forcing required by Grell-Devenyi scheme
  IF (((config_flags%cu_physics .EQ. gdscheme .OR. config_flags%&
&      cu_physics .EQ. g3scheme) .OR. config_flags%cu_physics .EQ. &
&      kfetascheme) .OR. config_flags%cu_physics .EQ. tiedtkescheme &
&      .OR. (config_flags%cu_physics == NTIEDTKESCHEME) &
&      .OR. (config_flags%cu_physics == MSKFSCHEME) ) THEN
    IF (p_qv .GE. param_first_scalar) THEN
      CALL PUSHCONTROL2B(0)
    ELSE
      CALL PUSHCONTROL2B(1)
    END IF
  ELSE
    CALL PUSHCONTROL2B(2)
  END IF
! fdda
! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
!   so only decouple those
  IF (config_flags%grid_fdda .GT. 0) THEN
    IF (its .LT. ids + 1) THEN
      i_startu = ids + 1
    ELSE
      i_startu = its
    END IF
    IF (jts .LT. jds + 1) THEN
      j_startv = jds + 1
    ELSE
      j_startv = jts
    END IF
!        RMUNDGDTEN(I,J) - no coupling
    IF (config_flags%grid_fdda .EQ. 2) THEN
      DO j=j_end,j_start,-1
        DO k=kte,k_start,-1
          DO i=i_end,i_start,-1
            temp1b28 = rphndgdtenb(i, k, j)/mu(i, j)
            mub(i, j) = mub(i, j) - rphndgdten(i, k, j)*temp1b28/mu(i, j&
&              )
            rphndgdtenb(i, k, j) = temp1b28
          END DO
        END DO
      END DO
    ELSE IF (config_flags%grid_fdda .EQ. 1) THEN
      IF (p_qv .GE. param_first_scalar) THEN
        DO j=j_end,j_start,-1
          DO k=k_end,k_start,-1
            DO i=i_end,i_start,-1
              temp1b29 = rqvndgdtenb(i, k, j)/mu(i, j)
              mub(i, j) = mub(i, j) - rqvndgdten(i, k, j)*temp1b29/mu(i&
&                , j)
              rqvndgdtenb(i, k, j) = temp1b29
            END DO
          END DO
        END DO
      END IF
    END IF
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b27 = rthndgdtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rthndgdten(i, k, j)*temp1b27/mu(i, j)
          rthndgdtenb(i, k, j) = temp1b27
        END DO
      END DO
    END DO
    DO j=j_end,j_startv,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b26 = rvndgdtenb(i, k, j)/muv(i, j)
          muvb(i, j) = muvb(i, j) - rvndgdten(i, k, j)*temp1b26/muv(i, j&
&            )
          rvndgdtenb(i, k, j) = temp1b26
        END DO
      END DO
    END DO
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_startu,-1
          temp1b25 = rundgdtenb(i, k, j)/muu(i, j)
          muub(i, j) = muub(i, j) - rundgdten(i, k, j)*temp1b25/muu(i, j&
&            )
          rundgdtenb(i, k, j) = temp1b25
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL2B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b24 = rqvftenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqvften(i, k, j)*temp1b24/mu(i, j)
          rqvftenb(i, k, j) = temp1b24
        END DO
      END DO
    END DO
  ELSE IF (branch .NE. 1) THEN
    GOTO 100
  END IF
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      DO k=k_end,k_start,-1
        temp1b23 = rthftenb(i, k, j)/mu(i, j)
        mub(i, j) = mub(i, j) - rthften(i, k, j)*temp1b23/mu(i, j)
        rthftenb(i, k, j) = temp1b23
      END DO
    END DO
  END DO
 100 CALL POPCONTROL2B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b22 = rqibltenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqiblten(i, k, j)*temp1b22/mu(i, j)
          rqibltenb(i, k, j) = temp1b22
        END DO
      END DO
    END DO
  ELSE IF (branch .NE. 1) THEN
    GOTO 110
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b21 = rqcbltenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqcblten(i, k, j)*temp1b21/mu(i, j)
          rqcbltenb(i, k, j) = temp1b21
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b20 = rqvbltenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqvblten(i, k, j)*temp1b20/mu(i, j)
          rqvbltenb(i, k, j) = temp1b20
        END DO
      END DO
    END DO
  END IF
  DO j=j_end,j_start,-1
    DO k=k_end,k_start,-1
      DO i=i_end,i_start,-1
        temp1b19 = rubltenb(i, k, j)/mu(i, j)
        temp1b18 = rvbltenb(i, k, j)/mu(i, j)
        temp1b17 = rthbltenb(i, k, j)/mu(i, j)
        mub(i, j) = mub(i, j) - rvblten(i, k, j)*temp1b18/mu(i, j) - &
&          rublten(i, k, j)*temp1b19/mu(i, j) - rthblten(i, k, j)*&
&          temp1b17/mu(i, j)
        rthbltenb(i, k, j) = temp1b17
        rvbltenb(i, k, j) = temp1b18
        rubltenb(i, k, j) = temp1b19
      END DO
    END DO
  END DO
 110 CALL POPCONTROL2B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b16 = rqgshtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqgshten(i, k, j)*temp1b16/mu(i, j)
          rqgshtenb(i, k, j) = temp1b16
        END DO
      END DO
    END DO
  ELSE IF (branch .NE. 1) THEN
    GOTO 120
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b15 = rqsshtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqsshten(i, k, j)*temp1b15/mu(i, j)
          rqsshtenb(i, k, j) = temp1b15
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b14 = rqishtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqishten(i, k, j)*temp1b14/mu(i, j)
          rqishtenb(i, k, j) = temp1b14
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b13 = rqrshtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqrshten(i, k, j)*temp1b13/mu(i, j)
          rqrshtenb(i, k, j) = temp1b13
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b12 = rqcshtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqcshten(i, k, j)*temp1b12/mu(i, j)
          rqcshtenb(i, k, j) = temp1b12
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b11 = rqvshtenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqvshten(i, k, j)*temp1b11/mu(i, j)
          rqvshtenb(i, k, j) = temp1b11
        END DO
      END DO
    END DO
  END IF
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      DO k=k_end,k_start,-1
        temp1b10 = rushtenb(i, k, j)/mu(i, j)
        temp1b9 = rvshtenb(i, k, j)/mu(i, j)
        temp1b8 = rthshtenb(i, k, j)/mu(i, j)
        mub(i, j) = mub(i, j) - rvshten(i, k, j)*temp1b9/mu(i, j) - &
&          rushten(i, k, j)*temp1b10/mu(i, j) - rthshten(i, k, j)*temp1b8&
&          /mu(i, j)
        rthshtenb(i, k, j) = temp1b8
        rvshtenb(i, k, j) = temp1b9
        rushtenb(i, k, j) = temp1b10
      END DO
    END DO
  END DO
 120 CALL POPCONTROL2B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b7 = rqscutenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqscuten(i, k, j)*temp1b7/mu(i, j)
          rqscutenb(i, k, j) = temp1b7
        END DO
      END DO
    END DO
  ELSE IF (branch .NE. 1) THEN
    GOTO 130
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b6 = rqicutenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqicuten(i, k, j)*temp1b6/mu(i, j)
          rqicutenb(i, k, j) = temp1b6
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b5 = rqrcutenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqrcuten(i, k, j)*temp1b5/mu(i, j)
          rqrcutenb(i, k, j) = temp1b5
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b4 = rqccutenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqccuten(i, k, j)*temp1b4/mu(i, j)
          rqccutenb(i, k, j) = temp1b4
        END DO
      END DO
    END DO
  END IF
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        DO k=k_end,k_start,-1
          temp1b3 = rqvcutenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rqvcuten(i, k, j)*temp1b3/mu(i, j)
          rqvcutenb(i, k, j) = temp1b3
        END DO
      END DO
    END DO
  END IF
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      DO k=k_end,k_start,-1
        temp1b2 = rucutenb(i, k, j)/mu(i, j)
        temp1b1 = rvcutenb(i, k, j)/mu(i, j)
        temp1b0 = rthcutenb(i, k, j)/mu(i, j)
        mub(i, j) = mub(i, j) - rvcuten(i, k, j)*temp1b1/mu(i, j) - &
&          rucuten(i, k, j)*temp1b2/mu(i, j) - rthcuten(i, k, j)*temp1b0/&
&          mu(i, j)
        rthcutenb(i, k, j) = temp1b0
        rvcutenb(i, k, j) = temp1b1
        rucutenb(i, k, j) = temp1b2
      END DO
    END DO
  END DO
 130 CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) THEN
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          temp1b = rthratenb(i, k, j)/mu(i, j)
          mub(i, j) = mub(i, j) - rthraten(i, k, j)*temp1b/mu(i, j)
          rthratenb(i, k, j) = temp1b
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_PHY_PREP_part2
SUBROUTINE A_PHY_PREP(config_flags, mu, mub, muu, muub, muv, muvb, u, ub&
&  , v, vb, p, pb0, pb, alt, altb, ph, phb0, phb, t, tb, moist, &
&  moistb, n_moist, rho, rhob, th_phy, th_phyb, p_phy, p_phyb, pi_phy, &
&  pi_phyb, u_phy, u_phyb, v_phy, v_phyb, p8w, p8wb, t_phy, t_phyb, t8w, &
&  t8wb, z, zb, z_at_w, z_at_wb, dz8w, dz8wb, p_hyd, p_hydb, p_hyd_w, &
&  p_hyd_wb, dnw, fzm, fzp, znw, p_top, &
&  ids, ide, jds, jde, kds, kde, ims&
&  , ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
!----------------------------------------------------------------------
  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
  INTEGER, INTENT(IN) :: n_moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(IN) :: &
&  moist
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist) :: moistb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mu, muu, muv
  REAL, DIMENSION(ims:ime, jms:jme) :: mub, muub, muvb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phy, v_phy, pi_phy, &
&  p_phy, p8w, t_phy, th_phy, t8w, rho, z, dz8w, z_at_w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phyb, v_phyb, pi_phyb&
&  , p_phyb, p8wb, t_phyb, th_phyb, t8wb, rhob, zb, dz8wb, z_at_wb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: p_hyd, p_hyd_w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: p_hydb, p_hyd_wb
  REAL, INTENT(IN) :: p_top
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: pb, p, u, v&
&  , alt, ph, phb, t
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: pb0, ub, vb, altb, phb0&
&  , tb
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp
  REAL, DIMENSION(kms:kme), INTENT(IN) :: znw, dnw
  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, &
&  j_startv
  INTEGER :: i, j, k
  REAL :: w1, w2, z0, z1, z2
  REAL :: w1b, w2b, z0b, z1b, z2b
  REAL :: qtot
  REAL :: qtotb
  INTEGER :: n
  INTEGER :: branch
  REAL :: temp0
  REAL :: tempb4
  REAL :: tempb3
  REAL :: tempb2
  REAL :: tempb1
  REAL :: tempb0
  REAL :: tempb
  REAL :: temp
!-----------------------------------------------------------------------
!<DESCRIPTION>
!
!  phys_prep calculates a number of diagnostic quantities needed by
!  the physics routines.
!
!</DESCRIPTION>
!  set up loop bounds for this grid's boundary conditions
  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
  k_start = kts
  IF (kte .GT. kde - 1) THEN
    k_end = kde - 1
  ELSE
    k_end = kte
  END IF

!  compute thermodynamics and velocities at pressure points (or half levels)
  DO j=j_start,j_end
    DO k=k_start,k_end
      DO i=i_start,i_end
        th_phy(i, k, j) = t(i, k, j) + t0
        p_phy(i, k, j) = p(i, k, j) + pb(i, k, j)
        pi_phy(i, k, j) = (p_phy(i, k, j)/p1000mb)**rcp
        t_phy(i, k, j) = th_phy(i, k, j)*pi_phy(i, k, j)
      END DO
    END DO
  END DO
!  compute z at w points
  DO j=j_start,j_end
    DO k=k_start,kte
      DO i=i_start,i_end
        z_at_w(i, k, j) = (phb(i, k, j)+ph(i, k, j))/g
      END DO
    END DO
  END DO
!  compute z at p points or half levels (average of z at full levels)
  DO j=j_start,j_end
    DO k=k_start,k_end
      DO i=i_start,i_end
        z(i, k, j) = 0.5*(z_at_w(i, k, j)+z_at_w(i, k+1, j))
      END DO
    END DO
  END DO
  DO j=j_start,j_end
    DO k=kte-1,k_start,-1
      DO i=i_start,i_end
        CALL PUSHREAL8(qtot)
        qtot = 0.
        DO n=param_first_scalar,n_moist
          qtot = qtot + moist(i, k, j, n)
        END DO
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,k_start,-1
      DO i=i_end,i_start,-1
        p_hyd_wb(i, k, j) = p_hyd_wb(i, k, j) + 0.5*p_hydb(i, k, j)
        p_hyd_wb(i, k+1, j) = p_hyd_wb(i, k+1, j) + 0.5*p_hydb(i, k, j)
        p_hydb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_start,kte-1,1
      DO i=i_end,i_start,-1
        p_hyd_wb(i, k+1, j) = p_hyd_wb(i, k+1, j) + p_hyd_wb(i, k, j)
        qtotb = -(dnw(k)*mu(i, j)*p_hyd_wb(i, k, j))
        mub(i, j) = mub(i, j) - dnw(k)*(qtot+1.)*p_hyd_wb(i, k, j)
        p_hyd_wb(i, k, j) = 0.0
        DO n=n_moist,param_first_scalar,-1
          moistb(i, k, j, n) = moistb(i, k, j, n) + qtotb
        END DO
        CALL POPREAL8(qtot)
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      p_hyd_wb(i, kte, j) = 0.0
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      z0 = z_at_w(i, kte, j)
      z1 = z(i, k_end, j)
      z2 = z(i, k_end-1, j)
      w1 = (z0-z2)/(z1-z2)
      w2 = 1. - w1
      t_phyb(i, kde-1, j) = t_phyb(i, kde-1, j) + w1*t8wb(i, kde, j)
      t_phyb(i, kde-2, j) = t_phyb(i, kde-2, j) + w2*t8wb(i, kde, j)
      temp0 = LOG(p_phy(i, kde-2, j))
      temp = LOG(p_phy(i, kde-1, j))
      tempb0 = EXP(w1*temp+w2*temp0)*p8wb(i, kde, j)
      w2b = temp0*tempb0 + t_phy(i, kde-2, j)*t8wb(i, kde, j)
      w1b = temp*tempb0 - w2b + t_phy(i, kde-1, j)*t8wb(i, kde, j)
      t8wb(i, kde, j) = 0.0
      p_phyb(i, kde-1, j) = p_phyb(i, kde-1, j) + w1*tempb0/p_phy(i, kde&
&        -1, j)
      p_phyb(i, kde-2, j) = p_phyb(i, kde-2, j) + w2*tempb0/p_phy(i, kde&
&        -2, j)
      p8wb(i, kde, j) = 0.0
      tempb1 = w1b/(z1-z2)
      tempb2 = -((z0-z2)*tempb1/(z1-z2))
      z0b = tempb1
      z2b = -tempb2 - tempb1
      z1b = tempb2
      zb(i, k_end-1, j) = zb(i, k_end-1, j) + z2b
      zb(i, k_end, j) = zb(i, k_end, j) + z1b
      z_at_wb(i, kte, j) = z_at_wb(i, kte, j) + z0b
      z0 = z_at_w(i, 1, j)
      z1 = z(i, 1, j)
      z2 = z(i, 2, j)
      w1 = (z0-z2)/(z1-z2)
      w2 = 1. - w1
      t_phyb(i, 1, j) = t_phyb(i, 1, j) + w1*t8wb(i, 1, j)
      w2b = p_phy(i, 2, j)*p8wb(i, 1, j) + t_phy(i, 2, j)*t8wb(i, 1, j)
      w1b = p_phy(i, 1, j)*p8wb(i, 1, j) - w2b + t_phy(i, 1, j)*t8wb(i, &
&        1, j)
      t_phyb(i, 2, j) = t_phyb(i, 2, j) + w2*t8wb(i, 1, j)
      t8wb(i, 1, j) = 0.0
      p_phyb(i, 1, j) = p_phyb(i, 1, j) + w1*p8wb(i, 1, j)
      p_phyb(i, 2, j) = p_phyb(i, 2, j) + w2*p8wb(i, 1, j)
      p8wb(i, 1, j) = 0.0
      tempb3 = w1b/(z1-z2)
      tempb4 = -((z0-z2)*tempb3/(z1-z2))
      z0b = tempb3
      z2b = -tempb4 - tempb3
      z1b = tempb4
      zb(i, 2, j) = zb(i, 2, j) + z2b
      zb(i, 1, j) = zb(i, 1, j) + z1b
      z_at_wb(i, 1, j) = z_at_wb(i, 1, j) + z0b
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,2,-1
      DO i=i_end,i_start,-1
        t_phyb(i, k, j) = t_phyb(i, k, j) + fzm(k)*t8wb(i, k, j)
        t_phyb(i, k-1, j) = t_phyb(i, k-1, j) + fzp(k)*t8wb(i, k, j)
        t8wb(i, k, j) = 0.0
        p_phyb(i, k, j) = p_phyb(i, k, j) + fzm(k)*p8wb(i, k, j)
        p_phyb(i, k-1, j) = p_phyb(i, k-1, j) + fzp(k)*p8wb(i, k, j)
        p8wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,k_start,-1
      DO i=i_end,i_start,-1
        z_at_wb(i, k, j) = z_at_wb(i, k, j) + 0.5*zb(i, k, j)
        z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + 0.5*zb(i, k, j)
        zb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      dz8wb(i, kte, j) = 0.0
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=kte-1,k_start,-1
      DO i=i_end,i_start,-1
        z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + dz8wb(i, k, j)
        z_at_wb(i, k, j) = z_at_wb(i, k, j) - dz8wb(i, k, j)
        dz8wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=kte,k_start,-1
      DO i=i_end,i_start,-1
        phb0(i, k, j) = phb0(i, k, j) + z_at_wb(i, k, j)/g
        z_at_wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,k_start,-1
      DO i=i_end,i_start,-1
        vb(i, k, j) = vb(i, k, j) + 0.5*v_phyb(i, k, j)
        vb(i, k, j+1) = vb(i, k, j+1) + 0.5*v_phyb(i, k, j)
        v_phyb(i, k, j) = 0.0
        ub(i, k, j) = ub(i, k, j) + 0.5*u_phyb(i, k, j)
        ub(i+1, k, j) = ub(i+1, k, j) + 0.5*u_phyb(i, k, j)
        u_phyb(i, k, j) = 0.0
        tempb = rhob(i, k, j)/alt(i, k, j)
        moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + tempb
        altb(i, k, j) = altb(i, k, j) - (moist(i, k, j, p_qv)+1.)*tempb/&
&          alt(i, k, j)
        rhob(i, k, j) = 0.0
        th_phyb(i, k, j) = th_phyb(i, k, j) + pi_phy(i, k, j)*t_phyb(i, &
&          k, j)
        pi_phyb(i, k, j) = pi_phyb(i, k, j) + th_phy(i, k, j)*t_phyb(i, &
&          k, j)
        t_phyb(i, k, j) = 0.0
        IF (.NOT.(p_phy(i, k, j)/p1000mb .LE. 0.0 .AND. (rcp .EQ. 0.0 &
&            .OR. rcp .NE. INT(rcp)))) p_phyb(i, k, j) = p_phyb(i, k, j) &
&            + rcp*(p_phy(i, k, j)/p1000mb)**(rcp-1)*pi_phyb(i, k, j)/&
&            p1000mb
        pi_phyb(i, k, j) = 0.0
        pb0(i, k, j) = pb0(i, k, j) + p_phyb(i, k, j)
        p_phyb(i, k, j) = 0.0
        tb(i, k, j) = tb(i, k, j) + th_phyb(i, k, j)
        th_phyb(i, k, j) = 0.0
      END DO
    END DO
  END DO
END SUBROUTINE A_PHY_PREP

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
!
!  Differentiation of moist_physics_prep_em in reverse (adjoint) mode:
!   gradient     of useful results: p al z th_phy h_diabatic t_new
!                pf ph p8w z_at_w rho pii dz8w
!   with respect to varying inputs: p al z th_phy h_diabatic t_new
!                pf ph p8w z_at_w rho pii dz8w
!   RW status of diff variables: p:incr al:incr z:in-out th_phy:in-out
!                h_diabatic:in-out t_new:incr pf:in-out ph:incr
!                p8w:in-out z_at_w:in-out rho:in-out pii:in-out
!                dz8w:in-out
SUBROUTINE A_MOIST_PHYSICS_PREP_EM(t_new, t_newb, t_old, t0, rho, rhob, &
&  al, alb0, alb, p, pb0, p8w, p8wb, p0, pb, ph, phb0, phb, th_phy, &
&  th_phyb, pii, piib, pf, pfb, z, zb, z_at_w, z_at_wb, dz8w, dz8wb, dt, &
&  h_diabatic, h_diabaticb, &
&  qv, qvb, qv_diabatic, qv_diabaticb, &
&  qc, qcb, qc_diabatic, qc_diabaticb, &
&  config_flags, fzm, fzp, ids, ide, jds, jde, &
&  kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
! Here we construct full fields
! needed by the microphysics
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde
  INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
  INTEGER, INTENT(IN) :: its, ite, jts, jte, kts, kte
  REAL, INTENT(IN) :: dt
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: al, alb, p, &
&  pb, ph, phb, qv, qc
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: alb0, pb0, phb0
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: qvb, qcb
  REAL, DIMENSION(kms:kme), INTENT(IN) :: fzm, fzp
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rho, th_phy, pii, pf, z&
&  , z_at_w, dz8w, p8w
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rhob, th_phyb, piib, pfb&
&  , zb, z_at_wb, dz8wb, p8wb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
&  h_diabatic, qv_diabatic, qc_diabatic
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: h_diabaticb, &
&  qv_diabaticb, qc_diabaticb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: t_new, &
&  t_old
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: t_newb
  REAL, INTENT(IN) :: t0, p0
  REAL :: z0, z1, z2, w1, w2
  REAL :: z0b, z1b, z2b, w1b, w2b
  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
  INTEGER :: i, j, k
  INTEGER :: branch
  REAL :: temp1
  REAL :: temp0
  REAL :: temp0b
  REAL :: temp0b3
  REAL :: temp0b2
  REAL :: temp0b1
  REAL :: temp0b0
  REAL :: temp
!--------------------------------------------------------------------
!<DESCRIPTION>
!
!  moist_phys_prep_em calculates a number of diagnostic quantities needed by
!  the microphysics routines.
!
!</DESCRIPTION>
!  set up loop bounds for this grid's boundary conditions
  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
  k_start = kts
  IF (kte .GT. kde - 1) THEN
    k_end = kde - 1
  ELSE
    k_end = kte
  END IF
  DO j=j_start,j_end
    DO k=k_start,kte
      DO i=i_start,i_end
        z_at_w(i, k, j) = (ph(i, k, j)+phb(i, k, j))/g
      END DO
    END DO
  END DO
!  compute full pii, rho, and z at the new time-level
!  (needed for physics).
!  convert perturbation theta to full theta (th_phy)
!  use h_diabatic to temporarily save pre-microphysics full theta
  DO j=j_start,j_end
    DO k=k_start,k_end
      DO i=i_start,i_end
        IF (p_qv .GE. param_first_scalar) THEN
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        IF (p_qc .GE. param_first_scalar) THEN
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
        END IF
        z(i, k, j) = 0.5*(z_at_w(i, k, j)+z_at_w(i, k+1, j))
        pf(i, k, j) = p(i, k, j) + pb(i, k, j)
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      z0 = z_at_w(i, kte, j)
      z1 = z(i, k_end, j)
      z2 = z(i, k_end-1, j)
      w1 = (z0-z2)/(z1-z2)
      w2 = 1. - w1
      temp1 = LOG(pf(i, kde-2, j))
      temp0 = LOG(pf(i, kde-1, j))
      temp0b = EXP(w1*temp0+w2*temp1)*p8wb(i, kde, j)
      pfb(i, kde-1, j) = pfb(i, kde-1, j) + w1*temp0b/pf(i, kde-1, j)
      w2b = temp1*temp0b
      w1b = temp0*temp0b - w2b
      pfb(i, kde-2, j) = pfb(i, kde-2, j) + w2*temp0b/pf(i, kde-2, j)
      p8wb(i, kde, j) = 0.0
      temp0b0 = w1b/(z1-z2)
      temp0b1 = -((z0-z2)*temp0b0/(z1-z2))
      z0b = temp0b0
      z2b = -temp0b1 - temp0b0
      z1b = temp0b1
      zb(i, k_end-1, j) = zb(i, k_end-1, j) + z2b
      zb(i, k_end, j) = zb(i, k_end, j) + z1b
      z_at_wb(i, kte, j) = z_at_wb(i, kte, j) + z0b
      z0 = z_at_w(i, 1, j)
      z1 = z(i, 1, j)
      z2 = z(i, 2, j)
      w1 = (z0-z2)/(z1-z2)
      w2 = 1. - w1
      pfb(i, 1, j) = pfb(i, 1, j) + w1*p8wb(i, 1, j)
      w2b = pf(i, 2, j)*p8wb(i, 1, j)
      w1b = pf(i, 1, j)*p8wb(i, 1, j) - w2b
      pfb(i, 2, j) = pfb(i, 2, j) + w2*p8wb(i, 1, j)
      p8wb(i, 1, j) = 0.0
      temp0b2 = w1b/(z1-z2)
      temp0b3 = -((z0-z2)*temp0b2/(z1-z2))
      z0b = temp0b2
      z2b = -temp0b3 - temp0b2
      z1b = temp0b3
      zb(i, 2, j) = zb(i, 2, j) + z2b
      zb(i, 1, j) = zb(i, 1, j) + z1b
      z_at_wb(i, 1, j) = z_at_wb(i, 1, j) + z0b
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,2,-1
      DO i=i_end,i_start,-1
        pfb(i, k, j) = pfb(i, k, j) + fzm(k)*p8wb(i, k, j)
        pfb(i, k-1, j) = pfb(i, k-1, j) + fzp(k)*p8wb(i, k, j)
        p8wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=k_end,k_start,-1
      DO i=i_end,i_start,-1
        IF ((pb(i, k, j)+p(i, k, j))/p0 .LE. 0.0 .AND. (rcp .EQ. 0.0 &
&            .OR. rcp .NE. INT(rcp))) THEN
          pb0(i, k, j) = pb0(i, k, j) + pfb(i, k, j)
        ELSE
          pb0(i, k, j) = pb0(i, k, j) + rcp*((pb(i, k, j)+p(i, k, j))/p0&
&            )**(rcp-1)*piib(i, k, j)/p0 + pfb(i, k, j)
        END IF
        pfb(i, k, j) = 0.0
        z_at_wb(i, k, j) = z_at_wb(i, k, j) + 0.5*zb(i, k, j)
        z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + 0.5*zb(i, k, j)
        zb(i, k, j) = 0.0
        piib(i, k, j) = 0.0
        temp = alb(i, k, j) + al(i, k, j)
        alb0(i, k, j) = alb0(i, k, j) - rhob(i, k, j)/temp**2
        rhob(i, k, j) = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          qcb(i, k, j) = qcb(i, k, j) + qc_diabaticb(i, k, j)
          qc_diabaticb(i, k, j) = 0.0
        ELSE
          qc_diabaticb(i, k, j) = 0.0
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          qvb(i, k, j) = qvb(i, k, j) + qv_diabaticb(i, k, j)
          qv_diabaticb(i, k, j) = 0.0
        ELSE
          qv_diabaticb(i, k, j) = 0.0
        END IF
        th_phyb(i, k, j) = th_phyb(i, k, j) + h_diabaticb(i, k, j)
        h_diabaticb(i, k, j) = 0.0
        t_newb(i, k, j) = t_newb(i, k, j) + th_phyb(i, k, j)
        th_phyb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO i=i_end,i_start,-1
      dz8wb(i, kte, j) = 0.0
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=kte-1,k_start,-1
      DO i=i_end,i_start,-1
        z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + dz8wb(i, k, j)
        z_at_wb(i, k, j) = z_at_wb(i, k, j) - dz8wb(i, k, j)
        dz8wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
  DO j=j_end,j_start,-1
    DO k=kte,k_start,-1
      DO i=i_end,i_start,-1
        phb0(i, k, j) = phb0(i, k, j) + z_at_wb(i, k, j)/g
        z_at_wb(i, k, j) = 0.0
      END DO
    END DO
  END DO
END SUBROUTINE A_MOIST_PHYSICS_PREP_EM

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of moist_physics_finish_em in reverse (adjoint) mode (with options i4 r8):
!   gradient     of useful results: th_phy h_diabatic t_new
!   with respect to varying inputs: th_phy h_diabatic t_new
!   RW status of diff variables: th_phy:incr h_diabatic:in-out
!                t_new:in-out
SUBROUTINE A_MOIST_PHYSICS_FINISH_EM(t_new, t_newb, t_old, t0, mut, &
&  th_phy, th_phyb, h_diabatic, h_diabaticb, &
&  qv, qvb, qv_diabatic, qv_diabaticb, &
&  qc, qcb, qc_diabatic, qc_diabaticb, &
&  dt, config_flags, ids, ide, &
&  jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
&  kts, kte)
  IMPLICIT NONE
! Here we construct full fields
! needed by the microphysics
  TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde
  INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
  INTEGER, INTENT(IN) :: its, ite, jts, jte, kts, kte
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: t_new, &
&  t_old, th_phy, h_diabatic
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: qv, qc
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: qvb, qcb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
&   qv_diabatic, qv_diabaticb, qc_diabatic, qc_diabaticb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: t_newb
  REAL :: mpten, qvten, qcten
  REAL :: mptenb, qvtenb, qctenb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mut
  REAL, INTENT(IN) :: t0, dt
  INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
  INTEGER :: i, j, k, imax, jmax, imin, jmin
  INTEGER :: branch
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
&  h_diabaticb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th_phyb
!--------------------------------------------------------------------
!<DESCRIPTION>
!
!  moist_phys_finish_em resets theta to its perturbation value and
!  computes and stores the microphysics diabatic heating term.
!
!</DESCRIPTION>
!  set up loop bounds for this grid's boundary conditions
  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
  k_start = kts
  IF (kte .GT. kde - 1) THEN
    k_end = kde - 1
  ELSE
    k_end = kte
  END IF
!  add microphysics theta diff to perturbation theta, set h_diabatic
  IF (config_flags%no_mp_heating .EQ. 0) THEN
    DO j=j_start,j_end
      DO k=k_start,k_end
        DO i=i_start,i_end
          mpten = th_phy(i, k, j) - h_diabatic(i, k, j)
          IF (p_qv .GE. param_first_scalar) THEN
            !qvten = qv(i, k, j) - qv_diabatic(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (p_qc .GE. param_first_scalar) THEN
            !qcten = qc(i, k, j) - qc_diabatic(i, k, j)
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (config_flags%mp_tend_lim*dt .GT. mpten) THEN
            CALL PUSHCONTROL1B(0)
            mpten = mpten
          ELSE
            mpten = config_flags%mp_tend_lim*dt
            CALL PUSHCONTROL1B(1)
          END IF
          IF (-(config_flags%mp_tend_lim*dt) .LT. mpten) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (p_qv .GE. param_first_scalar) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          IF (p_qc .GE. param_first_scalar) THEN
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
        END DO
      END DO
    END DO
    qvtenb = 0.0
    qctenb = 0.0
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            qctenb = qctenb + qc_diabaticb(i, k, j)/dt
            qc_diabaticb(i, k, j) = 0.0
          ELSE
            qc_diabaticb(i, k, j) = 0.0
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            qvtenb = qvtenb + qv_diabaticb(i, k, j)/dt
            qv_diabaticb(i, k, j) = 0.0
          ELSE
            qv_diabaticb(i, k, j) = 0.0
          END IF
          mptenb = t_newb(i, k, j) + h_diabaticb(i, k, j)/dt
          h_diabaticb(i, k, j) = 0.0_8
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) mptenb = 0.0_8
          CALL POPCONTROL1B(branch)
          IF (branch .NE. 0) mptenb = 0.0_8
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            qcb(i, k, j) = qcb(i, k, j) + qctenb
            qc_diabaticb(i, k, j) = qc_diabaticb(i, k, j) - qctenb
            qctenb = 0.0
          END IF
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) THEN
            qvb(i, k, j) = qvb(i, k, j) + qvtenb
            qv_diabaticb(i, k, j) = qv_diabaticb(i, k, j) - qvtenb
            qvtenb = 0.0
          END IF
          th_phyb(i, k, j) = th_phyb(i, k, j) + mptenb
          h_diabaticb(i, k, j) = h_diabaticb(i, k, j) - mptenb
        END DO
      END DO
    END DO
  ELSE
    DO j=j_end,j_start,-1
      DO k=k_end,k_start,-1
        DO i=i_end,i_start,-1
          qc_diabaticb(i, k, j) = 0.0
          qv_diabaticb(i, k, j) = 0.0
          h_diabaticb(i, k, j) = 0.0_8
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE A_MOIST_PHYSICS_FINISH_EM

   SUBROUTINE a_init_module_big_step

   END SUBROUTINE a_init_module_big_step

   SUBROUTINE a_set_tend(field,a_field,field_adv_tend,a_field_adv_tend,msf, &
! Revised by Ning Pan, 2010-07-19
!   a_msf,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
   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
   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
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: field_adv_tend,a_field_adv_tend
! Revised by Ning Pan, 2010-07-19
!   REAL,DIMENSION(ims:ime,jms:jme) :: msf,a_msf
   REAL,DIMENSION(ims:ime,jms:jme) :: msf
   INTEGER :: i,j,k,itf,jtf,ktf

   REAL :: a_Tmpv1,Tmpv001

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]

         jtf = MIN(jte,jde-1)
         ktf = MIN(kte,kde-1)
         itf = MIN(ite,ide-1)

!!LPB[1]
!         DO j = jts, jtf

!         DO k = kts, ktf
!         DO i = its, itf
!            field(i,k,j) = field_adv_tend(i,k,j)*msf(i,j)
!         ENDDO
!         ENDDO

!         ENDDO

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[1]
   DO j =jtf, jts, -1

!  DO k =kts, ktf
!  DO i =its, itf
!  Tmpv001 =field_adv_tend(i,k,j)*msf(i,j)
!  field(i,k,j) =Tmpv001

!  ENDDO
!  ENDDO

   DO k =ktf, kts, -1
   DO i =itf, its, -1
   a_Tmpv1 =a_field(i,k,j)
   a_field(i,k,j) =0.0
   a_field_adv_tend(i,k,j) =a_field_adv_tend(i,k,j) +msf(i,j)*a_Tmpv1
!   a_msf(i,j) =a_msf(i,j) +field_adv_tend(i,k,j)*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-19
   ENDDO
   ENDDO

   ENDDO

!LPB[0]
!  jtf =min(jte, jde-1)
!  ktf =min(kte, kde-1)
!  itf =min(ite, ide-1)

   END SUBROUTINE a_set_tend

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.5 (r3805) - 29 Mar 2011 12:57
!
!  Differentiation of theta_relaxation in reverse (adjoint) mode:
!   gradient     of useful results: t ph t_tendf mut
!   with respect to varying inputs: t ph t_tendf mut
!   RW status of diff variables: t:incr ph:incr t_tendf:in-out
!                mut:incr
SUBROUTINE A_THETA_RELAXATION(t_tendf, t_tendfb, t, tb, t_init, mut, &
&  mutb, ph, phb0, phb, t_base, z_base, ids, ide, jds, jde, kds, kde, ims&
&  , ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
  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(INOUT) :: t_tendf
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: t_tendfb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: t, t_init, &
&  ph, phb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: tb, phb0
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme) :: mutb
  REAL, DIMENSION(kms:kme), INTENT(IN) :: t_base, z_base
! Local variables.
  INTEGER :: i, j, k, ktf, k2
  REAL :: tau_r, rmax, rmin, inv_tau_r, inv_g, rterm
  REAL :: rtermb
  REAL, DIMENSION(kms:kme) :: z00, t00
  REAL, DIMENSION(kms:kme) :: z00b, t00b
  INTEGER :: branch
  INTEGER :: ad_to
  INTEGER :: min2
  INTEGER :: min1
  REAL :: tempb
! End declarations.
!-----------------------------------------------------------------------
! set tau_r to 12 h, following RE87
  tau_r = 12.0*3600.0
! limit rterm to +/- 2 K/day
  rmax = 2.0/86400.0
  rmin = -rmax
  IF (kte .GT. kde - 1) THEN
    ktf = kde - 1
  ELSE
    ktf = kte
  END IF
  inv_tau_r = 1.0/tau_r
  inv_g = 1.0/g
  IF (jte .GT. jde - 1) THEN
    min1 = jde - 1
  ELSE
    min1 = jte
  END IF
!-----------------------------------------------------------------------
! Adjust potential temperature to base state.
  DO j=jts,min1
    IF (ite .GT. ide - 1) THEN
      min2 = ide - 1
    ELSE
      min2 = ite
    END IF
    DO i=its,min2
! Get height of model levels:
      DO k=kts,ktf
        z00(k) = 0.5*(phb(i, k, j)+phb(i, k+1, j)+ph(i, k, j)+ph(i, k+1&
&          , j))*inv_g
      END DO
! Get reference state:
      DO k=kts,ktf
        CALL PUSHINTEGER4(k2)
        k2 = ktf
        DO WHILE (z_base(k2) .GT. z00(k) .AND. k2 .GT. 1)
          k2 = k2 - 1
        END DO
        IF (k2 + 1 .GT. ktf) THEN
          t00(k) = t_base(k2) + (t_base(k2)-t_base(k2-1))*(z00(k)-z_base&
&            (k2))/(z_base(k2)-z_base(k2-1))
          CALL PUSHCONTROL1B(1)
        ELSE
          t00(k) = t_base(k2) + (t_base(k2+1)-t_base(k2))*(z00(k)-z_base&
&            (k2))/(z_base(k2+1)-z_base(k2))
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
! Apply the RE87 R term:
      DO k=kts,ktf
        CALL PUSHREAL8(rterm)
        rterm = -((t(i, k, j)-t00(k))*inv_tau_r)
        IF (rterm .GT. rmax) THEN
          rterm = rmax
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
          rterm = rterm
        END IF
        IF (rterm .LT. rmin) THEN
          rterm = rmin
          CALL PUSHCONTROL1B(0)
        ELSE
          CALL PUSHCONTROL1B(1)
          rterm = rterm
        END IF
      END DO
    END DO
    CALL PUSHINTEGER4(i - 1)
  END DO
  t00b = 0.0
  z00b = 0.0
  DO j=min1,jts,-1
    CALL POPINTEGER4(ad_to)
    DO i=ad_to,its,-1
      DO k=ktf,kts,-1
        mutb(i, j) = mutb(i, j) + rterm*t_tendfb(i, k, j)
        rtermb = mut(i, j)*t_tendfb(i, k, j)
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) rtermb = 0.0
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) rtermb = 0.0
        CALL POPREAL8(rterm)
        tb(i, k, j) = tb(i, k, j) - inv_tau_r*rtermb
        t00b(k) = t00b(k) + inv_tau_r*rtermb
      END DO
      DO k=ktf,kts,-1
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          z00b(k) = z00b(k) + (t_base(k2+1)-t_base(k2))*t00b(k)/(z_base(&
&            k2+1)-z_base(k2))
          t00b(k) = 0.0
        ELSE
          z00b(k) = z00b(k) + (t_base(k2)-t_base(k2-1))*t00b(k)/(z_base(&
&            k2)-z_base(k2-1))
          t00b(k) = 0.0
        END IF
        CALL POPINTEGER4(k2)
      END DO
      DO k=ktf,kts,-1
        tempb = inv_g*0.5*z00b(k)
        phb0(i, k, j) = phb0(i, k, j) + tempb
        phb0(i, k+1, j) = phb0(i, k+1, j) + tempb
        z00b(k) = 0.0
      END DO
    END DO
  END DO
END SUBROUTINE A_THETA_RELAXATION

   SUBROUTINE a_rk_rayleigh_damp(ru_tendf,a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf, &
! Revised by Ning Pan, 2010-07-23
!   a_rw_tendf,t_tendf,a_t_tendf,u,a_u,v,a_v,w,a_w,t,a_t,t_init,a_t_init, &
!   mut,a_mut,muu,a_muu,muv,a_muv,ph,a_ph,phb,a_phb,u_base,a_u_base,v_base, &
!   a_v_base,t_base,a_t_base,z_base,a_z_base,dampcoef,a_dampcoef,zdamp,a_zdamp, &
   a_rw_tendf,t_tendf,a_t_tendf,u,a_u,v,a_v,w,a_w,t,a_t,t_init, &
   mut,a_mut,muu,a_muu,muv,a_muv,ph,a_ph,phb,u_base,v_base, &
   t_base,z_base,dampcoef,zdamp, &
   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
   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) :: ru_tendf,a_ru_tendf,rv_tendf, &
   a_rv_tendf,rw_tendf,a_rw_tendf,t_tendf,a_t_tendf
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v,w,a_w,t,a_t,t_init, &
! Revised by Ning Pan, 2010-07-23
!   a_t_init,ph,a_ph,phb,a_phb
   ph,a_ph,phb
   REAL,DIMENSION(ims:ime,jms:jme) :: mut,a_mut,muu,a_muu,muv,a_muv
! Revised by Ning Pan, 2010-07-23
!   REAL,DIMENSION(kms:kme) :: u_base,a_u_base,v_base,a_v_base,t_base,a_t_base, &
!   z_base,a_z_base
!   REAL :: dampcoef,a_dampcoef,zdamp,a_zdamp
   REAL,DIMENSION(kms:kme) :: u_base,v_base,t_base,z_base
   REAL :: dampcoef,zdamp
   INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end,i,j,k,ktf,k1,k2
! Revised by Ning Pan, 2010-07-23
!   REAL :: pii,a_pii,dcoef,a_dcoef,z,a_z,ztop,a_ztop
!   REAL :: wkp1,a_wkp1,wk,a_wk,wkm1,a_wkm1
   REAL :: pii,dcoef,a_dcoef,z,a_z,ztop,a_ztop
   REAL,DIMENSION(kms:kme) :: z00,a_z00,u00,a_u00,v00,a_v00,t00,a_t00

   REAL,DIMENSION(jts:min(jte, jde)) :: Keep_Lpb2_ztop
   REAL,DIMENSION(jts:min(jte, jde)) :: Keep_Lpb2_dcoef
   REAL,DIMENSION(jts:min(jte, jde-1)) :: Keep_Lpb3_ztop
   REAL,DIMENSION(jts:min(jte, jde-1)) :: Keep_Lpb3_dcoef
!  REAL,DIMENSION(jts:min(jte, jde-1)) :: Keep_Lpb4_ztop
!  REAL,DIMENSION(jts:min(jte, jde-1)) :: Keep_Lpb4_dcoef   
   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
!REVISED BY WALLS
!  REAL,DIMENSION(k1+2:min(kte,kde-1)) :: Tmpv200
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv200
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv201
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv202
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv203
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv204
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv205
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv206
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv207
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv208
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv209
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2010
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2011
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2012
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2013
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2014
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2015
   REAL,DIMENSION(kts:min(kte,kde-1)) :: Tmpv2016
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv300
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv301
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv302
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv303
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv304
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv305
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv306
   REAL,DIMENSION(kts:min(kte, kde),its:min(ite, ide-1)) :: Tmpv307

!REVISED BY WALLS
!!This line is fail to be recognized
!         DO WHILE( z >= (ztop-zdamp) )
!
!!This line is fail to be recognized
!         DO WHILE( z >= (ztop-zdamp) )
!
!!This line is fail to be recognized
!         DO WHILE( z >= (ztop-zdamp) )

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
       pii = 2.0 * asin(1.0)
       ktf = MIN( kte,   kde-1 )

!LPB[1]
!DELETED BY WALLS, ERRORS IN DO WHILE STRUCTURES

!       DO j = jts, MIN( jte, jde-1 )
!
!       DO i = its, MIN( ite, ide   )
!         ztop = 0.5*( phb(i  ,kde,j)+phb(i-1,kde,j)     &
!                     +ph(i  ,kde,j)+ph(i-1,kde,j) )/g
!         k1 = ktf
!         z = ztop
!           z = 0.25*( phb(i  ,k1,j)+phb(i  ,k1+1,j)    &
!                     +phb(i-1,k1,j)+phb(i-1,k1+1,j)    &
!                     +ph(i  ,k1,j)+ph(i  ,k1+1,j)      &
!                     +ph(i-1,k1,j)+ph(i-1,k1+1,j))/g
!           z00(k1) = z
!           k1 = k1 - 1
!         ENDDO
!         k1 = k1 + 2
!
!         DO k = k1, ktf
!           k2 = ktf
!
!           DO WHILE( z_base(k2) .gt. z00(k) )
!             k2 = k2 - 1
!           ENDDO
!        if(k2+1.gt.ktf)then
!
!             u00(k) = u_base(k2) + ( u_base(k2) - u_base(k2-1) )     &
!                                 * (     z00(k) - z_base(k2)   )     &
!                                 / ( z_base(k2) - z_base(k2-1) )
!           else
!             u00(k) = u_base(k2) + ( u_base(k2+1) - u_base(k2) )     &
!                                 * (       z00(k) - z_base(k2) )     &
!                                 / ( z_base(k2+1) - z_base(k2) )
!           endif
!         ENDDO
!
!         DO k = k1, ktf
!           dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
!           dcoef = (SIN( 0.5 * pii * dcoef ) )**2
!           ru_tendf(i,k,j) = ru_tendf(i,k,j) -                      &
!                             muu(i,j) * ( dcoef * dampcoef ) *      &
!                             ( u(i,k,j) - u00(k) )
!         END DO
!
!       END DO
!
!!LPB[2]
!       DO j = jts, MIN( jte, jde   )
!
!       Keep_Lpb2_ztop(j) =ztop
!       Keep_Lpb2_dcoef(j) =dcoef
!
!       END DO
!       DO i = its, MIN( ite, ide-1 )
!         ztop = 0.5*( phb(i,kde,j  )+phb(i,kde,j-1)     &
!                     +ph(i,kde,j  )+ph(i,kde,j-1) )/g
!         k1 = ktf
!         z = ztop
!           z = 0.25*( phb(i,k1,j  )+phb(i,k1+1,j  )    &
!                     +phb(i,k1,j-1)+phb(i,k1+1,j-1)    &
!                     +ph(i,k1,j  )+ph(i,k1+1,j  )      &
!                     +ph(i,k1,j-1)+ph(i,k1+1,j-1))/g
!           z00(k1) = z
!           k1 = k1 - 1
!         ENDDO
!         k1 = k1 + 2
!
!         DO k = k1, ktf
!           k2 = ktf
!
!           DO WHILE( z_base(k2) .gt. z00(k) )
!             k2 = k2 - 1
!           ENDDO
!        if(k2+1.gt.ktf)then
!
!             v00(k) = v_base(k2) + ( v_base(k2) - v_base(k2-1) )     &
!                                 * (     z00(k) - z_base(k2)   )     &
!                                 / ( z_base(k2) - z_base(k2-1) )
!           else
!             v00(k) = v_base(k2) + ( v_base(k2+1) - v_base(k2) )     &
!                                 * (       z00(k) - z_base(k2) )     &
!                                 / ( z_base(k2+1) - z_base(k2) )
!           endif
!         ENDDO
!
!         DO k = k1, ktf
!           dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
!           dcoef = (SIN( 0.5 * pii * dcoef ) )**2
!           rv_tendf(i,k,j) = rv_tendf(i,k,j) -                      &
!                             muv(i,j) * ( dcoef * dampcoef ) *      &
!                             ( v(i,k,j) - v00(k) )
!         END DO
!
!       END DO

!LPB[3]
!       DO j = jts, MIN( jte,   jde-1 )
!
!       Keep_Lpb3_ztop(j) =ztop
!       Keep_Lpb3_dcoef(j) =dcoef
!
!       END DO
!       DO i = its, MIN( ite,   ide-1 )
!         ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
!
!         DO k = kts, MIN( kte,   kde   )
!           z = ( phb(i,k,j) + ph(i,k,j) ) / g
!        IF ( z >= (ztop-zdamp) ) THEN
!
!             dcoef = 1.0 - MIN( 1.0, ( ztop - z ) / zdamp )
!             dcoef = ( SIN( 0.5 * pii * dcoef ) )**2
!             rw_tendf(i,k,j) = rw_tendf(i,k,j) -    &
!                               mut(i,j) * ( dcoef * dampcoef ) * w(i,k,j)
!           END IF
!         END DO
!       END DO
!
!       END DO
!
!!!LPB[4]
!       DO j = jts, MIN( jte,   jde-1 )
!
!!    !  Keep_Lpb4_ztop(j) =ztop
!!    !  Keep_Lpb4_dcoef(j) =dcoef

!!       DO i = its, MIN( ite,   ide-1 )
!!         ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g
!!         k1 = ktf
!!         z = ztop
!           z = 0.5 * ( phb(i,k1,j) + phb(i,k1+1,j) +    &
!!!                        ph(i,k1,j) +  ph(i,k1+1,j) ) / g
!!           z00(k1) = z
!!           k1 = k1 - 1
!         ENDDO
!!         k1 = k1 + 2
!
!!         DO k = k1, ktf
!!           k2 = ktf
!
!!           DO WHILE( z_base(k2) .gt. z00(k) )
!!             k2 = k2 - 1
!!           ENDDO
!!        if(k2+1.gt.ktf)then
!
!!             t00(k) = t_base(k2) + ( t_base(k2) - t_base(k2-1) )     &
!                                 * (     z00(k) - z_base(k2)   )     &
!!                                 / ( z_base(k2) - z_base(k2-1) )
!!           else
!!             t00(k) = t_base(k2) + ( t_base(k2+1) - t_base(k2) )     &
!!                                 * (       z00(k) - z_base(k2) )     &
!!                                 / ( z_base(k2+1) - z_base(k2) )
!!           endif
!         ENDDO
!
!!         DO k = k1, ktf
!!           dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp )
!!           dcoef = (SIN( 0.5 * pii * dcoef ) )**2
!!           t_tendf(i,k,j) = t_tendf(i,k,j) -                        &
!                            mut(i,j) * ( dcoef * dampcoef )  *      &
!!                            ( t(i,k,j) - t00(k) )
!!         END DO
!
!!       END DO
!
!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

!   a_pii =0.0  ! Remarked by Ning Pan, 2010-07-23
   a_dcoef =0.0
   a_z =0.0
   a_ztop =0.0
! Remarked by Ning Pan, 2010-07-23
!   a_wkp1 =0.0
!   a_wk =0.0
!   a_wkm1 =0.0

   Do K0_ADJ =kms, kme
   a_z00(K0_ADJ) =0.0
   End Do

   Do K0_ADJ =kms, kme
   a_u00(K0_ADJ) =0.0
   End Do

   Do K0_ADJ =kms, kme
   a_v00(K0_ADJ) =0.0
   End Do

   Do K0_ADJ =kms, kme
   a_t00(K0_ADJ) =0.0
   End Do

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[4]
   DO j =min(jte, jde-1), jts, -1

!  ztop =Keep_Lpb4_ztop(j)
!  dcoef =Keep_Lpb4_dcoef(j)

   DO i =its, min(ite, ide-1)
   Tmpv001 =phb(i,kde,j) +ph(i,kde,j)
   Tmpv002 =Tmpv001/g
   ztop =Tmpv002

   k1 =ktf
   z =ztop  ! Removed remark by Ning Pan, 2010-07-23

   DO WHILE( z >= (ztop-zdamp) )  ! Added by Ning Pan, 2010-07-23
   Tmpv001 =phb(i,k1,j) +phb(i,k1+1,j)
   Tmpv002 =Tmpv001 +ph(i,k1,j)
   Tmpv003 =Tmpv002 +ph(i,k1+1,j)
   Tmpv004 =0.5*Tmpv003
   Tmpv005 =Tmpv004/g
   z =Tmpv005  ! Removed remark by Ning Pan, 2010-07-23

   z00(k1) =z

   k1 =k1-1
   ENDDO

   k1 =k1+2
   DO k =k1, ktf
   k2 =ktf

   DO WHILE(z_base(k2) .gt. z00(k))
   k2 =k2-1
   ENDDO
   IF(k2+1.gt.ktf) THEN
   Tmpv001 =t_base(k2) -t_base(k2-1)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv200(k) =Tmpv001
   Tmpv201(k) =Tmpv002
   Tmpv003 =Tmpv200(k)*Tmpv201(k)
   Tmpv004 =z_base(k2) -z_base(k2-1)
   Tmpv202(k) =Tmpv003
   Tmpv203(k) =Tmpv004
   Tmpv005 =Tmpv202(k)/Tmpv203(k)
   Tmpv006 =t_base(k2) +Tmpv005
   t00(k) =Tmpv006

   else
   Tmpv001 =t_base(k2+1) -t_base(k2)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv204(k) =Tmpv001
   Tmpv205(k) =Tmpv002
   Tmpv003 =Tmpv204(k)*Tmpv205(k)
   Tmpv004 =z_base(k2+1) -z_base(k2)
   Tmpv206(k) =Tmpv003
   Tmpv207(k) =Tmpv004
   Tmpv005 =Tmpv206(k)/Tmpv207(k)
   Tmpv006 =t_base(k2) +Tmpv005
   t00(k) =Tmpv006

   endif
   ENDDO

   DO k =k1, ktf
   Tmpv001 =ztop -z00(k)
   Tmpv208(k) =Tmpv001
   Tmpv002 =Tmpv208(k)/zdamp
   Tmpv209(k) =Tmpv002
   Tmpv003 =1.0 -min(1.0, Tmpv209(k))
   Tmpv2010(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =0.5*pii*dcoef
   Tmpv2011(k) =Tmpv001
   Tmpv002 =sin(Tmpv2011(k))
   Tmpv2012(k) =Tmpv002
   Tmpv003 =Tmpv2012(k)**2
   Tmpv2013(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =dcoef*dampcoef
   Tmpv2014(k) =Tmpv001
   Tmpv002 =mut(i,j)*Tmpv2014(k)
   Tmpv003 =t(i,k,j) -t00(k)
   Tmpv2015(k) =Tmpv002
   Tmpv2016(k) =Tmpv003
! Remarked by Ning Pan, 2010-07-23
!   Tmpv004 =Tmpv2015(k)*Tmpv2016(k)
!   Tmpv005 =t_tendf(i,k,j) -Tmpv004
!!  t_tendf(i,k,j) =Tmpv005

   ENDDO

   DO k =ktf, k1, -1
   a_Tmpv5 =a_t_tendf(i,k,j)
   a_t_tendf(i,k,j) =0.0
   a_t_tendf(i,k,j) =a_t_tendf(i,k,j) +a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv2 =Tmpv2016(k)*a_Tmpv4
   a_Tmpv3 =Tmpv2015(k)*a_Tmpv4
   a_t(i,k,j) =a_t(i,k,j) +a_Tmpv3
   a_t00(k) =a_t00(k) -a_Tmpv3
   a_mut(i,j) =a_mut(i,j) +Tmpv2014(k)*a_Tmpv2
   a_Tmpv1 =mut(i,j)*a_Tmpv2
   a_dcoef =a_dcoef +dampcoef*a_Tmpv1
!   a_dampcoef =a_dampcoef +dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23

!   dcoef =Tmpv2013(k)  ! Remarked by Ning Pan, 2010-07-24

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
   a_Tmpv2 =2.0*Tmpv2012(k)*a_Tmpv3
   a_Tmpv1 =cos(Tmpv2011(k))*a_Tmpv2
!   a_pii =a_pii +0.5*dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_dcoef =a_dcoef +0.5*pii*a_Tmpv1

!   dcoef =Tmpv2010(k) ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
!STOP  ! Remarked by Ning Pan, 2010-07-23
!REVISED BY WALLS
!  (1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5* =-a_Tmpv3
   a_Tmpv2 = -(1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5*a_Tmpv3  ! Added by Ning Pan, 2010-07-23
   a_Tmpv1 =a_Tmpv2/zdamp
!   a_zdamp =a_zdamp -Tmpv208(k)/(zdamp*zdamp)*a_Tmpv2  ! Remarked by Ning Pan, 2010-07-23
   a_ztop =a_ztop +a_Tmpv1
   a_z00(k) =a_z00(k) -a_Tmpv1
   ENDDO

   DO k =ktf, k1, -1

! Added by Ning Pan, 2010-07-23
   k2 = ktf
   DO WHILE(z_base(k2) .gt. z00(k))
   k2 =k2-1
   ENDDO

   IF(k2+1.gt.ktf) THEN

   a_Tmpv6 =a_t00(k)
   a_t00(k) =0.0
!   a_t_base(k2) =a_t_base(k2) +a_Tmpv6  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv203(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv202(k)/(Tmpv203(k)*Tmpv203(k))*a_Tmpv5
!   a_z_base(k2) =a_z_base(k2) +a_Tmpv4
!   a_z_base(k2-1) =a_z_base(k2-1) -a_Tmpv4
!   a_Tmpv1 =Tmpv201(k)*a_Tmpv3
   a_Tmpv2 =Tmpv200(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_t_base(k2) =a_t_base(k2) +a_Tmpv1
!   a_t_base(k2-1) =a_t_base(k2-1) -a_Tmpv1

   else

   a_Tmpv6 =a_t00(k)
   a_t00(k) =0.0
!   a_t_base(k2) =a_t_base(k2) +a_Tmpv6  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv207(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv206(k)/(Tmpv207(k)*Tmpv207(k))*a_Tmpv5
!   a_z_base(k2+1) =a_z_base(k2+1) +a_Tmpv4
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv4
!   a_Tmpv1 =Tmpv205(k)*a_Tmpv3
   a_Tmpv2 =Tmpv204(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_t_base(k2+1) =a_t_base(k2+1) +a_Tmpv1
!   a_t_base(k2) =a_t_base(k2) -a_Tmpv1

   endif
! Remarked by Ning Pan, 2010-07-23
!   DO 
!   ENDDO

   ENDDO

!   DO i =min(ite, ide-1), its, -1  ! Remarked by Ning Pan, 2010-07-23
   DO k = k1-1, ktf  ! Added by Ning Pan, 2010-07-23
! Revised by Ning Pan, 2010-07-23
!   a_z =a_z +a_z00(k1)
!   a_z00(k1) =0.0
   a_z =a_z +a_z00(k)
   a_z00(k) =0.0
   a_Tmpv5 =a_z
   a_z =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.5*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1+1,j) =a_ph(i,k1+1,j) +a_Tmpv3
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1,j) =a_ph(i,k1,j) +a_Tmpv2
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_phb(i,k1,j) =a_phb(i,k1,j) +a_Tmpv1
!   a_phb(i,k1+1,j) =a_phb(i,k1+1,j) +a_Tmpv1
   ENDDO  ! Added by Ning Pan, 2010-07-23
   a_Tmpv2 =a_ztop
   a_ztop =0.0
   a_Tmpv1 =a_Tmpv2/g
!   a_phb(i,kde,j) =a_phb(i,kde,j) +a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_ph(i,kde,j) =a_ph(i,kde,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[3]
   DO j =min(jte, jde-1), jts, -1

! Remarked by Ning Pan, 2010-07-23
!   ztop =Keep_Lpb3_ztop(j)
!   dcoef =Keep_Lpb3_dcoef(j)

   DO i =its, min(ite, ide-1)
   Tmpv001 =phb(i,kde,j) +ph(i,kde,j)
   Tmpv002 =Tmpv001/g
   ztop =Tmpv002

   DO k =kts, min(kte, kde)
   Tmpv001 =phb(i,k,j) +ph(i,k,j)
   Tmpv002 =Tmpv001/g
   z =Tmpv002

   IF( z >= (ztop-zdamp) ) THEN
   Tmpv001 =ztop -z
   Tmpv300(k,i) =Tmpv001
   Tmpv002 =Tmpv300(k,i)/zdamp
   Tmpv301(k,i) =Tmpv002
   Tmpv003 =1.0 -min(1.0, Tmpv301(k,i))
   Tmpv302(k,i) =dcoef
   dcoef =Tmpv003

   Tmpv001 =0.5*pii*dcoef
   Tmpv303(k,i) =Tmpv001
   Tmpv002 =sin(Tmpv303(k,i))
   Tmpv304(k,i) =Tmpv002
   Tmpv003 =Tmpv304(k,i)**2
   Tmpv305(k,i) =dcoef
   dcoef =Tmpv003

   Tmpv001 =dcoef*dampcoef
   Tmpv306(k,i) =Tmpv001
   Tmpv002 =mut(i,j)*Tmpv306(k,i)
   Tmpv307(k,i) =Tmpv002
! Remarked by Ning Pan, 2010-07-24
!   Tmpv003 =Tmpv307(k,i)*w(i,k,j)
!   Tmpv004 =rw_tendf(i,k,j) -Tmpv003
!!  rw_tendf(i,k,j) =Tmpv004

   END IF
! Remarked by Ning Pan, 2010-07-23
!   ENDDO
!   ENDDO

! Remarked by Ning Pan, 2010-07-23
!   DO i =min(ite, ide-1), its, -1
!   DO k =min(kte, kde), kts, -1

   IF( z >= (ztop-zdamp) ) THEN

   a_Tmpv4 =a_rw_tendf(i,k,j)
   a_rw_tendf(i,k,j) =0.0
   a_rw_tendf(i,k,j) =a_rw_tendf(i,k,j) +a_Tmpv4
   a_Tmpv3 =-a_Tmpv4
   a_Tmpv2 =w(i,k,j)*a_Tmpv3
   a_w(i,k,j) =a_w(i,k,j) +Tmpv307(k,i)*a_Tmpv3
   a_mut(i,j) =a_mut(i,j) +Tmpv306(k,i)*a_Tmpv2
   a_Tmpv1 =mut(i,j)*a_Tmpv2
   a_dcoef =a_dcoef +dampcoef*a_Tmpv1
!   a_dampcoef =a_dampcoef +dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23

!   dcoef =Tmpv305(k,i)  ! Remarkedby Ning Pan, 2010-07-24

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
   a_Tmpv2 =2.0*Tmpv304(k,i)*a_Tmpv3
   a_Tmpv1 =cos(Tmpv303(k,i))*a_Tmpv2
!   a_pii =a_pii +0.5*dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_dcoef =a_dcoef +0.5*pii*a_Tmpv1

!   dcoef =Tmpv302(k,i)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
!STOP  ! Remarked by Ning Pan, 2010-07-23
!REVISED BY WALLS
!  (1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv301(k,i)))*0.5* =-a_Tmpv3
   a_Tmpv2 = -(1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv301(k,i)))*0.5*a_Tmpv3  ! Added by Ning Pan, 2010-07-23
   a_Tmpv1 =a_Tmpv2/zdamp
!   a_zdamp =a_zdamp -Tmpv300(k,i)/(zdamp*zdamp)*a_Tmpv2  ! Remarked by Ning Pan, 2010-07-23
   a_ztop =a_ztop +a_Tmpv1
   a_z =a_z -a_Tmpv1

   END IF
   a_Tmpv2 =a_z
   a_z =0.0
   a_Tmpv1 =a_Tmpv2/g
!   a_phb(i,k,j) =a_phb(i,k,j) +a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv1
   ENDDO
   a_Tmpv2 =a_ztop
   a_ztop =0.0
   a_Tmpv1 =a_Tmpv2/g
!   a_phb(i,kde,j) =a_phb(i,kde,j) +a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_ph(i,kde,j) =a_ph(i,kde,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[2]
   DO j =min(jte, jde), jts, -1

! Remarked by Ning Pan, 2010-07-23
!   ztop =Keep_Lpb2_ztop(j)
!   dcoef =Keep_Lpb2_dcoef(j)

   DO i =its, min(ite, ide-1)
   Tmpv001 =phb(i,kde,j) +phb(i,kde,j-1)
   Tmpv002 =Tmpv001 +ph(i,kde,j)
   Tmpv003 =Tmpv002 +ph(i,kde,j-1)
   Tmpv004 =0.5*Tmpv003
   Tmpv005 =Tmpv004/g
   ztop =Tmpv005

   k1 =ktf
   z =ztop  ! Removed remark by Ning Pan, 2010-07-23

   DO WHILE( z >= (ztop-zdamp) )  ! Added by Ning Pan, 2010-07-23
   Tmpv001 =phb(i,k1,j) +phb(i,k1+1,j)
   Tmpv002 =Tmpv001 +phb(i,k1,j-1)
   Tmpv003 =Tmpv002 +phb(i,k1+1,j-1)
   Tmpv004 =Tmpv003 +ph(i,k1,j)
   Tmpv005 =Tmpv004 +ph(i,k1+1,j)
   Tmpv006 =Tmpv005 +ph(i,k1,j-1)
   Tmpv007 =Tmpv006 +ph(i,k1+1,j-1)
   Tmpv008 =0.25*Tmpv007
   Tmpv009 =Tmpv008/g
   z =Tmpv009  ! Removed remark by Ning Pan, 2010-07-23

   z00(k1) =z

   k1 =k1-1
   ENDDO

   k1 =k1+2
   DO k =k1, ktf
   k2 =ktf

   DO WHILE(z_base(k2) .gt. z00(k))
   k2 =k2-1
   ENDDO
   IF(k2+1.gt.ktf) THEN
   Tmpv001 =v_base(k2) -v_base(k2-1)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv200(k) =Tmpv001
   Tmpv201(k) =Tmpv002
   Tmpv003 =Tmpv200(k)*Tmpv201(k)
   Tmpv004 =z_base(k2) -z_base(k2-1)
   Tmpv202(k) =Tmpv003
   Tmpv203(k) =Tmpv004
   Tmpv005 =Tmpv202(k)/Tmpv203(k)
   Tmpv006 =v_base(k2) +Tmpv005
   v00(k) =Tmpv006

   else
   Tmpv001 =v_base(k2+1) -v_base(k2)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv204(k) =Tmpv001
   Tmpv205(k) =Tmpv002
   Tmpv003 =Tmpv204(k)*Tmpv205(k)
   Tmpv004 =z_base(k2+1) -z_base(k2)
   Tmpv206(k) =Tmpv003
   Tmpv207(k) =Tmpv004
   Tmpv005 =Tmpv206(k)/Tmpv207(k)
   Tmpv006 =v_base(k2) +Tmpv005
   v00(k) =Tmpv006

   endif
   ENDDO

   DO k =k1, ktf
   Tmpv001 =ztop -z00(k)
   Tmpv208(k) =Tmpv001
   Tmpv002 =Tmpv208(k)/zdamp
   Tmpv209(k) =Tmpv002
   Tmpv003 =1.0 -min(1.0, Tmpv209(k))
   Tmpv2010(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =0.5*pii*dcoef
   Tmpv2011(k) =Tmpv001
   Tmpv002 =sin(Tmpv2011(k))
   Tmpv2012(k) =Tmpv002
   Tmpv003 =Tmpv2012(k)**2
   Tmpv2013(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =dcoef*dampcoef
   Tmpv2014(k) =Tmpv001
   Tmpv002 =muv(i,j)*Tmpv2014(k)
   Tmpv003 =v(i,k,j) -v00(k)
   Tmpv2015(k) =Tmpv002
   Tmpv2016(k) =Tmpv003
   Tmpv004 =Tmpv2015(k)*Tmpv2016(k)
   Tmpv005 =rv_tendf(i,k,j) -Tmpv004
!  rv_tendf(i,k,j) =Tmpv005

   ENDDO

   DO k =ktf, k1, -1
   a_Tmpv5 =a_rv_tendf(i,k,j)
   a_rv_tendf(i,k,j) =0.0
   a_rv_tendf(i,k,j) =a_rv_tendf(i,k,j) +a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv2 =Tmpv2016(k)*a_Tmpv4
   a_Tmpv3 =Tmpv2015(k)*a_Tmpv4
   a_v(i,k,j) =a_v(i,k,j) +a_Tmpv3
   a_v00(k) =a_v00(k) -a_Tmpv3
   a_muv(i,j) =a_muv(i,j) +Tmpv2014(k)*a_Tmpv2
   a_Tmpv1 =muv(i,j)*a_Tmpv2
   a_dcoef =a_dcoef +dampcoef*a_Tmpv1
!   a_dampcoef =a_dampcoef +dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23

!   dcoef =Tmpv2013(k)  ! Remarked by Ning Pan, 2010-07-24

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
   a_Tmpv2 =2.0*Tmpv2012(k)*a_Tmpv3
   a_Tmpv1 =cos(Tmpv2011(k))*a_Tmpv2
!   a_pii =a_pii +0.5*dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_dcoef =a_dcoef +0.5*pii*a_Tmpv1

!   dcoef =Tmpv2010(k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
!STOP  ! Remarked by Ning Pan, 2010-07-23
!REVISED BY WALLS
!  (1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5* =-a_Tmpv3
   a_Tmpv2 = -(1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5*a_Tmpv3  ! Added by Ning Pan, 2010-07-23
   a_Tmpv1 =a_Tmpv2/zdamp
!   a_zdamp =a_zdamp -Tmpv208(k)/(zdamp*zdamp)*a_Tmpv2  ! Remarked by Ning Pan, 2010-07-23
   a_ztop =a_ztop +a_Tmpv1
   a_z00(k) =a_z00(k) -a_Tmpv1
   ENDDO

   DO k =ktf, k1, -1

! Added by Ning Pan, 2010-07-23
   k2 = ktf
   DO WHILE( z_base(k2) .gt. z00(k) )
     k2 = k2 - 1
   ENDDO

   IF(k2+1.gt.ktf) THEN

   a_Tmpv6 =a_v00(k)
   a_v00(k) =0.0
!   a_v_base(k2) =a_v_base(k2) +a_Tmpv6  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv203(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv202(k)/(Tmpv203(k)*Tmpv203(k))*a_Tmpv5
!   a_z_base(k2) =a_z_base(k2) +a_Tmpv4
!   a_z_base(k2-1) =a_z_base(k2-1) -a_Tmpv4
!   a_Tmpv1 =Tmpv201(k)*a_Tmpv3
   a_Tmpv2 =Tmpv200(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_v_base(k2) =a_v_base(k2) +a_Tmpv1
!   a_v_base(k2-1) =a_v_base(k2-1) -a_Tmpv1

   else

   a_Tmpv6 =a_v00(k)
   a_v00(k) =0.0
!   a_v_base(k2) =a_v_base(k2) +a_Tmpv6   ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv207(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv206(k)/(Tmpv207(k)*Tmpv207(k))*a_Tmpv5
!   a_z_base(k2+1) =a_z_base(k2+1) +a_Tmpv4
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv4
!   a_Tmpv1 =Tmpv205(k)*a_Tmpv3
   a_Tmpv2 =Tmpv204(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_v_base(k2+1) =a_v_base(k2+1) +a_Tmpv1
!   a_v_base(k2) =a_v_base(k2) -a_Tmpv1

   endif
! Remarked by Ning Pan, 2010-07-23
!   DO 
!   ENDDO
   ENDDO

!   DO i =min(ite, ide-1), its, -1  ! Remarked by Ning Pan, 2010-07-23
   DO k = k1-1, ktf  ! Added by Ning Pan, 2010-07-23
! Revised by Ning Pan, 2010-07-23
!   a_z =a_z +a_z00(k1)
!   a_z00(k1) =0.0
   a_z =a_z +a_z00(k)
   a_z00(k) =0.0
   a_Tmpv9 =a_z
   a_z =0.0
   a_Tmpv8 =a_Tmpv9/g
   a_Tmpv7 =0.25*a_Tmpv8
   a_Tmpv6 =a_Tmpv7
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1+1,j-1) =a_ph(i,k1+1,j-1) +a_Tmpv7
   a_ph(i,k+1,j-1) =a_ph(i,k+1,j-1) +a_Tmpv7
   a_Tmpv5 =a_Tmpv6
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1,j-1) =a_ph(i,k1,j-1) +a_Tmpv6
   a_ph(i,k,j-1) =a_ph(i,k,j-1) +a_Tmpv6
   a_Tmpv4 =a_Tmpv5
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1+1,j) =a_ph(i,k1+1,j) +a_Tmpv5
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv5
   a_Tmpv3 =a_Tmpv4
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1,j) =a_ph(i,k1,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv4
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv2 =a_Tmpv3
!   a_phb(i,k1+1,j-1) =a_phb(i,k1+1,j-1) +a_Tmpv3
!   a_Tmpv1 =a_Tmpv2
!   a_phb(i,k1,j-1) =a_phb(i,k1,j-1) +a_Tmpv2
!   a_phb(i,k1,j) =a_phb(i,k1,j) +a_Tmpv1
!   a_phb(i,k1+1,j) =a_phb(i,k1+1,j) +a_Tmpv1
   ENDDO  ! Added by Ning Pan, 2010-07-23
   a_Tmpv5 =a_ztop
   a_ztop =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.5*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i,kde,j-1) =a_ph(i,kde,j-1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i,kde,j) =a_ph(i,kde,j) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_phb(i,kde,j) =a_phb(i,kde,j) +a_Tmpv1
!   a_phb(i,kde,j-1) =a_phb(i,kde,j-1) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[1]
   DO j =min(jte, jde-1), jts, -1

! Revised by Ning Pan, 2010-07-23
!   DO i =its, min(ite, ide)
   DO i =min(ite, ide), its, -1
   Tmpv001 =phb(i,kde,j) +phb(i-1,kde,j)
   Tmpv002 =Tmpv001 +ph(i,kde,j)
   Tmpv003 =Tmpv002 +ph(i-1,kde,j)
   Tmpv004 =0.5*Tmpv003
   Tmpv005 =Tmpv004/g
   ztop =Tmpv005

   k1 =ktf
   z =ztop  ! Removed remark by Ning Pan, 2010-07-23

   DO WHILE( z >= (ztop-zdamp) )  ! Added by Ning Pan, 2010-07-23
   Tmpv001 =phb(i,k1,j) +phb(i,k1+1,j)
   Tmpv002 =Tmpv001 +phb(i-1,k1,j)
   Tmpv003 =Tmpv002 +phb(i-1,k1+1,j)
   Tmpv004 =Tmpv003 +ph(i,k1,j)
   Tmpv005 =Tmpv004 +ph(i,k1+1,j)
   Tmpv006 =Tmpv005 +ph(i-1,k1,j)
   Tmpv007 =Tmpv006 +ph(i-1,k1+1,j)
   Tmpv008 =0.25*Tmpv007
   Tmpv009 =Tmpv008/g
   z =Tmpv009  ! Removed remark by Ning Pan, 2010-07-23 

   z00(k1) =z

   k1 =k1-1
   ENDDO

   k1 =k1+2
   DO k =k1, ktf
   k2 =ktf

   DO WHILE(z_base(k2) .gt. z00(k))
   k2 =k2-1
   ENDDO
   IF(k2+1.gt.ktf) THEN
   Tmpv001 =u_base(k2) -u_base(k2-1)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv200(k) =Tmpv001
   Tmpv201(k) =Tmpv002
   Tmpv003 =Tmpv200(k)*Tmpv201(k)
   Tmpv004 =z_base(k2) -z_base(k2-1)
   Tmpv202(k) =Tmpv003
   Tmpv203(k) =Tmpv004
   Tmpv005 =Tmpv202(k)/Tmpv203(k)
   Tmpv006 =u_base(k2) +Tmpv005
   u00(k) =Tmpv006

   else
   Tmpv001 =u_base(k2+1) -u_base(k2)
   Tmpv002 =z00(k) -z_base(k2)
   Tmpv204(k) =Tmpv001
   Tmpv205(k) =Tmpv002
   Tmpv003 =Tmpv204(k)*Tmpv205(k)
   Tmpv004 =z_base(k2+1) -z_base(k2)
   Tmpv206(k) =Tmpv003
   Tmpv207(k) =Tmpv004
   Tmpv005 =Tmpv206(k)/Tmpv207(k)
   Tmpv006 =u_base(k2) +Tmpv005
   u00(k) =Tmpv006

   endif
   ENDDO

   DO k =k1, ktf
   Tmpv001 =ztop -z00(k)
   Tmpv208(k) =Tmpv001
   Tmpv002 =Tmpv208(k)/zdamp
   Tmpv209(k) =Tmpv002
   Tmpv003 =1.0 -min(1.0, Tmpv209(k))
   Tmpv2010(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =0.5*pii*dcoef
   Tmpv2011(k) =Tmpv001
   Tmpv002 =sin(Tmpv2011(k))
   Tmpv2012(k) =Tmpv002
   Tmpv003 =Tmpv2012(k)**2
   Tmpv2013(k) =dcoef
   dcoef =Tmpv003

   Tmpv001 =dcoef*dampcoef
   Tmpv2014(k) =Tmpv001
   Tmpv002 =muu(i,j)*Tmpv2014(k)
   Tmpv003 =u(i,k,j) -u00(k)
   Tmpv2015(k) =Tmpv002
   Tmpv2016(k) =Tmpv003
! Remarked by Ning Pan, 2010-07-24
!   Tmpv004 =Tmpv2015(k)*Tmpv2016(k)
!   Tmpv005 =ru_tendf(i,k,j) -Tmpv004
!!  ru_tendf(i,k,j) =Tmpv005

   ENDDO

   DO k =ktf, k1, -1
   a_Tmpv5 =a_ru_tendf(i,k,j)
   a_ru_tendf(i,k,j) =0.0
   a_ru_tendf(i,k,j) =a_ru_tendf(i,k,j) +a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv2 =Tmpv2016(k)*a_Tmpv4
   a_Tmpv3 =Tmpv2015(k)*a_Tmpv4
   a_u(i,k,j) =a_u(i,k,j) +a_Tmpv3
   a_u00(k) =a_u00(k) -a_Tmpv3
   a_muu(i,j) =a_muu(i,j) +Tmpv2014(k)*a_Tmpv2
   a_Tmpv1 =muu(i,j)*a_Tmpv2
   a_dcoef =a_dcoef +dampcoef*a_Tmpv1
!   a_dampcoef =a_dampcoef +dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23

!   dcoef =Tmpv2013(k)  ! Remarked by Ning Pan, 2010-07-24

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
   a_Tmpv2 =2.0*Tmpv2012(k)*a_Tmpv3
   a_Tmpv1 =cos(Tmpv2011(k))*a_Tmpv2
!   a_pii =a_pii +0.5*dcoef*a_Tmpv1  ! Remarked by Ning Pan, 2010-07-23
   a_dcoef =a_dcoef +0.5*pii*a_Tmpv1

!   dcoef =Tmpv2010(k)  ! Remarked by Ning Pan, 2010-07-23

   a_Tmpv3 =a_dcoef
   a_dcoef =0.0
!STOP  ! Remarked by Ning Pan, 2010-07-23
!REVISED BY WALLS
!  (1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5* =-a_Tmpv3
   a_Tmpv2 = -(1.0 -(-1.0)*sign(1.0, 1.0 -Tmpv209(k)))*0.5*a_Tmpv3  ! Added by Ning Pan, 2010-07-23
   a_Tmpv1 =a_Tmpv2/zdamp
!   a_zdamp =a_zdamp -Tmpv208(k)/(zdamp*zdamp)*a_Tmpv2  ! Added by Ning Pan, 2010-07-23
   a_ztop =a_ztop +a_Tmpv1
   a_z00(k) =a_z00(k) -a_Tmpv1
   ENDDO

   DO k =ktf, k1, -1

! Added by Ning Pan, 2010-07-23 
   k2 = ktf
   DO WHILE( z_base(k2) .gt. z00(k) )
   k2 = k2 - 1
   ENDDO

   IF(k2+1.gt.ktf) THEN

   a_Tmpv6 =a_u00(k)
   a_u00(k) =0.0
!   a_u_base(k2) =a_u_base(k2) +a_Tmpv6  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv203(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv202(k)/(Tmpv203(k)*Tmpv203(k))*a_Tmpv5
!   a_z_base(k2) =a_z_base(k2) +a_Tmpv4
!   a_z_base(k2-1) =a_z_base(k2-1) -a_Tmpv4
!   a_Tmpv1 =Tmpv201(k)*a_Tmpv3
   a_Tmpv2 =Tmpv200(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_u_base(k2) =a_u_base(k2) +a_Tmpv1
!   a_u_base(k2-1) =a_u_base(k2-1) -a_Tmpv1

   else

   a_Tmpv6 =a_u00(k)
   a_u00(k) =0.0
!   a_u_base(k2) =a_u_base(k2) +a_Tmpv6   ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv5 =a_Tmpv6
   a_Tmpv3 =a_Tmpv5/Tmpv207(k)
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv4 =-Tmpv206(k)/(Tmpv207(k)*Tmpv207(k))*a_Tmpv5
!   a_z_base(k2+1) =a_z_base(k2+1) +a_Tmpv4
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv4
!   a_Tmpv1 =Tmpv205(k)*a_Tmpv3
   a_Tmpv2 =Tmpv204(k)*a_Tmpv3
   a_z00(k) =a_z00(k) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_z_base(k2) =a_z_base(k2) -a_Tmpv2
!   a_u_base(k2+1) =a_u_base(k2+1) +a_Tmpv1
!   a_u_base(k2) =a_u_base(k2) -a_Tmpv1

   endif
! Remarked by Ning Pan, 2010-07-23
!   DO 
!   ENDDO
   ENDDO

!   DO i =min(ite, ide), its, -1  ! Remarked by Ning Pan, 2010-07-23
   DO k = k1-1, ktf   ! Added by Ning Pan, 2010-07-23
! Revised by Ning Pan, 2010-07-23
!   a_z =a_z +a_z00(k1)
!   a_z00(k1) =0.0
   a_z =a_z +a_z00(k)
   a_z00(k) =0.0
   a_Tmpv9 =a_z
   a_z =0.0
   a_Tmpv8 =a_Tmpv9/g
   a_Tmpv7 =0.25*a_Tmpv8
   a_Tmpv6 =a_Tmpv7
! Revised by Ning Pan, 2010-07-23
!   a_ph(i-1,k1+1,j) =a_ph(i-1,k1+1,j) +a_Tmpv7
   a_ph(i-1,k+1,j) =a_ph(i-1,k+1,j) +a_Tmpv7
   a_Tmpv5 =a_Tmpv6
! Revised by Ning Pan, 2010-07-23
!   a_ph(i-1,k1,j) =a_ph(i-1,k1,j) +a_Tmpv6
   a_ph(i-1,k,j) =a_ph(i-1,k,j) +a_Tmpv6
   a_Tmpv4 =a_Tmpv5
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1+1,j) =a_ph(i,k1+1,j) +a_Tmpv5
   a_ph(i,k+1,j) =a_ph(i,k+1,j) +a_Tmpv5
   a_Tmpv3 =a_Tmpv4
! Revised by Ning Pan, 2010-07-23
!   a_ph(i,k1,j) =a_ph(i,k1,j) +a_Tmpv4
   a_ph(i,k,j) =a_ph(i,k,j) +a_Tmpv4
! Remarked by Ning Pan, 2010-07-23
!   a_Tmpv2 =a_Tmpv3
!   a_phb(i-1,k1+1,j) =a_phb(i-1,k1+1,j) +a_Tmpv3
!   a_Tmpv1 =a_Tmpv2
!   a_phb(i-1,k1,j) =a_phb(i-1,k1,j) +a_Tmpv2
!   a_phb(i,k1,j) =a_phb(i,k1,j) +a_Tmpv1
!   a_phb(i,k1+1,j) =a_phb(i,k1+1,j) +a_Tmpv1
   ENDDO  ! Added by Ning Pan, 2010-07-23
   a_Tmpv5 =a_ztop
   a_ztop =0.0
   a_Tmpv4 =a_Tmpv5/g
   a_Tmpv3 =0.5*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_ph(i-1,kde,j) =a_ph(i-1,kde,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_ph(i,kde,j) =a_ph(i,kde,j) +a_Tmpv2
! Remarked by Ning Pan, 2010-07-23
!   a_phb(i,kde,j) =a_phb(i,kde,j) +a_Tmpv1
!   a_phb(i-1,kde,j) =a_phb(i-1,kde,j) +a_Tmpv1
   ENDDO

   ENDDO

!LPB[0]
!  pii =2.0*Asin(1.0)

!  ktf =min(kte, kde-1)

!   a_pii =0.0  ! Remarked by Ning Pan, 2010-07-23

   END SUBROUTINE a_rk_rayleigh_damp

   SUBROUTINE a_sixth_order_diffusion(name,field,a_field,tendency,a_tendency,mu, &
   a_mu,dt,config_flags,diff_6th_opt,diff_6th_factor,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
   INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
   TYPE(grid_config_rec_type) :: config_flags
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: field,a_field
   REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
   REAL :: dt
   REAL :: diff_6th_factor
   INTEGER :: diff_6th_opt
   CHARACTER (LEN=1) :: name
   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end,ktf
   REAL :: dflux_x_p0,a_dflux_x_p0,dflux_y_p0,a_dflux_y_p0,dflux_x_p1, &
   a_dflux_x_p1,dflux_y_p1,a_dflux_y_p1,tendency_x,a_tendency_x,tendency_y, &
   a_tendency_y,mu_avg_p0,a_mu_avg_p0,mu_avg_p1,a_mu_avg_p1,diff_6th_coef
   LOGICAL :: specified

   REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
   a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,Tmpv300, Tmpv301,Tmpv3011,Tmpv3012

!ADDED BY WALLS
!   REAL :: a_diff_6th_coef  ! Remarked by Ning Pan, 2010-07-23

!PART II: CALCULATIONS OF B. S. TRAJECTORY

!LPB[0]
       diff_6th_coef = diff_6th_factor * 0.015625 / ( 2.0 * dt )  
       ktf = MIN( kte, kde-1 )

    IF ( name .EQ. 'u' ) THEN
         i_start = its
         i_end   = ite
         j_start = jts
         j_end   = MIN(jde-1,jte)
         k_start = kts
         k_end   = ktf
       ELSE IF ( name .EQ. 'v' ) THEN
         i_start = its
         i_end   = MIN(ide-1,ite)
         j_start = jts
         j_end   = jte
         k_start = kts
         k_end   = ktf
       ELSE IF ( name .EQ. 'w' ) THEN
         i_start = its
         i_end   = MIN(ide-1,ite)
         j_start = jts
         j_end   = MIN(jde-1,jte)
         k_start = kts+1
         k_end   = ktf
       ELSE
         i_start = its
         i_end   = MIN(ide-1,ite)
         j_start = jts
         j_end   = MIN(jde-1,jte)
         k_start = kts
         k_end   = ktf
   ENDIF

!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS

   a_dflux_x_p0 =0.0
   a_dflux_y_p0 =0.0
   a_dflux_x_p1 =0.0
   a_dflux_y_p1 =0.0
   a_tendency_x =0.0
   a_tendency_y =0.0
   a_mu_avg_p0 =0.0
   a_mu_avg_p1 =0.0

!PART IV: REVERSE/BACKWARD ACCUMULATIONS

!LPB[2]
   DO j =j_end, j_start, -1

   DO k =k_end, k_start, -1
   DO i =i_end, i_start, -1
   Tmpv001 =field(i,k,j) -field(i,k,j-1)
   Tmpv002 =10.0*Tmpv001
   Tmpv003 =field(i,k,j+1) -field(i,k,j-2)
   Tmpv004 =5.0*Tmpv003
   Tmpv005 =Tmpv002 -Tmpv004
   Tmpv006 =field(i,k,j+2) -field(i,k,j-3)
   Tmpv007 =Tmpv005 +Tmpv006
   dflux_y_p0 =Tmpv007
   Tmpv3011 =dflux_y_p0

   Tmpv001 =field(i,k,j+1) -field(i,k,j)
   Tmpv002 =10.0*Tmpv001
   Tmpv003 =field(i,k,j+2) -field(i,k,j-1)
   Tmpv004 =5.0*Tmpv003
   Tmpv005 =Tmpv002 -Tmpv004
   Tmpv006 =field(i,k,j+3) -field(i,k,j-2)
   Tmpv007 =Tmpv005 +Tmpv006
   dflux_y_p1 =Tmpv007
   Tmpv3012 =dflux_y_p1

   IF( diff_6th_opt .EQ. 2 ) THEN
   IF( dflux_y_p0 * ( field(i,k,j  )-field(i,k,j-1) ) .LE. 0.0 ) THEN
   dflux_y_p0 =0.0

   END IF
   IF( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j  ) ) .LE. 0.0 ) THEN
   dflux_y_p1 =0.0

   END IF
   END IF
   IF( name .EQ. 'u' ) THEN
   Tmpv001 =mu(i-1,j-1) +mu(i,j-1)
   Tmpv002 =Tmpv001 +mu(i-1,j)
   Tmpv003 =Tmpv002 +mu(i,j)
   Tmpv004 =0.25*Tmpv003
   mu_avg_p0 =Tmpv004

   Tmpv001 =mu(i-1,j) +mu(i,j)
   Tmpv002 =Tmpv001 +mu(i-1,j+1)
   Tmpv003 =Tmpv002 +mu(i,j+1)
   Tmpv004 =0.25*Tmpv003
   mu_avg_p1 =Tmpv004

   ELSE IF( name .EQ. 'v' ) THEN
   mu_avg_p0 =mu(i,j-1)

   mu_avg_p1 =mu(i,j)

   ELSE
   Tmpv001 =mu(i,j-1) +mu(i,j)
   Tmpv002 =0.5*Tmpv001
   mu_avg_p0 =Tmpv002

   Tmpv001 =mu(i,j) +mu(i,j+1)
   Tmpv002 =0.5*Tmpv001
   mu_avg_p1 =Tmpv002

   END IF

   a_Tmpv2 =a_tendency(i,k,j)
   a_tendency(i,k,j) =0.0
   a_Tmpv1 =a_Tmpv2
   a_tendency_y =a_tendency_y +a_Tmpv2
   a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv1
   a_tendency_x =a_tendency_x +a_Tmpv1
   a_Tmpv4 =a_tendency_y
   a_tendency_y =0.0
!   a_diff_6th_coef =a_diff_6th_coef +Tmpv3021(i,k)*a_Tmpv4  ! Remarked by Ning Pan, 2010-07-23
   a_Tmpv3 =diff_6th_coef*a_Tmpv4
   a_Tmpv1 =a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
   a_mu_avg_p0 =a_mu_avg_p0 +dflux_y_p0*a_Tmpv2
   a_dflux_y_p0 =a_dflux_y_p0 +mu_avg_p0*a_Tmpv2
   a_mu_avg_p1 =a_mu_avg_p1 +dflux_y_p1*a_Tmpv1
   a_dflux_y_p1 =a_dflux_y_p1 +mu_avg_p1*a_Tmpv1

! Added by Ning Pan, 2010-07-23
   IF( name .EQ. 'u' ) THEN
   a_Tmpv4 =a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_mu(i,j+1) =a_mu(i,j+1) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mu(i-1,j+1) =a_mu(i-1,j+1) +a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_Tmpv4 =a_mu_avg_p0
   a_mu_avg_p0 =0.0
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_mu(i,j) =a_mu(i,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv2
   a_mu(i-1,j-1) =a_mu(i-1,j-1) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ELSE IF( name .EQ. 'v' ) THEN
   a_mu(i,j) =a_mu(i,j) +a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_mu(i,j-1) =a_mu(i,j-1) +a_mu_avg_p0
   a_mu_avg_p0 =0.0
   ELSE
   a_Tmpv2 =a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i,j+1) =a_mu(i,j+1) +a_Tmpv1
   a_Tmpv2 =a_mu_avg_p0
   a_mu_avg_p0 =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   END IF

   dflux_y_p0 = Tmpv3011
   dflux_y_p1 = Tmpv3012

   IF( diff_6th_opt .EQ. 2 ) THEN

   IF( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j  ) ) .LE. 0.0 ) THEN

   a_dflux_y_p1 =0.0

   END IF

   IF( dflux_y_p0 * ( field(i,k,j  )-field(i,k,j-1) ) .LE. 0.0 ) THEN

   a_dflux_y_p0 =0.0

   END IF

   END IF

   a_Tmpv7 =a_dflux_y_p1
   a_dflux_y_p1 =0.0
   a_Tmpv5 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_field(i,k,j+3) =a_field(i,k,j+3) +a_Tmpv6
   a_field(i,k,j-2) =a_field(i,k,j-2) -a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv3 =5.0*a_Tmpv4
   a_field(i,k,j+2) =a_field(i,k,j+2) +a_Tmpv3
   a_field(i,k,j-1) =a_field(i,k,j-1) -a_Tmpv3
   a_Tmpv1 =10.0*a_Tmpv2
   a_field(i,k,j+1) =a_field(i,k,j+1) +a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv1

   a_Tmpv7 =a_dflux_y_p0
   a_dflux_y_p0 =0.0
   a_Tmpv5 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_field(i,k,j+2) =a_field(i,k,j+2) +a_Tmpv6
   a_field(i,k,j-3) =a_field(i,k,j-3) -a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv3 =5.0*a_Tmpv4
   a_field(i,k,j+1) =a_field(i,k,j+1) +a_Tmpv3
   a_field(i,k,j-2) =a_field(i,k,j-2) -a_Tmpv3
   a_Tmpv1 =10.0*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

   Tmpv001 =field(i,k,j) -field(i-1,k,j)
   Tmpv002 =10.0*Tmpv001
   Tmpv003 =field(i+1,k,j) -field(i-2,k,j)
   Tmpv004 =5.0*Tmpv003
   Tmpv005 =Tmpv002 -Tmpv004
   Tmpv006 =field(i+2,k,j) -field(i-3,k,j)
   Tmpv007 =Tmpv005 +Tmpv006
   dflux_x_p0 =Tmpv007
   Tmpv300 =dflux_x_p0

   Tmpv001 =field(i+1,k,j) -field(i,k,j)
   Tmpv002 =10.0*Tmpv001
   Tmpv003 =field(i+2,k,j) -field(i-1,k,j)
   Tmpv004 =5.0*Tmpv003
   Tmpv005 =Tmpv002 -Tmpv004
   Tmpv006 =field(i+3,k,j) -field(i-2,k,j)
   Tmpv007 =Tmpv005 +Tmpv006
   dflux_x_p1 =Tmpv007
   Tmpv301 =dflux_x_p1

   IF( diff_6th_opt .EQ. 2 ) THEN
   IF( dflux_x_p0 * ( field(i  ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN
   dflux_x_p0 =0.0

   END IF
   IF( dflux_x_p1 * ( field(i+1,k,j)-field(i  ,k,j) ) .LE. 0.0 ) THEN
   dflux_x_p1 =0.0

   END IF
   END IF
   IF( name .EQ. 'u' ) THEN
   mu_avg_p0 =mu(i-1,j)
   mu_avg_p1 =mu(i,j)

   ELSE IF( name .EQ. 'v' ) THEN
   Tmpv001 =mu(i-1,j-1) +mu(i,j-1)
   Tmpv002 =Tmpv001 +mu(i-1,j)
   Tmpv003 =Tmpv002 +mu(i,j)
   Tmpv004 =0.25*Tmpv003
   mu_avg_p0 =Tmpv004

   Tmpv001 =mu(i,j-1) +mu(i+1,j-1)
   Tmpv002 =Tmpv001 +mu(i,j)
   Tmpv003 =Tmpv002 +mu(i+1,j)
   Tmpv004 =0.25*Tmpv003
   mu_avg_p1 =Tmpv004

   ELSE
   Tmpv001 =mu(i-1,j) +mu(i,j)
   Tmpv002 =0.5*Tmpv001
   mu_avg_p0 =Tmpv002

   Tmpv001 =mu(i,j) +mu(i+1,j)
   Tmpv002 =0.5*Tmpv001
   mu_avg_p1 =Tmpv002

   END IF

   a_Tmpv4 =a_tendency_x
   a_tendency_x =0.0
   a_Tmpv3 =diff_6th_coef*a_Tmpv4
   a_Tmpv1 =a_Tmpv3
   a_Tmpv2 =-a_Tmpv3
   a_mu_avg_p0 =a_mu_avg_p0 +dflux_x_p0*a_Tmpv2
   a_dflux_x_p0 =a_dflux_x_p0 +mu_avg_p0*a_Tmpv2
   a_mu_avg_p1 =a_mu_avg_p1 +dflux_x_p1*a_Tmpv1
   a_dflux_x_p1 =a_dflux_x_p1 +mu_avg_p1*a_Tmpv1
 
   IF( name .EQ. 'u' ) THEN
   a_mu(i,j) =a_mu(i,j) +a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_mu(i-1,j) =a_mu(i-1,j) +a_mu_avg_p0
   a_mu_avg_p0 =0.0
   ELSE IF( name .EQ. 'v' ) THEN
   a_Tmpv4 =a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_mu(i+1,j) =a_mu(i+1,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv2
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   a_mu(i+1,j-1) =a_mu(i+1,j-1) +a_Tmpv1
   a_Tmpv4 =a_mu_avg_p0
   a_mu_avg_p0 =0.0
   a_Tmpv3 =0.25*a_Tmpv4
   a_Tmpv2 =a_Tmpv3
   a_mu(i,j) =a_mu(i,j) +a_Tmpv3
   a_Tmpv1 =a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv2
   a_mu(i-1,j-1) =a_mu(i-1,j-1) +a_Tmpv1
   a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
   ELSE
   a_Tmpv2 =a_mu_avg_p1
   a_mu_avg_p1 =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   a_mu(i+1,j) =a_mu(i+1,j) +a_Tmpv1
   a_Tmpv2 =a_mu_avg_p0
   a_mu_avg_p0 =0.0
   a_Tmpv1 =0.5*a_Tmpv2
   a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
   a_mu(i,j) =a_mu(i,j) +a_Tmpv1
   END IF

   dflux_x_p0 = Tmpv300
   dflux_x_p1 = Tmpv301
   IF( diff_6th_opt .EQ. 2 ) THEN

   IF( dflux_x_p1 * ( field(i+1,k,j)-field(i  ,k,j) ) .LE. 0.0 ) THEN

   a_dflux_x_p1 =0.0

   END IF

   IF( dflux_x_p0 * ( field(i  ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN

   a_dflux_x_p0 =0.0

   END IF

   END IF

   a_Tmpv7 =a_dflux_x_p1
   a_dflux_x_p1 =0.0
   a_Tmpv5 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_field(i+3,k,j) =a_field(i+3,k,j) +a_Tmpv6
   a_field(i-2,k,j) =a_field(i-2,k,j) -a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv3 =5.0*a_Tmpv4
   a_field(i+2,k,j) =a_field(i+2,k,j) +a_Tmpv3
   a_field(i-1,k,j) =a_field(i-1,k,j) -a_Tmpv3
   a_Tmpv1 =10.0*a_Tmpv2
   a_field(i+1,k,j) =a_field(i+1,k,j) +a_Tmpv1
   a_field(i,k,j) =a_field(i,k,j) -a_Tmpv1

   a_Tmpv7 =a_dflux_x_p0
   a_dflux_x_p0 =0.0
   a_Tmpv5 =a_Tmpv7
   a_Tmpv6 =a_Tmpv7
   a_field(i+2,k,j) =a_field(i+2,k,j) +a_Tmpv6
   a_field(i-3,k,j) =a_field(i-3,k,j) -a_Tmpv6
   a_Tmpv2 =a_Tmpv5
   a_Tmpv4 =-a_Tmpv5
   a_Tmpv3 =5.0*a_Tmpv4
   a_field(i+1,k,j) =a_field(i+1,k,j) +a_Tmpv3
   a_field(i-2,k,j) =a_field(i-2,k,j) -a_Tmpv3
   a_Tmpv1 =10.0*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
   ENDDO
   ENDDO

   ENDDO

   END SUBROUTINE a_sixth_order_diffusion

END MODULE a_module_big_step_utilities_em