! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53 ! ! Differentiation of lscond in reverse (adjoint) mode (with options r8): ! gradient of useful results: th p qv rainnc rainncv rho ! pii dz8w ! with respect to varying inputs: th p qv rainnc rainncv rho ! pii dz8w !WRF:MODEL_LAYER:PHYSICS ! MODULE a_module_mp_nconvp CONTAINS !---------------------------------------------------------------- ! domain dims ! memory dims ! tile dims SUBROUTINE LSCOND_B(th, thb, p, pb, qv, qvb, rho, rhob, pii, piib, r_v, & & xlv, cp, ep2, svp1, svp2, svp3, svpt0, dz8w, dz8wb, rainnc, rainncb, & & rainncv, rainncvb, 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) :: thb REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rho, pii, p& & , dz8w REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rhob, piib, pb, dz8wb REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainnc, rainncv REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainncb ! local variables REAL :: ttemp, es1, qs1, dqv, cond, r1 REAL :: ttempb, es1b, qs1b, dqvb, condb, r1b INTEGER :: i, j, k INTEGER :: branch REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: qvb REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainncvb REAL :: temp1 REAL :: temp0 REAL :: temp0b REAL :: temp2b1 REAL :: temp2b0 REAL :: tempb REAL :: temp0b0 REAL :: temp2b REAL :: temp1b REAL :: temp !---------------------------------------------------------------- DO j=jts,jte DO k=kts,kte DO i=its,ite CALL PUSHREAL8(ttemp) ttemp = pii(i, k, j)*th(i, k, j) CALL PUSHREAL8(es1) es1 = 1000.*svp1*EXP(svp2*(ttemp-svpt0)/(ttemp-svp3)) qs1 = ep2*es1/(p(i, k, j)-es1) CALL PUSHREAL8(dqv) dqv = qv(i, k, j) - qs1 IF (dqv .GT. 0.0) THEN CALL PUSHREAL8(r1) r1 = 1. + xlv*xlv/(r_v*cp)*qs1/(ttemp*ttemp) cond = dqv/r1 CALL PUSHREAL8(ttemp) ttemp = ttemp + xlv/cp*cond CALL PUSHCONTROL1B(1) ELSE CALL PUSHCONTROL1B(0) END IF END DO END DO END DO DO j=jte,jts,-1 DO k=kte,kts,-1 DO i=ite,its,-1 CALL POPCONTROL1B(branch) IF (branch .EQ. 0) THEN qs1b = 0.0_8 dqvb = 0.0_8 ttempb = 0.0_8 ELSE temp2b1 = thb(i, k, j)/pii(i, k, j) ttempb = temp2b1 temp2b0 = dz8w(i, k, j)*rainncvb(i, j) cond = dqv/r1 temp2b = dz8w(i, k, j)*rainncb(i, j) rhob(i, k, j) = rhob(i, k, j) + cond*temp2b0 + cond*temp2b condb = rho(i, k, j)*temp2b0 - qvb(i, k, j) + xlv*ttempb/cp + & & rho(i, k, j)*temp2b dz8wb(i, k, j) = dz8wb(i, k, j) + rho(i, k, j)*cond*rainncvb(i& & , j) + rho(i, k, j)*cond*rainncb(i, j) rainncvb(i, j) = 0.0_8 piib(i, k, j) = piib(i, k, j) - ttemp*temp2b1/pii(i, k, j) thb(i, k, j) = 0.0_8 qs1 = ep2*es1/(p(i, k, j)-es1) CALL POPREAL8(ttemp) dqvb = condb/r1 r1b = -(dqv*condb/r1**2) CALL POPREAL8(r1) temp1 = r_v*cp*ttemp**2 temp1b = xlv**2*r1b/temp1 qs1b = temp1b ttempb = ttempb - r_v*cp*qs1*2*ttemp*temp1b/temp1 END IF CALL POPREAL8(dqv) qvb(i, k, j) = qvb(i, k, j) + dqvb qs1b = qs1b - dqvb temp0 = p(i, k, j) - es1 temp0b = ep2*qs1b/temp0 temp0b0 = -(es1*temp0b/temp0) es1b = temp0b - temp0b0 pb(i, k, j) = pb(i, k, j) + temp0b0 CALL POPREAL8(es1) temp = (ttemp-svpt0)/(ttemp-svp3) tempb = svp2*EXP(svp2*temp)*svp1*1000.*es1b/(ttemp-svp3) ttempb = ttempb + (1.0-temp)*tempb CALL POPREAL8(ttemp) piib(i, k, j) = piib(i, k, j) + th(i, k, j)*ttempb thb(i, k, j) = thb(i, k, j) + pii(i, k, j)*ttempb END DO END DO END DO END SUBROUTINE LSCOND_B END MODULE a_module_mp_nconvp