!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of ducu in reverse (adjoint) mode (with options r8):
!   gradient     of useful results: th raincv t rthcuten pcps qv
!                z pratec rqvcuten rho dz8w
!   with respect to varying inputs: th raincv t rthcuten pcps qv
!                z pratec rqvcuten rho dz8w
MODULE a_module_cu_du
   USE module_wrf_error
  REAL    , PARAMETER :: cincap = -10.
  REAL    , PARAMETER :: capemin = 10.
  REAL    , PARAMETER :: dpthmin = 1000.
  REAL    , PARAMETER :: alpha = 0.00002
  REAL    , PARAMETER :: eps = 0.5
  REAL    , PARAMETER :: Vfall = 5.
!--------------------------------------------------------------------
CONTAINS
SUBROUTINE DUCU_B(ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms&
&  , kme, its, ite, jts, jte, kts, kte, dt, ktau, dx, rho, rhob, raincv, &
&  raincvb, nca, pratec, pratecb, u, v, th, thb, t, tb, w, dz8w, dz8wb, z&
&  , zb, pcps, pcpsb, pi, w0avg, cp, rd, rv, g, xlv, ep2, svp1, svp2, &
&  svp3, svpt0, stepcu, cu_act_flag, warm_rain, cutop, cubot, qv, qvb, &
&  rthcuten, rthcutenb, rqvcuten, rqvcutenb)
  IMPLICIT NONE
!
!-------------------------------------------------------------
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  INTEGER, INTENT(IN) :: stepcu
  LOGICAL, INTENT(IN) :: warm_rain
  REAL, INTENT(IN) :: xlv
  REAL, INTENT(IN) :: cp, rd, rv, g, ep2
  REAL, INTENT(IN) :: svp1, svp2, svp3, svpt0
  INTEGER, INTENT(IN) :: ktau
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u, v, w, th&
&  , t, qv, dz8w, z, pcps, rho, pi
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: thb, tb, qvb, dz8wb, zb&
&  , pcpsb, rhob
!
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: w0avg
  REAL, INTENT(IN) :: dt, dx
!
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincv, pratec
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincvb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: nca
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: cubot, cutop
  LOGICAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: cu_act_flag
!
! Optional arguments
!
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  rthcuten, rqvcuten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL :: rthcutenb, &
&  rqvcutenb
!
! LOCAL VARS
  LOGICAL :: flag_qr, flag_qi, flag_qs
  REAL, DIMENSION(kts:kte) :: u1d, v1d, t1d, th1d, dz1d, z1d, qv1d, p1d&
&  , rho1d, w0avg1d
  REAL, DIMENSION(kts:kte) :: t1db, th1db, dz1db, z1db, qv1db, p1db, &
&  rho1db
  REAL, DIMENSION(kts:kte) :: dqvdt, dthdt
  REAL, DIMENSION(kts:kte) :: dqvdtb, dthdtb
  REAL :: pprate, tst, tv, prs, rhoe, w0, scr1, dxsq, rthcumax
  REAL :: pprateb
  INTEGER :: i, j, k, i_start, i_end, j_start, j_end, sz, ntst, icldck
  INTEGER :: branch
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: pratecb
!
  ntst = stepcu
  icldck = MOD(ktau, ntst)
  IF (icldck .EQ. 0 .OR. ktau .EQ. 1) THEN
!
!  Keep away from specified and relaxation zone (should be for just specified and nested bc)
    sz = 1
    IF (ids + sz .LT. its) THEN
      i_start = its
    ELSE
      i_start = ids + sz
    END IF
    IF (ide - 1 - sz .GT. ite) THEN
      i_end = ite
    ELSE
      i_end = ide - 1 - sz
    END IF
    IF (jds + sz .LT. jts) THEN
      j_start = jts
    ELSE
      j_start = jds + sz
    END IF
    IF (jde - 1 - sz .GT. jte) THEN
      j_end = jte
    ELSE
      j_end = jde - 1 - sz
    END IF
!
    DO j=j_start,j_end
      DO i=i_start,i_end
