! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53 ! ! Differentiation of lscond in forward (tangent) mode (with options r8): ! variations of useful results: th qv rainnc rainncv ! with respect to varying inputs: th p qv rainnc rainncv rho ! pii dz8w !WRF:MODEL_LAYER:PHYSICS ! MODULE g_module_mp_nconvp CONTAINS !---------------------------------------------------------------- ! domain dims ! memory dims ! tile dims SUBROUTINE LSCOND_D(th, thd, p, pd, qv, qvd, rho, rhod, pii, piid, r_v, & & xlv, cp, ep2, svp1, svp2, svp3, svpt0, dz8w, dz8wd, rainnc, rainncd, & & rainncv, rainncvd, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, & & kms, kme, its, ite, jts, jte, kts, kte) IMPLICIT NONE !---------------------------------------------------------------- ! based on MM5 code (JD November 2006) !---------------------------------------------------------------- INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, its, ite, jts, jte, kts, kte REAL, INTENT(IN) :: r_v, xlv, cp REAL, INTENT(IN) :: ep2, svp1, svp2, svp3, svpt0 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th, qv REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thd, qvd REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rho, pii, p& & , dz8w REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rhod, piid, & & pd, dz8wd REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainnc, rainncv REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainncd, rainncvd ! local variables REAL :: ttemp, es1, qs1, dqv, cond, r1 REAL :: ttempd, es1d, qs1d, dqvd, condd, r1d INTEGER :: i, j, k REAL :: arg1 REAL :: arg1d !---------------------------------------------------------------- DO j=jts,jte DO k=kts,kte DO i=its,ite ttempd = piid(i, k, j)*th(i, k, j) + pii(i, k, j)*thd(i, k, j) ttemp = pii(i, k, j)*th(i, k, j) arg1d = (svp2*ttempd*(ttemp-svp3)-svp2*(ttemp-svpt0)*ttempd)/(& & ttemp-svp3)**2 arg1 = svp2*(ttemp-svpt0)/(ttemp-svp3) es1d = 1000.*svp1*arg1d*EXP(arg1) es1 = 1000.*svp1*EXP(arg1) qs1d = (ep2*es1d*(p(i, k, j)-es1)-ep2*es1*(pd(i, k, j)-es1d))/(p& & (i, k, j)-es1)**2 qs1 = ep2*es1/(p(i, k, j)-es1) dqvd = qvd(i, k, j) - qs1d dqv = qv(i, k, j) - qs1 IF (dqv .GT. 0.0) THEN r1d = (xlv**2*qs1d*ttemp**2/(r_v*cp)-xlv**2*qs1*(ttempd*ttemp+& & ttemp*ttempd)/(r_v*cp))/(ttemp*ttemp)**2 r1 = 1. + xlv*xlv/(r_v*cp)*qs1/(ttemp*ttemp) condd = (dqvd*r1-dqv*r1d)/r1**2 cond = dqv/r1 qvd(i, k, j) = qvd(i, k, j) - condd qv(i, k, j) = qv(i, k, j) - cond ttempd = ttempd + xlv*condd/cp ttemp = ttemp + xlv/cp*cond thd(i, k, j) = (ttempd*pii(i, k, j)-ttemp*piid(i, k, j))/pii(i& & , k, j)**2 th(i, k, j) = ttemp/pii(i, k, j) rainncvd(i, j) = (rhod(i, k, j)*cond+rho(i, k, j)*condd)*dz8w(& & i, k, j) + rho(i, k, j)*cond*dz8wd(i, k, j) rainncv(i, j) = rho(i, k, j)*cond*dz8w(i, k, j) rainncd(i, j) = rainncd(i, j) + (rhod(i, k, j)*cond+rho(i, k, & & j)*condd)*dz8w(i, k, j) + rho(i, k, j)*cond*dz8wd(i, k, j) rainnc(i, j) = rainnc(i, j) + rho(i, k, j)*cond*dz8w(i, k, j) END IF END DO END DO END DO RETURN END SUBROUTINE LSCOND_D END MODULE g_module_mp_nconvp