| blob | 1108e064147de2788a3204723be60397d54dd65b |
2 MODULE module_ra_rrtm
4 ! Parameters
6 INTEGER, PRIVATE :: IDATA
7 INTEGER, PARAMETER :: MG=16
8 INTEGER, PARAMETER :: NBANDS=16
9 INTEGER, PARAMETER :: NGPT=140
10 INTEGER, PARAMETER :: NG1=8
11 INTEGER, PARAMETER :: NG2=14
12 INTEGER, PARAMETER :: NG3=16
13 INTEGER, PARAMETER :: NG4=14
14 INTEGER, PARAMETER :: NG5=16
15 INTEGER, PARAMETER :: NG6=8
16 INTEGER, PARAMETER :: NG7=12
17 INTEGER, PARAMETER :: NG8=8
18 INTEGER, PARAMETER :: NG9=12
19 INTEGER, PARAMETER :: NG10=6
20 INTEGER, PARAMETER :: NG11=8
21 INTEGER, PARAMETER :: NG12=8
22 INTEGER, PARAMETER :: NG13=4
23 INTEGER, PARAMETER :: NG14=2
24 INTEGER, PARAMETER :: NG15=2
25 INTEGER, PARAMETER :: NG16=2
26 INTEGER, PARAMETER :: MAXINPX=35
27 INTEGER, PARAMETER :: MAXXSEC=4
29 INTEGER, PARAMETER :: NMOL = 6
30 REAL, PARAMETER :: ONEMINUS = 1. - 1.E-6
31 REAL, PARAMETER :: deltap = 4. ! Pressure interval for buffer layer in mb
33 ! var
35 REAL , SAVE :: FLUXFAC
36 INTEGER , SAVE :: NLAYERS
37 !
38 ! data 1
39 !
40 REAL,SAVE :: abscoefL1(5,13,MG), abscoefH1(5,13:59,MG), &
41 SELFREF1(10,MG)
42 REAL,SAVE :: abscoefL2(5,13,MG), abscoefH2(5,13:59,MG), &
43 SELFREF2(10,MG)
44 REAL,SAVE :: abscoefL3(10,5,13,MG), abscoefH3(5,5,13:59,MG), &
45 SELFREF3(10,MG)
46 REAL,SAVE :: abscoefL4(9,5,13,MG), abscoefH4(6,5,13:59,MG), &
47 SELFREF4(10,MG)
48 REAL,SAVE :: abscoefL5(9,5,13,MG), abscoefH5(5,5,13:59,MG), &
49 SELFREF5(10,MG)
50 REAL,SAVE :: abscoefL6(5,13,MG), SELFREF6(10,MG)
51 REAL,SAVE :: abscoefL7(9,5,13,MG), abscoefH7(5,13:59,MG), &
52 SELFREF7(10,MG)
53 REAL,SAVE :: abscoefL8(5,7,MG), abscoefH8(5,7:59,MG), &
54 SELFREF8(10,MG)
55 REAL,SAVE :: abscoefL9(11,5,13,MG), abscoefH9(5,13:59,MG), &
56 SELFREF9(10,MG)
57 REAL,SAVE :: abscoefL10(5,13,MG), abscoefH10(5,13:59,MG)
58 REAL,SAVE :: abscoefL11(5,13,MG), abscoefH11(5,13:59,MG), &
59 SELFREF11(10,MG)
60 REAL,SAVE :: abscoefL12(9,5,13,MG), SELFREF12(10,MG)
61 REAL,SAVE :: abscoefL13(9,5,13,MG), SELFREF13(10,MG)
62 REAL,SAVE :: abscoefL14(5,13,MG), abscoefH14(5,13:59,MG), &
63 SELFREF14(10,MG)
64 REAL,SAVE :: abscoefL15(9,5,13,MG), SELFREF15(10,MG)
65 REAL,SAVE :: abscoefL16(9,5,13,MG), SELFREF16(10,MG)
67 !
68 ! data 2
69 !
70 INTEGER,SAVE :: NGM(MG*NBANDS), NGC(NBANDS), NGS(NBANDS), &
71 NGN(NGPT), NGB(NGPT)
72 REAL,SAVE :: WT(MG)
73 !
74 ! data 3
75 !
76 REAL,SAVE :: FRACREFA1(MG), FRACREFB1(MG), FORREF1(MG)
77 REAL,SAVE :: FRACREFA2(MG,13), FRACREFB2(MG), FORREF2(MG)
78 REAL,SAVE :: FRACREFA3(MG,10), FRACREFB3(MG,5)
79 REAL,SAVE :: FORREF3(MG), ABSN2OA3(MG), ABSN2OB3(MG)
80 REAL,SAVE :: FRACREFA4(MG,9), FRACREFB4(MG,6)
81 REAL,SAVE :: FRACREFA5(MG,9), FRACREFB5(MG,5), CCL45(MG)
82 REAL,SAVE :: FRACREFA6(MG), ABSCO26(MG), CFC11ADJ6(MG), CFC126(MG)
83 REAL,SAVE :: FRACREFA7(MG,9), FRACREFB7(MG), ABSCO27(MG)
84 REAL,SAVE :: FRACREFA8(MG), FRACREFB8(MG), ABSCO2A8(MG), ABSCO2B8(MG)
85 REAL,SAVE :: ABSN2OA8(MG), ABSN2OB8(MG), CFC128(MG), CFC22ADJ8(MG)
86 REAL,SAVE :: FRACREFA9(MG,9), FRACREFB9(MG), ABSN2O9(3*MG)
87 REAL,SAVE :: FRACREFA10(MG), FRACREFB10(MG)
88 REAL,SAVE :: FRACREFA11(MG), FRACREFB11(MG)
89 REAL,SAVE :: FRACREFA12(MG,9)
90 REAL,SAVE :: FRACREFA13(MG,9)
91 REAL,SAVE :: FRACREFA14(MG), FRACREFB14(MG)
92 REAL,SAVE :: FRACREFA15(MG,9)
93 REAL,SAVE :: FRACREFA16(MG,9)
94 !
95 ! data 4
96 !
97 INTEGER,SAVE :: NXMOL, IXINDX(MAXINPX)
99 ! data 5
101 REAL,SAVE :: WAVENUM1(NBANDS),WAVENUM2(NBANDS),DELWAVE(NBANDS)
103 ! data 6
105 INTEGER,SAVE :: NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS)
106 REAL, SAVE :: HEATFAC
107 REAL, SAVE :: PREF(59),PREFLOG(59),TREF(59)
109 ! data 7
111 REAL, SAVE :: TOTPLNK(181,NBANDS), TOTPLK16(181)
113 ! data
115 REAL, SAVE :: TAU(0:5000),TF(0:5000),TRANS(0:5000)
116 !
117 REAL, SAVE :: ABSA1(5*13,NG1), ABSB1(5*(59-13+1),NG1), &
118 SELFREFC1(10,NG1), FORREFC1(NG1)
119 REAL, SAVE :: ABSA2(5*13,NG2), ABSB2(5*(59-13+1),NG2), &
120 SELFREFC2(10,NG2), FORREFC2(NG2)
121 REAL, SAVE :: ABSA3(10*5*13,NG3), ABSB3(5*5*(59-13+1),NG3), &
122 SELFREFC3(10,NG3), FORREFC3(NG3), &
123 ABSN2OAC3(NG3), ABSN2OBC3(NG3)
124 REAL, SAVE :: ABSA4(9*5*13,NG4), ABSB4(6*5*(59-13+1),NG4), &
125 SELFREFC4(10,NG4)
126 REAL, SAVE :: ABSA5(9*5*13,NG5), ABSB5(5*5*(59-13+1),NG5), &
127 SELFREFC5(10,NG5), CCL4C5(NG5)
128 REAL, SAVE :: ABSA6(5*13,NG6), SELFREFC6(10,NG6), &
129 ABSCO2C6(NG6), CFC11ADJC6(NG6), CFC12C6(NG6)
130 REAL, SAVE :: ABSA7(9*5*13,NG7), ABSB7(5*(59-13+1),NG7), &
131 SELFREFC7(10,NG7), ABSCO2C7(NG7)
132 REAL, SAVE :: ABSA8(5*7,NG8), ABSB8(5*(59-7+1),NG8), &
133 SELFREFC8(10,NG8), &
134 ABSCO2AC8(NG8), ABSCO2BC8(NG8), &
135 ABSN2OAC8(NG8), ABSN2OBC8(NG8), &
136 CFC12C8(NG8), CFC22ADJC8(NG8)
137 REAL, SAVE :: ABSA9(11*5*13,NG9), ABSB9(5*(59-13+1),NG9), &
138 SELFREFC9(10,NG9), ABSN2OC9(3*NG9)
139 REAL, SAVE :: ABSA10(5*13,NG10), ABSB10(5*(59-13+1),NG10)
140 REAL, SAVE :: ABSA11(5*13,NG11), ABSB11(5*(59-13+1),NG11), &
141 SELFREFC11(10,NG11)
142 REAL, SAVE :: ABSA12(9*5*13,NG12), SELFREFC12(10,NG12)
143 REAL, SAVE :: ABSA13(9*5*13,NG13), SELFREFC13(10,NG13)
144 REAL, SAVE :: ABSA14(5*13,NG14), ABSB14(5*(59-13+1),NG14), &
145 SELFREFC14(10,NG14)
146 REAL, SAVE :: ABSA15(9*5*13,NG15), SELFREFC15(10,NG15)
147 REAL, SAVE :: ABSA16(9*5*13,NG16), SELFREFC16(10,NG16)
149 REAL, SAVE :: FRACREFAC1(NG1), FRACREFBC1(NG1)
150 REAL, SAVE :: FRACREFAC2(NG2,13), FRACREFBC2(NG2)
151 REAL, SAVE :: FRACREFAC3(NG3,10), FRACREFBC3(NG3,5)
152 REAL, SAVE :: FRACREFAC4(NG4,9), FRACREFBC4(NG4,6)
153 REAL, SAVE :: FRACREFAC5(NG5,9), FRACREFBC5(NG5,5)
154 REAL, SAVE :: FRACREFAC6(NG6)
155 REAL, SAVE :: FRACREFAC7(NG7,9), FRACREFBC7(NG7)
156 REAL, SAVE :: FRACREFAC8(NG8), FRACREFBC8(NG8)
157 REAL, SAVE :: FRACREFAC9(NG9,9), FRACREFBC9(NG9)
158 REAL, SAVE :: FRACREFAC10(NG10), FRACREFBC10(NG10)
159 REAL, SAVE :: FRACREFAC11(NG11), FRACREFBC11(NG11)
160 REAL, SAVE :: FRACREFAC12(NG12,9)
161 REAL, SAVE :: FRACREFAC13(NG13,9)
162 REAL, SAVE :: FRACREFAC14(NG14), FRACREFBC14(NG14)
163 REAL, SAVE :: FRACREFAC15(NG15,9)
164 REAL, SAVE :: FRACREFAC16(NG16,9)
166 REAL, SAVE :: CORR1(0:200),CORR2(0:200)
167 REAL, SAVE :: BPADE
168 REAL, SAVE :: RWGT(MG*NBANDS)
170 !----------------------------------------------------------------------------
171 !
172 ! start data 2
174 ! Arrays for the g-point reduction from 256 to 140 for the 16 LW bands:
175 ! This mapping from 256 to 140 points has been carefully selected to
176 ! minimize the effect on the resulting fluxes and cooling rates, and
177 ! caution should be used if the mapping is modified.
178 !
179 ! NGPT The total number of new g-points
180 ! NGC The number of new g-points in each band
181 ! NGM The index of each new g-point relative to the original
182 ! 16 g-points for each band.
183 ! NGN The number of original g-points that are combined to make
184 ! each new g-point in each band.
185 ! NGB The band index for each new g-point.
186 ! WT RRTM weights for 16 g-points.
188 ! Data Statements
189 DATA NGC /8,14,16,14,16,8,12,8,12,6,8,8,4,2,2,2/
190 DATA NGS /8,22,38,52,68,76,88,96,108,114,122,130,134,136,138,140/
191 DATA NGM /1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! Band 1
192 1,2,3,4,5,6,7,8,9,10,11,12,13,13,14,14, & ! Band 2
193 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! Band 3
194 1,2,3,4,5,6,7,8,9,10,11,12,13,14,14,14, & ! Band 4
195 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16, & ! Band 5
196 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! Band 6
197 1,1,2,2,3,4,5,6,7,8,9,10,11,11,12,12, & ! Band 7
198 1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8, & ! Band 8
199 1,2,3,4,5,6,7,8,9,9,10,10,11,11,12,12, & ! Band 9
200 1,1,2,2,3,3,4,4,5,5,5,5,6,6,6,6, & ! Band 10
201 1,2,3,3,4,4,5,5,6,6,7,7,7,8,8,8, & ! Band 11
202 1,2,3,4,5,5,6,6,7,7,7,7,8,8,8,8, & ! Band 12
203 1,1,1,2,2,2,3,3,3,3,4,4,4,4,4,4, & ! Band 13
204 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! Band 14
205 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2, & ! Band 15
206 1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2/ ! Band 16
207 DATA NGN /2,2,2,2,2,2,2,2, & ! Band 1
208 1,1,1,1,1,1,1,1,1,1,1,1,2,2, & ! Band 2
209 16*1, & ! Band 3
210 1,1,1,1,1,1,1,1,1,1,1,1,1,3, & ! Band 4
211 16*1, & ! Band 5
212 2,2,2,2,2,2,2,2, & ! Band 6
213 2,2,1,1,1,1,1,1,1,1,2,2, & ! Band 7
214 2,2,2,2,2,2,2,2, & ! Band 8
215 1,1,1,1,1,1,1,1,2,2,2,2, & ! Band 9
216 2,2,2,2,4,4, & ! Band 10
217 1,1,2,2,2,2,3,3, & ! Band 11
218 1,1,1,1,2,2,4,4, & ! Band 12
219 3,3,4,6, & ! Band 13
220 8,8, & ! Band 14
221 8,8, & ! Band 15
222 8,8/ ! Band 16
223 DATA NGB /8*1, & ! Band 1
224 14*2, & ! Band 2
225 16*3, & ! Band 3
226 14*4, & ! Band 4
227 16*5, & ! Band 5
228 8*6, & ! Band 6
229 12*7, & ! Band 7
230 8*8, & ! Band 8
231 12*9, & ! Band 9
232 6*10, & ! Band 10
233 8*11, & ! Band 11
234 8*12, & ! Band 12
235 4*13, & ! Band 13
236 2*14, & ! Band 14
237 2*15, & ! Band 15
238 2*16/ ! Band 16
239 DATA WT/ &
240 0.1527534276,0.1491729617,0.1420961469,0.1316886544, &
241 0.1181945205,0.1019300893,0.0832767040,0.0626720116, &
242 0.0424925,0.0046269894,0.0038279891,0.0030260086, &
243 0.0022199750,0.0014140010,0.000533,0.000075/
245 !
246 ! end of data 2
247 !
248 !-----------------------------------------------------------------------
250 ! start data 3
253 ! Data
255 DATA FRACREFA1/ &
256 0.08452097,0.17952873,0.16214369,0.13602182, &
257 0.12760490,0.10302561,0.08392423,0.06337652, &
258 0.04206551,0.00487497,0.00410743,0.00344421, &
259 0.00285731,0.00157327,0.00080648,0.00012406/
260 DATA FRACREFB1/ &
261 0.15492001,0.17384727,0.15165100,0.12675308, &
262 0.10986247,0.09006091,0.07584465,0.05990077, &
263 0.04113461,0.00438638,0.00374754,0.00313924, &
264 0.00234381,0.00167167,0.00062744,0.00010889/
266 DATA FORREF1/ &
267 -4.50470E-02,-1.18908E-01,-7.21730E-02,-2.83862E-02, &
268 -3.01961E-02,-1.56877E-02,-1.53684E-02,-1.29135E-02, &
269 -1.27963E-02,-1.81742E-03, 4.40008E-05, 1.05260E-02, &
270 2.17290E-02, 1.65571E-02, 7.60751E-02, 1.47405E-01/
273 ! Data
275 ! The ith set of reference fractions are from the ith reference
276 ! pressure level.
278 DATA FRACREFA2/ &
279 0.18068060,0.16803175,0.15140158,0.12221480, 0.10240850,0.09330297,0.07518960,0.05611294, &
280 0.03781487,0.00387192,0.00321285,0.00244440, 0.00179546,0.00107704,0.00038798,0.00005060, &
281 0.17927621,0.16731168,0.15129538,0.12328085, 0.10243484,0.09354796,0.07538418,0.05633071, &
282 0.03810832,0.00398347,0.00320262,0.00250029, 0.00178666,0.00111127,0.00039438,0.00005169, &
283 0.17762886,0.16638555,0.15115446,0.12470623, 0.10253213,0.09383459,0.07560240,0.05646568, &
284 0.03844077,0.00409142,0.00322521,0.00254918, 0.00179296,0.00113652,0.00040169,0.00005259, &
285 0.17566043,0.16539773,0.15092199,0.12571971, 0.10340609,0.09426189,0.07559051,0.05678188, &
286 0.03881499,0.00414102,0.00328551,0.00258795, 0.00181648,0.00115145,0.00040969,0.00005357, &
287 0.17335825,0.16442548,0.15070701,0.12667464, 0.10452303,0.09450833,0.07599410,0.05706393, &
288 0.03910370,0.00417880,0.00335256,0.00261708, 0.00185491,0.00116627,0.00041759,0.00005464, &
289 0.17082544,0.16321516,0.15044247,0.12797612, 0.10574646,0.09470057,0.07647423,0.05738756, &
290 0.03935621,0.00423789,0.00342651,0.00264549, 0.00190188,0.00118281,0.00042592,0.00005583, &
291 0.16809277,0.16193336,0.15013184,0.12937409, 0.10720784,0.09485368,0.07692636,0.05771774, &
292 0.03966988,0.00427754,0.00349696,0.00268946, 0.00193536,0.00120222,0.00043462,0.00005712, &
293 0.16517997,0.16059248,0.14984852,0.13079269, 0.10865030,0.09492947,0.07759736,0.05812201, &
294 0.03997169,0.00432356,0.00355308,0.00274031, 0.00197243,0.00122401,0.00044359,0.00005849, &
295 0.16209179,0.15912023,0.14938223,0.13198245, 0.11077233,0.09487948,0.07831636,0.05863440, &
296 0.04028239,0.00436804,0.00360407,0.00279885, 0.00200364,0.00124861,0.00045521,0.00005996, &
297 0.15962425,0.15789343,0.14898103,0.13275230, 0.11253940,0.09503502,0.07884382,0.05908009, &
298 0.04053524,0.00439971,0.00364269,0.00284965, 0.00202758,0.00127076,0.00046408,0.00006114, &
299 0.15926200,0.15770932,0.14891729,0.13283882, 0.11276010,0.09507311,0.07892222,0.05919230, &
300 0.04054824,0.00440833,0.00365575,0.00286459, 0.00203786,0.00128405,0.00046504,0.00006146, &
301 0.15926351,0.15770483,0.14891177,0.13279966, 0.11268171,0.09515216,0.07890341,0.05924807, &
302 0.04052851,0.00440870,0.00365425,0.00286878, 0.00205747,0.00128916,0.00046589,0.00006221, &
303 0.15937765,0.15775780,0.14892603,0.13273248, 0.11252731,0.09521657,0.07885858,0.05927679, &
304 0.04050184,0.00440285,0.00365748,0.00286791, 0.00207507,0.00129193,0.00046679,0.00006308/
305 ! From P = 0.432 mb.
306 DATA FRACREFB2/ &
307 0.17444289,0.16467269,0.15021490,0.12460902, &
308 0.10400643,0.09481928,0.07590704,0.05752856, &
309 0.03931715,0.00428572,0.00349352,0.00278938, &
310 0.00203448,0.00130037,0.00051560,0.00006255/
312 DATA FORREF2/ &
313 -2.34550E-03,-8.42698E-03,-2.01816E-02,-5.66701E-02, &
314 -8.93189E-02,-6.37487E-02,-4.56455E-02,-4.41417E-02, &
315 -4.48605E-02,-4.74696E-02,-5.16648E-02,-5.63099E-02, &
316 -4.74781E-02,-3.84704E-02,-2.49905E-02, 2.02114E-03/
318 ! Data
320 DATA FRACREFA3/ &
321 ! From P = 1053.6 mb.
322 0.15116400,0.14875700,0.14232300,0.13234501, 0.11881600,0.10224100,0.08345580,0.06267490, &
323 0.04250650,0.00462650,0.00382259,0.00302600, 0.00222004,0.00141397,0.00053379,0.00007421, &
324 0.15266000,0.14888400,0.14195900,0.13179500, 0.11842700,0.10209000,0.08336130,0.06264370, &
325 0.04247660,0.00461946,0.00381536,0.00302601, 0.00222004,0.00141397,0.00053302,0.00007498, &
326 0.15282799,0.14903000,0.14192399,0.13174300, 0.11835300,0.10202700,0.08329830,0.06264830, &
327 0.04246910,0.00460242,0.00381904,0.00301573, 0.00222004,0.00141397,0.00053379,0.00007421, &
328 0.15298399,0.14902800,0.14193401,0.13173500, 0.11833300,0.10195800,0.08324730,0.06264770, &
329 0.04246490,0.00460489,0.00381123,0.00301893, 0.00221093,0.00141397,0.00053379,0.00007421, &
330 0.15307599,0.14907201,0.14198899,0.13169800, 0.11827300,0.10192300,0.08321600,0.06263490, &
331 0.04245600,0.00460846,0.00380836,0.00301663, 0.00221402,0.00141167,0.00052807,0.00007376, &
332 0.15311401,0.14915401,0.14207301,0.13167299, 0.11819300,0.10188900,0.08318760,0.06261960, &
333 0.04243890,0.00461584,0.00380929,0.00300815, 0.00221736,0.00140588,0.00052776,0.00007376, &
334 0.15316001,0.14925499,0.14213000,0.13170999, 0.11807700,0.10181400,0.08317400,0.06260300, &
335 0.04242720,0.00461520,0.00381381,0.00301285, 0.00220275,0.00140371,0.00052776,0.00007376, &
336 0.15321200,0.14940999,0.14222500,0.13164200, 0.11798200,0.10174500,0.08317500,0.06253640, &
337 0.04243130,0.00461724,0.00381534,0.00300320, 0.00220091,0.00140364,0.00052852,0.00007300, &
338 0.15312800,0.14973100,0.14234400,0.13168900, 0.11795200,0.10156100,0.08302990,0.06252240, &
339 0.04240980,0.00461035,0.00381381,0.00300176, 0.00220160,0.00140284,0.00052774,0.00007376, &
340 0.15292500,0.14978001,0.14242400,0.13172600, 0.11798800,0.10156400,0.08303050,0.06251670, &
341 0.04240970,0.00461302,0.00381452,0.00300250, 0.00220126,0.00140324,0.00052850,0.00007300/
342 DATA FRACREFB3/ &
343 ! From P = 64.1 mb.
344 0.16340201,0.15607700,0.14601400,0.13182700, &
345 0.11524700,0.09666570,0.07825360,0.05849780, &
346 0.03949650,0.00427980,0.00353719,0.00279303, &
347 0.00204788,0.00130139,0.00049055,0.00006904, &
348 0.15762900,0.15494700,0.14659800,0.13267800, &
349 0.11562700,0.09838360,0.07930420,0.05962700, &
350 0.04036360,0.00438053,0.00361463,0.00285723, &
351 0.00208345,0.00132135,0.00050528,0.00008003, &
352 0.15641500,0.15394500,0.14633600,0.13180400, &
353 0.11617100,0.09924170,0.08000510,0.06021420, &
354 0.04082730,0.00441694,0.00365364,0.00287723, &
355 0.00210914,0.00135784,0.00054651,0.00008003, &
356 0.15482700,0.15286300,0.14392500,0.13244100, &
357 0.11712000,0.09994920,0.08119200,0.06104360, &
358 0.04135600,0.00446685,0.00368377,0.00290767, &
359 0.00215445,0.00142865,0.00056142,0.00008003, &
360 0.15975100,0.15653500,0.14214399,0.12892200, &
361 0.11508400,0.09906020,0.08087940,0.06078190, &
362 0.04140530,0.00452724,0.00374558,0.00295328, &
363 0.00218509,0.00138644,0.00056018,0.00008003/
365 DATA ABSN2OA3/ &
366 1.50387E-01,2.91407E-01,6.28803E-01,9.65619E-01, &
367 1.15054E-00,2.23424E-00,1.83392E-00,1.39033E-00, &
368 4.28457E-01,2.73502E-01,1.84307E-01,1.61325E-01, &
369 7.66314E-02,1.33862E-01,6.71196E-07,1.59293E-06/
370 DATA ABSN2OB3/ &
371 9.37044E-05,1.23318E-03,7.91720E-03,5.33005E-02, &
372 1.72343E-01,4.29571E-01,1.01288E+00,3.83863E+00, &
373 1.15312E+01,1.08383E+00,2.24847E+00,1.51268E+00, &
374 3.33177E-01,7.82102E-01,3.44631E-01,1.61039E-03/
375 DATA FORREF3/ &
376 1.76842E-04, 1.77913E-04, 1.25186E-04, 1.07912E-04, &
377 1.05217E-04, 7.48726E-05, 1.11701E-04, 7.68921E-05, &
378 9.87242E-05, 9.85711E-05, 6.16557E-05,-1.61291E-05, &
379 -1.26794E-04,-1.19011E-04,-2.67814E-04, 6.95005E-05/
381 ! Data
383 DATA FRACREFA4/ &
384 ! From P =
385 0.15579100,0.14918099,0.14113800,0.13127001, &
386 0.11796300,0.10174300,0.08282370,0.06238150, &
387 0.04213440,0.00458968,0.00377949,0.00298736, &
388 0.00220743,0.00140644,0.00053024,0.00007459, &
389 0.15292799,0.15004000,0.14211500,0.13176700, &
390 0.11821100,0.10186300,0.08288040,0.06241390, &
391 0.04220720,0.00459006,0.00377919,0.00298743, &
392 0.00220743,0.00140644,0.00053024,0.00007459, &
393 0.14386199,0.15125300,0.14650001,0.13377000, &
394 0.11895900,0.10229400,0.08312110,0.06239520, &
395 0.04225560,0.00459428,0.00378865,0.00298860, &
396 0.00220743,0.00140644,0.00053024,0.00007459, &
397 0.14359100,0.14561599,0.14479300,0.13740200, &
398 0.12150100,0.10315400,0.08355480,0.06247240, &
399 0.04230980,0.00459916,0.00378373,0.00300063, &
400 0.00221111,0.00140644,0.00053024,0.00007459, &
401 0.14337599,0.14451601,0.14238000,0.13520500, &
402 0.12354200,0.10581200,0.08451810,0.06262440, &
403 0.04239590,0.00460297,0.00378701,0.00300466, &
404 0.00221899,0.00141020,0.00053024,0.00007459, &
405 0.14322001,0.14397401,0.14117201,0.13401900, &
406 0.12255500,0.10774100,0.08617650,0.06296420, &
407 0.04249590,0.00463406,0.00378241,0.00302037, &
408 0.00221583,0.00141103,0.00053814,0.00007991, &
409 0.14309500,0.14364301,0.14043900,0.13348100, &
410 0.12211600,0.10684700,0.08820590,0.06374610, &
411 0.04264730,0.00464231,0.00384022,0.00303427, &
412 0.00221825,0.00140943,0.00055564,0.00007991, &
413 0.15579100,0.14918099,0.14113800,0.13127001, &
414 0.11796300,0.10174300,0.08282370,0.06238150, &
415 0.04213440,0.00458968,0.00377949,0.00298736, &
416 0.00220743,0.00140644,0.00053024,0.00007459, &
417 0.15937001,0.15159500,0.14242800,0.13078900, &
418 0.11671300,0.10035700,0.08143450,0.06093850, &
419 0.04105320,0.00446233,0.00369844,0.00293784, &
420 0.00216425,0.00143403,0.00054571,0.00007991/
421 DATA FRACREFB4/ &
422 ! From P = 1.17 mb.
423 0.15558299,0.14930600,0.14104301,0.13124099, &
424 0.11792900,0.10159200,0.08314130,0.06240450, &
425 0.04217020,0.00459313,0.00379798,0.00299835, &
426 0.00218950,0.00140615,0.00053010,0.00007457, &
427 0.15592700,0.14918999,0.14095700,0.13115700, &
428 0.11788900,0.10158000,0.08313780,0.06240240, &
429 0.04217000,0.00459313,0.00379798,0.00299835, &
430 0.00218950,0.00140615,0.00053010,0.00007457, &
431 0.15949000,0.15014900,0.14162201,0.13080800, &
432 0.11713500,0.10057100,0.08170080,0.06128110, &
433 0.04165600,0.00459202,0.00379835,0.00299717, &
434 0.00218958,0.00140616,0.00053010,0.00007457, &
435 0.15967900,0.15038200,0.14196999,0.13074800, &
436 0.11701700,0.10053000,0.08160790,0.06122690, &
437 0.04128310,0.00456598,0.00379486,0.00299457, &
438 0.00219016,0.00140619,0.00053011,0.00007456, &
439 0.15989800,0.15057300,0.14207700,0.13068600, &
440 0.11682900,0.10053900,0.08163610,0.06121870, &
441 0.04121690,0.00449061,0.00371235,0.00294207, &
442 0.00217778,0.00139877,0.00053011,0.00007455, &
443 0.15950100,0.15112500,0.14199100,0.13071300, &
444 0.11680800,0.10054600,0.08179050,0.06120910, &
445 0.04126050,0.00444324,0.00366843,0.00289369, &
446 0.00211550,0.00134746,0.00050874,0.00007863/
448 ! Data
450 DATA FRACREFA5/ &
451 ! From P = 387.6 mb.
452 0.13966499,0.14138900,0.13763399,0.13076700, &
453 0.12299100,0.10747700,0.08942000,0.06769200, &
454 0.04587610,0.00501173,0.00415809,0.00328398, &
455 0.00240015,0.00156222,0.00059104,0.00008323, &
456 0.13958199,0.14332899,0.13785399,0.13205400, &
457 0.12199700,0.10679600,0.08861080,0.06712320, &
458 0.04556030,0.00500863,0.00416315,0.00328629, &
459 0.00240023,0.00156220,0.00059104,0.00008323, &
460 0.13907100,0.14250501,0.13889600,0.13297300, &
461 0.12218700,0.10683800,0.08839260,0.06677310, &
462 0.04538570,0.00495402,0.00409863,0.00328219, &
463 0.00240805,0.00156266,0.00059104,0.00008323, &
464 0.13867700,0.14190100,0.13932300,0.13327099, &
465 0.12280800,0.10692500,0.08844510,0.06658510, &
466 0.04519340,0.00492276,0.00408832,0.00323856, &
467 0.00239289,0.00155698,0.00059104,0.00008323, &
468 0.13845000,0.14158800,0.13929300,0.13295600, &
469 0.12348300,0.10736700,0.08859480,0.06650610, &
470 0.04498230,0.00491335,0.00406968,0.00322901, &
471 0.00234666,0.00155235,0.00058813,0.00008323, &
472 0.13837101,0.14113200,0.13930500,0.13283101, &
473 0.12349200,0.10796400,0.08890490,0.06646480, &
474 0.04485990,0.00489554,0.00405264,0.00320313, &
475 0.00234742,0.00151159,0.00058438,0.00008253, &
476 0.13834500,0.14093500,0.13896500,0.13262001, &
477 0.12326900,0.10828900,0.08950050,0.06674610, &
478 0.04476560,0.00489624,0.00400962,0.00317423, &
479 0.00233479,0.00148249,0.00058590,0.00008253, &
480 0.13831300,0.14069000,0.13871400,0.13247600, &
481 0.12251400,0.10831300,0.08977090,0.06776920, &
482 0.04498390,0.00484111,0.00398948,0.00316069, &
483 0.00229741,0.00150104,0.00058608,0.00008253, &
484 0.14027201,0.14420401,0.14215700,0.13446601, &
485 0.12303700,0.10596100,0.08650370,0.06409570, &
486 0.04312310,0.00471110,0.00393954,0.00310850, &
487 0.00229588,0.00146366,0.00058194,0.00008253/
488 DATA FRACREFB5/ &
489 ! From P = 1.17 mb.
490 0.14339100,0.14358699,0.13935301,0.13306700, &
491 0.12135700,0.10590600,0.08688240,0.06553220, &
492 0.04446740,0.00483580,0.00399413,0.00316225, &
493 0.00233007,0.00149135,0.00056246,0.00008059, &
494 0.14330500,0.14430299,0.14053699,0.13355300, &
495 0.12151200,0.10529100,0.08627630,0.06505230, &
496 0.04385850,0.00476555,0.00395010,0.00313878, &
497 0.00232273,0.00149354,0.00056246,0.00008059, &
498 0.14328399,0.14442700,0.14078601,0.13390100, &
499 0.12132600,0.10510600,0.08613660,0.06494630, &
500 0.04381310,0.00475378,0.00394166,0.00313076, &
501 0.00231235,0.00149159,0.00056301,0.00008059, &
502 0.14326900,0.14453100,0.14114200,0.13397101, &
503 0.12127200,0.10493400,0.08601380,0.06483360, &
504 0.04378900,0.00474655,0.00393549,0.00312583, &
505 0.00230686,0.00148433,0.00056502,0.00008059, &
506 0.14328900,0.14532700,0.14179000,0.13384600, &
507 0.12093700,0.10461500,0.08573010,0.06461340, &
508 0.04366570,0.00473087,0.00392539,0.00311238, &
509 0.00229865,0.00147572,0.00056517,0.00007939/
511 DATA CCL45/ &
512 26.1407, 53.9776, 63.8085, 36.1701, &
513 15.4099, 10.23116, 4.82948, 5.03836, &
514 1.75558,0.,0.,0., &
515 0.,0.,0.,0./
517 ! Data
519 DATA FRACREFA6/ &
520 ! From P = 706 mb.
521 0.13739009,0.14259538,0.14033118,0.13547136, &
522 0.12569460,0.11028396,0.08626066,0.06245148, &
523 0.04309394,0.00473551,0.00403920,0.00321695, &
524 0.00232470,0.00147662,0.00056095,0.00007373/
526 DATA CFC11ADJ6/ &
527 0., 0., 36.7627, 150.757, &
528 81.4109, 74.9112, 56.9325, 49.3226, &
529 57.1074, 66.1202, 109.557, 89.0562, &
530 149.865, 196.140, 258.393, 80.9923/
531 DATA CFC126/ &
532 62.8368, 43.2626, 26.7549, 22.2487, &
533 23.5029, 34.8323, 26.2335, 23.2306, &
534 18.4062, 13.9534, 22.6268, 24.2604, &
535 30.0088, 26.3634, 15.8237, 57.5050/
536 DATA ABSCO26/ &
537 7.44852E-05, 6.29208E-05, 7.34031E-05, 6.65218E-05, &
538 7.87511E-05, 1.22489E-04, 3.39785E-04, 9.33040E-04, &
539 1.54323E-03, 4.07220E-04, 4.34332E-04, 8.76418E-05, &
540 9.80381E-05, 3.51680E-05, 5.31766E-05, 1.01542E-05/
542 ! Data
544 DATA FRACREFA7/ &
545 0.16461779, 0.14889984, 0.14233345, 0.13156526, &
546 0.11679733, 0.09988949, 0.08078653, 0.06006384, &
547 0.04028391, 0.00435899, 0.00359173, 0.00281707, &
548 0.00206767, 0.00135012, 0.00050720, 0.00007146, &
549 0.16442357, 0.14944240, 0.14245804, 0.13111183, &
550 0.11688625, 0.09983791, 0.08085148, 0.05993948, &
551 0.04028057, 0.00435939, 0.00358708, 0.00284036, &
552 0.00208869, 0.00133256, 0.00049260, 0.00006931, &
553 0.16368519, 0.15018989, 0.14262174, 0.13084342, &
554 0.11682195, 0.09996257, 0.08074036, 0.05985692, &
555 0.04045362, 0.00436208, 0.00358257, 0.00287122, &
556 0.00211004, 0.00133804, 0.00049260, 0.00006931, &
557 0.16274056, 0.15133780, 0.14228874, 0.13081114, &
558 0.11688486, 0.09979610, 0.08073687, 0.05996741, &
559 0.04040616, 0.00439869, 0.00368910, 0.00293041, &
560 0.00211604, 0.00133536, 0.00049260, 0.00006931, &
561 0.16176532, 0.15207882, 0.14226955, 0.13079646, &
562 0.11688191, 0.09966998, 0.08066384, 0.06020275, &
563 0.04047901, 0.00446696, 0.00377456, 0.00294410, &
564 0.00211082, 0.00133536, 0.00049260, 0.00006931, &
565 0.15993737, 0.15305527, 0.14259829, 0.13078023, &
566 0.11686983, 0.09980131, 0.08058286, 0.06031430, &
567 0.04082833, 0.00450509, 0.00377574, 0.00294823, &
568 0.00210977, 0.00133302, 0.00049260, 0.00006931, &
569 0.15371189, 0.15592396, 0.14430280, 0.13076764, &
570 0.11720382, 0.10023471, 0.08066396, 0.06073554, &
571 0.04121581, 0.00451202, 0.00377832, 0.00294609, &
572 0.00210943, 0.00133336, 0.00049260, 0.00006931, &
573 0.14262275, 0.14572631, 0.14560597, 0.13736825, &
574 0.12271351, 0.10419556, 0.08294533, 0.06199794, &
575 0.04157615, 0.00452842, 0.00377704, 0.00293852, &
576 0.00211034, 0.00133278, 0.00049259, 0.00006931, &
577 0.14500433, 0.14590444, 0.14430299, 0.13770708, &
578 0.12288283, 0.10350952, 0.08269450, 0.06130579, &
579 0.04144571, 0.00452096, 0.00377382, 0.00294532, &
580 0.00210943, 0.00133228, 0.00049260, 0.00006931/
581 DATA FRACREFB7/ &
582 0.15355594,0.15310939,0.14274909,0.13129812, &
583 0.11736792,0.10118213,0.08215259,0.06165591, &
584 0.04164486,0.00451141,0.00372837,0.00294095, &
585 0.00215259,0.00136792,0.00051233,0.00007075/
587 DATA ABSCO27/ &
588 9.30038E-05, 1.74061E-04, 2.09293E-04, 2.52360E-04, &
589 3.13404E-04, 4.16619E-04, 6.27394E-04, 1.29386E-03, &
590 4.05192E-03, 3.97050E-03, 7.00634E-04, 6.06617E-04, &
591 7.66978E-04, 6.70661E-04, 7.89971E-04, 7.55709E-04/
593 ! Data
595 DATA FRACREFA8/ &
596 ! From P = 1053.6 mb.
597 0.15309700,0.15450300,0.14458799,0.13098200, &
598 0.11817900,0.09953490,0.08132080,0.06139960, &
599 0.04132010,0.00446788,0.00372533,0.00294053, &
600 0.00211371,0.00128122,0.00048050,0.00006759/
601 DATA FRACREFB8/ &
602 ! From P = 28.9 mb.
603 0.14105400,0.14728899,0.14264800,0.13331699, &
604 0.12034100,0.10467000,0.08574980,0.06469390, &
605 0.04394640,0.00481284,0.00397375,0.00315006, &
606 0.00228636,0.00144606,0.00054604,0.00007697/
608 DATA CFC128/ &
609 85.4027, 89.4696, 74.0959, 67.7480, &
610 61.2444, 59.9073, 60.8296, 63.0998, &
611 59.6110, 64.0735, 57.2622, 58.9721, &
612 43.5505, 26.1192, 32.7023, 32.8667/
613 DATA CFC22ADJ8/ &
614 ! Original CFC22 is multiplied by 1.485 to account for the 780-850 cm-1
615 ! and 1290-1335 cm-1 bands.
616 135.335, 89.6642, 76.2375, 65.9748, &
617 63.1164, 60.2935, 64.0299, 75.4264, &
618 51.3018, 7.07911, 5.86928, 0.398693, &
619 2.82885, 9.12751, 6.28271, 0./
620 DATA ABSCO2A8/ &
621 1.11233E-05, 3.92400E-05, 6.62059E-05, 8.51687E-05, &
622 7.79035E-05, 1.34058E-04, 2.82553E-04, 5.41741E-04, &
623 1.47029E-05, 2.34982E-05, 6.91094E-08, 8.48917E-08, &
624 6.58783E-08, 4.64849E-08, 3.62742E-08, 3.62742E-08/
625 DATA ABSCO2B8/ &
626 4.10977E-09, 5.65200E-08, 1.70800E-07, 4.16840E-07, &
627 9.53684E-07, 2.36468E-06, 7.29502E-06, 4.93883E-05, &
628 5.10440E-04, 9.75248E-04, 1.36495E-03, 2.40451E-03, &
629 4.50277E-03, 2.24486E-02, 4.06756E-02, 2.17447E-10/
630 DATA ABSN2OA8/ &
631 1.28527E-02,5.28651E-02,1.01668E-01,1.57224E-01, &
632 2.76947E-01,4.93048E-01,6.71387E-01,3.48809E-01, &
633 4.19840E-01,3.13558E-01,2.44432E-01,2.05108E-01, &
634 1.21423E-01,1.22158E-01,1.49702E-01,1.47799E-01/
635 DATA ABSN2OB8/ &
636 3.15864E-03,4.87347E-03,8.63235E-03,2.16053E-02, &
637 3.63699E-02,7.89149E-02,3.53807E-01,1.27140E-00, &
638 2.31464E-00,7.75834E-02,5.15063E-02,4.07059E-02, &
639 5.91947E-02,5.83546E-02,3.12716E-01,1.47456E-01/
641 ! Data
643 DATA FRACREFA9/ &
644 ! From P = 1053.6 mb.
645 0.16898900,0.15898301,0.13575301,0.12600900, &
646 0.11545800,0.09879170,0.08106830,0.06063440, &
647 0.03988780,0.00421760,0.00346635,0.00278779, &
648 0.00206225,0.00132324,0.00050033,0.00007038, &
649 0.18209399,0.15315101,0.13571000,0.12504999, &
650 0.11379100,0.09680810,0.08008570,0.05970280, &
651 0.03942860,0.00413383,0.00343186,0.00275558, &
652 0.00204657,0.00130219,0.00045454,0.00005664, &
653 0.18459500,0.15512000,0.13395500,0.12576801, &
654 0.11276800,0.09645190,0.07956650,0.05903340, &
655 0.03887050,0.00412226,0.00339453,0.00273518, &
656 0.00196922,0.00119411,0.00040263,0.00005664, &
657 0.18458800,0.15859900,0.13278100,0.12589300, &
658 0.11272700,0.09599660,0.07903030,0.05843600, &
659 0.03843400,0.00405181,0.00337980,0.00263818, &
660 0.00186869,0.00111807,0.00040263,0.00005664, &
661 0.18459301,0.16176100,0.13235000,0.12528200, &
662 0.11237100,0.09618840,0.07833760,0.05800770, &
663 0.03787610,0.00408253,0.00330363,0.00250445, &
664 0.00176725,0.00111753,0.00040263,0.00005664, &
665 0.18454400,0.16505300,0.13221300,0.12476600, &
666 0.11158300,0.09618120,0.07797340,0.05740380, &
667 0.03742820,0.00392691,0.00312208,0.00246306, &
668 0.00176735,0.00111721,0.00040263,0.00005664, &
669 0.18452001,0.16697501,0.13445500,0.12391300, &
670 0.11059100,0.09596890,0.07761050,0.05643200, &
671 0.03686520,0.00377086,0.00309351,0.00246297, &
672 0.00176765,0.00111700,0.00040263,0.00005664, &
673 0.18460999,0.16854499,0.13922299,0.12266400, &
674 0.10962200,0.09452030,0.07653800,0.05551340, &
675 0.03609660,0.00377043,0.00309367,0.00246304, &
676 0.00176749,0.00111689,0.00040263,0.00005664, &
677 0.18312500,0.16787501,0.14720701,0.12766500, &
678 0.10890900,0.08935530,0.07310870,0.05443140, &
679 0.03566380,0.00376446,0.00309521,0.00246510, &
680 0.00176139,0.00111543,0.00040263,0.00005664/
681 DATA FRACREFB9/ &
682 ! From P = 0.071 mb.
683 0.20148601,0.15252700,0.13376500,0.12184600, &
684 0.10767800,0.09307410,0.07674570,0.05876940, &
685 0.04001480,0.00424612,0.00346896,0.00269954, &
686 0.00196864,0.00122562,0.00043628,0.00004892/
688 DATA ABSN2O9/ &
689 ! From P = 952 mb.
690 3.26267E-01,2.42869E-00,1.15455E+01,7.39478E-00, &
691 5.16550E-00,2.54474E-00,3.53082E-00,3.82278E-00, &
692 1.81297E-00,6.65313E-01,1.23652E-01,1.83895E-03, &
693 1.70592E-03,2.68434E-09,0.,0., &
694 ! From P = 620 mb.
695 2.08632E-01,1.11865E+00,4.95975E+00,8.10907E+00, &
696 1.10408E+01,5.45460E+00,4.18611E+00,3.53422E+00, &
697 2.54164E+00,3.65093E-01,5.84480E-01,2.26918E-01, &
698 1.36230E-03,5.54400E-10,6.83703E-10,0., &
699 ! From P = 313 mb.
700 6.20022E-02,2.69521E-01,9.81928E-01,1.65004E-00, &
701 3.08089E-00,5.38696E-00,1.14600E+01,2.41211E+01, &
702 1.69655E+01,1.37556E-00,5.43254E-01,3.52079E-01, &
703 4.31888E-01,4.82523E-06,5.74747E-11,0./
705 ! Data
707 DATA FRACREFA10/ &
708 ! From P = 473 mb.
709 0.16271301,0.15141940,0.14065412,0.12899506, &
710 0.11607002,0.10142808,0.08116794,0.06104711, &
711 0.04146209,0.00447386,0.00372902,0.00287258, &
712 0.00206028,0.00134634,0.00049232,0.00006927/
713 DATA FRACREFB10/ &
714 ! From P = 1.17 mb.
715 0.16571465,0.15262246,0.14036226,0.12620729, &
716 0.11477834,0.09967982,0.08155201,0.06159503, &
717 0.04196607,0.00453940,0.00376881,0.00300437, &
718 0.00223034,0.00139432,0.00051516,0.00007095/
720 ! Data
722 DATA FRACREFA11/ &
723 ! From P = 473 mb.
724 0.14152819,0.13811260,0.14312185,0.13705885, &
725 0.11944738,0.10570189,0.08866373,0.06565409, &
726 0.04428961,0.00481540,0.00387058,0.00329187, &
727 0.00238294,0.00150971,0.00049287,0.00005980/
728 DATA FRACREFB11/ &
729 ! From P = 1.17 mb.
730 0.10874039,0.15164889,0.15149839,0.14515044, &
731 0.12486220,0.10725017,0.08715712,0.06463144, &
732 0.04332319,0.00441193,0.00393819,0.00305960, &
733 0.00224221,0.00145100,0.00055586,0.00007934/
735 ! Data
737 DATA FRACREFA12/ &
738 ! From P = 706.3 mb.
739 0.21245100,0.15164700,0.14486700,0.13075501, &
740 0.11629600,0.09266050,0.06579930,0.04524000, &
741 0.03072870,0.00284297,0.00234660,0.00185208, &
742 0.00133978,0.00082214,0.00031016,0.00004363, &
743 0.14703900,0.16937999,0.15605700,0.14159000, &
744 0.12088500,0.10058500,0.06809110,0.05131470, &
745 0.03487040,0.00327281,0.00250183,0.00190024, &
746 0.00133978,0.00082214,0.00031016,0.00004363, &
747 0.13689300,0.16610400,0.15723500,0.14299500, &
748 0.12399400,0.09907820,0.07169690,0.05367370, &
749 0.03671630,0.00378148,0.00290510,0.00221076, &
750 0.00142810,0.00093527,0.00031016,0.00004363, &
751 0.13054299,0.16273800,0.15874299,0.14279599, &
752 0.12674300,0.09664900,0.07462200,0.05620080, &
753 0.03789090,0.00411690,0.00322920,0.00245036, &
754 0.00178303,0.00098595,0.00040802,0.00010150, &
755 0.12828299,0.15824600,0.15688400,0.14449100, &
756 0.12787800,0.09517830,0.07679350,0.05890820, &
757 0.03883570,0.00442304,0.00346796,0.00255333, &
758 0.00212519,0.00116168,0.00067065,0.00010150, &
759 0.12649800,0.15195100,0.15646499,0.14569700, &
760 0.12669300,0.09653520,0.07887920,0.06106920, &
761 0.04043910,0.00430390,0.00364453,0.00314360, &
762 0.00203206,0.00187787,0.00067075,0.00010150, &
763 0.12500300,0.14460599,0.15672199,0.14724600, &
764 0.11978900,0.10190200,0.08196710,0.06315770, &
765 0.04240100,0.00433645,0.00404097,0.00329466, &
766 0.00288491,0.00187803,0.00067093,0.00010150, &
767 0.12317200,0.14118700,0.15242000,0.13794300, &
768 0.12119200,0.10655400,0.08808350,0.06521370, &
769 0.04505680,0.00485949,0.00477105,0.00401468, &
770 0.00288491,0.00187786,0.00067110,0.00010150, &
771 0.10193600,0.11693000,0.13236099,0.14053200, &
772 0.13749801,0.12193100,0.10221000,0.07448910, &
773 0.05205320,0.00572312,0.00476882,0.00403380, &
774 0.00288871,0.00187396,0.00067218,0.00010150/
776 ! Data
778 DATA FRACREFA13/ &
779 ! From P = 706.3 mb.
780 0.17683899,0.17319500,0.15712699,0.13604601, &
781 0.10776200,0.08750010,0.06808820,0.04905150, &
782 0.03280360,0.00350836,0.00281864,0.00219862, &
783 0.00160943,0.00101885,0.00038147,0.00005348, &
784 0.17535400,0.16999300,0.15610200,0.13589200, &
785 0.10842100,0.08988550,0.06943920,0.04974900, &
786 0.03323400,0.00352752,0.00289402,0.00231003, &
787 0.00174659,0.00101884,0.00038147,0.00005348, &
788 0.17409500,0.16846400,0.15641899,0.13503000, &
789 0.10838600,0.08985800,0.07092720,0.05075710, &
790 0.03364180,0.00354241,0.00303507,0.00243391, &
791 0.00177502,0.00114638,0.00043585,0.00005348, &
792 0.17248300,0.16778600,0.15543500,0.13496999, &
793 0.10826300,0.09028740,0.07156720,0.05187120, &
794 0.03424890,0.00363933,0.00324715,0.00255030, &
795 0.00187380,0.00116978,0.00051229,0.00009768, &
796 0.17061099,0.16715799,0.15405200,0.13471501, &
797 0.10896400,0.09069460,0.07229760,0.05218280, &
798 0.03555340,0.00379576,0.00330240,0.00274693, &
799 0.00201587,0.00119598,0.00061885,0.00009768, &
800 0.16789700,0.16629100,0.15270300,0.13360199, &
801 0.11047200,0.09151080,0.07325000,0.05261450, &
802 0.03657990,0.00450092,0.00349537,0.00283321, &
803 0.00208396,0.00140354,0.00066587,0.00009768, &
804 0.16412200,0.16387400,0.15211500,0.13062200, &
805 0.11325100,0.09348130,0.07381380,0.05434740, &
806 0.03803160,0.00481346,0.00393592,0.00296633, &
807 0.00222532,0.00163762,0.00066648,0.00009768, &
808 0.15513401,0.15768200,0.14850400,0.13330200, &
809 0.11446500,0.09868230,0.07642050,0.05624170, &
810 0.04197810,0.00502288,0.00429452,0.00315347, &
811 0.00263559,0.00171772,0.00066860,0.00009768, &
812 0.15732600,0.15223300,0.14271900,0.13563600, &
813 0.11859600,0.10274200,0.07934560,0.05763410, &
814 0.03921740,0.00437741,0.00337921,0.00280212, &
815 0.00200156,0.00124812,0.00064664,0.00009768/
817 ! Data
819 DATA FRACREFA14/ &
820 ! From P = 1053.6 mb.
821 0.18446200,0.16795200,0.14949700,0.12036000, &
822 0.10440100,0.09024280,0.07435880,0.05629380, &
823 0.03825420,0.00417276,0.00345278,0.00272949, &
824 0.00200378,0.00127404,0.00050721,0.00004141/
825 DATA FRACREFB14/ &
826 ! From P = 0.64 mb.
827 0.19128500,0.16495700,0.14146100,0.11904500, &
828 0.10350200,0.09151190,0.07604270,0.05806020, &
829 0.03979950,0.00423959,0.00357439,0.00287559, &
830 0.00198860,0.00116529,0.00043616,0.00005987/
832 ! Data
834 DATA FRACREFA15/ &
835 ! From P = 1053.6 mb.
836 0.11287100,0.12070200,0.12729000,0.12858100, &
837 0.12743001,0.11961800,0.10290400,0.07888980, &
838 0.05900120,0.00667979,0.00552926,0.00436993, &
839 0.00320611,0.00204765,0.00077371,0.00010894, &
840 0.13918801,0.16353001,0.16155800,0.14090499, &
841 0.11322300,0.08757720,0.07225720,0.05173390, &
842 0.04731360,0.00667979,0.00552926,0.00436993, &
843 0.00320611,0.00204765,0.00077371,0.00010894, &
844 0.14687300,0.17853101,0.15664500,0.13351700, &
845 0.10791200,0.08684320,0.07158090,0.05198410, &
846 0.04340110,0.00667979,0.00552926,0.00436993, &
847 0.00320611,0.00204765,0.00077371,0.00010894, &
848 0.15760700,0.17759100,0.15158001,0.13193300, &
849 0.10742800,0.08693760,0.07159490,0.05196250, &
850 0.04065270,0.00667979,0.00552926,0.00436993, &
851 0.00320611,0.00204765,0.00077371,0.00010894, &
852 0.16646700,0.17299300,0.15018500,0.13138700, &
853 0.10735900,0.08713110,0.07130330,0.05279420, &
854 0.03766730,0.00667979,0.00552926,0.00436993, &
855 0.00320611,0.00204765,0.00077371,0.00010894, &
856 0.17546000,0.16666500,0.14969499,0.13105400, &
857 0.10782500,0.08718610,0.07156770,0.05308320, &
858 0.03753960,0.00432465,0.00509623,0.00436993, &
859 0.00320611,0.00204765,0.00077371,0.00010894, &
860 0.18378501,0.16064601,0.14940400,0.13146400, &
861 0.10810300,0.08775740,0.07115360,0.05400040, &
862 0.03689970,0.00388333,0.00323610,0.00353414, &
863 0.00320611,0.00204765,0.00077371,0.00010894, &
864 0.18966800,0.15744300,0.14993000,0.13152599, &
865 0.10899200,0.08858690,0.07142920,0.05399600, &
866 0.03433460,0.00374886,0.00302066,0.00240653, &
867 0.00199205,0.00204765,0.00077371,0.00010894, &
868 0.11887100,0.12479600,0.12569501,0.12839900, &
869 0.12473500,0.12012800,0.11086700,0.08493590, &
870 0.05063770,0.00328723,0.00266849,0.00210232, &
871 0.00152114,0.00095635,0.00035374,0.00004980/
873 ! Data
875 DATA FRACREFA16/ &
876 ! From P = 862.6 mb.
877 0.17356300,0.18880001,0.17704099,0.13661300, &
878 0.10691600,0.08222480,0.05939860,0.04230810, &
879 0.02526330,0.00244532,0.00193541,0.00150415, &
880 0.00103528,0.00067068,0.00024951,0.00003348, &
881 0.17779499,0.19837400,0.16557600,0.13470000, &
882 0.11013600,0.08342720,0.05987030,0.03938700, &
883 0.02293650,0.00238849,0.00192400,0.00149921, &
884 0.00103539,0.00067150,0.00024822,0.00003348, &
885 0.18535601,0.19407199,0.16053200,0.13300700, &
886 0.10779000,0.08408500,0.06480450,0.04070160, &
887 0.02203590,0.00227779,0.00189074,0.00146888, &
888 0.00103147,0.00066770,0.00024751,0.00003348, &
889 0.19139200,0.18917400,0.15748601,0.13240699, &
890 0.10557300,0.08383260,0.06724060,0.04364450, &
891 0.02175820,0.00225436,0.00184421,0.00143153, &
892 0.00103027,0.00066066,0.00024222,0.00003148, &
893 0.19547801,0.18539500,0.15442000,0.13114899, &
894 0.10515600,0.08350350,0.06909780,0.04671630, &
895 0.02168820,0.00224400,0.00182009,0.00139098, &
896 0.00102582,0.00065367,0.00023202,0.00003148, &
897 0.19757500,0.18266800,0.15208900,0.12897800, &
898 0.10637200,0.08391220,0.06989830,0.04964120, &
899 0.02155800,0.00224310,0.00177358,0.00138184, &
900 0.00101538,0.00063370,0.00023227,0.00003148, &
901 0.20145500,0.17692900,0.14940600,0.12690400, &
902 0.10828800,0.08553720,0.07004940,0.05153430, &
903 0.02268740,0.00216943,0.00178603,0.00137754, &
904 0.00098344,0.00063165,0.00023218,0.00003148, &
905 0.20383500,0.17047501,0.14570600,0.12679300, &
906 0.11043100,0.08719150,0.07045440,0.05345420, &
907 0.02448340,0.00215839,0.00175893,0.00138296, &
908 0.00098318,0.00063188,0.00023199,0.00003148, &
909 0.18680701,0.15961801,0.15092900,0.13049100, &
910 0.11418400,0.09380540,0.07093450,0.05664280, &
911 0.02938410,0.00217751,0.00176766,0.00138275, &
912 0.00098377,0.00063181,0.00023193,0.00003148/
915 !
916 ! end of data 3
917 !
919 !-----------------------------------------------------------------------
921 ! start data 4
923 DATA NXMOL /2/
924 DATA IXINDX /0,2,3,0,31*0/
926 !
927 ! end of data 4
928 !
929 !-----------------------------------------------------------------------
931 ! start data 5
933 !
934 ! Longwave spectral band data
936 DATA WAVENUM1(1) /10./, WAVENUM2(1) /250./, DELWAVE(1) /240./
937 DATA WAVENUM1(2) /250./, WAVENUM2(2) /500./, DELWAVE(2) /250./
938 DATA WAVENUM1(3) /500./, WAVENUM2(3) /630./, DELWAVE(3) /130./
939 DATA WAVENUM1(4) /630./, WAVENUM2(4) /700./, DELWAVE(4) /70./
940 DATA WAVENUM1(5) /700./, WAVENUM2(5) /820./, DELWAVE(5) /120./
941 DATA WAVENUM1(6) /820./, WAVENUM2(6) /980./, DELWAVE(6) /160./
942 DATA WAVENUM1(7) /980./, WAVENUM2(7) /1080./, DELWAVE(7) /100./
943 DATA WAVENUM1(8) /1080./, WAVENUM2(8) /1180./, DELWAVE(8) /100./
944 DATA WAVENUM1(9) /1180./, WAVENUM2(9) /1390./, DELWAVE(9) /210./
945 DATA WAVENUM1(10) /1390./,WAVENUM2(10) /1480./,DELWAVE(10) /90./
946 DATA WAVENUM1(11) /1480./,WAVENUM2(11) /1800./,DELWAVE(11) /320./
947 DATA WAVENUM1(12) /1800./,WAVENUM2(12) /2080./,DELWAVE(12) /280./
948 DATA WAVENUM1(13) /2080./,WAVENUM2(13) /2250./,DELWAVE(13) /170./
949 DATA WAVENUM1(14) /2250./,WAVENUM2(14) /2380./,DELWAVE(14) /130./
950 DATA WAVENUM1(15) /2380./,WAVENUM2(15) /2600./,DELWAVE(15) /220./
951 DATA WAVENUM1(16) /2600./,WAVENUM2(16) /3000./,DELWAVE(16) /400./
953 !
954 ! end of data 5
955 !
956 !-----------------------------------------------------------------------
958 ! start data 6
961 DATA NG /16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16/
962 DATA NSPA /1, 1,10, 9, 9, 1, 9, 1,11, 1, 1, 9, 9, 1, 9, 9/
963 DATA NSPB /1, 1, 5, 6, 5, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0/
965 ! HEATFAC is the factor by which one must multiply delta-flux/
966 ! delta-pressure, with flux in w/m-2 and pressure in mbar, to get
967 ! the heating rate in units of degrees/day. It is equal to
968 ! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
969 ! = (9.8066)(3600)(1e-5)/(1.004)
971 DATA HEATFAC /8.4391/
973 ! These pressures are chosen such that the ln of the first pressure
974 ! has only a few non-zero digits (i.e. ln(PREF(1)) = 6.96000) and
975 ! each subsequent ln(pressure) differs from the previous one by 0.2.
977 DATA PREF / &
978 1.05363E+03,8.62642E+02,7.06272E+02,5.78246E+02,4.73428E+02, &
979 3.87610E+02,3.17348E+02,2.59823E+02,2.12725E+02,1.74164E+02, &
980 1.42594E+02,1.16746E+02,9.55835E+01,7.82571E+01,6.40715E+01, &
981 5.24573E+01,4.29484E+01,3.51632E+01,2.87892E+01,2.35706E+01, &
982 1.92980E+01,1.57998E+01,1.29358E+01,1.05910E+01,8.67114E+00, &
983 7.09933E+00,5.81244E+00,4.75882E+00,3.89619E+00,3.18993E+00, &
984 2.61170E+00,2.13828E+00,1.75067E+00,1.43333E+00,1.17351E+00, &
985 9.60789E-01,7.86628E-01,6.44036E-01,5.27292E-01,4.31710E-01, &
986 3.53455E-01,2.89384E-01,2.36928E-01,1.93980E-01,1.58817E-01, &
987 1.30029E-01,1.06458E-01,8.71608E-02,7.13612E-02,5.84256E-02, &
988 4.78349E-02,3.91639E-02,3.20647E-02,2.62523E-02,2.14936E-02, &
989 1.75975E-02,1.44076E-02,1.17959E-02,9.65769E-03/
990 DATA PREFLOG / &
991 6.9600E+00, 6.7600E+00, 6.5600E+00, 6.3600E+00, 6.1600E+00, &
992 5.9600E+00, 5.7600E+00, 5.5600E+00, 5.3600E+00, 5.1600E+00, &
993 4.9600E+00, 4.7600E+00, 4.5600E+00, 4.3600E+00, 4.1600E+00, &
994 3.9600E+00, 3.7600E+00, 3.5600E+00, 3.3600E+00, 3.1600E+00, &
995 2.9600E+00, 2.7600E+00, 2.5600E+00, 2.3600E+00, 2.1600E+00, &
996 1.9600E+00, 1.7600E+00, 1.5600E+00, 1.3600E+00, 1.1600E+00, &
997 9.6000E-01, 7.6000E-01, 5.6000E-01, 3.6000E-01, 1.6000E-01, &
998 -4.0000E-02,-2.4000E-01,-4.4000E-01,-6.4000E-01,-8.4000E-01, &
999 -1.0400E+00,-1.2400E+00,-1.4400E+00,-1.6400E+00,-1.8400E+00, &
1000 -2.0400E+00,-2.2400E+00,-2.4400E+00,-2.6400E+00,-2.8400E+00, &
1001 -3.0400E+00,-3.2400E+00,-3.4400E+00,-3.6400E+00,-3.8400E+00, &
1002 -4.0400E+00,-4.2400E+00,-4.4400E+00,-4.6400E+00/
1003 ! These are the temperatures associated with the respective
1004 ! pressures for the MLS standard atmosphere.
1005 DATA TREF / &
1006 2.9420E+02, 2.8799E+02, 2.7894E+02, 2.6925E+02, 2.5983E+02, &
1007 2.5017E+02, 2.4077E+02, 2.3179E+02, 2.2306E+02, 2.1578E+02, &
1008 2.1570E+02, 2.1570E+02, 2.1570E+02, 2.1706E+02, 2.1858E+02, &
1009 2.2018E+02, 2.2174E+02, 2.2328E+02, 2.2479E+02, 2.2655E+02, &
1010 2.2834E+02, 2.3113E+02, 2.3401E+02, 2.3703E+02, 2.4022E+02, &
1011 2.4371E+02, 2.4726E+02, 2.5085E+02, 2.5457E+02, 2.5832E+02, &
1012 2.6216E+02, 2.6606E+02, 2.6999E+02, 2.7340E+02, 2.7536E+02, &
1013 2.7568E+02, 2.7372E+02, 2.7163E+02, 2.6955E+02, 2.6593E+02, &
1014 2.6211E+02, 2.5828E+02, 2.5360E+02, 2.4854E+02, 2.4348E+02, &
1015 2.3809E+02, 2.3206E+02, 2.2603E+02, 2.2000E+02, 2.1435E+02, &
1016 2.0887E+02, 2.0340E+02, 1.9792E+02, 1.9290E+02, 1.8809E+02, &
1017 1.8329E+02, 1.7849E+02, 1.7394E+02, 1.7212E+02/
1019 !
1020 ! end of data 6
1021 !
1022 !-----------------------------------------------------------------------
1024 ! start data 7
1026 DATA (TOTPLNK(IDATA, 1),IDATA=1,50)/ &
1027 1.13735E-06,1.15150E-06,1.16569E-06,1.17992E-06,1.19419E-06, &
1028 1.20850E-06,1.22285E-06,1.23723E-06,1.25164E-06,1.26610E-06, &
1029 1.28059E-06,1.29511E-06,1.30967E-06,1.32426E-06,1.33889E-06, &
1030 1.35355E-06,1.36824E-06,1.38296E-06,1.39772E-06,1.41250E-06, &
1031 1.42732E-06,1.44217E-06,1.45704E-06,1.47195E-06,1.48689E-06, &
1032 1.50185E-06,1.51684E-06,1.53186E-06,1.54691E-06,1.56198E-06, &
1033 1.57709E-06,1.59222E-06,1.60737E-06,1.62255E-06,1.63776E-06, &
1034 1.65299E-06,1.66825E-06,1.68352E-06,1.69883E-06,1.71416E-06, &
1035 1.72951E-06,1.74488E-06,1.76028E-06,1.77570E-06,1.79114E-06, &
1036 1.80661E-06,1.82210E-06,1.83760E-06,1.85313E-06,1.86868E-06/
1037 DATA (TOTPLNK(IDATA, 1),IDATA=51,100)/ &
1038 1.88425E-06,1.89985E-06,1.91546E-06,1.93109E-06,1.94674E-06, &
1039 1.96241E-06,1.97811E-06,1.99381E-06,2.00954E-06,2.02529E-06, &
1040 2.04105E-06,2.05684E-06,2.07264E-06,2.08846E-06,2.10429E-06, &
1041 2.12015E-06,2.13602E-06,2.15190E-06,2.16781E-06,2.18373E-06, &
1042 2.19966E-06,2.21562E-06,2.23159E-06,2.24758E-06,2.26358E-06, &
1043 2.27959E-06,2.29562E-06,2.31167E-06,2.32773E-06,2.34381E-06, &
1044 2.35990E-06,2.37601E-06,2.39212E-06,2.40825E-06,2.42440E-06, &
1045 2.44056E-06,2.45673E-06,2.47292E-06,2.48912E-06,2.50533E-06, &
1046 2.52157E-06,2.53781E-06,2.55406E-06,2.57032E-06,2.58660E-06, &
1047 2.60289E-06,2.61919E-06,2.63550E-06,2.65183E-06,2.66817E-06/
1048 DATA (TOTPLNK(IDATA, 1),IDATA=101,150)/ &
1049 2.68452E-06,2.70088E-06,2.71726E-06,2.73364E-06,2.75003E-06, &
1050 2.76644E-06,2.78286E-06,2.79929E-06,2.81572E-06,2.83218E-06, &
1051 2.84864E-06,2.86510E-06,2.88159E-06,2.89807E-06,2.91458E-06, &
1052 2.93109E-06,2.94762E-06,2.96415E-06,2.98068E-06,2.99724E-06, &
1053 3.01379E-06,3.03036E-06,3.04693E-06,3.06353E-06,3.08013E-06, &
1054 3.09674E-06,3.11335E-06,3.12998E-06,3.14661E-06,3.16324E-06, &
1055 3.17989E-06,3.19656E-06,3.21323E-06,3.22991E-06,3.24658E-06, &
1056 3.26328E-06,3.27998E-06,3.29669E-06,3.31341E-06,3.33013E-06, &
1057 3.34686E-06,3.36360E-06,3.38034E-06,3.39709E-06,3.41387E-06, &
1058 3.43063E-06,3.44742E-06,3.46420E-06,3.48099E-06,3.49779E-06/
1059 DATA (TOTPLNK(IDATA, 1),IDATA=151,181)/ &
1060 3.51461E-06,3.53141E-06,3.54824E-06,3.56506E-06,3.58191E-06, &
1061 3.59875E-06,3.61559E-06,3.63244E-06,3.64931E-06,3.66617E-06, &
1062 3.68305E-06,3.69992E-06,3.71682E-06,3.73372E-06,3.75061E-06, &
1063 3.76753E-06,3.78443E-06,3.80136E-06,3.81829E-06,3.83522E-06, &
1064 3.85215E-06,3.86910E-06,3.88605E-06,3.90301E-06,3.91997E-06, &
1065 3.93694E-06,3.95390E-06,3.97087E-06,3.98788E-06,4.00485E-06, &
1066 4.02187E-06/
1067 DATA (TOTPLNK(IDATA, 2),IDATA=1,50)/ &
1068 2.13441E-06,2.18076E-06,2.22758E-06,2.27489E-06,2.32268E-06, &
1069 2.37093E-06,2.41966E-06,2.46886E-06,2.51852E-06,2.56864E-06, &
1070 2.61922E-06,2.67026E-06,2.72175E-06,2.77370E-06,2.82609E-06, &
1071 2.87893E-06,2.93221E-06,2.98593E-06,3.04008E-06,3.09468E-06, &
1072 3.14970E-06,3.20515E-06,3.26103E-06,3.31732E-06,3.37404E-06, &
1073 3.43118E-06,3.48873E-06,3.54669E-06,3.60506E-06,3.66383E-06, &
1074 3.72301E-06,3.78259E-06,3.84256E-06,3.90293E-06,3.96368E-06, &
1075 4.02483E-06,4.08636E-06,4.14828E-06,4.21057E-06,4.27324E-06, &
1076 4.33629E-06,4.39971E-06,4.46350E-06,4.52765E-06,4.59217E-06, &
1077 4.65705E-06,4.72228E-06,4.78787E-06,4.85382E-06,4.92011E-06/
1078 DATA (TOTPLNK(IDATA, 2),IDATA=51,100)/ &
1079 4.98675E-06,5.05374E-06,5.12106E-06,5.18873E-06,5.25674E-06, &
1080 5.32507E-06,5.39374E-06,5.46274E-06,5.53207E-06,5.60172E-06, &
1081 5.67169E-06,5.74198E-06,5.81259E-06,5.88352E-06,5.95475E-06, &
1082 6.02629E-06,6.09815E-06,6.17030E-06,6.24276E-06,6.31552E-06, &
1083 6.38858E-06,6.46192E-06,6.53557E-06,6.60950E-06,6.68373E-06, &
1084 6.75824E-06,6.83303E-06,6.90810E-06,6.98346E-06,7.05909E-06, &
1085 7.13500E-06,7.21117E-06,7.28763E-06,7.36435E-06,7.44134E-06, &
1086 7.51859E-06,7.59611E-06,7.67388E-06,7.75192E-06,7.83021E-06, &
1087 7.90875E-06,7.98755E-06,8.06660E-06,8.14589E-06,8.22544E-06, &
1088 8.30522E-06,8.38526E-06,8.46553E-06,8.54604E-06,8.62679E-06/
1089 DATA (TOTPLNK(IDATA, 2),IDATA=101,150)/ &
1090 8.70777E-06,8.78899E-06,8.87043E-06,8.95211E-06,9.03402E-06, &
1091 9.11616E-06,9.19852E-06,9.28109E-06,9.36390E-06,9.44692E-06, &
1092 9.53015E-06,9.61361E-06,9.69729E-06,9.78117E-06,9.86526E-06, &
1093 9.94957E-06,1.00341E-05,1.01188E-05,1.02037E-05,1.02888E-05, &
1094 1.03742E-05,1.04597E-05,1.05454E-05,1.06313E-05,1.07175E-05, &
1095 1.08038E-05,1.08903E-05,1.09770E-05,1.10639E-05,1.11509E-05, &
1096 1.12382E-05,1.13257E-05,1.14133E-05,1.15011E-05,1.15891E-05, &
1097 1.16773E-05,1.17656E-05,1.18542E-05,1.19429E-05,1.20317E-05, &
1098 1.21208E-05,1.22100E-05,1.22994E-05,1.23890E-05,1.24787E-05, &
1099 1.25686E-05,1.26587E-05,1.27489E-05,1.28393E-05,1.29299E-05/
1100 DATA (TOTPLNK(IDATA, 2),IDATA=151,181)/ &
1101 1.30206E-05,1.31115E-05,1.32025E-05,1.32937E-05,1.33850E-05, &
1102 1.34765E-05,1.35682E-05,1.36600E-05,1.37520E-05,1.38441E-05, &
1103 1.39364E-05,1.40288E-05,1.41213E-05,1.42140E-05,1.43069E-05, &
1104 1.43999E-05,1.44930E-05,1.45863E-05,1.46797E-05,1.47733E-05, &
1105 1.48670E-05,1.49608E-05,1.50548E-05,1.51489E-05,1.52431E-05, &
1106 1.53375E-05,1.54320E-05,1.55267E-05,1.56214E-05,1.57164E-05, &
1107 1.58114E-05/
1108 DATA (TOTPLNK(IDATA, 3),IDATA=1,50)/ &
1109 1.34822E-06,1.39134E-06,1.43530E-06,1.48010E-06,1.52574E-06, &
1110 1.57222E-06,1.61956E-06,1.66774E-06,1.71678E-06,1.76666E-06, &
1111 1.81741E-06,1.86901E-06,1.92147E-06,1.97479E-06,2.02898E-06, &
1112 2.08402E-06,2.13993E-06,2.19671E-06,2.25435E-06,2.31285E-06, &
1113 2.37222E-06,2.43246E-06,2.49356E-06,2.55553E-06,2.61837E-06, &
1114 2.68207E-06,2.74664E-06,2.81207E-06,2.87837E-06,2.94554E-06, &
1115 3.01356E-06,3.08245E-06,3.15221E-06,3.22282E-06,3.29429E-06, &
1116 3.36662E-06,3.43982E-06,3.51386E-06,3.58876E-06,3.66451E-06, &
1117 3.74112E-06,3.81857E-06,3.89688E-06,3.97602E-06,4.05601E-06, &
1118 4.13685E-06,4.21852E-06,4.30104E-06,4.38438E-06,4.46857E-06/
1119 DATA (TOTPLNK(IDATA, 3),IDATA=51,100)/ &
1120 4.55358E-06,4.63943E-06,4.72610E-06,4.81359E-06,4.90191E-06, &
1121 4.99105E-06,5.08100E-06,5.17176E-06,5.26335E-06,5.35573E-06, &
1122 5.44892E-06,5.54292E-06,5.63772E-06,5.73331E-06,5.82970E-06, &
1123 5.92688E-06,6.02485E-06,6.12360E-06,6.22314E-06,6.32346E-06, &
1124 6.42455E-06,6.52641E-06,6.62906E-06,6.73247E-06,6.83664E-06, &
1125 6.94156E-06,7.04725E-06,7.15370E-06,7.26089E-06,7.36883E-06, &
1126 7.47752E-06,7.58695E-06,7.69712E-06,7.80801E-06,7.91965E-06, &
1127 8.03201E-06,8.14510E-06,8.25891E-06,8.37343E-06,8.48867E-06, &
1128 8.60463E-06,8.72128E-06,8.83865E-06,8.95672E-06,9.07548E-06, &
1129 9.19495E-06,9.31510E-06,9.43594E-06,9.55745E-06,9.67966E-06/
1130 DATA (TOTPLNK(IDATA, 3),IDATA=101,150)/ &
1131 9.80254E-06,9.92609E-06,1.00503E-05,1.01752E-05,1.03008E-05, &
1132 1.04270E-05,1.05539E-05,1.06814E-05,1.08096E-05,1.09384E-05, &
1133 1.10679E-05,1.11980E-05,1.13288E-05,1.14601E-05,1.15922E-05, &
1134 1.17248E-05,1.18581E-05,1.19920E-05,1.21265E-05,1.22616E-05, &
1135 1.23973E-05,1.25337E-05,1.26706E-05,1.28081E-05,1.29463E-05, &
1136 1.30850E-05,1.32243E-05,1.33642E-05,1.35047E-05,1.36458E-05, &
1137 1.37875E-05,1.39297E-05,1.40725E-05,1.42159E-05,1.43598E-05, &
1138 1.45044E-05,1.46494E-05,1.47950E-05,1.49412E-05,1.50879E-05, &
1139 1.52352E-05,1.53830E-05,1.55314E-05,1.56803E-05,1.58297E-05, &
1140 1.59797E-05,1.61302E-05,1.62812E-05,1.64327E-05,1.65848E-05/
1141 DATA (TOTPLNK(IDATA, 3),IDATA=151,181)/ &
1142 1.67374E-05,1.68904E-05,1.70441E-05,1.71982E-05,1.73528E-05, &
1143 1.75079E-05,1.76635E-05,1.78197E-05,1.79763E-05,1.81334E-05, &
1144 1.82910E-05,1.84491E-05,1.86076E-05,1.87667E-05,1.89262E-05, &
1145 1.90862E-05,1.92467E-05,1.94076E-05,1.95690E-05,1.97309E-05, &
1146 1.98932E-05,2.00560E-05,2.02193E-05,2.03830E-05,2.05472E-05, &
1147 2.07118E-05,2.08768E-05,2.10423E-05,2.12083E-05,2.13747E-05, &
1148 2.15414E-05/
1149 DATA (TOTPLNK(IDATA, 4),IDATA=1,50)/ &
1150 8.90528E-07,9.24222E-07,9.58757E-07,9.94141E-07,1.03038E-06, &
1151 1.06748E-06,1.10545E-06,1.14430E-06,1.18403E-06,1.22465E-06, &
1152 1.26618E-06,1.30860E-06,1.35193E-06,1.39619E-06,1.44136E-06, &
1153 1.48746E-06,1.53449E-06,1.58246E-06,1.63138E-06,1.68124E-06, &
1154 1.73206E-06,1.78383E-06,1.83657E-06,1.89028E-06,1.94495E-06, &
1155 2.00060E-06,2.05724E-06,2.11485E-06,2.17344E-06,2.23303E-06, &
1156 2.29361E-06,2.35519E-06,2.41777E-06,2.48134E-06,2.54592E-06, &
1157 2.61151E-06,2.67810E-06,2.74571E-06,2.81433E-06,2.88396E-06, &
1158 2.95461E-06,3.02628E-06,3.09896E-06,3.17267E-06,3.24741E-06, &
1159 3.32316E-06,3.39994E-06,3.47774E-06,3.55657E-06,3.63642E-06/
1160 DATA (TOTPLNK(IDATA, 4),IDATA=51,100)/ &
1161 3.71731E-06,3.79922E-06,3.88216E-06,3.96612E-06,4.05112E-06, &
1162 4.13714E-06,4.22419E-06,4.31227E-06,4.40137E-06,4.49151E-06, &
1163 4.58266E-06,4.67485E-06,4.76806E-06,4.86229E-06,4.95754E-06, &
1164 5.05383E-06,5.15113E-06,5.24946E-06,5.34879E-06,5.44916E-06, &
1165 5.55053E-06,5.65292E-06,5.75632E-06,5.86073E-06,5.96616E-06, &
1166 6.07260E-06,6.18003E-06,6.28848E-06,6.39794E-06,6.50838E-06, &
1167 6.61983E-06,6.73229E-06,6.84573E-06,6.96016E-06,7.07559E-06, &
1168 7.19200E-06,7.30940E-06,7.42779E-06,7.54715E-06,7.66749E-06, &
1169 7.78882E-06,7.91110E-06,8.03436E-06,8.15859E-06,8.28379E-06, &
1170 8.40994E-06,8.53706E-06,8.66515E-06,8.79418E-06,8.92416E-06/
1171 DATA (TOTPLNK(IDATA, 4),IDATA=101,150)/ &
1172 9.05510E-06,9.18697E-06,9.31979E-06,9.45356E-06,9.58826E-06, &
1173 9.72389E-06,9.86046E-06,9.99793E-06,1.01364E-05,1.02757E-05, &
1174 1.04159E-05,1.05571E-05,1.06992E-05,1.08422E-05,1.09861E-05, &
1175 1.11309E-05,1.12766E-05,1.14232E-05,1.15707E-05,1.17190E-05, &
1176 1.18683E-05,1.20184E-05,1.21695E-05,1.23214E-05,1.24741E-05, &
1177 1.26277E-05,1.27822E-05,1.29376E-05,1.30939E-05,1.32509E-05, &
1178 1.34088E-05,1.35676E-05,1.37273E-05,1.38877E-05,1.40490E-05, &
1179 1.42112E-05,1.43742E-05,1.45380E-05,1.47026E-05,1.48680E-05, &
1180 1.50343E-05,1.52014E-05,1.53692E-05,1.55379E-05,1.57074E-05, &
1181 1.58778E-05,1.60488E-05,1.62207E-05,1.63934E-05,1.65669E-05/
1182 DATA (TOTPLNK(IDATA, 4),IDATA=151,181)/ &
1183 1.67411E-05,1.69162E-05,1.70920E-05,1.72685E-05,1.74459E-05, &
1184 1.76240E-05,1.78029E-05,1.79825E-05,1.81629E-05,1.83440E-05, &
1185 1.85259E-05,1.87086E-05,1.88919E-05,1.90760E-05,1.92609E-05, &
1186 1.94465E-05,1.96327E-05,1.98199E-05,2.00076E-05,2.01961E-05, &
1187 2.03853E-05,2.05752E-05,2.07658E-05,2.09571E-05,2.11491E-05, &
1188 2.13418E-05,2.15352E-05,2.17294E-05,2.19241E-05,2.21196E-05, &
1189 2.23158E-05/
1190 DATA (TOTPLNK(IDATA, 5),IDATA=1,50)/ &
1191 5.70230E-07,5.94788E-07,6.20085E-07,6.46130E-07,6.72936E-07, &
1192 7.00512E-07,7.28869E-07,7.58019E-07,7.87971E-07,8.18734E-07, &
1193 8.50320E-07,8.82738E-07,9.15999E-07,9.50110E-07,9.85084E-07, &
1194 1.02093E-06,1.05765E-06,1.09527E-06,1.13378E-06,1.17320E-06, &
1195 1.21353E-06,1.25479E-06,1.29698E-06,1.34011E-06,1.38419E-06, &
1196 1.42923E-06,1.47523E-06,1.52221E-06,1.57016E-06,1.61910E-06, &
1197 1.66904E-06,1.71997E-06,1.77192E-06,1.82488E-06,1.87886E-06, &
1198 1.93387E-06,1.98991E-06,2.04699E-06,2.10512E-06,2.16430E-06, &
1199 2.22454E-06,2.28584E-06,2.34821E-06,2.41166E-06,2.47618E-06, &
1200 2.54178E-06,2.60847E-06,2.67626E-06,2.74514E-06,2.81512E-06/
1201 DATA (TOTPLNK(IDATA, 5),IDATA=51,100)/ &
1202 2.88621E-06,2.95841E-06,3.03172E-06,3.10615E-06,3.18170E-06, &
1203 3.25838E-06,3.33618E-06,3.41511E-06,3.49518E-06,3.57639E-06, &
1204 3.65873E-06,3.74221E-06,3.82684E-06,3.91262E-06,3.99955E-06, &
1205 4.08763E-06,4.17686E-06,4.26725E-06,4.35880E-06,4.45150E-06, &
1206 4.54537E-06,4.64039E-06,4.73659E-06,4.83394E-06,4.93246E-06, &
1207 5.03215E-06,5.13301E-06,5.23504E-06,5.33823E-06,5.44260E-06, &
1208 5.54814E-06,5.65484E-06,5.76272E-06,5.87177E-06,5.98199E-06, &
1209 6.09339E-06,6.20596E-06,6.31969E-06,6.43460E-06,6.55068E-06, &
1210 6.66793E-06,6.78636E-06,6.90595E-06,7.02670E-06,7.14863E-06, &
1211 7.27173E-06,7.39599E-06,7.52142E-06,7.64802E-06,7.77577E-06/
1212 DATA (TOTPLNK(IDATA, 5),IDATA=101,150)/ &
1213 7.90469E-06,8.03477E-06,8.16601E-06,8.29841E-06,8.43198E-06, &
1214 8.56669E-06,8.70256E-06,8.83957E-06,8.97775E-06,9.11706E-06, &
1215 9.25753E-06,9.39915E-06,9.54190E-06,9.68580E-06,9.83085E-06, &
1216 9.97704E-06,1.01243E-05,1.02728E-05,1.04224E-05,1.05731E-05, &
1217 1.07249E-05,1.08779E-05,1.10320E-05,1.11872E-05,1.13435E-05, &
1218 1.15009E-05,1.16595E-05,1.18191E-05,1.19799E-05,1.21418E-05, &
1219 1.23048E-05,1.24688E-05,1.26340E-05,1.28003E-05,1.29676E-05, &
1220 1.31361E-05,1.33056E-05,1.34762E-05,1.36479E-05,1.38207E-05, &
1221 1.39945E-05,1.41694E-05,1.43454E-05,1.45225E-05,1.47006E-05, &
1222 1.48797E-05,1.50600E-05,1.52413E-05,1.54236E-05,1.56070E-05/
1223 DATA (TOTPLNK(IDATA, 5),IDATA=151,181)/ &
1224 1.57914E-05,1.59768E-05,1.61633E-05,1.63509E-05,1.65394E-05, &
1225 1.67290E-05,1.69197E-05,1.71113E-05,1.73040E-05,1.74976E-05, &
1226 1.76923E-05,1.78880E-05,1.80847E-05,1.82824E-05,1.84811E-05, &
1227 1.86808E-05,1.88814E-05,1.90831E-05,1.92857E-05,1.94894E-05, &
1228 1.96940E-05,1.98996E-05,2.01061E-05,2.03136E-05,2.05221E-05, &
1229 2.07316E-05,2.09420E-05,2.11533E-05,2.13657E-05,2.15789E-05, &
1230 2.17931E-05/
1231 DATA (TOTPLNK(IDATA, 6),IDATA=1,50)/ &
1232 2.73493E-07,2.87408E-07,3.01848E-07,3.16825E-07,3.32352E-07, &
1233 3.48439E-07,3.65100E-07,3.82346E-07,4.00189E-07,4.18641E-07, &
1234 4.37715E-07,4.57422E-07,4.77774E-07,4.98784E-07,5.20464E-07, &
1235 5.42824E-07,5.65879E-07,5.89638E-07,6.14115E-07,6.39320E-07, &
1236 6.65266E-07,6.91965E-07,7.19427E-07,7.47666E-07,7.76691E-07, &
1237 8.06516E-07,8.37151E-07,8.68607E-07,9.00896E-07,9.34029E-07, &
1238 9.68018E-07,1.00287E-06,1.03860E-06,1.07522E-06,1.11274E-06, &
1239 1.15117E-06,1.19052E-06,1.23079E-06,1.27201E-06,1.31418E-06, &
1240 1.35731E-06,1.40141E-06,1.44650E-06,1.49257E-06,1.53965E-06, &
1241 1.58773E-06,1.63684E-06,1.68697E-06,1.73815E-06,1.79037E-06/
1242 DATA (TOTPLNK(IDATA, 6),IDATA=51,100)/ &
1243 1.84365E-06,1.89799E-06,1.95341E-06,2.00991E-06,2.06750E-06, &
1244 2.12619E-06,2.18599E-06,2.24691E-06,2.30895E-06,2.37212E-06, &
1245 2.43643E-06,2.50189E-06,2.56851E-06,2.63628E-06,2.70523E-06, &
1246 2.77536E-06,2.84666E-06,2.91916E-06,2.99286E-06,3.06776E-06, &
1247 3.14387E-06,3.22120E-06,3.29975E-06,3.37953E-06,3.46054E-06, &
1248 3.54280E-06,3.62630E-06,3.71105E-06,3.79707E-06,3.88434E-06, &
1249 3.97288E-06,4.06270E-06,4.15380E-06,4.24617E-06,4.33984E-06, &
1250 4.43479E-06,4.53104E-06,4.62860E-06,4.72746E-06,4.82763E-06, &
1251 4.92911E-06,5.03191E-06,5.13603E-06,5.24147E-06,5.34824E-06, &
1252 5.45634E-06,5.56578E-06,5.67656E-06,5.78867E-06,5.90213E-06/
1253 DATA (TOTPLNK(IDATA, 6),IDATA=101,150)/ &
1254 6.01694E-06,6.13309E-06,6.25060E-06,6.36947E-06,6.48968E-06, &
1255 6.61126E-06,6.73420E-06,6.85850E-06,6.98417E-06,7.11120E-06, &
1256 7.23961E-06,7.36938E-06,7.50053E-06,7.63305E-06,7.76694E-06, &
1257 7.90221E-06,8.03887E-06,8.17690E-06,8.31632E-06,8.45710E-06, &
1258 8.59928E-06,8.74282E-06,8.88776E-06,9.03409E-06,9.18179E-06, &
1259 9.33088E-06,9.48136E-06,9.63323E-06,9.78648E-06,9.94111E-06, &
1260 1.00971E-05,1.02545E-05,1.04133E-05,1.05735E-05,1.07351E-05, &
1261 1.08980E-05,1.10624E-05,1.12281E-05,1.13952E-05,1.15637E-05, &
1262 1.17335E-05,1.19048E-05,1.20774E-05,1.22514E-05,1.24268E-05, &
1263 1.26036E-05,1.27817E-05,1.29612E-05,1.31421E-05,1.33244E-05/
1264 DATA (TOTPLNK(IDATA, 6),IDATA=151,181)/ &
1265 1.35080E-05,1.36930E-05,1.38794E-05,1.40672E-05,1.42563E-05, &
1266 1.44468E-05,1.46386E-05,1.48318E-05,1.50264E-05,1.52223E-05, &
1267 1.54196E-05,1.56182E-05,1.58182E-05,1.60196E-05,1.62223E-05, &
1268 1.64263E-05,1.66317E-05,1.68384E-05,1.70465E-05,1.72559E-05, &
1269 1.74666E-05,1.76787E-05,1.78921E-05,1.81069E-05,1.83230E-05, &
1270 1.85404E-05,1.87591E-05,1.89791E-05,1.92005E-05,1.94232E-05, &
1271 1.96471E-05/
1272 DATA (TOTPLNK(IDATA, 7),IDATA=1,50)/ &
1273 1.25349E-07,1.32735E-07,1.40458E-07,1.48527E-07,1.56954E-07, &
1274 1.65748E-07,1.74920E-07,1.84481E-07,1.94443E-07,2.04814E-07, &
1275 2.15608E-07,2.26835E-07,2.38507E-07,2.50634E-07,2.63229E-07, &
1276 2.76301E-07,2.89864E-07,3.03930E-07,3.18508E-07,3.33612E-07, &
1277 3.49253E-07,3.65443E-07,3.82195E-07,3.99519E-07,4.17428E-07, &
1278 4.35934E-07,4.55050E-07,4.74785E-07,4.95155E-07,5.16170E-07, &
1279 5.37844E-07,5.60186E-07,5.83211E-07,6.06929E-07,6.31355E-07, &
1280 6.56498E-07,6.82373E-07,7.08990E-07,7.36362E-07,7.64501E-07, &
1281 7.93420E-07,8.23130E-07,8.53643E-07,8.84971E-07,9.17128E-07, &
1282 9.50123E-07,9.83969E-07,1.01868E-06,1.05426E-06,1.09073E-06/
1283 DATA (TOTPLNK(IDATA, 7),IDATA=51,100)/ &
1284 1.12810E-06,1.16638E-06,1.20558E-06,1.24572E-06,1.28680E-06, &
1285 1.32883E-06,1.37183E-06,1.41581E-06,1.46078E-06,1.50675E-06, &
1286 1.55374E-06,1.60174E-06,1.65078E-06,1.70087E-06,1.75200E-06, &
1287 1.80421E-06,1.85749E-06,1.91186E-06,1.96732E-06,2.02389E-06, &
1288 2.08159E-06,2.14040E-06,2.20035E-06,2.26146E-06,2.32372E-06, &
1289 2.38714E-06,2.45174E-06,2.51753E-06,2.58451E-06,2.65270E-06, &
1290 2.72210E-06,2.79272E-06,2.86457E-06,2.93767E-06,3.01201E-06, &
1291 3.08761E-06,3.16448E-06,3.24261E-06,3.32204E-06,3.40275E-06, &
1292 3.48476E-06,3.56808E-06,3.65271E-06,3.73866E-06,3.82595E-06, &
1293 3.91456E-06,4.00453E-06,4.09584E-06,4.18851E-06,4.28254E-06/
1294 DATA (TOTPLNK(IDATA, 7),IDATA=101,150)/ &
1295 4.37796E-06,4.47475E-06,4.57293E-06,4.67249E-06,4.77346E-06, &
1296 4.87583E-06,4.97961E-06,5.08481E-06,5.19143E-06,5.29948E-06, &
1297 5.40896E-06,5.51989E-06,5.63226E-06,5.74608E-06,5.86136E-06, &
1298 5.97810E-06,6.09631E-06,6.21597E-06,6.33713E-06,6.45976E-06, &
1299 6.58388E-06,6.70950E-06,6.83661E-06,6.96521E-06,7.09531E-06, &
1300 7.22692E-06,7.36005E-06,7.49468E-06,7.63084E-06,7.76851E-06, &
1301 7.90773E-06,8.04846E-06,8.19072E-06,8.33452E-06,8.47985E-06, &
1302 8.62674E-06,8.77517E-06,8.92514E-06,9.07666E-06,9.22975E-06, &
1303 9.38437E-06,9.54057E-06,9.69832E-06,9.85762E-06,1.00185E-05, &
1304 1.01810E-05,1.03450E-05,1.05106E-05,1.06777E-05,1.08465E-05/
1305 DATA (TOTPLNK(IDATA, 7),IDATA=151,181)/ &
1306 1.10168E-05,1.11887E-05,1.13621E-05,1.15372E-05,1.17138E-05, &
1307 1.18920E-05,1.20718E-05,1.22532E-05,1.24362E-05,1.26207E-05, &
1308 1.28069E-05,1.29946E-05,1.31839E-05,1.33749E-05,1.35674E-05, &
1309 1.37615E-05,1.39572E-05,1.41544E-05,1.43533E-05,1.45538E-05, &
1310 1.47558E-05,1.49595E-05,1.51647E-05,1.53716E-05,1.55800E-05, &
1311 1.57900E-05,1.60017E-05,1.62149E-05,1.64296E-05,1.66460E-05, &
1312 1.68640E-05/
1313 DATA (TOTPLNK(IDATA, 8),IDATA=1,50)/ &
1314 6.74445E-08,7.18176E-08,7.64153E-08,8.12456E-08,8.63170E-08, &
1315 9.16378E-08,9.72168E-08,1.03063E-07,1.09184E-07,1.15591E-07, &
1316 1.22292E-07,1.29296E-07,1.36613E-07,1.44253E-07,1.52226E-07, &
1317 1.60540E-07,1.69207E-07,1.78236E-07,1.87637E-07,1.97421E-07, &
1318 2.07599E-07,2.18181E-07,2.29177E-07,2.40598E-07,2.52456E-07, &
1319 2.64761E-07,2.77523E-07,2.90755E-07,3.04468E-07,3.18673E-07, &
1320 3.33381E-07,3.48603E-07,3.64352E-07,3.80638E-07,3.97474E-07, &
1321 4.14871E-07,4.32841E-07,4.51395E-07,4.70547E-07,4.90306E-07, &
1322 5.10687E-07,5.31699E-07,5.53357E-07,5.75670E-07,5.98652E-07, &
1323 6.22315E-07,6.46672E-07,6.71731E-07,6.97511E-07,7.24018E-07/
1324 DATA (TOTPLNK(IDATA, 8),IDATA=51,100)/ &
1325 7.51266E-07,7.79269E-07,8.08038E-07,8.37584E-07,8.67922E-07, &
1326 8.99061E-07,9.31016E-07,9.63797E-07,9.97417E-07,1.03189E-06, &
1327 1.06722E-06,1.10343E-06,1.14053E-06,1.17853E-06,1.21743E-06, &
1328 1.25726E-06,1.29803E-06,1.33974E-06,1.38241E-06,1.42606E-06, &
1329 1.47068E-06,1.51630E-06,1.56293E-06,1.61056E-06,1.65924E-06, &
1330 1.70894E-06,1.75971E-06,1.81153E-06,1.86443E-06,1.91841E-06, &
1331 1.97350E-06,2.02968E-06,2.08699E-06,2.14543E-06,2.20500E-06, &
1332 2.26573E-06,2.32762E-06,2.39068E-06,2.45492E-06,2.52036E-06, &
1333 2.58700E-06,2.65485E-06,2.72393E-06,2.79424E-06,2.86580E-06, &
1334 2.93861E-06,3.01269E-06,3.08803E-06,3.16467E-06,3.24259E-06/
1335 DATA (TOTPLNK(IDATA, 8),IDATA=101,150)/ &
1336 3.32181E-06,3.40235E-06,3.48420E-06,3.56739E-06,3.65192E-06, &
1337 3.73779E-06,3.82502E-06,3.91362E-06,4.00359E-06,4.09494E-06, &
1338 4.18768E-06,4.28182E-06,4.37737E-06,4.47434E-06,4.57273E-06, &
1339 4.67254E-06,4.77380E-06,4.87651E-06,4.98067E-06,5.08630E-06, &
1340 5.19339E-06,5.30196E-06,5.41201E-06,5.52356E-06,5.63660E-06, &
1341 5.75116E-06,5.86722E-06,5.98479E-06,6.10390E-06,6.22453E-06, &
1342 6.34669E-06,6.47042E-06,6.59569E-06,6.72252E-06,6.85090E-06, &
1343 6.98085E-06,7.11238E-06,7.24549E-06,7.38019E-06,7.51646E-06, &
1344 7.65434E-06,7.79382E-06,7.93490E-06,8.07760E-06,8.22192E-06, &
1345 8.36784E-06,8.51540E-06,8.66459E-06,8.81542E-06,8.96786E-06/
1346 DATA (TOTPLNK(IDATA, 8),IDATA=151,181)/ &
1347 9.12197E-06,9.27772E-06,9.43513E-06,9.59419E-06,9.75490E-06, &
1348 9.91728E-06,1.00813E-05,1.02471E-05,1.04144E-05,1.05835E-05, &
1349 1.07543E-05,1.09267E-05,1.11008E-05,1.12766E-05,1.14541E-05, &
1350 1.16333E-05,1.18142E-05,1.19969E-05,1.21812E-05,1.23672E-05, &
1351 1.25549E-05,1.27443E-05,1.29355E-05,1.31284E-05,1.33229E-05, &
1352 1.35193E-05,1.37173E-05,1.39170E-05,1.41185E-05,1.43217E-05, &
1353 1.45267E-05/
1354 DATA (TOTPLNK(IDATA, 9),IDATA=1,50)/ &
1355 2.61522E-08,2.80613E-08,3.00838E-08,3.22250E-08,3.44899E-08, &
1356 3.68841E-08,3.94129E-08,4.20820E-08,4.48973E-08,4.78646E-08, &
1357 5.09901E-08,5.42799E-08,5.77405E-08,6.13784E-08,6.52001E-08, &
1358 6.92126E-08,7.34227E-08,7.78375E-08,8.24643E-08,8.73103E-08, &
1359 9.23832E-08,9.76905E-08,1.03240E-07,1.09039E-07,1.15097E-07, &
1360 1.21421E-07,1.28020E-07,1.34902E-07,1.42075E-07,1.49548E-07, &
1361 1.57331E-07,1.65432E-07,1.73860E-07,1.82624E-07,1.91734E-07, &
1362 2.01198E-07,2.11028E-07,2.21231E-07,2.31818E-07,2.42799E-07, &
1363 2.54184E-07,2.65983E-07,2.78205E-07,2.90862E-07,3.03963E-07, &
1364 3.17519E-07,3.31541E-07,3.46039E-07,3.61024E-07,3.76507E-07/
1365 DATA (TOTPLNK(IDATA, 9),IDATA=51,100)/ &
1366 3.92498E-07,4.09008E-07,4.26050E-07,4.43633E-07,4.61769E-07, &
1367 4.80469E-07,4.99744E-07,5.19606E-07,5.40067E-07,5.61136E-07, &
1368 5.82828E-07,6.05152E-07,6.28120E-07,6.51745E-07,6.76038E-07, &
1369 7.01010E-07,7.26674E-07,7.53041E-07,7.80124E-07,8.07933E-07, &
1370 8.36482E-07,8.65781E-07,8.95845E-07,9.26683E-07,9.58308E-07, &
1371 9.90732E-07,1.02397E-06,1.05803E-06,1.09292E-06,1.12866E-06, &
1372 1.16526E-06,1.20274E-06,1.24109E-06,1.28034E-06,1.32050E-06, &
1373 1.36158E-06,1.40359E-06,1.44655E-06,1.49046E-06,1.53534E-06, &
1374 1.58120E-06,1.62805E-06,1.67591E-06,1.72478E-06,1.77468E-06, &
1375 1.82561E-06,1.87760E-06,1.93066E-06,1.98479E-06,2.04000E-06/
1376 DATA (TOTPLNK(IDATA, 9),IDATA=101,150)/ &
1377 2.09631E-06,2.15373E-06,2.21228E-06,2.27196E-06,2.33278E-06, &
1378 2.39475E-06,2.45790E-06,2.52222E-06,2.58773E-06,2.65445E-06, &
1379 2.72238E-06,2.79152E-06,2.86191E-06,2.93354E-06,3.00643E-06, &
1380 3.08058E-06,3.15601E-06,3.23273E-06,3.31075E-06,3.39009E-06, &
1381 3.47074E-06,3.55272E-06,3.63605E-06,3.72072E-06,3.80676E-06, &
1382 3.89417E-06,3.98297E-06,4.07315E-06,4.16474E-06,4.25774E-06, &
1383 4.35217E-06,4.44802E-06,4.54532E-06,4.64406E-06,4.74428E-06, &
1384 4.84595E-06,4.94911E-06,5.05376E-06,5.15990E-06,5.26755E-06, &
1385 5.37671E-06,5.48741E-06,5.59963E-06,5.71340E-06,5.82871E-06, &
1386 5.94559E-06,6.06403E-06,6.18404E-06,6.30565E-06,6.42885E-06/
1387 DATA (TOTPLNK(IDATA, 9),IDATA=151,181)/ &
1388 6.55364E-06,6.68004E-06,6.80806E-06,6.93771E-06,7.06898E-06, &
1389 7.20190E-06,7.33646E-06,7.47267E-06,7.61056E-06,7.75010E-06, &
1390 7.89133E-06,8.03423E-06,8.17884E-06,8.32514E-06,8.47314E-06, &
1391 8.62284E-06,8.77427E-06,8.92743E-06,9.08231E-06,9.23893E-06, &
1392 9.39729E-06,9.55741E-06,9.71927E-06,9.88291E-06,1.00483E-05, &
1393 1.02155E-05,1.03844E-05,1.05552E-05,1.07277E-05,1.09020E-05, &
1394 1.10781E-05/
1395 DATA (TOTPLNK(IDATA,10),IDATA=1,50)/ &
1396 8.89300E-09,9.63263E-09,1.04235E-08,1.12685E-08,1.21703E-08, &
1397 1.31321E-08,1.41570E-08,1.52482E-08,1.64090E-08,1.76428E-08, &
1398 1.89533E-08,2.03441E-08,2.18190E-08,2.33820E-08,2.50370E-08, &
1399 2.67884E-08,2.86402E-08,3.05969E-08,3.26632E-08,3.48436E-08, &
1400 3.71429E-08,3.95660E-08,4.21179E-08,4.48040E-08,4.76294E-08, &
1401 5.05996E-08,5.37201E-08,5.69966E-08,6.04349E-08,6.40411E-08, &
1402 6.78211E-08,7.17812E-08,7.59276E-08,8.02670E-08,8.48059E-08, &
1403 8.95508E-08,9.45090E-08,9.96873E-08,1.05093E-07,1.10733E-07, &
1404 1.16614E-07,1.22745E-07,1.29133E-07,1.35786E-07,1.42711E-07, &
1405 1.49916E-07,1.57410E-07,1.65202E-07,1.73298E-07,1.81709E-07/
1406 DATA (TOTPLNK(IDATA,10),IDATA=51,100)/ &
1407 1.90441E-07,1.99505E-07,2.08908E-07,2.18660E-07,2.28770E-07, &
1408 2.39247E-07,2.50101E-07,2.61340E-07,2.72974E-07,2.85013E-07, &
1409 2.97467E-07,3.10345E-07,3.23657E-07,3.37413E-07,3.51623E-07, &
1410 3.66298E-07,3.81448E-07,3.97082E-07,4.13212E-07,4.29848E-07, &
1411 4.47000E-07,4.64680E-07,4.82898E-07,5.01664E-07,5.20991E-07, &
1412 5.40888E-07,5.61369E-07,5.82440E-07,6.04118E-07,6.26410E-07, &
1413 6.49329E-07,6.72887E-07,6.97095E-07,7.21964E-07,7.47506E-07, &
1414 7.73732E-07,8.00655E-07,8.28287E-07,8.56635E-07,8.85717E-07, &
1415 9.15542E-07,9.46122E-07,9.77469E-07,1.00960E-06,1.04251E-06, &
1416 1.07623E-06,1.11077E-06,1.14613E-06,1.18233E-06,1.21939E-06/
1417 DATA (TOTPLNK(IDATA,10),IDATA=101,150)/ &
1418 1.25730E-06,1.29610E-06,1.33578E-06,1.37636E-06,1.41785E-06, &
1419 1.46027E-06,1.50362E-06,1.54792E-06,1.59319E-06,1.63942E-06, &
1420 1.68665E-06,1.73487E-06,1.78410E-06,1.83435E-06,1.88564E-06, &
1421 1.93797E-06,1.99136E-06,2.04582E-06,2.10137E-06,2.15801E-06, &
1422 2.21576E-06,2.27463E-06,2.33462E-06,2.39577E-06,2.45806E-06, &
1423 2.52153E-06,2.58617E-06,2.65201E-06,2.71905E-06,2.78730E-06, &
1424 2.85678E-06,2.92749E-06,2.99946E-06,3.07269E-06,3.14720E-06, &
1425 3.22299E-06,3.30007E-06,3.37847E-06,3.45818E-06,3.53923E-06, &
1426 3.62161E-06,3.70535E-06,3.79046E-06,3.87695E-06,3.96481E-06, &
1427 4.05409E-06,4.14477E-06,4.23687E-06,4.33040E-06,4.42538E-06/
1428 DATA (TOTPLNK(IDATA,10),IDATA=151,181)/ &
1429 4.52180E-06,4.61969E-06,4.71905E-06,4.81991E-06,4.92226E-06, &
1430 5.02611E-06,5.13148E-06,5.23839E-06,5.34681E-06,5.45681E-06, &
1431 5.56835E-06,5.68146E-06,5.79614E-06,5.91242E-06,6.03030E-06, &
1432 6.14978E-06,6.27088E-06,6.39360E-06,6.51798E-06,6.64398E-06, &
1433 6.77165E-06,6.90099E-06,7.03198E-06,7.16468E-06,7.29906E-06, &
1434 7.43514E-06,7.57294E-06,7.71244E-06,7.85369E-06,7.99666E-06, &
1435 8.14138E-06/
1436 DATA (TOTPLNK(IDATA,11),IDATA=1,50)/ &
1437 2.53767E-09,2.77242E-09,3.02564E-09,3.29851E-09,3.59228E-09, &
1438 3.90825E-09,4.24777E-09,4.61227E-09,5.00322E-09,5.42219E-09, &
1439 5.87080E-09,6.35072E-09,6.86370E-09,7.41159E-09,7.99628E-09, &
1440 8.61974E-09,9.28404E-09,9.99130E-09,1.07437E-08,1.15436E-08, &
1441 1.23933E-08,1.32953E-08,1.42522E-08,1.52665E-08,1.63410E-08, &
1442 1.74786E-08,1.86820E-08,1.99542E-08,2.12985E-08,2.27179E-08, &
1443 2.42158E-08,2.57954E-08,2.74604E-08,2.92141E-08,3.10604E-08, &
1444 3.30029E-08,3.50457E-08,3.71925E-08,3.94476E-08,4.18149E-08, &
1445 4.42991E-08,4.69043E-08,4.96352E-08,5.24961E-08,5.54921E-08, &
1446 5.86277E-08,6.19081E-08,6.53381E-08,6.89231E-08,7.26681E-08/
1447 DATA (TOTPLNK(IDATA,11),IDATA=51,100)/ &
1448 7.65788E-08,8.06604E-08,8.49187E-08,8.93591E-08,9.39879E-08, &
1449 9.88106E-08,1.03834E-07,1.09063E-07,1.14504E-07,1.20165E-07, &
1450 1.26051E-07,1.32169E-07,1.38525E-07,1.45128E-07,1.51982E-07, &
1451 1.59096E-07,1.66477E-07,1.74132E-07,1.82068E-07,1.90292E-07, &
1452 1.98813E-07,2.07638E-07,2.16775E-07,2.26231E-07,2.36015E-07, &
1453 2.46135E-07,2.56599E-07,2.67415E-07,2.78592E-07,2.90137E-07, &
1454 3.02061E-07,3.14371E-07,3.27077E-07,3.40186E-07,3.53710E-07, &
1455 3.67655E-07,3.82031E-07,3.96848E-07,4.12116E-07,4.27842E-07, &
1456 4.44039E-07,4.60713E-07,4.77876E-07,4.95537E-07,5.13706E-07, &
1457 5.32392E-07,5.51608E-07,5.71360E-07,5.91662E-07,6.12521E-07/
1458 DATA (TOTPLNK(IDATA,11),IDATA=101,150)/ &
1459 6.33950E-07,6.55958E-07,6.78556E-07,7.01753E-07,7.25562E-07, &
1460 7.49992E-07,7.75055E-07,8.00760E-07,8.27120E-07,8.54145E-07, &
1461 8.81845E-07,9.10233E-07,9.39318E-07,9.69113E-07,9.99627E-07, &
1462 1.03087E-06,1.06286E-06,1.09561E-06,1.12912E-06,1.16340E-06, &
1463 1.19848E-06,1.23435E-06,1.27104E-06,1.30855E-06,1.34690E-06, &
1464 1.38609E-06,1.42614E-06,1.46706E-06,1.50886E-06,1.55155E-06, &
1465 1.59515E-06,1.63967E-06,1.68512E-06,1.73150E-06,1.77884E-06, &
1466 1.82715E-06,1.87643E-06,1.92670E-06,1.97797E-06,2.03026E-06, &
1467 2.08356E-06,2.13791E-06,2.19330E-06,2.24975E-06,2.30728E-06, &
1468 2.36589E-06,2.42560E-06,2.48641E-06,2.54835E-06,2.61142E-06/
1469 DATA (TOTPLNK(IDATA,11),IDATA=151,181)/ &
1470 2.67563E-06,2.74100E-06,2.80754E-06,2.87526E-06,2.94417E-06, &
1471 3.01429E-06,3.08562E-06,3.15819E-06,3.23199E-06,3.30704E-06, &
1472 3.38336E-06,3.46096E-06,3.53984E-06,3.62002E-06,3.70151E-06, &
1473 3.78433E-06,3.86848E-06,3.95399E-06,4.04084E-06,4.12907E-06, &
1474 4.21868E-06,4.30968E-06,4.40209E-06,4.49592E-06,4.59117E-06, &
1475 4.68786E-06,4.78600E-06,4.88561E-06,4.98669E-06,5.08926E-06, &
1476 5.19332E-06/
1477 DATA (TOTPLNK(IDATA,12),IDATA=1,50)/ &
1478 2.73921E-10,3.04500E-10,3.38056E-10,3.74835E-10,4.15099E-10, &
1479 4.59126E-10,5.07214E-10,5.59679E-10,6.16857E-10,6.79103E-10, &
1480 7.46796E-10,8.20335E-10,9.00144E-10,9.86671E-10,1.08039E-09, &
1481 1.18180E-09,1.29142E-09,1.40982E-09,1.53757E-09,1.67529E-09, &
1482 1.82363E-09,1.98327E-09,2.15492E-09,2.33932E-09,2.53726E-09, &
1483 2.74957E-09,2.97710E-09,3.22075E-09,3.48145E-09,3.76020E-09, &
1484 4.05801E-09,4.37595E-09,4.71513E-09,5.07672E-09,5.46193E-09, &
1485 5.87201E-09,6.30827E-09,6.77205E-09,7.26480E-09,7.78794E-09, &
1486 8.34304E-09,8.93163E-09,9.55537E-09,1.02159E-08,1.09151E-08, &
1487 1.16547E-08,1.24365E-08,1.32625E-08,1.41348E-08,1.50554E-08/
1488 DATA (TOTPLNK(IDATA,12),IDATA=51,100)/ &
1489 1.60264E-08,1.70500E-08,1.81285E-08,1.92642E-08,2.04596E-08, &
1490 2.17171E-08,2.30394E-08,2.44289E-08,2.58885E-08,2.74209E-08, &
1491 2.90290E-08,3.07157E-08,3.24841E-08,3.43371E-08,3.62782E-08, &
1492 3.83103E-08,4.04371E-08,4.26617E-08,4.49878E-08,4.74190E-08, &
1493 4.99589E-08,5.26113E-08,5.53801E-08,5.82692E-08,6.12826E-08, &
1494 6.44245E-08,6.76991E-08,7.11105E-08,7.46634E-08,7.83621E-08, &
1495 8.22112E-08,8.62154E-08,9.03795E-08,9.47081E-08,9.92066E-08, &
1496 1.03879E-07,1.08732E-07,1.13770E-07,1.18998E-07,1.24422E-07, &
1497 1.30048E-07,1.35880E-07,1.41924E-07,1.48187E-07,1.54675E-07, &
1498 1.61392E-07,1.68346E-07,1.75543E-07,1.82988E-07,1.90688E-07/
1499 DATA (TOTPLNK(IDATA,12),IDATA=101,150)/ &
1500 1.98650E-07,2.06880E-07,2.15385E-07,2.24172E-07,2.33247E-07, &
1501 2.42617E-07,2.52289E-07,2.62272E-07,2.72571E-07,2.83193E-07, &
1502 2.94147E-07,3.05440E-07,3.17080E-07,3.29074E-07,3.41430E-07, &
1503 3.54155E-07,3.67259E-07,3.80747E-07,3.94631E-07,4.08916E-07, &
1504 4.23611E-07,4.38725E-07,4.54267E-07,4.70245E-07,4.86666E-07, &
1505 5.03541E-07,5.20879E-07,5.38687E-07,5.56975E-07,5.75751E-07, &
1506 5.95026E-07,6.14808E-07,6.35107E-07,6.55932E-07,6.77293E-07, &
1507 6.99197E-07,7.21656E-07,7.44681E-07,7.68278E-07,7.92460E-07, &
1508 8.17235E-07,8.42614E-07,8.68606E-07,8.95223E-07,9.22473E-07, &
1509 9.50366E-07,9.78915E-07,1.00813E-06,1.03802E-06,1.06859E-06/
1510 DATA (TOTPLNK(IDATA,12),IDATA=151,181)/ &
1511 1.09986E-06,1.13184E-06,1.16453E-06,1.19796E-06,1.23212E-06, &
1512 1.26703E-06,1.30270E-06,1.33915E-06,1.37637E-06,1.41440E-06, &
1513 1.45322E-06,1.49286E-06,1.53333E-06,1.57464E-06,1.61679E-06, &
1514 1.65981E-06,1.70370E-06,1.74847E-06,1.79414E-06,1.84071E-06, &
1515 1.88821E-06,1.93663E-06,1.98599E-06,2.03631E-06,2.08759E-06, &
1516 2.13985E-06,2.19310E-06,2.24734E-06,2.30260E-06,2.35888E-06, &
1517 2.41619E-06/
1518 DATA (TOTPLNK(IDATA,13),IDATA=1,50)/ &
1519 4.53634E-11,5.11435E-11,5.75754E-11,6.47222E-11,7.26531E-11, &
1520 8.14420E-11,9.11690E-11,1.01921E-10,1.13790E-10,1.26877E-10, &
1521 1.41288E-10,1.57140E-10,1.74555E-10,1.93665E-10,2.14613E-10, &
1522 2.37548E-10,2.62633E-10,2.90039E-10,3.19948E-10,3.52558E-10, &
1523 3.88073E-10,4.26716E-10,4.68719E-10,5.14331E-10,5.63815E-10, &
1524 6.17448E-10,6.75526E-10,7.38358E-10,8.06277E-10,8.79625E-10, &
1525 9.58770E-10,1.04410E-09,1.13602E-09,1.23495E-09,1.34135E-09, &
1526 1.45568E-09,1.57845E-09,1.71017E-09,1.85139E-09,2.00268E-09, &
1527 2.16464E-09,2.33789E-09,2.52309E-09,2.72093E-09,2.93212E-09, &
1528 3.15740E-09,3.39757E-09,3.65341E-09,3.92579E-09,4.21559E-09/
1529 DATA (TOTPLNK(IDATA,13),IDATA=51,100)/ &
1530 4.52372E-09,4.85115E-09,5.19886E-09,5.56788E-09,5.95928E-09, &
1531 6.37419E-09,6.81375E-09,7.27917E-09,7.77168E-09,8.29256E-09, &
1532 8.84317E-09,9.42487E-09,1.00391E-08,1.06873E-08,1.13710E-08, &
1533 1.20919E-08,1.28515E-08,1.36514E-08,1.44935E-08,1.53796E-08, &
1534 1.63114E-08,1.72909E-08,1.83201E-08,1.94008E-08,2.05354E-08, &
1535 2.17258E-08,2.29742E-08,2.42830E-08,2.56545E-08,2.70910E-08, &
1536 2.85950E-08,3.01689E-08,3.18155E-08,3.35373E-08,3.53372E-08, &
1537 3.72177E-08,3.91818E-08,4.12325E-08,4.33727E-08,4.56056E-08, &
1538 4.79342E-08,5.03617E-08,5.28915E-08,5.55270E-08,5.82715E-08, &
1539 6.11286E-08,6.41019E-08,6.71951E-08,7.04119E-08,7.37560E-08/
1540 DATA (TOTPLNK(IDATA,13),IDATA=101,150)/ &
1541 7.72315E-08,8.08424E-08,8.45927E-08,8.84866E-08,9.25281E-08, &
1542 9.67218E-08,1.01072E-07,1.05583E-07,1.10260E-07,1.15107E-07, &
1543 1.20128E-07,1.25330E-07,1.30716E-07,1.36291E-07,1.42061E-07, &
1544 1.48031E-07,1.54206E-07,1.60592E-07,1.67192E-07,1.74015E-07, &
1545 1.81064E-07,1.88345E-07,1.95865E-07,2.03628E-07,2.11643E-07, &
1546 2.19912E-07,2.28443E-07,2.37244E-07,2.46318E-07,2.55673E-07, &
1547 2.65316E-07,2.75252E-07,2.85489E-07,2.96033E-07,3.06891E-07, &
1548 3.18070E-07,3.29576E-07,3.41417E-07,3.53600E-07,3.66133E-07, &
1549 3.79021E-07,3.92274E-07,4.05897E-07,4.19899E-07,4.34288E-07, &
1550 4.49071E-07,4.64255E-07,4.79850E-07,4.95863E-07,5.12300E-07/
1551 DATA (TOTPLNK(IDATA,13),IDATA=151,181)/ &
1552 5.29172E-07,5.46486E-07,5.64250E-07,5.82473E-07,6.01164E-07, &
1553 6.20329E-07,6.39979E-07,6.60122E-07,6.80767E-07,7.01922E-07, &
1554 7.23596E-07,7.45800E-07,7.68539E-07,7.91826E-07,8.15669E-07, &
1555 8.40076E-07,8.65058E-07,8.90623E-07,9.16783E-07,9.43544E-07, &
1556 9.70917E-07,9.98912E-07,1.02754E-06,1.05681E-06,1.08673E-06, &
1557 1.11731E-06,1.14856E-06,1.18050E-06,1.21312E-06,1.24645E-06, &
1558 1.28049E-06/
1559 DATA (TOTPLNK(IDATA,14),IDATA=1,50)/ &
1560 1.40113E-11,1.59358E-11,1.80960E-11,2.05171E-11,2.32266E-11, &
1561 2.62546E-11,2.96335E-11,3.33990E-11,3.75896E-11,4.22469E-11, &
1562 4.74164E-11,5.31466E-11,5.94905E-11,6.65054E-11,7.42522E-11, &
1563 8.27975E-11,9.22122E-11,1.02573E-10,1.13961E-10,1.26466E-10, &
1564 1.40181E-10,1.55206E-10,1.71651E-10,1.89630E-10,2.09265E-10, &
1565 2.30689E-10,2.54040E-10,2.79467E-10,3.07128E-10,3.37190E-10, &
1566 3.69833E-10,4.05243E-10,4.43623E-10,4.85183E-10,5.30149E-10, &
1567 5.78755E-10,6.31255E-10,6.87910E-10,7.49002E-10,8.14824E-10, &
1568 8.85687E-10,9.61914E-10,1.04385E-09,1.13186E-09,1.22631E-09, &
1569 1.32761E-09,1.43617E-09,1.55243E-09,1.67686E-09,1.80992E-09/
1570 DATA (TOTPLNK(IDATA,14),IDATA=51,100)/ &
1571 1.95212E-09,2.10399E-09,2.26607E-09,2.43895E-09,2.62321E-09, &
1572 2.81949E-09,3.02844E-09,3.25073E-09,3.48707E-09,3.73820E-09, &
1573 4.00490E-09,4.28794E-09,4.58819E-09,4.90647E-09,5.24371E-09, &
1574 5.60081E-09,5.97875E-09,6.37854E-09,6.80120E-09,7.24782E-09, &
1575 7.71950E-09,8.21740E-09,8.74271E-09,9.29666E-09,9.88054E-09, &
1576 1.04956E-08,1.11434E-08,1.18251E-08,1.25422E-08,1.32964E-08, &
1577 1.40890E-08,1.49217E-08,1.57961E-08,1.67140E-08,1.76771E-08, &
1578 1.86870E-08,1.97458E-08,2.08553E-08,2.20175E-08,2.32342E-08, &
1579 2.45077E-08,2.58401E-08,2.72334E-08,2.86900E-08,3.02122E-08, &
1580 3.18021E-08,3.34624E-08,3.51954E-08,3.70037E-08,3.88899E-08/
1581 DATA (TOTPLNK(IDATA,14),IDATA=101,150)/ &
1582 4.08568E-08,4.29068E-08,4.50429E-08,4.72678E-08,4.95847E-08, &
1583 5.19963E-08,5.45058E-08,5.71161E-08,5.98309E-08,6.26529E-08, &
1584 6.55857E-08,6.86327E-08,7.17971E-08,7.50829E-08,7.84933E-08, &
1585 8.20323E-08,8.57035E-08,8.95105E-08,9.34579E-08,9.75488E-08, &
1586 1.01788E-07,1.06179E-07,1.10727E-07,1.15434E-07,1.20307E-07, &
1587 1.25350E-07,1.30566E-07,1.35961E-07,1.41539E-07,1.47304E-07, &
1588 1.53263E-07,1.59419E-07,1.65778E-07,1.72345E-07,1.79124E-07, &
1589 1.86122E-07,1.93343E-07,2.00792E-07,2.08476E-07,2.16400E-07, &
1590 2.24568E-07,2.32988E-07,2.41666E-07,2.50605E-07,2.59813E-07, &
1591 2.69297E-07,2.79060E-07,2.89111E-07,2.99455E-07,3.10099E-07/
1592 DATA (TOTPLNK(IDATA,14),IDATA=151,181)/ &
1593 3.21049E-07,3.32311E-07,3.43893E-07,3.55801E-07,3.68041E-07, &
1594 3.80621E-07,3.93547E-07,4.06826E-07,4.20465E-07,4.34473E-07, &
1595 4.48856E-07,4.63620E-07,4.78774E-07,4.94325E-07,5.10280E-07, &
1596 5.26648E-07,5.43436E-07,5.60652E-07,5.78302E-07,5.96397E-07, &
1597 6.14943E-07,6.33949E-07,6.53421E-07,6.73370E-07,6.93803E-07, &
1598 7.14731E-07,7.36157E-07,7.58095E-07,7.80549E-07,8.03533E-07, &
1599 8.27050E-07/
1600 DATA (TOTPLNK(IDATA,15),IDATA=1,50)/ &
1601 3.90483E-12,4.47999E-12,5.13122E-12,5.86739E-12,6.69829E-12, &
1602 7.63467E-12,8.68833E-12,9.87221E-12,1.12005E-11,1.26885E-11, &
1603 1.43534E-11,1.62134E-11,1.82888E-11,2.06012E-11,2.31745E-11, &
1604 2.60343E-11,2.92087E-11,3.27277E-11,3.66242E-11,4.09334E-11, &
1605 4.56935E-11,5.09455E-11,5.67338E-11,6.31057E-11,7.01127E-11, &
1606 7.78096E-11,8.62554E-11,9.55130E-11,1.05651E-10,1.16740E-10, &
1607 1.28858E-10,1.42089E-10,1.56519E-10,1.72243E-10,1.89361E-10, &
1608 2.07978E-10,2.28209E-10,2.50173E-10,2.73999E-10,2.99820E-10, &
1609 3.27782E-10,3.58034E-10,3.90739E-10,4.26067E-10,4.64196E-10, &
1610 5.05317E-10,5.49631E-10,5.97347E-10,6.48689E-10,7.03891E-10/
1611 DATA (TOTPLNK(IDATA,15),IDATA=51,100)/ &
1612 7.63201E-10,8.26876E-10,8.95192E-10,9.68430E-10,1.04690E-09, &
1613 1.13091E-09,1.22079E-09,1.31689E-09,1.41957E-09,1.52922E-09, &
1614 1.64623E-09,1.77101E-09,1.90401E-09,2.04567E-09,2.19647E-09, &
1615 2.35690E-09,2.52749E-09,2.70875E-09,2.90127E-09,3.10560E-09, &
1616 3.32238E-09,3.55222E-09,3.79578E-09,4.05375E-09,4.32682E-09, &
1617 4.61574E-09,4.92128E-09,5.24420E-09,5.58536E-09,5.94558E-09, &
1618 6.32575E-09,6.72678E-09,7.14964E-09,7.59526E-09,8.06470E-09, &
1619 8.55897E-09,9.07916E-09,9.62638E-09,1.02018E-08,1.08066E-08, &
1620 1.14420E-08,1.21092E-08,1.28097E-08,1.35446E-08,1.43155E-08, &
1621 1.51237E-08,1.59708E-08,1.68581E-08,1.77873E-08,1.87599E-08/
1622 DATA (TOTPLNK(IDATA,15),IDATA=101,150)/ &
1623 1.97777E-08,2.08423E-08,2.19555E-08,2.31190E-08,2.43348E-08, &
1624 2.56045E-08,2.69302E-08,2.83140E-08,2.97578E-08,3.12636E-08, &
1625 3.28337E-08,3.44702E-08,3.61755E-08,3.79516E-08,3.98012E-08, &
1626 4.17265E-08,4.37300E-08,4.58143E-08,4.79819E-08,5.02355E-08, &
1627 5.25777E-08,5.50114E-08,5.75393E-08,6.01644E-08,6.28896E-08, &
1628 6.57177E-08,6.86521E-08,7.16959E-08,7.48520E-08,7.81239E-08, &
1629 8.15148E-08,8.50282E-08,8.86675E-08,9.24362E-08,9.63380E-08, &
1630 1.00376E-07,1.04555E-07,1.08878E-07,1.13349E-07,1.17972E-07, &
1631 1.22751E-07,1.27690E-07,1.32793E-07,1.38064E-07,1.43508E-07, &
1632 1.49129E-07,1.54931E-07,1.60920E-07,1.67099E-07,1.73473E-07/
1633 DATA (TOTPLNK(IDATA,15),IDATA=151,181)/ &
1634 1.80046E-07,1.86825E-07,1.93812E-07,2.01014E-07,2.08436E-07, &
1635 2.16082E-07,2.23957E-07,2.32067E-07,2.40418E-07,2.49013E-07, &
1636 2.57860E-07,2.66963E-07,2.76328E-07,2.85961E-07,2.95868E-07, &
1637 3.06053E-07,3.16524E-07,3.27286E-07,3.38345E-07,3.49707E-07, &
1638 3.61379E-07,3.73367E-07,3.85676E-07,3.98315E-07,4.11287E-07, &
1639 4.24602E-07,4.38265E-07,4.52283E-07,4.66662E-07,4.81410E-07, &
1640 4.96535E-07/
1641 DATA (TOTPLNK(IDATA,16),IDATA=1,50)/ &
1642 4.65378E-13,5.41927E-13,6.29913E-13,7.30869E-13,8.46510E-13, &
1643 9.78750E-13,1.12972E-12,1.30181E-12,1.49764E-12,1.72016E-12, &
1644 1.97260E-12,2.25858E-12,2.58206E-12,2.94744E-12,3.35955E-12, &
1645 3.82372E-12,4.34581E-12,4.93225E-12,5.59010E-12,6.32711E-12, &
1646 7.15171E-12,8.07317E-12,9.10159E-12,1.02480E-11,1.15244E-11, &
1647 1.29438E-11,1.45204E-11,1.62697E-11,1.82084E-11,2.03545E-11, &
1648 2.27278E-11,2.53494E-11,2.82424E-11,3.14313E-11,3.49431E-11, &
1649 3.88064E-11,4.30522E-11,4.77139E-11,5.28273E-11,5.84308E-11, &
1650 6.45658E-11,7.12764E-11,7.86103E-11,8.66176E-11,9.53534E-11, &
1651 1.04875E-10,1.15245E-10,1.26528E-10,1.38796E-10,1.52123E-10/
1652 DATA (TOTPLNK(IDATA,16),IDATA=51,100)/ &
1653 1.66590E-10,1.82281E-10,1.99287E-10,2.17704E-10,2.37632E-10, &
1654 2.59182E-10,2.82468E-10,3.07610E-10,3.34738E-10,3.63988E-10, &
1655 3.95504E-10,4.29438E-10,4.65951E-10,5.05212E-10,5.47402E-10, &
1656 5.92707E-10,6.41329E-10,6.93477E-10,7.49371E-10,8.09242E-10, &
1657 8.73338E-10,9.41911E-10,1.01524E-09,1.09359E-09,1.17728E-09, &
1658 1.26660E-09,1.36190E-09,1.46350E-09,1.57177E-09,1.68709E-09, &
1659 1.80984E-09,1.94044E-09,2.07932E-09,2.22693E-09,2.38373E-09, &
1660 2.55021E-09,2.72689E-09,2.91429E-09,3.11298E-09,3.32353E-09, &
1661 3.54655E-09,3.78265E-09,4.03251E-09,4.29679E-09,4.57620E-09, &
1662 4.87148E-09,5.18341E-09,5.51276E-09,5.86037E-09,6.22708E-09/
1663 DATA (TOTPLNK(IDATA,16),IDATA=101,150)/ &
1664 6.61381E-09,7.02145E-09,7.45097E-09,7.90336E-09,8.37967E-09, &
1665 8.88092E-09,9.40827E-09,9.96280E-09,1.05457E-08,1.11583E-08, &
1666 1.18017E-08,1.24773E-08,1.31865E-08,1.39306E-08,1.47111E-08, &
1667 1.55295E-08,1.63872E-08,1.72860E-08,1.82274E-08,1.92132E-08, &
1668 2.02450E-08,2.13247E-08,2.24541E-08,2.36352E-08,2.48699E-08, &
1669 2.61602E-08,2.75082E-08,2.89161E-08,3.03860E-08,3.19203E-08, &
1670 3.35213E-08,3.51913E-08,3.69330E-08,3.87486E-08,4.06411E-08, &
1671 4.26129E-08,4.46668E-08,4.68058E-08,4.90325E-08,5.13502E-08, &
1672 5.37617E-08,5.62703E-08,5.88791E-08,6.15915E-08,6.44107E-08, &
1673 6.73404E-08,7.03841E-08,7.35453E-08,7.68278E-08,8.02355E-08/
1674 DATA (TOTPLNK(IDATA,16),IDATA=151,181)/ &
1675 8.37721E-08,8.74419E-08,9.12486E-08,9.51968E-08,9.92905E-08, &
1676 1.03534E-07,1.07932E-07,1.12490E-07,1.17211E-07,1.22100E-07, &
1677 1.27163E-07,1.32404E-07,1.37829E-07,1.43443E-07,1.49250E-07, &
1678 1.55257E-07,1.61470E-07,1.67893E-07,1.74532E-07,1.81394E-07, &
1679 1.88485E-07,1.95810E-07,2.03375E-07,2.11189E-07,2.19256E-07, &
1680 2.27583E-07,2.36177E-07,2.45046E-07,2.54196E-07,2.63634E-07, &
1681 2.73367E-07/
1683 DATA (TOTPLK16(IDATA),IDATA=1,50)/ &
1684 4.46128E-13,5.19008E-13,6.02681E-13,6.98580E-13,8.08302E-13, &
1685 9.33629E-13,1.07654E-12,1.23925E-12,1.42419E-12,1.63407E-12, &
1686 1.87190E-12,2.14099E-12,2.44498E-12,2.78793E-12,3.17424E-12, &
1687 3.60881E-12,4.09698E-12,4.64461E-12,5.25813E-12,5.94456E-12, &
1688 6.71156E-12,7.56752E-12,8.52154E-12,9.58357E-12,1.07644E-11, &
1689 1.20758E-11,1.35304E-11,1.51420E-11,1.69256E-11,1.88973E-11, &
1690 2.10746E-11,2.34762E-11,2.61227E-11,2.90356E-11,3.22388E-11, &
1691 3.57574E-11,3.96187E-11,4.38519E-11,4.84883E-11,5.35616E-11, &
1692 5.91075E-11,6.51647E-11,7.17743E-11,7.89797E-11,8.68284E-11, &
1693 9.53697E-11,1.04658E-10,1.14748E-10,1.25701E-10,1.37582E-10/
1694 DATA (TOTPLK16(IDATA),IDATA=51,100)/ &
1695 1.50457E-10,1.64400E-10,1.79487E-10,1.95799E-10,2.13422E-10, &
1696 2.32446E-10,2.52970E-10,2.75094E-10,2.98925E-10,3.24578E-10, &
1697 3.52172E-10,3.81833E-10,4.13695E-10,4.47897E-10,4.84588E-10, &
1698 5.23922E-10,5.66063E-10,6.11182E-10,6.59459E-10,7.11081E-10, &
1699 7.66251E-10,8.25172E-10,8.88065E-10,9.55155E-10,1.02668E-09, &
1700 1.10290E-09,1.18406E-09,1.27044E-09,1.36233E-09,1.46002E-09, &
1701 1.56382E-09,1.67406E-09,1.79108E-09,1.91522E-09,2.04686E-09, &
1702 2.18637E-09,2.33416E-09,2.49063E-09,2.65622E-09,2.83136E-09, &
1703 3.01653E-09,3.21221E-09,3.41890E-09,3.63712E-09,3.86740E-09, &
1704 4.11030E-09,4.36641E-09,4.63631E-09,4.92064E-09,5.22003E-09/
1705 DATA (TOTPLK16(IDATA),IDATA=101,150)/ &
1706 5.53516E-09,5.86670E-09,6.21538E-09,6.58191E-09,6.96708E-09, &
1707 7.37165E-09,7.79645E-09,8.24229E-09,8.71007E-09,9.20066E-09, &
1708 9.71498E-09,1.02540E-08,1.08186E-08,1.14100E-08,1.20290E-08, &
1709 1.26767E-08,1.33544E-08,1.40630E-08,1.48038E-08,1.55780E-08, &
1710 1.63867E-08,1.72313E-08,1.81130E-08,1.90332E-08,1.99932E-08, &
1711 2.09945E-08,2.20385E-08,2.31267E-08,2.42605E-08,2.54416E-08, &
1712 2.66716E-08,2.79520E-08,2.92846E-08,3.06711E-08,3.21133E-08, &
1713 3.36128E-08,3.51717E-08,3.67918E-08,3.84749E-08,4.02232E-08, &
1714 4.20386E-08,4.39231E-08,4.58790E-08,4.79083E-08,5.00132E-08, &
1715 5.21961E-08,5.44592E-08,5.68049E-08,5.92356E-08,6.17537E-08/
1716 DATA (TOTPLK16(IDATA),IDATA=151,181)/ &
1717 6.43617E-08,6.70622E-08,6.98578E-08,7.27511E-08,7.57449E-08, &
1718 7.88419E-08,8.20449E-08,8.53568E-08,8.87805E-08,9.23190E-08, &
1719 9.59753E-08,9.97526E-08,1.03654E-07,1.07682E-07,1.11841E-07, &
1720 1.16134E-07,1.20564E-07,1.25135E-07,1.29850E-07,1.34712E-07, &
1721 1.39726E-07,1.44894E-07,1.50221E-07,1.55711E-07,1.61367E-07, &
1722 1.67193E-07,1.73193E-07,1.79371E-07,1.85732E-07,1.92279E-07, &
1723 1.99016E-07/
1728 CONTAINS
1730 !------------------------------------------------------------------
1731 SUBROUTINE RRTMLWRAD( &
1732 p_top &
1733 ,rthraten,rthratenc,glw,olr,emiss &
1734 ,p8w,p3d,pi3d &
1735 ,dz8w,tsk,t3d,t8w,rho3d,r,g &
1736 ,icloud, warm_rain &
1737 ,ids,ide, jds,jde, kds,kde &
1738 ,ims,ime, jms,jme, kms,kme &
1739 ,its,ite, jts,jte, kts,kte &
1740 ,qv3d,qc3d,qr3d &
1741 ,qi3d,qs3d,qg3d,cldfra3d &
1742 ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg &
1743 !ccc Added for time-varying trace gases.
1744 ,yr, julian, ghg_input )
1745 !ccc
1746 !------------------------------------------------------------------
1747 !ccc
1748 USE MODULE_RA_CLWRF_SUPPORT, ONLY : read_CAMgases
1749 !ccc
1751 IMPLICIT NONE
1752 !------------------------------------------------------------------
1753 LOGICAL, INTENT(IN ) :: warm_rain
1754 !
1755 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
1756 ims,ime, jms,jme, kms,kme, &
1757 its,ite, jts,jte, kts,kte
1759 INTEGER, INTENT(IN ) :: ICLOUD, ghg_input
1760 !
1761 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
1762 INTENT(IN ) :: dz8w, &
1763 T3D, &
1764 t8w, &
1765 p8w, &
1766 P3D, &
1767 pi3D, &
1768 rho3D
1769 !
1770 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
1771 INTENT(INOUT) :: RTHRATEN, &
1772 RTHRATENC
1773 !
1774 REAL, DIMENSION( ims:ime, jms:jme ) , &
1775 INTENT(IN ) :: EMISS, &
1776 TSK
1777 !
1778 REAL, DIMENSION( ims:ime, jms:jme ) , &
1779 INTENT(INOUT) :: GLW, &
1780 OLR
1781 !
1782 REAL, INTENT(IN ) :: R,G
1784 !ccc Added for time-varying trace gases.
1785 INTEGER, INTENT(IN ) :: yr
1786 REAL, INTENT(IN ) :: julian
1787 !ccc
1789 !
1790 ! Optional
1791 !
1792 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
1793 OPTIONAL , &
1794 INTENT(IN ) :: &
1795 CLDFRA3D, &
1796 QV3D, &
1797 QC3D, &
1798 QR3D, &
1799 QI3D, &
1800 QS3D, &
1801 QG3D
1803 LOGICAL, OPTIONAL, INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
1805 ! LOCAL VARS
1807 REAL, DIMENSION( kts:kte+1 ) :: Pw1D, &
1808 Tw1D
1810 REAL, DIMENSION( kts:kte ) :: TTEN1D, &
1811 TTEN1DC, &
1812 CLDFRA1D, &
1813 DZ1D, &
1814 P1D, &
1815 T1D, &
1816 QV1D, &
1817 QC1D, &
1818 QR1D, &
1819 QI1D, &
1820 QS1D, &
1821 QG1D
1822 !
1823 REAL :: TSFC,GLW0,OLR0,EMISS0
1824 !
1825 INTEGER:: i,j,K,NK
1826 LOGICAL :: predicate
1828 ! Add variables for variable trace gas concentrations (ccc)
1829 REAL(8) :: co2vmr, n2ovmr, ch4vmr
1830 REAL(8) :: cfc11vmr, cfc12vmr ! NOT USED
1831 LOGICAL, EXTERNAL :: wrf_dm_on_monitor
1832 CHARACTER(LEN=256) :: message
1834 ! p_top for vertical nesting
1835 REAL, INTENT(IN ) :: p_top
1837 !------------------------------------------------------------------
1839 IF ( p_top .GT. 0 ) THEN ! flag value for NMM = -1
1840 ! NLAYERS is recalculated
1841 ! every time the radiation scheme is called. This is
1842 ! necessary if e_vert parent .NE. e_vert nest since
1843 ! NLAYERS could then be different for each domain.
1844 CALL rrtminit( &
1845 p_top, .FALSE. , &
1846 ids, ide, jds, jde, kds, kde, &
1847 ims, ime, jms, jme, kms, kme, &
1848 its, ite, jts, jte, kts, kte )
1849 END IF
1851 !----- Calculate the trace gas concentrations from file.
1852 !ccc
1853 IF(ghg_input .EQ. 1 ) THEN
1854 CALL read_CAMgases(yr,julian,.false.,"RRTM",co2vmr,n2ovmr,ch4vmr,cfc11vmr,cfc12vmr)
1855 ELSE
1856 ! values used in pre-V3.5
1857 ! co2vmr = 330.e-6
1858 ! n2ovmr = 0.
1859 ! ch4vmr = 0.
1860 ! values updated to RRTMG in V3.5
1861 co2vmr = (280. + 90.*exp(0.02*(yr-2000)))*1.e-6
1862 ! co2vmr = 379.e-6
1863 n2ovmr = 319.e-9
1864 ch4vmr = 1774.e-9
1865 END IF
1867 IF ( wrf_dm_on_monitor() ) THEN
1868 WRITE(message,*)'CAM-CLWRF interpolated values______ year:',yr,' julian day:',julian
1869 call wrf_debug( 100, message)
1870 WRITE(message,*)' CAM-CLWRF co2vmr: ',co2vmr,' n2ovmr:',n2ovmr,' ch4vmr:',ch4vmr
1871 call wrf_debug( 100, message)
1872 ENDIF
1875 !-----CALCULATE LONG WAVE RADIATION
1876 !
1877 j_loop: DO J=jts,jte
1878 i_loop: DO I=its,ite
1880 ! reverse vars
1881 ! p1D pw1D are in mb
1883 do k=kts,kte+1
1884 NK=kme-k+kms
1885 Pw1D(K) = p8w(I,NK,J)/100.
1886 Tw1D(K) = t8w(I,NK,J)
1887 enddo
1889 DO K=kts,kte
1890 QV1D(K)=0.
1891 QC1D(K)=0.
1892 QR1D(K)=0.
1893 QI1D(K)=0.
1894 QS1D(K)=0.
1895 CLDFRA1D(k)=0.
1896 ENDDO
1898 DO K=kts,kte
1899 NK=kme-1-K+kms
1900 QV1D(K)=QV3D(I,NK,J)
1901 QV1D(K)=max(0.,QV1D(K))
1902 ENDDO
1904 DO K=kts,kte
1905 NK=kme-1-K+kms
1906 TTEN1D(K)=0.
1907 TTEN1DC(K)=0.
1908 T1D(K)=T3D(I,NK,J)
1909 P1D(K)=P3D(I,NK,J)/100.
1910 DZ1D(K)=dz8w(I,NK,J)
1911 ENDDO
1913 IF (ICLOUD .ne. 0) THEN
1914 IF ( PRESENT( CLDFRA3D ) ) THEN
1915 DO K=kts,kte
1916 NK=kme-1-K+kms
1917 CLDFRA1D(k)=CLDFRA3D(I,NK,J)
1918 ENDDO
1919 ENDIF
1921 IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
1922 IF ( F_QC) THEN
1923 DO K=kts,kte
1924 NK=kme-1-K+kms
1925 QC1D(K)=QC3D(I,NK,J)
1926 QC1D(K)=max(0.,QC1D(K))
1927 ENDDO
1928 ENDIF
1929 ENDIF
1931 IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
1932 IF ( F_QR) THEN
1933 DO K=kts,kte
1934 NK=kme-1-K+kms
1935 QR1D(K)=QR3D(I,NK,J)
1936 QR1D(K)=max(0.,QR1D(K))
1937 ENDDO
1938 ENDIF
1939 ENDIF
1941 ! This logic is tortured because cannot test F_QI unless
1942 ! it is present, and order of evaluation of expressions
1943 ! is not specified in Fortran
1945 IF ( PRESENT ( F_QI ) ) THEN
1946 predicate = F_QI
1947 ELSE
1948 predicate = .FALSE.
1949 ENDIF
1951 IF (.NOT. predicate .and. .not. warm_rain) THEN
1952 DO K=kts,kte
1953 IF (T1D(K) .lt. 273.15) THEN
1954 QI1D(K)=QC1D(K)
1955 QS1D(K)=QR1D(K)
1956 QC1D(K)=0.
1957 QR1D(K)=0.
1958 ENDIF
1959 ENDDO
1960 ENDIF
1962 IF (PRESENT(F_QI) .AND. PRESENT(QI3D)) THEN
1963 DO K=kts,kte
1964 NK=kme-1-K+kms
1965 QI1D(K)=QI3D(I,NK,J)
1966 QI1D(K)=max(0.,QI1D(K))
1967 ENDDO
1968 ENDIF
1970 IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
1971 IF (F_QS) THEN
1972 DO K=kts,kte
1973 NK=kme-1-K+kms
1974 QS1D(K)=QS3D(I,NK,J)
1975 QS1D(K)=max(0.,QS1D(K))
1976 ENDDO
1977 ENDIF
1978 ENDIF
1980 IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
1981 IF (F_QG) THEN
1982 DO K=kts,kte
1983 NK=kme-1-K+kms
1984 QG1D(K)=QG3D(I,NK,J)
1985 QG1D(K)=max(0.,QG1D(K))
1986 ENDDO
1987 ENDIF
1988 ENDIF
1990 ENDIF
1992 EMISS0=EMISS(I,J)
1993 GLW0=0.
1994 OLR0=0.
1995 TSFC=TSK(I,J)
1997 CALL RRTM(tten1d,tten1dc,glw0,olr0,tsfc,cldfra1d, &
1998 t1d,tw1d,qv1d,qc1d, &
1999 qr1d,qi1d,qs1d,qg1d,p1d,pW1d,dz1d, &
2000 emiss0,r,g, &
2001 !ccc Added for time-varying trace gases.
2002 co2vmr, n2ovmr, ch4vmr, &
2003 !ccc
2004 kts,kte )
2006 GLW(I,J)=GLW0
2007 OLR(I,J)=OLR0
2009 DO K=kts,kte
2010 nk=kme-1-k+kms
2011 rthraten(i,k,j)=rthraten(i,k,j)+tten1d(nk)/pi3d(i,k,j)
2012 rthratenc(i,k,j)=rthratenc(i,k,j)+tten1dc(nk)/pi3d(i,k,j)
2013 ENDDO
2015 END DO i_loop
2016 END DO j_loop
2018 !-------------------------------------------------------------------
2020 END SUBROUTINE RRTMLWRAD
2023 !****************************************************************************
2024 !* *
2025 !* RRTM *
2026 !* *
2027 !* *
2028 !* *
2029 !* RAPID RADIATIVE TRANSFER MODEL *
2030 !* *
2031 !* *
2032 !* ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. *
2033 !* 840 MEMORIAL DRIVE *
2034 !* CAMBRIDGE, MA 02139 *
2035 !* *
2036 !* *
2037 !* ELI J. MLAWER *
2038 !* STEVEN J. TAUBMAN~ *
2039 !* SHEPARD A. CLOUGH *
2040 !* *
2041 !* *
2042 !* ~currently at GFDL *
2043 !* *
2044 !* *
2045 !* *
2046 !* email: mlawer@aer.com *
2047 !* *
2048 !* The authors wish to acknowledge the contributions of the *
2049 !* following people: Patrick D. Brown, Michael J. Iacono, *
2050 !* Ronald E. Farren, Luke Chen, Robert Bergstrom. *
2051 !* *
2052 !****************************************************************************
2054 ! *** This version of RRTM has been altered to interface with the
2055 ! *** NCAR MM5 mesoscale model for the calculation of longwave radiative
2056 ! *** transfer (based on a code for interface with CCM model by M. J. Iacono)
2057 ! *** J. Dudhia ; March, 1999
2058 !---------------------------------------------------------------------
2059 SUBROUTINE RRTM(TTEN,TTENC,GLW,OLR,TSFC,CLDFRA,T,Tw,QV,QC, &
2060 QR,QI,QS,QG,P,Pw,DZ, &
2061 EMISS,R,G, &
2062 !ccc Added for time-varying trace gases.
2063 CO2VMR, N2OVMR, CH4VMR, &
2064 !ccc
2065 kts,kte )
2066 !---------------------------------------------------------------------
2067 ! *** This program is the driver for RRTM, the AER LW radiation model.
2068 ! This routine:
2069 ! Calls MM5ATM to provide atmosphere in column and boundary values
2070 ! a) calls GASABS to calculate gaseous optical depths
2071 ! b) calls SETCOEF to calculate various quantities needed for
2072 ! the radiative transfer algorithm
2073 ! c) calls RTRN (for both clear and cloudy columns) to do the
2074 ! radiative transfer calculation
2075 ! d) passes the necessary flux and cooling rate back to MM5
2076 !---------------------------------------------------------------------
2077 IMPLICIT NONE
2078 !---------------------------------------------------------------------
2080 INTEGER, INTENT(IN ) :: kts, kte
2081 !
2082 REAL, DIMENSION( kts:kte+1 ), INTENT(IN ) :: Pw, &
2083 Tw
2085 REAL, DIMENSION( kts:kte ), INTENT(IN ) :: CLDFRA, &
2086 T, &
2087 P, &
2088 DZ
2089 !
2090 REAL, DIMENSION( kts:kte ), INTENT(INOUT) :: &
2091 QV
2092 REAL, DIMENSION( kts:kte ), INTENT(IN ) :: &
2093 QC, &
2094 QR, &
2095 QI, &
2096 QS, &
2097 QG
2098 !
2099 REAL, DIMENSION( kts:kte ), INTENT(INOUT):: TTEN, &
2100 TTENC
2101 !
2102 REAL, INTENT(IN ) :: R, G, EMISS
2104 !ccc Added for time-varying trace gases.
2105 ! Trace gases variables
2106 REAL(8), INTENT(IN ) :: co2vmr, n2ovmr, ch4vmr
2107 !ccc
2109 !
2110 REAL, INTENT(INOUT) :: TSFC,GLW,OLR
2112 ! LOCAL VAR
2114 INTEGER, DIMENSION( NGPT,kts:NLAYERS ) :: ITR
2116 REAL, DIMENSION( NGPT,kts:NLAYERS ) :: PFRAC, &
2117 TAUG
2119 REAL, DIMENSION( 35,kts:NLAYERS ) :: WKL
2121 REAL, DIMENSION( MAXXSEC,kts:NLAYERS ) :: WX
2123 REAL, DIMENSION( kts:kte ) :: O3PROF
2125 REAL, DIMENSION( kts:NLAYERS ) :: PAVEL, &
2126 TAVEL, &
2127 CLDFRAC, &
2128 TAUCLOUD, &
2129 COLDRY, &
2130 COLH2O, &
2131 COLCO2, &
2132 COLO3, &
2133 COLN2O, &
2134 COLCH4, &
2135 COLO2, &
2136 CO2MULT, &
2137 FAC00, &
2138 FAC01, &
2139 FAC10, &
2140 FAC11, &
2141 FORFAC, &
2142 SELFFAC, &
2143 SELFFRAC
2145 !
2146 INTEGER, DIMENSION( kts:NLAYERS ) :: ICLDLYR, &
2147 JP, &
2148 JT, &
2149 JT1, &
2150 INDSELF
2152 REAL, DIMENSION( 0:NLAYERS ) :: PZ, &
2153 TZ, &
2154 TOTDFLUX, &
2155 TOTUFLUX, &
2156 HTR, &
2157 HTRC
2158 !
2159 INTEGER :: I,K,ktep1
2160 INTEGER :: LAYTROP,LAYSWTCH,LAYLOW
2161 REAL :: TBOUND
2162 REAL, DIMENSION(NBANDS) :: SEMISS
2165 !---------------------------------------------------------------------------
2166 ! RRTM Definitions
2167 ! NGPT ! Total number of g-point subintervals
2168 ! MXLAY ! Maximum number of model layers
2169 ! NBANDS ! Number of longwave spectral bands
2170 ! PI ! Geometric constant
2171 ! FLUXFAC ! Radiance to flux conversion factor
2172 ! HEATFAC ! Heating rate conversion factor
2173 ! NG(NBANDS) ! Number of g-points per band for input
2174 ! absorption coefficient data
2175 ! NSPA(NBANDS),NSPB(NBANDS) ! Number of reference atmospheres per band
2176 ! WAVENUM1(NBANDS) ! Longwave band lower limit (wavenumbers)
2177 ! WAVENUM2(NBANDS) ! Longwave band upper limit (wavenumbers)
2178 ! DELWAVE ! Longwave band width (wavenumbers)
2179 ! NLAYERS ! Number of model layers (mkx+1)
2180 ! PAVEL(MXLAY) ! Layer pressures (mb)
2181 ! PZ(0:MXLAY) ! Level (interface) pressures (mb)
2182 ! TAVEL(MXLAY) ! Layer temperatures (K)
2183 ! TZ(0:MXLAY) ! Level (interface) temperatures(mb)
2184 ! TBOUND ! Surface temperature (K)
2185 ! CLDFRAC(MXLAY) ! Layer cloud fraction
2186 ! TAUCLOUD(MXLAY) ! Layer cloud optical depth
2187 ! ITR(NGPT,MXLAY) ! Integer look-up table index
2188 ! PFRAC(NGPT,MXLAY) ! Planck fractions
2189 ! ICLDLYR(MXLAY) ! Flag for cloudy layers
2190 ! TOTUFLUX(0:MXLAY) ! Upward longwave flux (W/m2)
2191 ! TOTDFLUX(0:MXLAY) ! Downward longwave flux (W/m2)
2192 ! FNET(0:MXLAY) ! Net longwave flux (W/m2)
2193 ! HTR(0:MXLAY) ! Longwave heating rate (K/day)
2194 ! CLRNTTOA ! Clear-sky TOA outgoing flux (W/m2)
2195 ! CLRNTSRF ! Clear-sky net surface flux (W/m2)
2196 ! TOTUCLFL(0:MXLAY) ! Clear-sky upward longwave flux (W/m2)
2197 ! TOTDCLFL(0:MXLAY) ! Clear-sky downward longwave flux (W/m2)
2198 ! FNETC(0:MXLAY) ! Clear-sky net longwave flux (W/m2)
2199 ! HTRC(0:MXLAY) ! Clear-sky longwave heating rate (K/day)
2200 !
2201 ! This compiler directive was added to insure private common block storage
2202 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
2203 ! carry constants.
2204 !---------------------------------------------------------------------------
2206 ! ktep1=kte+1
2207 ktep1=NLAYERS
2208 !
2209 ! CLOUD EMISSIVITIES (M^2/G)
2210 ! THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))
2211 !
2212 ! ONEMINUS = 1. - 1.E-6
2213 ! PI = 2.*ASIN(1.)
2214 ! FLUXFAC = PI * 2.D4
2215 !
2216 CALL INIRAD (O3PROF,Pw,kts,kte)
2218 ! Prepare atmospheric profile from CCM for use in RRTM, and define
2219 ! other RRTM input parameters. Arrays are passed back through the
2220 ! existing RRTM commons and arrays.
2222 CALL MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG, &
2223 P,Pw,DZ,EMISS,R,G, &
2224 PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY, &
2225 WKL,WX,TBOUND,SEMISS, &
2226 !ccc Added for time-varying trace gases.
2227 CO2VMR, N2OVMR, CH4VMR, &
2228 !ccc
2229 kts,kte )
2231 ! Calculate information needed by the radiative transfer routine
2232 ! that is specific to this atmosphere, especially some of the
2233 ! coefficients and indices needed to compute the optical depths
2234 ! by interpolating data from stored reference atmospheres.
2236 CALL SETCOEF(kts,ktep1, &
2237 PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3, &
2238 COLN2O,COLCH4,COLO2,CO2MULT, &
2239 FAC00,FAC01,FAC10,FAC11, &
2240 FORFAC,SELFFAC,SELFFRAC, &
2241 JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW)
2243 CALL GASABS(kts,ktep1, &
2244 COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4, &
2245 COLO2,CO2MULT, &
2246 FAC00,FAC01,FAC10,FAC11, &
2247 FORFAC,SELFFAC,SELFFRAC, &
2248 JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG, &
2249 LAYTROP,LAYSWTCH,LAYLOW )
2251 ! Check for cloud in column. Use original CCM LW threshold: if total
2252 ! clear sky fraction < 0.999, then column is cloudy, otherwise consider
2253 ! it clear. Also, set up flag array, icldlyr, for use in radiative
2254 ! transfer. Set icldlyr to one for each layer with cloud. If tclrsf
2255 ! is not available, icldlyr can be set from cldfrac alone.
2257 do 1500 k = 1, nlayers
2258 if (cldfrac(k).gt.0.) then
2259 icldlyr(k) = 1
2260 else
2261 icldlyr(k) = 0
2262 endif
2263 1500 continue
2265 ! Call the radiative transfer routine.
2267 CALL RTRN(kts,ktep1, &
2268 TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX, &
2269 TOTUFLUX, HTR, HTRC, ICLDLYR, ITR, PFRAC, &
2270 TBOUND,SEMISS )
2272 ! Pass total sky up and down flux profiles to CCM output arrays and
2273 ! convert from mks to cgs units for CCM. Pass clear sky TOA and surface
2274 ! net fluxes to CCM fields for diagnostics. Pass total sky heating rate
2275 ! profile to CCM output arrays and convert units to K/sec. The vertical
2276 ! array index (bottom to top in RRTM) is reversed for CCM fields.
2278 ! flntc(iiplon) = CLRNTTOA*1.e3
2279 ! flnsc(iiplon) = CLRNTSRF*1.e3
2280 ! do 2400 k = 0, NLAYERS-1
2281 ! fulc(k+1) = TOTUCLFL(NLAYERS-1-k)*1.e3
2282 ! fdlc(k+1) = TOTDCLFL(NLAYERS-1-k)*1.e3
2283 ! ful(k+1) = TOTUFLUX(NLAYERS-1-k)*1.e3
2284 ! fdl(k+1) = TOTDFLUX(NLAYERS-1-k)*1.e3
2285 ! 2400 continue
2286 ! do 2450 k = 1, NLAYERS-1
2287 do 2450 k = 1, kte
2288 ! qrlc(k) = HTRC(NLAYERS-1-k)/86400.
2289 ! qrl(k) = HTR(NLAYERS-1-k)/86400.
2290 ! TTEN(K)=HTR(NLAYERS-1-k)/86400.
2291 TTEN(K)=HTR(kte-k)/86400.
2292 TTENC(K)=HTRC(kte-k)/86400.
2293 2450 continue
2294 GLW = TOTDFLUX(0)
2295 ! OLR = TOTUFLUX(NLAYERS)
2296 OLR = TOTUFLUX(kte)
2298 END SUBROUTINE RRTM
2301 !***************************************************************************
2302 SUBROUTINE CMBGB1(abscoefL, abscoefH, SELFREF, &
2303 FRACREFA, FRACREFB, FORREF, &
2304 SELFREFC, FORREFC, FRACREFAC, FRACREFBC )
2305 !***************************************************************************
2306 !
2307 ! Original version: Michael J. Iacono; July, 1998
2308 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
2309 !
2310 ! The subroutines CMBGB1->CMBGB16 input the absorption coefficient
2311 ! data for each band, which are defined for 16 g-points and 16 spectral
2312 ! bands. The data are combined with appropriate weighting following the
2313 ! g-point mapping arrays specified in RRTMINIT. Plank fraction data
2314 ! in arrays FRACREFA and FRACREFB are combined without weighting. All
2315 ! g-point reduced data are put into new arrays for use in RRTM.
2316 !
2317 ! BAND 1: 10-250 cm-1 (low - H2O; high - H2O)
2318 !***************************************************************************
2320 ! Input
2321 REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
2322 REAL SELFREF(10,MG)
2323 REAL FRACREFA(MG), FRACREFB(MG), FORREF(MG)
2324 ! REAL RWGT(MG*NBANDS)
2325 ! Output
2326 REAL SELFREFC(10,NG1), FORREFC(NG1)
2327 REAL FRACREFAC(NG1), FRACREFBC(NG1)
2329 DO 2000 JTJT = 1,5
2330 DO 2200 JPJP = 1,13
2331 IPRSM = 0
2332 DO 2400 IGC = 1,NGC(1)
2333 SUMK = 0.
2334 DO 2600 IPR = 1, NGN(IGC)
2335 IPRSM = IPRSM + 1
2336 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM)
2337 2600 CONTINUE
2338 ABSA1(JTJT+(JPJP-1)*5,IGC) = SUMK
2339 2400 CONTINUE
2340 2200 CONTINUE
2341 DO 3200 JPJP = 13,59
2342 IPRSM = 0
2343 DO 3400 IGC = 1,NGC(1)
2344 SUMK = 0.
2345 DO 3600 IPR = 1, NGN(IGC)
2346 IPRSM = IPRSM + 1
2347 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM)
2348 3600 CONTINUE
2349 ABSB1(JTJT+(JPJP-13)*5,IGC) = SUMK
2350 3400 CONTINUE
2351 3200 CONTINUE
2352 2000 CONTINUE
2354 DO 4000 JTJT = 1,10
2355 IPRSM = 0
2356 DO 4400 IGC = 1,NGC(1)
2357 SUMK = 0.
2358 DO 4600 IPR = 1, NGN(IGC)
2359 IPRSM = IPRSM + 1
2360 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM)
2361 4600 CONTINUE
2362 SELFREFC(JTJT,IGC) = SUMK
2363 4400 CONTINUE
2364 4000 CONTINUE
2366 IPRSM = 0
2367 DO 5400 IGC = 1,NGC(1)
2368 SUMK = 0.
2369 SUMF1 = 0.
2370 SUMF2 = 0.
2371 DO 5600 IPR = 1, NGN(IGC)
2372 IPRSM = IPRSM + 1
2373 SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM)
2374 SUMF1= SUMF1+ FRACREFA(IPRSM)
2375 SUMF2= SUMF2+ FRACREFB(IPRSM)
2376 5600 CONTINUE
2377 FORREFC(IGC) = SUMK
2378 FRACREFAC(IGC) = SUMF1
2379 FRACREFBC(IGC) = SUMF2
2380 5400 CONTINUE
2382 END SUBROUTINE CMBGB1
2384 !***************************************************************************
2385 SUBROUTINE CMBGB2(abscoefL, abscoefH, SELFREF, &
2386 FRACREFA, FRACREFB, FORREF, &
2387 SELFREFC, FORREFC, FRACREFAC, FRACREFBC )
2388 !***************************************************************************
2389 !
2390 ! BAND 2: 250-500 cm-1 (low - H2O; high - H2O)
2391 !***************************************************************************
2393 ! Input
2394 REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
2395 REAL SELFREF(10,MG)
2396 REAL FRACREFA(MG,13), FRACREFB(MG), FORREF(MG)
2397 ! REAL RWGT(MG*NBANDS)
2398 ! Output
2399 REAL SELFREFC(10,NG2), FORREFC(NG2)
2400 REAL FRACREFAC(NG2,13), FRACREFBC(NG2)
2402 DO 2000 JTJT = 1,5
2403 DO 2200 JPJP = 1,13
2404 IPRSM = 0
2405 DO 2400 IGC = 1,NGC(2)
2406 SUMK = 0.
2407 DO 2600 IPR = 1, NGN(NGS(1)+IGC)
2408 IPRSM = IPRSM + 1
2409 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
2410 2600 CONTINUE
2411 ABSA2(JTJT+(JPJP-1)*5,IGC) = SUMK
2412 2400 CONTINUE
2413 2200 CONTINUE
2414 DO 3200 JPJP = 13,59
2415 IPRSM = 0
2416 DO 3400 IGC = 1,NGC(2)
2417 SUMK = 0.
2418 DO 3600 IPR = 1, NGN(NGS(1)+IGC)
2419 IPRSM = IPRSM + 1
2420 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+16)
2421 3600 CONTINUE
2422 ABSB2(JTJT+(JPJP-13)*5,IGC) = SUMK
2423 3400 CONTINUE
2424 3200 CONTINUE
2425 2000 CONTINUE
2427 DO 4000 JTJT = 1,10
2428 IPRSM = 0
2429 DO 4400 IGC = 1,NGC(2)
2430 SUMK = 0.
2431 DO 4600 IPR = 1, NGN(NGS(1)+IGC)
2432 IPRSM = IPRSM + 1
2433 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+16)
2434 4600 CONTINUE
2435 SELFREFC(JTJT,IGC) = SUMK
2436 4400 CONTINUE
2437 4000 CONTINUE
2439 DO 5000 JPJP = 1,13
2440 IPRSM = 0
2441 DO 5400 IGC = 1,NGC(2)
2442 SUMF = 0.
2443 DO 5600 IPR = 1, NGN(NGS(1)+IGC)
2444 IPRSM = IPRSM + 1
2445 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
2446 5600 CONTINUE
2447 FRACREFAC(IGC,JPJP) = SUMF
2448 5400 CONTINUE
2449 5000 CONTINUE
2451 IPRSM = 0
2452 DO 6400 IGC = 1,NGC(2)
2453 SUMK = 0.
2454 SUMF = 0.
2455 DO 6600 IPR = 1, NGN(NGS(1)+IGC)
2456 IPRSM = IPRSM + 1
2457 SUMK = SUMK + FORREF(IPRSM)*RWGT(IPRSM+16)
2458 SUMF = SUMF + FRACREFB(IPRSM)
2459 6600 CONTINUE
2460 FORREFC(IGC) = SUMK
2461 FRACREFBC(IGC) = SUMF
2462 6400 CONTINUE
2464 END SUBROUTINE CMBGB2
2466 !***************************************************************************
2467 SUBROUTINE CMBGB3(abscoefL, abscoefH, SELFREF, &
2468 FRACREFA, FRACREFB, FORREF, ABSN2OA, ABSN2OB, &
2469 SELFREFC, FORREFC, &
2470 ABSN2OAC, ABSN2OBC, FRACREFAC, FRACREFBC )
2471 !***************************************************************************
2472 !
2473 ! BAND 3: 500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
2474 !***************************************************************************
2476 ! Input
2477 REAL abscoefL(10,5,13,MG),abscoefH(5,5,13:59,MG)
2478 REAL SELFREF(10,MG)
2479 REAL FRACREFA(MG,10), FRACREFB(MG,5)
2480 REAL FORREF(MG), ABSN2OA(MG), ABSN2OB(MG)
2481 ! REAL RWGT(MG*NBANDS)
2482 ! Output
2483 REAL SELFREFC(10,NG3), FORREFC(NG3), &
2484 ABSN2OAC(NG3), ABSN2OBC(NG3)
2485 REAL FRACREFAC(NG3,10), FRACREFBC(NG3,5)
2487 DO 2000 JN = 1,10
2488 DO 2000 JTJT = 1,5
2489 DO 2200 JPJP = 1,13
2490 IPRSM = 0
2491 DO 2400 IGC = 1,NGC(3)
2492 SUMK = 0.
2493 DO 2600 IPR = 1, NGN(NGS(2)+IGC)
2494 IPRSM = IPRSM + 1
2495 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
2496 2600 CONTINUE
2497 ABSA3(JN+(JTJT-1)*10+(JPJP-1)*50,IGC) = SUMK
2498 2400 CONTINUE
2499 2200 CONTINUE
2500 2000 CONTINUE
2501 DO 3000 JN = 1,5
2502 DO 3000 JTJT = 1,5
2503 DO 3200 JPJP = 13,59
2504 IPRSM = 0
2505 DO 3400 IGC = 1,NGC(3)
2506 SUMK = 0.
2507 DO 3600 IPR = 1, NGN(NGS(2)+IGC)
2508 IPRSM = IPRSM + 1
2509 SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)* RWGT(IPRSM+32)
2510 3600 CONTINUE
2511 ABSB3(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
2512 3400 CONTINUE
2513 3200 CONTINUE
2514 3000 CONTINUE
2516 DO 4000 JTJT = 1,10
2517 IPRSM = 0
2518 DO 4400 IGC = 1,NGC(3)
2519 SUMK = 0.
2520 SUMF = 0.
2521 DO 4600 IPR = 1, NGN(NGS(2)+IGC)
2522 IPRSM = IPRSM + 1
2523 SUMK = SUMK + SELFREF(JTJT,IPRSM)* RWGT(IPRSM+32)
2524 SUMF = SUMF + FRACREFA(IPRSM,JTJT)
2525 4600 CONTINUE
2526 SELFREFC(JTJT,IGC) = SUMK
2527 FRACREFAC(IGC,JTJT) = SUMF
2528 4400 CONTINUE
2529 4000 CONTINUE
2531 DO 5000 JPJP = 1,5
2532 IPRSM = 0
2533 DO 5400 IGC = 1,NGC(3)
2534 SUMF = 0.
2535 DO 5600 IPR = 1, NGN(NGS(2)+IGC)
2536 IPRSM = IPRSM + 1
2537 SUMF = SUMF + FRACREFB(IPRSM,JPJP)
2538 5600 CONTINUE
2539 FRACREFBC(IGC,JPJP) = SUMF
2540 5400 CONTINUE
2541 5000 CONTINUE
2543 IPRSM = 0
2544 DO 6400 IGC = 1,NGC(3)
2545 SUMK1= 0.
2546 SUMK2= 0.
2547 SUMK3= 0.
2548 DO 6600 IPR = 1, NGN(NGS(2)+IGC)
2549 IPRSM = IPRSM + 1
2550 SUMK1= SUMK1+ FORREF(IPRSM)*RWGT(IPRSM+32)
2551 SUMK2= SUMK2+ ABSN2OA(IPRSM)*RWGT(IPRSM+32)
2552 SUMK3= SUMK3+ ABSN2OB(IPRSM)*RWGT(IPRSM+32)
2553 6600 CONTINUE
2554 FORREFC(IGC) = SUMK1
2555 ABSN2OAC(IGC) = SUMK2
2556 ABSN2OBC(IGC) = SUMK3
2557 6400 CONTINUE
2559 END SUBROUTINE CMBGB3
2561 !***************************************************************************
2562 SUBROUTINE CMBGB4(abscoefL, abscoefH, SELFREF, &
2563 FRACREFA, FRACREFB, &
2564 SELFREFC, FRACREFAC, FRACREFBC )
2565 !***************************************************************************
2566 !
2567 ! BAND 4: 630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
2568 !***************************************************************************
2570 ! Input
2571 REAL abscoefL(9,5,13,MG),abscoefH(6,5,13:59,MG)
2572 REAL SELFREF(10,MG)
2573 REAL FRACREFA(MG,9), FRACREFB(MG,6)
2574 ! REAL RWGT(MG*NBANDS)
2575 ! Output
2576 REAL SELFREFC(10,NG4)
2577 REAL FRACREFAC(NG4,9), FRACREFBC(NG4,6)
2579 DO 2000 JN = 1,9
2580 DO 2000 JTJT = 1,5
2581 DO 2200 JPJP = 1,13
2582 IPRSM = 0
2583 DO 2400 IGC = 1,NGC(4)
2584 SUMK = 0.
2585 DO 2600 IPR = 1, NGN(NGS(3)+IGC)
2586 IPRSM = IPRSM + 1
2587 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
2588 2600 CONTINUE
2589 ABSA4(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
2590 2400 CONTINUE
2591 2200 CONTINUE
2592 2000 CONTINUE
2593 DO 3000 JN = 1,6
2594 DO 3000 JTJT = 1,5
2595 DO 3200 JPJP = 13,59
2596 IPRSM = 0
2597 DO 3400 IGC = 1,NGC(4)
2598 SUMK = 0.
2599 DO 3600 IPR = 1, NGN(NGS(3)+IGC)
2600 IPRSM = IPRSM + 1
2601 SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+48)
2602 3600 CONTINUE
2603 ABSB4(JN+(JTJT-1)*6+(JPJP-13)*30,IGC) = SUMK
2604 3400 CONTINUE
2605 3200 CONTINUE
2606 3000 CONTINUE
2608 DO 4000 JTJT = 1,10
2609 IPRSM = 0
2610 DO 4400 IGC = 1,NGC(4)
2611 SUMK = 0.
2612 DO 4600 IPR = 1, NGN(NGS(3)+IGC)
2613 IPRSM = IPRSM + 1
2614 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+48)
2615 4600 CONTINUE
2616 SELFREFC(JTJT,IGC) = SUMK
2617 4400 CONTINUE
2618 4000 CONTINUE
2620 DO 5000 JPJP = 1,9
2621 IPRSM = 0
2622 DO 5400 IGC = 1,NGC(4)
2623 SUMF = 0.
2624 DO 5600 IPR = 1, NGN(NGS(3)+IGC)
2625 IPRSM = IPRSM + 1
2626 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
2627 5600 CONTINUE
2628 FRACREFAC(IGC,JPJP) = SUMF
2629 5400 CONTINUE
2630 5000 CONTINUE
2632 DO 6000 JPJP = 1,6
2633 IPRSM = 0
2634 DO 6400 IGC = 1,NGC(4)
2635 SUMF = 0.
2636 DO 6600 IPR = 1, NGN(NGS(3)+IGC)
2637 IPRSM = IPRSM + 1
2638 SUMF = SUMF + FRACREFB(IPRSM,JPJP)
2639 6600 CONTINUE
2640 FRACREFBC(IGC,JPJP) = SUMF
2641 6400 CONTINUE
2642 6000 CONTINUE
2644 END SUBROUTINE CMBGB4
2646 !***************************************************************************
2647 SUBROUTINE CMBGB5(abscoefL, abscoefH, SELFREF, &
2648 FRACREFA, FRACREFB, CCL4, &
2649 SELFREFC, CCL4C, FRACREFAC, FRACREFBC )
2650 !***************************************************************************
2651 !
2652 ! BAND 5: 700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
2653 !***************************************************************************
2655 ! Input
2656 REAL abscoefL(9,5,13,MG),abscoefH(5,5,13:59,MG)
2657 REAL SELFREF(10,MG)
2658 REAL FRACREFA(MG,9), FRACREFB(MG,5), CCL4(MG)
2659 ! REAL RWGT(MG*NBANDS)
2660 ! Output
2661 REAL SELFREFC(10,NG5), CCL4C(NG5)
2662 REAL FRACREFAC(NG5,9), FRACREFBC(NG5,5)
2664 DO 2000 JN = 1,9
2665 DO 2000 JTJT = 1,5
2666 DO 2200 JPJP = 1,13
2667 IPRSM = 0
2668 DO 2400 IGC = 1,NGC(5)
2669 SUMK = 0.
2670 DO 2600 IPR = 1, NGN(NGS(4)+IGC)
2671 IPRSM = IPRSM + 1
2672 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
2673 2600 CONTINUE
2674 ABSA5(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
2675 2400 CONTINUE
2676 2200 CONTINUE
2677 2000 CONTINUE
2678 DO 3000 JN = 1,5
2679 DO 3000 JTJT = 1,5
2680 DO 3200 JPJP = 13,59
2681 IPRSM = 0
2682 DO 3400 IGC = 1,NGC(5)
2683 SUMK = 0.
2684 DO 3600 IPR = 1, NGN(NGS(4)+IGC)
2685 IPRSM = IPRSM + 1
2686 SUMK = SUMK + abscoefH(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+64)
2687 3600 CONTINUE
2688 ABSB5(JN+(JTJT-1)*5+(JPJP-13)*25,IGC) = SUMK
2689 3400 CONTINUE
2690 3200 CONTINUE
2691 3000 CONTINUE
2693 DO 4000 JTJT = 1,10
2694 IPRSM = 0
2695 DO 4400 IGC = 1,NGC(5)
2696 SUMK = 0.
2697 DO 4600 IPR = 1, NGN(NGS(4)+IGC)
2698 IPRSM = IPRSM + 1
2699 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+64)
2700 4600 CONTINUE
2701 SELFREFC(JTJT,IGC) = SUMK
2702 4400 CONTINUE
2703 4000 CONTINUE
2705 DO 5000 JPJP = 1,9
2706 IPRSM = 0
2707 DO 5400 IGC = 1,NGC(5)
2708 SUMF = 0.
2709 DO 5600 IPR = 1, NGN(NGS(4)+IGC)
2710 IPRSM = IPRSM + 1
2711 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
2712 5600 CONTINUE
2713 FRACREFAC(IGC,JPJP) = SUMF
2714 5400 CONTINUE
2715 5000 CONTINUE
2717 DO 6000 JPJP = 1,5
2718 IPRSM = 0
2719 DO 6400 IGC = 1,NGC(5)
2720 SUMF = 0.
2721 DO 6600 IPR = 1, NGN(NGS(4)+IGC)
2722 IPRSM = IPRSM + 1
2723 SUMF = SUMF + FRACREFB(IPRSM,JPJP)
2724 6600 CONTINUE
2725 FRACREFBC(IGC,JPJP) = SUMF
2726 6400 CONTINUE
2727 6000 CONTINUE
2729 IPRSM = 0
2730 DO 7400 IGC = 1,NGC(5)
2731 SUMK = 0.
2732 DO 7600 IPR = 1, NGN(NGS(4)+IGC)
2733 IPRSM = IPRSM + 1
2734 SUMK = SUMK + CCL4(IPRSM)*RWGT(IPRSM+64)
2735 7600 CONTINUE
2736 CCL4C(IGC) = SUMK
2737 7400 CONTINUE
2739 END SUBROUTINE CMBGB5
2741 !***************************************************************************
2742 SUBROUTINE CMBGB6(abscoefL, SELFREF, &
2743 FRACREFA, ABSCO2, CFC11ADJ, CFC12, &
2744 SELFREFC, ABSCO2C, CFC11ADJC, CFC12C, &
2745 FRACREFAC )
2746 !***************************************************************************
2747 !
2748 ! BAND 6: 820-980 cm-1 (low - H2O; high - nothing)
2749 !***************************************************************************
2751 ! Input
2752 REAL abscoefL(5,13,MG)
2753 REAL SELFREF(10,MG)
2754 REAL FRACREFA(MG), ABSCO2(MG), CFC11ADJ(MG), CFC12(MG)
2755 ! REAL RWGT(MG*NBANDS)
2756 ! Output
2757 REAL SELFREFC(10,NG6), &
2758 ABSCO2C(NG6), CFC11ADJC(NG6), CFC12C(NG6)
2759 REAL FRACREFAC(NG6)
2761 DO 2000 JTJT = 1,5
2762 DO 2200 JPJP = 1,13
2763 IPRSM = 0
2764 DO 2400 IGC = 1,NGC(6)
2765 SUMK = 0.
2766 DO 2600 IPR = 1, NGN(NGS(5)+IGC)
2767 IPRSM = IPRSM + 1
2768 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+80)
2769 2600 CONTINUE
2770 ABSA6(JTJT+(JPJP-1)*5,IGC) = SUMK
2771 2400 CONTINUE
2772 2200 CONTINUE
2773 2000 CONTINUE
2775 DO 4000 JTJT = 1,10
2776 IPRSM = 0
2777 DO 4400 IGC = 1,NGC(6)
2778 SUMK = 0.
2779 DO 4600 IPR = 1, NGN(NGS(5)+IGC)
2780 IPRSM = IPRSM + 1
2781 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+80)
2782 4600 CONTINUE
2783 SELFREFC(JTJT,IGC) = SUMK
2784 4400 CONTINUE
2785 4000 CONTINUE
2787 IPRSM = 0
2788 DO 7400 IGC = 1,NGC(6)
2789 SUMF = 0.
2790 SUMK1= 0.
2791 SUMK2= 0.
2792 SUMK3= 0.
2793 DO 7600 IPR = 1, NGN(NGS(5)+IGC)
2794 IPRSM = IPRSM + 1
2795 SUMF = SUMF + FRACREFA(IPRSM)
2796 SUMK1= SUMK1+ ABSCO2(IPRSM)*RWGT(IPRSM+80)
2797 SUMK2= SUMK2+ CFC11ADJ(IPRSM)*RWGT(IPRSM+80)
2798 SUMK3= SUMK3+ CFC12(IPRSM)*RWGT(IPRSM+80)
2799 7600 CONTINUE
2800 FRACREFAC(IGC) = SUMF
2801 ABSCO2C(IGC) = SUMK1
2802 CFC11ADJC(IGC) = SUMK2
2803 CFC12C(IGC) = SUMK3
2804 7400 CONTINUE
2806 END SUBROUTINE CMBGB6
2808 !***************************************************************************
2809 SUBROUTINE CMBGB7(abscoefL, abscoefH, SELFREF, &
2810 FRACREFA, FRACREFB, ABSCO2, &
2811 SELFREFC, ABSCO2C, FRACREFAC, FRACREFBC )
2812 !***************************************************************************
2813 !
2814 ! BAND 7: 980-1080 cm-1 (low - H2O,O3; high - O3)
2815 !***************************************************************************
2817 ! Input
2818 REAL abscoefL(9,5,13,MG),abscoefH(5,13:59,MG)
2819 REAL SELFREF(10,MG)
2820 REAL FRACREFA(MG,9), FRACREFB(MG), ABSCO2(MG)
2821 ! REAL RWGT(MG*NBANDS)
2822 ! Output
2823 REAL SELFREFC(10,NG7), ABSCO2C(NG7)
2824 REAL FRACREFAC(NG7,9), FRACREFBC(NG7)
2826 DO 2000 JN = 1,9
2827 DO 2000 JTJT = 1,5
2828 DO 2200 JPJP = 1,13
2829 IPRSM = 0
2830 DO 2400 IGC = 1,NGC(7)
2831 SUMK = 0.
2832 DO 2600 IPR = 1, NGN(NGS(6)+IGC)
2833 IPRSM = IPRSM + 1
2834 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
2835 2600 CONTINUE
2836 ABSA7(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
2837 2400 CONTINUE
2838 2200 CONTINUE
2839 2000 CONTINUE
2840 DO 3000 JTJT = 1,5
2841 DO 3200 JPJP = 13,59
2842 IPRSM = 0
2843 DO 3400 IGC = 1,NGC(7)
2844 SUMK = 0.
2845 DO 3600 IPR = 1, NGN(NGS(6)+IGC)
2846 IPRSM = IPRSM + 1
2847 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+96)
2848 3600 CONTINUE
2849 ABSB7(JTJT+(JPJP-13)*5,IGC) = SUMK
2850 3400 CONTINUE
2851 3200 CONTINUE
2852 3000 CONTINUE
2854 DO 4000 JTJT = 1,10
2855 IPRSM = 0
2856 DO 4400 IGC = 1,NGC(7)
2857 SUMK = 0.
2858 DO 4600 IPR = 1, NGN(NGS(6)+IGC)
2859 IPRSM = IPRSM + 1
2860 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+96)
2861 4600 CONTINUE
2862 SELFREFC(JTJT,IGC) = SUMK
2863 4400 CONTINUE
2864 4000 CONTINUE
2866 DO 5000 JPJP = 1,9
2867 IPRSM = 0
2868 DO 5400 IGC = 1,NGC(7)
2869 SUMF = 0.
2870 DO 5600 IPR = 1, NGN(NGS(6)+IGC)
2871 IPRSM = IPRSM + 1
2872 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
2873 5600 CONTINUE
2874 FRACREFAC(IGC,JPJP) = SUMF
2875 5400 CONTINUE
2876 5000 CONTINUE
2878 IPRSM = 0
2879 DO 7400 IGC = 1,NGC(7)
2880 SUMF = 0.
2881 SUMK = 0.
2882 DO 7600 IPR = 1, NGN(NGS(6)+IGC)
2883 IPRSM = IPRSM + 1
2884 SUMF = SUMF + FRACREFB(IPRSM)
2885 SUMK = SUMK + ABSCO2(IPRSM)*RWGT(IPRSM+96)
2886 7600 CONTINUE
2887 FRACREFBC(IGC) = SUMF
2888 ABSCO2C(IGC) = SUMK
2889 7400 CONTINUE
2891 END SUBROUTINE CMBGB7
2893 !***************************************************************************
2894 SUBROUTINE CMBGB8(abscoefL, abscoefH, SELFREF, &
2895 FRACREFA, FRACREFB, ABSCO2A, ABSCO2B, &
2896 ABSN2OA, ABSN2OB, CFC12, CFC22ADJ, &
2897 SELFREFC, ABSCO2AC, ABSCO2BC, &
2898 ABSN2OAC, ABSN2OBC, CFC12C, CFC22ADJC, &
2899 FRACREFAC, FRACREFBC )
2900 !***************************************************************************
2901 !
2902 ! BAND 8: 1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
2903 !***************************************************************************
2905 ! Input
2906 REAL abscoefL(5,7,MG),abscoefH(5,7:59,MG), SELFREF(10,MG)
2907 REAL FRACREFA(MG), FRACREFB(MG), ABSCO2A(MG), ABSCO2B(MG)
2908 REAL ABSN2OA(MG), ABSN2OB(MG), CFC12(MG), CFC22ADJ(MG)
2909 ! REAL RWGT(MG*NBANDS)
2910 ! Output
2911 REAL SELFREFC(10,NG8), &
2912 ABSCO2AC(NG8), ABSCO2BC(NG8), &
2913 ABSN2OAC(NG8), ABSN2OBC(NG8), &
2914 CFC12C(NG8), CFC22ADJC(NG8)
2915 REAL FRACREFAC(NG8), FRACREFBC(NG8)
2917 DO 2000 JTJT = 1,5
2918 DO 2200 JPJP = 1,7
2919 IPRSM = 0
2920 DO 2400 IGC = 1,NGC(8)
2921 SUMK = 0.
2922 DO 2600 IPR = 1, NGN(NGS(7)+IGC)
2923 IPRSM = IPRSM + 1
2924 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
2925 2600 CONTINUE
2926 ABSA8(JTJT+(JPJP-1)*5,IGC) = SUMK
2927 2400 CONTINUE
2928 2200 CONTINUE
2929 2000 CONTINUE
2930 DO 3000 JTJT = 1,5
2931 DO 3200 JPJP = 7,59
2932 IPRSM = 0
2933 DO 3400 IGC = 1,NGC(8)
2934 SUMK = 0.
2935 DO 3600 IPR = 1, NGN(NGS(7)+IGC)
2936 IPRSM = IPRSM + 1
2937 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+112)
2938 3600 CONTINUE
2939 ABSB8(JTJT+(JPJP-7)*5,IGC) = SUMK
2940 3400 CONTINUE
2941 3200 CONTINUE
2942 3000 CONTINUE
2944 DO 4000 JTJT = 1,10
2945 IPRSM = 0
2946 DO 4400 IGC = 1,NGC(8)
2947 SUMK = 0.
2948 DO 4600 IPR = 1, NGN(NGS(7)+IGC)
2949 IPRSM = IPRSM + 1
2950 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+112)
2951 4600 CONTINUE
2952 SELFREFC(JTJT,IGC) = SUMK
2953 4400 CONTINUE
2954 4000 CONTINUE
2956 IPRSM = 0
2957 DO 7400 IGC = 1,NGC(8)
2958 SUMF1= 0.
2959 SUMF2= 0.
2960 SUMK1= 0.
2961 SUMK2= 0.
2962 SUMK3= 0.
2963 SUMK4= 0.
2964 SUMK5= 0.
2965 SUMK6= 0.
2966 DO 7600 IPR = 1, NGN(NGS(7)+IGC)
2967 IPRSM = IPRSM + 1
2968 SUMF1= SUMF1+ FRACREFA(IPRSM)
2969 SUMF2= SUMF2+ FRACREFB(IPRSM)
2970 SUMK1= SUMK1+ ABSCO2A(IPRSM)*RWGT(IPRSM+112)
2971 SUMK2= SUMK2+ ABSCO2B(IPRSM)*RWGT(IPRSM+112)
2972 SUMK3= SUMK3+ ABSN2OA(IPRSM)*RWGT(IPRSM+112)
2973 SUMK4= SUMK4+ ABSN2OB(IPRSM)*RWGT(IPRSM+112)
2974 SUMK5= SUMK5+ CFC12(IPRSM)*RWGT(IPRSM+112)
2975 SUMK6= SUMK6+ CFC22ADJ(IPRSM)*RWGT(IPRSM+112)
2976 7600 CONTINUE
2977 FRACREFAC(IGC) = SUMF1
2978 FRACREFBC(IGC) = SUMF2
2979 ABSCO2AC(IGC) = SUMK1
2980 ABSCO2BC(IGC) = SUMK2
2981 ABSN2OAC(IGC) = SUMK3
2982 ABSN2OBC(IGC) = SUMK4
2983 CFC12C(IGC) = SUMK5
2984 CFC22ADJC(IGC) = SUMK6
2985 7400 CONTINUE
2987 END SUBROUTINE CMBGB8
2989 !***************************************************************************
2990 SUBROUTINE CMBGB9(abscoefL, abscoefH, SELFREF, &
2991 FRACREFA, FRACREFB, ABSN2O, &
2992 SELFREFC, ABSN2OC, FRACREFAC, FRACREFBC )
2993 !***************************************************************************
2994 !
2995 ! BAND 9: 1180-1390 cm-1 (low - H2O,CH4; high - CH4)
2996 !***************************************************************************
2998 ! Input
2999 REAL abscoefL(11,5,13,MG), abscoefH(5,13:59,MG)
3000 REAL SELFREF(10,MG)
3001 REAL FRACREFA(MG,9), FRACREFB(MG), ABSN2O(3*MG)
3002 ! REAL RWGT(MG*NBANDS)
3003 ! Output
3004 REAL SELFREFC(10,NG9), ABSN2OC(3*NG9)
3005 REAL FRACREFAC(NG9,9), FRACREFBC(NG9)
3007 DO 2000 JN = 1,11
3008 DO 2000 JTJT = 1,5
3009 DO 2200 JPJP = 1,13
3010 IPRSM = 0
3011 DO 2400 IGC = 1,NGC(9)
3012 SUMK = 0.
3013 DO 2600 IPR = 1, NGN(NGS(8)+IGC)
3014 IPRSM = IPRSM + 1
3015 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
3016 2600 CONTINUE
3017 ABSA9(JN+(JTJT-1)*11+(JPJP-1)*55,IGC) = SUMK
3018 2400 CONTINUE
3019 2200 CONTINUE
3020 2000 CONTINUE
3022 DO 3000 JTJT = 1,5
3023 DO 3200 JPJP = 13,59
3024 IPRSM = 0
3025 DO 3400 IGC = 1,NGC(9)
3026 SUMK = 0.
3027 DO 3600 IPR = 1, NGN(NGS(8)+IGC)
3028 IPRSM = IPRSM + 1
3029 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+128)
3030 3600 CONTINUE
3031 ABSB9(JTJT+(JPJP-13)*5,IGC) = SUMK
3032 3400 CONTINUE
3033 3200 CONTINUE
3034 3000 CONTINUE
3036 DO 4000 JTJT = 1,10
3037 IPRSM = 0
3038 DO 4400 IGC = 1,NGC(9)
3039 SUMK = 0.
3040 DO 4600 IPR = 1, NGN(NGS(8)+IGC)
3041 IPRSM = IPRSM + 1
3042 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+128)
3043 4600 CONTINUE
3044 SELFREFC(JTJT,IGC) = SUMK
3045 4400 CONTINUE
3046 4000 CONTINUE
3048 DO 5000 JN = 1,3
3049 IPRSM = 0
3050 DO 5400 IGC = 1,NGC(9)
3051 SUMK = 0.
3052 DO 5600 IPR = 1, NGN(NGS(8)+IGC)
3053 IPRSM = IPRSM + 1
3054 JND = (JN-1)*16
3055 SUMK = SUMK + ABSN2O(JND+IPRSM)*RWGT(IPRSM+128)
3056 5600 CONTINUE
3057 JNDC = (JN-1)*NGC(9)
3058 ABSN2OC(JNDC+IGC) = SUMK
3059 5400 CONTINUE
3060 5000 CONTINUE
3062 DO 6000 JPJP = 1,9
3063 IPRSM = 0
3064 DO 6400 IGC = 1,NGC(9)
3065 SUMF = 0.
3066 DO 6600 IPR = 1, NGN(NGS(8)+IGC)
3067 IPRSM = IPRSM + 1
3068 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
3069 6600 CONTINUE
3070 FRACREFAC(IGC,JPJP) = SUMF
3071 6400 CONTINUE
3072 6000 CONTINUE
3074 IPRSM = 0
3075 DO 7400 IGC = 1,NGC(9)
3076 SUMF = 0.
3077 DO 7600 IPR = 1, NGN(NGS(8)+IGC)
3078 IPRSM = IPRSM + 1
3079 SUMF = SUMF + FRACREFB(IPRSM)
3080 7600 CONTINUE
3081 FRACREFBC(IGC) = SUMF
3082 7400 CONTINUE
3084 END SUBROUTINE CMBGB9
3086 !***************************************************************************
3087 SUBROUTINE CMBGB10(abscoefL, abscoefH, &
3088 FRACREFA, FRACREFB, &
3089 FRACREFAC, FRACREFBC )
3090 !***************************************************************************
3091 !
3092 ! BAND 10: 1390-1480 cm-1 (low - H2O; high - H2O)
3093 !***************************************************************************
3095 ! Input
3096 REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
3097 REAL FRACREFA(MG), FRACREFB(MG)
3098 ! REAL RWGT(MG*NBANDS)
3099 ! Output
3100 REAL FRACREFAC(NG10), FRACREFBC(NG10)
3102 DO 2000 JTJT = 1,5
3103 DO 2200 JPJP = 1,13
3104 IPRSM = 0
3105 DO 2400 IGC = 1,NGC(10)
3106 SUMK = 0.
3107 DO 2600 IPR = 1, NGN(NGS(9)+IGC)
3108 IPRSM = IPRSM + 1
3109 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
3110 2600 CONTINUE
3111 ABSA10(JTJT+(JPJP-1)*5,IGC) = SUMK
3112 2400 CONTINUE
3113 2200 CONTINUE
3114 2000 CONTINUE
3115 DO 3000 JTJT = 1,5
3116 DO 3200 JPJP = 13,59
3117 IPRSM = 0
3118 DO 3400 IGC = 1,NGC(10)
3119 SUMK = 0.
3120 DO 3600 IPR = 1, NGN(NGS(9)+IGC)
3121 IPRSM = IPRSM + 1
3122 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+144)
3123 3600 CONTINUE
3124 ABSB10(JTJT+(JPJP-13)*5,IGC) = SUMK
3125 3400 CONTINUE
3126 3200 CONTINUE
3127 3000 CONTINUE
3129 IPRSM = 0
3130 DO 7400 IGC = 1,NGC(10)
3131 SUMF1= 0.
3132 SUMF2= 0.
3133 DO 7600 IPR = 1, NGN(NGS(9)+IGC)
3134 IPRSM = IPRSM + 1
3135 SUMF1= SUMF1+ FRACREFA(IPRSM)
3136 SUMF2= SUMF2+ FRACREFB(IPRSM)
3137 7600 CONTINUE
3138 FRACREFAC(IGC) = SUMF1
3139 FRACREFBC(IGC) = SUMF2
3140 7400 CONTINUE
3142 END SUBROUTINE CMBGB10
3144 !***************************************************************************
3145 SUBROUTINE CMBGB11(abscoefL, abscoefH, SELFREF, &
3146 FRACREFA, FRACREFB, &
3147 SELFREFC, &
3148 FRACREFAC, FRACREFBC )
3149 !***************************************************************************
3150 !
3151 ! BAND 11: 1480-1800 cm-1 (low - H2O; high - H2O)
3152 !***************************************************************************
3154 ! Input
3155 REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
3156 REAL SELFREF(10,MG)
3157 REAL FRACREFA(MG), FRACREFB(MG)
3158 ! REAL RWGT(MG*NBANDS)
3159 ! Output
3160 REAL SELFREFC(10,NG11)
3161 REAL FRACREFAC(NG11), FRACREFBC(NG11)
3163 DO 2000 JTJT = 1,5
3164 DO 2200 JPJP = 1,13
3165 IPRSM = 0
3166 DO 2400 IGC = 1,NGC(11)
3167 SUMK = 0.
3168 DO 2600 IPR = 1, NGN(NGS(10)+IGC)
3169 IPRSM = IPRSM + 1
3170 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160)
3171 2600 CONTINUE
3172 ABSA11(JTJT+(JPJP-1)*5,IGC) = SUMK
3173 2400 CONTINUE
3174 2200 CONTINUE
3175 2000 CONTINUE
3176 DO 3000 JTJT = 1,5
3177 DO 3200 JPJP = 13,59
3178 IPRSM = 0
3179 DO 3400 IGC = 1,NGC(11)
3180 SUMK = 0.
3181 DO 3600 IPR = 1, NGN(NGS(10)+IGC)
3182 IPRSM = IPRSM + 1
3183 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+160)
3184 3600 CONTINUE
3185 ABSB11(JTJT+(JPJP-13)*5,IGC) = SUMK
3186 3400 CONTINUE
3187 3200 CONTINUE
3188 3000 CONTINUE
3190 DO 4000 JTJT = 1,10
3191 IPRSM = 0
3192 DO 4400 IGC = 1,NGC(11)
3193 SUMK = 0.
3194 DO 4600 IPR = 1, NGN(NGS(10)+IGC)
3195 IPRSM = IPRSM + 1
3196 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+160)
3197 4600 CONTINUE
3198 SELFREFC(JTJT,IGC) = SUMK
3199 4400 CONTINUE
3200 4000 CONTINUE
3202 IPRSM = 0
3203 DO 7400 IGC = 1,NGC(11)
3204 SUMF1= 0.
3205 SUMF2= 0.
3206 DO 7600 IPR = 1, NGN(NGS(10)+IGC)
3207 IPRSM = IPRSM + 1
3208 SUMF1= SUMF1+ FRACREFA(IPRSM)
3209 SUMF2= SUMF2+ FRACREFB(IPRSM)
3210 7600 CONTINUE
3211 FRACREFAC(IGC) = SUMF1
3212 FRACREFBC(IGC) = SUMF2
3213 7400 CONTINUE
3215 END SUBROUTINE CMBGB11
3218 !***************************************************************************
3219 SUBROUTINE CMBGB12(abscoefL, SELFREF, &
3220 FRACREFA, &
3221 SELFREFC, FRACREFAC )
3222 !***************************************************************************
3223 !
3224 ! BAND 12: 1800-2080 cm-1 (low - H2O,CO2; high - nothing)
3225 !***************************************************************************
3227 ! Input
3228 REAL abscoefL(9,5,13,MG)
3229 REAL SELFREF(10,MG)
3230 REAL FRACREFA(MG,9)
3231 ! REAL RWGT(MG*NBANDS)
3232 ! Output
3233 REAL SELFREFC(10,NG12)
3234 REAL FRACREFAC(NG12,9)
3236 DO 2000 JN = 1,9
3237 DO 2000 JTJT = 1,5
3238 DO 2200 JPJP = 1,13
3239 IPRSM = 0
3240 DO 2400 IGC = 1,NGC(12)
3241 SUMK = 0.
3242 DO 2600 IPR = 1, NGN(NGS(11)+IGC)
3243 IPRSM = IPRSM + 1
3244 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+176)
3245 2600 CONTINUE
3246 ABSA12(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
3247 2400 CONTINUE
3248 2200 CONTINUE
3249 2000 CONTINUE
3251 DO 4000 JTJT = 1,10
3252 IPRSM = 0
3253 DO 4400 IGC = 1,NGC(12)
3254 SUMK = 0.
3255 DO 4600 IPR = 1, NGN(NGS(11)+IGC)
3256 IPRSM = IPRSM + 1
3257 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+176)
3258 4600 CONTINUE
3259 SELFREFC(JTJT,IGC) = SUMK
3260 4400 CONTINUE
3261 4000 CONTINUE
3263 DO 7000 JPJP = 1,9
3264 IPRSM = 0
3265 DO 7400 IGC = 1,NGC(12)
3266 SUMF = 0.
3267 DO 7600 IPR = 1, NGN(NGS(11)+IGC)
3268 IPRSM = IPRSM + 1
3269 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
3270 7600 CONTINUE
3271 FRACREFAC(IGC,JPJP) = SUMF
3272 7400 CONTINUE
3273 7000 CONTINUE
3275 END SUBROUTINE CMBGB12
3277 !***************************************************************************
3278 SUBROUTINE CMBGB13(abscoefL, SELFREF, FRACREFA, &
3279 SELFREFC, FRACREFAC )
3280 !***************************************************************************
3281 !
3282 ! BAND 13: 2080-2250 cm-1 (low - H2O,N2O; high - nothing)
3283 !***************************************************************************
3285 ! Input
3286 REAL abscoefL(9,5,13,MG)
3287 REAL SELFREF(10,MG)
3288 REAL FRACREFA(MG,9)
3289 ! REAL RWGT(MG*NBANDS)
3290 ! Output
3291 REAL SELFREFC(10,NG13)
3292 REAL FRACREFAC(NG13,9)
3294 DO 2000 JN = 1,9
3295 DO 2000 JTJT = 1,5
3296 DO 2200 JPJP = 1,13
3297 IPRSM = 0
3298 DO 2400 IGC = 1,NGC(13)
3299 SUMK = 0.
3300 DO 2600 IPR = 1, NGN(NGS(12)+IGC)
3301 IPRSM = IPRSM + 1
3302 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+192)
3303 2600 CONTINUE
3304 ABSA13(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
3305 2400 CONTINUE
3306 2200 CONTINUE
3307 2000 CONTINUE
3309 DO 4000 JTJT = 1,10
3310 IPRSM = 0
3311 DO 4400 IGC = 1,NGC(13)
3312 SUMK = 0.
3313 DO 4600 IPR = 1, NGN(NGS(12)+IGC)
3314 IPRSM = IPRSM + 1
3315 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+192)
3316 4600 CONTINUE
3317 SELFREFC(JTJT,IGC) = SUMK
3318 4400 CONTINUE
3319 4000 CONTINUE
3321 DO 7000 JPJP = 1,9
3322 IPRSM = 0
3323 DO 7400 IGC = 1,NGC(13)
3324 SUMF = 0.
3325 DO 7600 IPR = 1, NGN(NGS(12)+IGC)
3326 IPRSM = IPRSM + 1
3327 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
3328 7600 CONTINUE
3329 FRACREFAC(IGC,JPJP) = SUMF
3330 7400 CONTINUE
3331 7000 CONTINUE
3333 END SUBROUTINE CMBGB13
3335 !***************************************************************************
3336 SUBROUTINE CMBGB14(abscoefL, abscoefH, SELFREF, &
3337 FRACREFA, FRACREFB, &
3338 SELFREFC, FRACREFAC, FRACREFBC )
3339 !***************************************************************************
3340 !
3341 ! BAND 14: 2250-2380 cm-1 (low - CO2; high - CO2)
3342 !***************************************************************************
3344 ! Input
3345 REAL abscoefL(5,13,MG),abscoefH(5,13:59,MG)
3346 REAL SELFREF(10,MG)
3347 REAL FRACREFA(MG), FRACREFB(MG)
3348 ! REAL RWGT(MG*NBANDS)
3349 ! Output
3350 REAL SELFREFC(10,NG14)
3351 REAL FRACREFAC(NG14), FRACREFBC(NG14)
3353 DO 2000 JTJT = 1,5
3354 DO 2200 JPJP = 1,13
3355 IPRSM = 0
3356 DO 2400 IGC = 1,NGC(14)
3357 SUMK = 0.
3358 DO 2600 IPR = 1, NGN(NGS(13)+IGC)
3359 IPRSM = IPRSM + 1
3360 SUMK = SUMK + abscoefL(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
3361 2600 CONTINUE
3362 ABSA14(JTJT+(JPJP-1)*5,IGC) = SUMK
3363 2400 CONTINUE
3364 2200 CONTINUE
3365 2000 CONTINUE
3367 DO 3000 JTJT = 1,5
3368 DO 3200 JPJP = 13,59
3369 IPRSM = 0
3370 DO 3400 IGC = 1,NGC(14)
3371 SUMK = 0.
3372 DO 3600 IPR = 1, NGN(NGS(13)+IGC)
3373 IPRSM = IPRSM + 1
3374 SUMK = SUMK + abscoefH(JTJT,JPJP,IPRSM)*RWGT(IPRSM+208)
3375 3600 CONTINUE
3376 ABSB14(JTJT+(JPJP-13)*5,IGC) = SUMK
3377 3400 CONTINUE
3378 3200 CONTINUE
3379 3000 CONTINUE
3381 DO 4000 JTJT = 1,10
3382 IPRSM = 0
3383 DO 4400 IGC = 1,NGC(14)
3384 SUMK = 0.
3385 DO 4600 IPR = 1, NGN(NGS(13)+IGC)
3386 IPRSM = IPRSM + 1
3387 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+208)
3388 4600 CONTINUE
3389 SELFREFC(JTJT,IGC) = SUMK
3390 4400 CONTINUE
3391 4000 CONTINUE
3393 IPRSM = 0
3394 DO 7400 IGC = 1,NGC(14)
3395 SUMF1= 0.
3396 SUMF2= 0.
3397 DO 7600 IPR = 1, NGN(NGS(13)+IGC)
3398 IPRSM = IPRSM + 1
3399 SUMF1= SUMF1+ FRACREFA(IPRSM)
3400 SUMF2= SUMF2+ FRACREFB(IPRSM)
3401 7600 CONTINUE
3402 FRACREFAC(IGC) = SUMF1
3403 FRACREFBC(IGC) = SUMF2
3404 7400 CONTINUE
3407 END SUBROUTINE CMBGB14
3409 !***************************************************************************
3410 SUBROUTINE CMBGB15(abscoefL, SELFREF, FRACREFA, &
3411 SELFREFC, FRACREFAC )
3412 !***************************************************************************
3413 !
3414 ! BAND 15: 2380-2600 cm-1 (low - N2O,CO2; high - nothing)
3415 !***************************************************************************
3417 ! Input
3418 REAL abscoefL(9,5,13,MG)
3419 REAL SELFREF(10,MG)
3420 REAL FRACREFA(MG,9)
3421 ! REAL RWGT(MG*NBANDS)
3422 ! Output
3423 REAL SELFREFC(10,NG15)
3424 REAL FRACREFAC(NG15,9)
3426 DO 2000 JN = 1,9
3427 DO 2000 JTJT = 1,5
3428 DO 2200 JPJP = 1,13
3429 IPRSM = 0
3430 DO 2400 IGC = 1,NGC(15)
3431 SUMK = 0.
3432 DO 2600 IPR = 1, NGN(NGS(14)+IGC)
3433 IPRSM = IPRSM + 1
3434 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+224)
3435 2600 CONTINUE
3436 ABSA15(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
3437 2400 CONTINUE
3438 2200 CONTINUE
3439 2000 CONTINUE
3441 DO 4000 JTJT = 1,10
3442 IPRSM = 0
3443 DO 4400 IGC = 1,NGC(15)
3444 SUMK = 0.
3445 DO 4600 IPR = 1, NGN(NGS(14)+IGC)
3446 IPRSM = IPRSM + 1
3447 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+224)
3448 4600 CONTINUE
3449 SELFREFC(JTJT,IGC) = SUMK
3450 4400 CONTINUE
3451 4000 CONTINUE
3453 DO 7000 JPJP = 1,9
3454 IPRSM = 0
3455 DO 7400 IGC = 1,NGC(15)
3456 SUMF = 0.
3457 DO 7600 IPR = 1, NGN(NGS(14)+IGC)
3458 IPRSM = IPRSM + 1
3459 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
3460 7600 CONTINUE
3461 FRACREFAC(IGC,JPJP) = SUMF
3462 7400 CONTINUE
3463 7000 CONTINUE
3465 END SUBROUTINE CMBGB15
3467 !***************************************************************************
3468 SUBROUTINE CMBGB16(abscoefL, SELFREF, FRACREFA, &
3469 SELFREFC, FRACREFAC )
3470 !***************************************************************************
3471 !
3472 ! BAND 16: 2600-3000 cm-1 (low - H2O,CH4; high - nothing)
3473 !***************************************************************************
3475 ! Input
3476 REAL abscoefL(9,5,13,MG)
3477 REAL SELFREF(10,MG)
3478 REAL FRACREFA(MG,9)
3479 ! REAL RWGT(MG*NBANDS)
3480 ! Output
3481 REAL SELFREFC(10,NG16)
3482 REAL FRACREFAC(NG16,9)
3484 DO 2000 JN = 1,9
3485 DO 2000 JTJT = 1,5
3486 DO 2200 JPJP = 1,13
3487 IPRSM = 0
3488 DO 2400 IGC = 1,NGC(16)
3489 SUMK = 0.
3490 DO 2600 IPR = 1, NGN(NGS(15)+IGC)
3491 IPRSM = IPRSM + 1
3492 SUMK = SUMK + abscoefL(JN,JTJT,JPJP,IPRSM)*RWGT(IPRSM+240)
3493 2600 CONTINUE
3494 ABSA16(JN+(JTJT-1)*9+(JPJP-1)*45,IGC) = SUMK
3495 2400 CONTINUE
3496 2200 CONTINUE
3497 2000 CONTINUE
3499 DO 4000 JTJT = 1,10
3500 IPRSM = 0
3501 DO 4400 IGC = 1,NGC(16)
3502 SUMK = 0.
3503 DO 4600 IPR = 1, NGN(NGS(15)+IGC)
3504 IPRSM = IPRSM + 1
3505 SUMK = SUMK + SELFREF(JTJT,IPRSM)*RWGT(IPRSM+240)
3506 4600 CONTINUE
3507 SELFREFC(JTJT,IGC) = SUMK
3508 4400 CONTINUE
3509 4000 CONTINUE
3511 DO 7000 JPJP = 1,9
3512 IPRSM = 0
3513 DO 7400 IGC = 1,NGC(16)
3514 SUMF = 0.
3515 DO 7600 IPR = 1, NGN(NGS(15)+IGC)
3516 IPRSM = IPRSM + 1
3517 SUMF = SUMF + FRACREFA(IPRSM,JPJP)
3518 7600 CONTINUE
3519 FRACREFAC(IGC,JPJP) = SUMF
3520 7400 CONTINUE
3521 7000 CONTINUE
3523 END SUBROUTINE CMBGB16
3525 !-------------------------------------------------------------------------
3526 SUBROUTINE INIRAD (O3PROF,Pw, kts, kte)
3527 !-------------------------------------------------------------------------
3528 IMPLICIT NONE
3529 !-------------------------------------------------------------------------
3530 INTEGER, INTENT(IN ) :: kts,kte
3532 REAL, DIMENSION( kts:kte ),INTENT(INOUT) :: O3PROF
3534 REAL, DIMENSION( kts:kte+1 ),INTENT(IN ) :: Pw
3536 ! LOCAL VAR
3538 REAL, DIMENSION( kts:kte+1 ) :: PAVEL, TAVEL
3539 REAL, DIMENSION( 0:kte+1 ) :: PZ, TZ
3541 INTEGER :: k
3544 !
3545 ! COMPUTE OZONE MIXING RATIO DISTRIBUTION
3546 !
3547 DO K=kts,kte
3548 O3PROF(K)=0.
3549 ENDDO
3551 CALL O3DATA(O3PROF, Pw, kts, kte)
3552 !
3553 END SUBROUTINE INIRAD
3555 !-------------------------------------------------------------------------
3556 SUBROUTINE O3DATA (O3PROF, Pw, kts, kte)
3557 !-------------------------------------------------------------------------
3558 IMPLICIT NONE
3559 !-------------------------------------------------------------------------
3560 !
3561 INTEGER, INTENT(IN ) :: kts, kte
3562 !
3563 REAL, DIMENSION( kts:kte ),INTENT(INOUT) :: O3PROF
3565 REAL, DIMENSION( kts:kte+1 ),INTENT(IN ) :: Pw
3567 ! LOCAL VAR
3568 INTEGER :: K, JJ, NK
3570 REAL :: PRLEVH(kts:kte+1),PPWRKH(32), &
3571 O3WRK(31),PPWRK(31),O3SUM(31),PPSUM(31), &
3572 O3WIN(31),PPWIN(31),O3ANN(31),PPANN(31)
3574 REAL :: PB1, PB2, PT1, PT2
3576 DATA O3SUM /5.297E-8,5.852E-8,6.579E-8,7.505E-8, &
3577 8.577E-8,9.895E-8,1.175E-7,1.399E-7,1.677E-7,2.003E-7, &
3578 2.571E-7,3.325E-7,4.438E-7,6.255E-7,8.168E-7,1.036E-6, &
3579 1.366E-6,1.855E-6,2.514E-6,3.240E-6,4.033E-6,4.854E-6, &
3580 5.517E-6,6.089E-6,6.689E-6,1.106E-5,1.462E-5,1.321E-5, &
3581 9.856E-6,5.960E-6,5.960E-6/
3583 DATA PPSUM /955.890,850.532,754.599,667.742,589.841, &
3584 519.421,455.480,398.085,347.171,301.735,261.310,225.360, &
3585 193.419,165.490,141.032,120.125,102.689, 87.829, 75.123, &
3586 64.306, 55.086, 47.209, 40.535, 34.795, 29.865, 19.122, &
3587 9.277, 4.660, 2.421, 1.294, 0.647/
3588 !
3589 DATA O3WIN /4.629E-8,4.686E-8,5.017E-8,5.613E-8, &
3590 6.871E-8,8.751E-8,1.138E-7,1.516E-7,2.161E-7,3.264E-7, &
3591 4.968E-7,7.338E-7,1.017E-6,1.308E-6,1.625E-6,2.011E-6, &
3592 2.516E-6,3.130E-6,3.840E-6,4.703E-6,5.486E-6,6.289E-6, &
3593 6.993E-6,7.494E-6,8.197E-6,9.632E-6,1.113E-5,1.146E-5, &
3594 9.389E-6,6.135E-6,6.135E-6/
3596 DATA PPWIN /955.747,841.783,740.199,649.538,568.404, &
3597 495.815,431.069,373.464,322.354,277.190,237.635,203.433, &
3598 174.070,148.949,127.408,108.915, 93.114, 79.551, 67.940, &
3599 58.072, 49.593, 42.318, 36.138, 30.907, 26.362, 16.423, &
3600 7.583, 3.620, 1.807, 0.938, 0.469/
3601 !
3603 DO K=1,31
3604 PPANN(K)=PPSUM(K)
3605 ENDDO
3606 !
3607 O3ANN(1)=0.5*(O3SUM(1)+O3WIN(1))
3608 !
3609 DO K=2,31
3610 O3ANN(K)=O3WIN(K-1)+(O3WIN(K)-O3WIN(K-1))/(PPWIN(K)-PPWIN(K-1))* &
3611 (PPSUM(K)-PPWIN(K-1))
3612 ENDDO
3613 !
3614 DO K=2,31
3615 O3ANN(K)=0.5*(O3ANN(K)+O3SUM(K))
3616 ENDDO
3617 !
3618 DO K=1,31
3619 O3WRK(K)=O3ANN(K)
3620 PPWRK(K)=PPANN(K)
3621 ENDDO
3622 !
3623 ! CALCULATE HALF PRESSURE LEVELS FOR MODEL AND DATA LEVELS
3624 !
3626 ! Pw is total P at w level
3627 ! Pw is in mb
3629 DO K=kts,kte+1
3630 NK=kte+1-K+1
3631 PRLEVH(K)=Pw(NK)
3632 ENDDO
3633 !
3634 PPWRKH(1)=1100.
3635 DO K=2,31
3636 PPWRKH(K)=(PPWRK(K)+PPWRK(K-1))/2.
3637 ENDDO
3638 PPWRKH(32)=0.
3639 DO K=kts,kte
3640 DO 25 JJ=1,31
3641 IF((-(PRLEVH(K)-PPWRKH(JJ))).GE.0.)THEN
3642 PB1=0.
3643 ELSE
3644 PB1=PRLEVH(K)-PPWRKH(JJ)
3645 ENDIF
3646 IF((-(PRLEVH(K)-PPWRKH(JJ+1))).GE.0.)THEN
3647 PB2=0.
3648 ELSE
3649 PB2=PRLEVH(K)-PPWRKH(JJ+1)
3650 ENDIF
3651 IF((-(PRLEVH(K+1)-PPWRKH(JJ))).GE.0.)THEN
3652 PT1=0.
3653 ELSE
3654 PT1=PRLEVH(K+1)-PPWRKH(JJ)
3655 ENDIF
3656 IF((-(PRLEVH(K+1)-PPWRKH(JJ+1))).GE.0.)THEN
3657 PT2=0.
3658 ELSE
3659 PT2=PRLEVH(K+1)-PPWRKH(JJ+1)
3660 ENDIF
3661 O3PROF(K)=O3PROF(K)+(PB2-PB1-PT2+PT1)*O3WRK(JJ)
3662 25 CONTINUE
3663 O3PROF(K)=O3PROF(K)/(PRLEVH(K)-PRLEVH(K+1))
3665 ENDDO
3666 !
3667 END SUBROUTINE O3DATA
3669 !---------------------------------------------------------------------------
3670 SUBROUTINE MM5ATM(CLDFRA,O3PROF,T,Tw,TSFC,QV,QC,QR,QI,QS,QG, &
3671 P,Pw,DELZ,EMISS,R,G, &
3672 PAVEL,TAVEL,PZ,TZ,CLDFRAC,TAUCLOUD,COLDRY, &
3673 WKL,WX,TBOUND,SEMISS, &
3674 !ccc Added for time-varying trace gases.
3675 co2vmr, n2ovmr, ch4vmr, &
3676 !ccc
3677 kts,kte )
3678 !---------------------------------------------------------------------------
3679 ! RRTM Longwave Radiative Transfer Model
3680 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
3681 !
3682 ! Revision for NCAR MM5: J. Dudhia (converted from CCM code)
3683 !
3684 ! Input atmospheric profile from NCAR MM5, and prepare it for use in RRTM.
3685 ! Set other RRTM input parameters. Values are passed back through existing
3686 ! RRTM arrays and commons.
3687 !---------------------------------------------------------------------------
3688 ! RRTM Definitions
3689 ! MXLAY = kte+1 ! Maximum number of model layers
3690 ! MAXXSEC ! Maximum number of cross sections
3691 ! NLAYERS ! Number of model layers (kte+1)
3692 ! PAVEL(MXLAY) ! Layer pressures (mb)
3693 ! PZ(0:MXLAY) ! Level (interface) pressures (mb)
3694 ! TAVEL(MXLAY) ! Layer temperatures (K)
3695 ! TZ(0:MXLAY) ! Level (interface) temperatures(mb)
3696 ! TBOUND ! Surface temperature (K)
3697 ! COLDRY(MXLAY) ! Dry air column (molecules/cm2)
3698 ! WKL(35,MXLAY) ! Molecular amounts (molecules/cm2)
3699 ! WBRODL(MXLAY) ! Inactive in this version
3700 ! WX(MAXXSEC) ! Cross-section amounts (molecules/cm2)
3701 ! CLDFRAC(MXLAY) ! Layer cloud fraction
3702 ! TAUCLOUD(MXLAY) ! Layer cloud optical depth
3703 ! AMD ! Atomic weight of dry air
3704 ! AMW ! Atomic weight of water
3705 ! AMO ! Atomic weight of ozone
3706 ! AMCH4 ! Atomic weight of methane
3707 ! AMN2O ! Atomic weight of nitrous oxide
3708 ! AMC11 ! Atomic weight of CFC-11
3709 ! AMC12 ! Atomic weight of CFC-12
3710 ! NXMOL ! Number of cross-section molecules
3711 ! IXINDX ! Cross-section molecule index (see below)
3712 ! IXSECT ! On/off flag for cross-sections (inactive)
3713 ! IXMAX ! Maximum number of cross-sections (inactive)
3714 !
3715 !-----------------------------------------------------------------------------
3716 ! This compiler directive was added to insure private common block storage
3717 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
3718 ! carry constants.
3719 !----------------------------------------------------------------------------
3720 ! Activate cross section molecules:
3721 ! NXMOL - number of cross-sections input by user
3722 ! IXINDX(I) - index of cross-section molecule corresponding to Ith
3723 ! cross-section specified by user
3724 ! = 0 -- not allowed in RRTM
3725 ! = 1 -- CCL4
3726 ! = 2 -- CFC11
3727 ! = 3 -- CFC12
3728 ! = 4 -- CFC22
3729 ! DATA NXMOL /2/
3730 ! DATA IXINDX /0,2,3,0,31*0/
3731 !
3732 ! CLOUD EMISSIVITIES (M^2/G)
3733 ! THESE ARE CONSISTENT WITH LWRAD (ABCW=0.5*(ABUP+ABDOWN))
3734 !----------------------------------------------------------------------------
3737 INTEGER, INTENT(IN ) :: kts, kte
3738 !
3739 REAL, DIMENSION( 35,kts:NLAYERS ), &
3740 INTENT(INOUT) :: WKL
3742 REAL, DIMENSION( MAXXSEC,kts:NLAYERS ), &
3743 INTENT(INOUT) :: WX
3745 REAL, INTENT(INOUT) :: TBOUND
3746 REAL, DIMENSION(NBANDS), INTENT(INOUT) :: SEMISS
3748 REAL, DIMENSION( kts:kte+1 ), INTENT(IN ) :: &
3749 Tw, &
3750 Pw
3751 REAL, DIMENSION( kts:kte ), INTENT(IN ) :: &
3752 CLDFRA, &
3753 O3PROF, &
3754 DELZ, &
3755 T, &
3756 P
3758 REAL, DIMENSION( kts:kte ), INTENT(INOUT) :: &
3759 QV
3761 REAL, DIMENSION( kts:kte ), INTENT(IN ) :: &
3762 QC, &
3763 QR, &
3764 QI, &
3765 QS, &
3766 QG
3768 REAL, DIMENSION( kts:NLAYERS ), INTENT(INOUT) :: &
3769 PAVEL, &
3770 TAVEL, &
3771 CLDFRAC, &
3772 TAUCLOUD, &
3773 COLDRY
3775 REAL, DIMENSION( 0:NLAYERS ), INTENT(INOUT) :: &
3776 PZ, &
3777 TZ
3779 REAL, INTENT(IN ) :: R,G,EMISS,TSFC
3781 !ccc Added for time-varying trace gases mixing ratios.
3782 ! Trace gase variables
3783 REAL(8), INTENT(IN ) :: co2vmr, n2ovmr, ch4vmr
3784 !ccc
3786 REAL :: GRAVIT
3788 !
3789 ! LOCAL
3791 REAL, DIMENSION( kts:kte ) :: CLDFRC, &
3792 PINT, &
3793 TINT, &
3794 O3, &
3795 N2O, &
3796 CH4, &
3797 CLWP, &
3798 CIWP, &
3799 PLWP, &
3800 PIWP
3801 ! New declarations for RRTM buffer patch.
3802 ! Steven Cavallo, NCAR/MMM 01/2010
3804 INTEGER, PARAMETER :: nproflevs = 60 ! Constant, from the table
3805 INTEGER :: L, LL, klev ! Loop indices
3806 REAL, DIMENSION( kts:NLAYERS ) :: O3PROF2, PZR, varint
3807 REAL :: wght,vark,vark1
3808 REAL :: PPROF(nproflevs), TPROF(nproflevs)
3809 ! Mean pressure and temperature profiles from midlatitude
3810 ! summer (MLS),midlatitude winter (MLW), sub-Arctic
3811 ! winter (SAW),and tropical (TROP) standard atmospheres.
3812 DATA PPROF /1000.00,855.47,731.82,626.05,535.57,458.16, &
3813 391.94,335.29,286.83,245.38,209.91,179.57, &
3814 153.62,131.41,112.42,96.17,82.27,70.38, &
3815 60.21,51.51,44.06,37.69,32.25,27.59, &
3816 23.60,20.19,17.27,14.77,12.64,10.81, &
3817 9.25,7.91,6.77,5.79,4.95,4.24, &
3818 3.63,3.10,2.65,2.27,1.94,1.66, &
3819 1.42,1.22,1.04,0.89,0.76,0.65, &
3820 0.56,0.48,0.41,0.35,0.30,0.26, &
3821 0.22,0.19,0.16,0.14,0.12,0.10/
3822 DATA TPROF /279.94,276.16,270.73,264.14,256.71,249.28, &
3823 241.97,234.91,228.78,224.02,220.52,217.31, &
3824 215.21,213.48,211.63,211.45,211.73,212.71, &
3825 213.81,214.95,215.96,216.73,217.42,218.11, &
3826 218.89,219.92,221.31,222.84,224.39,226.04, &
3827 227.78,229.73,231.88,234.22,236.82,239.50, &
3828 242.30,245.21,248.13,251.08,254.04,257.02, &
3829 259.84,261.88,263.38,264.67,265.42,265.34, &
3830 264.45,262.76,260.85,258.78,256.49,254.02, &
3831 251.07,248.23,245.46,242.77,239.87,237.53/
3833 ! End new declarations for buffer layer edit
3835 CHARACTER*80 errmess
3837 real :: amd ! Effective molecular weight of dry air (g/mol)
3838 real :: amw ! Molecular weight of water vapor (g/mol)
3839 real :: amo ! Molecular weight of ozone (g/mol)
3840 real :: amch4 ! Molecular weight of methane (g/mol)
3841 real :: amn2o ! Molecular weight of nitrous oxide (g/mol)
3842 real :: amc11 ! Molecular weight of CFC11 (g/mol) - CFCL3
3843 real :: amc12 ! Molecular weight of CFC12 (g/mol) - CF2CL2
3844 real :: avgdro ! Avogadro's number (molecules/mole)
3846 ! Atomic weights for conversion from mass to volume mixing ratios
3848 data amd / 28.9644 /
3849 data amw / 18.0154 /
3850 data amo / 47.9998 /
3851 data amch4 / 16.0430 /
3852 data amn2o / 44.0128 /
3853 data amc11 / 137.3684 /
3854 data amc12 / 120.9138 /
3855 data avgdro/ 6.022E23 /
3857 ! Set molecular weight ratios
3859 real :: amdw, & ! Molecular weight of dry air / water vapor
3860 amdo, & ! Molecular weight of dry air / ozone
3861 amdc, & ! Molecular weight of dry air / methane
3862 amdn, & ! Molecular weight of dry air / nitrous oxide
3863 amdc1, & ! Molecular weight of dry air / CFC11
3864 amdc2 ! Molecular weight of dry air / CFC12
3866 data amdw / 1.607758 /
3867 data amdo / 0.603461 /
3868 data amdc / 1.805423 /
3869 data amdn / 0.658090 /
3870 data amdc1/ 0.210852 /
3871 data amdc2/ 0.239546 /
3873 ! Put in CO2 volume mixing ratio here (330 ppmv)
3874 ! Added H2O volume mixing ratio from standard atmosphere
3875 ! above 150 mb (Steven Cavallo, 01/2010).
3876 !ccc
3877 !ccc Modified CO2 VMR declaration for time-varying case.
3878 ! real :: co2vmr, h2ovmr
3879 ! data co2vmr / 330.e-6 /
3880 ! data h2ovmr / 5.00e-6 /
3881 real :: h2ovmr
3882 data h2ovmr / 5.00e-6 /
3884 REAL :: ABCW,ABICE,ABRN,ABSN
3886 DATA ABCW /0.144/
3887 DATA ABICE /0.0735/
3888 DATA ABRN /0.330E-3/
3889 DATA ABSN /2.34E-3/
3891 GRAVIT = G*100.
3893 !
3894 ! MID-LAYER VALUES
3895 DO K=kts,kte
3896 RO=P(K)/(R*T(K))*100.
3897 DZ=DELZ(K)
3898 QV(K)=AMAX1(QV(K),1.E-12)
3900 CLDFRC(K)=CLDFRA(K)
3902 ! PATHS IN G/M^2
3904 ! QI=0 if no ice phase
3905 ! QS=0 if no ice phase
3907 CLWP(K)=RO*QC(K)*DZ*1000.
3908 CIWP(K)=RO*QI(K)*DZ*1000.
3909 PLWP(K)=(RO*QR(K))**0.75*DZ*1000.
3910 PIWP(K)=(RO*QS(K))**0.75*DZ*1000.
3912 O3(K)=O3PROF(K)
3913 N2O(K)=0.
3914 CH4(K)=0.
3916 ENDDO
3918 !ccc Unit conversion
3919 N2O(:) = n2ovmr / amdn
3920 CH4(:) = ch4vmr / amdc
3921 !ccc
3924 ! Initialize all molecular amounts to zero here, then pass MM5 amounts
3925 ! into RRTM arrays WKL and WX below.
3927 ! DO 1000 ILAY = kts,kte+1
3928 DO 1000 ILAY = kts,NLAYERS
3929 DO 1100 ISP = 1,35
3930 1100 WKL(ISP,ILAY) = 0.0
3931 DO 1200 ISP = 1,MAXXSEC
3932 1200 WX(ISP,ILAY) = 0.0
3933 1000 CONTINUE
3935 ! Set parameters needed for RRTM execution:
3937 IXSECT = 1
3938 IXMAX = 4
3940 ! Set surface temperature. The longwave upward surface flux is
3941 ! computed in the Land Surface Model based on the surface
3942 ! temperature and the emissivity of the surface type for each
3943 ! grid point. The bottom interface temperature, tint(kte+1), is
3944 ! ground temperature consistent with this LW upward flux, and
3945 ! TBOUND is set to this temperature here.
3947 ! TBOUND = TINT(kte+1)
3948 ! TBOUND = Tw(kte+1)
3949 TBOUND = TSFC
3950 IF(TBOUND .GT. 340.)THEN
3951 WRITE( errmess , '(A,F10.3)' ) 'rrtm: TBOUND exceeds table limit: reset ',TBOUND
3952 CALL wrf_message (errmess)
3953 TBOUND = 339.99
3954 ENDIF
3956 ! Install MM5 profiles into RRTM arrays for pressure, temperature,
3957 ! and molecular amounts. Pressures are converted from cb
3958 ! (CCM) to mb (RRTM). H2O and trace gas amounts are converted from
3959 ! mass mixing ratio to volume mixing ratio. CO2 vmr is constant at all
3960 ! levels. The dry air column COLDRY (in molec/cm2) is calculated
3961 ! from the level pressures PZ (in mb) based on the hydrostatic equation
3962 ! and includes a correction to account for H2O in the layer. The
3963 ! molecular weight of moist air (amm) is calculated for each layer.
3965 ! RRTM is executed for additional levels (L = kte + int(p_top/4) + 1)
3966 ! from the model top (p_top) to 0 mb, to estimate the downward
3967 ! fluxes between the model top interface and the top of the atmosphere
3968 ! where kte is the top WRF model level index and p_top is the pressure at
3969 ! the top model level. H2O, CO2, N2O, and CH4 vmrs for these extra layers are
3970 ! set to the values in the model's top layer, though the O3 value is
3971 ! interpolated based on the US Std Atm. For GCMs with a model top near 0 mb,
3972 ! these extra layers are not needed, and NLAYERS should be set to the number
3973 ! of model layers (kte in this case).
3974 ! Note: RRTM levels count from bottom to top, while MM5 levels count
3975 ! from the top down and must be reversed here.
3977 ! NMOL = 6
3978 ! PZ(0) = pint(kte+1)
3979 ! TZ(0) = tint(kte+1)
3981 PZ(0) = Pw(kte+1)
3982 TZ(0) = Tw(kte+1)
3983 ! DO 2000 L = 1, NLAYERS-1
3984 DO 2000 L = 1, kte
3985 PAVEL(L) = p(kte+1-L)
3986 TAVEL(L) = t(kte+1-L)
3987 ! PZ(L) = pint(kte+1-L)
3988 ! TZ(L) = tint(kte+1-L)
3989 PZ(L) = Pw(kte+1-L)
3990 TZ(L) = Tw(kte+1-L)
3991 WKL(1,L) = qv(kte+1-L)*amdw
3992 ! Set the water vapor mixing ratio constant above
3993 ! the typical level where global and reanalysis data
3994 ! does not provide it. Steven Cavallo 01/2010.
3995 !IF (PAVEL(L).LE.100) THEN
3996 ! WKL(1,L) = h2ovmr
3997 !ENDIF
3998 WKL(2,L) = co2vmr
3999 WKL(3,L) = o3(kte+1-L)
4000 ! ozone is already bottom to top array but convert mmr to vmr
4001 WKL(3,L) = o3(L)*amdo
4002 WKL(4,L) = n2o(kte+1-L)*amdn
4003 WKL(6,L) = ch4(kte+1-L)*amdc
4004 amm = (1-WKL(1,L))*amd + WKL(1,L)*amw
4005 COLDRY(L) = (PZ(L-1)-PZ(L))*1.E3*avgdro/ &
4006 (gravit*amm*(1+WKL(1,L)))
4007 2000 CONTINUE
4009 ! Set cross section molecule amounts from CCM; convert to vmr
4010 ! DO 2100 L=1, NLAYERS-1
4011 DO 2100 L=1, kte
4012 ! WX(2,L) = c11mmr(kte+1-L)*amdc1
4013 ! WX(3,L) = c12mmr(kte+1-L)*amdc2
4014 WX(2,L) = 0.
4015 WX(3,L) = 0.
4016 2100 CONTINUE
4018 ! old section
4019 IF ( 1 .EQ. 0 ) THEN
4020 ! *****
4021 ! Set up values for extra layer at top of the atmosphere.
4022 ! The top layer temperature for all gridpoints is set to the top layer-1
4023 ! temperature plus a constant (0 K) that represents an isothermal layer
4024 ! above ptop. Top layer interface temperatures are
4025 ! linearly interpolated from the layer temperatures.
4026 ! Note: The top layer temperature and ozone amount are based on a 0-3mb
4027 ! top layer and must be modified if the layering is changed.
4028 ! This section should be commented if the extra layer is not needed.
4030 PAVEL(NLAYERS) = 0.5*PZ(NLAYERS-1)
4031 TAVEL(NLAYERS) = TAVEL(NLAYERS-1) + 0.0
4032 PZ(NLAYERS) = 0.00
4033 TZ(NLAYERS-1) = 0.5*(TAVEL(NLAYERS)+TAVEL(NLAYERS-1))
4034 TZ(NLAYERS) = TZ(NLAYERS-1)+0.0
4035 WKL(1,NLAYERS) = WKL(1,NLAYERS-1)
4036 WKL(2,NLAYERS) = co2vmr
4037 WKL(3,NLAYERS) = 0.6*WKL(3,NLAYERS-1)
4038 WKL(4,NLAYERS) = WKL(4,NLAYERS-1)
4039 WKL(6,NLAYERS) = WKL(6,NLAYERS-1)
4040 amm = (1-WKL(1,NLAYERS-1))*amd + WKL(1,NLAYERS-1)*amw
4041 ! COLDRY(NLAYERS) = (PZ(NLAYERS-1))*1.E3*avgdro/ &
4042 COLDRY(NLAYERS) = ((PZ(NLAYERS-1)-PZ(NLAYERS)))*1.E3*avgdro/ &
4043 (gravit*amm*(1+WKL(1,NLAYERS-1)))
4044 WX(2,NLAYERS) = WX(2,NLAYERS-1)
4045 WX(3,NLAYERS) = WX(3,NLAYERS-1)
4046 ! *****
4048 ENDIF
4050 ! *****
4051 ! Set up values for extra layers to the top of the atmosphere.
4052 ! Temperature is calculated based on an average temperature profile given
4053 ! here in a table. The input table data is linearly interpolated to the
4054 ! column pressure. Mixing ratios are held constant except for ozone.
4055 ! Caution should be used if model top pressure is less than 5 hPa.
4056 ! Steven Cavallo, NCAR/MMM, January 2010
4057 ! Calculate the column pressure buffer levels above the
4058 ! model top
4059 DO 3000 L=kte+1,NLAYERS-1,1
4060 PZ(L) = PZ(L-1) - deltap
4061 PAVEL(L) = 0.5*(PZ(L) + PZ(L-1))
4062 3000 CONTINUE
4063 ! Add zero as top level. This gets the temperature max at the
4064 ! stratopause, reducing the downward flux errors in the top
4065 ! levels. If zero happened to be the top level already,
4066 ! this will add another level with zero, but will not affect
4067 ! the radiative transfer calculation.
4068 PZ(NLAYERS) = 0.00
4069 PAVEL(NLAYERS) = 0.5*(PZ(NLAYERS) + PZ(NLAYERS-1))
4071 ! Interpolate the table temperatures to column pressure levels
4072 DO 3100 L=1,NLAYERS,1
4073 IF ( PPROF(nproflevs) .LT. PZ(L) ) THEN
4074 DO 3150 LL=2,nproflevs,1
4075 IF ( PPROF(LL) .LT. PZ(L) ) THEN
4076 klev = LL - 1
4077 exit
4078 ENDIF
4079 3150 CONTINUE
4081 ELSE
4082 klev = nproflevs
4083 ENDIF
4085 IF (klev .NE. nproflevs ) THEN
4086 vark = TPROF(klev)
4087 vark1 = TPROF(klev+1)
4088 wght=( PZ(L)-PPROF(klev) ) / ( PPROF(klev+1)-PPROF(klev))
4089 ELSE
4090 vark = TPROF(klev)
4091 vark1 = TPROF(klev)
4092 wght = 0.0
4093 ENDIF
4094 varint(L) = wght*(vark1-vark)+vark
4096 3100 CONTINUE
4098 ! Match the interpolated table temperature profile to WRF column
4099 DO 3200 L=kte+1,NLAYERS,1
4100 TZ(L) = varint(L) + (TZ(kte) - varint(kte))
4101 TAVEL(L) = 0.5*(TZ(L) + TZ(L-1))
4102 3200 CONTINUE
4104 ! Get the new ozone profile. First need to reverse pressure
4105 ! array for the ozone interpolator subroutines.
4106 DO 3225 L=kts,NLAYERS,1
4107 klev=NLAYERS-L+1
4108 PZR(L)=PZ(klev)
4109 3225 CONTINUE
4110 CALL INIRAD (O3PROF2(kts:NLAYERS-1),PZR,kts,NLAYERS-1)
4111 ! Pick the top level to be the closest to zero from the table
4112 O3PROF2(NLAYERS) = 6.135E-6
4114 ! Keep all molecular mixing ratios constant in the buffer zone,
4115 ! except for ozone
4116 IF ( kte .NE. NLAYERS ) THEN
4117 DO 3250 L=1,NLAYERS,1
4118 WKL(3,L) = O3PROF2(L)*amdo! O3
4119 IF ( L .GT. kte ) THEN
4120 ! WKL(1,L) = WKL(1,kte) ! H2O
4121 WKL(1,L) = h2ovmr ! H2O above model top set to constant value
4122 WKL(2,L) = co2vmr ! CO2
4123 WKL(4,L) = WKL(4,kte) ! N2O
4124 WKL(6,L) = WKL(6,kte) ! CH4
4125 amm = (1-WKL(1,L))*amd + WKL(1,L)*amw
4126 COLDRY(L) = (PZ(L-1)-PZ(L))*1.E3*avgdro/ &
4127 (gravit*amm*(1+WKL(1,L)))
4128 WX(2,L) = WX(2,kte)
4129 WX(3,L) = WX(3,kte)
4130 ENDIF
4131 3250 CONTINUE
4132 ENDIF
4133 !
4134 ! End of buffer layer edit.
4135 !
4136 ! Here, all molecules in WKL and WX are in volume mixing ratio; convert to
4137 ! molec/cm2 based on COLDRY for use in RRTM
4139 DO 5000 L = 1, NLAYERS
4140 DO 4200 IMOL = 1, NMOL
4141 WKL(IMOL,L) = COLDRY(L) * WKL(IMOL,L)
4142 4200 CONTINUE
4143 DO 4400 IX = 1,MAXXSEC
4144 IF (IXINDX(IX) .NE. 0) THEN
4145 WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20
4146 ENDIF
4147 4400 CONTINUE
4148 5000 CONTINUE
4151 ! Set spectral surface emissivity for each longwave band. The default value
4152 ! is set here to emiss(i,j) based on land-use (taken to be constant across band
4153 ! Comment: if land-surface uses skin temperature, emissivity must match that
4154 ! used in its calculation (e.g. 1.0)
4155 DO 5500 N=1,NBANDS
4156 SEMISS(N) = EMISS
4157 5500 CONTINUE
4159 ! Transfer cloud fraction to RRTM array; compute cloud optical depth, TAUCLOUD,
4160 ! as the product of clwp and cloud mass absorption coefficient in MM5, which is
4161 ! a combination of liquid and ice absorption coefficients.
4162 ! Note: RRTM levels count from bottom to top, while CCM levels count from the
4163 ! top down and must be reversed here. Values for the extra RRTM levels (above
4164 ! the model top) are set to zero.
4166 ! DO 7000 L = 1, NLAYERS-1
4167 DO 7000 L = 1, kte
4168 TAUCLOUD(L) = ABCW*CLWP(kte+1-L)+ABICE*CIWP(kte+1-L) &
4169 +ABRN*PLWP(kte+1-L)+ABSN*PIWP(kte+1-L)
4170 IF(TAUCLOUD(L).GT.0.01)CLDFRC(kte+1-L)=1.
4171 CLDFRAC(L) = cldfrc(kte+1-L)
4172 7000 CONTINUE
4173 ! CLDFRAC(NLAYERS) = 0.0
4174 ! TAUCLOUD(NLAYERS) = 0.0
4175 DO 7500 L = kte+1,NLAYERS,1
4176 CLDFRAC(L) = 0.0
4177 TAUCLOUD(L) = 0.0
4178 7500 CONTINUE
4180 END SUBROUTINE MM5ATM
4182 !---------------------------------------------------------------------------
4183 SUBROUTINE SETCOEF(kts,ktep1, &
4184 PAVEL,TAVEL,COLDRY,COLH2O,COLCO2,COLO3, &
4185 COLN2O,COLCH4,COLO2,CO2MULT, &
4186 FAC00,FAC01,FAC10,FAC11, &
4187 FORFAC,SELFFAC,SELFFRAC, &
4188 JP,JT,JT1,INDSELF,WKL,LAYTROP,LAYSWTCH,LAYLOW )
4189 !---------------------------------------------------------------------------
4190 IMPLICIT NONE
4191 !---------------------------------------------------------------------------
4192 ! RRTM Longwave Radiative Transfer Model
4193 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
4194 !
4195 ! Original version: E. J. Mlawer, et al.
4196 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
4197 !
4198 ! For a given atmosphere, calculate the indices and fractions related to the
4199 ! pressure and temperature interpolations. Also calculate the values of the
4200 ! integrated Planck functions for each band at the level and layer
4201 ! temperatures.
4202 !---------------------------------------------------------------------------
4204 INTEGER, INTENT(IN ) :: kts, ktep1
4206 REAL, DIMENSION( 35,kts:ktep1), &
4207 INTENT(IN ) :: WKL
4209 INTEGER, INTENT(INOUT) :: LAYTROP,LAYSWTCH,LAYLOW
4211 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4212 PAVEL, &
4213 TAVEL, &
4214 COLDRY
4216 REAL, DIMENSION( kts:ktep1 ), INTENT(INOUT) :: &
4217 COLH2O, &
4218 COLCO2, &
4219 COLO3, &
4220 COLN2O, &
4221 COLCH4, &
4222 COLO2, &
4223 CO2MULT, &
4224 FAC00, &
4225 FAC01, &
4226 FAC10, &
4227 FAC11, &
4228 FORFAC, &
4229 SELFFAC, &
4230 SELFFRAC
4232 INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) :: &
4233 JP, &
4234 JT, &
4235 JT1, &
4236 INDSELF
4237 ! LOCAL
4239 INTEGER :: LAY, JP1
4240 REAL :: STPFAC, PLOG, FP, FT, FT1, WATERS, WATER, &
4241 CALEFAC, FACTOR, CO2REG, COMPFP, SCALEFAC
4243 ! This compiler directive was added to insure private common block storage
4244 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
4245 ! carry constants.
4247 STPFAC = 296./1013.
4249 LAYTROP = 0
4250 LAYSWTCH = 0
4251 LAYLOW = 0
4252 DO 7000 LAY = 1, NLAYERS
4253 ! Find the two reference pressures on either side of the
4254 ! layer pressure. Store them in JP and JP1. Store in FP the
4255 ! fraction of the difference (in ln(pressure)) between these
4256 ! two values that the layer pressure lies.
4257 PLOG = LOG(PAVEL(LAY))
4258 JP(LAY) = INT(36. - 5*(PLOG+0.04))
4259 IF (JP(LAY) .LT. 1) THEN
4260 JP(LAY) = 1
4261 ELSEIF (JP(LAY) .GT. 58) THEN
4262 JP(LAY) = 58
4263 ENDIF
4264 JP1 = JP(LAY) + 1
4265 FP = 5. * (PREFLOG(JP(LAY)) - PLOG)
4267 ! Determine, for each reference pressure (JP and JP1), which
4268 ! reference temperature (these are different for each
4269 ! reference pressure) is nearest the layer temperature but does
4270 ! not exceed it. Store these indices in JT and JT1, resp.
4271 ! Store in FT (resp. FT1) the fraction of the way between JT
4272 ! (JT1) and the next highest reference temperature that the
4273 ! layer temperature falls.
4274 JT(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP(LAY)))/15.)
4275 IF (JT(LAY) .LT. 1) THEN
4276 JT(LAY) = 1
4277 ELSEIF (JT(LAY) .GT. 4) THEN
4278 JT(LAY) = 4
4279 ENDIF
4280 FT = ((TAVEL(LAY)-TREF(JP(LAY)))/15.) - FLOAT(JT(LAY)-3)
4281 JT1(LAY) = INT(3. + (TAVEL(LAY)-TREF(JP1))/15.)
4282 IF (JT1(LAY) .LT. 1) THEN
4283 JT1(LAY) = 1
4284 ELSEIF (JT1(LAY) .GT. 4) THEN
4285 JT1(LAY) = 4
4286 ENDIF
4287 FT1 = ((TAVEL(LAY)-TREF(JP1))/15.) - FLOAT(JT1(LAY)-3)
4289 WATER = WKL(1,LAY)/COLDRY(LAY)
4290 SCALEFAC = PAVEL(LAY) * STPFAC / TAVEL(LAY)
4292 ! If the pressure is less than ~100mb, perform a different
4293 ! set of species interpolations.
4294 IF (PLOG .LE. 4.56) GO TO 5300
4295 LAYTROP = LAYTROP + 1
4296 ! For one band, the "switch" occurs at ~300 mb.
4297 ! JD: changed from (PLOG .GE. 5.76) to avoid out-of-range
4298 IF (PLOG .Gt. 5.76) LAYSWTCH = LAYSWTCH + 1
4299 IF (PLOG .GE. 6.62) LAYLOW = LAYLOW + 1
4300 !
4301 FORFAC(LAY) = SCALEFAC / (1.+WATER)
4302 ! Set up factors needed to separately include the water vapor
4303 ! self-continuum in the calculation of absorption coefficient.
4304 SELFFAC(LAY) = WATER * FORFAC(LAY)
4305 FACTOR = (TAVEL(LAY)-188.0)/7.2
4306 INDSELF(LAY) = MIN(9, MAX(1, INT(FACTOR)-7))
4307 SELFFRAC(LAY) = FACTOR - FLOAT(INDSELF(LAY) + 7)
4309 ! Calculate needed column amounts.
4310 COLH2O(LAY) = 1.E-20 * WKL(1,LAY)
4311 COLCO2(LAY) = 1.E-20 * WKL(2,LAY)
4312 COLO3(LAY) = 1.E-20 * WKL(3,LAY)
4313 COLN2O(LAY) = 1.E-20 * WKL(4,LAY)
4314 COLCH4(LAY) = 1.E-20 * WKL(6,LAY)
4315 COLO2(LAY) = 1.E-20 * WKL(7,LAY)
4316 IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)
4317 IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)
4318 IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)
4319 ! Using E = 1334.2 cm-1.
4320 CO2REG = 3.55E-24 * COLDRY(LAY)
4321 CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) * &
4322 272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))
4323 GO TO 5400
4325 ! Above LAYTROP.
4326 5300 CONTINUE
4328 FORFAC(LAY) = SCALEFAC / (1.+WATER)
4329 ! Calculate needed column amounts.
4330 COLH2O(LAY) = 1.E-20 * WKL(1,LAY)
4331 COLCO2(LAY) = 1.E-20 * WKL(2,LAY)
4332 COLO3(LAY) = 1.E-20 * WKL(3,LAY)
4333 COLN2O(LAY) = 1.E-20 * WKL(4,LAY)
4334 COLCH4(LAY) = 1.E-20 * WKL(6,LAY)
4335 COLO2(LAY) = 1.E-20 * WKL(7,LAY)
4336 IF (COLCO2(LAY) .EQ. 0.) COLCO2(LAY) = 1.E-32 * COLDRY(LAY)
4337 IF (COLN2O(LAY) .EQ. 0.) COLN2O(LAY) = 1.E-32 * COLDRY(LAY)
4338 IF (COLCH4(LAY) .EQ. 0.) COLCH4(LAY) = 1.E-32 * COLDRY(LAY)
4339 CO2REG = 3.55E-24 * COLDRY(LAY)
4340 CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) * &
4341 272.63*EXP(-1919.4/TAVEL(LAY))/(8.7604E-4*TAVEL(LAY))
4342 5400 CONTINUE
4344 ! We have now isolated the layer ln pressure and temperature,
4345 ! between two reference pressures and two reference temperatures
4346 ! (for each reference pressure). We multiply the pressure
4347 ! fraction FP with the appropriate temperature fractions to get
4348 ! the factors that will be needed for the interpolation that yields
4349 ! the optical depths (performed in routines TAUGBn for band n).
4351 COMPFP = 1. - FP
4352 FAC10(LAY) = COMPFP * FT
4353 FAC00(LAY) = COMPFP * (1. - FT)
4354 FAC11(LAY) = FP * FT1
4355 FAC01(LAY) = FP * (1. - FT1)
4357 7000 CONTINUE
4359 ! Set LAYLOW for profiles with surface pressure less than 750mb.
4360 IF (LAYLOW.EQ.0) LAYLOW=1
4361 ! Sometimes round-off gives wrong LAYSWTCH therefore check here (JD)
4362 IF (JP(LAYSWTCH+1).LE.6) THEN
4363 LAYSWTCH=LAYSWTCH+1
4364 ENDIF
4366 END SUBROUTINE SETCOEF
4368 !-------------------------------------------------------------------------------
4369 !* *
4370 !* Optical depths developed for the *
4371 !* *
4372 !* RAPID RADIATIVE TRANSFER MODEL (RRTM) *
4373 !* *
4374 !* *
4375 !* ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. *
4376 !* 840 MEMORIAL DRIVE *
4377 !* CAMBRIDGE, MA 02139 *
4378 !* *
4379 !* *
4380 !* ELI J. MLAWER *
4381 !* STEVEN J. TAUBMAN *
4382 !* SHEPARD A. CLOUGH *
4383 !* *
4384 !* *
4385 !* *
4386 !* *
4387 !* email: mlawer@aer.com *
4388 !* *
4389 !* The authors wish to acknowledge the contributions of the *
4390 !* following people: Patrick D. Brown, Michael J. Iacono, *
4391 !* Ronald E. Farren, Luke Chen, Robert Bergstrom. *
4392 !* *
4393 !-------------------------------------------------------------------------------
4394 !* *
4395 !* Revision for NCAR CCM: Michael J. Iacono; September, 1998 *
4396 !* *
4397 !* TAUMOL *
4398 !* *
4399 !* This file contains the subroutines TAUGBn (where n goes from *
4400 !* 1 to 16). TAUGBn calculates the optical depths and Planck fractions *
4401 !* per g-value and layer for band n. *
4402 !* *
4403 !* Output: optical depths (unitless) *
4404 !* fractions needed to compute Planck functions at every layer *
4405 !* and g-value *
4406 !* *
4407 !* COMMON /TAUGCOM/ TAUG(MXLAY,MG) *
4408 !* COMMON /PLANKG/ FRACS(MXLAY,MG) *
4409 !* *
4410 !* Input *
4411 !* *
4412 !* COMMON /FEATURES/ NG(NBANDS),NSPA(NBANDS),NSPB(NBANDS) *
4413 !* COMMON /PRECISE/ ONEMINUS *
4414 !* COMMON /PROFILE/ NLAYERS,PAVEL(MXLAY),TAVEL(MXLAY), *
4415 !* & PZ(0:MXLAY),TZ(0:MXLAY) *
4416 !* COMMON /PROFDATA/ LAYTROP,LAYSWTCH,LAYLOW, *
4417 !* & COLH2O(MXLAY),COLCO2(MXLAY), *
4418 !* & COLO3(MXLAY),COLN2O(MXLAY),COLCH4(MXLAY), *
4419 !* & COLO2(MXLAY),CO2MULT(MXLAY) *
4420 !* COMMON /INTFAC/ FAC00(MXLAY),FAC01(MXLAY), *
4421 !* & FAC10(MXLAY),FAC11(MXLAY) *
4422 !* COMMON /INTIND/ JP(MXLAY),JT(MXLAY),JT1(MXLAY) *
4423 !* COMMON /SELF/ SELFFAC(MXLAY), SELFFRAC(MXLAY), INDSELF(MXLAY) *
4424 !* *
4425 !* Description: *
4426 !* NG(IBAND) - number of g-values in band IBAND *
4427 !* NSPA(IBAND) - for the lower atmosphere, the number of reference *
4428 !* atmospheres that are stored for band IBAND per *
4429 !* pressure level and temperature. Each of these *
4430 !* atmospheres has different relative amounts of the *
4431 !* key species for the band (i.e. different binary *
4432 !* species parameters). *
4433 !* NSPB(IBAND) - same for upper atmosphere *
4434 !* ONEMINUS - since problems are caused in some cases by interpolation *
4435 !* parameters equal to or greater than 1, for these cases *
4436 !* these parameters are set to this value, slightly < 1. *
4437 !* PAVEL - layer pressures (mb) *
4438 !* TAVEL - layer temperatures (degrees K) *
4439 !* PZ - level pressures (mb) *
4440 !* TZ - level temperatures (degrees K) *
4441 !* LAYTROP - layer at which switch is made from one combination of *
4442 !* key species to another *
4443 !* COLH2O, COLCO2, COLO3, COLN2O, COLCH4 - column amounts of water *
4444 !* vapor,carbon dioxide, ozone, nitrous ozide, methane, *
4445 !* respectively (molecules/cm**2) *
4446 !* CO2MULT - for bands in which carbon dioxide is implemented as a *
4447 !* trace species, this is the factor used to multiply the *
4448 !* band's average CO2 absorption coefficient to get the added *
4449 !* contribution to the optical depth relative to 355 ppm. *
4450 !* FACij(LAY) - for layer LAY, these are factors that are needed to *
4451 !* compute the interpolation factors that multiply the *
4452 !* appropriate reference k-values. A value of 0 (1) for *
4453 !* i,j indicates that the corresponding factor multiplies *
4454 !* reference k-value for the lower (higher) of the two *
4455 !* appropriate temperatures, and altitudes, respectively. *
4456 !* JP - the index of the lower (in altitude) of the two appropriate *
4457 !* reference pressure levels needed for interpolation *
4458 !* JT, JT1 - the indices of the lower of the two appropriate reference *
4459 !* temperatures needed for interpolation (for pressure *
4460 !* levels JP and JP+1, respectively) *
4461 !* SELFFAC - scale factor needed to water vapor self-continuum, equals *
4462 !* (water vapor density)/(atmospheric density at 296K and *
4463 !* 1013 mb) *
4464 !* SELFFRAC - factor needed for temperature interpolation of reference *
4465 !* water vapor self-continuum data *
4466 !* INDSELF - index of the lower of the two appropriate reference *
4467 !* temperatures needed for the self-continuum interpolation *
4468 !* *
4469 !* Data input *
4470 !* COMMON /Kn/ KA(NSPA(n),5,13,MG), KB(NSPB(n),5,13:59,MG), SELFREF(10,MG) *
4471 !* (note: n is the band number) *
4472 !* *
4473 !* Description: *
4474 !* KA - k-values for low reference atmospheres (no water vapor *
4475 !* self-continuum) (units: cm**2/molecule) *
4476 !* KB - k-values for high reference atmospheres (all sources) *
4477 !* (units: cm**2/molecule) *
4478 !* SELFREF - k-values for water vapor self-continuum for reference *
4479 !* atmospheres (used below LAYTROP) *
4480 !* (units: cm**2/molecule) *
4481 !* *
4482 !* DIMENSION ABSA(65*NSPA(n),MG), ABSB(235*NSPB(n),MG) *
4483 !* EQUIVALENCE (KA,ABSA),(KB,ABSB) *
4484 !* *
4485 !*******************************************************************************
4487 !---------------------------------------------------------------------------
4488 SUBROUTINE TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11, &
4489 FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
4490 PFRAC,TAUG,LAYTROP )
4491 !---------------------------------------------------------------------------
4493 INTEGER, INTENT(IN ) :: kts,ktep1
4495 INTEGER, INTENT(IN ) :: LAYTROP
4497 REAL, DIMENSION( NGPT,kts:ktep1 ), &
4498 INTENT(INOUT) :: PFRAC, &
4499 TAUG
4501 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4502 COLH2O, &
4503 FAC00, &
4504 FAC01, &
4505 FAC10, &
4506 FAC11, &
4507 FORFAC, &
4508 SELFFAC, &
4509 SELFFRAC
4511 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4512 JP, &
4513 JT, &
4514 JT1, &
4515 INDSELF
4517 ! Written by Eli J. Mlawer, Atmospheric & Environmental Research.
4518 ! Revised by Michael J. Iacono, Atmospheric & Environmental Research.
4520 ! BAND 1: 10-250 cm-1 (low - H2O; high - H2O)
4522 ! This compiler directive was added to insure private common block storage
4523 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
4524 ! carry constants.
4526 ! Compute the optical depth by interpolating in ln(pressure) and
4527 ! temperature. Below LAYTROP, the water vapor self-continuum
4528 ! is interpolated (in temperature) separately.
4529 !cdir novector
4530 DO 2500 LAY = 1, LAYTROP
4531 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(1) + 1
4532 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(1) + 1
4533 INDS = INDSELF(LAY)
4534 DO 2000 IG = 1, NG1
4535 TAUG(IG,LAY) = COLH2O(LAY) * &
4536 (FAC00(LAY) * ABSA1(IND0,IG) + &
4537 FAC10(LAY) * ABSA1(IND0+1,IG) + &
4538 FAC01(LAY) * ABSA1(IND1,IG) + &
4539 FAC11(LAY) * ABSA1(IND1+1,IG) + &
4540 SELFFAC(LAY) * (SELFREFC1(INDS,IG) + &
4541 SELFFRAC(LAY) * &
4542 (SELFREFC1(INDS+1,IG) - SELFREFC1(INDS,IG))) + &
4543 FORFAC(LAY) * FORREFC1(IG))
4544 PFRAC(IG,LAY) = FRACREFAC1(IG)
4545 2000 CONTINUE
4546 2500 CONTINUE
4548 !cdir novector
4549 DO 3500 LAY = LAYTROP+1, NLAYERS
4550 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(1) + 1
4551 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(1) + 1
4552 DO 3000 IG = 1, NG1
4553 TAUG(IG,LAY) = COLH2O(LAY) * &
4554 (FAC00(LAY) * ABSB1(IND0,IG) + &
4555 FAC10(LAY) * ABSB1(IND0+1,IG) + &
4556 FAC01(LAY) * ABSB1(IND1,IG) + &
4557 FAC11(LAY) * ABSB1(IND1+1,IG) + &
4558 FORFAC(LAY) * FORREFC1(IG))
4559 PFRAC(IG,LAY) = FRACREFBC1(IG)
4560 3000 CONTINUE
4561 3500 CONTINUE
4563 END SUBROUTINE TAUGB1
4565 !----------------------------------------------------------------------------
4566 SUBROUTINE TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11, &
4567 FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
4568 PFRAC,TAUG,LAYTROP )
4569 !----------------------------------------------------------------------------
4571 ! BAND 2: 250-500 cm-1 (low - H2O; high - H2O)
4573 INTEGER, INTENT(IN ) :: kts,ktep1
4575 INTEGER, PARAMETER :: NGS1=8
4577 INTEGER, INTENT(IN ) :: LAYTROP
4579 REAL, DIMENSION( NGPT,kts:ktep1 ), &
4580 INTENT(INOUT) :: PFRAC, &
4581 TAUG
4583 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4584 COLDRY, &
4585 COLH2O, &
4586 FAC00, &
4587 FAC01, &
4588 FAC10, &
4589 FAC11, &
4590 FORFAC, &
4591 SELFFAC, &
4592 SELFFRAC
4594 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4595 JP, &
4596 JT, &
4597 JT1, &
4598 INDSELF
4600 ! This compiler directive was added to insure private common block storage
4601 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
4602 ! carry constants.
4604 DIMENSION FC00(kts:ktep1),FC01(kts:ktep1),FC10(kts:ktep1),FC11(kts:ktep1)
4605 DIMENSION REFPARAM(13)
4607 ! These are the mixing ratios for H2O for a MLS atmosphere at the
4608 ! 13 RRTM reference pressure levels: 1.8759999E-02, 1.2223309E-02,
4609 ! 5.8908667E-03, 2.7675382E-03, 1.4065107E-03, 7.5969833E-04,
4610 ! 3.8875898E-04, 1.6542293E-04, 3.7189537E-05, 7.4764857E-06,
4611 ! 4.3081886E-06, 3.3319423E-06, 3.2039343E-06/
4613 ! The following are parameters related to the reference water vapor
4614 ! mixing ratios by REFPARAM(I) = REFH2O(I) / (.002+REFH2O(I)).
4615 ! These parameters are used for the Planck function interpolation.
4616 DATA REFPARAM/ &
4617 0.903661, 0.859386, 0.746542, 0.580496, 0.412889, 0.275283, &
4618 0.162745, 7.63929E-02, 1.82553E-02, 3.72432E-03, &
4619 2.14946E-03, 1.66320E-03, 1.59940E-03/
4621 ! Compute the optical depth by interpolating in ln(pressure) and
4622 ! temperature. Below LAYTROP, the water vapor self-continuum is
4623 ! interpolated (in temperature) separately.
4624 !cdir novector
4625 DO 2500 LAY = 1, LAYTROP
4626 WATER = 1.E20 * COLH2O(LAY) / COLDRY(LAY)
4627 H2OPARAM = WATER/(WATER +.002)
4628 DO 1800 IFRAC = 2, 12
4629 IF (H2OPARAM .GE. REFPARAM(IFRAC)) GO TO 1900
4630 1800 CONTINUE
4631 1900 CONTINUE
4632 FRACINT = (H2OPARAM-REFPARAM(IFRAC))/ &
4633 (REFPARAM(IFRAC-1)-REFPARAM(IFRAC))
4635 FP = FAC11(LAY) + FAC01(LAY)
4636 IFP = 2.E2*FP+0.5
4637 IF (IFP.LE.0) IFP = 0
4638 FC00(LAY) = FAC00(LAY) * CORR2(IFP)
4639 FC10(LAY) = FAC10(LAY) * CORR2(IFP)
4640 FC01(LAY) = FAC01(LAY) * CORR1(IFP)
4641 FC11(LAY) = FAC11(LAY) * CORR1(IFP)
4642 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(2) + 1
4643 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(2) + 1
4644 INDS = INDSELF(LAY)
4645 DO 2000 IG = 1, NG2
4646 TAUG(NGS1+IG,LAY) = COLH2O(LAY) * &
4647 (FC00(LAY) * ABSA2(IND0,IG) + &
4648 FC10(LAY) * ABSA2(IND0+1,IG) + &
4649 FC01(LAY) * ABSA2(IND1,IG) + &
4650 FC11(LAY) * ABSA2(IND1+1,IG) + &
4651 SELFFAC(LAY) * (SELFREFC2(INDS,IG) + &
4652 SELFFRAC(LAY) * &
4653 (SELFREFC2(INDS+1,IG) - SELFREFC2(INDS,IG))) + &
4654 FORFAC(LAY) * FORREFC2(IG))
4655 PFRAC(NGS1+IG,LAY) = FRACREFAC2(IG,IFRAC) + FRACINT * &
4656 (FRACREFAC2(IG,IFRAC-1)-FRACREFAC2(IG,IFRAC))
4657 2000 CONTINUE
4658 2500 CONTINUE
4660 !cdir novector
4661 DO 3500 LAY = LAYTROP+1, NLAYERS
4662 FP = FAC11(LAY) + FAC01(LAY)
4663 IFP = 2.E2*FP+0.5
4664 IF (IFP.LE.0) IFP = 0
4665 FC00(LAY) = FAC00(LAY) * CORR2(IFP)
4666 FC10(LAY) = FAC10(LAY) * CORR2(IFP)
4667 FC01(LAY) = FAC01(LAY) * CORR1(IFP)
4668 FC11(LAY) = FAC11(LAY) * CORR1(IFP)
4669 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(2) + 1
4670 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(2) + 1
4671 DO 3000 IG = 1, NG2
4672 TAUG(NGS1+IG,LAY) = COLH2O(LAY) * &
4673 (FC00(LAY) * ABSB2(IND0,IG) + &
4674 FC10(LAY) * ABSB2(IND0+1,IG) + &
4675 FC01(LAY) * ABSB2(IND1,IG) + &
4676 FC11(LAY) * ABSB2(IND1+1,IG) + &
4677 FORFAC(LAY) * FORREFC2(IG))
4678 PFRAC(NGS1+IG,LAY) = FRACREFBC2(IG)
4679 3000 CONTINUE
4680 3500 CONTINUE
4682 END SUBROUTINE TAUGB2
4684 !-----------------------------------------------------------------------------
4685 SUBROUTINE TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10, &
4686 FAC11,FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
4687 PFRAC,TAUG,LAYTROP )
4688 !-----------------------------------------------------------------------------
4690 ! BAND 3: 500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
4692 INTEGER, PARAMETER :: NGS2=22
4694 INTEGER, INTENT(IN ) :: kts,ktep1
4696 INTEGER, INTENT(IN ) :: LAYTROP
4698 REAL, DIMENSION( NGPT,kts:ktep1 ), &
4699 INTENT(INOUT) :: PFRAC, &
4700 TAUG
4702 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4703 COLH2O, &
4704 COLCO2, &
4705 COLN2O, &
4706 FAC00, &
4707 FAC01, &
4708 FAC10, &
4709 FAC11, &
4710 FORFAC, &
4711 SELFFAC, &
4712 SELFFRAC
4714 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4715 JP, &
4716 JT, &
4717 JT1, &
4718 INDSELF
4720 ! This compiler directive was added to insure private common block storage
4721 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
4722 ! carry constants.
4724 DIMENSION H2OREF(59),CO2REF(59), ETAREF(10)
4725 REAL N2OMULT,N2OREF(59)
4727 DATA ETAREF/ &
4728 0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.9875,1.0/
4729 DATA H2OREF/ &
4730 1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &
4731 7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &
4732 4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &
4733 3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &
4734 4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &
4735 4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &
4736 5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &
4737 5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &
4738 5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &
4739 4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &
4740 3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &
4741 2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/
4742 DATA N2OREF/ &
4743 3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &
4744 3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &
4745 2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &
4746 1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &
4747 8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &
4748 3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &
4749 1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &
4750 3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &
4751 1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &
4752 9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &
4753 7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &
4754 5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/
4755 DATA CO2REF/ &
4756 53*3.55E-04, 3.5470873E-04, 3.5427220E-04, 3.5383567E-04, &
4757 3.5339911E-04, 3.5282588E-04, 3.5079606E-04/
4759 STRRAT = 1.19268
4761 ! Compute the optical depth by interpolating in ln(pressure),
4762 ! temperature, and appropriate species. Below LAYTROP, the water
4763 ! vapor self-continuum is interpolated (in temperature) separately.
4765 !cdir novector
4766 DO 2500 LAY = 1, LAYTROP
4767 SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)
4768 SPECPARM = COLH2O(LAY)/SPECCOMB
4769 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
4770 SPECMULT = 8.*(SPECPARM)
4771 JS = 1 + INT(SPECMULT)
4772 FS = MOD(SPECMULT,1.0)
4773 IF (JS .EQ. 8) THEN
4774 IF (FS .GE. 0.9) THEN
4775 JS = 9
4776 FS = 10. * (FS - 0.9)
4777 ELSE
4778 FS = FS/0.9
4779 ENDIF
4780 ENDIF
4781 NS = JS + INT(FS + 0.5)
4782 FP = FAC01(LAY) + FAC11(LAY)
4783 FAC000 = (1. - FS) * FAC00(LAY)
4784 FAC010 = (1. - FS) * FAC10(LAY)
4785 FAC100 = FS * FAC00(LAY)
4786 FAC110 = FS * FAC10(LAY)
4787 FAC001 = (1. - FS) * FAC01(LAY)
4788 FAC011 = (1. - FS) * FAC11(LAY)
4789 FAC101 = FS * FAC01(LAY)
4790 FAC111 = FS * FAC11(LAY)
4791 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(3) + JS
4792 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(3) + JS
4793 INDS = INDSELF(LAY)
4794 COLREF1 = N2OREF(JP(LAY))
4795 COLREF2 = N2OREF(JP(LAY)+1)
4796 IF (NS .EQ. 10) THEN
4797 WCOMB1 = H2OREF(JP(LAY))
4798 WCOMB2 = H2OREF(JP(LAY)+1)
4799 ELSE
4800 WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))
4801 WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))
4802 ENDIF
4803 RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))
4804 CURRN2O = SPECCOMB * RATIO
4805 N2OMULT = COLN2O(LAY) - CURRN2O
4806 !!DIR$ VECTOR
4807 DO 2000 IG = 1, NG3
4808 TAUG(NGS2+IG,LAY) = SPECCOMB * &
4809 (FAC000 * ABSA3(IND0,IG) + &
4810 FAC100 * ABSA3(IND0+1,IG) + &
4811 FAC010 * ABSA3(IND0+10,IG) + &
4812 FAC110 * ABSA3(IND0+11,IG) + &
4813 FAC001 * ABSA3(IND1,IG) + &
4814 FAC101 * ABSA3(IND1+1,IG) + &
4815 FAC011 * ABSA3(IND1+10,IG) + &
4816 FAC111 * ABSA3(IND1+11,IG)) + &
4817 COLH2O(LAY) * &
4818 (SELFFAC(LAY) * (SELFREFC3(INDS,IG) + &
4819 SELFFRAC(LAY) * &
4820 (SELFREFC3(INDS+1,IG) - SELFREFC3(INDS,IG))) + &
4821 FORFAC(LAY) * FORREFC3(IG)) &
4822 + N2OMULT * ABSN2OAC3(IG)
4823 PFRAC(NGS2+IG,LAY) = FRACREFAC3(IG,JS) + FS * &
4824 (FRACREFAC3(IG,JS+1) - FRACREFAC3(IG,JS))
4825 2000 CONTINUE
4826 2500 CONTINUE
4828 !!DIR$ NOVECTOR
4829 !cdir novector
4830 DO 3500 LAY = LAYTROP+1, NLAYERS
4831 SPECCOMB = COLH2O(LAY) + STRRAT*COLCO2(LAY)
4832 SPECPARM = COLH2O(LAY)/SPECCOMB
4833 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
4834 SPECMULT = 4.*(SPECPARM)
4835 JS = 1 + INT(SPECMULT)
4836 FS = MOD(SPECMULT,1.0)
4837 NS = JS + INT(FS + 0.5)
4838 FP = FAC01(LAY) + FAC11(LAY)
4839 FAC000 = (1. - FS) * FAC00(LAY)
4840 FAC010 = (1. - FS) * FAC10(LAY)
4841 FAC100 = FS * FAC00(LAY)
4842 FAC110 = FS * FAC10(LAY)
4843 FAC001 = (1. - FS) * FAC01(LAY)
4844 FAC011 = (1. - FS) * FAC11(LAY)
4845 FAC101 = FS * FAC01(LAY)
4846 FAC111 = FS * FAC11(LAY)
4847 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(3) + JS
4848 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(3) + JS
4849 COLREF1 = N2OREF(JP(LAY))
4850 COLREF2 = N2OREF(JP(LAY)+1)
4851 IF (NS .EQ. 5) THEN
4852 WCOMB1 = H2OREF(JP(LAY))
4853 WCOMB2 = H2OREF(JP(LAY)+1)
4854 ELSE
4855 WCOMB1 = STRRAT * CO2REF(JP(LAY))/(1.-ETAREF(NS))
4856 WCOMB2 = STRRAT * CO2REF(JP(LAY)+1)/(1.-ETAREF(NS))
4857 ENDIF
4858 RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))
4859 CURRN2O = SPECCOMB * RATIO
4860 N2OMULT = COLN2O(LAY) - CURRN2O
4861 !!DIR$ VECTOR
4862 DO 3000 IG = 1, NG3
4863 TAUG(NGS2+IG,LAY) = SPECCOMB * &
4864 (FAC000 * ABSB3(IND0,IG) + &
4865 FAC100 * ABSB3(IND0+1,IG) + &
4866 FAC010 * ABSB3(IND0+5,IG) + &
4867 FAC110 * ABSB3(IND0+6,IG) + &
4868 FAC001 * ABSB3(IND1,IG) + &
4869 FAC101 * ABSB3(IND1+1,IG) + &
4870 FAC011 * ABSB3(IND1+5,IG) + &
4871 FAC111 * ABSB3(IND1+6,IG)) + &
4872 COLH2O(LAY) * FORFAC(LAY) * FORREFC3(IG) &
4873 + N2OMULT * ABSN2OBC3(IG)
4874 PFRAC(NGS2+IG,LAY) = FRACREFBC3(IG,JS) + FS * &
4875 (FRACREFBC3(IG,JS+1) - FRACREFBC3(IG,JS))
4876 3000 CONTINUE
4877 3500 CONTINUE
4879 END SUBROUTINE TAUGB3
4881 !----------------------------------------------------------------------------
4882 SUBROUTINE TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10, &
4883 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
4884 PFRAC,TAUG,LAYTROP )
4885 !----------------------------------------------------------------------------
4887 ! BAND 4: 630-700 cm-1 (low - H2O,CO2; high - O3,CO2)
4889 INTEGER, PARAMETER :: NGS3=38
4891 INTEGER, INTENT(IN ) :: kts,ktep1
4893 INTEGER, INTENT(IN ) :: LAYTROP
4895 REAL, DIMENSION( NGPT,kts:ktep1 ), &
4896 INTENT(INOUT) :: PFRAC, &
4897 TAUG
4899 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4900 COLH2O, &
4901 COLCO2, &
4902 COLO3, &
4903 FAC00, &
4904 FAC01, &
4905 FAC10, &
4906 FAC11, &
4907 SELFFAC, &
4908 SELFFRAC
4910 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
4911 JP, &
4912 JT, &
4913 JT1, &
4914 INDSELF
4916 ! This compiler directive was added to insure private common block storage
4917 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
4918 ! carry constants.
4920 STRRAT1 = 850.577
4921 STRRAT2 = 35.7416
4923 ! Compute the optical depth by interpolating in ln(pressure),
4924 ! temperature, and appropriate species. Below LAYTROP, the water
4925 ! vapor self-continuum is interpolated (in temperature) separately.
4926 !!DIR$ NOVECTOR
4927 !cdir novector
4928 DO 2500 LAY = 1, LAYTROP
4929 SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)
4930 SPECPARM = COLH2O(LAY)/SPECCOMB
4931 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
4932 SPECMULT = 8.*(SPECPARM)
4933 JS = 1 + INT(SPECMULT)
4934 FS = MOD(SPECMULT,1.0)
4935 FAC000 = (1. - FS) * FAC00(LAY)
4936 FAC010 = (1. - FS) * FAC10(LAY)
4937 FAC100 = FS * FAC00(LAY)
4938 FAC110 = FS * FAC10(LAY)
4939 FAC001 = (1. - FS) * FAC01(LAY)
4940 FAC011 = (1. - FS) * FAC11(LAY)
4941 FAC101 = FS * FAC01(LAY)
4942 FAC111 = FS * FAC11(LAY)
4943 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(4) + JS
4944 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(4) + JS
4945 INDS = INDSELF(LAY)
4946 !!DIR$ VECTOR
4947 DO 2000 IG = 1, NG4
4948 TAUG(NGS3+IG,LAY) = SPECCOMB * &
4949 (FAC000 * ABSA4(IND0,IG) + &
4950 FAC100 * ABSA4(IND0+1,IG) + &
4951 FAC010 * ABSA4(IND0+9,IG) + &
4952 FAC110 * ABSA4(IND0+10,IG) + &
4953 FAC001 * ABSA4(IND1,IG) + &
4954 FAC101 * ABSA4(IND1+1,IG) + &
4955 FAC011 * ABSA4(IND1+9,IG) + &
4956 FAC111 * ABSA4(IND1+10,IG)) + &
4957 COLH2O(LAY) * &
4958 SELFFAC(LAY) * (SELFREFC4(INDS,IG) + &
4959 SELFFRAC(LAY) * &
4960 (SELFREFC4(INDS+1,IG) - SELFREFC4(INDS,IG)))
4961 PFRAC(NGS3+IG,LAY) = FRACREFAC4(IG,JS) + FS * &
4962 (FRACREFAC4(IG,JS+1) - FRACREFAC4(IG,JS))
4963 2000 CONTINUE
4964 2500 CONTINUE
4966 !!DIR$ NOVECTOR
4967 !cdir novector
4968 DO 3500 LAY = LAYTROP+1, NLAYERS
4969 SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)
4970 SPECPARM = COLO3(LAY)/SPECCOMB
4971 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
4972 SPECMULT = 4.*(SPECPARM)
4973 JS = 1 + INT(SPECMULT)
4974 FS = MOD(SPECMULT,1.0)
4975 IF (JS .GT. 1) THEN
4976 JS = JS + 1
4977 ELSEIF (FS .GE. 0.0024) THEN
4978 JS = 2
4979 FS = (FS - 0.0024)/0.9976
4980 ELSE
4981 JS = 1
4982 FS = FS/0.0024
4983 ENDIF
4984 FAC000 = (1. - FS) * FAC00(LAY)
4985 FAC010 = (1. - FS) * FAC10(LAY)
4986 FAC100 = FS * FAC00(LAY)
4987 FAC110 = FS * FAC10(LAY)
4988 FAC001 = (1. - FS) * FAC01(LAY)
4989 FAC011 = (1. - FS) * FAC11(LAY)
4990 FAC101 = FS * FAC01(LAY)
4991 FAC111 = FS * FAC11(LAY)
4992 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(4) + JS
4993 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(4) + JS
4994 !!DIR$ VECTOR
4995 DO 3000 IG = 1, NG4
4996 TAUG(NGS3+IG,LAY) = SPECCOMB * &
4997 (FAC000 * ABSB4(IND0,IG) + &
4998 FAC100 * ABSB4(IND0+1,IG) + &
4999 FAC010 * ABSB4(IND0+6,IG) + &
5000 FAC110 * ABSB4(IND0+7,IG) + &
5001 FAC001 * ABSB4(IND1,IG) + &
5002 FAC101 * ABSB4(IND1+1,IG) + &
5003 FAC011 * ABSB4(IND1+6,IG) + &
5004 FAC111 * ABSB4(IND1+7,IG))
5005 PFRAC(NGS3+IG,LAY) = FRACREFBC4(IG,JS) + FS * &
5006 (FRACREFBC4(IG,JS+1) - FRACREFBC4(IG,JS))
5007 3000 CONTINUE
5008 3500 CONTINUE
5010 END SUBROUTINE TAUGB4
5012 !----------------------------------------------------------------------------
5013 SUBROUTINE TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10, &
5014 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX, &
5015 PFRAC,TAUG,LAYTROP )
5016 !----------------------------------------------------------------------------
5018 ! BAND 5: 700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
5020 INTEGER, PARAMETER :: NGS4=52
5022 INTEGER, INTENT(IN ) :: kts,ktep1
5024 INTEGER, INTENT(IN ) :: LAYTROP
5026 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5027 INTENT(INOUT) :: PFRAC, &
5028 TAUG
5030 REAL, DIMENSION( MAXXSEC,kts:ktep1 ), &
5031 INTENT(IN ) :: WX
5033 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5034 COLH2O, &
5035 COLCO2, &
5036 COLO3, &
5037 FAC00, &
5038 FAC01, &
5039 FAC10, &
5040 FAC11, &
5041 SELFFAC, &
5042 SELFFRAC
5044 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5045 JP, &
5046 JT, &
5047 JT1, &
5048 INDSELF
5050 ! This compiler directive was added to insure private common block storage
5051 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5052 ! carry constants.
5054 STRRAT1 = 90.4894
5055 STRRAT2 = 0.900502
5057 ! Compute the optical depth by interpolating in ln(pressure),
5058 ! temperature, and appropriate species. Below LAYTROP, the water
5059 ! vapor self-continuum is interpolated (in temperature) separately.
5060 !!DIR$ NOVECTOR
5061 !cdir novector
5062 DO 2500 LAY = 1, LAYTROP
5063 SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)
5064 SPECPARM = COLH2O(LAY)/SPECCOMB
5065 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5066 SPECMULT = 8.*(SPECPARM)
5067 JS = 1 + INT(SPECMULT)
5068 FS = MOD(SPECMULT,1.0)
5069 FAC000 = (1. - FS) * FAC00(LAY)
5070 FAC010 = (1. - FS) * FAC10(LAY)
5071 FAC100 = FS * FAC00(LAY)
5072 FAC110 = FS * FAC10(LAY)
5073 FAC001 = (1. - FS) * FAC01(LAY)
5074 FAC011 = (1. - FS) * FAC11(LAY)
5075 FAC101 = FS * FAC01(LAY)
5076 FAC111 = FS * FAC11(LAY)
5077 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(5) + JS
5078 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(5) + JS
5079 INDS = INDSELF(LAY)
5080 !!DIR$ VECTOR
5081 DO 2000 IG = 1, NG5
5082 TAUG(NGS4+IG,LAY) = SPECCOMB * &
5083 (FAC000 * ABSA5(IND0,IG) + &
5084 FAC100 * ABSA5(IND0+1,IG) + &
5085 FAC010 * ABSA5(IND0+9,IG) + &
5086 FAC110 * ABSA5(IND0+10,IG) + &
5087 FAC001 * ABSA5(IND1,IG) + &
5088 FAC101 * ABSA5(IND1+1,IG) + &
5089 FAC011 * ABSA5(IND1+9,IG) + &
5090 FAC111 * ABSA5(IND1+10,IG)) + &
5091 COLH2O(LAY) * &
5092 SELFFAC(LAY) * (SELFREFC5(INDS,IG) + &
5093 SELFFRAC(LAY) * &
5094 (SELFREFC5(INDS+1,IG) - SELFREFC5(INDS,IG))) &
5095 + WX(1,LAY) * CCL4C5(IG)
5096 PFRAC(NGS4+IG,LAY) = FRACREFAC5(IG,JS) + FS * &
5097 (FRACREFAC5(IG,JS+1) - FRACREFAC5(IG,JS))
5098 2000 CONTINUE
5099 2500 CONTINUE
5101 !!DIR$ NOVECTOR
5102 !cdir novector
5103 DO 3500 LAY = LAYTROP+1, NLAYERS
5104 SPECCOMB = COLO3(LAY) + STRRAT2*COLCO2(LAY)
5105 SPECPARM = COLO3(LAY)/SPECCOMB
5106 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5107 SPECMULT = 4.*(SPECPARM)
5108 JS = 1 + INT(SPECMULT)
5109 FS = MOD(SPECMULT,1.0)
5110 FAC000 = (1. - FS) * FAC00(LAY)
5111 FAC010 = (1. - FS) * FAC10(LAY)
5112 FAC100 = FS * FAC00(LAY)
5113 FAC110 = FS * FAC10(LAY)
5114 FAC001 = (1. - FS) * FAC01(LAY)
5115 FAC011 = (1. - FS) * FAC11(LAY)
5116 FAC101 = FS * FAC01(LAY)
5117 FAC111 = FS * FAC11(LAY)
5118 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(5) + JS
5119 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(5) + JS
5120 !!DIR$ VECTOR
5121 DO 3000 IG = 1, NG5
5122 TAUG(NGS4+IG,LAY) = SPECCOMB * &
5123 (FAC000 * ABSB5(IND0,IG) + &
5124 FAC100 * ABSB5(IND0+1,IG) + &
5125 FAC010 * ABSB5(IND0+5,IG) + &
5126 FAC110 * ABSB5(IND0+6,IG) + &
5127 FAC001 * ABSB5(IND1,IG) + &
5128 FAC101 * ABSB5(IND1+1,IG) + &
5129 FAC011 * ABSB5(IND1+5,IG) + &
5130 FAC111 * ABSB5(IND1+6,IG)) &
5131 + WX(1,LAY) * CCL4C5(IG)
5132 PFRAC(NGS4+IG,LAY) = FRACREFBC5(IG,JS) + FS * &
5133 (FRACREFBC5(IG,JS+1) - FRACREFBC5(IG,JS))
5134 3000 CONTINUE
5135 3500 CONTINUE
5137 END SUBROUTINE TAUGB5
5139 !-----------------------------------------------------------------------------
5140 SUBROUTINE TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11, &
5141 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG, &
5142 LAYTROP )
5143 !-----------------------------------------------------------------------------
5145 ! BAND 6: 820-980 cm-1 (low - H2O; high - nothing)
5147 INTEGER, PARAMETER :: NGS5=68
5149 INTEGER, INTENT(IN ) :: kts,ktep1
5151 INTEGER, INTENT(IN ) :: LAYTROP
5153 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5154 INTENT(INOUT) :: PFRAC, &
5155 TAUG
5157 REAL, DIMENSION( MAXXSEC,kts:ktep1 ), &
5158 INTENT(IN ) :: WX
5160 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5161 COLH2O, &
5162 CO2MULT, &
5163 FAC00, &
5164 FAC01, &
5165 FAC10, &
5166 FAC11, &
5167 SELFFAC, &
5168 SELFFRAC
5170 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5171 JP, &
5172 JT, &
5173 JT1, &
5174 INDSELF
5176 ! This compiler directive was added to insure private common block storage
5177 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5178 ! carry constants.
5180 ! Compute the optical depth by interpolating in ln(pressure) and
5181 ! temperature. The water vapor self-continuum is interpolated
5182 ! (in temperature) separately.
5183 !cdir novector
5184 DO 2500 LAY = 1, LAYTROP
5185 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(6) + 1
5186 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(6) + 1
5187 INDS = INDSELF(LAY)
5188 DO 2000 IG = 1, NG6
5189 TAUG(NGS5+IG,LAY) = COLH2O(LAY) * &
5190 (FAC00(LAY) * ABSA6(IND0,IG) + &
5191 FAC10(LAY) * ABSA6(IND0+1,IG) + &
5192 FAC01(LAY) * ABSA6(IND1,IG) + &
5193 FAC11(LAY) * ABSA6(IND1+1,IG) + &
5194 SELFFAC(LAY) * (SELFREFC6(INDS,IG) + &
5195 SELFFRAC(LAY)* &
5196 (SELFREFC6(INDS+1,IG)-SELFREFC6(INDS,IG)))) &
5197 + WX(2,LAY) * CFC11ADJC6(IG) &
5198 + WX(3,LAY) * CFC12C6(IG) &
5199 + CO2MULT(LAY) * ABSCO2C6(IG)
5200 PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)
5201 2000 CONTINUE
5202 2500 CONTINUE
5204 ! Nothing important goes on above LAYTROP in this band.
5205 !cdir novector
5206 DO 3500 LAY = LAYTROP+1, NLAYERS
5207 DO 3000 IG = 1, NG6
5208 TAUG(NGS5+IG,LAY) = 0.0 &
5209 + WX(2,LAY) * CFC11ADJC6(IG) &
5210 + WX(3,LAY) * CFC12C6(IG)
5211 PFRAC(NGS5+IG,LAY) = FRACREFAC6(IG)
5212 3000 CONTINUE
5213 3500 CONTINUE
5215 END SUBROUTINE TAUGB6
5217 !-----------------------------------------------------------------------------
5218 SUBROUTINE TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10, &
5219 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
5220 PFRAC,TAUG,LAYTROP )
5221 !-----------------------------------------------------------------------------
5223 ! BAND 7: 980-1080 cm-1 (low - H2O,O3; high - O3)
5225 INTEGER, PARAMETER :: NGS6=76
5227 INTEGER, INTENT(IN ) :: kts,ktep1
5229 INTEGER, INTENT(IN ) :: LAYTROP
5231 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5232 INTENT(INOUT) :: PFRAC, &
5233 TAUG
5235 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5236 COLH2O, &
5237 COLO3, &
5238 CO2MULT, &
5239 FAC00, &
5240 FAC01, &
5241 FAC10, &
5242 FAC11, &
5243 SELFFAC, &
5244 SELFFRAC
5246 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5247 JP, &
5248 JT, &
5249 JT1, &
5250 INDSELF
5252 ! This compiler directive was added to insure private common block storage
5253 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5254 ! carry constants.
5256 STRRAT1 = 8.21104E4
5258 ! Compute the optical depth by interpolating in ln(pressure),
5259 ! temperature, and appropriate species. Below LAYTROP, the water
5260 ! vapor self-continuum is interpolated (in temperature) separately.
5261 !!DIR$ NOVECTOR
5262 !cdir novector
5263 DO 2500 LAY = 1, LAYTROP
5264 SPECCOMB = COLH2O(LAY) + STRRAT1*COLO3(LAY)
5265 SPECPARM = COLH2O(LAY)/SPECCOMB
5266 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5267 SPECMULT = 8.*SPECPARM
5268 JS = 1 + INT(SPECMULT)
5269 FS = MOD(SPECMULT,1.0)
5270 FAC000 = (1. - FS) * FAC00(LAY)
5271 FAC010 = (1. - FS) * FAC10(LAY)
5272 FAC100 = FS * FAC00(LAY)
5273 FAC110 = FS * FAC10(LAY)
5274 FAC001 = (1. - FS) * FAC01(LAY)
5275 FAC011 = (1. - FS) * FAC11(LAY)
5276 FAC101 = FS * FAC01(LAY)
5277 FAC111 = FS * FAC11(LAY)
5278 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(7) + JS
5279 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(7) + JS
5280 INDS = INDSELF(LAY)
5281 !!DIR$ VECTOR
5282 DO 2000 IG = 1, NG7
5283 TAUG(NGS6+IG,LAY) = SPECCOMB * &
5284 (FAC000 * ABSA7(IND0,IG) + &
5285 FAC100 * ABSA7(IND0+1,IG) + &
5286 FAC010 * ABSA7(IND0+9,IG) + &
5287 FAC110 * ABSA7(IND0+10,IG) + &
5288 FAC001 * ABSA7(IND1,IG) + &
5289 FAC101 * ABSA7(IND1+1,IG) + &
5290 FAC011 * ABSA7(IND1+9,IG) + &
5291 FAC111 * ABSA7(IND1+10,IG)) + &
5292 COLH2O(LAY) * &
5293 SELFFAC(LAY) * (SELFREFC7(INDS,IG) + &
5294 SELFFRAC(LAY) * &
5295 (SELFREFC7(INDS+1,IG) - SELFREFC7(INDS,IG)))&
5296 + CO2MULT(LAY) * ABSCO2C7(IG)
5297 PFRAC(NGS6+IG,LAY) = FRACREFAC7(IG,JS) + FS * &
5298 (FRACREFAC7(IG,JS+1) - FRACREFAC7(IG,JS))
5299 2000 CONTINUE
5300 2500 CONTINUE
5302 !cdir novector
5303 DO 3500 LAY = LAYTROP+1, NLAYERS
5304 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(7) + 1
5305 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(7) + 1
5306 DO 3000 IG = 1, NG7
5307 TAUG(NGS6+IG,LAY) = COLO3(LAY) * &
5308 (FAC00(LAY) * ABSB7(IND0,IG) + &
5309 FAC10(LAY) * ABSB7(IND0+1,IG) + &
5310 FAC01(LAY) * ABSB7(IND1,IG) + &
5311 FAC11(LAY) * ABSB7(IND1+1,IG)) &
5312 + CO2MULT(LAY) * ABSCO2C7(IG)
5313 PFRAC(NGS6+IG,LAY) = FRACREFBC7(IG)
5314 3000 CONTINUE
5315 3500 CONTINUE
5317 END SUBROUTINE TAUGB7
5319 !----------------------------------------------------------------------------
5320 SUBROUTINE TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT, &
5321 FAC00,FAC01,FAC10,FAC11,SELFFAC,SELFFRAC, &
5322 JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,LAYSWTCH )
5323 !----------------------------------------------------------------------------
5325 ! BAND 8: 1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
5327 INTEGER, PARAMETER :: NGS7=88
5329 INTEGER, INTENT(IN ) :: kts,ktep1
5331 INTEGER, INTENT(IN ) :: LAYSWTCH
5333 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5334 INTENT(INOUT) :: PFRAC, &
5335 TAUG
5337 REAL, DIMENSION( MAXXSEC,kts:ktep1 ), &
5338 INTENT(IN ) :: WX
5340 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5341 COLH2O, &
5342 COLO3, &
5343 COLN2O, &
5344 CO2MULT, &
5345 FAC00, &
5346 FAC01, &
5347 FAC10, &
5348 FAC11, &
5349 SELFFAC, &
5350 SELFFRAC
5352 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5353 JP, &
5354 JT, &
5355 JT1, &
5356 INDSELF
5358 ! This compiler directive was added to insure private common block storage
5359 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5360 ! carry constants.
5362 DIMENSION H2OREF(59),O3REF(59)
5363 REAL N2OMULT,N2OREF(59)
5365 DATA H2OREF/ &
5366 1.87599E-02,1.22233E-02,5.89086E-03,2.76753E-03,1.40651E-03, &
5367 7.59698E-04,3.88758E-04,1.65422E-04,3.71895E-05,7.47648E-06, &
5368 4.30818E-06,3.33194E-06,3.20393E-06,3.16186E-06,3.25235E-06, &
5369 3.42258E-06,3.62884E-06,3.91482E-06,4.14875E-06,4.30810E-06, &
5370 4.44204E-06,4.57783E-06,4.70865E-06,4.79432E-06,4.86971E-06, &
5371 4.92603E-06,4.96688E-06,4.99628E-06,5.05266E-06,5.12658E-06, &
5372 5.25028E-06,5.35708E-06,5.45085E-06,5.48304E-06,5.50000E-06, &
5373 5.50000E-06,5.45359E-06,5.40468E-06,5.35576E-06,5.25327E-06, &
5374 5.14362E-06,5.03396E-06,4.87662E-06,4.69787E-06,4.51911E-06, &
5375 4.33600E-06,4.14416E-06,3.95232E-06,3.76048E-06,3.57217E-06, &
5376 3.38549E-06,3.19881E-06,3.01212E-06,2.82621E-06,2.64068E-06, &
5377 2.45515E-06,2.26962E-06,2.08659E-06,1.93029E-06/
5378 DATA N2OREF/ &
5379 3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &
5380 3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &
5381 2.76714E-07,2.64709E-07,2.42847E-07,2.09547E-07,1.71945E-07, &
5382 1.37491E-07,1.13319E-07,1.00354E-07,9.12812E-08,8.54633E-08, &
5383 8.03631E-08,7.33718E-08,6.59754E-08,5.60386E-08,4.70901E-08, &
5384 3.99774E-08,3.29786E-08,2.60642E-08,2.10663E-08,1.65918E-08, &
5385 1.30167E-08,1.00900E-08,7.62490E-09,6.11592E-09,4.66725E-09, &
5386 3.28574E-09,2.84838E-09,2.46198E-09,2.07557E-09,1.85507E-09, &
5387 1.65675E-09,1.45843E-09,1.31948E-09,1.20716E-09,1.09485E-09, &
5388 9.97803E-10,9.31260E-10,8.64721E-10,7.98181E-10,7.51380E-10, &
5389 7.13670E-10,6.75960E-10,6.38250E-10,6.09811E-10,5.85998E-10, &
5390 5.62185E-10,5.38371E-10,5.15183E-10,4.98660E-10/
5391 DATA O3REF/ &
5392 3.01700E-08,3.47254E-08,4.24769E-08,5.27592E-08,6.69439E-08, &
5393 8.71295E-08,1.13911E-07,1.56771E-07,2.17878E-07,3.24430E-07, &
5394 4.65942E-07,5.68057E-07,6.96065E-07,1.11863E-06,1.76175E-06, &
5395 2.32689E-06,2.95769E-06,3.65930E-06,4.59503E-06,5.31891E-06, &
5396 5.96179E-06,6.51133E-06,7.06350E-06,7.69169E-06,8.25771E-06, &
5397 8.70824E-06,8.83245E-06,8.71486E-06,8.09434E-06,7.33071E-06, &
5398 6.31014E-06,5.36717E-06,4.48289E-06,3.83913E-06,3.28270E-06, &
5399 2.82351E-06,2.49061E-06,2.16453E-06,1.83845E-06,1.66182E-06, &
5400 1.50517E-06,1.34852E-06,1.19718E-06,1.04822E-06,8.99264E-07, &
5401 7.63432E-07,6.53806E-07,5.44186E-07,4.34564E-07,3.64210E-07, &
5402 3.11938E-07,2.59667E-07,2.07395E-07,1.91456E-07,1.93639E-07, &
5403 1.95821E-07,1.98004E-07,2.06442E-07,2.81546E-07/
5405 ! Compute the optical depth by interpolating in ln(pressure) and
5406 ! temperature.
5407 !cdir novector
5408 DO 2500 LAY = 1, LAYSWTCH
5409 FP = FAC01(LAY) + FAC11(LAY)
5410 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(8) + 1
5411 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(8) + 1
5412 INDS = INDSELF(LAY)
5413 COLREF1 = N2OREF(JP(LAY))
5414 COLREF2 = N2OREF(JP(LAY)+1)
5415 WCOMB1 = H2OREF(JP(LAY))
5416 WCOMB2 = H2OREF(JP(LAY)+1)
5417 RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))
5418 CURRN2O = COLH2O(LAY) * RATIO
5419 N2OMULT = COLN2O(LAY) - CURRN2O
5420 DO 2000 IG = 1, NG8
5421 TAUG(NGS7+IG,LAY) = COLH2O(LAY) * &
5422 (FAC00(LAY) * ABSA8(IND0,IG) + &
5423 FAC10(LAY) * ABSA8(IND0+1,IG) + &
5424 FAC01(LAY) * ABSA8(IND1,IG) + &
5425 FAC11(LAY) * ABSA8(IND1+1,IG) + &
5426 SELFFAC(LAY) * (SELFREFC8(INDS,IG) + &
5427 SELFFRAC(LAY) * &
5428 (SELFREFC8(INDS+1,IG) - SELFREFC8(INDS,IG))))&
5429 + WX(3,LAY) * CFC12C8(IG) &
5430 + WX(4,LAY) * CFC22ADJC8(IG) &
5431 + CO2MULT(LAY) * ABSCO2AC8(IG) &
5432 + N2OMULT * ABSN2OAC8(IG)
5433 PFRAC(NGS7+IG,LAY) = FRACREFAC8(IG)
5434 2000 CONTINUE
5435 2500 CONTINUE
5437 !cdir novector
5438 DO 3500 LAY = LAYSWTCH+1, NLAYERS
5439 FP = FAC01(LAY) + FAC11(LAY)
5440 IND0 = ((JP(LAY)-7)*5+(JT(LAY)-1))*NSPB(8) + 1
5441 IND1 = ((JP(LAY)-6)*5+(JT1(LAY)-1))*NSPB(8) + 1
5442 COLREF1 = N2OREF(JP(LAY))
5443 COLREF2 = N2OREF(JP(LAY)+1)
5444 WCOMB1 = O3REF(JP(LAY))
5445 WCOMB2 = O3REF(JP(LAY)+1)
5446 RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))
5447 CURRN2O = COLO3(LAY) * RATIO
5448 N2OMULT = COLN2O(LAY) - CURRN2O
5449 DO 3000 IG = 1, NG8
5450 TAUG(NGS7+IG,LAY) = COLO3(LAY) * &
5451 (FAC00(LAY) * ABSB8(IND0,IG) + &
5452 FAC10(LAY) * ABSB8(IND0+1,IG) + &
5453 FAC01(LAY) * ABSB8(IND1,IG) + &
5454 FAC11(LAY) * ABSB8(IND1+1,IG)) &
5455 + WX(3,LAY) * CFC12C8(IG) &
5456 + WX(4,LAY) * CFC22ADJC8(IG) &
5457 + CO2MULT(LAY) * ABSCO2BC8(IG) &
5458 + N2OMULT * ABSN2OBC8(IG)
5459 PFRAC(NGS7+IG,LAY) = FRACREFBC8(IG)
5460 3000 CONTINUE
5461 3500 CONTINUE
5463 END SUBROUTINE TAUGB8
5465 !-----------------------------------------------------------------------------
5466 SUBROUTINE TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10, &
5467 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
5468 PFRAC,TAUG,LAYTROP,LAYSWTCH,LAYLOW )
5469 !-----------------------------------------------------------------------------
5471 ! BAND 9: 1180-1390 cm-1 (low - H2O,CH4; high - CH4)
5473 INTEGER, PARAMETER :: NGS8=96
5475 INTEGER, INTENT(IN ) :: kts,ktep1
5477 INTEGER, INTENT(IN ) :: LAYTROP,LAYSWTCH,LAYLOW
5479 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5480 INTENT(INOUT) :: PFRAC, &
5481 TAUG
5483 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5484 COLH2O, &
5485 COLN2O, &
5486 COLCH4, &
5487 FAC00, &
5488 FAC01, &
5489 FAC10, &
5490 FAC11, &
5491 SELFFAC, &
5492 SELFFRAC
5494 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5495 JP, &
5496 JT, &
5497 JT1, &
5498 INDSELF
5500 ! This compiler directive was added to insure private common block storage
5501 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5502 ! carry constants.
5504 DIMENSION H2OREF(13),CH4REF(13),ETAREF(11)
5505 REAL N2OMULT,N2OREF(13)
5507 DATA N2OREF/ &
5508 3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07,3.20000E-07, &
5509 3.19652E-07,3.15324E-07,3.03830E-07,2.94221E-07,2.84953E-07, &
5510 2.76714E-07,2.64709E-07,2.42847E-07/
5511 DATA H2OREF/ &
5512 1.8759999E-02, 1.2223309E-02, 5.8908667E-03, 2.7675382E-03, &
5513 1.4065107E-03, 7.5969833E-04, 3.8875898E-04, 1.6542293E-04, &
5514 3.7189537E-05, 7.4764857E-06, 4.3081886E-06, 3.3319423E-06, &
5515 3.2039343E-06/
5516 DATA CH4REF/ &
5517 1.7000001E-06, 1.7000001E-06, 1.6998713E-06, 1.6904165E-06, &
5518 1.6671424E-06, 1.6350652E-06, 1.6097551E-06, 1.5590465E-06, &
5519 1.5119849E-06, 1.4741138E-06, 1.4384609E-06, 1.4002215E-06, &
5520 1.3573376E-06/
5521 DATA ETAREF/ &
5522 0.,0.125,0.25,0.375,0.5,0.625,0.75,0.875,0.96,0.99,1.0/
5524 STRRAT = 21.6282
5525 IOFF = 0
5527 ! Compute the optical depth by interpolating in ln(pressure),
5528 ! temperature, and appropriate species. Below LAYTROP, the water
5529 ! vapor self-continuum is interpolated (in temperature) separately.
5530 !cdir novector
5531 DO 2500 LAY = 1, LAYTROP
5532 SPECCOMB = COLH2O(LAY) + STRRAT*COLCH4(LAY)
5533 SPECPARM = COLH2O(LAY)/SPECCOMB
5534 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5535 SPECMULT = 8.*(SPECPARM)
5536 JS = 1 + INT(SPECMULT)
5537 JFRAC = JS
5538 FS = MOD(SPECMULT,1.0)
5539 FFRAC = FS
5540 IF (JS .EQ. 8) THEN
5541 IF (FS .LE. 0.68) THEN
5542 FS = FS/0.68
5543 ELSEIF (FS .LE. 0.92) THEN
5544 JS = JS + 1
5545 FS = (FS-0.68)/0.24
5546 ELSE
5547 JS = JS + 2
5548 FS = (FS-0.92)/0.08
5549 ENDIF
5550 ELSEIF (JS .EQ.9) THEN
5551 JS = 10
5552 FS = 1.
5553 JFRAC = 8
5554 FFRAC = 1.
5555 ENDIF
5556 FP = FAC01(LAY) + FAC11(LAY)
5557 NS = JS + INT(FS + 0.5)
5558 FAC000 = (1. - FS) * FAC00(LAY)
5559 FAC010 = (1. - FS) * FAC10(LAY)
5560 FAC100 = FS * FAC00(LAY)
5561 FAC110 = FS * FAC10(LAY)
5562 FAC001 = (1. - FS) * FAC01(LAY)
5563 FAC011 = (1. - FS) * FAC11(LAY)
5564 FAC101 = FS * FAC01(LAY)
5565 FAC111 = FS * FAC11(LAY)
5566 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(9) + JS
5567 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(9) + JS
5568 INDS = INDSELF(LAY)
5569 IF (LAY .EQ. LAYLOW) IOFF = NG9
5570 IF (LAY .EQ. LAYSWTCH) IOFF = 2*NG9
5571 COLREF1 = N2OREF(JP(LAY))
5572 COLREF2 = N2OREF(JP(LAY)+1)
5573 IF (NS .EQ. 11) THEN
5574 WCOMB1 = H2OREF(JP(LAY))
5575 WCOMB2 = H2OREF(JP(LAY)+1)
5576 ELSE
5577 WCOMB1 = STRRAT * CH4REF(JP(LAY))/(1.-ETAREF(NS))
5578 WCOMB2 = STRRAT * CH4REF(JP(LAY)+1)/(1.-ETAREF(NS))
5579 ENDIF
5580 RATIO = (COLREF1/WCOMB1)+FP*((COLREF2/WCOMB2)-(COLREF1/WCOMB1))
5581 CURRN2O = SPECCOMB * RATIO
5582 N2OMULT = COLN2O(LAY) - CURRN2O
5583 DO 2000 IG = 1, NG9
5584 TAUG(NGS8+IG,LAY) = SPECCOMB * &
5585 (FAC000 * ABSA9(IND0,IG) + &
5586 FAC100 * ABSA9(IND0+1,IG) + &
5587 FAC010 * ABSA9(IND0+11,IG) + &
5588 FAC110 * ABSA9(IND0+12,IG) + &
5589 FAC001 * ABSA9(IND1,IG) + &
5590 FAC101 * ABSA9(IND1+1,IG) + &
5591 FAC011 * ABSA9(IND1+11,IG) + &
5592 FAC111 * ABSA9(IND1+12,IG)) + &
5593 COLH2O(LAY) * &
5594 SELFFAC(LAY) * (SELFREFC9(INDS,IG) + &
5595 SELFFRAC(LAY) * &
5596 (SELFREFC9(INDS+1,IG) - SELFREFC9(INDS,IG))) &
5597 + N2OMULT * ABSN2OC9(IG+IOFF)
5598 PFRAC(NGS8+IG,LAY) = FRACREFAC9(IG,JFRAC) + FFRAC * &
5599 (FRACREFAC9(IG,JFRAC+1) - FRACREFAC9(IG,JFRAC))
5600 2000 CONTINUE
5601 2500 CONTINUE
5603 !cdir novector
5604 DO 3500 LAY = LAYTROP+1, NLAYERS
5605 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(9) + 1
5606 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(9) + 1
5607 DO 3000 IG = 1, NG9
5608 TAUG(NGS8+IG,LAY) = COLCH4(LAY) * &
5609 (FAC00(LAY) * ABSB9(IND0,IG) + &
5610 FAC10(LAY) * ABSB9(IND0+1,IG) + &
5611 FAC01(LAY) * ABSB9(IND1,IG) + &
5612 FAC11(LAY) * ABSB9(IND1+1,IG))
5613 PFRAC(NGS8+IG,LAY) = FRACREFBC9(IG)
5614 3000 CONTINUE
5615 3500 CONTINUE
5617 END SUBROUTINE TAUGB9
5619 !--------------------------------------------------------------------------------
5620 SUBROUTINE TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1, &
5621 PFRAC,TAUG,LAYTROP )
5622 !--------------------------------------------------------------------------------
5624 ! BAND 10: 1390-1480 cm-1 (low - H2O; high - H2O)
5626 INTEGER, PARAMETER :: NGS9=108
5628 INTEGER, INTENT(IN ) :: kts,ktep1
5630 INTEGER, INTENT(IN ) :: LAYTROP
5632 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5633 INTENT(INOUT) :: PFRAC, &
5634 TAUG
5636 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5637 COLH2O, &
5638 FAC00, &
5639 FAC01, &
5640 FAC10, &
5641 FAC11
5643 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5644 JP, &
5645 JT, &
5646 JT1
5648 ! This compiler directive was added to insure private common block storage
5649 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5650 ! carry constants.
5652 ! Compute the optical depth by interpolating in ln(pressure) and
5653 ! temperature.
5654 !cdir novector
5655 DO 2500 LAY = 1, LAYTROP
5656 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(10) + 1
5657 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(10) + 1
5658 DO 2000 IG = 1, NG10
5659 TAUG(NGS9+IG,LAY) = COLH2O(LAY) * &
5660 (FAC00(LAY) * ABSA10(IND0,IG) + &
5661 FAC10(LAY) * ABSA10(IND0+1,IG) + &
5662 FAC01(LAY) * ABSA10(IND1,IG) + &
5663 FAC11(LAY) * ABSA10(IND1+1,IG))
5664 PFRAC(NGS9+IG,LAY) = FRACREFAC10(IG)
5665 2000 CONTINUE
5666 2500 CONTINUE
5668 !cdir novector
5669 DO 3500 LAY = LAYTROP+1, NLAYERS
5670 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(10) + 1
5671 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(10) + 1
5672 DO 3000 IG = 1, NG10
5673 TAUG(NGS9+IG,LAY) = COLH2O(LAY) * &
5674 (FAC00(LAY) * ABSB10(IND0,IG) + &
5675 FAC10(LAY) * ABSB10(IND0+1,IG) + &
5676 FAC01(LAY) * ABSB10(IND1,IG) + &
5677 FAC11(LAY) * ABSB10(IND1+1,IG))
5678 PFRAC(NGS9+IG,LAY) = FRACREFBC10(IG)
5679 3000 CONTINUE
5680 3500 CONTINUE
5682 END SUBROUTINE TAUGB10
5684 !--------------------------------------------------------------------------
5685 SUBROUTINE TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11, &
5686 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
5687 LAYTROP )
5688 !--------------------------------------------------------------------------
5690 ! BAND 11: 1480-1800 cm-1 (low - H2O; high - H2O)
5692 INTEGER, PARAMETER :: NGS10=114
5694 INTEGER, INTENT(IN ) :: kts,ktep1
5696 INTEGER, INTENT(IN ) :: LAYTROP
5698 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5699 INTENT(INOUT) :: PFRAC, &
5700 TAUG
5702 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5703 COLH2O, &
5704 FAC00, &
5705 FAC01, &
5706 FAC10, &
5707 FAC11, &
5708 SELFFAC, &
5709 SELFFRAC
5711 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5712 JP, &
5713 JT, &
5714 JT1, &
5715 INDSELF
5717 ! This compiler directive was added to insure private common block storage
5718 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5719 ! carry constants.
5722 ! Compute the optical depth by interpolating in ln(pressure) and
5723 ! temperature. Below LAYTROP, the water vapor self-continuum
5724 ! is interpolated (in temperature) separately.
5725 !cdir novector
5726 DO 2500 LAY = 1, LAYTROP
5727 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(11) + 1
5728 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(11) + 1
5729 INDS = INDSELF(LAY)
5730 DO 2000 IG = 1, NG11
5731 TAUG(NGS10+IG,LAY) = COLH2O(LAY) * &
5732 (FAC00(LAY) * ABSA11(IND0,IG) + &
5733 FAC10(LAY) * ABSA11(IND0+1,IG) + &
5734 FAC01(LAY) * ABSA11(IND1,IG) + &
5735 FAC11(LAY) * ABSA11(IND1+1,IG) + &
5736 SELFFAC(LAY) * (SELFREFC11(INDS,IG) + &
5737 SELFFRAC(LAY) * &
5738 (SELFREFC11(INDS+1,IG) - SELFREFC11(INDS,IG))))
5739 PFRAC(NGS10+IG,LAY) = FRACREFAC11(IG)
5740 2000 CONTINUE
5741 2500 CONTINUE
5743 !cdir novector
5744 DO 3500 LAY = LAYTROP+1, NLAYERS
5745 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(11) + 1
5746 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(11) + 1
5747 DO 3000 IG = 1, NG11
5748 TAUG(NGS10+IG,LAY) = COLH2O(LAY) * &
5749 (FAC00(LAY) * ABSB11(IND0,IG) + &
5750 FAC10(LAY) * ABSB11(IND0+1,IG) + &
5751 FAC01(LAY) * ABSB11(IND1,IG) + &
5752 FAC11(LAY) * ABSB11(IND1+1,IG))
5753 PFRAC(NGS10+IG,LAY) = FRACREFBC11(IG)
5754 3000 CONTINUE
5755 3500 CONTINUE
5757 END SUBROUTINE TAUGB11
5759 !-----------------------------------------------------------------------------
5760 SUBROUTINE TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11, &
5761 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
5762 LAYTROP )
5763 !-----------------------------------------------------------------------------
5765 ! BAND 12: 1800-2080 cm-1 (low - H2O,CO2; high - nothing)
5767 INTEGER, PARAMETER :: NGS11=122
5769 INTEGER, INTENT(IN ) :: kts,ktep1
5771 INTEGER, INTENT(IN ) :: LAYTROP
5773 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5774 INTENT(INOUT) :: PFRAC, &
5775 TAUG
5777 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5778 COLH2O, &
5779 COLCO2, &
5780 FAC00, &
5781 FAC01, &
5782 FAC10, &
5783 FAC11, &
5784 SELFFAC, &
5785 SELFFRAC
5787 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5788 JP, &
5789 JT, &
5790 JT1, &
5791 INDSELF
5793 ! This compiler directive was added to insure private common block storage
5794 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5795 ! carry constants.
5797 STRRAT1 = 0.009736757
5799 ! Compute the optical depth by interpolating in ln(pressure),
5800 ! temperature, and appropriate species. Below LAYTROP, the water
5801 ! vapor self-continuum is interpolated (in temperature) separately.
5802 !!DIR$ NOVECTOR
5803 !cdir novector
5804 DO 2500 LAY = 1, LAYTROP
5805 SPECCOMB = COLH2O(LAY) + STRRAT1*COLCO2(LAY)
5806 SPECPARM = COLH2O(LAY)/SPECCOMB
5807 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5808 SPECMULT = 8.*(SPECPARM)
5809 JS = 1 + INT(SPECMULT)
5810 FS = MOD(SPECMULT,1.0)
5811 FAC000 = (1. - FS) * FAC00(LAY)
5812 FAC010 = (1. - FS) * FAC10(LAY)
5813 FAC100 = FS * FAC00(LAY)
5814 FAC110 = FS * FAC10(LAY)
5815 FAC001 = (1. - FS) * FAC01(LAY)
5816 FAC011 = (1. - FS) * FAC11(LAY)
5817 FAC101 = FS * FAC01(LAY)
5818 FAC111 = FS * FAC11(LAY)
5819 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(12) + JS
5820 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(12) + JS
5821 INDS = INDSELF(LAY)
5822 !!DIR$ VECTOR
5823 DO 2000 IG = 1, NG12
5824 TAUG(NGS11+IG,LAY) = SPECCOMB * &
5825 (FAC000 * ABSA12(IND0,IG) + &
5826 FAC100 * ABSA12(IND0+1,IG) + &
5827 FAC010 * ABSA12(IND0+9,IG) + &
5828 FAC110 * ABSA12(IND0+10,IG) + &
5829 FAC001 * ABSA12(IND1,IG) + &
5830 FAC101 * ABSA12(IND1+1,IG) + &
5831 FAC011 * ABSA12(IND1+9,IG) + &
5832 FAC111 * ABSA12(IND1+10,IG)) + &
5833 COLH2O(LAY) * &
5834 SELFFAC(LAY) * (SELFREFC12(INDS,IG) + &
5835 SELFFRAC(LAY) * &
5836 (SELFREFC12(INDS+1,IG) - SELFREFC12(INDS,IG)))
5837 PFRAC(NGS11+IG,LAY) = FRACREFAC12(IG,JS) + FS * &
5838 (FRACREFAC12(IG,JS+1) - FRACREFAC12(IG,JS))
5839 2000 CONTINUE
5840 2500 CONTINUE
5842 !cdir novector
5843 DO 3500 LAY = LAYTROP+1, NLAYERS
5844 DO 3000 IG = 1, NG12
5845 TAUG(NGS11+IG,LAY) = 0.0
5846 PFRAC(NGS11+IG,LAY) = 0.0
5847 3000 CONTINUE
5848 3500 CONTINUE
5850 END SUBROUTINE TAUGB12
5852 !-----------------------------------------------------------------------------
5853 SUBROUTINE TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11, &
5854 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
5855 LAYTROP )
5856 !-----------------------------------------------------------------------------
5858 ! BAND 13: 2080-2250 cm-1 (low - H2O,N2O; high - nothing)
5860 INTEGER, PARAMETER :: NGS12=130
5862 INTEGER, INTENT(IN ) :: kts,ktep1
5864 INTEGER, INTENT(IN ) :: LAYTROP
5866 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5867 INTENT(INOUT) :: PFRAC, &
5868 TAUG
5870 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5871 COLH2O, &
5872 COLN2O, &
5873 FAC00, &
5874 FAC01, &
5875 FAC10, &
5876 FAC11, &
5877 SELFFAC, &
5878 SELFFRAC
5880 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5881 JP, &
5882 JT, &
5883 JT1, &
5884 INDSELF
5886 ! This compiler directive was added to insure private common block storage
5887 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5888 ! carry constants.
5890 STRRAT1 = 16658.87
5892 ! Compute the optical depth by interpolating in ln(pressure),
5893 ! temperature, and appropriate species. Below LAYTROP, the water
5894 ! vapor self-continuum is interpolated (in temperature) separately.
5895 DO 2500 LAY = 1, LAYTROP
5896 SPECCOMB = COLH2O(LAY) + STRRAT1*COLN2O(LAY)
5897 SPECPARM = COLH2O(LAY)/SPECCOMB
5898 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
5899 SPECMULT = 8.*(SPECPARM)
5900 JS = 1 + INT(SPECMULT)
5901 FS = MOD(SPECMULT,1.0)
5902 FAC000 = (1. - FS) * FAC00(LAY)
5903 FAC010 = (1. - FS) * FAC10(LAY)
5904 FAC100 = FS * FAC00(LAY)
5905 FAC110 = FS * FAC10(LAY)
5906 FAC001 = (1. - FS) * FAC01(LAY)
5907 FAC011 = (1. - FS) * FAC11(LAY)
5908 FAC101 = FS * FAC01(LAY)
5909 FAC111 = FS * FAC11(LAY)
5910 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(13) + JS
5911 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(13) + JS
5912 INDS = INDSELF(LAY)
5913 DO 2000 IG = 1, NG13
5914 TAUG(NGS12+IG,LAY) = SPECCOMB * &
5915 (FAC000 * ABSA13(IND0,IG) + &
5916 FAC100 * ABSA13(IND0+1,IG) + &
5917 FAC010 * ABSA13(IND0+9,IG) + &
5918 FAC110 * ABSA13(IND0+10,IG) + &
5919 FAC001 * ABSA13(IND1,IG) + &
5920 FAC101 * ABSA13(IND1+1,IG) + &
5921 FAC011 * ABSA13(IND1+9,IG) + &
5922 FAC111 * ABSA13(IND1+10,IG)) + &
5923 COLH2O(LAY) * &
5924 SELFFAC(LAY) * (SELFREFC13(INDS,IG) + &
5925 SELFFRAC(LAY) * &
5926 (SELFREFC13(INDS+1,IG) - SELFREFC13(INDS,IG)))
5927 PFRAC(NGS12+IG,LAY) = FRACREFAC13(IG,JS) + FS * &
5928 (FRACREFAC13(IG,JS+1) - FRACREFAC13(IG,JS))
5929 2000 CONTINUE
5930 2500 CONTINUE
5932 DO 3500 LAY = LAYTROP+1, NLAYERS
5933 DO 3000 IG = 1, NG13
5934 TAUG(NGS12+IG,LAY) = 0.0
5935 PFRAC(NGS12+IG,LAY) = 0.0
5936 3000 CONTINUE
5937 3500 CONTINUE
5940 END SUBROUTINE TAUGB13
5942 !----------------------------------------------------------------------------
5943 SUBROUTINE TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11, &
5944 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
5945 LAYTROP )
5946 !----------------------------------------------------------------------------
5948 ! BAND 14: 2250-2380 cm-1 (low - CO2; high - CO2)
5950 INTEGER, PARAMETER :: NGS13=134
5952 INTEGER, INTENT(IN ) :: kts,ktep1
5954 INTEGER, INTENT(IN ) :: LAYTROP
5956 REAL, DIMENSION( NGPT,kts:ktep1 ), &
5957 INTENT(INOUT) :: PFRAC, &
5958 TAUG
5960 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5961 COLCO2, &
5962 FAC00, &
5963 FAC01, &
5964 FAC10, &
5965 FAC11, &
5966 SELFFAC, &
5967 SELFFRAC
5969 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
5970 JP, &
5971 JT, &
5972 JT1, &
5973 INDSELF
5975 ! This compiler directive was added to insure private common block storage
5976 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
5977 ! carry constants.
5979 ! Compute the optical depth by interpolating in ln(pressure) and
5980 ! temperature. Below LAYTROP, the water vapor self-continuum
5981 ! is interpolated (in temperature) separately.
5982 DO 2500 LAY = 1, LAYTROP
5983 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(14) + 1
5984 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(14) + 1
5985 INDS = INDSELF(LAY)
5986 DO 2000 IG = 1, NG14
5987 TAUG(NGS13+IG,LAY) = COLCO2(LAY) * &
5988 (FAC00(LAY) * ABSA14(IND0,IG) + &
5989 FAC10(LAY) * ABSA14(IND0+1,IG) + &
5990 FAC01(LAY) * ABSA14(IND1,IG) + &
5991 FAC11(LAY) * ABSA14(IND1+1,IG) + &
5992 SELFFAC(LAY) * (SELFREFC14(INDS,IG) + &
5993 SELFFRAC(LAY) * &
5994 (SELFREFC14(INDS+1,IG) - SELFREFC14(INDS,IG))))
5995 PFRAC(NGS13+IG,LAY) = FRACREFAC14(IG)
5996 2000 CONTINUE
5997 2500 CONTINUE
5999 DO 3500 LAY = LAYTROP+1, NLAYERS
6000 IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(14) + 1
6001 IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(14) + 1
6002 DO 3000 IG = 1, NG14
6003 TAUG(NGS13+IG,LAY) = COLCO2(LAY) * &
6004 (FAC00(LAY) * ABSB14(IND0,IG) + &
6005 FAC10(LAY) * ABSB14(IND0+1,IG) + &
6006 FAC01(LAY) * ABSB14(IND1,IG) + &
6007 FAC11(LAY) * ABSB14(IND1+1,IG))
6008 PFRAC(NGS13+IG,LAY) = FRACREFBC14(IG)
6009 3000 CONTINUE
6010 3500 CONTINUE
6012 END SUBROUTINE TAUGB14
6014 !------------------------------------------------------------------------------
6015 SUBROUTINE TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10, &
6016 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF, &
6017 PFRAC,TAUG,LAYTROP )
6018 !------------------------------------------------------------------------------
6020 ! BAND 15: 2380-2600 cm-1 (low - N2O,CO2; high - nothing)
6022 INTEGER, PARAMETER :: NGS14=136
6024 INTEGER, INTENT(IN ) :: kts,ktep1
6026 INTEGER, INTENT(IN ) :: LAYTROP
6028 REAL, DIMENSION( NGPT,kts:ktep1 ), &
6029 INTENT(INOUT) :: PFRAC, &
6030 TAUG
6032 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6033 COLH2O, &
6034 COLCO2, &
6035 COLN2O, &
6036 FAC00, &
6037 FAC01, &
6038 FAC10, &
6039 FAC11, &
6040 SELFFAC, &
6041 SELFFRAC
6043 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6044 JP, &
6045 JT, &
6046 JT1, &
6047 INDSELF
6049 ! This compiler directive was added to insure private common block storage
6050 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
6051 ! carry constants.
6053 STRRAT1 = 0.2883201
6055 ! Compute the optical depth by interpolating in ln(pressure),
6056 ! temperature, and appropriate species. Below LAYTROP, the water
6057 ! vapor self-continuum is interpolated (in temperature) separately.
6058 DO 2500 LAY = 1, LAYTROP
6059 SPECCOMB = COLN2O(LAY) + STRRAT1*COLCO2(LAY)
6060 SPECPARM = COLN2O(LAY)/SPECCOMB
6061 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
6062 SPECMULT = 8.*(SPECPARM)
6063 JS = 1 + INT(SPECMULT)
6064 FS = MOD(SPECMULT,1.0)
6065 FAC000 = (1. - FS) * FAC00(LAY)
6066 FAC010 = (1. - FS) * FAC10(LAY)
6067 FAC100 = FS * FAC00(LAY)
6068 FAC110 = FS * FAC10(LAY)
6069 FAC001 = (1. - FS) * FAC01(LAY)
6070 FAC011 = (1. - FS) * FAC11(LAY)
6071 FAC101 = FS * FAC01(LAY)
6072 FAC111 = FS * FAC11(LAY)
6073 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(15) + JS
6074 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(15) + JS
6075 INDS = INDSELF(LAY)
6076 DO 2000 IG = 1, NG15
6077 TAUG(NGS14+IG,LAY) = SPECCOMB * &
6078 (FAC000 * ABSA15(IND0,IG) + &
6079 FAC100 * ABSA15(IND0+1,IG) + &
6080 FAC010 * ABSA15(IND0+9,IG) + &
6081 FAC110 * ABSA15(IND0+10,IG) + &
6082 FAC001 * ABSA15(IND1,IG) + &
6083 FAC101 * ABSA15(IND1+1,IG) + &
6084 FAC011 * ABSA15(IND1+9,IG) + &
6085 FAC111 * ABSA15(IND1+10,IG)) + &
6086 COLH2O(LAY) * &
6087 SELFFAC(LAY) * (SELFREFC15(INDS,IG) + &
6088 SELFFRAC(LAY) * &
6089 (SELFREFC15(INDS+1,IG) - SELFREFC15(INDS,IG)))
6090 PFRAC(NGS14+IG,LAY) = FRACREFAC15(IG,JS) + FS * &
6091 (FRACREFAC15(IG,JS+1) - FRACREFAC15(IG,JS))
6092 2000 CONTINUE
6093 2500 CONTINUE
6095 DO 3500 LAY = LAYTROP+1, NLAYERS
6096 DO 3000 IG = 1, NG15
6097 TAUG(NGS14+IG,LAY) = 0.0
6098 PFRAC(NGS14+IG,LAY) = 0.0
6099 3000 CONTINUE
6100 3500 CONTINUE
6102 END SUBROUTINE TAUGB15
6104 !-----------------------------------------------------------------------------
6105 SUBROUTINE TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11, &
6106 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6107 LAYTROP )
6108 !-----------------------------------------------------------------------------
6110 ! BAND 16: 2600-3000 cm-1 (low - H2O,CH4; high - nothing)
6112 INTEGER, PARAMETER :: NGS15=138
6114 INTEGER, INTENT(IN ) :: kts,ktep1
6116 INTEGER, INTENT(IN ) :: LAYTROP
6118 REAL, DIMENSION( NGPT,kts:ktep1 ), &
6119 INTENT(INOUT) :: PFRAC, &
6120 TAUG
6122 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6123 COLH2O, &
6124 COLCH4, &
6125 FAC00, &
6126 FAC01, &
6127 FAC10, &
6128 FAC11, &
6129 SELFFAC, &
6130 SELFFRAC
6132 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6133 JP, &
6134 JT, &
6135 JT1, &
6136 INDSELF
6138 ! This compiler directive was added to insure private common block storage
6139 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
6140 ! carry constants.
6142 STRRAT1 = 830.411
6144 ! Compute the optical depth by interpolating in ln(pressure),
6145 ! temperature, and appropriate species. Below LAYTROP, the water
6146 ! vapor self-continuum is interpolated (in temperature) separately.
6147 DO 2500 LAY = 1, LAYTROP
6148 SPECCOMB = COLH2O(LAY) + STRRAT1*COLCH4(LAY)
6149 SPECPARM = COLH2O(LAY)/SPECCOMB
6150 IF (SPECPARM .GE. ONEMINUS) SPECPARM = ONEMINUS
6151 SPECMULT = 8.*(SPECPARM)
6152 JS = 1 + INT(SPECMULT)
6153 FS = MOD(SPECMULT,1.0)
6154 FAC000 = (1. - FS) * FAC00(LAY)
6155 FAC010 = (1. - FS) * FAC10(LAY)
6156 FAC100 = FS * FAC00(LAY)
6157 FAC110 = FS * FAC10(LAY)
6158 FAC001 = (1. - FS) * FAC01(LAY)
6159 FAC011 = (1. - FS) * FAC11(LAY)
6160 FAC101 = FS * FAC01(LAY)
6161 FAC111 = FS * FAC11(LAY)
6162 IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(16) + JS
6163 IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(16) + JS
6164 INDS = INDSELF(LAY)
6165 DO 2000 IG = 1, NG16
6166 TAUG(NGS15+IG,LAY) = SPECCOMB * &
6167 (FAC000 * ABSA16(IND0,IG) + &
6168 FAC100 * ABSA16(IND0+1,IG) + &
6169 FAC010 * ABSA16(IND0+9,IG) + &
6170 FAC110 * ABSA16(IND0+10,IG) + &
6171 FAC001 * ABSA16(IND1,IG) + &
6172 FAC101 * ABSA16(IND1+1,IG) + &
6173 FAC011 * ABSA16(IND1+9,IG) + &
6174 FAC111 * ABSA16(IND1+10,IG)) + &
6175 COLH2O(LAY) * &
6176 SELFFAC(LAY) * (SELFREFC16(INDS,IG) + &
6177 SELFFRAC(LAY) * &
6178 (SELFREFC16(INDS+1,IG) - SELFREFC16(INDS,IG)))
6179 PFRAC(NGS15+IG,LAY) = FRACREFAC16(IG,JS) + FS * &
6180 (FRACREFAC16(IG,JS+1) - FRACREFAC16(IG,JS))
6181 2000 CONTINUE
6182 2500 CONTINUE
6184 DO 3500 LAY = LAYTROP+1, NLAYERS
6185 DO 3000 IG = 1, NG16
6186 TAUG(NGS15+IG,LAY) = 0.0
6187 PFRAC(NGS15+IG,LAY) = 0.0
6188 3000 CONTINUE
6189 3500 CONTINUE
6191 END SUBROUTINE TAUGB16
6194 !-------------------------------------------------------------------------
6195 SUBROUTINE RTRN(kts,ktep1, &
6196 TAVEL, PZ, TZ, CLDFRAC, TAUCLOUD, TOTDFLUX, &
6197 TOTUFLUX, HTR, HTRC, ICLDLYR, ITR, PFRAC, TBOUND, &
6198 SEMISS )
6199 !-------------------------------------------------------------------------
6200 ! RRTM Longwave Radiative Transfer Model
6201 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
6202 !
6203 ! Original version: E. J. Mlawer, et al.
6204 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
6205 !
6206 ! This program calculates the upward fluxes, downward fluxes, and
6207 ! heating rates for an arbitrary clear or cloudy atmosphere. The input
6208 ! to this program is the atmospheric profile, all Planck function
6209 ! information, and the cloud fraction by layer. The diffusivity angle
6210 ! (SECANG=1.66) is used for the angle integration for consistency with
6211 ! the NCAR CCM; the Gaussian weight appropriate to this angle (WTNUM=0.5)
6212 ! is applied here. Note that use of the emissivity angle for the flux
6213 ! integration can cause errors of 1 to 4 W/m2 within cloudy layers.
6214 !-------------------------------------------------------------------------
6216 INTEGER, INTENT(IN ) :: kts,ktep1
6218 INTEGER, DIMENSION( NGPT,kts:ktep1 ), &
6219 INTENT(IN ) :: ITR
6221 REAL, DIMENSION( NGPT,kts:ktep1 ), &
6222 INTENT(IN ) :: PFRAC
6224 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6225 TAVEL
6226 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6227 CLDFRAC, &
6228 TAUCLOUD
6230 REAL, DIMENSION( 0:ktep1 ),INTENT(INOUT):: &
6231 TOTDFLUX, &
6232 TOTUFLUX
6234 REAL, DIMENSION( 0:ktep1 ), INTENT(INOUT) :: &
6235 HTR, &
6236 HTRC
6238 REAL, DIMENSION( 0:ktep1 ), INTENT(IN ) :: &
6239 PZ, &
6240 TZ
6241 INTEGER, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6242 ICLDLYR
6244 REAL, INTENT(IN ) :: TBOUND
6245 REAL, DIMENSION(NBANDS), INTENT(IN ) :: SEMISS
6247 ! LOCAL VAR
6249 REAL, DIMENSION( 0:ktep1 ) :: &
6250 TOTUCLFL, &
6251 TOTDCLFL
6253 REAL, DIMENSION( 0:ktep1 ) :: &
6254 FNET, &
6255 FNETC
6257 INTEGER :: kk
6259 REAL :: CLRNTTOA,CLRNTSRF
6261 ! Parameters
6263 ! INTEGER, PARAMETER :: MXLAY=101
6264 REAL, PARAMETER :: SECANG=1.66
6265 REAL, PARAMETER :: WTNUM=0.5
6267 ! RRTM Definitions
6268 ! Input
6269 ! MXLAY ! Maximum number of model layers
6270 ! NGPT ! Total number of g-point subintervals
6271 ! NBANDS ! Number of longwave spectral bands
6272 ! SECANG ! Diffusivity angle
6273 ! WTNUM ! Weight for radiance to flux conversion
6274 ! NLAYERS ! Number of model layers (plev+1)
6275 ! PAVEL(MXLAY) ! Layer pressures (mb)
6276 ! PZ(0:MXLAY) ! Level (interface) pressures (mb)
6277 ! TAVEL(MXLAY) ! Layer temperatures (K)
6278 ! TZ(0:MXLAY) ! Level (interface) temperatures(mb)
6279 ! TBOUND ! Surface temperature (K)
6280 ! CLDFRAC(MXLAY) ! Layer cloud fraction
6281 ! TAUCLOUD(MXLAY) ! Layer cloud optical depth
6282 ! ITR(NGPT,MXLAY) ! Integer look-up table index
6283 ! PFRAC(NGPT,MXLAY) ! Planck fractions
6284 ! ICLDLYR(MXLAY) ! Flag for cloudy layers
6285 ! ICLD ! Flag for cloudy in column
6286 ! SEMISS(NBANDS) ! Surface emissivities for each band
6287 ! BPADE ! Pade constant
6288 ! TAU ! Clear sky optical depth look-up table
6289 ! TF ! Tau transition function look-up table
6290 ! TRANS ! Clear sky transmittance look-up table
6291 ! Local
6292 ! ABSS(NGPT*MXLAY) ! Gaseous absorptivity
6293 ! ABSCLD(MXLAY) ! Cloud absorptivity
6294 ! ATOT(NGPT*MXLAY) ! Combined gaseous and cloud absorptivity
6295 ! ODCLR(NGPT,MXLAY) ! Clear sky (gaseous) optical depth
6296 ! ODCLD(MXLAY) ! Cloud optical depth
6297 ! EFCLFRAC(MXLAY) ! Effective cloud fraction
6298 ! RADLU(NGPT) ! Upward radiance
6299 ! URAD ! Spectrally summed upward radiance
6300 ! RADCLRU(NGPT) ! Clear sky upward radiance
6301 ! CLRURAD ! Spectrally summed clear sky upward radiance
6302 ! RADLD(NGPT) ! Downward radiance
6303 ! DRAD ! Spectrally summed downward radiance
6304 ! RADCLRD(NGPT) ! Clear sky downward radiance
6305 ! CLRDRAD ! Spectrally summed clear sky downward radianc
6306 ! Output
6307 ! TOTUFLUX(0:MXLAY) ! Upward longwave flux (W/m2)
6308 ! TOTDFLUX(0:MXLAY) ! Downward longwave flux (W/m2)
6309 ! FNET(0:MXLAY) ! Net longwave flux (W/m2)
6310 ! HTR(0:MXLAY) ! Longwave heating rate (K/day)
6311 ! CLRNTTOA ! Clear sky TOA outgoing flux (W/m2)
6312 ! CLRNTSFC ! Clear sky net surface flux (W/m2)
6313 ! TOTUCLFL(0:MXLAY) ! Clear sky upward longwave flux (W/m2)
6314 ! TOTDCLFL(0:MXLAY) ! Clear sky downward longwave flux (W/m2)
6315 ! FNETC(0:MXLAY) ! Clear sky net longwave flux (W/m2)
6316 ! HTRC(0:MXLAY) ! Clear sky longwave heating rate (K/day)
6317 !
6319 ! This compiler directive was added to insure private common block storage
6320 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
6321 ! carry constants.
6323 DIMENSION BBU(NGPT*(ktep1-kts+1)),BBUTOT(NGPT*(ktep1-kts)),BGLEV(NGPT)
6324 DIMENSION PLANKBND(NBANDS),PLNKEMIT(NBANDS)
6325 DIMENSION PLVL(NBANDS,0:ktep1),PLAY(NBANDS,kts:ktep1)
6326 DIMENSION INDLAY(kts:ktep1),INDLEV(0:ktep1)
6327 DIMENSION TLAYFRAC(kts:ktep1),TLEVFRAC(0:ktep1)
6328 DIMENSION ABSS(NGPT*(ktep1-kts+1)),ABSCLD(kts:ktep1-1),ATOT(NGPT*(ktep1-kts))
6329 DIMENSION ODCLR(NGPT,kts:ktep1-1),ODCLD(kts:ktep1-1),EFCLFRAC(kts:ktep1-1)
6330 DIMENSION RADLU(NGPT),RADLD(NGPT)
6331 DIMENSION RADCLRU(NGPT),RADCLRD(NGPT)
6332 DIMENSION SEMIS(NGPT),RADUEMIT(NGPT)
6334 INDBOUND = TBOUND - 159.
6335 TBNDFRAC = TBOUND - INT(TBOUND)
6337 DO 200 LAY = 0, NLAYERS
6338 TOTUFLUX(LAY) = 0.0
6339 TOTDFLUX(LAY) = 0.0
6340 TOTUCLFL(LAY) = 0.0
6341 TOTDCLFL(LAY) = 0.0
6342 INDLEV(LAY) = TZ(LAY) - 159.
6343 TLEVFRAC(LAY) = TZ(LAY) - INT(TZ(LAY))
6344 200 CONTINUE
6346 DO 220 LEV = 1, NLAYERS
6348 IF (ICLDLYR(LEV).EQ.1) THEN
6349 INDLAY(LEV) = TAVEL(LEV) - 159.
6350 TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))
6351 ! Cloudy sky optical depth and absorptivity.
6352 ODCLD(LEV) = SECANG * TAUCLOUD(LEV)
6353 TRANSCLD = EXP(-ODCLD(LEV))
6354 ABSCLD(LEV) = 1. - TRANSCLD
6355 EFCLFRAC(LEV) = ABSCLD(LEV) * CLDFRAC(LEV)
6356 ! Get clear sky optical depth from TAU lookup table
6357 DO 250 IPR = 1, NGPT
6358 IND = ITR(IPR,LEV)
6359 ODCLR(IPR,LEV) = TAU(IND)
6360 250 CONTINUE
6361 ELSE
6362 INDLAY(LEV) = TAVEL(LEV) - 159.
6363 TLAYFRAC(LEV) = TAVEL(LEV) - INT(TAVEL(LEV))
6364 ENDIF
6366 220 CONTINUE
6368 ! SUMPL = 0.0
6369 ! SUMPLEM = 0.0
6370 ! *** Loop over frequency bands.
6371 DO 600 IBAND = 1, NBANDS
6372 DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)
6373 PLANKBND(IBAND) = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + &
6374 TBNDFRAC * DBDTLEV)
6375 DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) - &
6376 TOTPLNK(INDLEV(0),IBAND)
6377 PLVL(IBAND,0) = DELWAVE(IBAND) * (TOTPLNK(INDLEV(0),IBAND) + &
6378 TLEVFRAC(0)*DBDTLEV)
6380 PLNKEMIT(IBAND) = SEMISS(IBAND) * PLANKBND(IBAND)
6381 ! SUMPLEM = SUMPLEM + PLNKEMIT(IBAND)
6382 ! SUMPL = SUMPL + PLANKBND(IBAND)
6384 DO 300 LEV = 1, NLAYERS
6385 ! Calculate the integrated Planck functions at the level and
6386 ! layer temperatures.
6387 DBDTLEV = TOTPLNK(INDLEV(LEV)+1,IBAND) - &
6388 TOTPLNK(INDLEV(LEV),IBAND)
6389 DBDTLAY = TOTPLNK(INDLAY(LEV)+1,IBAND) - &
6390 TOTPLNK(INDLAY(LEV),IBAND)
6391 PLAY(IBAND,LEV) = DELWAVE(IBAND) * &
6392 (TOTPLNK(INDLAY(LEV),IBAND) + TLAYFRAC(LEV) * DBDTLAY)
6393 PLVL(IBAND,LEV) = DELWAVE(IBAND) * &
6394 (TOTPLNK(INDLEV(LEV),IBAND) + TLEVFRAC(LEV) * DBDTLEV)
6395 300 CONTINUE
6396 600 CONTINUE
6398 ! SEMISLW = SUMPLEM / SUMPL
6400 ! *** Initialize for radiative transfer.
6401 DO 500 IPR = 1, NGPT
6402 RADCLRD(IPR) = 0.
6403 RADLD(IPR) = 0.
6404 SEMIS(IPR) = SEMISS(NGB(IPR))
6405 RADUEMIT(IPR) = PFRAC(IPR,1) * PLNKEMIT(NGB(IPR))
6406 BGLEV(IPR) = PFRAC(IPR,NLAYERS) * PLVL(NGB(IPR),NLAYERS)
6407 500 CONTINUE
6410 ! *** DOWNWARD RADIATIVE TRANSFER
6411 ! *** DRAD holds summed radiance for total sky stream
6412 ! *** CLRDRAD holds summed radiance for clear sky stream
6414 ICLDDN = 0
6415 DO 3000 LEV = NLAYERS, 1, -1
6416 DRAD = 0.0
6417 CLRDRAD = 0.0
6419 IF (ICLDLYR(LEV).EQ.1) THEN
6421 ! *** Cloudy layer
6422 ICLDDN = 1
6423 IENT = NGPT * (LEV-1)
6424 DO 2000 IPR = 1, NGPT
6425 INDEX = IENT + IPR
6426 ! Get lookup table index
6427 IND = ITR(IPR,LEV)
6428 ! Add clear sky and cloud optical depths
6429 ODSM = ODCLR(IPR,LEV) + ODCLD(LEV)
6430 FACTOT = ODSM / (BPADE + ODSM)
6431 BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)
6432 DELBGUP = BGLEV(IPR) - BGLAY
6433 ! Get TF from lookup table
6434 TAUF = TF(IND)
6435 BBU(INDEX) = BGLAY + TAUF * DELBGUP
6436 BBUTOT(INDEX) = BGLAY + FACTOT * DELBGUP
6437 BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)
6438 DELBGDN = BGLEV(IPR) - BGLAY
6439 BBD = BGLAY + TAUF * DELBGDN
6440 BBDLEVD = BGLAY + FACTOT * DELBGDN
6441 ! Get clear sky transmittance from lookup table
6442 ABSS(INDEX) = 1. - TRANS(IND)
6443 ATOT(INDEX) = ABSS(INDEX) + ABSCLD(LEV) - &
6444 ABSS(INDEX) * ABSCLD(LEV)
6445 GASSRC = BBD * ABSS(INDEX)
6446 ! Total sky radiance
6447 RADLD(IPR) = RADLD(IPR) - RADLD(IPR) * (ABSS(INDEX) + &
6448 EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC + &
6449 CLDFRAC(LEV) * (BBDLEVD * ATOT(INDEX) - GASSRC)
6450 DRAD = DRAD + RADLD(IPR)
6451 ! Clear sky radiance
6452 RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR)) &
6453 * ABSS(INDEX)
6454 CLRDRAD = CLRDRAD + RADCLRD(IPR)
6455 2000 CONTINUE
6457 ELSE
6459 ! *** Clear layer
6460 IENT = NGPT * (LEV-1)
6461 !DEC$ IVDEP
6462 DO 2100 IPR = 1, NGPT
6463 INDEX = IENT + IPR
6464 IND = ITR(IPR,LEV)
6465 BGLAY = PFRAC(IPR,LEV) * PLAY(NGB(IPR),LEV)
6466 DELBGUP = BGLEV(IPR) - BGLAY
6467 ! Get TF from lookup table
6468 TAUF = TF(IND)
6469 BBU(INDEX) = BGLAY + TAUF * DELBGUP
6470 BGLEV(IPR) = PFRAC(IPR,LEV) * PLVL(NGB(IPR),LEV-1)
6471 DELBGDN = BGLEV(IPR) - BGLAY
6472 BBD = BGLAY + TAUF * DELBGDN
6473 ! Get clear sky transmittance from lookup table
6474 ABSS(INDEX) = 1. - TRANS(IND)
6475 ! Total sky radiance
6476 RADLD(IPR) = RADLD(IPR) + (BBD - RADLD(IPR)) * &
6477 ABSS(INDEX)
6478 DRAD = DRAD + RADLD(IPR)
6479 ! Set clear sky stream to total sky stream as long as layers
6480 ! remain clear. Streams diverge when a cloud is reached.
6481 IF (ICLDDN.EQ.1) THEN
6482 RADCLRD(IPR) = RADCLRD(IPR) + (BBD - RADCLRD(IPR)) * &
6483 ABSS(INDEX)
6484 CLRDRAD = CLRDRAD + RADCLRD(IPR)
6485 ELSE
6486 RADCLRD(IPR) = RADLD(IPR)
6487 CLRDRAD = DRAD
6488 ENDIF
6490 2100 CONTINUE
6492 ENDIF
6494 TOTDFLUX(LEV-1) = DRAD * WTNUM
6495 TOTDCLFL(LEV-1) = CLRDRAD * WTNUM
6497 3000 CONTINUE
6500 ! SPECTRAL EMISSIVITY & REFLECTANCE
6501 ! Include the contribution of spectrally varying longwave emissivity and
6502 ! reflection from the surface to the upward radiative transfer.
6503 ! Note: Spectral and Lambertian reflection are identical for the one angle
6504 ! flux integration used here.
6506 URAD = 0.0
6507 CLRURAD = 0.0
6508 DO 3500 IPR = 1, NGPT
6509 ! Total sky radiance
6510 RADLU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR)) * RADLD(IPR)
6511 URAD = URAD + RADLU(IPR)
6512 ! Clear sky radiance
6513 RADCLRU(IPR) = RADUEMIT(IPR) + (1. - SEMIS(IPR)) &
6514 * RADCLRD(IPR)
6515 CLRURAD = CLRURAD + RADCLRU(IPR)
6516 3500 CONTINUE
6517 TOTUFLUX(0) = URAD * WTNUM
6518 TOTUCLFL(0) = CLRURAD * WTNUM
6521 ! *** UPWARD RADIATIVE TRANSFER
6522 ! *** URAD holds the summed radiance for total sky stream
6523 ! *** CLRURAD holds the summed radiance for clear sky stream
6525 DO 5000 LEV = 1, NLAYERS
6526 URAD = 0.0
6527 CLRURAD = 0.0
6529 ! Check flag for cloud in current layer
6531 IF (ICLDLYR(LEV).EQ.1) THEN
6533 ! *** Cloudy layers
6534 IENT = NGPT * (LEV-1)
6535 DO 4000 IPR = 1, NGPT
6536 INDEX = IENT + IPR
6537 GASSRC = BBU(INDEX) * ABSS(INDEX)
6538 ! Total sky radiance
6539 RADLU(IPR) = RADLU(IPR) - RADLU(IPR) * (ABSS(INDEX) + &
6540 EFCLFRAC(LEV) * (1.-ABSS(INDEX))) + GASSRC + &
6541 CLDFRAC(LEV) * (BBUTOT(INDEX) * ATOT(INDEX) - GASSRC)
6542 URAD = URAD + RADLU(IPR)
6543 ! Clear sky radiance
6544 RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR)) * &
6545 ABSS(INDEX)
6546 CLRURAD = CLRURAD + RADCLRU(IPR)
6547 4000 CONTINUE
6549 ELSE
6551 ! *** Clear layer
6552 IENT = NGPT * (LEV-1)
6553 DO 4100 IPR = 1, NGPT
6554 INDEX = IENT + IPR
6555 ! Total sky radiance
6556 RADLU(IPR) = RADLU(IPR) + (BBU(INDEX)-RADLU(IPR)) * &
6557 ABSS(INDEX)
6558 URAD = URAD + RADLU(IPR)
6559 ! Clear sky radiance
6560 ! Upward clear and total sky streams must remain separate because surface
6561 ! reflectance is different for each.
6562 RADCLRU(IPR) = RADCLRU(IPR) + (BBU(INDEX) - RADCLRU(IPR)) &
6563 * ABSS(INDEX)
6564 CLRURAD = CLRURAD + RADCLRU(IPR)
6565 4100 CONTINUE
6567 ENDIF
6569 TOTUFLUX(LEV) = URAD * WTNUM
6570 TOTUCLFL(LEV) = CLRURAD * WTNUM
6572 5000 CONTINUE
6575 ! *** Convert radiances to fluxes and heating rates for total sky. Calculates
6576 ! clear sky surface and TOA values. To compute clear sky profiles, uncommen
6577 ! relevant lines below.
6578 TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC
6579 TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC
6580 FNET(0) = TOTUFLUX(0) - TOTDFLUX(0)
6581 TOTUCLFL(0) = TOTUCLFL(0) * FLUXFAC
6582 TOTDCLFL(0) = TOTDCLFL(0) * FLUXFAC
6583 FNETC(0) = TOTUCLFL(0) - TOTDCLFL(0)
6584 CLRNTTOA = TOTUCLFL(NLAYERS)
6585 CLRNTSRF = TOTUFLUX(0) - TOTDCLFL(0)
6587 DO 7000 LEV = 1, NLAYERS
6588 TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC
6589 TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC
6590 FNET(LEV) = TOTUFLUX(LEV) - TOTDFLUX(LEV)
6591 TOTUCLFL(LEV) = TOTUCLFL(LEV) * FLUXFAC
6592 TOTDCLFL(LEV) = TOTDCLFL(LEV) * FLUXFAC
6593 FNETC(LEV) = TOTUCLFL(LEV) - TOTDCLFL(LEV)
6594 L = LEV - 1
6595 ! Calculate Heating Rates.
6596 HTR(L) = HEATFAC * (FNET(L) - FNET(LEV)) / (PZ(L) - PZ(LEV))
6597 HTRC(L) = HEATFAC * (FNETC(L) - FNETC(LEV)) / (PZ(L) - PZ(LEV))
6598 7000 CONTINUE
6599 HTR(NLAYERS) = 0.0
6600 HTRC(NLAYERS) = 0.0
6602 END SUBROUTINE RTRN
6604 !---------------------------------------------------------------------------
6605 SUBROUTINE GASABS(kts,ktep1, &
6606 COLDRY,COLH2O,COLCO2,COLO3,COLN2O,COLCH4, &
6607 COLO2,CO2MULT, &
6608 FAC00,FAC01,FAC10,FAC11, &
6609 FORFAC,SELFFAC,SELFFRAC, &
6610 JP,JT,JT1,INDSELF,ITR,WX,PFRAC,TAUG, &
6611 LAYTROP,LAYSWTCH,LAYLOW )
6612 !---------------------------------------------------------------------------
6613 ! RRTM Longwave Radiative Transfer Model
6614 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
6615 !
6616 ! Original version: E. J. Mlawer, et al.
6617 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
6618 !
6619 ! This routine calculates the gaseous optical depths for all 16 longwave
6620 ! spectral bands. The optical depths are used to define the Pade
6621 ! approximation to the function of tau transition from tranparancy to
6622 ! opacity. This function, which varies from 0 to 1, is converted to an
6623 ! integer that will serve as an index for the lookup tables of tau
6624 ! transition function and transmittance used in the radiative transfer.
6625 ! These lookup tables are created on initialization in routine RRTMINIT.
6626 !---------------------------------------------------------------------------
6627 !
6628 ! Definitions
6629 ! NGPT ! Total number of g-point subintervals
6630 ! MXLAY ! Maximum number of model layers
6631 ! SECANG ! Diffusivity angle for flux computation
6632 ! TAU(NGPT,MXLAY) ! Gaseous optical depths
6633 ! NLAYERS ! Number of model layers used in RRTM
6634 ! PAVEL(MXLAY) ! Model layer pressures (mb)
6635 ! PZ(0:MXLAY) ! Model level (interface) pressures (mb)
6636 ! TAVEL(MXLAY) ! Model layer temperatures (K)
6637 ! TZ(0:MXLAY) ! Model level (interface) temperatures (K)
6638 ! TBOUND ! Surface temperature (K)
6639 ! BPADE ! Pade approximation constant (=1./0.278)
6640 ! ITR(NGPT,MXLAY) ! Integer lookup table index
6641 !
6642 ! Parameters
6644 IMPLICIT NONE
6646 REAL, PARAMETER :: SECANG=1.66
6648 INTEGER, INTENT(IN ) :: kts,ktep1
6649 INTEGER, INTENT(IN ) :: LAYTROP,LAYSWTCH,LAYLOW
6651 REAL, DIMENSION( NGPT,kts:ktep1 ), &
6652 INTENT(INOUT) :: PFRAC
6654 REAL, DIMENSION( NGPT,kts:ktep1 ), &
6655 INTENT(INOUT) :: TAUG
6657 REAL, DIMENSION( MAXXSEC,kts:ktep1 ), &
6658 INTENT(IN ) :: WX
6660 INTEGER, DIMENSION( NGPT,kts:ktep1 ), &
6661 INTENT(INOUT) :: ITR
6663 REAL, DIMENSION( kts:ktep1 ), INTENT(IN ) :: &
6664 COLDRY, &
6665 COLH2O, &
6666 COLCO2, &
6667 COLO3, &
6668 COLN2O, &
6669 COLCH4, &
6670 COLO2, &
6671 CO2MULT, &
6672 FAC00, &
6673 FAC01, &
6674 FAC10, &
6675 FAC11, &
6676 FORFAC, &
6677 SELFFAC, &
6678 SELFFRAC
6680 INTEGER, DIMENSION( kts:ktep1 ), INTENT(INOUT) :: &
6681 JP, &
6682 JT, &
6683 JT1, &
6684 INDSELF
6686 INTEGER :: lay,ipr
6687 REAL :: odepth,tff
6689 ! This compiler directive was added to insure private common block storage
6690 ! in multi-tasked mode on a CRAY or SGI for all commons except those that
6691 ! carry constants.
6693 ! **************************************************************************
6695 ! Calculate optical depth for each band
6697 CALL TAUGB1(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11, &
6698 FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6699 LAYTROP)
6700 CALL TAUGB2(kts,ktep1,COLDRY,COLH2O,FAC00,FAC01,FAC10,FAC11, &
6701 FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6702 LAYTROP)
6703 CALL TAUGB3(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
6704 FORFAC,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6705 LAYTROP)
6706 CALL TAUGB4(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
6707 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6708 LAYTROP)
6709 CALL TAUGB5(kts,ktep1,COLH2O,COLCO2,COLO3,FAC00,FAC01,FAC10,FAC11, &
6710 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG, &
6711 LAYTROP)
6712 CALL TAUGB6(kts,ktep1,COLH2O,CO2MULT,FAC00,FAC01,FAC10,FAC11, &
6713 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG, &
6714 LAYTROP)
6715 CALL TAUGB7(kts,ktep1,COLH2O,COLO3,CO2MULT,FAC00,FAC01,FAC10,FAC11,&
6716 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6717 LAYTROP)
6718 CALL TAUGB8(kts,ktep1,COLH2O,COLO3,COLN2O,CO2MULT,FAC00,FAC01,FAC10,&
6719 FAC11,SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,WX,PFRAC,TAUG,&
6720 LAYSWTCH)
6721 CALL TAUGB9(kts,ktep1,COLH2O,COLN2O,COLCH4,FAC00,FAC01,FAC10,FAC11,&
6722 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6723 LAYTROP,LAYSWTCH,LAYLOW)
6724 CALL TAUGB10(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
6725 PFRAC,TAUG,LAYTROP)
6726 CALL TAUGB11(kts,ktep1,COLH2O,FAC00,FAC01,FAC10,FAC11, &
6727 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6728 LAYTROP)
6729 CALL TAUGB12(kts,ktep1,COLH2O,COLCO2,FAC00,FAC01,FAC10,FAC11, &
6730 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6731 LAYTROP)
6732 CALL TAUGB13(kts,ktep1,COLH2O,COLN2O,FAC00,FAC01,FAC10,FAC11, &
6733 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6734 LAYTROP)
6735 CALL TAUGB14(kts,ktep1,COLCO2,FAC00,FAC01,FAC10,FAC11, &
6736 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6737 LAYTROP)
6738 CALL TAUGB15(kts,ktep1,COLH2O,COLCO2,COLN2O,FAC00,FAC01,FAC10,FAC11,&
6739 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6740 LAYTROP)
6741 CALL TAUGB16(kts,ktep1,COLH2O,COLCH4,FAC00,FAC01,FAC10,FAC11, &
6742 SELFFAC,SELFFRAC,JP,JT,JT1,INDSELF,PFRAC,TAUG, &
6743 LAYTROP)
6745 ! Compute the lookup table index from the Pade approximation of the
6746 ! tau transition function, which is derived from the optical depth.
6748 DO 6000 LAY = 1, NLAYERS
6749 DO 5000 IPR = 1, NGPT
6750 ODEPTH = SECANG * TAUG(IPR,LAY)
6751 TFF = ODEPTH/(BPADE+ODEPTH)
6752 IF (ODEPTH.LE.0.) TFF=0.
6753 ITR(IPR,LAY) = INT(5.E3*TFF+0.5)
6754 5000 CONTINUE
6755 6000 CONTINUE
6757 END SUBROUTINE GASABS
6759 !====================================================================
6760 SUBROUTINE rrtminit( &
6761 p_top, allowed_to_read , &
6762 ids, ide, jds, jde, kds, kde, &
6763 ims, ime, jms, jme, kms, kme, &
6764 its, ite, jts, jte, kts, kte )
6765 !--------------------------------------------------------------------
6766 IMPLICIT NONE
6767 !--------------------------------------------------------------------
6769 LOGICAL , INTENT(IN) :: allowed_to_read
6770 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
6771 ims, ime, jms, jme, kms, kme, &
6772 its, ite, jts, jte, kts, kte
6773 REAL, INTENT(IN) :: p_top
6774 ! REAL, PARAMETER :: deltap = 4 ! Pressure interval for buffer layer (hPa)
6776 REAL :: pi
6778 PI = 2.*ASIN(1.)
6779 FLUXFAC = PI * 2.D4
6780 !NLAYERS = kme
6781 NLAYERS = kme + nint(p_top*0.01/deltap)- 1 ! Model levels plus new levels
6783 IF ( allowed_to_read ) THEN
6784 CALL rrtm_lookuptable
6785 ENDIF
6787 END SUBROUTINE rrtminit
6790 ! **************************************************************************
6791 SUBROUTINE rrtm_lookuptable
6792 ! **************************************************************************
6794 USE module_wrf_error
6795 !USE module_dm, ONLY : wrf_dm_bcast_bytes
6796 IMPLICIT NONE
6798 ! RRTM Longwave Radiative Transfer Model
6799 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
6800 !
6801 ! Original version: Michael J. Iacono; July, 1998
6802 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
6803 !
6804 ! This subroutine performs calculations necessary for the initialization
6805 ! of the LW model, RRTM. Lookup tables are computed for use in the LW
6806 ! radiative transfer, and input absorption coefficient data for each
6807 ! spectral band are reduced from 256 g-points to 140 for use in RRTM.
6808 ! **************************************************************************
6810 ! Definitions
6811 ! Arrays for 5000-point look-up tables:
6812 ! TAU Clear-sky optical depth (used in cloudy radiative transfer)
6813 ! TF Tau transition function; i.e. the transition of the Planck
6814 ! function from that for the mean layer temperature to that for
6815 ! the layer boundary temperature as a function of optical depth.
6816 ! The "linear in tau" method is used to make the table.
6817 ! TRANS Transmittance
6818 ! BPADE Inverse of the Pade approximation constant (= 1./0.278)
6820 ! Local
6821 INTEGER :: i,itre,igcsm,ibnd,igc,ind,ig,ipr,iprsm
6822 REAL :: tfn,fp,rtfp,wtsum
6823 LOGICAL :: opened
6824 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
6826 REAL :: WTSM(MG)
6827 CHARACTER*80 errmess
6828 INTEGER rrtm_unit
6830 IF ( wrf_dm_on_monitor() ) THEN
6831 DO i = 10,99
6832 INQUIRE ( i , OPENED = opened )
6833 IF ( .NOT. opened ) THEN
6834 rrtm_unit = i
6835 GOTO 2010
6836 ENDIF
6837 ENDDO
6838 rrtm_unit = -1
6839 2010 CONTINUE
6840 ENDIF
6841 CALL wrf_dm_bcast_bytes ( rrtm_unit , IWORDSIZE )
6842 IF ( rrtm_unit < 0 ) THEN
6843 CALL wrf_error_fatal ( 'module_ra_rrtm: rrtm_lookuptable: Can not '// &
6844 'find unused fortran unit to read in lookup table.' )
6845 ENDIF
6847 ! start data 1
6849 ! **************************************************************************
6850 ! RRTM Longwave Radiative Transfer Model
6851 ! Atmospheric and Environmental Research, Inc., Cambridge, MA
6852 !
6853 ! Original version: E. J. Mlawer, et al.
6854 ! Revision for NCAR CCM: Michael J. Iacono; September, 1998
6855 !
6856 ! This routine contains 16 READ statements that include the
6857 ! absorption coefficients and other data for each of the 16 longwave
6858 ! spectral bands used in RRTM. Here, the data are defined for 16
6859 ! g-points, or sub-intervals, per band. These data are combined and
6860 ! weighted using a mapping procedure in routine RRTMINIT to reduce
6861 ! the total number of g-points from 256 to 140 for use in the CCM.
6862 ! **************************************************************************
6863 IF ( wrf_dm_on_monitor() ) THEN
6864 OPEN(rrtm_unit,FILE='RRTM_DATA', &
6865 FORM='UNFORMATTED',STATUS='OLD',ERR=9009)
6866 ENDIF
6868 ! The array abscoefL1 contains absorption coefs at the 16 chosen g-values
6869 ! for a range of pressure levels > ~100mb and temperatures. The first
6870 ! index in the array, JT, which runs from 1 to 5, corresponds to
6871 ! different temperatures. More specifically, JT = 3 means that the
6872 ! data are for the corresponding TREF for this pressure level,
6873 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30,
6874 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
6875 ! index, JP, runs from 1 to 13 and refers to the corresponding
6876 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
6877 ! The third index, IG, goes from 1 to 16, and tells us which
6878 ! g-interval the absorption coefficients are for.
6882 ! The array abscoefH1 contains absorption coefs at the 16 chosen g-values
6883 ! for a range of pressure levels < ~100mb and temperatures. The first
6884 ! index in the array, JT, which runs from 1 to 5, corresponds to
6885 ! different temperatures. More specifically, JT = 3 means that the
6886 ! data are for the reference temperature TREF for this pressure
6887 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
6888 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
6889 ! The second index, JP, runs from 13 to 59 and refers to the JPth
6890 ! reference pressure level (see taumol.f for the value of these
6891 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
6892 ! and tells us which g-interval the absorption coefficients are for.
6895 ! The array SELFREF1 contains the coefficient of the water vapor
6896 ! self-continuum (including the energy term). The first index
6897 ! refers to temperature in 7.2 degree increments. For instance, &
6898 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
6899 ! etc. The second index runs over the g-channel (1 to 16).
6901 #define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE )
6903 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL1, abscoefH1, SELFREF1
6904 DM_BCAST_MACRO(abscoefL1)
6905 DM_BCAST_MACRO(abscoefH1)
6906 DM_BCAST_MACRO(SELFREF1)
6908 ! **************************************************************************
6909 ! The array abscoefL2 contains absorption coefs at the 16 chosen g-values
6910 ! for a range of pressure levels > ~100mb and temperatures. The first
6911 ! index in the array, JT, which runs from 1 to 5, corresponds to
6912 ! different temperatures. More specifically, JT = 3 means that the
6913 ! data are for the corresponding TREF for this pressure level, &
6914 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
6915 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
6916 ! index, JP, runs from 1 to 13 and refers to the corresponding
6917 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
6918 ! The third index, IG, goes from 1 to 16, and tells us which
6919 ! g-interval the absorption coefficients are for.
6922 ! The array abscoefH2 contains absorption coefs at the 16 chosen g-values
6923 ! for a range of pressure levels < ~100mb and temperatures. The first
6924 ! index in the array, JT, which runs from 1 to 5, corresponds to
6925 ! different temperatures. More specifically, JT = 3 means that the
6926 ! data are for the reference temperature TREF for this pressure
6927 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
6928 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
6929 ! The second index, JP, runs from 13 to 59 and refers to the JPth
6930 ! reference pressure level (see taumol.f for the value of these
6931 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
6932 ! and tells us which g-interval the absorption coefficients are for.
6935 ! The array SELFREF2 contains the coefficient of the water vapor
6936 ! self-continuum (including the energy term). The first index
6937 ! refers to temperature in 7.2 degree increments. For instance, &
6938 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
6939 ! etc. The second index runs over the g-channel (1 to 16).
6941 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL2, abscoefH2, SELFREF2
6942 DM_BCAST_MACRO(abscoefL2)
6943 DM_BCAST_MACRO(abscoefH2)
6944 DM_BCAST_MACRO(SELFREF2)
6946 ! **************************************************************************
6948 ! The array abscoefL3 contains absorption coefs for each of the 16 g-intervals
6949 ! for a range of pressure levels > ~100mb, temperatures, and ratios
6950 ! of water vapor to CO2. The first index in the array, JS, runs
6951 ! from 1 to 10, and corresponds to different water vapor to CO2 ratios, &
6952 ! as expressed through the binary species parameter eta, defined as
6953 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
6954 ! line strength in the band of co2 to that of h2o. For instance, &
6955 ! JS=1 refers to dry air (eta = 0), JS = 10 corresponds to eta = 1.0.
6956 ! The 2nd index in the array, JT, which runs from 1 to 5, corresponds
6957 ! to different temperatures. More specifically, JT = 3 means that the
6958 ! data are for the reference temperature TREF for this pressure
6959 ! level, JT = 2 refers to the temperature
6960 ! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
6961 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
6962 ! to the reference pressure level (e.g. JP = 1 is for a
6963 ! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, &
6964 ! and tells us which g-interval the absorption coefficients are for.
6967 ! The array abscoefH3 contains absorption coefs for each of the 16 g-intervals
6968 ! for a range of pressure levels < ~100mb, temperatures, and ratios
6969 ! of H2O to CO2. The first index in the array, JS, runs from 1 to 5, &
6970 ! and corresponds to different H2O to CO2 ratios, as expressed through
6971 ! the binary species parameter eta, defined as eta = H2O/(H2O+RAT*CO2), &
6972 ! where RAT is the ratio of the integrated line strength in the band
6973 ! of CO2 to that of H2O. For instance, JS=1 refers to no H2O, &
6974 ! JS = 2 corresponds to eta = 0.25, etc. The second index, JT, which
6975 ! runs from 1 to 5, corresponds to different temperatures. More
6976 ! specifically, JT = 3 means that the data are for the corresponding
6977 ! reference temperature TREF for this pressure level, JT = 2 refers
6978 ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
6979 ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and
6980 ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is
6981 ! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to
6982 ! 16, and tells us which g-interval the absorption coefficients are for.
6985 ! The array SELFREF3 contains the coefficient of the water vapor
6986 ! self-continuum (including the energy term). The first index
6987 ! refers to temperature in 7.2 degree increments. For instance, &
6988 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
6989 ! etc. The second index runs over the g-channel (1 to 16).
6991 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL3, abscoefH3, SELFREF3
6992 DM_BCAST_MACRO(abscoefL3)
6993 DM_BCAST_MACRO(abscoefH3)
6994 DM_BCAST_MACRO(SELFREF3)
6996 ! **************************************************************************
6998 ! The array abscoefL4 contains absorption coefs for each of the 16 g-intervals
6999 ! for a range of pressure levels > ~100mb, temperatures, and ratios
7000 ! of water vapor to CO2. The first index in the array, JS, runs
7001 ! from 1 to 9 and corresponds to different water vapor to CO2 ratios, &
7002 ! as expressed through the binary species parameter eta, defined as
7003 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
7004 ! line strength in the band of co2 to that of h2o. For instance, &
7005 ! JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.
7006 ! The 2nd index in the array, JT, which runs from 1 to 5, corresponds
7007 ! to different temperatures. More specifically, JT = 3 means that the
7008 ! data are for the reference temperature TREF for this pressure
7009 ! level, JT = 2 refers to the temperature TREF-15, &
7010 ! JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7011 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7012 ! to the reference pressure level (e.g. JP = 1 is for a
7013 ! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, &
7014 ! and tells us which g-interval the absorption coefficients are for.
7017 ! The array abscoefH4 contains absorption coefs for each of the 16 g-intervals
7018 ! for a range of pressure levels < ~100mb, temperatures, and ratios
7019 ! of O3 to CO2. The first index in the array, JS, runs from 1 to 6, &
7020 ! and corresponds to different O3 to CO2 ratios, as expressed through
7021 ! the binary species parameter eta, defined as eta = O3/(O3+RAT*H2O), &
7022 ! where RAT is the ratio of the integrated line strength in the band
7023 ! of CO2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0)
7024 ! and JS = 5 corresponds to eta = 1.0. The second index, JT, which
7025 ! runs from 1 to 5, corresponds to different temperatures. More
7026 ! specifically, JT = 3 means that the data are for the corresponding
7027 ! reference temperature TREF for this pressure level, JT = 2 refers
7028 ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
7029 ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and
7030 ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is
7031 ! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to
7032 ! 16, and tells us which g-interval the absorption coefficients are for.
7035 ! The array SELFREF4 contains the coefficient of the water vapor
7036 ! self-continuum (including the energy term). The first index
7037 ! refers to temperature in 7.2 degree increments. For instance, &
7038 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7039 ! etc. The second index runs over the g-channel (1 to 16).
7041 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL4, abscoefH4, SELFREF4
7042 DM_BCAST_MACRO(abscoefL4)
7043 DM_BCAST_MACRO(abscoefH4)
7044 DM_BCAST_MACRO(SELFREF4)
7046 ! **************************************************************************
7048 ! The array abscoefL5 contains absorption coefs for each of the 16 g-intervals
7049 ! for a range of pressure levels > ~100mb, temperatures, and ratios
7050 ! of water vapor to CO2. The first index in the array, JS, runs
7051 ! from 1 to 9 and corresponds to different water vapor to CO2 ratios, &
7052 ! as expressed through the binary species parameter eta, defined as
7053 ! eta = h2o/(h20 + (rat) * co2), where rat is the ratio of the integrated
7054 ! line strength in the band of co2 to that of h2o. For instance, &
7055 ! JS=1 refers to dry air (eta = 0), JS = 9 corresponds to eta = 1.0.
7056 ! The 2nd index in the array, JT, which runs from 1 to 5, corresponds
7057 ! to different temperatures. More specifically, JT = 3 means that the
7058 ! data are for the reference temperature TREF for this pressure
7059 ! level, JT = 2 refers to the temperature TREF-15, &
7060 ! JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7061 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7062 ! to the reference pressure level (e.g. JP = 1 is for a
7063 ! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, &
7064 ! and tells us which g-interval the absorption coefficients are for.
7067 ! The array abscoefH5 contains absorption coefs for each of the 16 g-intervals
7068 ! for a range of pressure levels < ~100mb, temperatures, and ratios
7069 ! of O3 to CO2. The first index in the array, JS, runs from 1 to 5, &
7070 ! and corresponds to different O3 to CO2 ratios, as expressed through
7071 ! the binary species parameter eta, defined as eta = O3/(O3+RAT*CO2), &
7072 ! where RAT is the ratio of the integrated line strength in the band
7073 ! of co2 to that of O3. For instance, JS=1 refers to no O3 (eta = 0)
7074 ! and JS = 5 corresponds to eta = 1.0. The second index, JT, which
7075 ! runs from 1 to 5, corresponds to different temperatures. More
7076 ! specifically, JT = 3 means that the data are for the corresponding
7077 ! reference temperature TREF for this pressure level, JT = 2 refers
7078 ! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and
7079 ! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and
7080 ! refers to the corresponding pressure level in PREF (e.g. JP = 13 is
7081 ! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to
7082 ! 16, and tells us which g-interval the absorption coefficients are for.
7085 ! The array SELFREF5 contains the coefficient of the water vapor
7086 ! self-continuum (including the energy term). The first index
7087 ! refers to temperature in 7.2 degree increments. For instance, &
7088 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7089 ! etc. The second index runs over the g-channel (1 to 16).
7091 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL5, abscoefH5, SELFREF5
7092 DM_BCAST_MACRO(abscoefL5)
7093 DM_BCAST_MACRO(abscoefH5)
7094 DM_BCAST_MACRO(SELFREF5)
7096 ! **************************************************************************
7098 ! The array abscoefL6 contains absorption coefs at the 16 chosen g-values
7099 ! for a range of pressure levels > ~100mb and temperatures. The first
7100 ! index in the array, JT, which runs from 1 to 5, corresponds to
7101 ! different temperatures. More specifically, JT = 3 means that the
7102 ! data are for the corresponding TREF for this pressure level, &
7103 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
7104 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
7105 ! index, JP, runs from 1 to 13 and refers to the corresponding
7106 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
7107 ! The third index, IG, goes from 1 to 16, and tells us which
7108 ! g-interval the absorption coefficients are for.
7111 ! The array SELFREF6 contains the coefficient of the water vapor
7112 ! self-continuum (including the energy term). The first index
7113 ! refers to temperature in 7.2 degree increments. For instance, &
7114 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7115 ! etc. The second index runs over the g-channel (1 to 16).
7117 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL6, SELFREF6
7118 DM_BCAST_MACRO(abscoefL6)
7119 DM_BCAST_MACRO(SELFREF6)
7121 ! **************************************************************************
7123 ! The array abscoefL7 contains absorption coefs at the 16 chosen g-values
7124 ! for a range of pressure levels> ~100mb, temperatures, and binary
7125 ! species parameters (see taumol.f for definition). The first
7126 ! index in the array, JS, runs from 1 to 9, and corresponds to
7127 ! different values of the binary species parameter. For instance, &
7128 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7129 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7130 ! in the array, JT, which runs from 1 to 5, corresponds to different
7131 ! temperatures. More specifically, JT = 3 means that the data are for
7132 ! the reference temperature TREF for this pressure level, JT = 2 refers
7133 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7134 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7135 ! to the JPth reference pressure level (see taumol.f for these levels
7136 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7137 ! which g-interval the absorption coefficients are for.
7140 ! The array abscoefH7 contains absorption coefs at the 16 chosen g-values
7141 ! for a range of pressure levels < ~100mb and temperatures. The first
7142 ! index in the array, JT, which runs from 1 to 5, corresponds to
7143 ! different temperatures. More specifically, JT = 3 means that the
7144 ! data are for the reference temperature TREF for this pressure
7145 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7146 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7147 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7148 ! reference pressure level (see taumol.f for the value of these
7149 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7150 ! and tells us which g-interval the absorption coefficients are for.
7153 ! The array SELFREF7 contains the coefficient of the water vapor
7154 ! self-continuum (including the energy term). The first index
7155 ! refers to temperature in 7.2 degree increments. For instance, &
7156 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7157 ! etc. The second index runs over the g-channel (1 to 16).
7159 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL7, abscoefH7, SELFREF7
7160 DM_BCAST_MACRO(abscoefL7)
7161 DM_BCAST_MACRO(abscoefH7)
7162 DM_BCAST_MACRO(SELFREF7)
7164 ! **************************************************************************
7166 ! The array abscoefL8 contains absorption coefs at the 16 chosen g-values
7167 ! for a range of pressure levels > ~100mb and temperatures. The first
7168 ! index in the array, JT, which runs from 1 to 5, corresponds to
7169 ! different temperatures. More specifically, JT = 3 means that the
7170 ! data are for the corresponding TREF for this pressure level, &
7171 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
7172 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
7173 ! index, JP, runs from 1 to 13 and refers to the corresponding
7174 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
7175 ! The third index, IG, goes from 1 to 16, and tells us which
7176 ! g-interval the absorption coefficients are for.
7177 ! The array abscoefL8 contains absorption coef5s at the 16 chosen g-values
7178 ! for a range of pressure levels > ~100mb and temperatures. The first
7179 ! index in the array, JT, which runs from 1 to 5, corresponds to
7180 ! different temperatures. More specifically, JT = 3 means that the
7181 ! data are for the cooresponding TREF for this pressure level, &
7182 ! JT = 2 refers to the temperature
7183 ! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7184 ! is for TREF+30. The second index, JP, runs from 1 to 13 and refers
7185 ! to the corresponding pressure level in PREF (e.g. JP = 1 is for a
7186 ! pressure of 1053.63 mb). The third index, IG, goes from 1 to 16, &
7187 ! and tells us which "g-channel" the absorption coefficients are for.
7190 ! The array abscoefH8 contains absorption coefs at the 16 chosen g-values
7191 ! for a range of pressure levels < ~100mb and temperatures. The first
7192 ! index in the array, JT, which runs from 1 to 5, corresponds to
7193 ! different temperatures. More specifically, JT = 3 means that the
7194 ! data are for the reference temperature TREF for this pressure
7195 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7196 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7197 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7198 ! reference pressure level (see taumol.f for the value of these
7199 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7200 ! and tells us which g-interval the absorption coefficients are for.
7202 !
7203 ! SELFREF8 is the array for the self-continuum.
7204 !
7205 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL8, abscoefH8, SELFREF8
7206 DM_BCAST_MACRO(abscoefL8)
7207 DM_BCAST_MACRO(abscoefH8)
7208 DM_BCAST_MACRO(SELFREF8)
7210 ! **************************************************************************
7212 ! The array abscoefL9 contains absorption coefs at the 16 chosen g-values
7213 ! for a range of pressure levels> ~100mb, temperatures, and binary
7214 ! species parameters (see taumol.f for definition). The first
7215 ! index in the array, JS, runs from 1 to 11, and corresponds to
7216 ! different values of the binary species parameter. For instance, &
7217 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7218 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7219 ! in the array, JT, which runs from 1 to 5, corresponds to different
7220 ! temperatures. More specifically, JT = 3 means that the data are for
7221 ! the reference temperature TREF for this pressure level, JT = 2 refers
7222 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7223 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7224 ! to the JPth reference pressure level (see taumol.f for these levels
7225 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7226 ! which g-interval the absorption coefficients are for.
7229 ! The array abscoefH9 contains absorption coefs at the 16 chosen g-values
7230 ! for a range of pressure levels < ~100mb and temperatures. The first
7231 ! index in the array, JT, which runs from 1 to 5, corresponds to
7232 ! different temperatures. More specifically, JT = 3 means that the
7233 ! data are for the reference temperature TREF for this pressure
7234 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7235 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7236 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7237 ! reference pressure level (see taumol.f for the value of these
7238 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7239 ! and tells us which g-interval the absorption coefficients are for.
7242 ! The array SELFREF9 contains the coefficient of the water vapor
7243 ! self-continuum (including the energy term). The first index
7244 ! refers to temperature in 7.2 degree increments. For instance, &
7245 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7246 ! etc. The second index runs over the g-channel (1 to 16).
7248 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL9, abscoefH9, SELFREF9
7249 DM_BCAST_MACRO(abscoefL9)
7250 DM_BCAST_MACRO(abscoefH9)
7251 DM_BCAST_MACRO(SELFREF9)
7253 ! **************************************************************************
7255 ! The array abscoefL10 contains absorption coefs at the 16 chosen g-values
7256 ! for a range of pressure levels > ~100mb and temperatures. The first
7257 ! index in the array, JT, which runs from 1 to 5, corresponds to
7258 ! different temperatures. More specifically, JT = 3 means that the
7259 ! data are for the corresponding TREF for this pressure level, &
7260 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
7261 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
7262 ! index, JP, runs from 1 to 13 and refers to the corresponding
7263 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
7264 ! The third index, IG, goes from 1 to 16, and tells us which
7265 ! g-interval the absorption coefficients are for.
7268 ! The array abscoefH10 contains absorption coefs at the 16 chosen g-values
7269 ! for a range of pressure levels < ~100mb and temperatures. The first
7270 ! index in the array, JT, which runs from 1 to 5, corresponds to
7271 ! different temperatures. More specifically, JT = 3 means that the
7272 ! data are for the reference temperature TREF for this pressure
7273 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7274 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7275 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7276 ! reference pressure level (see taumol.f for the value of these
7277 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7278 ! and tells us which g-interval the absorption coefficients are for.
7280 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL10, abscoefH10
7281 DM_BCAST_MACRO(abscoefL10)
7282 DM_BCAST_MACRO(abscoefH10)
7284 ! **************************************************************************
7286 ! The array abscoefL11 contains absorption coefs at the 16 chosen g-values
7287 ! for a range of pressure levels > ~100mb and temperatures. The first
7288 ! index in the array, JT, which runs from 1 to 5, corresponds to
7289 ! different temperatures. More specifically, JT = 3 means that the
7290 ! data are for the corresponding TREF for this pressure level, &
7291 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
7292 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
7293 ! index, JP, runs from 1 to 13 and refers to the corresponding
7294 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
7295 ! The third index, IG, goes from 1 to 16, and tells us which
7296 ! g-interval the absorption coefficients are for.
7299 ! The array abscoefH11 contains absorption coefs at the 16 chosen g-values
7300 ! for a range of pressure levels < ~100mb and temperatures. The first
7301 ! index in the array, JT, which runs from 1 to 5, corresponds to
7302 ! different temperatures. More specifically, JT = 3 means that the
7303 ! data are for the reference temperature TREF for this pressure
7304 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7305 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7306 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7307 ! reference pressure level (see taumol.f for the value of these
7308 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7309 ! and tells us which g-interval the absorption coefficients are for.
7312 ! The array SELFREF11 contains the coefficient of the water vapor
7313 ! self-continuum (including the energy term). The first index
7314 ! refers to temperature in 7.2 degree increments. For instance, &
7315 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7316 ! etc. The second index runs over the g-channel (1 to 16).
7318 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL11, abscoefH11, SELFREF11
7319 DM_BCAST_MACRO(abscoefL11)
7320 DM_BCAST_MACRO(abscoefH11)
7321 DM_BCAST_MACRO(SELFREF11)
7323 ! **************************************************************************
7325 ! The array abscoefL12 contains absorption coefs at the 16 chosen g-values
7326 ! for a range of pressure levels> ~100mb, temperatures, and binary
7327 ! species parameters (see taumol.f for definition). The first
7328 ! index in the array, JS, runs from 1 to 9, and corresponds to
7329 ! different values of the binary species parameter. For instance, &
7330 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7331 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7332 ! in the array, JT, which runs from 1 to 5, corresponds to different
7333 ! temperatures. More specifically, JT = 3 means that the data are for
7334 ! the reference temperature TREF for this pressure level, JT = 2 refers
7335 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7336 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7337 ! to the JPth reference pressure level (see taumol.f for these levels
7338 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7339 ! which g-interval the absorption coefficients are for.
7342 ! The array SELFREF12 contains the coefficient of the water vapor
7343 ! self-continuum (including the energy term). The first index
7344 ! refers to temperature in 7.2 degree increments. For instance, &
7345 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7346 ! etc. The second index runs over the g-channel (1 to 16).
7348 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL12, SELFREF12
7349 DM_BCAST_MACRO(abscoefL12)
7350 DM_BCAST_MACRO(SELFREF12)
7352 ! **************************************************************************
7354 ! The array abscoefL13 contains absorption coefs at the 16 chosen g-values
7355 ! for a range of pressure levels> ~100mb, temperatures, and binary
7356 ! species parameters (see taumol.f for definition). The first
7357 ! index in the array, JS, runs from 1 to 9, and corresponds to
7358 ! different values of the binary species parameter. For instance, &
7359 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7360 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7361 ! in the array, JT, which runs from 1 to 5, corresponds to different
7362 ! temperatures. More specifically, JT = 3 means that the data are for
7363 ! the reference temperature TREF for this pressure level, JT = 2 refers
7364 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7365 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7366 ! to the JPth reference pressure level (see taumol.f for these levels
7367 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7368 ! which g-interval the absorption coefficients are for.
7371 ! The array SELFREF13 contains the coefficient of the water vapor
7372 ! self-continuum (including the energy term). The first index
7373 ! refers to temperature in 7.2 degree increments. For instance, &
7374 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7375 ! etc. The second index runs over the g-channel (1 to 16).
7377 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL13, SELFREF13
7378 DM_BCAST_MACRO(abscoefL13)
7379 DM_BCAST_MACRO(SELFREF13)
7381 ! **************************************************************************
7383 ! The array abscoefL14 contains absorption coefs at the 16 chosen g-values
7384 ! for a range of pressure levels > ~100mb and temperatures. The first
7385 ! index in the array, JT, which runs from 1 to 5, corresponds to
7386 ! different temperatures. More specifically, JT = 3 means that the
7387 ! data are for the corresponding TREF for this pressure level, &
7388 ! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, &
7389 ! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
7390 ! index, JP, runs from 1 to 13 and refers to the corresponding
7391 ! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
7392 ! The third index, IG, goes from 1 to 16, and tells us which
7393 ! g-interval the absorption coefficients are for.
7396 ! The array abscoefH14 contains absorption coefs at the 16 chosen g-values
7397 ! for a range of pressure levels < ~100mb and temperatures. The first
7398 ! index in the array, JT, which runs from 1 to 5, corresponds to
7399 ! different temperatures. More specifically, JT = 3 means that the
7400 ! data are for the reference temperature TREF for this pressure
7401 ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
7402 ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
7403 ! The second index, JP, runs from 13 to 59 and refers to the JPth
7404 ! reference pressure level (see taumol.f for the value of these
7405 ! pressure levels in mb). The third index, IG, goes from 1 to 16, &
7406 ! and tells us which g-interval the absorption coefficients are for.
7409 ! The array SELFREF14 contains the coefficient of the water vapor
7410 ! self-continuum (including the energy term). The first index
7411 ! refers to temperature in 7.2 degree increments. For instance, &
7412 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7413 ! etc. The second index runs over the g-channel (1 to 16).
7415 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL14, abscoefH14, SELFREF14
7416 DM_BCAST_MACRO(abscoefL14)
7417 DM_BCAST_MACRO(abscoefH14)
7418 DM_BCAST_MACRO(SELFREF14)
7420 ! **************************************************************************
7422 ! The array abscoefL15 contains absorption coefs at the 16 chosen g-values
7423 ! for a range of pressure levels> ~100mb, temperatures, and binary
7424 ! species parameters (see taumol.f for definition). The first
7425 ! index in the array, JS, runs from 1 to 9, and corresponds to
7426 ! different values of the binary species parameter. For instance, &
7427 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7428 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7429 ! in the array, JT, which runs from 1 to 5, corresponds to different
7430 ! temperatures. More specifically, JT = 3 means that the data are for
7431 ! the reference temperature TREF for this pressure level, JT = 2 refers
7432 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7433 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7434 ! to the JPth reference pressure level (see taumol.f for these levels
7435 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7436 ! which g-interval the absorption coefficients are for.
7439 ! The array SELFREF15 contains the coefficient of the water vapor
7440 ! self-continuum (including the energy term). The first index
7441 ! refers to temperature in 7.2 degree increments. For instance, &
7442 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7443 ! etc. The second index runs over the g-channel (1 to 16).
7445 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL15, SELFREF15
7446 DM_BCAST_MACRO(abscoefL15)
7447 DM_BCAST_MACRO(SELFREF15)
7449 ! **************************************************************************
7451 ! The array abscoefL16 contains absorption coefs at the 16 chosen g-values
7452 ! for a range of pressure levels> ~100mb, temperatures, and binary
7453 ! species parameters (see taumol.f for definition). The first
7454 ! index in the array, JS, runs from 1 to 9, and corresponds to
7455 ! different values of the binary species parameter. For instance, &
7456 ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, &
7457 ! JS = 3 corresponds to the parameter value 2/8, etc. The second index
7458 ! in the array, JT, which runs from 1 to 5, corresponds to different
7459 ! temperatures. More specifically, JT = 3 means that the data are for
7460 ! the reference temperature TREF for this pressure level, JT = 2 refers
7461 ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
7462 ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
7463 ! to the JPth reference pressure level (see taumol.f for these levels
7464 ! in mb). The fourth index, IG, goes from 1 to 16, and indicates
7465 ! which g-interval the absorption coefficients are for.
7468 ! The array SELFREF16 contains the coefficient of the water vapor
7469 ! self-continuum (including the energy term). The first index
7470 ! refers to temperature in 7.2 degree increments. For instance, &
7471 ! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, &
7472 ! etc. The second index runs over the g-channel (1 to 16).
7474 IF ( wrf_dm_on_monitor() ) READ (rrtm_unit,ERR=9010) abscoefL16, SELFREF16
7475 DM_BCAST_MACRO(abscoefL16)
7476 DM_BCAST_MACRO(SELFREF16)
7478 IF ( wrf_dm_on_monitor() ) CLOSE (rrtm_unit)
7480 !-----------------------------------------------------------------------
7484 ! Compute lookup tables for transmittance, tau transition function,
7485 ! and clear sky tau (for the cloudy sky radiative transfer). Tau is
7486 ! computed as a function of the tau transition function, transmittance
7487 ! is calculated as a function of tau, and the tau transition function
7488 ! is calculated using the linear in tau formulation at values of tau
7489 ! above 0.01. TF is approximated as tau/6 for tau < 0.01. All tables
7490 ! are computed at intervals of 0.001. The inverse of the constant used
7491 ! in the Pade approximation to the tau transition function is set to b.
7493 TAU(0) = 0.0
7494 TAU(5000) = 1.E10
7495 TRANS(0) = 1.0
7496 TRANS(5000) = 0.0
7497 TF(0) = 0.0
7498 TF(5000) = 1.0
7499 BPADE=1./0.278
7500 DO 1000 ITRE = 1,4999
7501 TFN = ITRE/5.E3
7502 TAU(ITRE) = BPADE*TFN/(1.-TFN)
7503 TRANS(ITRE) = EXP(-TAU(ITRE))
7504 IF (TAU(ITRE).LT.0.1) THEN
7505 TF(ITRE) = TAU(ITRE)/6.
7506 ELSE
7507 TF(ITRE) = 1.-2.*((1./TAU(ITRE))-(TRANS(ITRE)/(1.-TRANS(ITRE))))
7508 ENDIF
7509 1000 CONTINUE
7510 ! Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)
7511 CORR1(0) = 1.
7512 CORR1(200) = 1.
7513 CORR2(0) = 1.
7514 CORR2(200) = 1.
7515 DO 1200 I = 1,199
7516 FP = 0.005*FLOAT(I)
7517 RTFP = SQRT(FP)
7518 CORR1(I) = RTFP/FP
7519 CORR2(I) = (1.-RTFP)/(1.-FP)
7520 1200 CONTINUE
7522 ! Perform g-point reduction from 16 per band (256 total points) to
7523 ! a band dependant number (140 total points) for all absorption
7524 ! coefficient input data and Planck fraction input data.
7525 ! Compute relative weighting for new g-point combinations.
7527 IGCSM = 0
7528 DO 500 IBND = 1,NBANDS
7529 IPRSM = 0
7530 IF (NGC(IBND).LT.16) THEN
7531 DO 450 IGC = 1,NGC(IBND)
7532 IGCSM = IGCSM + 1
7533 WTSUM = 0.
7534 DO 420 IPR = 1, NGN(IGCSM)
7535 IPRSM = IPRSM + 1
7536 WTSUM = WTSUM + WT(IPRSM)
7537 420 CONTINUE
7538 WTSM(IGC) = WTSUM
7539 450 CONTINUE
7540 DO 400 IG = 1,NG(IBND)
7541 IND = (IBND-1)*16 + IG
7542 RWGT(IND) = WT(IG)/WTSM(NGM(IND))
7543 400 CONTINUE
7544 ELSE
7545 DO 300 IG = 1,NG(IBND)
7546 IGCSM = IGCSM + 1
7547 IND = (IBND-1)*16 + IG
7548 RWGT(IND) = 1.0
7549 300 CONTINUE
7550 ENDIF
7551 500 CONTINUE
7553 ! Reduce g-points for relevant data in each LW spectral band.
7555 CALL CMBGB1 (abscoefL1, abscoefH1, SELFREF1, &
7556 FRACREFA1, FRACREFB1, FORREF1, &
7557 SELFREFC1, FORREFC1, FRACREFAC1, &
7558 FRACREFBC1 &
7559 )
7560 CALL CMBGB2 (abscoefL2, abscoefH2, SELFREF2, &
7561 FRACREFA2, FRACREFB2, FORREF2, &
7562 SELFREFC2, FORREFC2, FRACREFAC2, &
7563 FRACREFBC2 &
7564 )
7565 CALL CMBGB3 (abscoefL3, abscoefH3, SELFREF3, &
7566 FRACREFA3, FRACREFB3, &
7567 FORREF3, ABSN2OA3, ABSN2OB3, &
7568 SELFREFC3, FORREFC3, &
7569 ABSN2OAC3, ABSN2OBC3, FRACREFAC3, FRACREFBC3 &
7570 )
7571 CALL CMBGB4 (abscoefL4, abscoefH4, SELFREF4, &
7572 FRACREFA4, FRACREFB4, &
7573 SELFREFC4, FRACREFAC4, FRACREFBC4 &
7574 )
7575 CALL CMBGB5 (abscoefL5, abscoefH5, SELFREF5, &
7576 FRACREFA5, FRACREFB5, CCL45, &
7577 SELFREFC5, CCL4C5, FRACREFAC5, &
7578 FRACREFBC5 &
7579 )
7580 CALL CMBGB6 (abscoefL6, SELFREF6, &
7581 FRACREFA6, ABSCO26, CFC11ADJ6, CFC126, &
7582 SELFREFC6, ABSCO2C6, CFC11ADJC6, CFC12C6, &
7583 FRACREFAC6 &
7584 )
7585 CALL CMBGB7 (abscoefL7, abscoefH7, SELFREF7, &
7586 FRACREFA7, FRACREFB7, ABSCO27, &
7587 SELFREFC7, ABSCO2C7, FRACREFAC7, &
7588 FRACREFBC7 &
7589 )
7590 CALL CMBGB8 (abscoefL8, abscoefH8, SELFREF8, &
7591 FRACREFA8, FRACREFB8, ABSCO2A8, ABSCO2B8, &
7592 ABSN2OA8, ABSN2OB8, CFC128, CFC22ADJ8, &
7593 SELFREFC8, ABSCO2AC8, ABSCO2BC8, &
7594 ABSN2OAC8, ABSN2OBC8, CFC12C8, CFC22ADJC8, &
7595 FRACREFAC8, FRACREFBC8 &
7596 )
7597 CALL CMBGB9 (abscoefL9, abscoefH9, SELFREF9, &
7598 FRACREFA9, FRACREFB9, ABSN2O9, &
7599 SELFREFC9, ABSN2OC9, FRACREFAC9, &
7600 FRACREFBC9 &
7601 )
7602 CALL CMBGB10(abscoefL10, abscoefH10, &
7603 FRACREFA10, FRACREFB10, &
7604 FRACREFAC10, FRACREFBC10 &
7605 )
7606 CALL CMBGB11(abscoefL11, abscoefH11, SELFREF11, &
7607 FRACREFA11, FRACREFB11, &
7608 SELFREFC11, FRACREFAC11, &
7609 FRACREFBC11 &
7610 )
7611 CALL CMBGB12(abscoefL12, SELFREF12, &
7612 FRACREFA12, &
7613 SELFREFC12, FRACREFAC12 &
7614 )
7615 CALL CMBGB13(abscoefL13, SELFREF13, &
7616 FRACREFA13, &
7617 SELFREFC13, FRACREFAC13 &
7618 )
7619 CALL CMBGB14(abscoefL14, abscoefH14, SELFREF14, &
7620 FRACREFA14, FRACREFB14, &
7621 SELFREFC14, FRACREFAC14, &
7622 FRACREFBC14 &
7623 )
7624 CALL CMBGB15(abscoefL15, SELFREF15, &
7625 FRACREFA15, &
7626 SELFREFC15, FRACREFAC15 &
7627 )
7628 CALL CMBGB16(abscoefL16, SELFREF16, &
7629 FRACREFA16, &
7630 SELFREFC16, FRACREFAC16 &
7631 )
7632 RETURN
7633 9009 CONTINUE
7634 WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error opening RRTM_DATA on unit ',rrtm_unit
7635 CALL wrf_error_fatal(errmess)
7636 RETURN
7637 9010 CONTINUE
7638 WRITE( errmess , '(A,I4)' ) 'module_ra_rrtm: error reading RRTM_DATA on unit ',rrtm_unit
7639 CALL wrf_error_fatal(errmess)
7640 END SUBROUTINE rrtm_lookuptable
7642 !------------------------------------------------------------------
7644 END MODULE module_ra_rrtm