SUBROUTINE LWR88(HEATRA,GRNFLX,TOPFLX, & PRESS,TEMP,RH2O,QO3,CLDFAC, & CAMT,NCLDS,KTOP,KBTM) !--------------------------------------------------------------------- ! SUBROUTINE LWR88 COMPUTES TEMPERATURE-CORRECTED CO2 TRANSMISSION ! FUNCTIONS AND ALSO COMPUTES THE PRESSURE GRID AND LAYER OPTICAL ! PATHS. ! INPUTS: (COMMON BLOCKS) ! CLDFAC CLDCOM ! PRESS,TEMP,RH2O,QO3 RADISW ! CAMT,NCLDS,KTOP,KBTM RADISW ! CO251,CO258,CDT51,CDT58 CO2BD3 ! C2D51,C2D58,CO2M51,CO2M58 CO2BD3 ! CDTM51,CDTM58,C2DM51,C2DM58 CO2BD3 ! STEMP,GTEMP CO2BD3 ! CO231,CO238,CDT31,CDT38 CO2BD2 ! C2D31,C2D38 CO2BD2 ! CO271,CO278,CDT71,CDT78 CO2BD4 ! C2D71,C2D78 CO2BD4 ! BETINW BDWIDE ! OUTPUTS: ! HEATRA,GRNFLX,TOPFLX LWOUT ! CALLED BY: ! RADMN OR INPUT ROUTINE OF MODEL ! CALLS: ! FST88 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 !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- ! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: ! L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL ! 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 (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 (NB1=NB-1) PARAMETER (KO2=12) PARAMETER (KO21=KO2+1,KO2M=KO2-1) ! PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: ! L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL ! 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. ! THE FOLLOWING COMMON BLOCKS CONTAIN PRETABULATED CO2 TRANSMISSION ! FUNCTIONS, EVALUATED USING THE METHODS OF FELS AND ! SCHWARZKOPF (1981) AND SCHWARZKOPF AND FELS (1985), !***COMMON CO2BD3 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE ! AND PRESSURE DERIVATIVES FOR THE 560-800 CM-1 BAND. ALSO INCLUDED ! ARE THE STANDARD TEMPERATURES AND THE WEIGHTING FUNCTION. THESE ! DATA ARE IN BLOCK DATA BD3: ! CO251 = TRANSMISSION FCTNS FOR T0 (STD. PROFILE) ! WITH P(SFC)=1013.25 MB ! CO258 = TRANSMISSION FCTNS. FOR T0 (STD. PROFILE) ! WITH P(SFC)= ^810 MB ! CDT51 = FIRST TEMPERATURE DERIVATIVE OF CO251 ! CDT58 = FIRST TEMPERATURE DERIVATIVE OF CO258 ! C2D51 = SECOND TEMPERATURE DERIVATIVE OF CO251 ! C2D58 = SECOND TEMPERATURE DERIVATIVE OF CO251 ! CO2M51 = TRANSMISSION FCTNS FOR T0 FOR ADJACENT PRESSURE ! LEVELS, WITH NO PRESSURE QUADRATURE. USED FOR ! NEARBY LAYER COMPUTATIONS. P(SFC)=1013.25 MB ! CO2M58 = SAME AS CO2M51,WITH P(SFC)= ^810 MB ! CDTM51 = FIRST TEMPERATURE DERIVATIVE OF CO2M51 ! CDTM58 = FIRST TEMPERATURE DERIVATIVE OF CO2M58 ! C2DM51 = SECOND TEMPERATURE DERIVATIVE OF CO2M51 ! C2DM58 = SECOND TEMPERATURE DERIVATIVE OF CO2M58 ! STEMP = STANDARD TEMPERATURES FOR MODEL PRESSURE LEVEL ! STRUCTURE WITH P(SFC)=1013.25 MB ! GTEMP = WEIGHTING FUNCTION FOR MODEL PRESSURE LEVEL ! STRUCTURE WITH P(SFC)=1013.25 MB. ! B0 = TEMP. COEFFICIENT USED FOR CO2 TRANS. FCTN. ! CORRECTION FOR T(K). (SEE REF. 4 AND BD3) ! B1 = TEMP. COEFFICIENT, USED ALONG WITH B0 ! B2 = TEMP. COEFFICIENT, USED ALONG WITH B0 ! B3 = TEMP. COEFFICIENT, USED ALONG WITH B0 COMMON/CO2BD3/CO251(LP1,LP1),CO258(LP1,LP1),CDT51(LP1,LP1), & CDT58(LP1,LP1),C2D51(LP1,LP1),C2D58(LP1,LP1),CO2M51(L), & CO2M58(L),CDTM51(L),CDTM58(L),C2DM51(L),C2DM58(L), & STEMP(LP1),GTEMP(LP1),B0,B1,B2,B3 !***COMMON CO2BD2 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE ! AND PRESSURE DERIVATIVES FOR THE 560-670 CM-1 PART OF THE 15 UM ! CO2 BAND. THESE DATA ARE IN BLOCK DATA BD2. ! CO231 = TRANSMISSION FCTNS FOR T0 (STD. PROFILE) ! WITH P(SFC)=1013.25 MB ! CO238 = TRANSMISSION FCTNS. FOR T0 (STD. PROFILE) ! WITH P(SFC)= ^810 MB ! CDT31 = FIRST TEMPERATURE DERIVATIVE OF CO231 ! CDT38 = FIRST TEMPERATURE DERIVATIVE OF CO238 ! C2D31 = SECOND TEMPERATURE DERIVATIVE OF CO231 ! C2D38 = SECOND TEMPERATURE DERIVATIVE OF CO231 COMMON / CO2BD2 / CO231(LP1),CO238(LP1),CDT31(LP1), & CDT38(LP1),C2D31(LP1),C2D38(LP1) !***COMMON CO2BD4 CONTAINS CO2 TRANSMISSION FUNCTIONS AND TEMPERATURE ! AND PRESSURE DERIVATIVES FOR THE 670-800 CM-1 PART OF THE 15 UM ! CO2 BAND. THESE DATA ARE IN BLOCK DATA BD4. ! CO271 = TRANSMISSION FCTNS FOR T0 (STD. PROFILE) ! WITH P(SFC)=1013.25 MB ! CO278 = TRANSMISSION FCTNS. FOR T0 (STD. PROFILE) ! WITH P(SFC)= ^810 MB ! CDT71 = FIRST TEMPERATURE DERIVATIVE OF CO271 ! CDT78 = FIRST TEMPERATURE DERIVATIVE OF CO278 ! C2D71 = SECOND TEMPERATURE DERIVATIVE OF CO271 ! C2D78 = SECOND TEMPERATURE DERIVATIVE OF CO271 COMMON / CO2BD4 / CO271(LP1),CO278(LP1),CDT71(LP1), & CDT78(LP1),C2D71(LP1),C2D78(LP1) !***COMMON CO2BD5 CONTAINS CO2 TRANSMISSION FUNCTIONS FOR THE 2270- ! 2380 PART OF THE 4.3 UM CO2 BAND. THESE DATA ARE IN BLOCK DATA BD5. ! CO211 = TRANSMISSION FCTNS FOR T0 (STD. PROFILE) ! WITH P(SFC)=1013.25 MB ! CO218 = TRANSMISSION FCTNS. FOR T0 (STD. PROFILE) ! WITH P(SFC)= ^810 MB COMMON / CO2BD5 / CO211(LP1),CO218(LP1) ! COMMON BLOCK BANDTA CONTAINS RANDOM BAND PARAMETERS FOR THE LW ! CALCULATIONS USING 10 CM-1 WIDE BANDS.THE 15 UM CO2 COMPLEX ! IS 2 BANDS,560-670 AND 670-800 CM-1. OZONE COEFFICIENTS ARE ! IN 3 BANDS,670-800 (14.1 UM),990-1070 AND 1070-1200 (9.6 UM). ! THE (NBLW) BANDS NOW INCLUDE: ! 56 BANDS, 10 CM-1 WIDE 0 - 560 CM-1 ! 2 BANDS, 15 UM COMPLEX 560 - 670 CM-1 ! 670 - 800 CM-1 ! 3 "CONTINUUM" BANDS 800 - 900 CM-1 ! 900 - 990 CM-1 ! 1070 - 1200 CM-1 ! 1 BAND FOR 9.6 UM BAND 990 - 1070 CM-1 ! 100 BANDS, 10 CM-1 WIDE 1200 - 2200 CM-1 ! 1 BAND FOR 4.3 UM SRC 2270 - 2380 CM-1 ! THUS NBLW PRESENTLY EQUALS 163 ! ALL BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER ! ARNDM = RANDOM "A" PARAMETER FOR (NBLW) BANDS ! BRNDM = RANDOM "B" PARAMETER FOR (NBLW) BANDS ! BETAD = CONTINUUM COEFFICIENTS FOR (NBLW) BANDS ! AP,BP = CAPPHI COEFFICIENTS FOR (NBLW) BANDS ! ATP,BTP = CAPPSI COEFFICIENTS FOR (NBLW) BANDS ! BANDLO = LOWEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS ! BANDHI = HIGHEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS ! AO3RND = RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE ! BANDS ! BO3RND = RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE ! BANDS ! AB15 = THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS ! REPRESENTING THE 15 UM BAND COMPLEX OF CO2 ! DATA FOR ARNDM,BRNDM,AP,BP,ATP,BTP,AO3RND,BO3RND ARE OBTAINED BY ! USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS ARE FROM ! ROBERTS (1976). COMMON / BANDTA / ARNDM(NBLW),BRNDM(NBLW),BETAD(NBLW),AP(NBLW), & BP(NBLW),ATP(NBLW),BTP(NBLW),BANDLO(NBLW), & BANDHI(NBLW),AO3RND(3),BO3RND(3),AB15(2) ! COMMON BLOCK BDWIDE CONTAINS RANDOM BAND PARAMETERS FOR SPECIFIC ! WIDE BANDS. AT PRESENT,THE INFORMATION CONSISTS OF 1) RANDOM ! MODEL PARAMETERS FOR THE 15 UM BAND,560-800 CM-1; 2) THE ! CONTINUUM COEFFICIENT FOR THE 800-990,1070-1200 CM-1 BAND ! SPECIFICALLY: ! AWIDE = RANDOM "A" PARAMETER FOR BAND ! BWIDE = RANDOM "B" PARAMETER FOR BAND ! BETAWD = CONTINUUM COEFFICIENTS FOR BAND ! APWD,BPWD = CAPPHI COEFFICIENTS FOR BAND ! ATPWD,BTPWD = CAPPSI COEFFICIENTS FOR BAND ! BDLOWD = LOWEST FREQUENCY IN EACH FREQ BAND ! BDHIWD = HIGHEST FREQUENCY IN EACH FREQ BAND ! AB15WD = THE PRODUCT ARNDM*BRNDM FOR THE ONE BAND ! REPRESENTING THE 15 UM BAND COMPLEX OF CO2 ! BETINW = CONT.COEFFICIENT FOR A SPECIFIED WIDE ! FREQ.BAND (800-990 AND 1070-1200 CM-1). ! SKO2D = 1./BETINW, USED IN SPA88 FOR CONT. COEFFS ! SKC1R = BETAWD/BETINW, USED FOR CONT. COEFF. FOR ! 15 UM BAND IN FST88 ! SKO3R = RATIO OF CONT. COEFF. FOR 9.9 UM BAND TO ! BETINW, USED FOR 9.6 UM CONT COEFF IN FST88 ! DATA FOR AWIDE,BWIDE,APWD,BPWD,ATPWD,BTPWD,AO3WD,BO3WD ARE ! OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS ! ARE FROM ROBERTS (1976). COMMON / BDWIDE / AWIDE,BWIDE,BETAWD, & APWD,BPWD,ATPWD,BTPWD, & BDLOWD,BDHIWD,BETINW, & AB15WD,SKO2D,SKC1R,SKO3R ! COMMON BLOCK BDCOMB CONTAINS RANDOM BAND PARAMETERS FOR THE LW ! CALCULATIONS USING COMBINED WIDE FREQUENCY BANDS BETWEEN 160 AND ! 1200 CM-1,AS WELL AS THE 2270-2380 BAND FOR SOURCE CALC. ! BANDS 1-8: COMBINED WIDE FREQUENCY BANDS FOR 160-560 CM-1 ! BANDS 9-14: FREQUENCY BANDS,AS IN BANDTA (NARROW BANDS) ! FOR 560-1200 CM-1 ! BAND 15: FREQUENCY BAND 2270-2380 CM-1,USED FOR SOURCE ! CALCULATION ONLY ! THUS NBLY PRESENTLY EQUALS 15 ! BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER ! ACOMB = RANDOM "A" PARAMETER FOR (NBLY) BANDS ! BCOMB = RANDOM "B" PARAMETER FOR (NBLY) BANDS ! BETACM = CONTINUUM COEFFICIENTS FOR (NBLY) BANDS ! APCM,BPCM = CAPPHI COEFFICIENTS FOR (NBLY) BANDS ! ATPCM,BTPCM = CAPPSI COEFFICIENTS FOR (NBLY) BANDS ! BDLOCM = LOWEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS ! BDHICM = HIGHEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS ! AO3CM = RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE ! BANDS ! BO3CM = RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE ! BANDS ! AB15CM = THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS ! REPRESENTING THE 15 UM BAND COMPLEX OF CO2 ! BETINC = CONT.COEFFICIENT FOR A SPECIFIED WIDE ! FREQ.BAND (800-990 AND 1070-1200 CM-1). ! IBAND = INDEX NO OF THE 40 WIDE BANDS USED IN ! COMBINED WIDE BAND CALCULATIONS. IN OTHER ! WORDS,INDEX TELLING WHICH OF THE 40 WIDE ! BANDS BETWEEN 160-560 CM-1 ARE INCLUDED IN ! EACH OF THE FIRST 8 COMBINED WIDE BANDS ! DATA FOR ACOMB,BCOMB,APCM,BPCM,ATPCM,BTPCM,AO3CM,BO3CM ARE ! OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS ! ARE FROM ROBERTS (1976). IBAND INDEX VALUES ARE OBTAINED BY ! EXPERIMENTATION. COMMON / BDCOMB / IBAND(40),ACOMB(NBLY),BCOMB(NBLY), & BETACM(NBLY),APCM(NBLY),BPCM(NBLY),ATPCM(NBLY), & BTPCM(NBLY),BDLOCM(NBLY),BDHICM(NBLY),BETINC, & AO3CM(3),BO3CM(3),AB15CM(2) DIMENSION PRESS(IDIM1:IDIM2,LP1),TEMP(IDIM1:IDIM2,LP1), & RH2O(IDIM1:IDIM2,L),QO3(IDIM1:IDIM2,L) DIMENSION CLDFAC(IDIM1:IDIM2,LP1,LP1),CAMT(IDIM1:IDIM2,LP1) DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1), & KBTM(IDIM1:IDIM2,LP1) DIMENSION HEATRA(IDIM1:IDIM2,L),GRNFLX(IDIM1:IDIM2), & TOPFLX(IDIM1:IDIM2) DIMENSION DELP2(IDIM1:IDIM2,L) DIMENSION QH2O(IDIM1:IDIM2,L),T(IDIM1:IDIM2,LP1) DIMENSION P(IDIM1:IDIM2,LP1),DELP(IDIM1:IDIM2,L) DIMENSION CO21(IDIM1:IDIM2,LP1,LP1),CO2NBL(IDIM1:IDIM2,L) DIMENSION CO2SP1(IDIM1:IDIM2,LP1),CO2SP2(IDIM1:IDIM2,LP1) DIMENSION VAR1(IDIM1:IDIM2,L),VAR2(IDIM1:IDIM2,L), & VAR3(IDIM1:IDIM2,L),VAR4(IDIM1:IDIM2,L) DIMENSION CNTVAL(IDIM1:IDIM2,LP1) DIMENSION TOTO3(IDIM1:IDIM2,LP1),TPHIO3(IDIM1:IDIM2,LP1), & TOTPHI(IDIM1:IDIM2,LP1) DIMENSION TOTVO2(IDIM1:IDIM2,LP1),EMX1(IDIM1:IDIM2), & EMX2(IDIM1:IDIM2),EMPL(IDIM1:IDIM2,LLP1) DIMENSION CO2R(IDIM1:IDIM2,LP1),DIFT(IDIM1:IDIM2,LP1) DIMENSION CO2R1(IDIM1:IDIM2,LP1),DCO2D1(IDIM1:IDIM2,LP1) DIMENSION D2CD21(IDIM1:IDIM2,LP1),D2CD22(IDIM1:IDIM2,LP1) DIMENSION CO2R2(IDIM1:IDIM2,LP1),DCO2D2(IDIM1:IDIM2,LP1) DIMENSION CO2MR(IDIM1:IDIM2,L),CO2MD(IDIM1:IDIM2,L), & CO2M2D(IDIM1:IDIM2,L) DIMENSION TDAV(IDIM1:IDIM2,LP1),TSTDAV(IDIM1:IDIM2,LP1), & VV(IDIM1:IDIM2,L),VSUM3(IDIM1:IDIM2,LP1),VSUM1(IDIM1:IDIM2), & VSUM2(IDIM1:IDIM2) DIMENSION A1(IDIM1:IDIM2),A2(IDIM1:IDIM2) DIMENSION DCO2DT(IDIM1:IDIM2,LP1),D2CDT2(IDIM1:IDIM2,LP1) DIMENSION TEXPSL(IDIM1:IDIM2,LP1),TLSQU(IDIM1:IDIM2,LP1) DIMENSION VSUM4(IDIM1:IDIM2,L) EQUIVALENCE (VSUM3,TLSQU,TEXPSL) EQUIVALENCE (VV,VSUM4) !****COMPUTE FLUX PRESSURES (P) AND DIFFERENCES (DELP2,DELP) !****COMPUTE FLUX LEVEL TEMPERATURES (T) AND CONTINUUM TEMPERATURE ! CORRECTIONS (TEXPSL) DO 103 K=2,L DO 103 I=MYIS,MYIE P(I,K)=HAF*(PRESS(I,K-1)+PRESS(I,K)) T(I,K)=HAF*(TEMP(I,K-1)+TEMP(I,K)) 103 END DO DO 105 I=MYIS,MYIE P(I,1)=ZERO P(I,LP1)=PRESS(I,LP1) T(I,1)=TEMP(I,1) T(I,LP1)=TEMP(I,LP1) 105 END DO DO 107 K=1,L DO 107 I=MYIS,MYIE DELP2(I,K)=P(I,K+1)-P(I,K) DELP(I,K)=ONE/DELP2(I,K) 107 END DO !****COMPUTE ARGUMENT FOR CONT.TEMP.COEFF. ! (THIS IS 1800.(1./TEMP-1./296.)) DO 125 K=1,LP1 DO 125 I=MYIS,MYIE TEXPSL(I,K)=H18E3/TEMP(I,K)-H6P08108 !...THEN TAKE EXPONENTIAL TEXPSL(I,K)=EXP(TEXPSL(I,K)) 125 END DO !***COMPUTE OPTICAL PATHS FOR H2O AND O3, USING THE DIFFUSIVITY ! APPROXIMATION FOR THE ANGULAR INTEGRATION (1.66). OBTAIN THE ! UNWEIGHTED VALUES(VAR1,VAR3) AND THE WEIGHTED VALUES(VAR2,VAR4). ! THE QUANTITIES H3M4(.0003) AND H3M3(.003) APPEARING IN THE VAR2 AND ! VAR4 EXPRESSIONS ARE THE APPROXIMATE VOIGT CORRECTIONS FOR H2O AND ! O3,RESPECTIVELY. DO 131 K=1,L DO 131 I=MYIS,MYIE QH2O(I,K)=RH2O(I,K)*DIFFCTR !---VV IS THE LAYER-MEAN PRESSURE (IN ATM),WHICH IS NOT THE SAME AS ! THE LEVEL PRESSURE (PRESS) VV(I,K)=HAF*(P(I,K+1)+P(I,K))*P0INV VAR1(I,K)=DELP2(I,K)*QH2O(I,K)*GINV VAR3(I,K)=DELP2(I,K)*QO3(I,K)*DIFFCTR*GINV VAR2(I,K)=VAR1(I,K)*(VV(I,K)+H3M4) VAR4(I,K)=VAR3(I,K)*(VV(I,K)+H3M3) ! COMPUTE OPTICAL PATH FOR THE H2O CONTINUUM, USING ROBERTS COEFFS. ! (BETINW),AND TEMP. CORRECTION (TEXPSL). THE DIFFUSIVITY FACTOR ! (WHICH CANCELS OUT IN THIS EXPRESSION) IS ASSUMED TO BE 1.66. THE ! USE OF THE DIFFUSIVITY FACTOR HAS BEEN SHOWN TO BE A SIGNIFICANT ! SOURCE OF ERROR IN THE CONTINUUM CALCS.,BUT THE TIME PENALTY OF ! AN ANGULAR INTEGRATION IS SEVERE. CNTVAL(I,K)=TEXPSL(I,K)*RH2O(I,K)*VAR2(I,K)*BETINW/ & (RH2O(I,K)+RATH2OMW) 131 END DO ! COMPUTE SUMMED OPTICAL PATHS FOR H2O,O3 AND CONTINUUM DO 201 I=MYIS,MYIE TOTPHI(I,1)=ZERO TOTO3(I,1)=ZERO TPHIO3(I,1)=ZERO TOTVO2(I,1)=ZERO 201 END DO DO 203 K=2,LP1 DO 203 I=MYIS,MYIE TOTPHI(I,K)=TOTPHI(I,K-1)+VAR2(I,K-1) TOTO3(I,K)=TOTO3(I,K-1)+VAR3(I,K-1) TPHIO3(I,K)=TPHIO3(I,K-1)+VAR4(I,K-1) TOTVO2(I,K)=TOTVO2(I,K-1)+CNTVAL(I,K-1) 203 END DO !---EMX1 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO ! P(L). IT IS USED IN NEARBY LAYER AND EMISS CALCULATIONS. !---EMX2 IS THE ADDITIONAL PRESSURE-SCALED MASS FROM PRESS(L) TO ! P(LP1). IT IS USED IN CALCULATIONS BETWEEN FLUX LEVELS L AND LP1. DO 801 I=MYIS,MYIE EMX1(I)=QH2O(I,L)*PRESS(I,L)*(PRESS(I,L)-P(I,L))*GP0INV EMX2(I)=QH2O(I,L)*PRESS(I,L)*(P(I,LP1)-PRESS(I,L))*GP0INV 801 END DO !---EMPL IS THE PRESSURE SCALED MASS FROM P(K) TO PRESS(K) (INDEX 2-LP1) ! OR TO PRESS(K+1) (INDEX LP2-LL) DO 811 K=1,L DO 811 I=MYIS,MYIE EMPL(I,K+1)=QH2O(I,K)*P(I,K+1)*(P(I,K+1)-PRESS(I,K))*GP0INV 811 END DO DO 812 K=1,LM1 DO 812 I=MYIS,MYIE EMPL(I,LP2+K-1)=QH2O(I,K+1)*P(I,K+1)*(PRESS(I,K+1)-P(I,K+1)) & *GP0INV 812 END DO DO 821 I=MYIS,MYIE EMPL(I,1)=VAR2(I,L) EMPL(I,LLP1)=EMPL(I,LL) 821 END DO !***COMPUTE WEIGHTED TEMPERATURE (TDAV) AND PRESSURE (TSTDAV) INTEGRALS ! FOR USE IN OBTAINING TEMP. DIFFERENCE BET. SOUNDING AND STD. ! TEMP. SOUNDING (DIFT) DO 161 I=MYIS,MYIE TSTDAV(I,1)=ZERO TDAV(I,1)=ZERO 161 END DO DO 162 K=1,LP1 DO 162 I=MYIS,MYIE VSUM3(I,K)=TEMP(I,K)-STEMP(K) 162 END DO DO 163 K=1,L DO 165 I=MYIS,MYIE VSUM2(I)=GTEMP(K)*DELP2(I,K) VSUM1(I)=VSUM2(I)*VSUM3(I,K) TSTDAV(I,K+1)=TSTDAV(I,K)+VSUM2(I) TDAV(I,K+1)=TDAV(I,K)+VSUM1(I) 165 END DO 163 END DO !****EVALUATE COEFFICIENTS FOR CO2 PRESSURE INTERPOLATION (A1,A2) DO 171 I=MYIS,MYIE A1(I)=(PRESS(I,LP1)-P0XZP8)/P0XZP2 A2(I)=(P0-PRESS(I,LP1))/P0XZP2 171 END DO !***PERFORM CO2 PRESSURE INTERPOLATION ON ALL INPUTTED TRANSMISSION ! FUNCTIONS AND TEMP. DERIVATIVES !---SUCCESSIVELY COMPUTING CO2R,DCO2DT AND D2CDT2 IS DONE TO SAVE ! STORAGE (AT A SLIGHT LOSS IN COMPUTATION TIME) DO 184 K=1,LP1 DO 184 I=MYIS,MYIE CO2R1(I,K)=A1(I)*CO231(K)+A2(I)*CO238(K) D2CD21(I,K)=H1M3*(A1(I)*C2D31(K)+A2(I)*C2D38(K)) DCO2D1(I,K)=H1M2*(A1(I)*CDT31(K)+A2(I)*CDT38(K)) CO2R2(I,K)=A1(I)*CO271(K)+A2(I)*CO278(K) D2CD22(I,K)=H1M3*(A1(I)*C2D71(K)+A2(I)*C2D78(K)) DCO2D2(I,K)=H1M2*(A1(I)*CDT71(K)+A2(I)*CDT78(K)) 184 END DO DO 190 K=1,L DO 190 I=MYIS,MYIE CO2MR(I,K)=A1(I)*CO2M51(K)+A2(I)*CO2M58(K) CO2MD(I,K)=H1M2*(A1(I)*CDTM51(K)+A2(I)*CDTM58(K)) CO2M2D(I,K)=H1M3*(A1(I)*C2DM51(K)+A2(I)*C2DM58(K)) 190 END DO !***COMPUTE CO2 TEMPERATURE INTERPOLATIONS FOR ALL BANDS,USING DIFT ! THE CASE WHERE K=1 IS HANDLED FIRST. WE ARE NOW REPLACING ! 3-DIMENSIONAL ARRAYS BY 2-D ARRAYS, TO SAVE SPACE. THUS THIS ! CALCULATION IS FOR (I,KP,1) DO 211 KP=2,LP1 DO 211 I=MYIS,MYIE DIFT(I,KP)=TDAV(I,KP)/TSTDAV(I,KP) 211 END DO DO 212 I=MYIS,MYIE CO21(I,1,1)=1.0 CO2SP1(I,1)=1.0 CO2SP2(I,1)=1.0 212 END DO DO 215 KP=2,LP1 DO 215 I=MYIS,MYIE !---CALCULATIONS FOR KP>1 FOR K=1 CO2R(I,KP)=A1(I)*CO251(KP,1)+A2(I)*CO258(KP,1) DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,1)+A2(I)*CDT58(KP,1)) D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,1)+A2(I)*C2D58(KP,1)) CO21(I,KP,1)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ & HAF*DIFT(I,KP)*D2CDT2(I,KP)) !---CALCULATIONS FOR (EFFECTIVELY) KP=1,K>KP. THESE USE THE ! SAME VALUE OF DIFT DUE TO SYMMETRY CO2R(I,KP)=A1(I)*CO251(1,KP)+A2(I)*CO258(1,KP) DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(1,KP)+A2(I)*CDT58(1,KP)) D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(1,KP)+A2(I)*C2D58(1,KP)) CO21(I,1,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ & HAF*DIFT(I,KP)*D2CDT2(I,KP)) 215 END DO ! THE TRANSMISSION FUNCTIONS USED IN SPA88 MAY BE COMPUTED NOW. !---(IN THE 250 LOOP,DIFT REALLY SHOULD BE (I,1,K), BUT DIFT IS ! INVARIANT WITH RESPECT TO K,KP,AND SO (I,1,K)=(I,K,1)) DO 250 K=2,LP1 DO 250 I=MYIS,MYIE CO2SP1(I,K)=CO2R1(I,K)+DIFT(I,K)*(DCO2D1(I,K)+HAF*DIFT(I,K)* & D2CD21(I,K)) CO2SP2(I,K)=CO2R2(I,K)+DIFT(I,K)*(DCO2D2(I,K)+HAF*DIFT(I,K)* & D2CD22(I,K)) 250 END DO ! NEXT THE CASE WHEN K=2...L DO 220 K=2,L DO 222 KP=K+1,LP1 DO 222 I=MYIS,MYIE DIFT(I,KP)=(TDAV(I,KP)-TDAV(I,K))/ & (TSTDAV(I,KP)-TSTDAV(I,K)) CO2R(I,KP)=A1(I)*CO251(KP,K)+A2(I)*CO258(KP,K) DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(KP,K)+A2(I)*CDT58(KP,K)) D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(KP,K)+A2(I)*C2D58(KP,K)) CO21(I,KP,K)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ & HAF*DIFT(I,KP)*D2CDT2(I,KP)) CO2R(I,KP)=A1(I)*CO251(K,KP)+A2(I)*CO258(K,KP) DCO2DT(I,KP)=H1M2*(A1(I)*CDT51(K,KP)+A2(I)*CDT58(K,KP)) D2CDT2(I,KP)=H1M3*(A1(I)*C2D51(K,KP)+A2(I)*C2D58(K,KP)) CO21(I,K,KP)=CO2R(I,KP)+DIFT(I,KP)*(DCO2DT(I,KP)+ & HAF*DIFT(I,KP)*D2CDT2(I,KP)) 222 END DO 220 END DO ! FINALLY THE CASE WHEN K=KP,K=2..LP1 DO 206 K=2,LP1 DO 206 I=MYIS,MYIE DIFT(I,K)=HAF*(VSUM3(I,K)+VSUM3(I,K-1)) CO2R(I,K)=A1(I)*CO251(K,K)+A2(I)*CO258(K,K) DCO2DT(I,K)=H1M2*(A1(I)*CDT51(K,K)+A2(I)*CDT58(K,K)) D2CDT2(I,K)=H1M3*(A1(I)*C2D51(K,K)+A2(I)*C2D58(K,K)) CO21(I,K,K)=CO2R(I,K)+DIFT(I,K)*(DCO2DT(I,K)+ & HAF*DIFT(I,K)*D2CDT2(I,K)) 206 END DO !--- WE ARENT DOING NBL TFS ON THE 100 CM-1 BANDS . DO 260 K=1,L DO 260 I=MYIS,MYIE CO2NBL(I,K)=CO2MR(I,K)+VSUM3(I,K)*(CO2MD(I,K)+HAF* & VSUM3(I,K)*CO2M2D(I,K)) 260 END DO !***COMPUTE TEMP. COEFFICIENT BASED ON T(K) (SEE REF.2) DO 264 K=1,LP1 DO 264 I=MYIS,MYIE IF (T(I,K) <= H25E2) THEN TLSQU(I,K)=B0+(T(I,K)-H25E2)* & (B1+(T(I,K)-H25E2)* & (B2+B3*(T(I,K)-H25E2))) ELSE TLSQU(I,K)=B0 ENDIF 264 END DO !***APPLY TO ALL CO2 TFS DO 280 K=1,LP1 DO 282 KP=1,LP1 DO 282 I=MYIS,MYIE CO21(I,KP,K)=CO21(I,KP,K)*(ONE-TLSQU(I,KP))+TLSQU(I,KP) 282 END DO 280 END DO DO 284 K=1,LP1 DO 286 I=MYIS,MYIE CO2SP1(I,K)=CO2SP1(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1) CO2SP2(I,K)=CO2SP2(I,K)*(ONE-TLSQU(I,1))+TLSQU(I,1) 286 END DO 284 END DO DO 288 K=1,L DO 290 I=MYIS,MYIE CO2NBL(I,K)=CO2NBL(I,K)*(ONE-TLSQU(I,K))+TLSQU(I,K) 290 END DO 288 END DO CALL FST88(HEATRA,GRNFLX,TOPFLX, & QH2O,PRESS,P,DELP,DELP2,TEMP,T, & CLDFAC,NCLDS,KTOP,KBTM,CAMT, & CO21,CO2NBL,CO2SP1,CO2SP2, & VAR1,VAR2,VAR3,VAR4,CNTVAL, & TOTO3,TPHIO3,TOTPHI,TOTVO2, & EMX1,EMX2,EMPL) RETURN END SUBROUTINE LWR88