!
! assign vars from 3D to 1D
        DO k=kts,kte
          CALL PUSHREAL8(t1d(k))
          t1d(k) = t(i, k, j)
          CALL PUSHREAL8(th1d(k))
          th1d(k) = th(i, k, j)
          CALL PUSHREAL8(rho1d(k))
          rho1d(k) = rho(i, k, j)
          CALL PUSHREAL8(qv1d(k))
          qv1d(k) = qv(i, k, j)
          IF (qv1d(k) .LT. 1.e-08) THEN
            qv1d(k) = 1.e-08
            CALL PUSHCONTROL1B(0)
          ELSE
            CALL PUSHCONTROL1B(1)
          END IF
          CALL PUSHREAL8(p1d(k))
          p1d(k) = pcps(i, k, j)
          CALL PUSHREAL8(dz1d(k))
          dz1d(k) = dz8w(i, k, j)
          CALL PUSHREAL8(z1d(k))
          z1d(k) = z(i, k, j)
        END DO
        IF (PRESENT(rthcuten) .AND. PRESENT(rqvcuten)) THEN
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
      END DO
    END DO
    qv1db = 0.0_8
    dthdtb = 0.0_8
    th1db = 0.0_8
    rho1db = 0.0_8
    p1db = 0.0_8
    z1db = 0.0_8
    dz1db = 0.0_8
    t1db = 0.0_8
    dqvdtb = 0.0_8
    DO j=j_end,j_start,-1
      DO i=i_end,i_start,-1
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          pprateb = 0.0_8
        ELSE
          pprateb = pratecb(i, j) + dt*raincvb(i, j)
          raincvb(i, j) = 0.0_8
          pratecb(i, j) = 0.0_8
          DO k=kte,kts,-1
            dqvdtb(k) = dqvdtb(k) + rqvcutenb(i, k, j)
            rqvcutenb(i, k, j) = 0.0_8
            dthdtb(k) = dthdtb(k) + rthcutenb(i, k, j)
            rthcutenb(i, k, j) = 0.0_8
          END DO
        END IF
        CALL DUCU1D_B(i, j, u1d, v1d, t1d, t1db, qv1d, qv1db, p1d, p1db&
&                , dz1d, dz1db, z1d, z1db, w0avg1d, dt, dx, dxsq, rho1d, &
&                rho1db, th1d, th1db, xlv, cp, rd, rv, g, ep2, svp1, svp2&
&                , svp3, svpt0, dqvdt, dqvdtb, dthdt, dthdtb, pprate, &
&                pprateb, nca, ntst, cutop, cubot, ids, ide, jds, jde, &
&                kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
&                jte, kts, kte)
        DO k=kte,kts,-1
          CALL POPREAL8(z1d(k))
          zb(i, k, j) = zb(i, k, j) + z1db(k)
          z1db(k) = 0.0_8
          CALL POPREAL8(dz1d(k))
          dz8wb(i, k, j) = dz8wb(i, k, j) + dz1db(k)
          dz1db(k) = 0.0_8
          CALL POPREAL8(p1d(k))
          pcpsb(i, k, j) = pcpsb(i, k, j) + p1db(k)
          p1db(k) = 0.0_8
          CALL POPCONTROL1B(branch)
          IF (branch .EQ. 0) qv1db(k) = 0.0_8
          CALL POPREAL8(qv1d(k))
          qvb(i, k, j) = qvb(i, k, j) + qv1db(k)
          qv1db(k) = 0.0_8
          CALL POPREAL8(rho1d(k))
          rhob(i, k, j) = rhob(i, k, j) + rho1db(k)
          rho1db(k) = 0.0_8
          CALL POPREAL8(th1d(k))
          thb(i, k, j) = thb(i, k, j) + th1db(k)
          th1db(k) = 0.0_8
          CALL POPREAL8(t1d(k))
          tb(i, k, j) = tb(i, k, j) + t1db(k)
          t1db(k) = 0.0_8
        END DO
        pratecb(i, j) = 0.0_8
        raincvb(i, j) = 0.0_8
        DO k=kte,kts,-1
          dthdtb(k) = 0.0_8
          dqvdtb(k) = 0.0_8
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE DUCU_B

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of ducu1d in reverse (adjoint) mode (with options r8):
!   gradient     of useful results: dthdt p0 z t0 th0 pprate rhoe
!                dzq dqvdt qv0
!   with respect to varying inputs: dthdt p0 z t0 th0 rhoe dzq
!                dqvdt qv0
! ****************************************************************************
!-----------------------------------------------------------
SUBROUTINE DUCU1D_B(i, j, u0, v0, t0, t0b, qv0, qv0b, p0, p0b, dzq, dzqb&
&  , z, zb0, w0avg1d, delt, dx, dxsq, rhoe, rhoeb, th0, th0b, xlv, cp, rd&
&  , rv, g, ep2, svp1, svp2, svp3, svpt0, dqvdt, dqvdtb, dthdt, dthdtb, &
&  pprate, pprateb, nca, ntst, cutop, cubot, 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, i, j, ntst
!
  REAL, DIMENSION(kts:kte), INTENT(IN) :: u0, v0, t0, th0, qv0, p0, rhoe&
&  , dzq, z, w0avg1d
  REAL, DIMENSION(kts:kte) :: t0b, th0b, qv0b, p0b, rhoeb, dzqb, zb0
!
  REAL, INTENT(IN) :: delt, dx, dxsq
!
  REAL, INTENT(IN) :: xlv, cp, rd, rv, g
  REAL, INTENT(IN) :: ep2, svp1, svp2, svp3, svpt0
!
  REAL, DIMENSION(kts:kte), INTENT(INOUT) :: dqvdt, dthdt
  REAL, DIMENSION(kts:kte), INTENT(INOUT) :: dqvdtb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: nca
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: cubot, cutop
  REAL :: pprate
  REAL :: pprateb
!
!...DEFINE LOCAL VARIABLES...
!
  REAL, DIMENSION(kts:kte) :: cond, h, hs, qs, x
  REAL, DIMENSION(kts:kte) :: condb, hb, hsb, qsb, xb
  REAL :: buoy, cape, cin, dh, dq, dt, dtm, ep, es, evap, hp, mp, qp, &
&  qsp, rrk, rrkp, tadp, tdp, zb, zg, zi, zt
  REAL :: dhb, dqb, dtb, esb, evapb, hpb, mpb, qpb, qspb, rrkb, rrkpb
  INTEGER :: ipos, isat, k, kb, ki, kt
  INTEGER :: branch
  INTEGER :: ad_count
  INTEGER :: i0
  INTEGER :: ad_from
  INTEGER :: ad_to
  INTEGER :: ad_from0
  REAL, DIMENSION(kts:kte), INTENT(INOUT) :: dthdtb
  REAL :: temp3
  REAL :: temp2
  REAL :: temp1
  REAL :: temp0
  REAL :: temp7b
  REAL :: temp9b1
  REAL :: temp9b0
  REAL :: temp7b0
  REAL :: temp6b
  REAL :: temp12
  REAL :: temp11
  REAL :: temp10
  REAL :: temp9b
  REAL :: temp5b0
  REAL :: tempb
  REAL :: temp2b
  REAL :: temp5b
  REAL :: temp8b0
  REAL :: temp8b
  REAL :: abs1
  REAL :: abs0
  REAL :: temp1b
  REAL :: temp
  REAL :: temp6b0
  REAL :: temp9
  REAL :: temp1b1
  REAL :: temp8
  REAL :: temp1b0
  REAL :: temp7
  REAL :: temp10b
  REAL :: temp6
  REAL :: temp4b
  REAL :: temp5
  REAL :: temp10b0
  REAL :: temp4
!
!...DEFINE PROFILES
  DO k=kts,kte
    h(k) = cp*t0(k) + g*z(k) + xlv*qv0(k)
    CALL PUSHREAL8(es)
    es = 1000.*svp1*EXP(svp2*(t0(k)-svpt0)/(t0(k)-svp3))
    qs(k) = ep2*es/(p0(k)-es)
    hs(k) = cp*t0(k) + g*z(k) + xlv*qs(k)
    x(k) = xlv*xlv*qs(k)/(cp*rv*t0(k)*t0(k))
  END DO
!
!...LOOP OVER PARCELS
loop_origin:DO ki=kts,kte
    hp = h(ki)
    qp = qv0(ki)
    CALL PUSHREAL8(mp)
    mp = alpha*rhoe(ki)*dzq(ki)
    buoy = 0.
    cape = 0.
    dtm = 0.
    isat = 0
    ipos = 0
    CALL PUSHINTEGER4(kt)
    kt = 0
    kb = 0
    zt = 0.
    zb = 0.
    cond = 0.
    CALL PUSHINTEGER4(k)
    ad_count = 1
!
!...LIFT PARCEL
loop_lift:DO k=ki+1,kte
      tadp = t0(ki) + g/cp*(z(ki)-z(k))
      ep = p0(k)*qv0(ki)/(ep2+qv0(ki))
      tdp = (svpt0-svp3/svp2*ALOG(0.001*ep/svp1))/(1.-1./svp2*ALOG(0.001&
&        *ep/svp1))
      IF (tadp .GE. tdp) THEN
        dt = tadp - t0(k)
        cond(k) = 0.
        CALL PUSHCONTROL1B(1)
      ELSE
!         saturated
        IF (isat .EQ. 0) THEN
          kb = k
          zb = z(k) - 0.5*dzq(k)
        END IF
        isat = 1
        CALL PUSHREAL8(dh)
        dh = hp - hs(k)
        dt = dh/cp/(1.+x(k))
        CALL PUSHREAL8(qsp)
        qsp = qs(k) + dh/xlv*x(k)/(1.+x(k))
!...CONDENSATE PRODUCED
        cond(k) = mp*(qp-qsp)
        CALL PUSHREAL8(qp)
        qp = qsp
        CALL PUSHCONTROL1B(0)
      END IF
      buoy = buoy + g*dt*dzq(k)/t0(k)
      IF (cape .LT. buoy) THEN
        cape = buoy
      ELSE
        cape = cape
      END IF
      IF (dt .GE. 0.) THEN
        kt = k
        zt = z(k) + 0.5*dzq(k)
      ELSE IF (dt .LT. 0. .AND. dtm .GE. 0.) THEN
        IF (dt .GE. 0.) THEN
          abs0 = dt
        ELSE
          abs0 = -dt
        END IF
        IF (dtm .GE. 0.) THEN
          abs1 = dtm
        ELSE
          abs1 = -dtm
        END IF
! cloud top is level closest to parcel temperature
        IF (abs0 .LT. abs1) THEN
          kt = k
          zt = z(k) + 0.5*dzq(k)
        END IF
      END IF
      dtm = dt
! continue lifting until buoyancy is gone
      IF (buoy .LT. cincap) THEN
        GOTO 100
      ELSE
        IF (buoy .GT. 0.) ipos = 1
!         positive area detected
        IF (k .EQ. 1) THEN
          kt = k
          zt = z(k) + 0.5*dzq(k)
        END IF
        CALL PUSHINTEGER4(k)
        ad_count = ad_count + 1
      END IF
    END DO loop_lift
    CALL PUSHCONTROL1B(0)
    CALL PUSHINTEGER4(ad_count)
    GOTO 110
 100 CALL PUSHCONTROL1B(1)
    CALL PUSHINTEGER4(ad_count)
!
!...CHECK FOR CLOUD
 110 IF (isat .EQ. 0) THEN
      CALL PUSHCONTROL3B(3)
    ELSE IF (zt - zb .LE. dpthmin) THEN
!       no cloud from lifting - no convection
      CALL PUSHCONTROL3B(2)
    ELSE IF (ipos .EQ. 0) THEN
!       not more than one cloud level - no convection
      CALL PUSHCONTROL3B(1)
    ELSE IF (cape .LE. capemin) THEN
!       no buoyancy in cloud - no convection
      CALL PUSHCONTROL3B(0)
    ELSE
      CALL PUSHREAL8(dh)
!       not enough cape
!
!...IF CHECK FOR CLOUD SUCCESSFUL
!
!...DETRAINMENT
      ad_from = kt - 1
      CALL PUSHINTEGER4(k)
!
!...SUBSIDENCE
      k = ki - 1
      CALL PUSHINTEGER4(k + 1)
      CALL PUSHINTEGER4(ad_from)
!
!...RAINFALL AND EVAPORATION
      rrkp = 0.
      ad_from0 = kt
loop_rainfall:DO k=ad_from0,1,-1
        rrk = rrkp + cond(k)
        CALL PUSHREAL8(evap)
        evap = dzq(k)*rrkp/vfall*eps*(qs(k)-qv0(k))
! restrict evap to below cloud base
        IF (k .GE. kb) THEN
          evap = 0.
          CALL PUSHCONTROL1B(1)
        ELSE
          CALL PUSHCONTROL1B(0)
        END IF
        IF (rrk .GT. evap) THEN
          CALL PUSHCONTROL1B(0)
          evap = evap
        ELSE
          evap = rrk
          CALL PUSHCONTROL1B(1)
        END IF
        rrk = rrk - evap
        CALL PUSHREAL8(rrkp)
        rrkp = rrk
      END DO loop_rainfall
      CALL PUSHINTEGER4(ad_from0)
      CALL PUSHCONTROL3B(4)
    END IF
  END DO loop_origin
  hb = 0.0_8
  qsb = 0.0_8
  xb = 0.0_8
  hsb = 0.0_8
  DO ki=kte,kts,-1
    CALL POPCONTROL3B(branch)
    IF (branch .LT. 2) THEN
      IF (branch .EQ. 0) THEN
        hpb = 0.0_8
        condb = 0.0_8
        mpb = 0.0_8
      ELSE
        hpb = 0.0_8
        condb = 0.0_8
        mpb = 0.0_8
      END IF
    ELSE IF (branch .EQ. 2) THEN
      hpb = 0.0_8
      condb = 0.0_8
      mpb = 0.0_8
    ELSE IF (branch .EQ. 3) THEN
      hpb = 0.0_8
      condb = 0.0_8
      mpb = 0.0_8
    ELSE
      rrkpb = pprateb
      condb = 0.0_8
      CALL POPINTEGER4(ad_from0)
      DO k=1,ad_from0,1
        temp9 = rhoe(k)*dzq(k)
        temp9b1 = -(evap*dqvdtb(k)/temp9**2)
        CALL POPREAL8(rrkp)
        rrkb = rrkpb
        temp12 = rhoe(k)*dzq(k)
        temp11 = cp*t0(kt)
        temp10 = temp11*temp12
        temp10b = -(xlv*dthdtb(k)/temp10)
        temp10b0 = -(th0(kt)*evap*temp10b/temp10)
        th0b(kt) = th0b(kt) + evap*temp10b
        evapb = dqvdtb(k)/temp9 - rrkb + th0(kt)*temp10b
        t0b(kt) = t0b(kt) + temp12*cp*temp10b0
        rhoeb(k) = rhoeb(k) + dzq(k)*temp9b1 + temp11*dzq(k)*temp10b0
        dzqb(k) = dzqb(k) + rhoe(k)*temp9b1 + temp11*rhoe(k)*temp10b0
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) THEN
          rrkb = rrkb + evapb
          evapb = 0.0_8
        END IF
        CALL POPCONTROL1B(branch)
        IF (branch .NE. 0) evapb = 0.0_8
        CALL POPREAL8(evap)
        temp9b = eps*dzq(k)*rrkp*evapb/vfall
        temp9b0 = eps*(qs(k)-qv0(k))*evapb
        qsb(k) = qsb(k) + temp9b
        qv0b(k) = qv0b(k) - temp9b
        dzqb(k) = dzqb(k) + rrkp*temp9b0/vfall
        rrkpb = rrkb + dzq(k)*temp9b0/vfall
        condb(k) = condb(k) + rrkb
      END DO
      mp = alpha*rhoe(ki)*dzq(ki)
      mpb = 0.0_8
      CALL POPINTEGER4(ad_from)
      CALL POPINTEGER4(ad_to)
      DO k=ad_to,ad_from,1
        temp7 = rhoe(k)*dzq(k)
        temp7b = dthdtb(k)/temp7
        temp7b0 = -(mp*(th0(k+1)-th0(k))*temp7b/temp7)
        temp8 = rhoe(k)*dzq(k)
        temp8b = dqvdtb(k)/temp8
        temp8b0 = -(mp*(qv0(k+1)-qv0(k))*temp8b/temp8)
        mpb = mpb + (th0(k+1)-th0(k))*temp7b + (qv0(k+1)-qv0(k))*temp8b
        qv0b(k+1) = qv0b(k+1) + mp*temp8b
        qv0b(k) = qv0b(k) - mp*temp8b
        rhoeb(k) = rhoeb(k) + dzq(k)*temp7b0 + dzq(k)*temp8b0
        dzqb(k) = dzqb(k) + rhoe(k)*temp7b0 + rhoe(k)*temp8b0
        th0b(k+1) = th0b(k+1) + mp*temp7b
        th0b(k) = th0b(k) - mp*temp7b
      END DO
      CALL POPINTEGER4(k)
      temp3 = cp*(x(kt)+1.)
      temp5 = t0(kt)*rhoe(kt)
      temp5b = dthdtb(kt)/(temp5*dzq(kt))
      hp = h(ki)
      dh = hp - hs(kt)
      dq = qs(kt) + dh/xlv*x(kt)/(1.+x(kt)) - qv0(kt)
      temp6 = rhoe(kt)*dzq(kt)
      temp6b = dqvdtb(kt)/temp6
      temp6b0 = -(mp*dq*temp6b/temp6)
      dqb = mp*temp6b
      dt = dh/cp/(1.+x(kt))
      mpb = mpb + th0(kt)*dt*temp5b + dq*temp6b
      temp5b0 = -(th0(kt)*mp*dt*temp5b/(temp5*dzq(kt)))
      rhoeb(kt) = rhoeb(kt) + dzq(kt)*t0(kt)*temp5b0 + dzq(kt)*temp6b0
      dzqb(kt) = dzqb(kt) + temp5*temp5b0 + rhoe(kt)*temp6b0
      th0b(kt) = th0b(kt) + mp*dt*temp5b
      dtb = th0(kt)*mp*temp5b
      t0b(kt) = t0b(kt) + dzq(kt)*rhoe(kt)*temp5b0
      temp4 = xlv*(x(kt)+1.)
      temp4b = dqb/temp4
      qsb(kt) = qsb(kt) + dqb
      dhb = dtb/temp3 + x(kt)*temp4b
      xb(kt) = xb(kt) + (dh-dh*x(kt)*xlv/temp4)*temp4b - dh*cp*dtb/temp3&
