SUBROUTINE CLO89(CLDFAC,CAMT,NCLDS,KBTM,KTOP) ! ************************************************************ ! * * ! * THIS SUBROUTINE WAS MODIFIED TO BE USED IN THE ETA MODEL * ! * * ! * Q. ZHAO 95-3-22 * ! * * ! ************************************************************ 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 ! SUBROUTINE CLO88 COMPUTES CLOUD TRANSMISSION FUNCTIONS FOR THE ! LONGWAVE CODE,USING CODE WRITTEN BY BERT KATZ (301-763-8161). ! AND MODIFIED BY DAN SCHWARZKOPF IN DECEMBER,1988. ! INPUTS: (COMMON BLOCK) ! CAMT,KTOP,KBTM,NCLDS RADISW ! OUTPUT: ! CLDFAC CLDCOM ! CALLED BY: RADMN OR MODEL ROUTINE ! CALLS : !------------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpp.h" #include "sp.h" !------------------------------------------------------------------------- ! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: ! IMAX = NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS. ! L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL !***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS ! NBLW = NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE ! BANDTA FOR DEFINITION ! NBLX = NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS ! NBLY = NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE ! BDCOMB FOR DEFINITION ! INLTE = NO. LEVELS USED FOR NLTE CALCS. ! NNLTE = INDEX NO. OF FREQ. BAND IN NLTE CALCS. ! NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED ! 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) DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1), & KBTM(IDIM1:IDIM2,LP1) DIMENSION CAMT(IDIM1:IDIM2,LP1),CLDFAC(IDIM1:IDIM2,LP1,LP1) DIMENSION CLDROW(LP1) ! DIMENSION CLDFIP(LP1,LP1) DIMENSION CLDIPT(LP1,LP1, 64 ) DO 1 IQ=MYIS,MYIE,64 ITOP=IQ+63 IF(ITOP > MYIE) ITOP=MYIE JTOP=ITOP-IQ+1 DO 11 IP=1,JTOP IR=IQ+IP-1 IF (NCLDS(IR) == 0) THEN DO 25 J=1,LP1 DO 25 I=1,LP1 CLDIPT(I,J,IP)=1. 25 END DO ENDIF IF (NCLDS(IR) >= 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 END DO DO 29 J=1,K2 CLDROW(J)=XCLD 29 END DO KB=MAX(K1,K2+1) DO 33 K=KB,LP1 DO 33 KP=1,LP1 CLDIPT(KP,K,IP)=CLDROW(KP) 33 END DO DO 37 J=1,LP1 CLDROW(J)=1. 37 END DO DO 39 J=K1,LP1 CLDROW(J)=XCLD 39 END DO KT=MIN(K1-1,K2) DO 43 K=1,KT DO 43 KP=1,LP1 CLDIPT(KP,K,IP)=CLDROW(KP) 43 END DO IF(K2+1 <= K1-1) THEN DO 31 J=K2+1,K1-1 DO 31 I=1,LP1 CLDIPT(I,J,IP)=1. 31 END DO ELSE IF(K1 <= K2) THEN DO 32 J=K1,K2 DO 32 I=1,LP1 CLDIPT(I,J,IP)=XCLD 32 END DO ENDIF ENDIF IF (NCLDS(IR) >= 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 END DO DO 49 J=1,K2 CLDROW(J)=XCLD 49 END DO 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) ! CLDFIP(KP,K)=CLDROW(KP) 53 END DO DO 57 J=1,LP1 CLDROW(J)=1. 57 END DO DO 59 J=K1,LP1 CLDROW(J)=XCLD 59 END DO 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) ! CLDFIP(KP,K)=CLDROW(KP) 63 END DO ! IF(K2+1.LE.K1-1) THEN ! DO 51 J=K2+1,K1-1 ! DO 51 I=1,LP1 ! CLDIPT(I,J,IP)=1. ! 1 CONTINUE IF(K1 <= K2) THEN DO 52 J=K1,K2 DO 52 I=1,LP1 CLDIPT(I,J,IP)=CLDIPT(I,J,IP)*XCLD 52 END DO ENDIF ! DO 65 J=1,LP1 ! DO 65 I=1,LP1 ! CLDIPT(I,J,IP)=CLDIPT(I,J,IP)*CLDFIP(I,J) ! 5 CONTINUE 21 END DO ENDIF 11 END DO 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 END DO 1 END DO RETURN END SUBROUTINE CLO89