--- trunk/libf/phylmd/Conflx/flxflux.f90 2013/06/24 15:39:52 70 +++ trunk/phylmd/Conflx/flxflux.f 2018/02/05 10:39:38 254 @@ -5,8 +5,8 @@ contains SUBROUTINE flxflux(pdtime, pqen, pqsen, ptenh, pqenh, pap, paph, ldland, & - pgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, pmfu, pmfd, pmfus, & - pmfds, pmfuq, pmfdq, pmful, plude, pdmfup, pdmfdp, pten, prfl, psfl, & + pgeoh, kcbot, kctop, lddraf, kdtop, ktype, ldcum, mfu, pmfd, mfus, & + pmfds, mfuq, pmfdq, mful, plude, pdmfup, pdmfdp, pten, prfl, psfl, & pdpmel, ktopm2, pmflxr, pmflxs) ! This routine does the final calculation of convective fluxes in @@ -22,8 +22,8 @@ real, intent(inout):: pqsen(klon, klev) REAL, intent(in):: ptenh(klon, klev) REAL, intent(in):: pqenh(klon, klev) - REAL pap(klon, klev) - REAL paph(klon, klev+1) + REAL, intent(in):: pap(klon, klev) + REAL, intent(in):: paph(klon, klev + 1) LOGICAL ldland(klon) real pgeoh(klon, klev) INTEGER, intent(in):: kcbot(klon), kctop(klon) @@ -31,13 +31,13 @@ INTEGER kdtop(klon) INTEGER, intent(inout):: ktype(klon) LOGICAL, intent(in):: ldcum(klon) - REAL pmfu(klon, klev) + REAL mfu(klon, klev) REAL pmfd(klon, klev) - real pmfus(klon, klev) + real, intent(inout):: mfus(klon, klev) real pmfds(klon, klev) - REAL pmfuq(klon, klev) + REAL mfuq(klon, klev) REAL pmfdq(klon, klev) - real pmful(klon, klev) + real mful(klon, klev) REAL plude(klon, klev) REAL pdmfup(klon, klev) REAL pdmfdp(klon, klev) @@ -45,11 +45,11 @@ REAL prfl(klon), psfl(klon) real pdpmel(klon, klev) INTEGER, intent(out):: ktopm2 - REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1) + REAL pmflxr(klon, klev + 1), pmflxs(klon, klev + 1) ! Local: REAL cevapcu(klev) - REAL ztmsmlt, zdelta, zqsat + REAL ztmsmlt, zqsat !jq The variable maxpdmfdp(klon) has been introduced by Olivier Boucher !jq 14/11/00 to fix the problem with the negative precipitation. @@ -66,7 +66,7 @@ DO k=1, klev CEVAPCU(k)=1.93E-6*261.*SQRT(1.E3/(38.3*0.293) & - *SQRT(0.5*(paph(1, k)+paph(1, k+1))/paph(1, klev+1))) * 0.5/RG + *SQRT(0.5*(paph(1, k) + paph(1, k + 1))/paph(1, klev + 1))) * 0.5/RG end DO ! SPECIFY CONSTANTS @@ -88,9 +88,9 @@ DO k = ktopm2, klev DO i = 1, klon IF (ldcum(i) .AND. k >= kctop(i) - 1) THEN - pmfus(i, k) = pmfus(i, k) & - - pmfu(i, k) * (RCPD * ptenh(i, k) + pgeoh(i, k)) - pmfuq(i, k)=pmfuq(i, k)-pmfu(i, k)*pqenh(i, k) + mfus(i, k) = mfus(i, k) & + - mfu(i, k) * (RCPD * ptenh(i, k) + pgeoh(i, k)) + mfuq(i, k)=mfuq(i, k)-mfu(i, k)*pqenh(i, k) zdp = 1.5E4 IF (ldland(i)) zdp = 3.E4 @@ -104,7 +104,7 @@ IF (lddraf(i).AND.k >= kdtop(i)) THEN pmfds(i, k)=pmfds(i, k)-pmfd(i, k)* & - (RCPD*ptenh(i, k)+pgeoh(i, k)) + (RCPD*ptenh(i, k) + pgeoh(i, k)) pmfdq(i, k)=pmfdq(i, k)-pmfd(i, k)*pqenh(i, k) ELSE pmfd(i, k)=0. @@ -113,10 +113,10 @@ pdmfdp(i, k-1)=0. END IF ELSE - pmfu(i, k)=0. - pmfus(i, k)=0. - pmfuq(i, k)=0. - pmful(i, k)=0. + mfu(i, k)=0. + mfus(i, k)=0. + mfuq(i, k)=0. + mful(i, k)=0. pdmfup(i, k-1)=0. plude(i, k-1)=0. pmfd(i, k)=0. @@ -134,10 +134,10 @@ zzp = ((paph(i, klev + 1) - paph(i, k)) & / (paph(i, klev + 1) - paph(i, ikb))) IF (ktype(i) == 3) zzp = zzp**2 - pmfu(i, k)=pmfu(i, ikb)*zzp - pmfus(i, k)=pmfus(i, ikb)*zzp - pmfuq(i, k)=pmfuq(i, ikb)*zzp - pmful(i, k)=pmful(i, ikb)*zzp + mfu(i, k)=mfu(i, ikb)*zzp + mfus(i, k)=mfus(i, ikb)*zzp + mfuq(i, k)=mfuq(i, ikb)*zzp + mful(i, k)=mful(i, ikb)*zzp ENDIF end DO end DO @@ -146,7 +146,7 @@ ! CALCULATE MELTING OF SNOW ! CALCULATE EVAPORATION OF PRECIP - DO k = 1, klev+1 + DO k = 1, klev + 1 DO i = 1, klon pmflxr(i, k) = 0.0 pmflxs(i, k) = 0.0 @@ -156,12 +156,11 @@ DO i = 1, klon IF (ldcum(i)) THEN IF (pmflxs(i, k) > 0.0 .AND. pten(i, k) > ztmelp2) THEN - zfac=zcons1*(paph(i, k+1)-paph(i, k)) + zfac=zcons1*(paph(i, k + 1)-paph(i, k)) zsnmlt=MIN(pmflxs(i, k), zfac*(pten(i, k)-ztmelp2)) pdpmel(i, k)=zsnmlt ztmsmlt=pten(i, k)-zsnmlt/zfac - zdelta=MAX(0., SIGN(1., RTT-ztmsmlt)) - zqsat = R2ES * FOEEW(ztmsmlt, zdelta) / pap(i, k) + zqsat = R2ES * FOEEW(ztmsmlt, RTT >= ztmsmlt) / pap(i, k) zqsat = MIN(0.5, zqsat) zqsat = zqsat / (1. - RETV * zqsat) pqsen(i, k) = zqsat @@ -169,17 +168,17 @@ IF (pten(i, k) > RTT) THEN pmflxr(i, k + 1) = pmflxr(i, k) + pdmfup(i, k) + pdmfdp(i, k) & + pdpmel(i, k) - pmflxs(i, k+1)=pmflxs(i, k)-pdpmel(i, k) + pmflxs(i, k + 1)=pmflxs(i, k)-pdpmel(i, k) ELSE - pmflxs(i, k+1)=pmflxs(i, k)+pdmfup(i, k)+pdmfdp(i, k) - pmflxr(i, k+1)=pmflxr(i, k) + pmflxs(i, k + 1)=pmflxs(i, k) + pdmfup(i, k) + pdmfdp(i, k) + pmflxr(i, k + 1)=pmflxr(i, k) ENDIF ! si la precipitation est negative, on ajuste le plux du ! panache descendant pour eliminer la negativite - IF ((pmflxr(i, k+1)+pmflxs(i, k+1)) < 0.0) THEN + IF ((pmflxr(i, k + 1) + pmflxs(i, k + 1)) < 0.0) THEN pdmfdp(i, k) = -pmflxr(i, k)-pmflxs(i, k)-pdmfup(i, k) - pmflxr(i, k+1) = 0.0 - pmflxs(i, k+1) = 0.0 + pmflxr(i, k + 1) = 0.0 + pmflxs(i, k + 1) = 0.0 pdpmel(i, k) = 0.0 ENDIF ENDIF @@ -201,7 +200,7 @@ DO k = 1, klev DO kp = k, klev DO i = 1, klon - maxpdmfdp(i, k)=maxpdmfdp(i, k)+pdmfdp(i, kp) + maxpdmfdp(i, k)=maxpdmfdp(i, k) + pdmfdp(i, kp) ENDDO ENDDO ENDDO @@ -228,7 +227,7 @@ zdrfl=MAX(zdrfl, & MIN(-pmflxr(i, k)-pmflxs(i, k)-maxpdmfdp(i, k), 0.0)) - zdenom=1.0/MAX(1.0E-20, pmflxr(i, k)+pmflxs(i, k)) + zdenom=1.0/MAX(1.0E-20, pmflxr(i, k) + pmflxs(i, k)) IF (pten(i, k) > RTT) THEN zpdr = pdmfdp(i, k) zpds = 0.0 @@ -236,14 +235,14 @@ zpdr = 0.0 zpds = pdmfdp(i, k) ENDIF - pmflxr(i, k+1) = pmflxr(i, k) + zpdr + pdpmel(i, k) & + pmflxr(i, k + 1) = pmflxr(i, k) + zpdr + pdpmel(i, k) & + zdrfl*pmflxr(i, k)*zdenom - pmflxs(i, k+1) = pmflxs(i, k) + zpds - pdpmel(i, k) & + pmflxs(i, k + 1) = pmflxs(i, k) + zpds - pdpmel(i, k) & + zdrfl*pmflxs(i, k)*zdenom pdmfup(i, k) = pdmfup(i, k) + zdrfl ELSE - pmflxr(i, k+1) = 0.0 - pmflxs(i, k+1) = 0.0 + pmflxr(i, k + 1) = 0.0 + pmflxs(i, k + 1) = 0.0 pdmfdp(i, k) = 0.0 pdpmel(i, k) = 0.0 ENDIF @@ -254,8 +253,8 @@ ENDDO DO i = 1, klon - prfl(i) = pmflxr(i, klev+1) - psfl(i) = pmflxs(i, klev+1) + prfl(i) = pmflxr(i, klev + 1) + psfl(i) = pmflxs(i, klev + 1) end DO RETURN