GCC Code Coverage Report

Directory: ./
File: rad/rrtm_ecrt_140gp.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 103 118 87.3%
Branches: 41 58 70.7%
Line Branch Exec Source
1 !
2 ! $Id: rrtm_ecrt_140gp.F90 2626 2016-09-15 14:20:56Z musat $
3 !
4 !****************** SUBROUTINE RRTM_ECRT_140GP **************************
5
6 9423120 SUBROUTINE RRTM_ECRT_140GP &
7 & ( K_IPLON, klon , klev, kcld,&
8 119280 & paer , paph , pap,&
9 & pts , pth , pt,&
10 119280 & P_ZEMIS, P_ZEMIW,&
11 & pq , pcco2, pozn, pcldf, ptaucld, ptclear,&
12 & P_CLDFRAC,P_TAUCLD,&
13 119280 & PTAU_LW,&
14 & P_COLDRY,P_WKL,P_WX,&
15 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT )
16
17 ! Reformatted for F90 by JJMorcrette, ECMWF, 980714
18
19 ! Read in atmospheric profile from ECMWF radiation code, and prepare it
20 ! for use in RRTM. Set other RRTM input parameters. Values are passed
21 ! back through existing RRTM arrays and commons.
22
23 !- Modifications
24
25 ! 2000-05-15 Deborah Salmond Speed-up
26
27 USE PARKIND1 ,ONLY : JPIM ,JPRB
28 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
29
30 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPLAY ,&
31 & JPINPX
32 USE YOERAD , ONLY : NLW ,NOVLP
33 !MPL/IM 20160915 on prend GES de phylmd USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12
34 USE YOESW , ONLY : RAER
35
36 !------------------------------Arguments--------------------------------
37
38 IMPLICIT NONE
39
40
41 INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes)
42 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers
43 INTEGER(KIND=JPIM),INTENT(IN) :: K_IPLON
44 INTEGER(KIND=JPIM),INTENT(OUT) :: KCLD
45 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
46 REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
47 REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa)
48 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (K)
49 REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (K)
50 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (K)
51 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIS(KLON) ! Non-window surface emissivity
52 REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIW(KLON) ! Window surface emissivity
53 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
54 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 ! CO2 mass mixing ratio
55 REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio
56 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) ! Cloud fraction
57 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth
58 !--C.Kleinschmitt
59 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols
60 !--end
61 REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR
62 REAL(KIND=JPRB) ,INTENT(OUT) :: P_CLDFRAC(JPLAY) ! Cloud fraction
63 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
64 REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLDRY(JPLAY)
65 REAL(KIND=JPRB) ,INTENT(OUT) :: P_WKL(JPINPX,JPLAY)
66 REAL(KIND=JPRB) ,INTENT(OUT) :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases
67 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUAERL(JPLAY,JPBAND)
68 REAL(KIND=JPRB) ,INTENT(OUT) :: PAVEL(JPLAY)
69 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAVEL(JPLAY)
70 REAL(KIND=JPRB) ,INTENT(OUT) :: PZ(0:JPLAY)
71 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TZ(0:JPLAY)
72 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TBOUND
73 INTEGER(KIND=JPIM),INTENT(OUT) :: K_NLAYERS
74 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISS(JPBAND)
75 INTEGER(KIND=JPIM),INTENT(OUT) :: K_IREFLECT
76 ! real rch4 ! CH4 mass mixing ratio
77 ! real rn2o ! N2O mass mixing ratio
78 ! real rcfc11 ! CFC11 mass mixing ratio
79 ! real rcfc12 ! CFC12 mass mixing ratio
80 !- from AER
81 !- from PROFILE
82 !- from SURFACE
83 REAL(KIND=JPRB) :: ztauaer(5)
84 238560 REAL(KIND=JPRB) :: zc1j(0:klev) ! total cloud from top and level k
85 REAL(KIND=JPRB) :: Z_AMD ! Effective molecular weight of dry air (g/mol)
86 REAL(KIND=JPRB) :: Z_AMW ! Molecular weight of water vapor (g/mol)
87 REAL(KIND=JPRB) :: Z_AMCO2 ! Molecular weight of carbon dioxide (g/mol)
88 REAL(KIND=JPRB) :: Z_AMO ! Molecular weight of ozone (g/mol)
89 REAL(KIND=JPRB) :: Z_AMCH4 ! Molecular weight of methane (g/mol)
90 REAL(KIND=JPRB) :: Z_AMN2O ! Molecular weight of nitrous oxide (g/mol)
91 REAL(KIND=JPRB) :: Z_AMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3
92 REAL(KIND=JPRB) :: Z_AMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2
93 REAL(KIND=JPRB) :: Z_AVGDRO ! Avogadro's number (molecules/mole)
94 REAL(KIND=JPRB) :: Z_GRAVIT ! Gravitational acceleration (cm/sec2)
95
96 ! Atomic weights for conversion from mass to volume mixing ratios; these
97 ! are the same values used in ECRT to assure accurate conversion to vmr
98 data Z_AMD / 28.970_JPRB /
99 data Z_AMW / 18.0154_JPRB /
100 data Z_AMCO2 / 44.011_JPRB /
101 data Z_AMO / 47.9982_JPRB /
102 data Z_AMCH4 / 16.043_JPRB /
103 data Z_AMN2O / 44.013_JPRB /
104 data Z_AMC11 / 137.3686_JPRB /
105 data Z_AMC12 / 120.9140_JPRB /
106 data Z_AVGDRO/ 6.02214E23_JPRB /
107 data Z_GRAVIT/ 9.80665E02_JPRB /
108
109 INTEGER(KIND=JPIM) :: IATM, IMOL, IXMAX, J1, J2, JAE, JB, JK, JL, I_L
110 INTEGER(KIND=JPIM) :: I_NMOL, I_NXMOL
111
112 REAL(KIND=JPRB) :: Z_AMM, ZCLDLY, ZCLEAR, ZCLOUD, ZEPSEC
113 REAL(KIND=JPRB) :: ZHOOK_HANDLE
114
115 !MPL/IM 20160915 on prend GES de phylmd
116 ! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $
117 !
118 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
119 ! veillez \`a n'utiliser que des ! pour les commentaires
120 ! et \`a bien positionner les & des lignes de continuation
121 ! (les placer en colonne 6 et en colonne 73)
122 !
123 !..include cles_phys.h
124 !
125 INTEGER iflag_cycle_diurne
126 LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf
127 LOGICAL ok_limitvrai
128 LOGICAL ok_all_xml
129 LOGICAL ok_lwoff
130 INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
131 REAL co2_ppm, co2_ppm0, solaire
132 !FC
133 REAL Cd_frein
134 LOGICAL ok_suntime_rrtm
135 REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12
136 REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act
137 REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
138 !IM ajout CFMIP2/CMIP5
139 REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
140 REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per
141
142 !OM ---> correction du bilan d'eau global
143 !OM Correction sur precip KE
144 REAL cvl_corr
145 !OM Fonte calotte dans bilan eau
146 LOGICAL ok_lic_melt
147 !OB Depot de vapeur d eau sur la calotte pour le bilan eau
148 LOGICAL ok_lic_cond
149
150 !IM simulateur ISCCP
151 INTEGER top_height, overlap
152 !IM seuils cdrm, cdrh
153 REAL cdmmax, cdhmax
154 !IM param. stabilite s/ terres et en dehors
155 REAL ksta, ksta_ter, f_ri_cd_min
156 !IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
157 LOGICAL ok_kzmin
158 !IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif -
159 ! pour regler l albedo sur ocean
160 REAL pbl_lmixmin_alpha
161 REAL fmagic, pmagic
162 ! Hauteur (imposee) du contenu en eau du sol
163 REAL qsol0,albsno0,evap0
164 ! Frottement au sol (Cdrag)
165 Real f_cdrag_ter,f_cdrag_oce
166 REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce
167 REAL z0m_seaice,z0h_seaice
168 INTEGER iflag_gusts,iflag_z0_oce
169
170 ! Rugoro
171 Real f_rugoro,z0min
172
173 ! tau_gl : constante de rappel de la temperature a la surface de la glace
174 REAL tau_gl
175
176 !IM lev_histhf : niveau sorties 6h
177 !IM lev_histday : niveau sorties journalieres
178 !IM lev_histmth : niveau sorties mensuelles
179 !IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien
180 ! sur 17 niveaux de pression
181 INTEGER lev_histhf, lev_histday, lev_histmth
182 INTEGER lev_histdayNMC
183 Integer lev_histins, lev_histLES
184 !IM ok_histNMC : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
185 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
186 !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
187 LOGICAL ok_histNMC(3)
188 INTEGER levout_histNMC(3)
189 REAL freq_outNMC(3) , freq_calNMC(3)
190 CHARACTER(len=4) type_run
191 ! aer_type: pour utiliser un fichier constant dans readaerosol
192 CHARACTER(len=8) :: aer_type
193 LOGICAL ok_regdyn
194 REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
195 REAL ecrit_ins, ecrit_hf, ecrit_day
196 REAL ecrit_mth, ecrit_tra, ecrit_reg
197 REAL ecrit_LES
198 REAL freq_ISCCP, ecrit_ISCCP
199 REAL freq_COSP, freq_AIRS
200 LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
201 LOGICAL :: ok_airs
202 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
203 LOGICAL :: ok_chlorophyll
204 LOGICAL :: ok_strato
205 LOGICAL :: ok_hines, ok_gwd_rando
206 LOGICAL :: ok_qch4
207 LOGICAL :: ok_conserv_q
208 LOGICAL :: adjust_tropopause
209 LOGICAL :: ok_daily_climoz
210 ! flag to bypass or not the phytrac module
211 INTEGER :: iflag_phytrac
212
213 COMMON/clesphys/ &
214 ! REAL FIRST
215 & co2_ppm, solaire &
216 & , RCO2, RCH4, RN2O, RCFC11, RCFC12 &
217 & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act &
218 & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per &
219 & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
220 & , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per &
221 & , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha &
222 & , fmagic, pmagic &
223 & , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl &
224 & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce &
225 & , z0m_seaice,z0h_seaice &
226 & , freq_outNMC, freq_calNMC &
227 & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins &
228 & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS &
229 & , cvl_corr &
230 & , qsol0,albsno0,evap0 &
231 & , co2_ppm0 &
232 !FC
233 & , Cd_frein &
234 & , ecrit_LES &
235 & , ecrit_ins, ecrit_hf, ecrit_day &
236 & , ecrit_mth, ecrit_tra, ecrit_reg &
237 ! THEN INTEGER AND LOGICALS
238 & , top_height &
239 & , iflag_cycle_diurne, soil_model, new_oliq &
240 & , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad &
241 & , iflag_con, nbapp_cv, nbapp_wk &
242 & , iflag_ener_conserv &
243 & , ok_suntime_rrtm &
244 & , overlap &
245 & , ok_kzmin &
246 & , lev_histhf, lev_histday, lev_histmth &
247 & , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC &
248 & , ok_histNMC &
249 & , type_run, ok_regdyn, ok_cosp, ok_airs &
250 & , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP &
251 & , ip_ebil_phy &
252 & , iflag_gusts ,iflag_z0_oce &
253 & , ok_lic_melt, ok_lic_cond, aer_type &
254 & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 &
255 & , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo &
256 & , ok_chlorophyll,ok_conserv_q, adjust_tropopause &
257 & , ok_daily_climoz, ok_all_xml, ok_lwoff &
258 & , iflag_phytrac
259
260 save /clesphys/
261 !$OMP THREADPRIVATE(/clesphys/)
262 ! ***
263
264 ! *** mji
265 ! Initialize all molecular amounts and aerosol optical depths to zero here,
266 ! then pass ECRT amounts into RRTM arrays below.
267
268 ! DATA ZWKL /MAXPRDW*0.0/
269 ! DATA ZWX /MAXPROD*0.0/
270 ! DATA KREFLECT /0/
271
272 ! Activate cross section molecules:
273 ! NXMOL - number of cross-sections input by user
274 ! IXINDX(I) - index of cross-section molecule corresponding to Ith
275 ! cross-section specified by user
276 ! = 0 -- not allowed in RRTM
277 ! = 1 -- CCL4
278 ! = 2 -- CFC11
279 ! = 3 -- CFC12
280 ! = 4 -- CFC22
281 ! DATA KXMOL /2/
282 ! DATA KXINDX /0,2,3,0,31*0/
283
284 ! IREFLECT=KREFLECT
285 ! NXMOL=KXMOL
286
287
1/2
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
 119280 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',0,ZHOOK_HANDLE)
288 119280 K_IREFLECT=0
289 I_NXMOL=2
290
291
2/2
✓ Branch 0 taken 4174800 times.
✓ Branch 1 taken 119280 times.
 4294080 DO J1=1,35
292 ! IXINDX(J1)=0
293
2/2
✓ Branch 0 taken 162817200 times.
✓ Branch 1 taken 4174800 times.
 167111280 DO J2=1,KLEV
294 166992000 P_WKL(J1,J2)=0.0_JPRB
295 ENDDO
296 ENDDO
297 !IXINDX(2)=2
298 !IXINDX(3)=3
299
300 ! Set parameters needed for RRTM execution:
301 IATM = 0
302 ! IXSECT = 1
303 ! NUMANGS = 0
304 ! IOUT = -1
305 IXMAX = 4
306
307 ! Bands 6,7,8 are considered the 'window' and allowed to have a
308 ! different surface emissivity (as in ECMWF). Eli wrote this part....
309 119280 P_SEMISS(1) = P_ZEMIS(K_IPLON)
310 119280 P_SEMISS(2) = P_ZEMIS(K_IPLON)
311 119280 P_SEMISS(3) = P_ZEMIS(K_IPLON)
312 119280 P_SEMISS(4) = P_ZEMIS(K_IPLON)
313 119280 P_SEMISS(5) = P_ZEMIS(K_IPLON)
314 119280 P_SEMISS(6) = P_ZEMIW(K_IPLON)
315 119280 P_SEMISS(7) = P_ZEMIW(K_IPLON)
316 119280 P_SEMISS(8) = P_ZEMIW(K_IPLON)
317 119280 P_SEMISS(9) = P_ZEMIS(K_IPLON)
318 119280 P_SEMISS(10) = P_ZEMIS(K_IPLON)
319 119280 P_SEMISS(11) = P_ZEMIS(K_IPLON)
320 119280 P_SEMISS(12) = P_ZEMIS(K_IPLON)
321 119280 P_SEMISS(13) = P_ZEMIS(K_IPLON)
322 119280 P_SEMISS(14) = P_ZEMIS(K_IPLON)
323 119280 P_SEMISS(15) = P_ZEMIS(K_IPLON)
324 119280 P_SEMISS(16) = P_ZEMIS(K_IPLON)
325
326 ! Set surface temperature.
327
328 119280 P_TBOUND = pts(K_IPLON)
329
330 ! Install ECRT arrays into RRTM arrays for pressure, temperature,
331 ! and molecular amounts. Pressures are converted from Pascals
332 ! (ECRT) to mb (RRTM). H2O, CO2, O3 and trace gas amounts are
333 ! converted from mass mixing ratio to volume mixing ratio. CO2
334 ! converted with same dry air and CO2 molecular weights used in
335 ! ECRT to assure correct conversion back to the proper CO2 vmr.
336 ! The dry air column COLDRY (in molec/cm2) is calculated from
337 ! the level pressures PZ (in mb) based on the hydrostatic equation
338 ! and includes a correction to account for H2O in the layer. The
339 ! molecular weight of moist air (amm) is calculated for each layer.
340 ! Note: RRTM levels count from bottom to top, while the ECRT input
341 ! variables count from the top down and must be reversed here.
342
343 119280 K_NLAYERS = klev
344 I_NMOL = 6
345 119280 PZ(0) = paph(K_IPLON,klev+1)/100._JPRB
346 119280 P_TZ(0) = pth(K_IPLON,klev+1)
347
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 4651920 times.
 4771200 DO I_L = 1, KLEV
348 4651920 PAVEL(I_L) = pap(K_IPLON,KLEV-I_L+1)/100._JPRB
349 4651920 P_TAVEL(I_L) = pt(K_IPLON,KLEV-I_L+1)
350 4651920 PZ(I_L) = paph(K_IPLON,KLEV-I_L+1)/100._JPRB
351 4651920 P_TZ(I_L) = pth(K_IPLON,KLEV-I_L+1)
352 4651920 P_WKL(1,I_L) = pq(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMW
353 4651920 P_WKL(2,I_L) = pcco2*Z_AMD/Z_AMCO2
354 4651920 P_WKL(3,I_L) = pozn(K_IPLON,KLEV-I_L+1)*Z_AMD/Z_AMO
355 4651920 P_WKL(4,I_L) = rn2o*Z_AMD/Z_AMN2O
356 4651920 P_WKL(6,I_L) = rch4*Z_AMD/Z_AMCH4
357 4651920 Z_AMM = (1-P_WKL(1,I_L))*Z_AMD + P_WKL(1,I_L)*Z_AMW
358 4771200 P_COLDRY(I_L) = (PZ(I_L-1)-PZ(I_L))*1.E3_JPRB*Z_AVGDRO/(Z_GRAVIT*Z_AMM*(1+P_WKL(1,I_L)))
359 ENDDO
360
361 !- Fill RRTM aerosol arrays with operational ECMWF aerosols,
362 ! do the mixing and distribute over the 16 spectral intervals
363
364
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 4651920 times.
 4771200 DO I_L=1,KLEV
365 4651920 JK=KLEV-I_L+1
366 ! DO JAE=1,5
367 JAE=1
368 ZTAUAER(JAE) =&
369 & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
370 & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
371 4651920 & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK)
372 4651920 P_TAUAERL(I_L, 1)=ZTAUAER(1)
373 4651920 P_TAUAERL(I_L, 2)=ZTAUAER(1)
374 JAE=2
375 ZTAUAER(JAE) =&
376 & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
377 & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
378 4651920 & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK)
379 4651920 P_TAUAERL(I_L, 3)=ZTAUAER(2)
380 4651920 P_TAUAERL(I_L, 4)=ZTAUAER(2)
381 4651920 P_TAUAERL(I_L, 5)=ZTAUAER(2)
382 JAE=3
383 ZTAUAER(JAE) =&
384 & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
385 & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
386 4651920 & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK)
387 4651920 P_TAUAERL(I_L, 6)=ZTAUAER(3)
388 4651920 P_TAUAERL(I_L, 8)=ZTAUAER(3)
389 4651920 P_TAUAERL(I_L, 9)=ZTAUAER(3)
390 JAE=4
391 ZTAUAER(JAE) =&
392 & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
393 & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
394 4651920 & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK)
395 4651920 P_TAUAERL(I_L, 7)=ZTAUAER(4)
396 JAE=5
397 ZTAUAER(JAE) =&
398 & RAER(JAE,1)*PAER(K_IPLON,1,JK)+RAER(JAE,2)*PAER(K_IPLON,2,JK)&
399 & +RAER(JAE,3)*PAER(K_IPLON,3,JK)+RAER(JAE,4)*PAER(K_IPLON,4,JK)&
400 4651920 & +RAER(JAE,5)*PAER(K_IPLON,5,JK)+RAER(JAE,6)*PAER(K_IPLON,6,JK)
401 ! END DO
402 4651920 P_TAUAERL(I_L,10)=ZTAUAER(5)
403 4651920 P_TAUAERL(I_L,11)=ZTAUAER(5)
404 4651920 P_TAUAERL(I_L,12)=ZTAUAER(5)
405 4651920 P_TAUAERL(I_L,13)=ZTAUAER(5)
406 4651920 P_TAUAERL(I_L,14)=ZTAUAER(5)
407 4651920 P_TAUAERL(I_L,15)=ZTAUAER(5)
408 4771200 P_TAUAERL(I_L,16)=ZTAUAER(5)
409 ENDDO
410 !--Use LW AOD from own Mie calculations (C. Kleinschmitt)
411
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 4651920 times.
 4771200 DO I_L=1,KLEV
412 4651920 JK=KLEV-I_L+1
413
2/2
✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 4651920 times.
 79201920 DO JAE=1, NLW
414 79082640 P_TAUAERL(I_L,JAE) = MAX( PTAU_LW(K_IPLON, JK, JAE), 1e-30 )
415 ENDDO
416 ENDDO
417 !--end C. Kleinschmitt
418
419
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO J2=1,KLEV
420
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 4651920 times.
 23378880 DO J1=1,JPXSEC
421 23259600 P_WX(J1,J2)=0.0_JPRB
422 ENDDO
423 ENDDO
424
425
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO I_L = 1, KLEV
426 !- Set cross section molecule amounts from ECRT; convert to vmr
427 4651920 P_WX(2,I_L) = rcfc11*Z_AMD/Z_AMC11
428 4651920 P_WX(3,I_L) = rcfc12*Z_AMD/Z_AMC12
429 4651920 P_WX(2,I_L) = P_COLDRY(I_L) * P_WX(2,I_L) * 1.E-20_JPRB
430 4651920 P_WX(3,I_L) = P_COLDRY(I_L) * P_WX(3,I_L) * 1.E-20_JPRB
431
432 !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to
433 ! molec/cm2 based on COLDRY for use in RRTM
434
435
2/2
✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 4651920 times.
 32682720 DO IMOL = 1, I_NMOL
436 32563440 P_WKL(IMOL,I_L) = P_COLDRY(I_L) * P_WKL(IMOL,I_L)
437 ENDDO
438
439 ! DO IX = 1,JPXSEC
440 ! IF (IXINDX(IX) /= 0) THEN
441 ! WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20_JPRB
442 ! ENDIF
443 ! END DO
444
445 ENDDO
446
447 !- Approximate treatment for various cloud overlaps
448 ZCLEAR=1.0_JPRB
449 ZCLOUD=0.0_JPRB
450 119280 ZC1J(0)=0.0_JPRB
451 ZEPSEC=1.E-03_JPRB
452 JL=K_IPLON
453
454 !++MODIFCODE
455
1/4
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 119280 IF ((NOVLP == 1).OR.(NOVLP ==6).OR.(NOVLP ==8)) THEN
456 !--MODIFCODE
457
458
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
 4771200 DO JK=1,KLEV
459
2/2
✓ Branch 0 taken 1092037 times.
✓ Branch 1 taken 3559883 times.
 4771200 IF (pcldf(JL,JK) > ZEPSEC) THEN
460 ZCLDLY=pcldf(JL,JK)
461 ZCLEAR=ZCLEAR &
462 & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
463 1092037 & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC ))
464 ZCLOUD = ZCLDLY
465 1092037 ZC1J(JK)= 1.0_JPRB - ZCLEAR
466 ELSE
467 ZCLDLY=0.0_JPRB
468 ZCLEAR=ZCLEAR &
469 & *(1.0_JPRB-MAX( ZCLDLY , ZCLOUD ))&
470 3559883 & /(1.0_JPRB-MIN( ZCLOUD , 1.0_JPRB-ZEPSEC ))
471 ZCLOUD = ZCLDLY
472 3559883 ZC1J(JK)= 1.0_JPRB - ZCLEAR
473 ENDIF
474 ENDDO
475
476 !++MODIFCODE
477 ✗ ELSEIF ((NOVLP == 2).OR.(NOVLP ==7)) THEN
478 !--MODIFCODE
479
480 ✗ DO JK=1,KLEV
481 ✗ IF (pcldf(JL,JK) > ZEPSEC) THEN
482 ZCLDLY=pcldf(JL,JK)
483 ✗ ZCLOUD = MAX( ZCLDLY , ZCLOUD )
484 ✗ ZC1J(JK) = ZCLOUD
485 ELSE
486 ZCLDLY=0.0_JPRB
487 ✗ ZCLOUD = MAX( ZCLDLY , ZCLOUD )
488 ✗ ZC1J(JK) = ZCLOUD
489 ENDIF
490 ENDDO
491
492 !++MODIFCODE
493 ✗ ELSEIF ((NOVLP == 3).OR.(NOVLP ==5)) THEN
494 !--MODIFCODE
495
496 ✗ DO JK=1,KLEV
497 ✗ IF (pcldf(JL,JK) > ZEPSEC) THEN
498 ZCLDLY=pcldf(JL,JK)
499 ✗ ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
500 ✗ ZCLOUD = 1.0_JPRB - ZCLEAR
501 ✗ ZC1J(JK) = ZCLOUD
502 ELSE
503 ZCLDLY=0.0_JPRB
504 ZCLEAR = ZCLEAR * (1.0_JPRB-ZCLDLY)
505 ✗ ZCLOUD = 1.0_JPRB - ZCLEAR
506 ✗ ZC1J(JK) = ZCLOUD
507 ENDIF
508 ENDDO
509
510 ELSEIF (NOVLP == 4) THEN
511
512 ENDIF
513 119280 PTCLEAR=1.0_JPRB-ZC1J(KLEV)
514
515 ! Transfer cloud fraction and cloud optical depth to RRTM arrays;
516 ! invert array index for pcldf to go from bottom to top for RRTM
517
518 !- clear-sky column
519
2/2
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 116400 times.
 119280 IF (PTCLEAR > 1.0_JPRB-ZEPSEC) THEN
520 2880 KCLD=0
521
2/2
✓ Branch 0 taken 2880 times.
✓ Branch 1 taken 112320 times.
 115200 DO I_L = 1, KLEV
522 115200 P_CLDFRAC(I_L) = 0.0_JPRB
523 ENDDO
524
2/2
✓ Branch 0 taken 46080 times.
✓ Branch 1 taken 2880 times.
 48960 DO JB=1,JPBAND
525
2/2
✓ Branch 0 taken 1797120 times.
✓ Branch 1 taken 46080 times.
 1846080 DO I_L=1,KLEV
526 1843200 P_TAUCLD(I_L,JB) = 0.0_JPRB
527 ENDDO
528 ENDDO
529
530 ELSE
531
532 !- cloudy column
533 ! The diffusivity factor (Savijarvi, 1997) on the cloud optical
534 ! thickness TAUCLD has already been applied in RADLSW
535
536 116400 KCLD=1
537
2/2
✓ Branch 0 taken 116400 times.
✓ Branch 1 taken 4539600 times.
 4656000 DO I_L=1,KLEV
538 4656000 P_CLDFRAC(I_L) = pcldf(K_IPLON,I_L)
539 ENDDO
540
2/2
✓ Branch 0 taken 116400 times.
✓ Branch 1 taken 1862400 times.
 1978800 DO JB=1,JPBAND
541
2/2
✓ Branch 0 taken 72633600 times.
✓ Branch 1 taken 1862400 times.
 74612400 DO I_L=1,KLEV
542 74496000 P_TAUCLD(I_L,JB) = ptaucld(K_IPLON,I_L,JB)
543 ENDDO
544 ENDDO
545
546 ENDIF
547
548 ! ------------------------------------------------------------------
549
550
1/2
✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
 119280 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',1,ZHOOK_HANDLE)
551 119280 END SUBROUTINE RRTM_ECRT_140GP
552