&        **2
      qv0b(kt) = qv0b(kt) - dqb
      CALL POPREAL8(dh)
      hpb = dhb
      hsb(kt) = hsb(kt) - dhb
    END IF
    CALL POPINTEGER4(ad_count)
    DO i0=1,ad_count
      IF (i0 .EQ. 1) THEN
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          qpb = 0.0_8
          GOTO 120
        ELSE
          qpb = 0.0_8
        END IF
      END IF
      CALL POPCONTROL1B(branch)
      IF (branch .EQ. 0) THEN
        CALL POPREAL8(qp)
        qspb = qpb - mp*condb(k)
        mpb = mpb + (qp-qsp)*condb(k)
        qpb = mp*condb(k)
        condb(k) = 0.0_8
        CALL POPREAL8(qsp)
        temp2 = xlv*(x(k)+1.)
        temp2b = qspb/temp2
        qsb(k) = qsb(k) + qspb
        dhb = x(k)*temp2b
        xb(k) = xb(k) + (dh-dh*x(k)*xlv/temp2)*temp2b
        CALL POPREAL8(dh)
        hpb = hpb + dhb
        hsb(k) = hsb(k) - dhb
      ELSE
        condb(k) = 0.0_8
      END IF
 120  CALL POPINTEGER4(k)
    END DO
    CALL POPINTEGER4(kt)
    CALL POPREAL8(mp)
    rhoeb(ki) = rhoeb(ki) + alpha*dzq(ki)*mpb
    dzqb(ki) = dzqb(ki) + alpha*rhoe(ki)*mpb
    qv0b(ki) = qv0b(ki) + qpb
    hb(ki) = hb(ki) + hpb
  END DO
  DO k=kte,kts,-1
    dqvdtb(k) = 0.0_8
    dthdtb(k) = 0.0_8
    temp1 = cp*rv*t0(k)**2
    temp1b = xlv**2*xb(k)/temp1
    qsb(k) = qsb(k) + xlv*hsb(k) + temp1b
    xb(k) = 0.0_8
    zb0(k) = zb0(k) + g*hb(k) + g*hsb(k)
    temp1b0 = ep2*qsb(k)/(p0(k)-es)
    temp1b1 = -(es*temp1b0/(p0(k)-es))
    esb = temp1b0 - temp1b1
    p0b(k) = p0b(k) + temp1b1
    qsb(k) = 0.0_8
    CALL POPREAL8(es)
    temp0 = t0(k) - svp3
    temp = (t0(k)-svpt0)/temp0
    tempb = svp2*EXP(svp2*temp)*svp1*1000.*esb/temp0
    t0b(k) = t0b(k) + cp*hsb(k) + cp*hb(k) + (1.0-temp)*tempb - cp*rv*qs&
