SUBROUTINE E1E290(G1,G2,G3,G4,G5,EMISS,FXOE1,DTE1,FXOE2,DTE2, 1 AVEPHI,TEMP,T) C C SUBROUTINE E1E290 COMPUTES THE EXCHANGE TERMS IN THE FLUX EQUATION C FOR LONGWAVE RADIATION FOR ALL TERMS EXCEPT THE EXCHANGE WITH THE C TOP OF THE ATMOSPHERE. THE METHOD IS A TABLE LOOKUP ON A PRE- C COMPUTED E2 FUNCTION (DEFINED IN REF. (4)). C THE E1 FUNCTION CALCULATIONS (FORMERLY DONE IN SUBROUTINE C E1V88 COMPUTE THE FLUX RESULTING FROM THE EXCHANGE OF PHOTONS C BETWEEN A LAYER AND THE TOP OF THE ATMOSPHERE. THE METHOD IS A C TABLE LOOKUP ON A PRE-COMPUTED E1 FUNCTION. C CALCULATIONS ARE DONE IN TWO FREQUENCY RANGES: C 1) 0-560,1200-2200 CM-1 FOR Q(APPROX) C 2) 160-560 CM-1 FOR Q(APPROX,CTS). C MOTIVATION FOR THESE CALCULATIONS IS IN REFERENCES (1) AND (4). C INPUTS: (COMMON BLOCKS) C TABLE1,TABLE2,TABLE3,EM1,EM1WDE TABCOM C AVEPHI TFCOM C TEMP RADISW C T KDACOM C FXOE1,DTE1 ARGUMENT LIST C FXOE2,DTE2 ARGUMENT LIST C OUTPUTS: C EMISS TFCOM C G1,G2,G3 ARGUMENT LIST,FOR 1ST FREQ. RANGE C G4,G5 ARGUMENT LIST,FOR 2ND FREQ. RANGE C C CALLED BY : FST88 C CALLS : 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----------------------------------------------------------------------- INCLUDE "parmeta" INCLUDE "mpp.h" #include "sp.h" 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 PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: C IMAX = NO. POINTS SENT TO RADFS 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. C COMMON BLOCK TABCOM CONTAINS QUANTITIES PRECOMPUTED IN SUBROUTINE C TABLE FOR USE IN THE LONGWAVE RADIATION PROGRAM: C EM1 = E1 FUNCTION, EVALUATED OVER THE 0-560 AND C 1200-2200 CM-1 INTERVALS C EM1WDE = E1 FUNCTION, EVALUATED OVER THE 160-560 CM-1 C INTERVAL C TABLE1 = E2 FUNCTION, EVALUATED OVER THE 0-560 AND C 1200-2200 CM-1 INTERVALS C TABLE2 = TEMPERATURE DERIVATIVE OF TABLE1 C TABLE3 = MASS DERIVATIVE OF TABLE1 C EM3 = E3 FUNCTION, EVALUATED OVER THE 0-560 AND C 1200-2200 CM-1 INTERVALS C SOURCE = PLANCK FUNCTION, EVALUATED AT SPECIFIED TEMPS. FOR C BANDS USED IN CTS CALCULATIONS C DSRCE = TEMPERATURE DERIVATIVE OF SOURCE C IND = INDEX, WITH VALUE IND(I)=I. USED IN FST88 C INDX2 = INDEX VALUES USED IN OBTAINING "LOWER TRIANGLE" C ELEMENTS OF AVEPHI,ETC.,IN FST88 C KMAXV = INDEX VALUES USED IN OBTAINING "UPPER TRIANGLE" C ELEMENTS OF AVEPHI,ETC.,IN FST88 C KMAXVM = KMAXV(L),USED FOR DO LOOP INDICES C COMMON / TABCOM / IND(IMAX),INDX2(LP1V),KMAXV(LP1), 1 KMAXVM COMMON/TABCOM/EM1(28,180),EM1WDE(28,180),TABLE1(28,180), 1 TABLE2(28,180),TABLE3(28,180),EM3(28,180),SOURCE(28,NBLY), 2 DSRCE(28,NBLY) C DIMENSION TEMP(IDIM1:IDIM2,LP1),T(IDIM1:IDIM2,LP1) DIMENSION AVEPHI(IDIM1:IDIM2,LP1),EMISS(IDIM1:IDIM2,LP1) C DIMENSION IT1(IDIM1:IDIM2,LL3P),IVAL(IDIM1:IDIM2,LP1), 5 FYO(IDIM1:IDIM2,LP1),DU(IDIM1:IDIM2,LP1), 6 WW1(IDIM1:IDIM2,LP1),WW2(IDIM1:IDIM2,LP1), 7 TMP3(IDIM1:IDIM2,LP1),TMP5(IDIM1:IDIM2),TMP9(IDIM1:IDIM2) C---VARIABLES EQUIVALENCED TO COMMON BLOCK VARIABLES DIMENSION T1(5040),T2(5040),T4(5040) DIMENSION EM1V(5040),EM1VW(5040) C---VARIABLES IN THE ARGUMENT LIST DIMENSION FXOE1(IDIM1:IDIM2,LP1),DTE1(IDIM1:IDIM2,LP1), 1 FXOE2(IDIM1:IDIM2,LP1),DTE2(IDIM1:IDIM2,LP1), 2 G1(IDIM1:IDIM2,LP1),G2(IDIM1:IDIM2,L),G3(IDIM1:IDIM2,LP1), & G4(IDIM1:IDIM2,LP1),G5(IDIM1:IDIM2,L) C EQUIVALENCE (EM1V(1),EM1(1,1)),(EM1VW(1),EM1WDE(1,1)) EQUIVALENCE (T1(1),TABLE1(1,1)),(T2(1),TABLE2(1,1)), 1 (T4(1),TABLE3(1,1)) C---FIRST WE OBTAIN THE EMISSIVITIES AS A FUNCTION OF TEMPERATURE C (INDEX FXO) AND WATER AMOUNT (INDEX FYO). THIS PART OF THE CODE C THUS GENERATES THE E2 FUNCTION. THE FXO INDICES HAVE BEEN C OBTAINED IN FST88, FOR CONVENIENCE. C C---THIS SUBROUTINE EVALUATES THE K=1 CASE ONLY-- C C---THIS LOOP REPLACES LOOPS GOING FROMI=1,IMAX AND KP=2,LP1 PLUS C THE SPECIAL CASE FOR THE LP1TH LAYER. DO 1322 K=1,LP1 DO 1322 I=MYIS,MYIE TMP3(I,K)=LOG10(AVEPHI(I,K))+H16E1 FYO(I,K)=AINT(TMP3(I,K)*TEN) DU(I,K)=TMP3(I,K)-HP1*FYO(I,K) FYO(I,K)=H28E1*FYO(I,K) IVAL(I,K)=FYO(I,K)+FXOE2(I,K) EMISS(I,K)=T1(IVAL(I,K))+DU(I,K)*T2(IVAL(I,K)) 1 +DTE2(I,K)*T4(IVAL(I,K)) 1322 CONTINUE C C---THE SPECIAL CASE EMISS(I,L) (LAYER KP) IS OBTAINED NOW C BY AVERAGING THE VALUES FOR L AND LP1: DO 1344 I=MYIS,MYIE EMISS(I,L)=HAF*(EMISS(I,L)+EMISS(I,LP1)) 1344 CONTINUE C C CALCULATIONS FOR THE KP=1 LAYER ARE NOT PERFORMED, AS C THE RADIATION CODE ASSUMES THAT THE TOP FLUX LAYER (ABOVE THE C TOP DATA LEVEL) IS ISOTHERMAL, AND HENCE CONTRIBUTES NOTHING C TO THE FLUXES AT OTHER LEVELS. C C***THE FOLLOWING IS THE CALCULATION FOR THE E1 FUNCTION, FORMERLY C DONE IN SUBROUTINE E1V88. THE MOVE TO E1E288 IS DUE TO THE C SAVINGS IN OBTAINING INDEX VALUES (THE TEMP. INDICES HAVE C BEEN OBTAINED IN FST88, WHILE THE U-INDICES ARE OBTAINED C IN THE E2 CALCS.,WITH K=1). C C C FOR TERMS INVOLVING TOP LAYER, DU IS NOT KNOWN; IN FACT, WE C USE INDEX 2 TO REPERSENT INDEX 1 IN PREV. CODE. THIS MEANS THAT C THE IT1 INDEX 1 AND LLP1 HAS TO BE CALCULATED SEPARATELY. THE C INDEX LLP2 GIVES THE SAME VALUE AS 1; IT CAN BE OMITTED. DO 208 I=MYIS,MYIE IT1(I,1)=FXOE1(I,1) WW1(I,1)=TEN-DTE1(I,1) WW2(I,1)=HP1 208 CONTINUE DO 209 K=1,L DO 209 I=MYIS,MYIE IT1(I,K+1)=FYO(I,K)+FXOE1(I,K+1) IT1(I,LP2+K-1)=FYO(I,K)+FXOE1(I,K) WW1(I,K+1)=TEN-DTE1(I,K+1) WW2(I,K+1)=HP1-DU(I,K) 209 CONTINUE DO 211 KP=1,L DO 211 I=MYIS,MYIE IT1(I,KP+LLP1)=FYO(I,KP)+FXOE1(I,1) 211 CONTINUE C C C G3(I,1) HAS THE SAME VALUES AS G1 (AND DID ALL ALONG) DO 230 I=MYIS,MYIE G1(I,1)=WW1(I,1)*WW2(I,1)*EM1V(IT1(I,1))+ 1 WW2(I,1)*DTE1(I,1)*EM1V(IT1(I,1)+1) G3(I,1)=G1(I,1) 230 CONTINUE DO 240 K=1,L DO 240 I=MYIS,MYIE G1(I,K+1)=WW1(I,K+1)*WW2(I,K+1)*EM1V(IT1(I,K+1))+ 1 WW2(I,K+1)*DTE1(I,K+1)*EM1V(IT1(I,K+1)+1)+ 2 WW1(I,K+1)*DU(I,K)*EM1V(IT1(I,K+1)+28)+ 3 DTE1(I,K+1)*DU(I,K)*EM1V(IT1(I,K+1)+29) G2(I,K)=WW1(I,K)*WW2(I,K+1)*EM1V(IT1(I,K+LP2-1))+ 1 WW2(I,K+1)*DTE1(I,K)*EM1V(IT1(I,K+LP2-1)+1)+ 1 WW1(I,K)*DU(I,K)*EM1V(IT1(I,K+LP2-1)+28)+ 2 DTE1(I,K)*DU(I,K)*EM1V(IT1(I,K+LP2-1)+29) 240 CONTINUE DO 241 KP=2,LP1 DO 241 I=MYIS,MYIE G3(I,KP)=WW1(I,1)*WW2(I,KP)*EM1V(IT1(I,LL+KP))+ 1 WW2(I,KP)*DTE1(I,1)*EM1V(IT1(I,LL+KP)+1)+ 2 WW1(I,1)*DU(I,KP-1)*EM1V(IT1(I,LL+KP)+28)+ 3 DTE1(I,1)*DU(I,KP-1)*EM1V(IT1(I,LL+KP)+29) 241 CONTINUE C DO 244 I=MYIS,MYIE G4(I,1)=WW1(I,1)*WW2(I,1)*EM1VW(IT1(I,1))+ 1 WW2(I,1)*DTE1(I,1)*EM1VW(IT1(I,1)+1) 244 CONTINUE DO 242 K=1,L DO 242 I=MYIS,MYIE G4(I,K+1)=WW1(I,K+1)*WW2(I,K+1)*EM1VW(IT1(I,K+1))+ 1 WW2(I,K+1)*DTE1(I,K+1)*EM1VW(IT1(I,K+1)+1)+ 2 WW1(I,K+1)*DU(I,K)*EM1VW(IT1(I,K+1)+28)+ 3 DTE1(I,K+1)*DU(I,K)*EM1VW(IT1(I,K+1)+29) G5(I,K)=WW1(I,K)*WW2(I,K+1)*EM1VW(IT1(I,K+LP2-1))+ 1 WW2(I,K+1)*DTE1(I,K)*EM1VW(IT1(I,K+LP2-1)+1)+ 1 WW1(I,K)*DU(I,K)*EM1VW(IT1(I,K+LP2-1)+28)+ 2 DTE1(I,K)*DU(I,K)*EM1VW(IT1(I,K+LP2-1)+29) 242 CONTINUE C RETURN END