*=*=*=*= condens.html =*=*=*=*
SUBROUTINE condens

SUBROUTINE condens


      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