wrftladj/module_mp_nconvp_tl.F

   1 !        Generated by TAPENADE     (INRIA, Tropics team)
   2 !  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
   3 !
   4 !  Differentiation of lscond in forward (tangent) mode (with options r8):
   5 !   variations   of useful results: th qv rainnc rainncv
   6 !   with respect to varying inputs: th p qv rainnc rainncv rho
   7 !                pii dz8w
   8 !WRF:MODEL_LAYER:PHYSICS
   9 !
  10 MODULE g_module_mp_nconvp
  11 CONTAINS
  12 !----------------------------------------------------------------
  13 ! domain dims
  14 ! memory dims
  15 ! tile   dims
  16 SUBROUTINE LSCOND_D(th, thd, p, pd, qv, qvd, rho, rhod, pii, piid, r_v, &
  17 &  xlv, cp, ep2, svp1, svp2, svp3, svpt0, dz8w, dz8wd, rainnc, rainncd, &
  18 &  rainncv, rainncvd, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, &
  19 &  kms, kme, its, ite, jts, jte, kts, kte)
  20   IMPLICIT NONE
  21 !----------------------------------------------------------------
  22 !  based on MM5 code (JD November 2006)
  23 !----------------------------------------------------------------
  24   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
  25 &  jme, kms, kme, its, ite, jts, jte, kts, kte
  26   REAL, INTENT(IN) :: r_v, xlv, cp
  27   REAL, INTENT(IN) :: ep2, svp1, svp2, svp3, svpt0
  28   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th, qv
  29   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thd, qvd
  30   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rho, pii, p&
  31 &  , dz8w
  32   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rhod, piid, &
  33 &  pd, dz8wd
  34   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainnc, rainncv
  35   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainncd, rainncvd
  36 ! local variables
  37   REAL :: ttemp, es1, qs1, dqv, cond, r1
  38   REAL :: ttempd, es1d, qs1d, dqvd, condd, r1d
  39   INTEGER :: i, j, k
  40   REAL :: arg1
  41   REAL :: arg1d
  42 !----------------------------------------------------------------
  43   DO j=jts,jte
  44     DO k=kts,kte
  45       DO i=its,ite
  46         ttempd = piid(i, k, j)*th(i, k, j) + pii(i, k, j)*thd(i, k, j)
  47         ttemp = pii(i, k, j)*th(i, k, j)
  48         arg1d = (svp2*ttempd*(ttemp-svp3)-svp2*(ttemp-svpt0)*ttempd)/(&
  49 &          ttemp-svp3)**2
  50         arg1 = svp2*(ttemp-svpt0)/(ttemp-svp3)
  51         es1d = 1000.*svp1*arg1d*EXP(arg1)
  52         es1 = 1000.*svp1*EXP(arg1)
  53         qs1d = (ep2*es1d*(p(i, k, j)-es1)-ep2*es1*(pd(i, k, j)-es1d))/(p&
  54 &          (i, k, j)-es1)**2
  55         qs1 = ep2*es1/(p(i, k, j)-es1)
  56         dqvd = qvd(i, k, j) - qs1d
  57         dqv = qv(i, k, j) - qs1
  58         IF (dqv .GT. 0.0) THEN
  59           r1d = (xlv**2*qs1d*ttemp**2/(r_v*cp)-xlv**2*qs1*(ttempd*ttemp+&
  60 &            ttemp*ttempd)/(r_v*cp))/(ttemp*ttemp)**2
  61           r1 = 1. + xlv*xlv/(r_v*cp)*qs1/(ttemp*ttemp)
  62           condd = (dqvd*r1-dqv*r1d)/r1**2
  63           cond = dqv/r1
  64           qvd(i, k, j) = qvd(i, k, j) - condd
  65           qv(i, k, j) = qv(i, k, j) - cond
  66           ttempd = ttempd + xlv*condd/cp
  67           ttemp = ttemp + xlv/cp*cond
  68           thd(i, k, j) = (ttempd*pii(i, k, j)-ttemp*piid(i, k, j))/pii(i&
  69 &            , k, j)**2
  70           th(i, k, j) = ttemp/pii(i, k, j)
  71           rainncvd(i, j) = (rhod(i, k, j)*cond+rho(i, k, j)*condd)*dz8w(&
  72 &            i, k, j) + rho(i, k, j)*cond*dz8wd(i, k, j)
  73           rainncv(i, j) = rho(i, k, j)*cond*dz8w(i, k, j)
  74           rainncd(i, j) = rainncd(i, j) + (rhod(i, k, j)*cond+rho(i, k, &
  75 &            j)*condd)*dz8w(i, k, j) + rho(i, k, j)*cond*dz8wd(i, k, j)
  76           rainnc(i, j) = rainnc(i, j) + rho(i, k, j)*cond*dz8w(i, k, j)
  77         END IF
  78       END DO
  79     END DO
  80   END DO
  81   RETURN
  82 END SUBROUTINE LSCOND_D
  83 END MODULE g_module_mp_nconvp