*=*=*=*= condens.html =*=*=*=*
SUBROUTINE condens(ngrid,nlayer,ptimestep, $ pcapcal,pplay,pplev,ptsrf,pt, $ pphi,pdt,pdtsrf, $ piceco2,psolaralb,pemisurf, $ pdtc,pdtsrfc,pdpsrf) IMPLICIT NONE c======================================================================= c input: c ------ c ngrid nombre de points de verticales c (toutes les boucles de la physique sont au c moins vectorisees sur ngrid) c nlayer nombre de couches c pplay(ngrid,nlayer) Pressure levels c pplev(ngrid,nlayer+1) Pressure levels c pt(ngrid,nlayer) temperature (en K) c ptsrf(ngrid) temperature de surface c c \ c pdt(ngrid,nlayermx) \ derivee temporelle physique avant condensation c / ou sublimation pour pt,ptsrf c pdtsrf(ngrid) / c c output: c ------- c c pdpsrf(ngrid) \ derivee temporelle physique (contribution de c pdtc(ngrid,nlayermx) / la condensation ou sublimation) pour Ps,pt,ptsrf c pdtsrfc(ngrid) / c c Entree/sortie c ------------- c c piceco2(ngrid) : quantite de glace co2 au sol (kg/m2) c psolaralb(ngrid,2) : albedo au sol c pemisurf(ngrid) : emissivite du sol c c======================================================================= c c 0. Declarations : c ------------------ c #include "dimensions.h" #include "dimphys.h" #include "comcstfi.h" #include "surfdat.h" #include "comgeomfi.h" c----------------------------------------------------------------------- c Arguments : c --------- INTEGER ngrid,nlayer REAL ptimestep REAL pplay(ngrid,nlayer),pplev(ngrid,nlayer+1) REAL pcapcal(ngrid) REAL pt(ngrid,nlayer) REAL ptsrf(ngrid) REAL pphi(ngrid,nlayer) REAL pdt(ngrid,nlayer),pdtsrf(ngrid),pdtc(ngrid,nlayer) REAL pdtsrfc(ngrid),pdpsrf(ngrid) REAL piceco2(ngrid),psolaralb(ngrid,2),pemisurf(ngrid) c c Local variables : c ----------------- INTEGER l,ig,icap c REAL zt(ngridmx,nlayermx),zdt(ngridmx,nlayermx) REAL ztsrf(ngridmx) REAL zcpi REAL ztcond REAL ztcondsol(ngridmx) REAL zdiceco2(ngridmx),zdiceco2a(ngridmx),zdiceco2s(ngridmx) REAL zcalsrfcond(ngridmx) c variable speciale diagnostique real tconda1(ngridmx,nlayermx) real tconda2(ngridmx,nlayermx) real Tcondens(ngridmx,nlayermx) real topcloud (ngridmx) c local saved variables REAL latcond,tcond1mb REAL acond,bcond,ccond SAVE latcond,acond,bcond,ccond LOGICAL firstcall SAVE firstcall REAL SSUM EXTERNAL SSUM DATA latcond,tcond1mb/5.9e5,136.27/ DATA firstcall/.true./ common/scratch/zt,zdt,tconda1,tconda2,Tcondens c---------------------------------------------------------------------- c Initialisation c -------------- c IF (firstcall) THEN bcond=1./tcond1mb ccond=cpp/(g*latcond) acond=r/latcond firstcall=.false. PRINT*,'Tcond (P=1mb) =',tcond1mb,' Lcond=',latcond PRINT*,'acond,bcond,ccond',acond,bcond,acond ENDIF zcpi=1./cpp c c====================================================================== c Calcul de la temperature naturelle zt au milieux des couches c ------------------------------------------------------------- DO l=1,nlayer DO ig=1,ngrid zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep ENDDO ENDDO c c c ============================================================ c Calcul de la condensation et de la sublimation du CO2 c ============================================================ c c variables utilisees : c piceco2(ngrid) : quantite de glace co2 au sol (kg/m2) c zdiceco2(ngrid): variation de piceco2 (kg/m2) c zdiceco2a(ngrid) : Variation de ziceco2a (kg/m2) c zdiceco2s(ngrid) : Variation de piceco2 due (kg/m2) c a la condensation au sol c c zdt(ngrid,nlayermx) :variation de zt(ig,l) due a la cond dans l'atm. c (K) c c c Remise a zero des tendances (sauf zdt) c ------------------------------------- DO ig=1,ngrid zdiceco2(ig)=0. zdiceco2a(ig) = 0. zdiceco2s(ig) = 0. pdtsrfc(ig) = 0. pdpsrf(ig) = 0. topcloud(ig) = -1. ENDDO c c c Calcul dans l'atmosphere de zdiceco2a et zdt c ---------------------------------------------- c DO l=1,nlayer DO ig=1,ngrid zdt(ig,l)=0. ztcond=1./(bcond-acond*log(.01*pplay(ig,l))) c Calcul special diagnos : ********************************VVVVVV tcondens(ig,l)= ztcond IF (zt(ig,l) .LT. ztcond) THEN topcloud(ig) = pplay (ig,l) c PRINT*,'condensation ig=',ig,' l=',l, c s ' lat=',180.*lati(ig)/pi,' Tc=',ztcond,' T=',zt(ig,l), c s ' dTphys=',zt(ig,l)-pt(ig,l) zdt(ig,l)=ztcond-zt(ig,l) zdiceco2a(ig)=zdiceco2a(ig)+ c!!! on a enleve le terme lie a l'energie potentielle $ (1-pphi(ig,l)/latcond)* $ (pplev(ig,l)-pplev(ig,l+1))*ccond*zdt(ig,l) END IF ENDDO ENDDO c c Calcul de la condensation/sublimation au sol (zdiceco2s,pdtsrfc ) c --------------------------------------------------------------- c Calcul de la temperature de condensation et de la temperature au c sol au pas suivants : DO ig=1,ngrid ztcondsol(ig)=1./(bcond-acond*log(.01*pplev(ig,1))) ztsrf(ig) = ptsrf(ig) + pdtsrf(ig)*ptimestep ENDDO c DO ig=1,ngrid IF(ig.GT.ngrid/2+1) THEN icap=2 ELSE icap=1 ENDIF c c Boucle sur les points ou la condensation/ sublimation existe c ------------------------------------------------------------ IF ((ztsrf(ig) .LT. ztcondsol(ig)) .OR. ! cond au sol $ (zdiceco2a(ig).NE.0.) .OR. ! cond dans l'atm $ ((ztsrf(ig) .GT. ztcondsol(ig)) .AND. ! Sub au sol $ ((piceco2(ig)+zdiceco2a(ig)) .NE. 0.))) THEN c Cas de cond ou sub d'une partie du CO2 solide au sol : c """""""""""""""""""""""""""""""""""""""""""""""""""" zcalsrfcond(ig) = pcapcal(ig)/ c & latcond ! d'origine, mais bugge & ( latcond+cpp*(zt(ig,1)-ztcondsol(ig)) ) !modif 13/07/94 zdiceco2s(ig) =zcalsrfcond(ig)*(ztcondsol(ig)-ztsrf(ig)) pdtsrfc(ig) = (ztcondsol(ig) - ztsrf(ig))/ptimestep c Modif si la toute la couche de CO2 solide se sublime : c """""""""""""""""""""""""""""""""""""""""""""""""""" c (On peut resublimer ce qui vient de condenser dans l'atm) IF((piceco2(ig)+zdiceco2a(ig)+zdiceco2s(ig)).LE.0.)THEN zdiceco2s(ig) = - (piceco2(ig) + zdiceco2a(ig) ) pdtsrfc(ig) = zdiceco2s(ig)/(zcalsrfcond(ig)*ptimestep) psolaralb(ig,1) = albedodat(ig) psolaralb(ig,2) = albedodat(ig) pemisurf(ig) = emissiv ELSE psolaralb(ig,1) = albedice(icap) psolaralb(ig,2) = albedice(icap) pemisurf(ig) = emisice(icap) END IF c Changement de la couche de glace co2 et de la pression : c """""""""""""""""""""""""""""""""""""""""""""""""""""" zdiceco2(ig) = zdiceco2a(ig) + zdiceco2s(ig) piceco2(ig) = piceco2(ig) + zdiceco2(ig) pdpsrf(ig) = -zdiceco2(ig)*g/ptimestep c ************************************************************ c if (ig.eq.1) then c write(*,*) 'ztcondsol ' , ztcondsol(ig) c write(*,*) 'ztsrf ' , ztsrf(ig) c write(*,*) 'cond au sol: ', zdiceco2s(ig)/ptimestep c write(*,*) 'cond atm : ', zdiceco2a(ig)/ptimestep c write(*,*) 'cond total : ', zdiceco2(ig)/ptimestep c end if c ************************************************************ IF(ABS(pdpsrf(ig)*ptimestep).GT.pplev(ig,1)) THEN PRINT*,'STOP dans condens' PRINT*,'on condense plus que la masse totale' PRINT*,'point de grille ',ig PRINT*,'Ps = ',pplev(ig,1) PRINT*,'d Ps = ',pdpsrf(ig) STOP ENDIF END IF ENDDO c Trans. de la variation de zdt en derivee temporelle de T (pdtc) c ------------------------------------------------------------------- c DO l=1,nlayer DO ig=1,ngrid pdtc(ig,l) = zdt(ig,l)/ptimestep c pdtc(ig,l)=0. ENDDO ENDDO c *************************************************************** c Ecriture des diagnostiques c *************************************************************** c Taux de cond au sol en g.m2.s-1 c DO ig=1,ngrid c zdiceco2a(ig)=zdiceco2a(ig)/ptimestep c zdiceco2s(ig)=zdiceco2s(ig)/ptimestep c zdiceco2(ig)=zdiceco2(ig)/ptimestep c END DO c call WRITEDRSFI(ngridmx,44,'pdtsrfc', c &'Tendance Tsol','K.s-1',2, pdtsrfc) c call WRITEDRSFI(ngridmx,44,'pdtc', c &'Tendance T due a cond', 'K.s-1',3,pdtc) c call WRITEDRSFI(ngridmx,44,'diceco2a', c &'Taux de cond atm','g.m-2.s-1',2,zdiceco2a) c call WRITEDRSFI(ngridmx,44,'diceco2s', c &'Taux de cond sol','g.m-2.s-1',2,zdiceco2s) c call WRITEDRSFI(ngridmx,44,'diceco2', c &'Taux de cond tot','g.m-2.s-1',2,zdiceco2) c c DO l=1,nlayer c DO ig=1,ngrid c Taux de cond en microg.m-2.Pa-1.s-1 c tconda1 (ig,l)= 1.e9*ccond*zdt(ig,l)/ptimestep c Taux de cond en microg.m-3.s-1 c tconda2(ig,l)=tconda1(ig,l)*pplay(ig,l)*g/(r*zt(ig,l)) c c if((tconda2(ig,l).gt.20.).or.(tconda2(ig,l).lt.0.)) then c if ((ig.eq.328).and.(l.eq.1)) then c write (*,*) c write (*,*) 'tconda2(ig,l) =',tconda2(ig,l) c write (*,*) '-------------------------------' c write (*,*) 'ig, l = ',ig,l c write(*,*) ' pdt(ig,l)*ptimestep', pdt(ig,l)*ptimestep c write (*,*) 'tconda1(ig,l) =',tconda1(ig,l) c write (*,*) 'zdt(ig,l) =', zdt(ig,l) c write (*,*) 'zt(ig,l) =', zt(ig,l) c write (*,*) 'tcondens(ig,l) =', tcondens(ig,l) c write (*,*) 'pt(ig,l) =', pt(ig,l) c write (*,*) 'pdt(ig,l) =', pdt(ig,l) c write (*,*) 'ptimestep =', ptimestep c end if c c zdt(ig,l) = max (0.,zdt(ig,l)) c END DO c END DO c call WRITEDRSFI(ngridmx,44,'tconda1', c &'Taux de condensation CO2 atmospherique /Pa', c & 'microg.m-2.Pa-1.s-1',3,tconda1) c call WRITEDRSFI(ngridmx,44,'tconda2', c &'Taux de condensation CO2 atmospherique /m', c & 'microg.m-3.s-1',3,tconda2) c call WRITEDRSFI(ngridmx,44,'Tcond-T', c &'Tcond -Tair','K',3,zdt) return end