GCC Code Coverage Report

Directory: ./
File: rad/rrtm_rrtm_140gp.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 25 25 100.0%
Branches: 12 14 85.7%
Line Branch Exec Source
1 !***************************************************************************
2 ! *
3 ! RRTM : RAPID RADIATIVE TRANSFER MODEL *
4 ! *
5 ! ATMOSPHERIC AND ENVIRONMENTAL RESEARCH, INC. *
6 ! 840 MEMORIAL DRIVE *
7 ! CAMBRIDGE, MA 02139 *
8 ! *
9 ! ELI J. MLAWER *
10 ! STEVEN J. TAUBMAN~ *
11 ! SHEPARD A. CLOUGH *
12 ! *
13 ! ~currently at GFDL *
14 ! *
15 ! email: mlawer@aer.com *
16 ! *
17 ! The authors wish to acknowledge the contributions of the *
18 ! following people: Patrick D. Brown, Michael J. Iacono, *
19 ! Ronald E. Farren, Luke Chen, Robert Bergstrom. *
20 ! *
21 !***************************************************************************
22 ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 *
23 ! *
24 !***************************************************************************
25 ! *** mji ***
26 ! *** This version of RRTM has been altered to interface with either
27 ! the ECMWF numerical weather prediction model or the ECMWF column
28 ! radiation model (ECRT) package.
29
30 ! Revised, April, 1997; Michael J. Iacono, AER, Inc.
31 ! - initial implementation of RRTM in ECRT code
32 ! Revised, June, 1999; Michael J. Iacono and Eli J. Mlawer, AER, Inc.
33 ! - to implement generalized maximum/random cloud overlap
34
35 120 SUBROUTINE RRTM_RRTM_140GP &
36 & ( KIDIA , KFDIA , KLON , KLEV,&
37 120 & PAER , PAPH , PAP,&
38 & PTS , PTH , PT,&
39 & P_ZEMIS , P_ZEMIW,&
40 & PQ , PCCO2 , POZN,&
41 & PCLDF , PTAUCLD,&
42 & PTAU_LW,&
43 120 & PEMIT , PFLUX , PFLUC, PTCLEAR &
44 & )
45
46 ! *** This program is the driver for RRTM, the AER rapid model.
47 ! For each atmosphere the user wishes to analyze, this routine
48 ! a) calls ECRTATM to read in the atmospheric profile
49 ! b) calls SETCOEF to calculate various quantities needed for
50 ! the radiative transfer algorithm
51 ! c) calls RTRN to do the radiative transfer calculation for
52 ! clear or cloudy sky
53 ! d) writes out the upward, downward, and net flux for each
54 ! level and the heating rate for each layer
55
56 USE PARKIND1 ,ONLY : JPIM ,JPRB
57 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
58 USE YOERAD ,ONLY : NLW
59 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPGPT ,JPLAY ,&
60 & JPINPX
61 !------------------------------Arguments--------------------------------
62
63 ! Input arguments
64
65 IMPLICIT NONE
66 INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes)
67 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers
68 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! First atmosphere index
69 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! Last atmosphere index
70 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
71 REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
72 REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa)
73 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (I_K)
74 REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (I_K)
75 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (I_K)
76 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIS(KLON) ! Non-window surface emissivity
77 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIW(KLON) ! Window surface emissivity
78 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
79 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 ! CO2 mass mixing ratio
80 REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio
81 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) ! Cloud fraction
82 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth
83 !--C.Kleinschmitt
84 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols
85 !--end
86 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) ! Surface LW emissivity
87 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
88 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
89 REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR(KLON) ! clear-sky fraction of column
90 INTEGER(KIND=JPIM) :: ICLDLYR(JPLAY) ! Cloud indicator
91 REAL(KIND=JPRB) :: Z_CLDFRAC(JPLAY) ! Cloud fraction
92 REAL(KIND=JPRB) :: Z_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
93
94 REAL(KIND=JPRB) :: Z_ABSS1 (JPGPT*JPLAY)
95 REAL(KIND=JPRB) :: Z_ATR1 (JPGPT,JPLAY)
96 EQUIVALENCE (Z_ABSS1(1),Z_ATR1(1,1))
97
98 REAL(KIND=JPRB) :: Z_OD (JPGPT,JPLAY)
99
100 REAL(KIND=JPRB) :: Z_TAUSF1(JPGPT*JPLAY)
101 REAL(KIND=JPRB) :: Z_TF1 (JPGPT,JPLAY)
102 EQUIVALENCE (Z_TAUSF1(1),Z_TF1(1,1))
103
104 REAL(KIND=JPRB) :: Z_COLDRY(JPLAY)
105 REAL(KIND=JPRB) :: Z_WKL(JPINPX,JPLAY)
106
107 REAL(KIND=JPRB) :: Z_WX(JPXSEC,JPLAY) ! Amount of trace gases
108
109 REAL(KIND=JPRB) :: Z_CLFNET (0:JPLAY)
110 REAL(KIND=JPRB) :: Z_CLHTR (0:JPLAY)
111 REAL(KIND=JPRB) :: Z_FNET (0:JPLAY)
112 REAL(KIND=JPRB) :: Z_HTR (0:JPLAY)
113 REAL(KIND=JPRB) :: Z_TOTDFLUC(0:JPLAY)
114 REAL(KIND=JPRB) :: Z_TOTDFLUX(0:JPLAY)
115 REAL(KIND=JPRB) :: Z_TOTUFLUC(0:JPLAY)
116 REAL(KIND=JPRB) :: Z_TOTUFLUX(0:JPLAY)
117
118 INTEGER(KIND=JPIM) :: i, icld, iplon, I_K
119 INTEGER(KIND=JPIM) :: ISTART
120 INTEGER(KIND=JPIM) :: IEND
121
122 REAL(KIND=JPRB) :: Z_FLUXFAC, Z_HEATFAC, Z_PI, ZEPSEC, ZTCLEAR
123
124 !- from AER
125 REAL(KIND=JPRB) :: Z_TAUAERL(JPLAY,JPBAND)
126
127 !- from INTFAC
128 REAL(KIND=JPRB) :: Z_FAC00(JPLAY)
129 REAL(KIND=JPRB) :: Z_FAC01(JPLAY)
130 REAL(KIND=JPRB) :: Z_FAC10(JPLAY)
131 REAL(KIND=JPRB) :: Z_FAC11(JPLAY)
132 REAL(KIND=JPRB) :: Z_FORFAC(JPLAY)
133
134 !- from INTIND
135 INTEGER(KIND=JPIM) :: JP(JPLAY)
136 INTEGER(KIND=JPIM) :: JT(JPLAY)
137 INTEGER(KIND=JPIM) :: JT1(JPLAY)
138
139 !- from PRECISE
140 REAL(KIND=JPRB) :: Z_ONEMINUS
141
142 !- from PROFDATA
143 REAL(KIND=JPRB) :: Z_COLH2O(JPLAY)
144 REAL(KIND=JPRB) :: Z_COLCO2(JPLAY)
145 REAL(KIND=JPRB) :: Z_COLO3 (JPLAY)
146 REAL(KIND=JPRB) :: Z_COLN2O(JPLAY)
147 REAL(KIND=JPRB) :: Z_COLCH4(JPLAY)
148 REAL(KIND=JPRB) :: Z_COLO2 (JPLAY)
149 REAL(KIND=JPRB) :: Z_CO2MULT(JPLAY)
150 INTEGER(KIND=JPIM) :: I_LAYTROP
151 INTEGER(KIND=JPIM) :: I_LAYSWTCH
152 INTEGER(KIND=JPIM) :: I_LAYLOW
153
154 !- from PROFILE
155 REAL(KIND=JPRB) :: Z_PAVEL(JPLAY)
156 REAL(KIND=JPRB) :: Z_TAVEL(JPLAY)
157 REAL(KIND=JPRB) :: Z_PZ(0:JPLAY)
158 REAL(KIND=JPRB) :: Z_TZ(0:JPLAY)
159 REAL(KIND=JPRB) :: Z_TBOUND
160 INTEGER(KIND=JPIM) :: I_NLAYERS
161
162 !- from SELF
163 REAL(KIND=JPRB) :: Z_SELFFAC(JPLAY)
164 REAL(KIND=JPRB) :: Z_SELFFRAC(JPLAY)
165 INTEGER(KIND=JPIM) :: INDSELF(JPLAY)
166
167 !- from SP
168 REAL(KIND=JPRB) :: Z_PFRAC(JPGPT,JPLAY)
169
170 !- from SURFACE
171 REAL(KIND=JPRB) :: Z_SEMISS(JPBAND)
172 REAL(KIND=JPRB) :: Z_SEMISLW
173 INTEGER(KIND=JPIM) :: IREFLECT
174 REAL(KIND=JPRB) :: ZHOOK_HANDLE
175
176 INTERFACE
177 SUBROUTINE RRTM_ECRT_140GP &
178 & ( K_IPLON, klon , klev, kcld,&
179 & paer , paph , pap,&
180 & pts , pth , pt,&
181 & P_ZEMIS, P_ZEMIW,&
182 & pq , pcco2, pozn, pcldf, ptaucld, ptclear,&
183 & P_CLDFRAC,P_TAUCLD,&
184 & PTAU_LW,&
185 & P_COLDRY,P_WKL,P_WX,&
186 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT )
187 USE PARKIND1 ,ONLY : JPIM ,JPRB
188 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPLAY ,&
189 & JPINPX
190 USE YOERAD , ONLY : NLW ,NOVLP
191 USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12
192 USE YOESW , ONLY : RAER
193 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
194 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
195 INTEGER(KIND=JPIM),INTENT(IN) :: K_IPLON
196 INTEGER(KIND=JPIM),INTENT(OUT) :: KCLD
197 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV)
198 REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
199 REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
200 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON)
201 REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
202 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
203 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIS(KLON)
204 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIW(KLON)
205 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
206 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2
207 REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV)
208 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV)
209 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND)
210 !--C.Kleinschmitt
211 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols
212 !--end
213 REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR
214 REAL(KIND=JPRB) ,INTENT(OUT) :: P_CLDFRAC(JPLAY)
215 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUCLD(JPLAY,JPBAND)
216 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLDRY(JPLAY)
217 REAL(KIND=JPRB) ,INTENT(OUT) :: P_WKL(JPINPX,JPLAY)
218 REAL(KIND=JPRB) ,INTENT(OUT) :: P_WX(JPXSEC,JPLAY)
219 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUAERL(JPLAY,JPBAND)
220 REAL(KIND=JPRB) ,INTENT(OUT) :: PAVEL(JPLAY)
221 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAVEL(JPLAY)
222 REAL(KIND=JPRB) ,INTENT(OUT) :: PZ(0:JPLAY)
223 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TZ(0:JPLAY)
224 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TBOUND
225 INTEGER(KIND=JPIM),INTENT(OUT) :: K_NLAYERS
226 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISS(JPBAND)
227 INTEGER(KIND=JPIM),INTENT(OUT) :: K_IREFLECT
228 END SUBROUTINE RRTM_ECRT_140GP
229 END INTERFACE
230 INTERFACE
231 SUBROUTINE RRTM_GASABS1A_140GP (KLEV,P_ATR1,P_OD,P_TF1,P_COLDRY,P_WX,&
232 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
233 & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,&
234 & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)
235 USE PARKIND1 ,ONLY : JPIM ,JPRB
236 USE PARRRTM , ONLY : JPLAY ,JPBAND ,JPGPT ,JPXSEC
237 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
238 REAL(KIND=JPRB) ,INTENT(OUT) :: P_ATR1(JPGPT,JPLAY)
239 REAL(KIND=JPRB) ,INTENT(OUT) :: P_OD(JPGPT,JPLAY)
240 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TF1(JPGPT,JPLAY)
241 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(JPLAY)
242 REAL(KIND=JPRB) ,INTENT(IN) :: P_WX(JPXSEC,JPLAY)
243 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUAERL(JPLAY,JPBAND)
244 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
245 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
246 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
247 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
248 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
249 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
250 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
251 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
252 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
253 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
254 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCO2(JPLAY)
255 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
256 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLN2O(JPLAY)
257 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY)
258 REAL(KIND=JPRB) :: P_COLO2(JPLAY)
259 REAL(KIND=JPRB) ,INTENT(IN) :: P_CO2MULT(JPLAY)
260 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
261 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYSWTCH
262 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYLOW
263 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
264 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
265 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
266 REAL(KIND=JPRB) ,INTENT(OUT) :: PFRAC(JPGPT,JPLAY)
267 END SUBROUTINE RRTM_GASABS1A_140GP
268 END INTERFACE
269 INTERFACE
270 SUBROUTINE RRTM_RTRN1A_140GP (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,&
271 & P_OD,P_TAUSF1,P_CLFNET,P_CLHTR,P_FNET,P_HTR,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,&
272 & P_TAVEL,PZ,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW,K_IREFLECT)
273 USE PARKIND1 ,ONLY : JPIM ,JPRB
274 USE PARRRTM , ONLY : JPBAND ,JPGPT ,JPLAY
275 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
276 INTEGER(KIND=JPIM),INTENT(IN) :: K_ISTART
277 INTEGER(KIND=JPIM),INTENT(IN) :: K_IEND
278 INTEGER(KIND=JPIM),INTENT(IN) :: K_ICLDLYR(JPLAY)
279 REAL(KIND=JPRB) ,INTENT(IN) :: P_CLDFRAC(JPLAY)
280 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUCLD(JPLAY,JPBAND)
281 REAL(KIND=JPRB) ,INTENT(IN) :: P_ABSS1(JPGPT*JPLAY)
282 REAL(KIND=JPRB) ,INTENT(IN) :: P_OD(JPGPT,JPLAY)
283 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUSF1(JPGPT*JPLAY)
284 REAL(KIND=JPRB) :: P_CLFNET(0:JPLAY)
285 REAL(KIND=JPRB) :: P_CLHTR(0:JPLAY)
286 REAL(KIND=JPRB) :: P_FNET(0:JPLAY)
287 REAL(KIND=JPRB) :: P_HTR(0:JPLAY)
288 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUC(0:JPLAY)
289 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUX(0:JPLAY)
290 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUC(0:JPLAY)
291 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUX(0:JPLAY)
292 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY)
293 REAL(KIND=JPRB) :: PZ(0:JPLAY)
294 REAL(KIND=JPRB) ,INTENT(IN) :: P_TZ(0:JPLAY)
295 REAL(KIND=JPRB) ,INTENT(IN) :: P_TBOUND
296 REAL(KIND=JPRB) ,INTENT(IN) :: PFRAC(JPGPT,JPLAY)
297 REAL(KIND=JPRB) ,INTENT(IN) :: P_SEMISS(JPBAND)
298 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISLW
299 INTEGER(KIND=JPIM) :: K_IREFLECT
300 END SUBROUTINE RRTM_RTRN1A_140GP
301 END INTERFACE
302 INTERFACE
303 SUBROUTINE RRTM_SETCOEF_140GP (KLEV,P_COLDRY,P_WKL,&
304 & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
305 & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,&
306 & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,PAVEL,P_TAVEL,P_SELFFAC,P_SELFFRAC,K_INDSELF)
307 USE PARKIND1 ,ONLY : JPIM ,JPRB
308 USE PARRRTM , ONLY : JPLAY ,JPINPX
309 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
310 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(JPLAY)
311 REAL(KIND=JPRB) ,INTENT(IN) :: P_WKL(JPINPX,JPLAY)
312 REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC00(JPLAY)
313 REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC01(JPLAY)
314 REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC10(JPLAY)
315 REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC11(JPLAY)
316 REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFAC(JPLAY)
317 INTEGER(KIND=JPIM),INTENT(OUT) :: K_JP(JPLAY)
318 INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT(JPLAY)
319 INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT1(JPLAY)
320 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLH2O(JPLAY)
321 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCO2(JPLAY)
322 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO3(JPLAY)
323 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLN2O(JPLAY)
324 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCH4(JPLAY)
325 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO2(JPLAY)
326 REAL(KIND=JPRB) ,INTENT(OUT) :: P_CO2MULT(JPLAY)
327 INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYTROP
328 INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYSWTCH
329 INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYLOW
330 REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(JPLAY)
331 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY)
332 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFAC(JPLAY)
333 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFRAC(JPLAY)
334 INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDSELF(JPLAY)
335 END SUBROUTINE RRTM_SETCOEF_140GP
336 END INTERFACE
337
338 ! HEATFAC is the factor by which one must multiply delta-flux/
339 ! delta-pressure, with flux in w/m-2 and pressure in mbar, to get
340 ! the heating rate in units of degrees/day. It is equal to
341 ! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
342 ! = (9.8066)(86400)(1e-5)/(1.004)
343
344
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP',0,ZHOOK_HANDLE)
345 ZEPSEC = 1.E-06_JPRB
346 120 Z_ONEMINUS = 1.0_JPRB - ZEPSEC
347 Z_PI = 2.0_JPRB*ASIN(1.0_JPRB)
348 Z_FLUXFAC = Z_PI * 2.D4
349 Z_HEATFAC = 8.4391_JPRB
350
351 ! *** mji ***
352 ! For use with ECRT, this loop is over atmospheres (or longitudes)
353
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO iplon = kidia,kfdia
354
355 ! *** mji ***
356 !- Prepare atmospheric profile from ECRT for use in RRTM, and define
357 ! other RRTM input parameters. Arrays are passed back through the
358 ! existing RRTM commons and arrays.
359 ZTCLEAR=1.0_JPRB
360
361 CALL RRTM_ECRT_140GP &
362 & ( iplon, klon , klev, icld,&
363 & paer , paph , pap,&
364 & pts , pth , pt,&
365 & P_ZEMIS, P_ZEMIW,&
366 & pq , pcco2, pozn, pcldf, ptaucld, ztclear,&
367 & Z_CLDFRAC,Z_TAUCLD,&
368 & PTAU_LW,&
369 & Z_COLDRY,Z_WKL,Z_WX,&
370 119280 & Z_TAUAERL,Z_PAVEL,Z_TAVEL,Z_PZ,Z_TZ,Z_TBOUND,I_NLAYERS,Z_SEMISS,IREFLECT)
371
372 119280 PTCLEAR(iplon)=ztclear
373
374 119280 ISTART = 1
375 119280 IEND = 16
376
377 ! Calculate information needed by the radiative transfer routine
378 ! that is specific to this atmosphere, especially some of the
379 ! coefficients and indices needed to compute the optical depths
380 ! by interpolating data from stored reference atmospheres.
381
382 CALL RRTM_SETCOEF_140GP (KLEV,Z_COLDRY,Z_WKL,&
383 & Z_FAC00,Z_FAC01,Z_FAC10,Z_FAC11,Z_FORFAC,JP,JT,JT1,&
384 & Z_COLH2O,Z_COLCO2,Z_COLO3,Z_COLN2O,Z_COLCH4,Z_COLO2,Z_CO2MULT,&
385 119280 & I_LAYTROP,I_LAYSWTCH,I_LAYLOW,Z_PAVEL,Z_TAVEL,Z_SELFFAC,Z_SELFFRAC,INDSELF)
386
387 CALL RRTM_GASABS1A_140GP (KLEV,Z_ATR1,Z_OD,Z_TF1,Z_COLDRY,Z_WX,&
388 & Z_TAUAERL,Z_FAC00,Z_FAC01,Z_FAC10,Z_FAC11,Z_FORFAC,JP,JT,JT1,Z_ONEMINUS,&
389 & Z_COLH2O,Z_COLCO2,Z_COLO3,Z_COLN2O,Z_COLCH4,Z_COLO2,Z_CO2MULT,&
390 119280 & I_LAYTROP,I_LAYSWTCH,I_LAYLOW,Z_SELFFAC,Z_SELFFRAC,INDSELF,Z_PFRAC)
391
392 !- Call the radiative transfer routine.
393
394 ! *** mji ***
395 ! Check for cloud in column. Use ECRT threshold set as flag icld in
396 ! routine ECRTATM. If icld=1 then column is cloudy, otherwise it is
397 ! clear. Also, set up flag array, icldlyr, for use in radiative
398 ! transfer. Set icldlyr to one for each layer with non-zero cloud
399 ! fraction.
400
401
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_K = 1, KLEV
402
4/4
✓ Branch 0 taken 4539600 times.
✓ Branch 1 taken 112320 times.
✓ Branch 2 taken 1092037 times.
✓ Branch 3 taken 3447563 times.
 4771200 IF (ICLD == 1.AND.Z_CLDFRAC(I_K) > ZEPSEC) THEN
