source: trunk/LMDZ.TITAN/libf/phytitan/cld.F @ 1242

      SUBROUTINE CLD(IPRINT)
C PUT IN A METHANE CLOUD HERE
C THIS ROUTINE SETS UP THE CLOUD DISTRIBUTION
C
#include "dimensions.h"
      PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1)
      PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25)
      COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL)
      COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL)
     & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER)
      COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER)
     & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV)
      COMMON /PLANT/ CSUBP,F0PI
      COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
      COMMON /CONST/RGAS,RHOP,PI,SIGMA
      TOTALC=0.0
CCC
      XC=.95
      DO 190 J=1,NLAYER
      XNCLD(J)=0.
      RADCLD(J)=0.
      IF ( CH4(J)*PRESS(J)/PCH4(TEMP(J)) .GT. XC) THEN
          RADCLD(J)=RCLOUD
C TO COLAPSE THE CLOUD INTO ONE LAYER:  XC=9.
C LET 1% OF THE GAS BE CLOUD AS AN INTITIAL GUESS
       XNCLD(J)=.01*COLDEN(J)*GAS1(J)/((4.*PI/3.)*RADCLD(J)**3*1.E-12)
          IF (IPRINT .GT. 0 ) WRITE(6,95) J,RADCLD(J),XNCLD(J),Z(J)
  95      FORMAT(' CLOUD INSERTED: ',I3,F8.2,1P5E10.3)
          TOTALC=TOTALC+XNCLD(J)
          ENDIF
 190  CONTINUE
C CALL THE MIE CODE TO GIVE THE AEROSOL PROPERTIES AT A REF WAVENO
C WHICH IS THE REF WAVENO OF TOON ET AL.
      WNOREF=200.
      RREF=1.27
      XIREF=REFLIQ(WNOREF)
      CALL XMIE(RCLOUD,RREF,XIREF,
     &                     QEXT,QSCT,QABS,CBAR,WNOREF)
      CTAU=QEXT*TOTALC
      IF (IPRINT .GT. 0) WRITE(6,98) WNOREF,RREF,XIREF,TOTALC,CTAU
 98   FORMAT(' CLOUD AT REFERENCE WAVENUMBER OF ',F7.2,' REAL, IMG =',
     & 1P2E10.2,'  COLUMN DENSITY , OPTICAL DEPTH= ',2E10.2)
C SCALE THE CLOUD DENSITIES TO THE REFERENCE WAVENUMBER
      DO 145 J=1,NLAYER
      XNCLD(J)=XNCLD(J)*TAUFAC/CTAU
 145  CONTINUE
      RETURN
      END