1 | |
---|
2 | ! $Id: rrtm_ecrt_140gp.F90 5159 2024-08-02 19:58:25Z fhourdin $ |
---|
3 | |
---|
4 | !****************** SUBROUTINE RRTM_ECRT_140GP ************************** |
---|
5 | |
---|
6 | SUBROUTINE RRTM_ECRT_140GP & |
---|
7 | & (K_IPLON, klon, klev, kcld, & |
---|
8 | & paer, paph, pap, & |
---|
9 | & pts, pth, pt, & |
---|
10 | & P_ZEMIS, P_ZEMIW, & |
---|
11 | & pq, pcco2, pozn, pcldf, ptaucld, ptclear, & |
---|
12 | & P_CLDFRAC, P_TAUCLD, & |
---|
13 | & 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 | USE lmdz_clesphys |
---|
36 | |
---|
37 | !------------------------------Arguments-------------------------------- |
---|
38 | |
---|
39 | IMPLICIT NONE |
---|
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 | 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 | ! *** |
---|
116 | |
---|
117 | ! *** mji |
---|
118 | ! Initialize all molecular amounts and aerosol optical depths to zero here, |
---|
119 | ! then pass ECRT amounts into RRTM arrays below. |
---|
120 | |
---|
121 | ! DATA ZWKL /MAXPRDW*0.0/ |
---|
122 | ! DATA ZWX /MAXPROD*0.0/ |
---|
123 | ! DATA KREFLECT /0/ |
---|
124 | |
---|
125 | ! Activate cross section molecules: |
---|
126 | ! NXMOL - number of cross-sections input by user |
---|
127 | ! IXINDX(I) - index of cross-section molecule corresponding to Ith |
---|
128 | ! cross-section specified by user |
---|
129 | ! = 0 -- not allowed in RRTM |
---|
130 | ! = 1 -- CCL4 |
---|
131 | ! = 2 -- CFC11 |
---|
132 | ! = 3 -- CFC12 |
---|
133 | ! = 4 -- CFC22 |
---|
134 | ! DATA KXMOL /2/ |
---|
135 | ! DATA KXINDX /0,2,3,0,31*0/ |
---|
136 | |
---|
137 | ! IREFLECT=KREFLECT |
---|
138 | ! NXMOL=KXMOL |
---|
139 | |
---|
140 | IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP', 0, ZHOOK_HANDLE) |
---|
141 | K_IREFLECT = 0 |
---|
142 | I_NXMOL = 2 |
---|
143 | |
---|
144 | DO J1 = 1, 35 |
---|
145 | ! IXINDX(J1)=0 |
---|
146 | DO J2 = 1, KLEV |
---|
147 | P_WKL(J1, J2) = 0.0_JPRB |
---|
148 | ENDDO |
---|
149 | ENDDO |
---|
150 | !IXINDX(2)=2 |
---|
151 | !IXINDX(3)=3 |
---|
152 | |
---|
153 | ! Set parameters needed for RRTM execution: |
---|
154 | IATM = 0 |
---|
155 | ! IXSECT = 1 |
---|
156 | ! NUMANGS = 0 |
---|
157 | ! IOUT = -1 |
---|
158 | IXMAX = 4 |
---|
159 | |
---|
160 | ! Bands 6,7,8 are considered the 'window' and allowed to have a |
---|
161 | ! different surface emissivity (as in ECMWF). Eli wrote this part.... |
---|
162 | P_SEMISS(1) = P_ZEMIS(K_IPLON) |
---|
163 | P_SEMISS(2) = P_ZEMIS(K_IPLON) |
---|
164 | P_SEMISS(3) = P_ZEMIS(K_IPLON) |
---|
165 | P_SEMISS(4) = P_ZEMIS(K_IPLON) |
---|
166 | P_SEMISS(5) = P_ZEMIS(K_IPLON) |
---|
167 | P_SEMISS(6) = P_ZEMIW(K_IPLON) |
---|
168 | P_SEMISS(7) = P_ZEMIW(K_IPLON) |
---|
169 | P_SEMISS(8) = P_ZEMIW(K_IPLON) |
---|
170 | P_SEMISS(9) = P_ZEMIS(K_IPLON) |
---|
171 | P_SEMISS(10) = P_ZEMIS(K_IPLON) |
---|
172 | P_SEMISS(11) = P_ZEMIS(K_IPLON) |
---|
173 | P_SEMISS(12) = P_ZEMIS(K_IPLON) |
---|
174 | P_SEMISS(13) = P_ZEMIS(K_IPLON) |
---|
175 | P_SEMISS(14) = P_ZEMIS(K_IPLON) |
---|
176 | P_SEMISS(15) = P_ZEMIS(K_IPLON) |
---|
177 | P_SEMISS(16) = P_ZEMIS(K_IPLON) |
---|
178 | |
---|
179 | ! Set surface temperature. |
---|
180 | |
---|
181 | P_TBOUND = pts(K_IPLON) |
---|
182 | |
---|
183 | ! Install ECRT arrays into RRTM arrays for pressure, temperature, |
---|
184 | ! and molecular amounts. Pressures are converted from Pascals |
---|
185 | ! (ECRT) to mb (RRTM). H2O, CO2, O3 and trace gas amounts are |
---|
186 | ! converted from mass mixing ratio to volume mixing ratio. CO2 |
---|
187 | ! converted with same dry air and CO2 molecular weights used in |
---|
188 | ! ECRT to assure correct conversion back to the proper CO2 vmr. |
---|
189 | ! The dry air column COLDRY (in molec/cm2) is calculated from |
---|
190 | ! the level pressures PZ (in mb) based on the hydrostatic equation |
---|
191 | ! and includes a correction to account for H2O in the layer. The |
---|
192 | ! molecular weight of moist air (amm) is calculated for each layer. |
---|
193 | ! Note: RRTM levels count from bottom to top, while the ECRT input |
---|
194 | ! variables count from the top down and must be reversed here. |
---|
195 | |
---|
196 | K_NLAYERS = klev |
---|
197 | I_NMOL = 6 |
---|
198 | PZ(0) = paph(K_IPLON, klev + 1) / 100._JPRB |
---|
199 | P_TZ(0) = pth(K_IPLON, klev + 1) |
---|
200 | DO I_L = 1, KLEV |
---|
201 | PAVEL(I_L) = pap(K_IPLON, KLEV - I_L + 1) / 100._JPRB |
---|
202 | P_TAVEL(I_L) = pt(K_IPLON, KLEV - I_L + 1) |
---|
203 | PZ(I_L) = paph(K_IPLON, KLEV - I_L + 1) / 100._JPRB |
---|
204 | P_TZ(I_L) = pth(K_IPLON, KLEV - I_L + 1) |
---|
205 | P_WKL(1, I_L) = pq(K_IPLON, KLEV - I_L + 1) * Z_AMD / Z_AMW |
---|
206 | P_WKL(2, I_L) = pcco2 * Z_AMD / Z_AMCO2 |
---|
207 | P_WKL(3, I_L) = pozn(K_IPLON, KLEV - I_L + 1) * Z_AMD / Z_AMO |
---|
208 | P_WKL(4, I_L) = rn2o * Z_AMD / Z_AMN2O |
---|
209 | P_WKL(6, I_L) = rch4 * Z_AMD / Z_AMCH4 |
---|
210 | Z_AMM = (1 - P_WKL(1, I_L)) * Z_AMD + P_WKL(1, I_L) * Z_AMW |
---|
211 | 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))) |
---|
212 | ENDDO |
---|
213 | |
---|
214 | !- Fill RRTM aerosol arrays with operational ECMWF aerosols, |
---|
215 | ! do the mixing and distribute over the 16 spectral intervals |
---|
216 | |
---|
217 | DO I_L = 1, KLEV |
---|
218 | JK = KLEV - I_L + 1 |
---|
219 | ! DO JAE=1,5 |
---|
220 | JAE = 1 |
---|
221 | ZTAUAER(JAE) = & |
---|
222 | & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)& |
---|
223 | & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)& |
---|
224 | & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK) |
---|
225 | P_TAUAERL(I_L, 1) = ZTAUAER(1) |
---|
226 | P_TAUAERL(I_L, 2) = ZTAUAER(1) |
---|
227 | JAE = 2 |
---|
228 | ZTAUAER(JAE) = & |
---|
229 | & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)& |
---|
230 | & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)& |
---|
231 | & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK) |
---|
232 | P_TAUAERL(I_L, 3) = ZTAUAER(2) |
---|
233 | P_TAUAERL(I_L, 4) = ZTAUAER(2) |
---|
234 | P_TAUAERL(I_L, 5) = ZTAUAER(2) |
---|
235 | JAE = 3 |
---|
236 | ZTAUAER(JAE) = & |
---|
237 | & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)& |
---|
238 | & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)& |
---|
239 | & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK) |
---|
240 | P_TAUAERL(I_L, 6) = ZTAUAER(3) |
---|
241 | P_TAUAERL(I_L, 8) = ZTAUAER(3) |
---|
242 | P_TAUAERL(I_L, 9) = ZTAUAER(3) |
---|
243 | JAE = 4 |
---|
244 | ZTAUAER(JAE) = & |
---|
245 | & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)& |
---|
246 | & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)& |
---|
247 | & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK) |
---|
248 | P_TAUAERL(I_L, 7) = ZTAUAER(4) |
---|
249 | JAE = 5 |
---|
250 | ZTAUAER(JAE) = & |
---|
251 | & RAER(JAE, 1) * PAER(K_IPLON, 1, JK) + RAER(JAE, 2) * PAER(K_IPLON, 2, JK)& |
---|
252 | & + RAER(JAE, 3) * PAER(K_IPLON, 3, JK) + RAER(JAE, 4) * PAER(K_IPLON, 4, JK)& |
---|
253 | & + RAER(JAE, 5) * PAER(K_IPLON, 5, JK) + RAER(JAE, 6) * PAER(K_IPLON, 6, JK) |
---|
254 | ! END DO |
---|
255 | P_TAUAERL(I_L, 10) = ZTAUAER(5) |
---|
256 | P_TAUAERL(I_L, 11) = ZTAUAER(5) |
---|
257 | P_TAUAERL(I_L, 12) = ZTAUAER(5) |
---|
258 | P_TAUAERL(I_L, 13) = ZTAUAER(5) |
---|
259 | P_TAUAERL(I_L, 14) = ZTAUAER(5) |
---|
260 | P_TAUAERL(I_L, 15) = ZTAUAER(5) |
---|
261 | P_TAUAERL(I_L, 16) = ZTAUAER(5) |
---|
262 | ENDDO |
---|
263 | !--Use LW AOD from own Mie calculations (C. Kleinschmitt) |
---|
264 | DO I_L = 1, KLEV |
---|
265 | JK = KLEV - I_L + 1 |
---|
266 | DO JAE = 1, NLW |
---|
267 | P_TAUAERL(I_L, JAE) = MAX(PTAU_LW(K_IPLON, JK, JAE), 1e-30) |
---|
268 | ENDDO |
---|
269 | ENDDO |
---|
270 | !--end C. Kleinschmitt |
---|
271 | |
---|
272 | DO J2 = 1, KLEV |
---|
273 | DO J1 = 1, JPXSEC |
---|
274 | P_WX(J1, J2) = 0.0_JPRB |
---|
275 | ENDDO |
---|
276 | ENDDO |
---|
277 | |
---|
278 | DO I_L = 1, KLEV |
---|
279 | !- Set cross section molecule amounts from ECRT; convert to vmr |
---|
280 | P_WX(2, I_L) = rcfc11 * Z_AMD / Z_AMC11 |
---|
281 | P_WX(3, I_L) = rcfc12 * Z_AMD / Z_AMC12 |
---|
282 | P_WX(2, I_L) = P_COLDRY(I_L) * P_WX(2, I_L) * 1.E-20_JPRB |
---|
283 | P_WX(3, I_L) = P_COLDRY(I_L) * P_WX(3, I_L) * 1.E-20_JPRB |
---|
284 | |
---|
285 | !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to |
---|
286 | ! molec/cm2 based on COLDRY for use in RRTM |
---|
287 | |
---|
288 | DO IMOL = 1, I_NMOL |
---|
289 | P_WKL(IMOL, I_L) = P_COLDRY(I_L) * P_WKL(IMOL, I_L) |
---|
290 | ENDDO |
---|
291 | |
---|
292 | ! DO IX = 1,JPXSEC |
---|
293 | ! IF (IXINDX(IX) /= 0) THEN |
---|
294 | ! WX(IXINDX(IX),L) = COLDRY(L) * WX(IX,L) * 1.E-20_JPRB |
---|
295 | ! ENDIF |
---|
296 | ! END DO |
---|
297 | |
---|
298 | ENDDO |
---|
299 | |
---|
300 | !- Approximate treatment for various cloud overlaps |
---|
301 | ZCLEAR = 1.0_JPRB |
---|
302 | ZCLOUD = 0.0_JPRB |
---|
303 | ZC1J(0) = 0.0_JPRB |
---|
304 | ZEPSEC = 1.E-03_JPRB |
---|
305 | JL = K_IPLON |
---|
306 | |
---|
307 | !++MODIFCODE |
---|
308 | IF ((NOVLP == 1).OR.(NOVLP ==6).OR.(NOVLP ==8)) THEN |
---|
309 | !--MODIFCODE |
---|
310 | |
---|
311 | DO JK = 1, KLEV |
---|
312 | IF (pcldf(JL, JK) > ZEPSEC) THEN |
---|
313 | ZCLDLY = pcldf(JL, JK) |
---|
314 | ZCLEAR = ZCLEAR & |
---|
315 | & * (1.0_JPRB - MAX(ZCLDLY, ZCLOUD))& |
---|
316 | & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC)) |
---|
317 | ZCLOUD = ZCLDLY |
---|
318 | ZC1J(JK) = 1.0_JPRB - ZCLEAR |
---|
319 | ELSE |
---|
320 | ZCLDLY = 0.0_JPRB |
---|
321 | ZCLEAR = ZCLEAR & |
---|
322 | & * (1.0_JPRB - MAX(ZCLDLY, ZCLOUD))& |
---|
323 | & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC)) |
---|
324 | ZCLOUD = ZCLDLY |
---|
325 | ZC1J(JK) = 1.0_JPRB - ZCLEAR |
---|
326 | ENDIF |
---|
327 | ENDDO |
---|
328 | |
---|
329 | !++MODIFCODE |
---|
330 | ELSEIF ((NOVLP == 2).OR.(NOVLP ==7)) THEN |
---|
331 | !--MODIFCODE |
---|
332 | |
---|
333 | DO JK = 1, KLEV |
---|
334 | IF (pcldf(JL, JK) > ZEPSEC) THEN |
---|
335 | ZCLDLY = pcldf(JL, JK) |
---|
336 | ZCLOUD = MAX(ZCLDLY, ZCLOUD) |
---|
337 | ZC1J(JK) = ZCLOUD |
---|
338 | ELSE |
---|
339 | ZCLDLY = 0.0_JPRB |
---|
340 | ZCLOUD = MAX(ZCLDLY, ZCLOUD) |
---|
341 | ZC1J(JK) = ZCLOUD |
---|
342 | ENDIF |
---|
343 | ENDDO |
---|
344 | |
---|
345 | !++MODIFCODE |
---|
346 | ELSEIF ((NOVLP == 3).OR.(NOVLP ==5)) THEN |
---|
347 | !--MODIFCODE |
---|
348 | |
---|
349 | DO JK = 1, KLEV |
---|
350 | IF (pcldf(JL, JK) > ZEPSEC) THEN |
---|
351 | ZCLDLY = pcldf(JL, JK) |
---|
352 | ZCLEAR = ZCLEAR * (1.0_JPRB - ZCLDLY) |
---|
353 | ZCLOUD = 1.0_JPRB - ZCLEAR |
---|
354 | ZC1J(JK) = ZCLOUD |
---|
355 | ELSE |
---|
356 | ZCLDLY = 0.0_JPRB |
---|
357 | ZCLEAR = ZCLEAR * (1.0_JPRB - ZCLDLY) |
---|
358 | ZCLOUD = 1.0_JPRB - ZCLEAR |
---|
359 | ZC1J(JK) = ZCLOUD |
---|
360 | ENDIF |
---|
361 | ENDDO |
---|
362 | |
---|
363 | ELSEIF (NOVLP == 4) THEN |
---|
364 | |
---|
365 | ENDIF |
---|
366 | PTCLEAR = 1.0_JPRB - ZC1J(KLEV) |
---|
367 | |
---|
368 | ! Transfer cloud fraction and cloud optical depth to RRTM arrays; |
---|
369 | ! invert array index for pcldf to go from bottom to top for RRTM |
---|
370 | |
---|
371 | !- clear-sky column |
---|
372 | IF (PTCLEAR > 1.0_JPRB - ZEPSEC) THEN |
---|
373 | KCLD = 0 |
---|
374 | DO I_L = 1, KLEV |
---|
375 | P_CLDFRAC(I_L) = 0.0_JPRB |
---|
376 | ENDDO |
---|
377 | DO JB = 1, JPBAND |
---|
378 | DO I_L = 1, KLEV |
---|
379 | P_TAUCLD(I_L, JB) = 0.0_JPRB |
---|
380 | ENDDO |
---|
381 | ENDDO |
---|
382 | |
---|
383 | ELSE |
---|
384 | |
---|
385 | !- cloudy column |
---|
386 | ! The diffusivity factor (Savijarvi, 1997) on the cloud optical |
---|
387 | ! thickness TAUCLD has already been applied in RADLSW |
---|
388 | |
---|
389 | KCLD = 1 |
---|
390 | DO I_L = 1, KLEV |
---|
391 | P_CLDFRAC(I_L) = pcldf(K_IPLON, I_L) |
---|
392 | ENDDO |
---|
393 | DO JB = 1, JPBAND |
---|
394 | DO I_L = 1, KLEV |
---|
395 | P_TAUCLD(I_L, JB) = ptaucld(K_IPLON, I_L, JB) |
---|
396 | ENDDO |
---|
397 | ENDDO |
---|
398 | |
---|
399 | ENDIF |
---|
400 | |
---|
401 | ! ------------------------------------------------------------------ |
---|
402 | |
---|
403 | IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP', 1, ZHOOK_HANDLE) |
---|
404 | END SUBROUTINE RRTM_ECRT_140GP |
---|