403 1092037 ICLDLYR(I_K) = 1
404 ELSE
405 3559883 ICLDLYR(I_K) = 0
406 ENDIF
407 ENDDO
408
409 ! Clear and cloudy parts of column are treated together in RTRN.
410 ! Clear radiative transfer is done for clear layers and cloudy radiative
411 ! transfer is done for cloudy layers as identified by icldlyr.
412
413 CALL RRTM_RTRN1A_140GP (KLEV,ISTART,IEND,ICLDLYR,Z_CLDFRAC,Z_TAUCLD,Z_ABSS1,&
414 & Z_OD,Z_TAUSF1,Z_CLFNET,Z_CLHTR,Z_FNET,Z_HTR,Z_TOTDFLUC,Z_TOTDFLUX,Z_TOTUFLUC,Z_TOTUFLUX,&
415 119280 & Z_TAVEL,Z_PZ,Z_TZ,Z_TBOUND,Z_PFRAC,Z_SEMISS,Z_SEMISLW,IREFLECT)
416
417 ! *** Pass clear sky and total sky up and down flux profiles to ECRT
418 ! output arrays (zflux, zfluc). Array indexing from bottom to top
419 ! is preserved for ECRT.
420 ! Invert down flux arrays for consistency with ECRT sign conventions.
421
422 119280 pemit(iplon) = Z_SEMISLW
423
2/2
✓ Branch 3 taken 4771200 times.
✓ Branch 4 taken 119280 times.
 5129160 DO i = 0, KLEV
424 4771200 PFLUC(iplon,1,i+1) = Z_TOTUFLUC(i)*Z_FLUXFAC
425 4771200 PFLUC(iplon,2,i+1) = -Z_TOTDFLUC(i)*Z_FLUXFAC
426 4771200 PFLUX(iplon,1,i+1) = Z_TOTUFLUX(i)*Z_FLUXFAC
427 4890480 PFLUX(iplon,2,i+1) = -Z_TOTDFLUX(i)*Z_FLUXFAC
428 ENDDO
429 ENDDO
430
431
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP',1,ZHOOK_HANDLE)
432 120 END SUBROUTINE RRTM_RRTM_140GP
433