1 | SUBROUTINE CLD(IPRINT) |
---|
2 | C PUT IN A METHANE CLOUD HERE |
---|
3 | C THIS ROUTINE SETS UP THE CLOUD DISTRIBUTION |
---|
4 | C |
---|
5 | USE TGMDAT_MOD, ONLY: RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC, |
---|
6 | & RCLOUD,FARGON |
---|
7 | USE TGMDAT_MOD, ONLY: PI |
---|
8 | #include "dimensions.h" |
---|
9 | PARAMETER(NLAYER=llm,NLEVEL=NLAYER+1) |
---|
10 | PARAMETER (NSPECI=46,NSPC1I=47,NSPECV=24,NSPC1V=25) |
---|
11 | COMMON /ATM/ Z(NLEVEL),PRESS(NLEVEL),DEN(NLEVEL),TEMP(NLEVEL) |
---|
12 | COMMON /GASS/ CH4(NLEVEL),XN2(NLEVEL),H2(NLEVEL),AR(NLEVEL) |
---|
13 | & ,XMU(NLEVEL),GAS1(NLAYER),COLDEN(NLAYER) |
---|
14 | COMMON /CLOUD/ RADCLD(NLAYER), XNCLD(NLAYER) |
---|
15 | & , RCLDI(NSPECI), XICLDI(NSPECI), RCLDV(NSPECV), XICLDV(NSPECV) |
---|
16 | TOTALC=0.0 |
---|
17 | CCC |
---|
18 | XC=.95 |
---|
19 | DO 190 J=1,NLAYER |
---|
20 | XNCLD(J)=0. |
---|
21 | RADCLD(J)=0. |
---|
22 | IF ( CH4(J)*PRESS(J)/PCH4(TEMP(J)) .GT. XC) THEN |
---|
23 | RADCLD(J)=RCLOUD |
---|
24 | C TO COLAPSE THE CLOUD INTO ONE LAYER: XC=9. |
---|
25 | C LET 1% OF THE GAS BE CLOUD AS AN INTITIAL GUESS |
---|
26 | XNCLD(J)=.01*COLDEN(J)*GAS1(J)/((4.*PI/3.)*RADCLD(J)**3*1.E-12) |
---|
27 | IF (IPRINT .GT. 0 ) WRITE(6,95) J,RADCLD(J),XNCLD(J),Z(J) |
---|
28 | 95 FORMAT(' CLOUD INSERTED: ',I3,F8.2,1P5E10.3) |
---|
29 | TOTALC=TOTALC+XNCLD(J) |
---|
30 | ENDIF |
---|
31 | 190 CONTINUE |
---|
32 | C CALL THE MIE CODE TO GIVE THE AEROSOL PROPERTIES AT A REF WAVENO |
---|
33 | C WHICH IS THE REF WAVENO OF TOON ET AL. |
---|
34 | WNOREF=200. |
---|
35 | RREF=1.27 |
---|
36 | XIREF=REFLIQ(WNOREF) |
---|
37 | CALL XMIE(RCLOUD,RREF,XIREF, |
---|
38 | & QEXT,QSCT,QABS,CBAR,WNOREF) |
---|
39 | CTAU=QEXT*TOTALC |
---|
40 | IF (IPRINT .GT. 0) WRITE(6,98) WNOREF,RREF,XIREF,TOTALC,CTAU |
---|
41 | 98 FORMAT(' CLOUD AT REFERENCE WAVENUMBER OF ',F7.2,' REAL, IMG =', |
---|
42 | & 1P2E10.2,' COLUMN DENSITY , OPTICAL DEPTH= ',2E10.2) |
---|
43 | C SCALE THE CLOUD DENSITIES TO THE REFERENCE WAVENUMBER |
---|
44 | DO 145 J=1,NLAYER |
---|
45 | XNCLD(J)=XNCLD(J)*TAUFAC/CTAU |
---|
46 | 145 CONTINUE |
---|
47 | RETURN |
---|
48 | END |
---|