&      (k)*2*t0(k)*temp1b/temp1
    hsb(k) = 0.0_8
    qv0b(k) = qv0b(k) + xlv*hb(k)
    hb(k) = 0.0_8
  END DO
END SUBROUTINE DUCU1D_B

!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.6 (r4343) - 10 Feb 2012 10:52
!
!  Differentiation of ducuinit in reverse (adjoint) mode:
!   gradient     of useful results: rqccuten rthcuten w0avg rqvcuten
!   with respect to varying inputs: rqccuten rthcuten w0avg rqvcuten
SUBROUTINE DUCUINIT_B(rthcuten, rthcutenb, rqvcuten, rqvcutenb, rqccuten&
&  , rqccutenb, rqrcuten, rqicuten, rqscuten, nca, w0avg, w0avgb, p_qc, &
&  p_qr, svp1, svp2, svp3, svpt0, p_first_scalar, restart, &
&  allowed_to_read, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms&
&  , kme, its, ite, jts, jte, kts, kte)
  IMPLICIT NONE
!--------------------------------------------------------------------
  LOGICAL, INTENT(IN) :: restart, allowed_to_read
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, its, ite, jts, jte, kts, kte
  INTEGER, INTENT(IN) :: p_qc, p_qr, p_first_scalar
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rthcuten, rqvcuten, &
&  rqccuten, rqrcuten, rqicuten, rqscuten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rthcutenb, rqvcutenb, &
&  rqccutenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: w0avg
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: w0avgb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: nca
  INTEGER :: i, j, k, itf, jtf, ktf
  REAL, INTENT(IN) :: svp1, svp2, svp3, svpt0
  INTEGER :: branch
  INTRINSIC MIN0
  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
  IF (ite .GT. ide - 1) THEN
    itf = ide - 1
  ELSE
    itf = ite
  END IF
  IF (.NOT.restart) THEN
    IF (p_qc .GE. p_first_scalar) THEN
      CALL PUSHCONTROL1B(1)
    ELSE
      CALL PUSHCONTROL1B(0)
    END IF
    DO j=jtf,jts,-1
      DO k=ktf,kts,-1
        DO i=itf,its,-1
          w0avgb(i, k, j) = 0.0
        END DO
      END DO
    END DO
    CALL POPCONTROL1B(branch)
    IF (branch .NE. 0) THEN
      DO j=jtf,jts,-1
        DO k=ktf,kts,-1
          DO i=itf,its,-1
            rqccutenb(i, k, j) = 0.0
          END DO
        END DO
      END DO
    END IF
    DO j=jtf,jts,-1
      DO k=ktf,kts,-1
        DO i=itf,its,-1
          rqvcutenb(i, k, j) = 0.0
          rthcutenb(i, k, j) = 0.0
        END DO
      END DO
    END DO
  END IF
END SUBROUTINE DUCUINIT_B

END MODULE a_module_cu_du