SUBROUTINE CLO89(CLDFAC,CAMT,NCLDS,KBTM,KTOP)
C ************************************************************
C * *
C * THIS SUBROUTINE WAS MODIFIED TO BE USED IN THE ETA MODEL *
C * *
C * Q. ZHAO 95-3-22 *
C * *
C ************************************************************
C
COMMON/PHYCON/AMOLWT,CSUBP,DIFFCTR,G,GRAVDR,O3DIFCTR,P0,
* P0XZP2,P0XZP8,P0X2,RADCON,RGAS,RGASSP,SECPDA
COMMON/PHYCON/RATCO2MW,RATH2OMW
COMMON/PHYCON/RADCON1
COMMON/PHYCON/GINV,P0INV,GP0INV
COMMON/HCON/HUNDRED,HNINETY,SIXTY,FIFTY,TEN,EIGHT,FIVE,
* FOUR,THREE,TWO,ONE,HAF,QUARTR,ZERO
COMMON/HCON/H83E26,H71E26,H1E15,H1E13,H1E11,H1E8,H4E5,
* H165E5,H5725E4,H488E4,H1E4,H24E3,H20788E3,
* H2075E3,H1224E3,H5E2,H3082E2,H3E2,H2945E2,
* H23E2,H15E2,H35E1,H3P6,H181E1,H18E1,H2P9,H2P8,
* H2P5,H1P8,H1P4387,H1P4,H1P25892,HP8,HP518,
* HP369,HP1
COMMON/HCON/H44871M2,H559M3,H1M3,H987M4,H285M4,H1M4,
* H6938M5,H394M5,H37412M5,H1439M5,H128M5,H1M5,
* H7M6,H4999M6,H25452M6,H1M6,H391M7,H1174M7,
* H8725M8,H327M8,H257M8,H1M8,H23M10,H14M10,
* H11M10,H1M10,H83M11,H82M11,H8M11,H77M11,
* H72M11,H53M11,H48M11,H44M11,H42M11,H37M11,
* H35M11,H32M11,H3M11,H28M11,H24M11,H23M11,
* H2M11,H18M11,H15M11,H14M11,H114M11,H11M11,
* H1M11,H96M12,H93M12,H77M12,H74M12,H65M12,
* H62M12,H6M12,H45M12,H44M12,H4M12,H38M12,
* H37M12,H3M12,H29M12,H28M12,H24M12,H21M12,
* H16M12,H14M12,H12M12,H8M13,H46M13,H36M13,
* H135M13,H12M13,H1M13,H3M14,H15M14,H14M14,
* H1M17,H1M18,H1M19,H1M20,H1M21,H1M22,H1M23,
* H1M24,H26M30,H14M30,H25M31,H21M31,H12M31,
* H9M32,H55M32,H45M32,H4M33,H62M34,H1M60
COMMON/HCON/HMP575,HM13EZ,HM19EZ,HM1E1,HM181E1,HM1E2
COMMON/HCON/H1E6,H2E6,H1M2,HMP66667,HM6666M2,HP166666,
* H41666M2,HMP5,HM2M2,H29316E2,H1226E1,H3116E1,
* H9P94,HP6,H625M2,HP228,HP60241,HM1797E1,
* H8121E1,H2E2,HM1EZ,H26E2,H44194M2,H1P41819
COMMON/HCON/HP219,HP144,HP816,H69766E5,H235M3,HP26,
* H129M2,H75826M4,H1P082,HP805,H1386E2,
* H658M2,H1036E2,H2118M2,H42M2,H323M4,
* H67390E2,HP3795,HP5048,H102M5,H451M6
COMMON/HCON/H16E1,HM161E1,H161E1,H3M3,H101M16,
* HM1597E1,H25E2,HP118666,H15M5,H3P5,H18E3,
* H6P08108,HMP805,HP602409,HP526315,
* H28571M2,H1M16
COMMON/HCON/H3M4
COMMON/HCON/HM8E1
COMMON/HCON/H28E1
C SUBROUTINE CLO88 COMPUTES CLOUD TRANSMISSION FUNCTIONS FOR THE
C LONGWAVE CODE,USING CODE WRITTEN BY BERT KATZ (301-763-8161).
C AND MODIFIED BY DAN SCHWARZKOPF IN DECEMBER,1988.
C INPUTS: (COMMON BLOCK)
C CAMT,KTOP,KBTM,NCLDS RADISW
C OUTPUT:
C CLDFAC CLDCOM
C
C CALLED BY: RADMN OR MODEL ROUTINE
C CALLS :
C-------------------------------------------------------------------------
INCLUDE "parmeta"
INCLUDE "mpp.h"
#include "sp.h"
C-------------------------------------------------------------------------
C
C PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE:
C IMAX = NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS.
C L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL
C***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS
C NBLW = NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE
C BANDTA FOR DEFINITION
C NBLX = NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS
C NBLY = NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE
C BDCOMB FOR DEFINITION
C INLTE = NO. LEVELS USED FOR NLTE CALCS.
C NNLTE = INDEX NO. OF FREQ. BAND IN NLTE CALCS.
C NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED
C FROM THE ABOVE PARAMETERS.
PARAMETER (L= LM )
PARAMETER (IMAX=IM,NCOL=IMAX )
PARAMETER (NBLW=163,NBLX=47,NBLY=15)
PARAMETER (NBLM=NBLY-1)
PARAMETER (LP1=L+1,LP2=L+2,LP3=L+3)
PARAMETER (LM1=L-1,LM2=L-2,LM3=L-3)
PARAMETER (LL=2*L,LLP1=LL+1,LLP2=LL+2,LLP3=LL+3)
PARAMETER (LLM1=LL-1,LLM2=LL-2,LLM3=LL-3)
PARAMETER (LP1M=LP1*LP1,LP1M1=LP1M-1)
PARAMETER (LP1V=LP1*(1+2*L/2))
PARAMETER (LP121=LP1*NBLY)
PARAMETER (LL3P=3*L+2)
PARAMETER (NB=12)
PARAMETER (INLTE=3,INLTEP=INLTE+1,NNLTE=56)
PARAMETER (LP1I=IMAX*LP1,LLP1I=IMAX*LLP1,LL3PI=IMAX*LL3P)
PARAMETER (NB1=NB-1)
PARAMETER (KO2=12)
PARAMETER (KO21=KO2+1,KO2M=KO2-1)
C
DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1),
1 KBTM(IDIM1:IDIM2,LP1)
DIMENSION CAMT(IDIM1:IDIM2,LP1),CLDFAC(IDIM1:IDIM2,LP1,LP1)
DIMENSION CLDROW(LP1)
C
C DIMENSION CLDFIP(LP1,LP1)
DIMENSION CLDIPT(LP1,LP1, 64 )
C
DO 1 IQ=MYIS,MYIE,64
ITOP=IQ+63
IF(ITOP.GT.MYIE) ITOP=MYIE
JTOP=ITOP-IQ+1
DO 11 IP=1,JTOP
IR=IQ+IP-1
IF (NCLDS(IR).EQ.0) THEN
DO 25 J=1,LP1
DO 25 I=1,LP1
CLDIPT(I,J,IP)=1.
25 CONTINUE
ENDIF
IF (NCLDS(IR).GE.1) THEN
XCLD=1.-CAMT(IR,2)
K1=KTOP(IR,2)+1
K2=KBTM(IR,2)
DO 27 J=1,LP1
CLDROW(J)=1.
27 CONTINUE
DO 29 J=1,K2
CLDROW(J)=XCLD
29 CONTINUE
KB=MAX(K1,K2+1)
DO 33 K=KB,LP1
DO 33 KP=1,LP1
CLDIPT(KP,K,IP)=CLDROW(KP)
33 CONTINUE
DO 37 J=1,LP1
CLDROW(J)=1.
37 CONTINUE
DO 39 J=K1,LP1
CLDROW(J)=XCLD
39 CONTINUE
KT=MIN(K1-1,K2)
DO 43 K=1,KT
DO 43 KP=1,LP1
CLDIPT(KP,K,IP)=CLDROW(KP)
43 CONTINUE
IF(K2+1.LE.K1-1) THEN
DO 31 J=K2+1,K1-1
DO 31 I=1,LP1
CLDIPT(I,J,IP)=1.
31 CONTINUE
ELSE IF(K1.LE.K2) THEN
DO 32 J=K1,K2
DO 32 I=1,LP1
CLDIPT(I,J,IP)=XCLD
32 CONTINUE
ENDIF
ENDIF
IF (NCLDS(IR).GE.2) THEN
DO 21 NC=2,NCLDS(IR)
XCLD=1.-CAMT(IR,NC+1)
K1=KTOP(IR,NC+1)+1
K2=KBTM(IR,NC+1)
DO 47 J=1,LP1
CLDROW(J)=1.
47 CONTINUE
DO 49 J=1,K2
CLDROW(J)=XCLD
49 CONTINUE
KB=MAX(K1,K2+1)
DO 53 K=KB,LP1
DO 53 KP=1,LP1
CLDIPT(KP,K,IP)=CLDIPT(KP,K,IP)*CLDROW(KP)
C CLDFIP(KP,K)=CLDROW(KP)
53 CONTINUE
DO 57 J=1,LP1
CLDROW(J)=1.
57 CONTINUE
DO 59 J=K1,LP1
CLDROW(J)=XCLD
59 CONTINUE
KT=MIN(K1-1,K2)
DO 63 K=1,KT
DO 63 KP=1,LP1
CLDIPT(KP,K,IP)=CLDIPT(KP,K,IP)*CLDROW(KP)
C CLDFIP(KP,K)=CLDROW(KP)
63 CONTINUE
C IF(K2+1.LE.K1-1) THEN
C DO 51 J=K2+1,K1-1
C DO 51 I=1,LP1
C CLDIPT(I,J,IP)=1.
C51 CONTINUE
IF(K1.LE.K2) THEN
DO 52 J=K1,K2
DO 52 I=1,LP1
CLDIPT(I,J,IP)=CLDIPT(I,J,IP)*XCLD
52 CONTINUE
ENDIF
C DO 65 J=1,LP1
C DO 65 I=1,LP1
C CLDIPT(I,J,IP)=CLDIPT(I,J,IP)*CLDFIP(I,J)
C65 CONTINUE
21 CONTINUE
ENDIF
11 CONTINUE
DO 71 J=1,LP1
DO 71 I=1,LP1
DO 71 IP=1,JTOP
IR=IQ+IP-1
CLDFAC(IR,I,J)=CLDIPT(I,J,IP)
71 CONTINUE
1 CONTINUE
RETURN
END