Page 1 Source Listing FST88 2025-03-12 18:21 /tmp/ifortsnBcor.i 1 # 1 "FST88.F" 2 C ***************************************************************** 3 C SUBROUTINE FST88 IS THE MAIN COMPUTATION MODULE OF THE 4 C LONG-WAVE RADIATION CODE. IN IT ALL "EMISSIVITY" CALCULATIONS, 5 C INCLUDING CALLS TO TABLE LOOKUP SUBROUTINES. ALSO,AFTER CALLING 6 C SUBROUTINE "SPA88", FINAL COMBINED HEATING RATES AND GROUND 7 C FLUX ARE OBTAINED. 8 C ***************************************************************** 9 C INPUTS: 10 C BETINW,BETAWD,AB15WD BDWIDE 11 C BETAD,BO3RND,AO3RND BANDTA 12 C CLDFAC CLDCOM 13 C QH2O,P,DELP2,DELP,T,VAR1,VAR2, KDACOM 14 C VAR3,VAR4,CNTVAL KDACOM 15 C TOTVO2,TOTO3,TOTPHI,EMPL,EMX1 KDACOM 16 C TPHIO3,EMX2 KDACOM 17 C TEMP,PRESS RADISW 18 C NCLDS,KTOP,KBTM,CAMT RADISW 19 C IND,INDX2,KMAXV,SOURCE,DSRCE TABCOM 20 C SKC1R,SKC3R,KMAXVM,NREP1,NREP2 TABCOM 21 C NST1,NST2,NRP1,NRP2 TABCOM 22 C CO2NBL,CO21 TFCOM 23 C CO2SP1,CO2SP2 TFCOM 24 C OUTPUTS: 25 C HEATRA,GRNFLX,TOPFLX LWOUT 26 C 27 C CALLED BY : RADMN OR MAIN PGM 28 C CALLS : CLO88,E1E288,E3V88,SPA88,NLTE 29 C 30 C PASSED VARIABLES: 31 C IN E3V88: 32 C EMD = E3 FUNCTION FOR H2O LINES (0-560,1200-2200 CM-1) 33 C COMPUTED IN E3V88 34 C TPL = TEMPERATURE INPUT FOR E3 CALCULATION IN E3V88 35 C EMPL = H2O AMOUNT,INPUT FOR E3 CALCULATION IN E3V88 36 C (COMPUTED IN LWR88; STORED IN KDACOM.H) 37 C IN E1E288: 38 C E1CTS1 = E1 FUNCTION FOR THE (I+1)TH LEVEL USING THE 39 C TEMPERATURE OF THE ITH DATA LEVEL,COMPUTED OVER 40 C THE FREQUENCY RANGE 0-560,1200-2200 CM-1. (E1CTS1- 41 C E1CTW1) IS USED IN OBTAINING THE FLUX AT THE TOP 42 C IN THE 0-160,1200-2200 CM-1 RANGE (FLX1E1). 43 C E1CTS2 = E1 FUNCTION FOR THE ITH LEVEL, USING THE TEMP. OF 44 C THE ITH DATA LEVEL,COMPUTED OVER THE FREQUENCY RANGE 45 C 0-560,1200-2200 CM-1. (E1CTS2-E1CTW2) IS ALSO USED 46 C IN OBTAINING THE FLUX AT THE TOP IN THE 0-160,. 47 C 1200-2200 CM-1 RANGE. 48 C E1FLX = E1 FCTN. FOR THE ITH LEVEL,USING THE TEMPERATURE AT 49 C THE TOP OF THE ATMOSPHERE. COMPUTED OVER THE FREQ. 50 C RANGE 0-560,1200-2200 CM-1. USED FOR Q(APPROX) TERM. 51 C (IN COMMON BLOCK TFCOM) 52 C E1CTW1 = LIKE E1CTS1,BUT COMPUTED OVER THE 160-560 CM-1 RANGE 53 C AND USED FOR Q(APPROX,CTS) CALCULATION 54 C E1CTW2 = LIKE E1CTS2,BUT COMPUTED OVER THE 160-560 CM-1 RANGE 55 C AND USED FOR Q(APPROX,CTS) CALCULATION 56 C FXO = TEMPERATURE INDEX USED FOR E1 FUNCTION AND ALSO 57 C USED FOR SOURCE FUNCTION CALC. IN FST88. Page 2 Source Listing FST88 2025-03-12 18:21 FST88.F 58 C DT = TEMP. DIFF.BETWEEN MODEL TEMPS. AND TEMPS. AT 59 C TABULAR VALUES OF E1 AND SOURCE FCTNS. USED IN 60 C FST88 AND IN E1 FUNCTION CALC. 61 C FXOE2 = TEMPERATURE INDEX USED FOR E2 FUNCTION 62 C DTE2 = TEMP. DIFF. BETWEEN MODEL TEMP. AND TEMPS. AT 63 C TABULAR VALUES OF E2 FUNCTION. 64 SUBROUTINE FST88(HEATRA,GRNFLX,TOPFLX, 65 1 QH2O,PRESS,P,DELP,DELP2,TEMP,T, 66 2 CLDFAC,NCLDS,KTOP,KBTM,CAMT, 67 3 CO21,CO2NBL,CO2SP1,CO2SP2, 68 4 VAR1,VAR2,VAR3,VAR4,CNTVAL, 69 5 TOTO3,TPHIO3,TOTPHI,TOTVO2, 70 6 EMX1,EMX2,EMPL) 71 C 72 COMMON/PHYCON/AMOLWT,CSUBP,DIFFCTR,G,GRAVDR,O3DIFCTR,P0, 73 * P0XZP2,P0XZP8,P0X2,RADCON,RGAS,RGASSP,SECPDA 74 COMMON/PHYCON/RATCO2MW,RATH2OMW 75 COMMON/PHYCON/RADCON1 76 COMMON/PHYCON/GINV,P0INV,GP0INV 77 save /PHYCON/ 78 COMMON/HCON/HUNDRED,HNINETY,SIXTY,FIFTY,TEN,EIGHT,FIVE, 79 * FOUR,THREE,TWO,ONE,HAF,QUARTR,ZERO 80 COMMON/HCON/H83E26,H71E26,H1E15,H1E13,H1E11,H1E8,H4E5, 81 * H165E5,H5725E4,H488E4,H1E4,H24E3,H20788E3, 82 * H2075E3,H1224E3,H5E2,H3082E2,H3E2,H2945E2, 83 * H23E2,H15E2,H35E1,H3P6,H181E1,H18E1,H2P9,H2P8, 84 * H2P5,H1P8,H1P4387,H1P4,H1P25892,HP8,HP518, 85 * HP369,HP1 86 COMMON/HCON/H44871M2,H559M3,H1M3,H987M4,H285M4,H1M4, 87 * H6938M5,H394M5,H37412M5,H1439M5,H128M5,H1M5, 88 * H7M6,H4999M6,H25452M6,H1M6,H391M7,H1174M7, 89 * H8725M8,H327M8,H257M8,H1M8,H23M10,H14M10, 90 * H11M10,H1M10,H83M11,H82M11,H8M11,H77M11, 91 * H72M11,H53M11,H48M11,H44M11,H42M11,H37M11, 92 * H35M11,H32M11,H3M11,H28M11,H24M11,H23M11, 93 * H2M11,H18M11,H15M11,H14M11,H114M11,H11M11, 94 * H1M11,H96M12,H93M12,H77M12,H74M12,H65M12, 95 * H62M12,H6M12,H45M12,H44M12,H4M12,H38M12, 96 * H37M12,H3M12,H29M12,H28M12,H24M12,H21M12, 97 * H16M12,H14M12,H12M12,H8M13,H46M13,H36M13, 98 * H135M13,H12M13,H1M13,H3M14,H15M14,H14M14, 99 * H1M17,H1M18,H1M19,H1M20,H1M21,H1M22,H1M23, 100 * H1M24,H26M30,H14M30,H25M31,H21M31,H12M31, 101 * H9M32,H55M32,H45M32,H4M33,H62M34,H1M60 102 COMMON/HCON/HMP575,HM13EZ,HM19EZ,HM1E1,HM181E1,HM1E2 103 COMMON/HCON/H1E6,H2E6,H1M2,HMP66667,HM6666M2,HP166666, 104 * H41666M2,HMP5,HM2M2,H29316E2,H1226E1,H3116E1, 105 * H9P94,HP6,H625M2,HP228,HP60241,HM1797E1, 106 * H8121E1,H2E2,HM1EZ,H26E2,H44194M2,H1P41819 107 COMMON/HCON/HP219,HP144,HP816,H69766E5,H235M3,HP26, 108 * H129M2,H75826M4,H1P082,HP805,H1386E2, 109 * H658M2,H1036E2,H2118M2,H42M2,H323M4, 110 * H67390E2,HP3795,HP5048,H102M5,H451M6 111 COMMON/HCON/H16E1,HM161E1,H161E1,H3M3,H101M16, 112 * HM1597E1,H25E2,HP118666,H15M5,H3P5,H18E3, 113 * H6P08108,HMP805,HP602409,HP526315, 114 * H28571M2,H1M16 Page 3 Source Listing FST88 2025-03-12 18:21 FST88.F 115 COMMON/HCON/H3M4 116 COMMON/HCON/HM8E1 117 COMMON/HCON/H28E1 118 save /HCON/ 119 120 C----------------------------------------------------------------------- 121 INCLUDE "parmeta" 144 INCLUDE "mpp.h" 145 # 1 "./sp.h" 1 146 # 4 147 148 # 123 "FST88.F" 2 149 C----------------------------------------------------------------------- 150 C PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: 151 C IMAX = NO. POINTS ALONG THE LAT. CIRCLE USED IN CALCS. 152 C L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL 153 C***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS 154 C NBLW = NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE 155 C BANDTA FOR DEFINITION 156 C NBLX = NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS 157 C NBLY = NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE 158 C BDCOMB FOR DEFINITION 159 C INLTE = NO. LEVELS USED FOR NLTE CALCS. 160 C NNLTE = INDEX NO. OF FREQ. BAND IN NLTE CALCS. 161 C NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED 162 C FROM THE ABOVE PARAMETERS. 221 PARAMETER (L=LM) 222 PARAMETER (IMAX=IM,NCOL=IMAX) 223 PARAMETER (NBLW=163,NBLX=47,NBLY=15) 224 PARAMETER (NBLM=NBLY-1) 225 PARAMETER (LP1=L+1,LP2=L+2,LP3=L+3) 226 PARAMETER (LM1=L-1,LM2=L-2,LM3=L-3) 227 PARAMETER (LL=2*L,LLP1=LL+1,LLP2=LL+2,LLP3=LL+3) 228 PARAMETER (LLM1=LL-1,LLM2=LL-2,LLM3=LL-3) 229 PARAMETER (LP1M=LP1*LP1,LP1M1=LP1M-1) 230 PARAMETER (LP1V=LP1*(1+2*L/2)) 231 PARAMETER (LP121=LP1*NBLY) 232 PARAMETER (LL3P=3*L+2) 233 PARAMETER (NB=12) 234 PARAMETER (INLTE=3,INLTEP=INLTE+1,NNLTE=56) 235 PARAMETER (LP1I=IMAX*LP1,LLP1I=IMAX*LLP1,LL3PI=IMAX*LL3P) 236 PARAMETER (NB1=NB-1) 237 PARAMETER (KO2=12) 238 PARAMETER (KO21=KO2+1,KO2M=KO2-1) 239 C PARAMETER SETTINGS FOR THE LONGWAVE AND SHORTWAVE RADIATION CODE: 240 C IMAX = NO. POINTS SENT TO RADFS 241 C L = NO. VERTICAL LEVELS (ALSO LAYERS) IN MODEL 242 C***NOTE: THE USER NORMALLY WILL MODIFY ONLY THE IMAX AND L PARAMETERS 243 C NBLW = NO. FREQ. BANDS FOR APPROX COMPUTATIONS. SEE 244 C BANDTA FOR DEFINITION 245 C NBLX = NO. FREQ BANDS FOR APPROX CTS COMPUTATIONS 246 C NBLY = NO. FREQ. BANDS FOR EXACT CTS COMPUTATIONS. SEE 247 C BDCOMB FOR DEFINITION 248 C INLTE = NO. LEVELS USED FOR NLTE CALCS. 249 C NNLTE = INDEX NO. OF FREQ. BAND IN NLTE CALCS. 250 C NB,KO2 ARE SHORTWAVE PARAMETERS; OTHER QUANTITIES ARE DERIVED 251 C FROM THE ABOVE PARAMETERS. Page 4 Source Listing FST88 2025-03-12 18:21 FST88.F 252 C COMMON BLOCK BANDTA CONTAINS RANDOM BAND PARAMETERS FOR THE LW 253 C CALCULATIONS USING 10 CM-1 WIDE BANDS.THE 15 UM CO2 COMPLEX 254 C IS 2 BANDS,560-670 AND 670-800 CM-1. OZONE COEFFICIENTS ARE 255 C IN 3 BANDS,670-800 (14.1 UM),990-1070 AND 1070-1200 (9.6 UM). 256 C THE (NBLW) BANDS NOW INCLUDE: 257 C 56 BANDS, 10 CM-1 WIDE 0 - 560 CM-1 258 C 2 BANDS, 15 UM COMPLEX 560 - 670 CM-1 259 C 670 - 800 CM-1 260 C 3 "CONTINUUM" BANDS 800 - 900 CM-1 261 C 900 - 990 CM-1 262 C 1070 - 1200 CM-1 263 C 1 BAND FOR 9.6 UM BAND 990 - 1070 CM-1 264 C 100 BANDS, 10 CM-1 WIDE 1200 - 2200 CM-1 265 C 1 BAND FOR 4.3 UM SRC 2270 - 2380 CM-1 266 C THUS NBLW PRESENTLY EQUALS 163 267 C ALL BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER 268 C 269 C ARNDM = RANDOM "A" PARAMETER FOR (NBLW) BANDS 270 C BRNDM = RANDOM "B" PARAMETER FOR (NBLW) BANDS 271 C BETAD = CONTINUUM COEFFICIENTS FOR (NBLW) BANDS 272 C AP,BP = CAPPHI COEFFICIENTS FOR (NBLW) BANDS 273 C ATP,BTP = CAPPSI COEFFICIENTS FOR (NBLW) BANDS 274 C BANDLO = LOWEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS 275 C BANDHI = HIGHEST FREQUENCY IN EACH OF (NBLW) FREQ. BANDS 276 C AO3RND = RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE 277 C BANDS 278 C BO3RND = RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE 279 C BANDS 280 C AB15 = THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS 281 C REPRESENTING THE 15 UM BAND COMPLEX OF CO2 282 C DATA FOR ARNDM,BRNDM,AP,BP,ATP,BTP,AO3RND,BO3RND ARE OBTAINED BY 283 C USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS ARE FROM 284 C ROBERTS (1976). 285 COMMON / BANDTA / ARNDM(NBLW),BRNDM(NBLW),BETAD(NBLW),AP(NBLW), 286 1 BP(NBLW),ATP(NBLW),BTP(NBLW),BANDLO(NBLW), 287 2 BANDHI(NBLW),AO3RND(3),BO3RND(3),AB15(2) 288 C 289 C COMMON BLOCK BDWIDE CONTAINS RANDOM BAND PARAMETERS FOR SPECIFIC 290 C WIDE BANDS. AT PRESENT,THE INFORMATION CONSISTS OF 1) RANDOM 291 C MODEL PARAMETERS FOR THE 15 UM BAND,560-800 CM-1; 2) THE 292 C CONTINUUM COEFFICIENT FOR THE 800-990,1070-1200 CM-1 BAND 293 C SPECIFICALLY: 294 C AWIDE = RANDOM "A" PARAMETER FOR BAND 295 C BWIDE = RANDOM "B" PARAMETER FOR BAND 296 C BETAWD = CONTINUUM COEFFICIENTS FOR BAND 297 C APWD,BPWD = CAPPHI COEFFICIENTS FOR BAND 298 C ATPWD,BTPWD = CAPPSI COEFFICIENTS FOR BAND 299 C BDLOWD = LOWEST FREQUENCY IN EACH FREQ BAND 300 C BDHIWD = HIGHEST FREQUENCY IN EACH FREQ BAND 301 C AB15WD = THE PRODUCT ARNDM*BRNDM FOR THE ONE BAND 302 C REPRESENTING THE 15 UM BAND COMPLEX OF CO2 303 C BETINW = CONT.COEFFICIENT FOR A SPECIFIED WIDE 304 C FREQ.BAND (800-990 AND 1070-1200 CM-1). 305 C SKO2D = 1./BETINW, USED IN SPA88 FOR CONT. COEFFS 306 C SKC1R = BETAWD/BETINW, USED FOR CONT. COEFF. FOR 307 C 15 UM BAND IN FST88 308 C SKO3R = RATIO OF CONT. COEFF. FOR 9.9 UM BAND TO Page 5 Source Listing FST88 2025-03-12 18:21 FST88.F 309 C BETINW, USED FOR 9.6 UM CONT COEFF IN FST88 310 C DATA FOR AWIDE,BWIDE,APWD,BPWD,ATPWD,BTPWD,AO3WD,BO3WD ARE 311 C OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS 312 C ARE FROM ROBERTS (1976). 313 COMMON /BDWIDE/ AWIDE,BWIDE,BETAWD, 314 1 APWD,BPWD,ATPWD,BTPWD, 315 2 BDLOWD,BDHIWD,BETINW, 316 3 AB15WD,SKO2D,SKC1R,SKO3R 317 save /BDWIDE/ 318 C 319 C COMMON BLOCK BDCOMB CONTAINS RANDOM BAND PARAMETERS FOR THE LW 320 C CALCULATIONS USING COMBINED WIDE FREQUENCY BANDS BETWEEN 160 AND 321 C 1200 CM-1,AS WELL AS THE 2270-2380 BAND FOR SOURCE CALC. 322 C BANDS 1-8: COMBINED WIDE FREQUENCY BANDS FOR 160-560 CM-1 323 C BANDS 9-14: FREQUENCY BANDS,AS IN BANDTA (NARROW BANDS) 324 C FOR 560-1200 CM-1 325 C BAND 15: FREQUENCY BAND 2270-2380 CM-1,USED FOR SOURCE 326 C CALCULATION ONLY 327 C THUS NBLY PRESENTLY EQUALS 15 328 C 329 C BANDS ARE ARRANGED IN ORDER OF INCREASING WAVENUMBER 330 C ACOMB = RANDOM "A" PARAMETER FOR (NBLY) BANDS 331 C BCOMB = RANDOM "B" PARAMETER FOR (NBLY) BANDS 332 C BETACM = CONTINUUM COEFFICIENTS FOR (NBLY) BANDS 333 C APCM,BPCM = CAPPHI COEFFICIENTS FOR (NBLY) BANDS 334 C ATPCM,BTPCM = CAPPSI COEFFICIENTS FOR (NBLY) BANDS 335 C BDLOCM = LOWEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS 336 C BDHICM = HIGHEST FREQUENCY IN EACH OF (NBLY) FREQ. BANDS 337 C AO3CM = RANDOM "A" PARAMETER FOR OZONE IN (3) OZONE 338 C BANDS 339 C BO3CM = RANDOM "B" PARAMETER FOR OZONE IN (3) OZONE 340 C BANDS 341 C AB15CM = THE PRODUCT ARNDM*BRNDM FOR THE TWO BANDS 342 C REPRESENTING THE 15 UM BAND COMPLEX OF CO2 343 C BETINC = CONT.COEFFICIENT FOR A SPECIFIED WIDE 344 C FREQ.BAND (800-990 AND 1070-1200 CM-1). 345 C IBAND = INDEX NO OF THE 40 WIDE BANDS USED IN 346 C COMBINED WIDE BAND CALCULATIONS. IN OTHER 347 C WORDS,INDEX TELLING WHICH OF THE 40 WIDE 348 C BANDS BETWEEN 160-560 CM-1 ARE INCLUDED IN 349 C EACH OF THE FIRST 8 COMBINED WIDE BANDS 350 C DATA FOR ACOMB,BCOMB,APCM,BPCM,ATPCM,BTPCM,AO3CM,BO3CM ARE 351 C OBTAINED BY USING THE AFGL 1982 CATALOG. CONTINUUM COEFFICIENTS 352 C ARE FROM ROBERTS (1976). IBAND INDEX VALUES ARE OBTAINED BY 353 C EXPERIMENTATION. 354 COMMON / BDCOMB / IBAND(40),ACOMB(NBLY),BCOMB(NBLY), 355 1 BETACM(NBLY),APCM(NBLY),BPCM(NBLY),ATPCM(NBLY), 356 2 BTPCM(NBLY),BDLOCM(NBLY),BDHICM(NBLY),BETINC, 357 3 AO3CM(3),BO3CM(3),AB15CM(2) 358 save / BDCOMB / 359 C 360 C COMMON BLOCK TABCOM CONTAINS QUANTITIES PRECOMPUTED IN SUBROUTINE 361 C TABLE FOR USE IN THE LONGWAVE RADIATION PROGRAM: 362 C EM1 = E1 FUNCTION, EVALUATED OVER THE 0-560 AND 363 C 1200-2200 CM-1 INTERVALS 364 C EM1WDE = E1 FUNCTION, EVALUATED OVER THE 160-560 CM-1 365 C INTERVAL Page 6 Source Listing FST88 2025-03-12 18:21 FST88.F 366 C TABLE1 = E2 FUNCTION, EVALUATED OVER THE 0-560 AND 367 C 1200-2200 CM-1 INTERVALS 368 C TABLE2 = TEMPERATURE DERIVATIVE OF TABLE1 369 C TABLE3 = MASS DERIVATIVE OF TABLE1 370 C EM3 = E3 FUNCTION, EVALUATED OVER THE 0-560 AND 371 C 1200-2200 CM-1 INTERVALS 372 C SOURCE = PLANCK FUNCTION, EVALUATED AT SPECIFIED TEMPS. FOR 373 C BANDS USED IN CTS CALCULATIONS 374 C DSRCE = TEMPERATURE DERIVATIVE OF SOURCE 375 C IND = INDEX, WITH VALUE IND(I)=I. USED IN FST88 376 C INDX2 = INDEX VALUES USED IN OBTAINING "LOWER TRIANGLE" 377 C ELEMENTS OF AVEPHI,ETC.,IN FST88 378 C KMAXV = INDEX VALUES USED IN OBTAINING "UPPER TRIANGLE" 379 C ELEMENTS OF AVEPHI,ETC.,IN FST88 380 C KMAXVM = KMAXV(L),USED FOR DO LOOP INDICES 381 C 382 COMMON /TABCOM/ IND(IMAX),INDX2(LP1V),KMAXV(LP1), 383 1 KMAXVM 384 COMMON/TABCOM/EM1(28,180),EM1WDE(28,180),TABLE1(28,180), 385 1 TABLE2(28,180),TABLE3(28,180),EM3(28,180),SOURCE(28,NBLY), 386 2 DSRCE(28,NBLY) 387 save /TABCOM/ 388 C 389 DIMENSION QH2O(IDIM1:IDIM2,LP1),PRESS(IDIM1:IDIM2,LP1) 390 DIMENSION P(IDIM1:IDIM2,LP1),DELP(IDIM1:IDIM2,L), 391 & DELP2(IDIM1:IDIM2,L),TEMP(IDIM1:IDIM2,LP1) 392 DIMENSION T(IDIM1:IDIM2,LP1),CLDFAC(IDIM1:IDIM2,LP1,LP1), 393 & CAMT(IDIM1:IDIM2,LP1) 394 DIMENSION NCLDS(IDIM1:IDIM2),KTOP(IDIM1:IDIM2,LP1), 395 & KBTM(IDIM1:IDIM2,LP1) 396 DIMENSION CO21(IDIM1:IDIM2,LP1,LP1),CO2NBL(IDIM1:IDIM2,L) 397 DIMENSION CO2SP1(IDIM1:IDIM2,LP1),CO2SP2(IDIM1:IDIM2,LP1) 398 DIMENSION VAR1(IDIM1:IDIM2,L),VAR2(IDIM1:IDIM2,L), 399 & VAR3(IDIM1:IDIM2,L),VAR4(IDIM1:IDIM2,L) 400 DIMENSION CNTVAL(IDIM1:IDIM2,LP1) 401 DIMENSION HEATRA(IDIM1:IDIM2,L),GRNFLX(IDIM1:IDIM2), 402 & TOPFLX(IDIM1:IDIM2) 403 DIMENSION GXCTS(IDIM1:IDIM2),FLX1E1(IDIM1:IDIM2) 404 DIMENSION AVEPHI(IDIM1:IDIM2,LP1),EMISS(IDIM1:IDIM2,LP1), 405 & EMISSB(IDIM1:IDIM2,LP1) 406 C 407 DIMENSION TOTO3(IDIM1:IDIM2,LP1),TPHIO3(IDIM1:IDIM2,LP1), 408 & TOTPHI(IDIM1:IDIM2,LP1) 409 DIMENSION TOTVO2(IDIM1:IDIM2,LP1),EMX1(IDIM1:IDIM2), 410 & EMX2(IDIM1:IDIM2),EMPL(IDIM1:IDIM2,LLP1) 411 C 412 DIMENSION EXCTS(IDIM1:IDIM2,L),CTSO3(IDIM1:IDIM2,L), 413 & CTS(IDIM1:IDIM2,L),E1FLX(IDIM1:IDIM2,LP1) 414 DIMENSION CO2SP(IDIM1:IDIM2,LP1),TO3SPC(IDIM1:IDIM2,L), 415 & TO3SP(IDIM1:IDIM2,LP1) 416 DIMENSION OSS(IDIM1:IDIM2,LP1),CSS(IDIM1:IDIM2,LP1), 417 & SS1(IDIM1:IDIM2,LP1),SS2(IDIM1:IDIM2,LP1), 418 1 TC(IDIM1:IDIM2,LP1),DTC(IDIM1:IDIM2,LP1) 419 DIMENSION SORC(IDIM1:IDIM2,LP1,NBLY),CSOUR(IDIM1:IDIM2,LP1) 420 CCC 421 DIMENSION AVVO2(IDIM1:IDIM2,LP1),HEATEM(IDIM1:IDIM2,LP1), 422 1 OVER1D(IDIM1:IDIM2,LP1), Page 7 Source Listing FST88 2025-03-12 18:21 FST88.F 423 1 TO31D(IDIM1:IDIM2,LP1),CONT1D(IDIM1:IDIM2,LP1), 424 2 AVMO3(IDIM1:IDIM2,LP1),AVPHO3(IDIM1:IDIM2,LP1), 425 2 C(IDIM1:IDIM2,LLP1),C2(IDIM1:IDIM2,LLP1) 426 DIMENSION ITOP(IDIM1:IDIM2),IBOT(IDIM1:IDIM2), 427 & INDTC(IDIM1:IDIM2) 428 DIMENSION 429 4 DELPTC(IDIM1:IDIM2),PTOP(IDIM1:IDIM2),PBOT(IDIM1:IDIM2), 430 & FTOP(IDIM1:IDIM2), 431 5 FBOT(IDIM1:IDIM2) ,EMSPEC(IDIM1:IDIM2,2) 432 C---DIMENSION OF VARIABLES EQUIVALENCED TO THOSE IN VTEMP--- 433 DIMENSION VTMP3(IDIM1:IDIM2,LP1),DSORC(IDIM1:IDIM2,LP1) 434 DIMENSION ALP(IDIM1:IDIM2,LLP1),CSUB(IDIM1:IDIM2,LLP1), 435 & CSUB2(IDIM1:IDIM2,LLP1) 436 DIMENSION FAC1(IDIM1:IDIM2,LP1) 437 DIMENSION DELPR1(IDIM1:IDIM2,LP1),DELPR2(IDIM1:IDIM2,LP1) 438 DIMENSION EMISDG(IDIM1:IDIM2,LP1),CONTDG(IDIM1:IDIM2,LP1), 439 & TO3DG(IDIM1:IDIM2,LP1) 440 DIMENSION FLXNET(IDIM1:IDIM2,LP1) 441 DIMENSION IXO(IDIM1:IDIM2,LP1) 442 DIMENSION VSUM1(IDIM1:IDIM2,LP1) 443 DIMENSION FLXTHK(IDIM1:IDIM2,LP1) 444 DIMENSION Z1(IDIM1:IDIM2,LP1) 445 C---DIMENSION OF VARIABLES PASSED TO OTHER SUBROUTINES--- 446 C (AND NOT FOUND IN COMMON BLOCKS) 447 DIMENSION E1CTS1(IDIM1:IDIM2,LP1),E1CTS2(IDIM1:IDIM2,L) 448 DIMENSION E1CTW1(IDIM1:IDIM2,LP1),E1CTW2(IDIM1:IDIM2,L) 449 DIMENSION EMD(IDIM1:IDIM2,LLP1),TPL(IDIM1:IDIM2,LLP1) 450 C IT IS POSSIBLE TO EQUIVALENCE EMD,TPL TO THE ABOVE VARIABLES, 451 C AS THEY GET CALLED AT DIFFERENT TIMES 452 DIMENSION FXO(IDIM1:IDIM2,LP1),DT(IDIM1:IDIM2,LP1) 453 DIMENSION FXOE2(IDIM1:IDIM2,LP1),DTE2(IDIM1:IDIM2,LP1) 454 DIMENSION FXOSP(IDIM1:IDIM2,2),DTSP(IDIM1:IDIM2,2) 455 C 456 C DIMENSION OF LOCAL VARIABLES 457 DIMENSION RLOG(IDIM1:IDIM2,L),FLX(IDIM1:IDIM2,LP1) 458 DIMENSION TOTEVV(IDIM1:IDIM2,LP1),CNTTAU(IDIM1:IDIM2,LP1) 459 C 460 EQUIVALENCE (ALP,C,CSUB),(CSUB2,C2) 461 EQUIVALENCE (FAC1,DSORC,OVER1D,DELPR2,FLXNET) 462 EQUIVALENCE (DELPR1,HEATEM) 463 EQUIVALENCE (IXO,AVVO2,FLXTHK,TO3DG) 464 EQUIVALENCE (Z1,AVMO3,CONTDG) 465 EQUIVALENCE (EMISDG,VSUM1,AVPHO3) 466 EQUIVALENCE (EMD(IDIM1,1),E1CTS1(IDIM1,1)), 467 & (EMD(IDIM1,LP2),E1CTS2(IDIM1,1)) 468 EQUIVALENCE (TPL(IDIM1,1),E1CTW1(IDIM1,1)), 469 & (TPL(IDIM1,LP2),E1CTW2(IDIM1,1)) 470 c 471 C 472 C FIRST SECTION IS TABLE LOOKUP FOR SOURCE FUNCTION AND 473 C DERIVATIVE (B AND DB/DT).ALSO,THE NLTE CO2 SOURCE FUNCTION 474 C IS OBTAINED 475 C 476 C---IN CALCS. BELOW, DECREMENTING THE INDEX BY 9 477 C ACCOUNTS FOR THE TABLES BEGINNING AT T=100K. 478 C AT T=100K. 479 DO 101 K=1,LP1 Page 8 Source Listing FST88 2025-03-12 18:21 FST88.F 480 DO 101 I=MYIS,MYIE 481 C---TEMP. INDICES FOR E1,SOURCE 482 VTMP3(I,K)=AINT(TEMP(I,K)*HP1) 483 FXO(I,K)=VTMP3(I,K)-9. 484 DT(I,K)=TEMP(I,K)-TEN*VTMP3(I,K) 485 C---INTEGER INDEX FOR SOURCE (USED IMMEDIATELY) 486 C wne IXO(I,K)=FXO(I,K) 487 IXO(I,K)=max(FXO(I,K), 1.0) 488 101 CONTINUE 489 DO 103 k=1,L 490 DO 103 I=MYIS,MYIE 491 C---TEMP. INDICES FOR E2 (KP=1 LAYER NOT USED IN FLUX CALCULATIONS) 492 VTMP3(I,K)=AINT(T(I,K+1)*HP1) 493 FXOE2(I,K)=VTMP3(I,K)-9. 494 DTE2(I,K)=T(I,K+1)-TEN*VTMP3(I,K) 495 103 CONTINUE 496 C---SPECIAL CASE TO HANDLE KP=LP1 LAYER AND SPECIAL E2 CALCS. 497 DO 105 I=MYIS,MYIE 498 FXOE2(I,LP1)=FXO(I,L) 499 DTE2(I,LP1)=DT(I,L) 500 FXOSP(I,1)=FXOE2(I,LM1) 501 FXOSP(I,2)=FXO(I,LM1) 502 DTSP(I,1)=DTE2(I,LM1) 503 DTSP(I,2)=DT(I,LM1) 504 105 CONTINUE 505 C 506 C---SOURCE FUNCTION FOR COMBINED BAND 1 507 DO 4114 I=MYIS,MYIE 508 DO 4114 K=1,LP1 509 VTMP3(I,K)=SOURCE(IXO(I,K),1) 510 DSORC(I,K)=DSRCE(IXO(I,K),1) 511 4114 CONTINUE 512 DO 4112 K=1,LP1 513 DO 4112 I=MYIS,MYIE 514 SORC(I,K,1)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 515 4112 CONTINUE 516 C---SOURCE FUNCTION FOR COMBINED BAND 2 517 DO 4214 I=MYIS,MYIE 518 DO 4214 K=1,LP1 519 VTMP3(I,K)=SOURCE(IXO(I,K),2) 520 DSORC(I,K)=DSRCE(IXO(I,K),2) 521 4214 CONTINUE 522 DO 4212 K=1,LP1 523 DO 4212 I=MYIS,MYIE 524 SORC(I,K,2)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 525 4212 CONTINUE 526 C---SOURCE FUNCTION FOR COMBINED BAND 3 527 DO 4314 I=MYIS,MYIE 528 DO 4314 K=1,LP1 529 VTMP3(I,K)=SOURCE(IXO(I,K),3) 530 DSORC(I,K)=DSRCE(IXO(I,K),3) 531 4314 CONTINUE 532 DO 4312 K=1,LP1 533 DO 4312 I=MYIS,MYIE 534 SORC(I,K,3)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 535 4312 CONTINUE 536 C---SOURCE FUNCTION FOR COMBINED BAND 4 Page 9 Source Listing FST88 2025-03-12 18:21 FST88.F 537 DO 4414 I=MYIS,MYIE 538 DO 4414 K=1,LP1 539 VTMP3(I,K)=SOURCE(IXO(I,K),4) 540 DSORC(I,K)=DSRCE(IXO(I,K),4) 541 4414 CONTINUE 542 DO 4412 K=1,LP1 543 DO 4412 I=MYIS,MYIE 544 SORC(I,K,4)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 545 4412 CONTINUE 546 C---SOURCE FUNCTION FOR COMBINED BAND 5 547 DO 4514 I=MYIS,MYIE 548 DO 4514 K=1,LP1 549 VTMP3(I,K)=SOURCE(IXO(I,K),5) 550 DSORC(I,K)=DSRCE(IXO(I,K),5) 551 4514 CONTINUE 552 DO 4512 K=1,LP1 553 DO 4512 I=MYIS,MYIE 554 SORC(I,K,5)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 555 4512 CONTINUE 556 C---SOURCE FUNCTION FOR COMBINED BAND 6 557 DO 4614 I=MYIS,MYIE 558 DO 4614 K=1,LP1 559 VTMP3(I,K)=SOURCE(IXO(I,K),6) 560 DSORC(I,K)=DSRCE(IXO(I,K),6) 561 4614 CONTINUE 562 DO 4612 K=1,LP1 563 DO 4612 I=MYIS,MYIE 564 SORC(I,K,6)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 565 4612 CONTINUE 566 C---SOURCE FUNCTION FOR COMBINED BAND 7 567 DO 4714 I=MYIS,MYIE 568 DO 4714 K=1,LP1 569 VTMP3(I,K)=SOURCE(IXO(I,K),7) 570 DSORC(I,K)=DSRCE(IXO(I,K),7) 571 4714 CONTINUE 572 DO 4712 K=1,LP1 573 DO 4712 I=MYIS,MYIE 574 SORC(I,K,7)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 575 4712 CONTINUE 576 C---SOURCE FUNCTION FOR COMBINED BAND 8 577 DO 4814 I=MYIS,MYIE 578 DO 4814 K=1,LP1 579 VTMP3(I,K)=SOURCE(IXO(I,K),8) 580 DSORC(I,K)=DSRCE(IXO(I,K),8) 581 4814 CONTINUE 582 DO 4812 K=1,LP1 583 DO 4812 I=MYIS,MYIE 584 SORC(I,K,8)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 585 4812 CONTINUE 586 C---SOURCE FUNCTION FOR BAND 9 (560-670 CM-1) 587 DO 4914 I=MYIS,MYIE 588 DO 4914 K=1,LP1 589 VTMP3(I,K)=SOURCE(IXO(I,K),9) 590 DSORC(I,K)=DSRCE(IXO(I,K),9) 591 4914 CONTINUE 592 DO 4912 K=1,LP1 593 DO 4912 I=MYIS,MYIE Page 10 Source Listing FST88 2025-03-12 18:21 FST88.F 594 SORC(I,K,9)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 595 4912 CONTINUE 596 C---SOURCE FUNCTION FOR BAND 10 (670-800 CM-1) 597 DO 5014 I=MYIS,MYIE 598 DO 5014 K=1,LP1 599 VTMP3(I,K)=SOURCE(IXO(I,K),10) 600 DSORC(I,K)=DSRCE(IXO(I,K),10) 601 5014 CONTINUE 602 DO 5012 K=1,LP1 603 DO 5012 I=MYIS,MYIE 604 SORC(I,K,10)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 605 5012 CONTINUE 606 C---SOURCE FUNCTION FOR BAND 11 (800-900 CM-1) 607 DO 5114 I=MYIS,MYIE 608 DO 5114 K=1,LP1 609 VTMP3(I,K)=SOURCE(IXO(I,K),11) 610 DSORC(I,K)=DSRCE(IXO(I,K),11) 611 5114 CONTINUE 612 DO 5112 K=1,LP1 613 DO 5112 I=MYIS,MYIE 614 SORC(I,K,11)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 615 5112 CONTINUE 616 C---SOURCE FUNCTION FOR BAND 12 (900-990 CM-1) 617 DO 5214 I=MYIS,MYIE 618 DO 5214 K=1,LP1 619 VTMP3(I,K)=SOURCE(IXO(I,K),12) 620 DSORC(I,K)=DSRCE(IXO(I,K),12) 621 5214 CONTINUE 622 DO 5212 K=1,LP1 623 DO 5212 I=MYIS,MYIE 624 SORC(I,K,12)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 625 5212 CONTINUE 626 C---SOURCE FUNCTION FOR BAND 13 (990-1070 CM-1) 627 DO 5314 I=MYIS,MYIE 628 DO 5314 K=1,LP1 629 VTMP3(I,K)=SOURCE(IXO(I,K),13) 630 DSORC(I,K)=DSRCE(IXO(I,K),13) 631 5314 CONTINUE 632 DO 5312 K=1,LP1 633 DO 5312 I=MYIS,MYIE 634 SORC(I,K,13)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 635 5312 CONTINUE 636 C---SOURCE FUNCTION FOR BAND 14 (1070-1200 CM-1) 637 DO 5414 I=MYIS,MYIE 638 DO 5414 K=1,LP1 639 VTMP3(I,K)=SOURCE(IXO(I,K),14) 640 DSORC(I,K)=DSRCE(IXO(I,K),14) 641 5414 CONTINUE 642 DO 5412 K=1,LP1 643 DO 5412 I=MYIS,MYIE 644 SORC(I,K,14)=VTMP3(I,K)+DT(I,K)*DSORC(I,K) 645 5412 CONTINUE 646 C 647 C THE FOLLOWING SUBROUTINE OBTAINS NLTE SOURCE FUNCTION FOR CO2 648 C 649 C 650 C CALL NLTE Page 11 Source Listing FST88 2025-03-12 18:21 FST88.F 651 C 652 C 653 C---OBTAIN SPECIAL SOURCE FUNCTIONS FOR THE 15 UM BAND (CSOUR) 654 C AND THE WINDOW REGION (SS1) 655 DO 131 K=1,LP1 656 DO 131 I=MYIS,MYIE 657 SS1(I,K)=SORC(I,K,11)+SORC(I,K,12)+SORC(I,K,14) 658 131 CONTINUE 659 DO 143 K=1,LP1 660 DO 143 I=MYIS,MYIE 661 CSOUR(I,K)=SORC(I,K,9)+SORC(I,K,10) 662 143 CONTINUE 663 C 664 C---COMPUTE TEMP**4 (TC) AND VERTICAL TEMPERATURE DIFFERENCES 665 C (OSS,CSS,SS2,DTC). ALL THESE WILL BE USED LATER IN FLUX COMPUTA- 666 C TIONS. 667 C 668 DO 901 K=1,LP1 669 DO 901 I=MYIS,MYIE 670 TC(I,K)=(TEMP(I,K)*TEMP(I,K))**2 671 c if(mype.eq.13.and.i.eq.40) then 672 c print*,'i,k,temp(i,k)=',i,k,temp(i,k) 673 c endif 674 901 CONTINUE 675 DO 903 K=1,L 676 DO 903 I=MYIS,MYIE 677 OSS(I,K+1)=SORC(I,K+1,13)-SORC(I,K,13) 678 CSS(I,K+1)=CSOUR(I,K+1)-CSOUR(I,K) 679 DTC(I,K+1)=TC(I,K+1)-TC(I,K) 680 SS2(I,K+1)=SS1(I,K+1)-SS1(I,K) 681 903 CONTINUE 682 C 683 C 684 C---THE FOLLOWIMG IS A DRASTIC REWRITE OF THE RADIATION CODE TO 685 C (LARGELY) ELIMINATE THREE-DIMENSIONAL ARRAYS. THE CODE WORKS 686 C ON THE FOLLOWING PRINCIPLES: 687 C 688 C LET K = FIXED FLUX LEVEL, KP = VARYING FLUX LEVEL 689 C THEN FLUX(K)=SUM OVER KP : (DELTAB(KP)*TAU(KP,K)) 690 C OVER ALL KP'S, FROM 1 TO LP1. 691 C 692 C WE CAN BREAK DOWN THE CALCULATIONS FOR ALL K'S AS FOLLOWS: 693 C 694 C FOR ALL K'S K=1 TO LP1: 695 C FLUX(K)=SUM OVER KP : (DELTAB(KP)*TAU(KP,K)) (1) 696 C OVER ALL KP'S, FROM K+1 TO LP1 697 C AND 698 C FOR KP FROM K+1 TO LP1: 699 C FLUX(KP) = DELTAB(K)*TAU(K,KP) (2) 700 C 701 C NOW IF TAU(K,KP)=TAU(KP,K) (SYMMETRICAL ARRAYS) 702 C WE CAN COMPUTE A 1-DIMENSIONAL ARRAY TAU1D(KP) FROM 703 C K+1 TO LP1, EACH TIME K IS INCREMENTED. 704 C EQUATIONS (1) AND (2) THEN BECOME: 705 C 706 C TAU1D(KP) = (VALUES FOR TAU(KP,K) AT THE PARTICULAR K) 707 C FLUX(K) = SUM OVER KP : (DELTAB(KP)*TAU1D(KP)) (3) Page 12 Source Listing FST88 2025-03-12 18:21 FST88.F 708 C FLUX(KP) = DELTAB(K)*TAU1D(KP) (4) 709 C 710 C THE TERMS FOR TAU (K,K) AND OTHER SPECIAL TERMS (FOR 711 C NEARBY LAYERS) MUST, OF COURSE, BE HANDLED SEPARATELY, AND 712 C WITH CARE. 713 C 714 C COMPUTE "UPPER TRIANGLE" TRANSMISSION FUNCTIONS FOR 715 C THE 9.6 UM BAND (TO3SP) AND THE 15 UM BAND (OVER1D). ALSO, 716 C THE 717 C STAGE 1...COMPUTE O3 ,OVER TRANSMISSION FCTNS AND AVEPHI 718 C---DO K=1 CALCULATION (FROM FLUX LAYER KK TO THE TOP) SEPARATELY 719 C AS VECTORIZATION IS IMPROVED,AND OZONE CTS TRANSMISSIVITY 720 C MAY BE EXTRACTED HERE. 721 DO 3021 K=1,L 722 DO 3021 I=MYIS,MYIE 723 AVEPHI(I,K)=TOTPHI(I,K+1) 724 3021 CONTINUE 725 C---IN ORDER TO PROPERLY EVALUATE EMISS INTEGRATED OVER THE (LP1) 726 C LAYER, A SPECIAL EVALUATION OF EMISS IS DONE. THIS REQUIRES 727 C A SPECIAL COMPUTATION OF AVEPHI, AND IT IS STORED IN THE 728 C (OTHERWISE VACANT) LP1'TH POSITION 729 C 730 DO 803 I=MYIS,MYIE 731 AVEPHI(I,LP1)=AVEPHI(I,LM1)+EMX1(I) 732 803 CONTINUE 733 C COMPUTE FLUXES FOR K=1 734 CALL E1E290(E1CTS1,E1CTS2,E1FLX,E1CTW1,E1CTW2,EMISS, 735 1 FXO,DT,FXOE2,DTE2,AVEPHI,TEMP,T) 736 DO 302 K=1,L 737 DO 302 I=MYIS,MYIE 738 FAC1(I,K)=BO3RND(2)*TPHIO3(I,K+1)/TOTO3(I,K+1) 739 TO3SPC(I,K)=HAF*(FAC1(I,K)* 740 1 (SQRT(ONE+(FOUR*AO3RND(2)*TOTO3(I,K+1))/FAC1(I,K))-ONE)) 741 C FOR K=1, TO3SP IS USED INSTEAD OF TO31D (THEY ARE EQUAL IN THIS 742 C CASE); TO3SP IS PASSED TO SPA90, WHILE TO31D IS A WORK-ARRAY. 743 TO3SP(I,K)=EXP(HM1EZ*(TO3SPC(I,K)+SKO3R*TOTVO2(I,K+1))) 744 OVER1D(I,K)=EXP(HM1EZ*(SQRT(AB15WD*TOTPHI(I,K+1))+ 745 1 SKC1R*TOTVO2(I,K+1))) 746 C---BECAUSE ALL CONTINUUM TRANSMISSIVITIES ARE OBTAINED FROM THE 747 C 2-D QUANTITY CNTTAU (AND ITS RECIPROCAL TOTEVV) WE STORE BOTH 748 C OF THESE HERE. FOR K=1, CONT1D EQUALS CNTTAU 749 CNTTAU(I,K)=EXP(HM1EZ*TOTVO2(I,K+1)) 750 TOTEVV(I,K)=1./CNTTAU(I,K) 751 302 CONTINUE 752 DO 3022 K=1,L 753 DO 3022 I=MYIS,MYIE 754 CO2SP(I,K+1)=OVER1D(I,K)*CO21(I,1,K+1) 755 3022 CONTINUE 756 DO 3023 K=1,L 757 DO 3023 I=MYIS,MYIE 758 CO21(I,K+1,1)=CO21(I,K+1,1)*OVER1D(I,K) 759 3023 CONTINUE 760 C---RLOG IS THE NBL AMOUNT FOR THE 15 UM BAND CALCULATION 761 DO 1808 I=MYIS,MYIE 762 RLOG(I,1)=OVER1D(I,1)*CO2NBL(I,1) 763 1808 CONTINUE 764 C---THE TERMS WHEN KP=1 FOR ALL K ARE THE PHOTON EXCHANGE WITH Page 13 Source Listing FST88 2025-03-12 18:21 FST88.F 765 C THE TOP OF THE ATMOSPHERE, AND ARE OBTAINED DIFFERENTLY THAN 766 C THE OTHER CALCULATIONS 767 DO 305 K=2,LP1 768 DO 305 I=MYIS,MYIE 769 FLX(I,K)= (TC(I,1)*E1FLX(I,K) 770 1 +SS1(I,1)*CNTTAU(I,K-1) 771 2 +SORC(I,1,13)*TO3SP(I,K-1) 772 3 +CSOUR(I,1)*CO2SP(I,K)) 773 4 *CLDFAC(I,1,K) 774 305 CONTINUE 775 DO 307 I=MYIS,MYIE 776 FLX(I,1)= TC(I,1)*E1FLX(I,1)+SS1(I,1)+SORC(I,1,13) 777 1 +CSOUR(I,1) 778 307 CONTINUE 779 C---THE KP TERMS FOR K=1... 780 DO 303 KP=2,LP1 781 DO 303 I=MYIS,MYIE 782 FLX(I,1)=FLX(I,1)+(OSS(I,KP)*TO3SP(I,KP-1) 783 1 +SS2(I,KP)*CNTTAU(I,KP-1) 784 2 +CSS(I,KP)*CO21(I,KP,1) 785 3 +DTC(I,KP)*EMISS(I,KP-1))*CLDFAC(I,KP,1) 786 303 CONTINUE 787 C SUBROUTINE SPA88 IS CALLED TO OBTAIN EXACT CTS FOR WATER 788 C CO2 AND O3, AND APPROXIMATE CTS CO2 AND O3 CALCULATIONS. 789 C 790 CALL SPA88(EXCTS,CTSO3,GXCTS,SORC,CSOUR, 791 1 CLDFAC,TEMP,PRESS,VAR1,VAR2, 792 2 P,DELP,DELP2,TOTVO2,TO3SP,TO3SPC, 793 3 CO2SP1,CO2SP2,CO2SP) 794 C 795 C THIS SECTION COMPUTES THE EMISSIVITY CTS HEATING RATES FOR 2 796 C EMISSIVITY BANDS: THE 0-160,1200-2200 CM-1 BAND AND THE 800- 797 C 990,1070-1200 CM-1 BAND. THE REMAINING CTS COMTRIBUTIONS ARE 798 C CONTAINED IN CTSO3, COMPUTED IN SPA88. 799 C 800 DO 998 I=MYIS,MYIE 801 VTMP3(I,1)=1. 802 998 CONTINUE 803 DO 999 K=1,L 804 DO 999 I=MYIS,MYIE 805 VTMP3(I,K+1)=CNTTAU(I,K)*CLDFAC(I,K+1,1) 806 999 CONTINUE 807 DO 1001 K=1,L 808 DO 1001 I=MYIS,MYIE 809 CTS(I,K)=RADCON*DELP(I,K)*(TC(I,K)* 810 1 (E1CTW2(I,K)*CLDFAC(I,K+1,1)-E1CTW1(I,K)*CLDFAC(I,K,1)) + 811 2 SS1(I,K)*(VTMP3(I,K+1)-VTMP3(I,K))) 812 1001 CONTINUE 813 C 814 DO 1011 K=1,L 815 DO 1011 I=MYIS,MYIE 816 VTMP3(I,K)=TC(I,K)*(CLDFAC(I,K,1)*(E1CTS1(I,K)-E1CTW1(I,K)) - 817 1 CLDFAC(I,K+1,1)*(E1CTS2(I,K)-E1CTW2(I,K))) 818 1011 CONTINUE 819 DO 1012 I=MYIS,MYIE 820 FLX1E1(I)=TC(I,LP1)*CLDFAC(I,LP1,1)* 821 1 (E1CTS1(I,LP1)-E1CTW1(I,LP1)) Page 14 Source Listing FST88 2025-03-12 18:21 FST88.F 822 c if(mype.eq.13.and.i.eq.40) then 823 c print*,'i,lp1=',i,lp1 824 c print*,'tc(i,lp1)=',tc(i,lp1) 825 c print*,'cldfac(i,lp1,1)=',cldfac(i,lp1,1) 826 c print*,'e1cts1(i,lp1)=',e1cts1(i,lp1) 827 c print*,'e1ctw1(i,lp1)=',e1ctw1(i,lp1) 828 c endif 829 1012 CONTINUE 830 DO 1014 K=1,L 831 DO 1013 I=MYIS,MYIE 832 FLX1E1(I)=FLX1E1(I)+VTMP3(I,K) 833 1013 CONTINUE 834 1014 CONTINUE 835 C 836 C---NOW REPEAT FLUX CALCULATIONS FOR THE K=2..LM1 CASES. 837 C CALCULATIONS FOR FLUX LEVEL L AND LP1 ARE DONE SEPARATELY, AS ALL 838 C EMISSIVITY AND CO2 CALCULATIONS ARE SPECIAL CASES OR NEARBY LAYERS. 839 C 840 DO 321 K=2,LM1 841 KLEN=K 842 C 843 DO 3218 KK=1,LP1-K 844 DO 3218 I=MYIS,MYIE 845 AVEPHI(I,KK+K-1)=TOTPHI(I,KK+K)-TOTPHI(I,K) 846 3218 CONTINUE 847 DO 1803 I=MYIS,MYIE 848 AVEPHI(I,LP1)=AVEPHI(I,LM1)+EMX1(I) 849 1803 CONTINUE 850 C---COMPUTE EMISSIVITY FLUXES (E2) FOR THIS CASE. NOTE THAT 851 C WE HAVE OMITTED THE NEARBY LATER CASE (EMISS(I,K,K)) AS WELL 852 C AS ALL CASES WITH K=L OR LP1. BUT THESE CASES HAVE ALWAYS 853 C BEEN HANDLED AS SPECIAL CASES, SO WE MAY AS WELL COMPUTE 854 C THEIR FLUXES SEPARASTELY. 855 C 856 CALL E290(EMISSB,EMISS,AVEPHI,KLEN,FXOE2,DTE2) 857 DO 322 KK=1,LP1-K 858 DO 322 I=MYIS,MYIE 859 AVMO3(I,KK+K-1)=TOTO3(I,KK+K)-TOTO3(I,K) 860 AVPHO3(I,KK+K-1)=TPHIO3(I,KK+K)-TPHIO3(I,K) 861 AVVO2(I,KK+K-1)=TOTVO2(I,KK+K)-TOTVO2(I,K) 862 CONT1D(I,KK+K-1)=CNTTAU(I,KK+K-1)*TOTEVV(I,K-1) 863 322 CONTINUE 864 C 865 DO 3221 KK=1,LP1-K 866 DO 3221 I=MYIS,MYIE 867 FAC1(I,K+KK-1)=BO3RND(2)*AVPHO3(I,K+KK-1)/AVMO3(I,K+KK-1) 868 VTMP3(I,K+KK-1)=HAF*(FAC1(I,K+KK-1)* 869 1 (SQRT(ONE+(FOUR*AO3RND(2)*AVMO3(I,K+KK-1))/ 870 2 FAC1(I,K+KK-1))-ONE)) 871 TO31D(I,K+KK-1)=EXP(HM1EZ*(VTMP3(I,K+KK-1) 872 1 +SKO3R*AVVO2(I,K+KK-1))) 873 OVER1D(I,K+KK-1)=EXP(HM1EZ*(SQRT(AB15WD*AVEPHI(I,K+KK-1))+ 874 1 SKC1R*AVVO2(I,K+KK-1))) 875 CO21(I,K+KK,K)=OVER1D(I,K+KK-1)*CO21(I,K+KK,K) 876 3221 CONTINUE 877 DO 3223 KP=K+1,LP1 878 DO 3223 I=MYIS,MYIE Page 15 Source Listing FST88 2025-03-12 18:21 FST88.F 879 CO21(I,K,KP)=OVER1D(I,KP-1)*CO21(I,K,KP) 880 3223 CONTINUE 881 C---RLOG IS THE NBL AMOUNT FOR THE 15 UM BAND CALCULATION 882 DO 1804 I=MYIS,MYIE 883 RLOG(I,K)=OVER1D(I,K)*CO2NBL(I,K) 884 1804 CONTINUE 885 C---THE KP TERMS FOR ARBIRRARY K.. 886 DO 3423 KP=K+1,LP1 887 DO 3423 I=MYIS,MYIE 888 FLX(I,K)=FLX(I,K)+(OSS(I,KP)*TO31D(I,KP-1) 889 1 +SS2(I,KP)*CONT1D(I,KP-1) 890 2 +CSS(I,KP)*CO21(I,KP,K) 891 3 +DTC(I,KP)*EMISS(I,KP-1))*CLDFAC(I,KP,K) 892 3423 CONTINUE 893 DO 3425 KP=K+1,LP1 894 DO 3425 I=MYIS,MYIE 895 FLX(I,KP)=FLX(I,KP)+(OSS(I,K)*TO31D(I,KP-1) 896 1 +SS2(I,K)*CONT1D(I,KP-1) 897 2 +CSS(I,K)*CO21(I,K,KP) 898 3 +DTC(I,K)*EMISSB(I,KP-1))*CLDFAC(I,K,KP) 899 3425 CONTINUE 900 321 CONTINUE 901 C 902 C NOW DO K=L CASE. SINCE THE KP LOOP IS LENGTH 1, MANY SIMPLIFI- 903 C CATIONS OCCUR. ALSO, THE CO2 QUANTITIES (AS WELL AS THE EMISS 904 C QUANTITIES) ARE COMPUTED IN THE NBL SEDCTION; THEREFORE, WE WANT 905 C ONLY OVER,TO3 AND CONT1D (OVER(I,L),TO31D(I,L) AND CONT1D(I,L) 906 C ACCORDING TO THE NOTATION. THUS NO CALL IS MADE TO THE E290 907 C SUBROUTINE. 908 C THE THIRD SECTION CALCULATES BOUNDARY LAYER AND NEARBY LAYER 909 C CORRECTIONS TO THE TRANSMISSION FUNCTIONS OBTAINED ABOVE. METHODS 910 C ARE GIVEN IN REF. (4). 911 C THE FOLLOWING RATIOS ARE USED IN VARIOUS NBL CALCULATIONS: 912 C 913 C THE REMAINING CALCULATIONS ARE FOR : 914 C 1) THE (K,K) TERMS, K=2,LM1; 915 C 2) THE (L,L) TERM 916 C 3) THE (L,LP1) TERM 917 C 4) THE (LP1,L) TERM 918 C 5) THE (LP1,LP1) TERM. 919 C EACH IS UNIQUELY HANDLED; DIFFERENT FLUX TERMS ARE COMPUTED 920 C DIFFERENTLY 921 C 922 C 923 C FOURTH SECTION OBTAINS WATER TRANSMISSION FUNCTIONS 924 C USED IN Q(APPROX) CALCULATIONS AND ALSO MAKES NBL CORRECTIONS: 925 C 1) EMISS (I,J) IS THE TRANSMISSION FUNCTION MATRIX OBTAINED 926 C BY CALLING SUBROUTINE E1E288; 927 C 2) "NEARBY LAYER" CORRECTIONS (EMISS(I,I)) ARE OBTAINED 928 C USING SUBROUTINE E3V88; 929 C 3) SPECIAL VALUES AT THE SURFACE (EMISS(L,LP1),EMISS(LP1,L), 930 C EMISS(LP1,LP1)) ARE CALCULATED. 931 C 932 C 933 C OBTAIN ARGUMENTS FOR E1E288 AND E3V88: 934 C 935 DO 821 I=MYIS,MYIE Page 16 Source Listing FST88 2025-03-12 18:21 FST88.F 936 TPL(I,1)=TEMP(I,L) 937 TPL(I,LP1)=HAF*(T(I,LP1)+TEMP(I,L)) 938 TPL(I,LLP1)=HAF*(T(I,L)+TEMP(I,L)) 939 821 CONTINUE 940 DO 823 K=2,L 941 DO 823 I=MYIS,MYIE 942 TPL(I,K)=T(I,K) 943 TPL(I,K+L)=T(I,K) 944 823 CONTINUE 945 C 946 C---E2 FUNCTIONS ARE REQUIRED IN THE NBL CALCULATIONS FOR 2 CASES, 947 C DENOTED (IN OLD CODE) AS (L,LP1) AND (LP1,LP1) 948 DO 833 I=MYIS,MYIE 949 AVEPHI(I,1)=VAR2(I,L) 950 AVEPHI(I,2)=VAR2(I,L)+EMPL(I,L) 951 833 CONTINUE 952 CALL E2SPEC(EMISS,AVEPHI,FXOSP,DTSP) 953 C 954 C CALL E3V88 FOR NBL H2O TRANSMISSIVITIES 955 CALL E3V88(EMD,TPL,EMPL) 956 C 957 C COMPUTE NEARBY LAYER AND SPECIAL-CASE TRANSMISSIVITIES FOR EMISS 958 C USING METHODS FOR H2O GIVEN IN REF. (4) 959 DO 851 K=2,L 960 DO 851 I=MYIS,MYIE 961 EMISDG(I,K)=EMD(I,K+L)+EMD(I,K) 962 851 CONTINUE 963 C 964 C NOTE THAT EMX1/2 (PRESSURE SCALED PATHS) ARE NOW COMPUTED IN 965 C LWR88 966 DO 861 I=MYIS,MYIE 967 EMSPEC(I,1)=(EMD(I,1)*EMPL(I,1)-EMD(I,LP1)*EMPL(I,LP1))/ 968 1 EMX1(I) + QUARTR*(EMISS(I,1)+EMISS(I,2)) 969 EMISDG(I,LP1)=TWO*EMD(I,LP1) 970 EMSPEC(I,2)=TWO*(EMD(I,1)*EMPL(I,1)-EMD(I,LLP1)*EMPL(I,LLP1))/ 971 * EMX2(I) 972 861 CONTINUE 973 DO 331 I=MYIS,MYIE 974 FAC1(I,L)=BO3RND(2)*VAR4(I,L)/VAR3(I,L) 975 VTMP3(I,L)=HAF*(FAC1(I,L)* 976 1 (SQRT(ONE+(FOUR*AO3RND(2)*VAR3(I,L))/FAC1(I,L))-ONE)) 977 TO31D(I,L)=EXP(HM1EZ*(VTMP3(I,L)+SKO3R*CNTVAL(I,L))) 978 OVER1D(I,L)=EXP(HM1EZ*(SQRT(AB15WD*VAR2(I,L))+ 979 1 SKC1R*CNTVAL(I,L))) 980 CONT1D(I,L)=CNTTAU(I,L)*TOTEVV(I,LM1) 981 RLOG(I,L)=OVER1D(I,L)*CO2NBL(I,L) 982 331 CONTINUE 983 DO 618 K=1,L 984 DO 618 I=MYIS,MYIE 985 RLOG(I,K)=LOG(RLOG(I,K)) 986 618 CONTINUE 987 DO 601 K=1,LM1 988 DO 601 I=MYIS,MYIE 989 DELPR1(I,K+1)=DELP(I,K+1)*(PRESS(I,K+1)-P(I,K+1)) 990 ALP(I,LP1+K-1)=-SQRT(DELPR1(I,K+1))*RLOG(I,K+1) 991 601 CONTINUE 992 DO 603 K=1,L Page 17 Source Listing FST88 2025-03-12 18:21 FST88.F 993 DO 603 I=MYIS,MYIE 994 DELPR2(I,K+1)=DELP(I,K)*(P(I,K+1)-PRESS(I,K)) 995 ALP(I,K)=-SQRT(DELPR2(I,K+1))*RLOG(I,K) 996 603 CONTINUE 997 DO 625 I=MYIS,MYIE 998 ALP(I,LL)=-RLOG(I,L) 999 ALP(I,LLP1)=-RLOG(I,L)*SQRT(DELP(I,L)*(P(I,LP1)-PRESS(I,LM1))) 1000 625 CONTINUE 1001 C THE FIRST COMPUTATION IS FOR THE 15 UM BAND,WITH THE 1002 C FOR THE COMBINED H2O AND CO2 TRANSMISSION FUNCTION. 1003 C 1004 C PERFORM NBL COMPUTATIONS FOR THE 15 UM BAND 1005 C***THE STATEMENT FUNCTION SF IN PREV. VERSIONS IS NOW EXPLICITLY 1006 C EVALUATED. 1007 DO 631 K=1,LLP1 1008 DO 631 I=MYIS,MYIE 1009 C(I,K)=ALP(I,K)*(HMP66667+ALP(I,K)*(QUARTR+ALP(I,K)*HM6666M2)) 1010 631 CONTINUE 1011 DO 641 I=MYIS,MYIE 1012 CO21(I,LP1,LP1)=ONE+C(I,L) 1013 CO21(I,LP1,L)=ONE+(DELP2(I,L)*C(I,LL)-(PRESS(I,L)-P(I,L))* 1014 1 C(I,LLM1))/(P(I,LP1)-PRESS(I,L)) 1015 CO21(I,L,LP1)=ONE+((P(I,LP1)-PRESS(I,LM1))*C(I,LLP1)- 1016 1 (P(I,LP1)-PRESS(I,L))*C(I,L))/(PRESS(I,L)-PRESS(I,LM1)) 1017 641 CONTINUE 1018 DO 643 K=2,L 1019 DO 643 I=MYIS,MYIE 1020 CO21(I,K,K)=ONE+HAF*(C(I,LM1+K)+C(I,K-1)) 1021 643 CONTINUE 1022 C 1023 C COMPUTE NEARBY-LAYER TRANSMISSIVITIES FOR THE O3 BAND AND FOR THE 1024 C ONE-BAND CONTINUUM BAND (TO3 AND EMISS2). THE SF2 FUNCTION IS 1025 C USED. THE METHOD IS THE SAME AS DESCRIBED FOR CO2 IN REF (4). 1026 DO 651 K=1,LM1 1027 DO 651 I=MYIS,MYIE 1028 CSUB(I,K+1)=CNTVAL(I,K+1)*DELPR1(I,K+1) 1029 CSUB(I,LP1+K-1)=CNTVAL(I,K)*DELPR2(I,K+1) 1030 651 CONTINUE 1031 C---THE SF2 FUNCTION IN PREV. VERSIONS IS NOW EXPLICITLY EVALUATED 1032 DO 655 K=1,LLM2 1033 DO 655 I=MYIS,MYIE 1034 CSUB2(I,K+1)=SKO3R*CSUB(I,K+1) 1035 C(I,K+1)=CSUB(I,K+1)*(HMP5+CSUB(I,K+1)* 1036 1 (HP166666-CSUB(I,K+1)*H41666M2)) 1037 C2(I,K+1)=CSUB2(I,K+1)*(HMP5+CSUB2(I,K+1)* 1038 1 (HP166666-CSUB2(I,K+1)*H41666M2)) 1039 655 CONTINUE 1040 DO 661 I=MYIS,MYIE 1041 CONTDG(I,LP1)=1.+C(I,LLM1) 1042 TO3DG(I,LP1)=1.+C2(I,LLM1) 1043 661 CONTINUE 1044 DO 663 K=2,L 1045 DO 663 I=MYIS,MYIE 1046 CONTDG(I,K)=ONE+HAF*(C(I,K)+C(I,LM1+K)) 1047 TO3DG(I,K)=ONE+HAF*(C2(I,K)+C2(I,LM1+K)) 1048 663 CONTINUE 1049 C---NOW OBTAIN FLUXES Page 18 Source Listing FST88 2025-03-12 18:21 FST88.F 1050 C 1051 C FOR THE DIAGONAL TERMS... 1052 DO 871 K=2,LP1 1053 DO 871 I=MYIS,MYIE 1054 FLX(I,K)=FLX(I,K)+(DTC(I,K)*EMISDG(I,K) 1055 1 +SS2(I,K)*CONTDG(I,K) 1056 2 +OSS(I,K)*TO3DG(I,K) 1057 3 +CSS(I,K)*CO21(I,K,K))*CLDFAC(I,K,K) 1058 871 CONTINUE 1059 C FOR THE TWO OFF-DIAGONAL TERMS... 1060 DO 873 I=MYIS,MYIE 1061 FLX(I,L)=FLX(I,L)+(CSS(I,LP1)*CO21(I,LP1,L) 1062 1 +DTC(I,LP1)*EMSPEC(I,2) 1063 2 +OSS(I,LP1)*TO31D(I,L) 1064 3 +SS2(I,LP1)*CONT1D(I,L))*CLDFAC(I,LP1,L) 1065 FLX(I,LP1)=FLX(I,LP1)+(CSS(I,L)*CO21(I,L,LP1) 1066 1 +OSS(I,L)*TO31D(I,L) 1067 2 +SS2(I,L)*CONT1D(I,L) 1068 3 +DTC(I,L)*EMSPEC(I,1))*CLDFAC(I,L,LP1) 1069 873 CONTINUE 1070 C 1071 C FINAL SECTION OBTAINS EMISSIVITY HEATING RATES, 1072 C TOTAL HEATING RATES AND THE FLUX AT THE GROUND 1073 C 1074 C .....CALCULATE THE EMISSIVITY HEATING RATES 1075 DO 1101 K=1,L 1076 DO 1101 I=MYIS,MYIE 1077 HEATEM(I,K)=RADCON*(FLX(I,K+1)-FLX(I,K))*DELP(I,K) 1078 1101 CONTINUE 1079 C .....CALCULATE THE TOTAL HEATING RATES 1080 DO 1103 K=1,L 1081 DO 1103 I=MYIS,MYIE 1082 c if(mype.eq.13.and.i.eq.40) then 1083 c print*,'k=',k 1084 c print*,'cts(i,k)=',cts(i,k) 1085 c print*,'ctso(i,k)=',ctso3(i,k) 1086 c print*,'excts(i,k)=',excts(i,k) 1087 c endif 1088 HEATRA(I,K)=HEATEM(I,K)-CTS(I,K)-CTSO3(I,K)+EXCTS(I,K) 1089 1103 CONTINUE 1090 C .....CALCULATE THE FLUX AT EACH FLUX LEVEL USING THE FLUX AT THE 1091 C TOP (FLX1E1+GXCTS) AND THE INTEGRAL OF THE HEATING RATES (VSUM1) 1092 DO 1111 K=1,L 1093 DO 1111 I=MYIS,MYIE 1094 VSUM1(I,K)=HEATRA(I,K)*DELP2(I,K)*RADCON1 1095 1111 CONTINUE 1096 DO 1115 I=MYIS,MYIE 1097 TOPFLX(I)=FLX1E1(I)+GXCTS(I) 1098 c if(mype.eq.13.and.i.eq.40) then 1099 c print*,'flx1e1(i),gxcts(i)=',flx1e1(i),gxcts(i) 1100 c print*,'topflx(i)=',topflx(i) 1101 c endif 1102 FLXNET(I,1)=TOPFLX(I) 1103 1115 CONTINUE 1104 C---ONLY THE SURFACE VALUE OF FLUX (GRNFLX) IS NEEDED UNLESS 1105 C THE THICK CLOUD SECTION IS INVOKED. 1106 DO 1123 K=2,LP1 Page 19 Source Listing FST88 2025-03-12 18:21 FST88.F 1107 DO 1123 I=MYIS,MYIE 1108 c if(mype.eq.13.and.i.eq.40) then 1109 c print*,'k,k-1,flxnet(i,k-1),vsum1(i,k-1)=', 1110 c * k,k-1,flxnet(i,k-1),vsum1(i,k-1) 1111 c endif 1112 FLXNET(I,K)=FLXNET(I,K-1)+VSUM1(I,K-1) 1113 1123 CONTINUE 1114 DO 1125 I=MYIS,MYIE 1115 GRNFLX(I)=FLXNET(I,LP1) 1116 1125 CONTINUE 1117 C 1118 C THIS IS THE THICK CLOUD SECTION.OPTIONALLY,IF THICK CLOUD 1119 C FLUXES ARE TO BE "CONVECTIVELY ADJUSTED",IE,DF/DP IS CONSTANT, 1120 C FOR CLOUDY PART OF GRID POINT, THE FOLLOWING CODE IS EXECUTED. 1121 C***FIRST,COUNT THE NUMBER OF CLOUDS ALONG THE LAT. ROW. SKIP THE 1122 C ENTIRE THICK CLOUD COMPUTATION OF THERE ARE NO CLOUDS. 1123 ICNT=0 1124 DO 1301 I=MYIS,MYIE 1125 ICNT=ICNT+NCLDS(I) 1126 1301 CONTINUE 1127 IF (ICNT.EQ.0) GO TO 6999 1128 C---FIND THE MAXIMUM NUMBER OF CLOUDS IN THE LATITUDE ROW 1129 KCLDS=NCLDS(1) 1130 DO 2106 I=MYIS,MYIE 1131 KCLDS=MAX(NCLDS(I),KCLDS) 1132 2106 CONTINUE 1133 C 1134 C 1135 C***OBTAIN THE PRESSURES AND FLUXES OF THE TOP AND BOTTOM OF 1136 C THE NC'TH CLOUD (IT IS ASSUMED THAT ALL KTOP AND KBTM'S HAVE 1137 C BEEN DEFINED!). 1138 DO 1361 KK=1,KCLDS 1139 KMIN=LP1 1140 KMAX=0 1141 DO 1362 I=MYIS,MYIE 1142 J1=KTOP(I,KK+1) 1143 C IF (J1.EQ.1) GO TO 1362 1144 J3=KBTM(I,KK+1) 1145 IF (J3.GT.J1) THEN 1146 PTOP(I)=P(I,J1) 1147 PBOT(I)=P(I,J3+1) 1148 FTOP(I)=FLXNET(I,J1) 1149 FBOT(I)=FLXNET(I,J3+1) 1150 C***OBTAIN THE "FLUX DERIVATIVE" DF/DP (DELPTC) 1151 DELPTC(I)=(FTOP(I)-FBOT(I))/(PTOP(I)-PBOT(I)) 1152 KMIN=MIN(KMIN,J1) 1153 KMAX=MAX(KMAX,J3) 1154 ENDIF 1155 1362 CONTINUE 1156 KMIN=KMIN+1 1157 C***CALCULATE THE TOT. FLUX CHG. FROM THE TOP OF THE CLOUD, FOR 1158 C ALL LEVELS. 1159 DO 1365 K=KMIN,KMAX 1160 DO 1363 I=MYIS,MYIE 1161 C IF (KTOP(I,KK+1).EQ.1) GO TO 1363 1162 IF(KTOP(I,KK+1).LT.K .AND. K.LE.KBTM(I,KK+1)) THEN 1163 Z1(I,K)=(P(I,K)-PTOP(I))*DELPTC(I)+FTOP(I) Page 20 Source Listing FST88 2025-03-12 18:21 FST88.F 1164 CORIGINAL FLXNET(I,K)=FLXNET(I,K)*(ONE-CAMT(I,KK+1)) + 1165 CORIGINAL1 Z1(I,K)*CAMT(I,KK+1) 1166 c if(mype.eq.13.and.i.eq.40) then 1167 c print*,'k,z1(i,k)=',k,z1(i,k) 1168 c endif 1169 FLXNET(I,K)=Z1(I,K) 1170 ENDIF 1171 1363 CONTINUE 1172 1365 CONTINUE 1173 1361 CONTINUE 1174 C***USING THIS FLUX CHG. IN THE CLOUDY PART OF THE GRID BOX, OBTAIN 1175 C THE NEW FLUXES, WEIGHTING THE CLEAR AND CLOUDY FLUXES:AGAIN, ONLY 1176 C THE FLUXES IN THICK-CLOUD LEVELS WILL EVENTUALLY BE USED. 1177 C DO 6051 K=1,LP1 1178 C DO 6051 I=MYIS,MYIE 1179 C FLXNET(I,K)=FLXNET(I,K)*(ONE-CAMT(I,NC)) + 1180 C 1 Z1(I,K)*CAMT(I,NC) 1181 C051 CONTINUE 1182 C***MERGE FLXTHK INTO FLXNET FOR APPROPRIATE LEVELS. 1183 C DO 1401 K=1,LP1 1184 C DO 1401 I=MYIS,MYIE 1185 C IF (K.GT.ITOP(I) .AND. K.LE.IBOT(I) 1186 C 1 .AND. (NC-1).LE.NCLDS(I)) THEN 1187 if(mype.eq.13.and.i.eq.40) then 1188 print*,'k,flxthk(i,k)=',k,flxthk(i,k) 1189 endif 1190 C FLXNET(I,K)=FLXTHK(I,K) 1191 C ENDIF 1192 C401 CONTINUE 1193 C 1194 C******END OF CLOUD LOOP***** 1195 6001 CONTINUE 1196 6999 CONTINUE 1197 C***THE FINAL STEP IS TO RECOMPUTE THE HEATING RATES BASED ON THE 1198 C REVISED FLUXES: 1199 DO 6101 K=1,L 1200 DO 6101 I=MYIS,MYIE 1201 c if(mype.eq.13.and.i.eq.40) then 1202 c print*,'i,k=',i,k 1203 c print*,'radcon=',radcon 1204 c print*,'flxnet(i,k+1)=',flxnet(i,k+1) 1205 c print*,'flxnet(i,k)=',flxnet(i,k) 1206 c print*,'delp(i,k)=',delp(i,k) 1207 c endif 1208 HEATRA(I,K)=RADCON*(FLXNET(I,K+1)-FLXNET(I,K))*DELP(I,K) 1209 6101 CONTINUE 1210 C THE THICK CLOUD SECTION ENDS HERE. 1211 RETURN 1212 END Page 21 Source Listing FST88 2025-03-12 18:21 Entry Points FST88.F ENTRY POINTS Name fst88_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1001 Label 812 807,808 101 Label 488 479,480 1011 Label 818 814,815 1012 Label 829 819 1013 Label 833 831 1014 Label 834 830 103 Label 495 489,490 105 Label 504 497 1101 Label 1078 1075,1076 1103 Label 1089 1080,1081 1111 Label 1095 1092,1093 1115 Label 1103 1096 1123 Label 1113 1106,1107 1125 Label 1116 1114 1301 Label 1126 1124 131 Label 658 655,656 1361 Label 1173 1138 1362 Label 1155 1141 1363 Label 1171 1160 1365 Label 1172 1159 143 Label 662 659,660 1803 Label 849 847 1804 Label 884 882 1808 Label 763 761 2106 Label 1132 1130 302 Label 751 736,737 3021 Label 724 721,722 3022 Label 755 752,753 3023 Label 759 756,757 303 Label 786 780,781 305 Label 774 767,768 307 Label 778 775 321 Label 900 840 3218 Label 846 843,844 322 Label 863 857,858 3221 Label 876 865,866 3223 Label 880 877,878 331 Label 982 973 3423 Label 892 886,887 3425 Label 899 893,894 4112 Label 515 512,513 4114 Label 511 507,508 4212 Label 525 522,523 4214 Label 521 517,518 Page 22 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References 4312 Label 535 532,533 4314 Label 531 527,528 4412 Label 545 542,543 4414 Label 541 537,538 4512 Label 555 552,553 4514 Label 551 547,548 4612 Label 565 562,563 4614 Label 561 557,558 4712 Label 575 572,573 4714 Label 571 567,568 4812 Label 585 582,583 4814 Label 581 577,578 4912 Label 595 592,593 4914 Label 591 587,588 5012 Label 605 602,603 5014 Label 601 597,598 5112 Label 615 612,613 5114 Label 611 607,608 5212 Label 625 622,623 5214 Label 621 617,618 5312 Label 635 632,633 5314 Label 631 627,628 5412 Label 645 642,643 5414 Label 641 637,638 6001 Label 1195 601 Label 991 987,988 603 Label 996 992,993 6101 Label 1209 1199,1200 618 Label 986 983,984 625 Label 1000 997 631 Label 1010 1007,1008 641 Label 1017 1011 643 Label 1021 1018,1019 651 Label 1030 1026,1027 655 Label 1039 1032,1033 661 Label 1043 1040 663 Label 1048 1044,1045 6999 Label 1196 1127 803 Label 732 730 821 Label 939 935 823 Label 944 940,941 833 Label 951 948 851 Label 962 959,960 861 Label 972 966 871 Label 1058 1052,1053 873 Label 1069 1060 901 Label 674 668,669 903 Label 681 675,676 998 Label 802 800 999 Label 806 803,804 AINT Func 482 scalar 482,492 ALP Local 434 R(4) 4 2 4095 990,995,998,999,1009 AVEPHI Local 404 R(4) 4 2 2070 723,731,735,845,848,856,873,949,95 0,952 AVMO3 Local 424 R(4) 4 2 2070 859,867,869 Page 23 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References AVPHO3 Local 424 R(4) 4 2 2070 860,867 AVVO2 Local 421 R(4) 4 2 2070 861,872,874 BANDTA Common 285 5900 BDCOMB Common 354 736 SAVE BDWIDE Common 313 56 SAVE C Local 425 R(4) 4 2 4095 1009,1012,1013,1014,1015,1016,1020 ,1035,1041,1046 C2 Local 425 R(4) 4 2 4095 1037,1042,1047 CAMT Dummy 66 R(4) 4 2 2070 ARG,INOUT CLDFAC Dummy 66 R(4) 4 3 95220 ARG,INOUT 773,785,791,805,810,816,817,820,89 1,898,1057,1064,1068 CNTTAU Local 458 R(4) 4 2 2070 749,750,770,783,805,862,980 CNTVAL Dummy 68 R(4) 4 2 2070 ARG,INOUT 977,979,1028,1029 CO21 Dummy 67 R(4) 4 3 95220 ARG,INOUT 754,758,784,875,879,890,897,1012,1 013,1015,1020,1057,1061,1065 CO2NBL Dummy 67 R(4) 4 2 2025 ARG,INOUT 762,883,981 CO2SP Local 414 R(4) 4 2 2070 754,772,793 CO2SP1 Dummy 67 R(4) 4 2 2070 ARG,INOUT 793 CO2SP2 Dummy 67 R(4) 4 2 2070 ARG,INOUT 793 CONT1D Local 423 R(4) 4 2 2070 862,889,896,980,1064,1067 CONTDG Local 438 R(4) 4 2 2070 1041,1046,1055 CSOUR Local 419 R(4) 4 2 2070 661,678,772,777,790 CSS Local 416 R(4) 4 2 2070 678,784,890,897,1057,1061,1065 CSUB Local 434 R(4) 4 2 4095 1028,1029,1034,1035,1036 CSUB2 Local 435 R(4) 4 2 4095 1034,1037,1038 CTS Local 413 R(4) 4 2 2025 809,1088 CTSO3 Local 412 R(4) 4 2 2025 790,1088 DELP Dummy 65 R(4) 4 2 2025 ARG,INOUT 792,809,989,994,999,1077,1208 DELP2 Dummy 65 R(4) 4 2 2025 ARG,INOUT 792,1013,1094 DELPR1 Local 437 R(4) 4 2 2070 989,990,1028 DELPR2 Local 437 R(4) 4 2 2070 994,995,1029 DELPTC Local 429 R(4) 4 1 45 1151,1163 DSORC Local 433 R(4) 4 2 2070 510,514,520,524,530,534,540,544,55 0,554,560,564,570,574,580,584,590, 594,600,604,610,614,620,624,630,63 4,640,644 DT Local 452 R(4) 4 2 2070 484,499,503,514,524,534,544,554,56 4,574,584,594,604,614,624,634,644, 735 DTC Local 418 R(4) 4 2 2070 679,785,891,898,1054,1062,1068 DTE2 Local 453 R(4) 4 2 2070 494,499,502,735,856 DTSP Local 454 R(4) 4 2 90 502,503,952 E1CTS1 Local 447 R(4) 4 2 2070 734,816,821 E1CTS2 Local 447 R(4) 4 2 2025 734,817 E1CTW1 Local 448 R(4) 4 2 2070 734,810,816,821 E1CTW2 Local 448 R(4) 4 2 2025 734,810,817 E1E290 Subr 734 734 E1FLX Local 413 R(4) 4 2 2070 734,769,776 E290 Subr 856 856 E2SPEC Subr 952 952 E3V88 Subr 955 955 EMD Local 449 R(4) 4 2 4095 955,961,967,969,970 EMISDG Local 438 R(4) 4 2 2070 961,969,1054 EMISS Local 404 R(4) 4 2 2070 734,785,856,891,952,968 EMISSB Local 405 R(4) 4 2 2070 856,898 Page 24 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References EMPL Dummy 70 R(4) 4 2 4095 ARG,INOUT 950,955,967,970 EMSPEC Local 431 R(4) 4 2 90 967,970,1062,1068 EMX1 Dummy 70 R(4) 4 1 45 ARG,INOUT 731,848,968 EMX2 Dummy 70 R(4) 4 1 45 ARG,INOUT 971 EXCTS Local 412 R(4) 4 2 2025 790,1088 EXP Func 743 scalar 743,744,749,871,873,977,978 FAC1 Local 436 R(4) 4 2 2070 738,739,740,867,868,870,974,975,97 6 FBOT Local 431 R(4) 4 1 45 1149,1151 FLX Local 457 R(4) 4 2 2070 769,776,782,888,895,1054,1061,1065 ,1077 FLX1E1 Local 403 R(4) 4 1 45 820,832,1097 FLXNET Local 440 R(4) 4 2 2070 1102,1112,1115,1148,1149,1169,1208 FLXTHK Local 443 R(4) 4 2 2070 1188 FST88 Subr 64 FTOP Local 430 R(4) 4 1 45 1148,1151,1163 FXO Local 452 R(4) 4 2 2070 483,487,498,501,735 FXOE2 Local 453 R(4) 4 2 2070 493,498,500,735,856 FXOSP Local 454 R(4) 4 2 90 500,501,952 GLB_TABLE Common 199 128 SAVE GRNFLX Dummy 64 R(4) 4 1 45 ARG,INOUT 1115 GXCTS Local 403 R(4) 4 1 45 790,1097 HCON Common 78 872 SAVE HEATEM Local 421 R(4) 4 2 2070 1077,1088 HEATRA Dummy 64 R(4) 4 2 2025 ARG,INOUT 1088,1094,1208 I Local 480 I(4) 4 scalar 480,482,483,484,487,490,492,493,49 4,497,498,499,500,501,502,503,507, 509,510,513,514,517,519,520,523,52 4,527,529,530,533,534,537,539,540, 543,544,547,549,550,553,554,557,55 9,560,563,564,567,569,570,573,574, 577,579,580,583,584,587,589,590,59 3,594,597,599,600,603,604,607,609, 610,613,614,617,619,620,623,624,62 7,629,630,633,634,637,639,640,643, 644,656,657,660,661,669,670,676,67 7,678,679,680,722,723,730,731,737, 738,739,740,743,744,745,749,750,75 3,754,757,758,761,762,768,769,770, 771,772,773,775,776,777,781,782,78 3,784,785,800,801,804,805,808,809, 810,811,815,816,817,819,820,821,83 1,832,844,845,847,848,858,859,860, 861,862,866,867,868,869,870,871,87 2,873,874,875,878,879,882,883,887, 888,889,890,891,894,895,896,897,89 8,935,936,937,938,941,942,943,948, 949,950,960,961,966,967,968,969,97 0,971,973,974,975,976,977,978,979, 980,981,984,985,988,989,990,993,99 4,995,997,998,999,1008,1009,1011,1 012,1013,1014,1015,1016,1019,1020, 1027,1028,1029,1033,1034,1035,1036 ,1037,1038,1040,1041,1042,1045,104 6,1047,1053,1054,1055,1056,1057,10 Page 25 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References 60,1061,1062,1063,1064,1065,1066,1 067,1068,1076,1077,1081,1088,1093, 1094,1096,1097,1102,1107,1112,1114 ,1115,1124,1125,1130,1131,1141,114 2,1144,1146,1147,1148,1149,1151,11 60,1162,1163,1169,1187,1188,1200,1 208 IBOT Local 426 I(4) 4 1 45 ICNT Local 1123 I(4) 4 scalar 1123,1125,1127 IDIM1 Param 140 I(4) 4 scalar 389,390,391,392,393,394,395,396,39 7,398,399,400,401,402,403,404,405, 407,408,409,410,412,413,414,415,41 6,417,418,419,421,422,423,424,425, 426,427,429,430,431,433,434,435,43 6,437,438,439,440,441,442,443,444, 447,448,449,452,453,454,457,458,46 6,467,468,469 IDIM2 Param 140 I(4) 4 scalar 389,390,391,392,393,394,395,396,39 7,398,399,400,401,402,403,404,405, 407,408,409,410,412,413,414,415,41 6,417,418,419,421,422,423,424,425, 426,427,429,430,431,433,434,435,43 6,437,438,439,440,441,442,443,444, 447,448,449,452,453,454,457,458 IGSTL Param 135 I(4) 4 scalar 140 IGSTR Param 135 I(4) 4 scalar 140 IM Param 124 I(4) 4 scalar 137,140,205,206,207,208,209,213,21 4,219,222 IMAX Param 222 I(4) 4 scalar 222,235,382 INDTC Local 427 I(4) 4 1 45 INLTE Param 234 I(4) 4 scalar 234 INLTEP Param 234 I(4) 4 scalar INPES Param 132 I(4) 4 scalar 137,140,189,190,191,200,201 ITAIL Param 137 I(4) 4 scalar ITOP Local 426 I(4) 4 1 45 IXO Local 441 I(4) 4 2 2070 487,509,510,519,520,529,530,539,54 0,549,550,559,560,569,570,579,580, 589,590,599,600,609,610,619,620,62 9,630,639,640 J1 Local 1142 I(4) 4 scalar 1142,1145,1146,1148,1152 J3 Local 1144 I(4) 4 scalar 1144,1145,1147,1149,1153 JDIM1 Param 141 I(4) 4 scalar JDIM2 Param 141 I(4) 4 scalar JGSTL Param 136 I(4) 4 scalar 141 JGSTR Param 136 I(4) 4 scalar 141 JM Param 124 I(4) 4 scalar 138,141,205,206,207,208,209,213,21 4,219 JNPES Param 132 I(4) 4 scalar 138,141,189,190,191,200,201 JTAIL Param 138 I(4) 4 scalar K Local 479 I(4) 4 scalar 479,482,483,484,487,489,492,493,49 4,508,509,510,512,514,518,519,520, 522,524,528,529,530,532,534,538,53 9,540,542,544,548,549,550,552,554, 558,559,560,562,564,568,569,570,57 2,574,578,579,580,582,584,588,589, Page 26 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References 590,592,594,598,599,600,602,604,60 8,609,610,612,614,618,619,620,622, 624,628,629,630,632,634,638,639,64 0,642,644,655,657,659,661,668,670, 675,677,678,679,680,721,723,736,73 8,739,740,743,744,745,749,750,752, 754,756,758,767,769,770,771,772,77 3,803,805,807,809,810,811,814,816, 817,830,832,840,841,843,845,857,85 9,860,861,862,865,867,868,869,870, 871,872,873,874,875,877,879,883,88 6,888,890,891,893,895,896,897,898, 940,942,943,959,961,983,985,987,98 9,990,992,994,995,1007,1009,1018,1 020,1026,1028,1029,1032,1034,1035, 1036,1037,1038,1044,1046,1047,1052 ,1054,1055,1056,1057,1075,1077,108 0,1088,1092,1094,1106,1112,1159,11 62,1163,1169,1188,1199,1208 KBTM Dummy 66 I(4) 4 2 2070 ARG,INOUT 1144,1162 KCLDS Local 1129 I(4) 4 scalar 1129,1131,1138 KK Local 843 I(4) 4 scalar 843,845,857,859,860,861,862,865,86 7,868,869,870,871,872,873,874,875, 1138,1142,1144,1162 KLEN Local 841 I(4) 4 scalar 841,856 KMAX Local 1140 I(4) 4 scalar 1140,1153,1159 KMIN Local 1139 I(4) 4 scalar 1139,1152,1156,1159 KO2 Param 237 I(4) 4 scalar 238 KO21 Param 238 I(4) 4 scalar KO2M Param 238 I(4) 4 scalar KP Local 780 I(4) 4 scalar 780,782,783,784,785,877,879,886,88 8,889,890,891,893,895,896,897,898 KTOP Dummy 66 I(4) 4 2 2070 ARG,INOUT 1142,1162 L Param 221 I(4) 4 scalar 225,226,227,230,232,390,391,396,39 8,399,401,412,413,414,447,448,457, 489,498,499,675,721,736,752,756,80 3,807,814,830,936,937,938,940,943, 949,950,959,961,974,975,976,977,97 8,979,980,981,983,992,998,999,1012 ,1013,1014,1015,1016,1018,1044,106 1,1063,1064,1065,1066,1067,1068,10 75,1080,1092,1199 LL Param 227 I(4) 4 scalar 227,228,998,1013 LL3P Param 232 I(4) 4 scalar 235 LL3PI Param 235 I(4) 4 scalar LLM1 Param 228 I(4) 4 scalar 1014,1041,1042 LLM2 Param 228 I(4) 4 scalar 1032 LLM3 Param 228 I(4) 4 scalar LLP1 Param 227 I(4) 4 scalar 235,410,425,434,435,449,938,970,99 9,1007,1015 LLP1I Param 235 I(4) 4 scalar LLP2 Param 227 I(4) 4 scalar LLP3 Param 227 I(4) 4 scalar LM Param 124 I(4) 4 scalar 214,221 LM1 Param 226 I(4) 4 scalar 500,501,502,503,731,840,848,980,98 Page 27 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References 7,999,1015,1016,1020,1026,1046,104 7 LM2 Param 226 I(4) 4 scalar LM3 Param 226 I(4) 4 scalar LOG Func 985 scalar 985 LP1 Param 225 I(4) 4 scalar 229,230,231,235,382,389,390,391,39 2,393,394,395,396,397,400,404,405, 407,408,409,413,414,415,416,417,41 8,419,421,422,423,424,433,436,437, 438,439,440,441,442,443,444,447,44 8,452,453,457,458,479,498,499,508, 512,518,522,528,532,538,542,548,55 2,558,562,568,572,578,582,588,592, 598,602,608,612,618,622,628,632,63 8,642,655,659,668,731,767,780,820, 821,843,848,857,865,877,886,893,93 7,967,969,990,999,1012,1013,1014,1 015,1016,1029,1041,1042,1052,1061, 1062,1063,1064,1065,1068,1106,1115 ,1139 LP121 Param 231 I(4) 4 scalar LP1I Param 235 I(4) 4 scalar LP1M Param 229 I(4) 4 scalar 229 LP1M1 Param 229 I(4) 4 scalar LP1V Param 230 I(4) 4 scalar 382 LP2 Param 225 I(4) 4 scalar 467,469 LP3 Param 225 I(4) 4 scalar LSM Param 124 I(4) 4 scalar MAPPINGS Common 218 5024 SAVE MAX Func 487 scalar 487,1131,1153 MIN Func 1152 scalar 1152 MPPCOM Common 163 1464 SAVE NB Param 233 I(4) 4 scalar 236 NB1 Param 236 I(4) 4 scalar NBLM Param 224 I(4) 4 scalar NBLW Param 223 I(4) 4 scalar 285,286,287 NBLX Param 223 I(4) 4 scalar NBLY Param 223 I(4) 4 scalar 224,231,354,355,356,385,386,419 NCLDS Dummy 66 I(4) 4 1 45 ARG,INOUT 1125,1129,1131 NCOL Param 222 I(4) 4 scalar NNLTE Param 234 I(4) 4 scalar OSS Local 416 R(4) 4 2 2070 677,782,888,895,1056,1063,1066 OVER1D Local 422 R(4) 4 2 2070 744,754,758,762,873,875,879,883,97 8,981 P Dummy 65 R(4) 4 2 2070 ARG,INOUT 792,989,994,999,1013,1014,1015,101 6,1146,1147,1163 PBOT Local 429 R(4) 4 1 45 1147,1151 PHYCON Common 72 80 SAVE PRESS Dummy 65 R(4) 4 2 2070 ARG,INOUT 791,989,994,999,1013,1014,1015,101 6 PTOP Local 429 R(4) 4 1 45 1146,1151,1163 QH2O Dummy 65 R(4) 4 2 2070 ARG,INOUT RLOG Local 457 R(4) 4 2 2025 762,883,981,985,990,995,998,999 SORC Local 419 R(4) 4 3 31050 514,524,534,544,554,564,574,584,59 4,604,614,624,634,644,657,661,677, Page 28 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Object Declared Type Bytes Dimen Elements Attributes References 771,776,790 SPA88 Subr 790 790 SQRT Func 740 scalar 740,744,869,873,976,978,990,995,99 9 SS1 Local 417 R(4) 4 2 2070 657,680,770,776,811 SS2 Local 417 R(4) 4 2 2070 680,783,889,896,1055,1064,1067 T Dummy 65 R(4) 4 2 2070 ARG,INOUT 492,494,735,937,938,942,943 TABCOM Common 382 133920 SAVE TC Local 418 R(4) 4 2 2070 670,679,769,776,809,816,820 TEMP Dummy 65 R(4) 4 2 2070 ARG,INOUT 482,484,670,735,791,936,937,938 TEMPCOM Common 204 6603768 SAVE TO31D Local 423 R(4) 4 2 2070 871,888,895,977,1063,1066 TO3DG Local 439 R(4) 4 2 2070 1042,1047,1056 TO3SP Local 415 R(4) 4 2 2070 743,771,782,792 TO3SPC Local 414 R(4) 4 2 2025 739,743,792 TOPFLX Dummy 64 R(4) 4 1 45 ARG,INOUT 1097,1102 TOPO Common 212 17478548 SAVE TOTEVV Local 458 R(4) 4 2 2070 750,862,980 TOTO3 Dummy 69 R(4) 4 2 2070 ARG,INOUT 738,740,859 TOTPHI Dummy 69 R(4) 4 2 2070 ARG,INOUT 723,744,845 TOTVO2 Dummy 69 R(4) 4 2 2070 ARG,INOUT 743,745,749,792,861 TPHIO3 Dummy 69 R(4) 4 2 2070 ARG,INOUT 738,860 TPL Local 449 R(4) 4 2 4095 936,937,938,942,943,955 VAR1 Dummy 68 R(4) 4 2 2025 ARG,INOUT 791 VAR2 Dummy 68 R(4) 4 2 2025 ARG,INOUT 791,949,950,978 VAR3 Dummy 68 R(4) 4 2 2025 ARG,INOUT 974,976 VAR4 Dummy 68 R(4) 4 2 2025 ARG,INOUT 974 VSUM1 Local 442 R(4) 4 2 2070 1094,1112 VTMP3 Local 433 R(4) 4 2 2070 482,483,484,492,493,494,509,514,51 9,524,529,534,539,544,549,554,559, 564,569,574,579,584,589,594,599,60 4,609,614,619,624,629,634,639,644, 801,805,811,816,832,868,871,975,97 7 Z1 Local 444 R(4) 4 2 2070 1163,1169 TYPE COMPONENTS/COMMON VARIABLES Name Type Bytes Offset Dimen Elements Attributes References AB15 R(4) 4 5892 1 2 COM AB15CM R(4) 4 728 1 2 COM AB15WD R(4) 4 40 scalar COM 744,873,978 ACOMB R(4) 4 160 1 15 COM AMOLWT R(4) 4 0 scalar COM AO3CM R(4) 4 704 1 3 COM AO3RND R(4) 4 5868 1 3 COM 740,869,976 AP R(4) 4 1956 1 163 COM APCM R(4) 4 340 1 15 COM APWD R(4) 4 12 scalar COM ARNDM R(4) 4 0 1 163 COM ATP R(4) 4 3260 1 163 COM ATPCM R(4) 4 460 1 15 COM ATPWD R(4) 4 20 scalar COM Page 29 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References AWIDE R(4) 4 0 scalar COM BANDHI R(4) 4 5216 1 163 COM BANDLO R(4) 4 4564 1 163 COM BCOMB R(4) 4 220 1 15 COM BDHICM R(4) 4 640 1 15 COM BDHIWD R(4) 4 32 scalar COM BDLOCM R(4) 4 580 1 15 COM BDLOWD R(4) 4 28 scalar COM BETACM R(4) 4 280 1 15 COM BETAD R(4) 4 1304 1 163 COM BETAWD R(4) 4 8 scalar COM BETINC R(4) 4 700 scalar COM BETINW R(4) 4 36 scalar COM BO3CM R(4) 4 716 1 3 COM BO3RND R(4) 4 5880 1 3 COM 738,867,974 BP R(4) 4 2608 1 163 COM BPCM R(4) 4 400 1 15 COM BPWD R(4) 4 16 scalar COM BRNDM R(4) 4 652 1 163 COM BTP R(4) 4 3912 1 163 COM BTPCM R(4) 4 520 1 15 COM BTPWD R(4) 4 24 scalar COM BWIDE R(4) 4 4 scalar COM CSUBP R(4) 4 4 scalar COM DIFFCTR R(4) 4 8 scalar COM DSRCE R(4) 4 132240 2 420 COM 510,520,530,540,550,560,570,580,59 0,600,610,620,630,640 EIGHT R(4) 4 20 scalar COM EM1 R(4) 4 9600 2 5040 COM EM1WDE R(4) 4 29760 2 5040 COM EM3 R(4) 4 110400 2 5040 COM FIFTY R(4) 4 12 scalar COM FIVE R(4) 4 24 scalar COM FOUR R(4) 4 28 scalar COM 740,869,976 G R(4) 4 12 scalar COM G2LI I(4) 4 0 1 239 COM G2LJ I(4) 4 1912 1 389 COM GINV R(4) 4 68 scalar COM GP0INV R(4) 4 76 scalar COM GRAVDR R(4) 4 16 scalar COM H101M16 R(4) 4 808 scalar COM H102M5 R(4) 4 784 scalar COM H1036E2 R(4) 4 756 scalar COM H114M11 R(4) 4 384 scalar COM H1174M7 R(4) 4 268 scalar COM H11M10 R(4) 4 296 scalar COM H11M11 R(4) 4 388 scalar COM H1224E3 R(4) 4 112 scalar COM H1226E1 R(4) 4 652 scalar COM H128M5 R(4) 4 240 scalar COM H129M2 R(4) 4 732 scalar COM H12M12 R(4) 4 472 scalar COM H12M13 R(4) 4 492 scalar COM H12M31 R(4) 4 560 scalar COM H135M13 R(4) 4 488 scalar COM Page 30 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References H1386E2 R(4) 4 748 scalar COM H1439M5 R(4) 4 236 scalar COM H14M10 R(4) 4 292 scalar COM H14M11 R(4) 4 380 scalar COM H14M12 R(4) 4 468 scalar COM H14M14 R(4) 4 508 scalar COM H14M30 R(4) 4 548 scalar COM H15E2 R(4) 4 136 scalar COM H15M11 R(4) 4 376 scalar COM H15M14 R(4) 4 504 scalar COM H15M5 R(4) 4 824 scalar COM H161E1 R(4) 4 800 scalar COM H165E5 R(4) 4 84 scalar COM H16E1 R(4) 4 792 scalar COM H16M12 R(4) 4 464 scalar COM H181E1 R(4) 4 148 scalar COM H18E1 R(4) 4 152 scalar COM H18E3 R(4) 4 832 scalar COM H18M11 R(4) 4 372 scalar COM H1E11 R(4) 4 72 scalar COM H1E13 R(4) 4 68 scalar COM H1E15 R(4) 4 64 scalar COM H1E4 R(4) 4 96 scalar COM H1E6 R(4) 4 612 scalar COM H1E8 R(4) 4 76 scalar COM H1M10 R(4) 4 300 scalar COM H1M11 R(4) 4 392 scalar COM H1M13 R(4) 4 496 scalar COM H1M16 R(4) 4 856 scalar COM H1M17 R(4) 4 512 scalar COM H1M18 R(4) 4 516 scalar COM H1M19 R(4) 4 520 scalar COM H1M2 R(4) 4 620 scalar COM H1M20 R(4) 4 524 scalar COM H1M21 R(4) 4 528 scalar COM H1M22 R(4) 4 532 scalar COM H1M23 R(4) 4 536 scalar COM H1M24 R(4) 4 540 scalar COM H1M3 R(4) 4 208 scalar COM H1M4 R(4) 4 220 scalar COM H1M5 R(4) 4 244 scalar COM H1M6 R(4) 4 260 scalar COM H1M60 R(4) 4 584 scalar COM H1M8 R(4) 4 284 scalar COM H1P082 R(4) 4 740 scalar COM H1P25892 R(4) 4 180 scalar COM H1P4 R(4) 4 176 scalar COM H1P41819 R(4) 4 704 scalar COM H1P4387 R(4) 4 172 scalar COM H1P8 R(4) 4 168 scalar COM H2075E3 R(4) 4 108 scalar COM H20788E3 R(4) 4 104 scalar COM H2118M2 R(4) 4 760 scalar COM H21M12 R(4) 4 460 scalar COM H21M31 R(4) 4 556 scalar COM Page 31 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References H235M3 R(4) 4 724 scalar COM H23E2 R(4) 4 132 scalar COM H23M10 R(4) 4 288 scalar COM H23M11 R(4) 4 364 scalar COM H24E3 R(4) 4 100 scalar COM H24M11 R(4) 4 360 scalar COM H24M12 R(4) 4 456 scalar COM H25452M6 R(4) 4 256 scalar COM H257M8 R(4) 4 280 scalar COM H25E2 R(4) 4 816 scalar COM H25M31 R(4) 4 552 scalar COM H26E2 R(4) 4 696 scalar COM H26M30 R(4) 4 544 scalar COM H28571M2 R(4) 4 852 scalar COM H285M4 R(4) 4 216 scalar COM H28E1 R(4) 4 868 scalar COM H28M11 R(4) 4 356 scalar COM H28M12 R(4) 4 452 scalar COM H29316E2 R(4) 4 648 scalar COM H2945E2 R(4) 4 128 scalar COM H29M12 R(4) 4 448 scalar COM H2E2 R(4) 4 688 scalar COM H2E6 R(4) 4 616 scalar COM H2M11 R(4) 4 368 scalar COM H2P5 R(4) 4 164 scalar COM H2P8 R(4) 4 160 scalar COM H2P9 R(4) 4 156 scalar COM H3082E2 R(4) 4 120 scalar COM H3116E1 R(4) 4 656 scalar COM H323M4 R(4) 4 768 scalar COM H327M8 R(4) 4 276 scalar COM H32M11 R(4) 4 348 scalar COM H35E1 R(4) 4 140 scalar COM H35M11 R(4) 4 344 scalar COM H36M13 R(4) 4 484 scalar COM H37412M5 R(4) 4 232 scalar COM H37M11 R(4) 4 340 scalar COM H37M12 R(4) 4 440 scalar COM H38M12 R(4) 4 436 scalar COM H391M7 R(4) 4 264 scalar COM H394M5 R(4) 4 228 scalar COM H3E2 R(4) 4 124 scalar COM H3M11 R(4) 4 352 scalar COM H3M12 R(4) 4 444 scalar COM H3M14 R(4) 4 500 scalar COM H3M3 R(4) 4 804 scalar COM H3M4 R(4) 4 860 scalar COM H3P5 R(4) 4 828 scalar COM H3P6 R(4) 4 144 scalar COM H41666M2 R(4) 4 636 scalar COM 1036,1038 H42M11 R(4) 4 336 scalar COM H42M2 R(4) 4 764 scalar COM H44194M2 R(4) 4 700 scalar COM H44871M2 R(4) 4 200 scalar COM H44M11 R(4) 4 332 scalar COM Page 32 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References H44M12 R(4) 4 428 scalar COM H451M6 R(4) 4 788 scalar COM H45M12 R(4) 4 424 scalar COM H45M32 R(4) 4 572 scalar COM H46M13 R(4) 4 480 scalar COM H488E4 R(4) 4 92 scalar COM H48M11 R(4) 4 328 scalar COM H4999M6 R(4) 4 252 scalar COM H4E5 R(4) 4 80 scalar COM H4M12 R(4) 4 432 scalar COM H4M33 R(4) 4 576 scalar COM H53M11 R(4) 4 324 scalar COM H559M3 R(4) 4 204 scalar COM H55M32 R(4) 4 568 scalar COM H5725E4 R(4) 4 88 scalar COM H5E2 R(4) 4 116 scalar COM H625M2 R(4) 4 668 scalar COM H62M12 R(4) 4 416 scalar COM H62M34 R(4) 4 580 scalar COM H658M2 R(4) 4 752 scalar COM H65M12 R(4) 4 412 scalar COM H67390E2 R(4) 4 772 scalar COM H6938M5 R(4) 4 224 scalar COM H69766E5 R(4) 4 720 scalar COM H6M12 R(4) 4 420 scalar COM H6P08108 R(4) 4 836 scalar COM H71E26 R(4) 4 60 scalar COM H72M11 R(4) 4 320 scalar COM H74M12 R(4) 4 408 scalar COM H75826M4 R(4) 4 736 scalar COM H77M11 R(4) 4 316 scalar COM H77M12 R(4) 4 404 scalar COM H7M6 R(4) 4 248 scalar COM H8121E1 R(4) 4 684 scalar COM H82M11 R(4) 4 308 scalar COM H83E26 R(4) 4 56 scalar COM H83M11 R(4) 4 304 scalar COM H8725M8 R(4) 4 272 scalar COM H8M11 R(4) 4 312 scalar COM H8M13 R(4) 4 476 scalar COM H93M12 R(4) 4 400 scalar COM H96M12 R(4) 4 396 scalar COM H987M4 R(4) 4 212 scalar COM H9M32 R(4) 4 564 scalar COM H9P94 R(4) 4 660 scalar COM HAF R(4) 4 44 scalar COM 739,868,937,938,975,1020,1046,1047 HM13EZ R(4) 4 592 scalar COM HM1597E1 R(4) 4 812 scalar COM HM161E1 R(4) 4 796 scalar COM HM1797E1 R(4) 4 680 scalar COM HM181E1 R(4) 4 604 scalar COM HM19EZ R(4) 4 596 scalar COM HM1E1 R(4) 4 600 scalar COM HM1E2 R(4) 4 608 scalar COM HM1EZ R(4) 4 692 scalar COM 743,744,749,871,873,977,978 Page 33 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References HM2M2 R(4) 4 644 scalar COM HM6666M2 R(4) 4 628 scalar COM 1009 HM8E1 R(4) 4 864 scalar COM HMP5 R(4) 4 640 scalar COM 1035,1037 HMP575 R(4) 4 588 scalar COM HMP66667 R(4) 4 624 scalar COM 1009 HMP805 R(4) 4 840 scalar COM HNINETY R(4) 4 4 scalar COM HP1 R(4) 4 196 scalar COM 482,492 HP118666 R(4) 4 820 scalar COM HP144 R(4) 4 712 scalar COM HP166666 R(4) 4 632 scalar COM 1036,1038 HP219 R(4) 4 708 scalar COM HP228 R(4) 4 672 scalar COM HP26 R(4) 4 728 scalar COM HP369 R(4) 4 192 scalar COM HP3795 R(4) 4 776 scalar COM HP5048 R(4) 4 780 scalar COM HP518 R(4) 4 188 scalar COM HP526315 R(4) 4 848 scalar COM HP6 R(4) 4 664 scalar COM HP602409 R(4) 4 844 scalar COM HP60241 R(4) 4 676 scalar COM HP8 R(4) 4 184 scalar COM HP805 R(4) 4 744 scalar COM HP816 R(4) 4 716 scalar COM HTMG R(4) 4 743768 3 4183695 COM HUNDRED R(4) 4 0 scalar COM IBAND I(4) 4 0 1 40 COM IBROW I(4) 4 404 scalar COM ICHUNKTAB I(4) 4 620 1 8 COM IE_GLB_TABLE I(4) 4 32 1 8 COM IE_LOC_TABLE I(4) 4 556 1 8 COM ILCOL I(4) 4 396 scalar COM ILPAD1 I(4) 4 412 scalar COM ILPAD2 I(4) 4 416 scalar COM ILPAD3 I(4) 4 420 scalar COM ILPAD4 I(4) 4 424 scalar COM ILPAD5 I(4) 4 428 scalar COM IND I(4) 4 0 1 237 COM INDX2 I(4) 4 948 1 2116 COM INUMQ I(4) 4 1064 1 100 COM IQUILT_GROUP I(4) 4 1060 scalar COM IRCOL I(4) 4 400 scalar COM IRPAD1 I(4) 4 432 scalar COM IRPAD2 I(4) 4 436 scalar COM IRPAD3 I(4) 4 440 scalar COM IRPAD4 I(4) 4 444 scalar COM IRPAD5 I(4) 4 448 scalar COM IS_GLB_TABLE I(4) 4 0 1 8 COM IS_LOC_TABLE I(4) 4 492 1 8 COM ITEMP I(4) 4 5870016 2 91719 COM ITEMP2 I(4) 4 6236892 2 91719 COM ITROW I(4) 4 408 scalar COM JBPAD1 I(4) 4 452 scalar COM Page 34 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References JBPAD2 I(4) 4 456 scalar COM JBPAD3 I(4) 4 460 scalar COM JBPAD4 I(4) 4 464 scalar COM JBPAD5 I(4) 4 468 scalar COM JE_GLB_TABLE I(4) 4 96 1 8 COM JE_LOC_TABLE I(4) 4 588 1 8 COM JS_GLB_TABLE I(4) 4 64 1 8 COM JS_LOC_TABLE I(4) 4 524 1 8 COM JTPAD1 I(4) 4 472 scalar COM JTPAD2 I(4) 4 476 scalar COM JTPAD3 I(4) 4 480 scalar COM JTPAD4 I(4) 4 484 scalar COM JTPAD5 I(4) 4 488 scalar COM KMAXV I(4) 4 9412 1 46 COM KMAXVM I(4) 4 9596 scalar COM L2GI I(4) 4 956 1 239 COM L2GJ I(4) 4 3468 1 389 COM MPI_COMM_COMP I(4) 4 652 scalar COM MPI_COMM_INTER I(4) 4 656 scalar COM MPI_COMM_INTER_ARRAY I(4) 4 660 1 100 COM MYIE I(4) 4 52 scalar COM 480,490,497,507,513,517,523,527,53 3,537,543,547,553,557,563,567,573, 577,583,587,593,597,603,607,613,61 7,623,627,633,637,643,656,660,669, 676,722,730,737,753,757,761,768,77 5,781,800,804,808,815,819,831,844, 847,858,866,878,882,887,894,935,94 1,948,960,966,973,984,988,993,997, 1008,1011,1019,1027,1033,1040,1045 ,1053,1060,1076,1081,1093,1096,110 7,1114,1124,1130,1141,1160,1200 MYIE1 I(4) 4 56 scalar COM MYIE1_P1 I(4) 4 120 scalar COM MYIE1_P2 I(4) 4 124 scalar COM MYIE1_P3 I(4) 4 128 scalar COM MYIE1_P4 I(4) 4 132 scalar COM MYIE2 I(4) 4 60 scalar COM MYIE2_P1 I(4) 4 136 scalar COM MYIE_P1 I(4) 4 100 scalar COM MYIE_P2 I(4) 4 104 scalar COM MYIE_P3 I(4) 4 108 scalar COM MYIE_P4 I(4) 4 112 scalar COM MYIE_P5 I(4) 4 116 scalar COM MYIS I(4) 4 40 scalar COM 480,490,497,507,513,517,523,527,53 3,537,543,547,553,557,563,567,573, 577,583,587,593,597,603,607,613,61 7,623,627,633,637,643,656,660,669, 676,722,730,737,753,757,761,768,77 5,781,800,804,808,815,819,831,844, 847,858,866,878,882,887,894,935,94 1,948,960,966,973,984,988,993,997, 1008,1011,1019,1027,1033,1040,1045 ,1053,1060,1076,1081,1093,1096,110 7,1114,1124,1130,1141,1160,1200 MYIS1 I(4) 4 44 scalar COM Page 35 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References MYIS1_P1 I(4) 4 84 scalar COM MYIS1_P2 I(4) 4 88 scalar COM MYIS1_P3 I(4) 4 92 scalar COM MYIS1_P4 I(4) 4 96 scalar COM MYIS2 I(4) 4 48 scalar COM MYIS_P1 I(4) 4 64 scalar COM MYIS_P2 I(4) 4 68 scalar COM MYIS_P3 I(4) 4 72 scalar COM MYIS_P4 I(4) 4 76 scalar COM MYIS_P5 I(4) 4 80 scalar COM MYJE I(4) 4 236 scalar COM MYJE1 I(4) 4 240 scalar COM MYJE1_P1 I(4) 4 280 scalar COM MYJE1_P2 I(4) 4 284 scalar COM MYJE1_P3 I(4) 4 288 scalar COM MYJE1_P4 I(4) 4 292 scalar COM MYJE2 I(4) 4 244 scalar COM MYJE2_P1 I(4) 4 296 scalar COM MYJE2_P2 I(4) 4 300 scalar COM MYJE2_P3 I(4) 4 304 scalar COM MYJE2_P4 I(4) 4 308 scalar COM MYJE3 I(4) 4 248 scalar COM MYJE3_P4 I(4) 4 312 scalar COM MYJE4 I(4) 4 252 scalar COM MYJE4_P1 I(4) 4 316 scalar COM MYJE4_P4 I(4) 4 320 scalar COM MYJE5 I(4) 4 256 scalar COM MYJE5_P1 I(4) 4 324 scalar COM MYJE5_P2 I(4) 4 328 scalar COM MYJE_P1 I(4) 4 260 scalar COM MYJE_P2 I(4) 4 264 scalar COM MYJE_P3 I(4) 4 268 scalar COM MYJE_P4 I(4) 4 272 scalar COM MYJE_P5 I(4) 4 276 scalar COM MYJS I(4) 4 140 scalar COM MYJS1 I(4) 4 144 scalar COM MYJS1_P1 I(4) 4 184 scalar COM MYJS1_P2 I(4) 4 188 scalar COM MYJS1_P3 I(4) 4 192 scalar COM MYJS1_P4 I(4) 4 196 scalar COM MYJS2 I(4) 4 148 scalar COM MYJS2_P1 I(4) 4 200 scalar COM MYJS2_P2 I(4) 4 204 scalar COM MYJS2_P3 I(4) 4 208 scalar COM MYJS2_P4 I(4) 4 212 scalar COM MYJS3 I(4) 4 152 scalar COM MYJS3_P4 I(4) 4 216 scalar COM MYJS4 I(4) 4 156 scalar COM MYJS4_P1 I(4) 4 220 scalar COM MYJS4_P4 I(4) 4 224 scalar COM MYJS5 I(4) 4 160 scalar COM MYJS5_P1 I(4) 4 228 scalar COM MYJS5_P2 I(4) 4 232 scalar COM MYJS_P1 I(4) 4 164 scalar COM MYJS_P2 I(4) 4 168 scalar COM Page 36 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References MYJS_P3 I(4) 4 172 scalar COM MYJS_P4 I(4) 4 176 scalar COM MYJS_P5 I(4) 4 180 scalar COM MYPE I(4) 4 0 scalar COM 1187 MY_E I(4) 4 336 scalar COM MY_IE_GLB I(4) 4 12 scalar COM MY_IE_LOC I(4) 4 28 scalar COM MY_IS_GLB I(4) 4 8 scalar COM MY_IS_LOC I(4) 4 24 scalar COM MY_JE_GLB I(4) 4 20 scalar COM MY_JE_LOC I(4) 4 36 scalar COM MY_JS_GLB I(4) 4 16 scalar COM MY_JS_LOC I(4) 4 32 scalar COM MY_N I(4) 4 332 scalar COM MY_NE I(4) 4 348 scalar COM MY_NEB I(4) 4 364 1 8 COM MY_NW I(4) 4 360 scalar COM MY_S I(4) 4 340 scalar COM MY_SE I(4) 4 352 scalar COM MY_SW I(4) 4 356 scalar COM MY_W I(4) 4 344 scalar COM NPES I(4) 4 4 scalar COM O3DIFCTR R(4) 4 20 scalar COM ONE R(4) 4 40 scalar COM 740,869,870,976,1012,1013,1015,102 0,1046,1047 P0 R(4) 4 24 scalar COM P0INV R(4) 4 72 scalar COM P0X2 R(4) 4 36 scalar COM P0XZP2 R(4) 4 28 scalar COM P0XZP8 R(4) 4 32 scalar COM QUARTR R(4) 4 48 scalar COM 968,1009 RADCON R(4) 4 40 scalar COM 809,1077,1208 RADCON1 R(4) 4 64 scalar COM 1094 RATCO2MW R(4) 4 56 scalar COM RATH2OMW R(4) 4 60 scalar COM RGAS R(4) 4 44 scalar COM RGASSP R(4) 4 48 scalar COM SECPDA R(4) 4 52 scalar COM SIXTY R(4) 4 8 scalar COM SKC1R R(4) 4 48 scalar COM 745,874,979 SKO2D R(4) 4 44 scalar COM SKO3R R(4) 4 52 scalar COM 743,872,977,1034 SOURCE R(4) 4 130560 2 420 COM 509,519,529,539,549,559,569,579,58 9,599,609,619,629,639 TABLE1 R(4) 4 49920 2 5040 COM TABLE2 R(4) 4 70080 2 5040 COM TABLE3 R(4) 4 90240 2 5040 COM TEMP1 R(4) 4 0 2 91719 COM TEMP10 R(4) 4 3301884 2 91719 COM TEMP11 R(4) 4 3668760 2 91719 COM TEMP12 R(4) 4 4035636 2 91719 COM TEMP13 R(4) 4 4402512 2 91719 COM TEMP14 R(4) 4 4769388 2 91719 COM TEMP15 R(4) 4 5136264 2 91719 COM TEMP16 R(4) 4 5503140 2 91719 COM Page 37 Source Listing FST88 2025-03-12 18:21 Symbol Table FST88.F Name Type Bytes Offset Dimen Elements Attributes References TEMP2 R(4) 4 366876 2 91719 COM TEMP2X R(4) 4 0 2 92971 COM TEMP3 R(4) 4 733752 2 91719 COM TEMP4 R(4) 4 1100628 2 91719 COM TEMP5 R(4) 4 1467504 2 91719 COM TEMP6 R(4) 4 1834380 2 91719 COM TEMP7 R(4) 4 2201256 2 91719 COM TEMP8 R(4) 4 2568132 2 91719 COM TEMP9 R(4) 4 2935008 2 91719 COM TEN R(4) 4 16 scalar COM 484,494 THREE R(4) 4 32 scalar COM TTVG R(4) 4 371884 2 92971 COM TWO R(4) 4 36 scalar COM 969,970 ZERO R(4) 4 52 scalar COM Page 38 Source Listing FST88 2025-03-12 18:21 Subprograms/Common Blocks FST88.F SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References BANDTA Common 285 5900 BDCOMB Common 354 736 SAVE BDWIDE Common 313 56 SAVE FST88 Subr 64 GLB_TABLE Common 199 128 SAVE HCON Common 78 872 SAVE MAPPINGS Common 218 5024 SAVE MPPCOM Common 163 1464 SAVE PHYCON Common 72 80 SAVE TABCOM Common 382 133920 SAVE TEMPCOM Common 204 6603768 SAVE TOPO Common 212 17478548 SAVE COMPILER OPTIONS BEING USED -align noall -align nonone -align nocommons -align nodcommons -align noqcommons -align nozcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -align norec32byte -align norec64byte -align noarray8byte -align noarray16byte -align noarray32byte -align noarray64byte -align noarray128byte -align noarray256byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume nobuffered_stdout -assume byterecl -assume nocontiguous_assumed_shape -assume nocontiguous_pointer -assume nocc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_complex_align -assume old_unit_star -assume old_inquire_recl -assume old_ldout_format -assume old_ldout_zero -assume noold_logical_assign -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume noprotect_allocates -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume std_minus0_rounding -assume nostd_mod_proc_name -assume std_value -assume realloc_lhs -assume underscore -assume no2underscores -assume norecursion no -auto -auto_scalar no -bintext -ccdefault default -check noarg_temp_created -check noassume -check nobounds -check nocontiguous -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check noshape -check nostack Page 39 Source Listing FST88 2025-03-12 18:21 FST88.F -check nouninitialized -check noudio_iostat -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1910 -D __INTEL_COMPILER_UPDATE=3 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D __amd64 -D __amd64__ -D __INTEL_COMPILER_BUILD_DATE=20200925 -D __INTEL_OFFLOAD -D __MMX__ -D __SSE__ -D __SSE_MATH__ -D __SSE2__ -D __SSE2_MATH__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __POPCNT__ -D __PCLMUL__ -D __AES__ -D __AVX__ -D __F16C__ -D __AVX_I__ -D __RDRND__ -D __FMA__ -D __FP_FAST_FMA -D __FP_FAST_FMAF -D __BMI__ -D __LZCNT__ -D __AVX2__ -D __haswell -D __haswell__ -D __tune_haswell__ -D __core_avx2 -D __core_avx2__ -D __tune_core_avx2__ -D __CRAY_X86_ROME -D __CRAYXT_COMPUTE_LINUX_TARGET -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals -fixed no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model precise -fp_model nofast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -fp_modbits nofp_contract -fp_modbits nono_fp_contract -fp_modbits nofenv_access -fp_modbits nono_fenv_access -fp_modbits nocx_limited_range -fp_modbits nono_cx_limited_range -fp_modbits noprec_div -fp_modbits nono_prec_div -fp_modbits noprec_sqrt -fp_modbits nono_prec_sqrt -fp_modbits noftz -fp_modbits no_ftz -fp_modbits nointrin_limited_range -fp_modbits nono_intrin_limited_range -fp_modbits notrunc_compares -fp_modbits nono_trunc_compares -fp_modbits noieee_nan_compares -fp_modbits nono_ieee_nan_compares -fp_modbits nohonor_f32_conversion -fp_modbits nono_honor_f32_conversion -fp_modbits nohonor_f64_conversion -fp_modbits nono_honor_f64_conversion -fp_modbits nono_x87_copy -fp_modbits nono_no_x87_copy -fp_modbits noexception_semantics -fp_modbits nono_exception_semantics -fp_modbits noprecise_libm_functions -fp_modbits nono_precise_libm_functions -heap_arrays 0 no -threadprivate_compat -g2 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg -init noarrays -init nohuge -init noinfinity Page 40 Source Listing FST88 2025-03-12 18:21 FST88.F -init nominus_huge -init nominus_infinity -init nominus_tiny -init nonan -init nosnan -init notiny -init nozero no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude no -o -offload-build=host -openmp-simd -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded -vec=simd -show nofullpath -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w nodeclarations -w noexternals -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w noshape -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage no -wrap-margins -includepath : /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/, .f90,./.f90,/opt/cray/pe/mpich/8.1.12/ofi/intel/19.0/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/ipp/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/mkl/include/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/pstl/stdlib/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/tbb/include/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/intel64/.f90,/pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/icc/.f90, /pe/intel/compilers_and_libraries_2020.4.304/linux/compiler/include/.f90,/usr/lib64/gcc/x86_64-suse-linux/7/include/.f90, /usr/lib64/gcc/x86_64-suse-linux/7/include-fixed/.f90,/usr/include/.f90,/usr/include/.f90,/usr/include/.f90 -list filename : FST88.lst no -o COMPILER: Intel(R) Fortran 19.1-1655