1 | |
---|
2 | ! $Id: srtm_srtm_224gp.F90 5160 2024-08-03 12:56:58Z abarral $ |
---|
3 | |
---|
4 | SUBROUTINE SRTM_SRTM_224GP & |
---|
5 | & (KIDIA, KFDIA, KLON, KLEV, KSW, KOVLP, & |
---|
6 | & PAER, PALBD, PALBP, PAPH, PAP, & |
---|
7 | & PTS, PTH, PT, & |
---|
8 | & PQ, PCCO2, POZN, PRMU0, & |
---|
9 | & PFRCL, PTAUC, PASYC, POMGC, & |
---|
10 | & PALBT, PFSUX, PFSUC & |
---|
11 | &) |
---|
12 | |
---|
13 | !-- interface to RRTM_SW |
---|
14 | ! JJMorcrette 030225 |
---|
15 | |
---|
16 | USE PARKIND1, ONLY: JPIM, JPRB |
---|
17 | USE YOMHOOK, ONLY: LHOOK, DR_HOOK |
---|
18 | |
---|
19 | USE PARSRTM, ONLY: JPLAY |
---|
20 | !USE YOERDI , ONLY : RCH4 , RN2O |
---|
21 | USE YOERAD, ONLY: NAER |
---|
22 | USE YOESRTAER, ONLY: RSRTAUA, RSRPIZA, RSRASYA |
---|
23 | USE YOMPHY3, ONLY: RII0 |
---|
24 | USE YOMCST, ONLY: RI0 |
---|
25 | USE lmdz_clesphys |
---|
26 | |
---|
27 | IMPLICIT NONE |
---|
28 | |
---|
29 | !-- Input arguments |
---|
30 | |
---|
31 | INTEGER(KIND = JPIM), INTENT(IN) :: KLON |
---|
32 | INTEGER(KIND = JPIM) :: KLEV! UNDETERMINED INTENT |
---|
33 | INTEGER(KIND = JPIM) :: KSW! UNDETERMINED INTENT |
---|
34 | INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA |
---|
35 | INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA |
---|
36 | INTEGER(KIND = JPIM), INTENT(IN) :: KOVLP |
---|
37 | REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV) ! top to bottom |
---|
38 | REAL(KIND = JPRB), INTENT(IN) :: PALBD(KLON, KSW) |
---|
39 | REAL(KIND = JPRB), INTENT(IN) :: PALBP(KLON, KSW) |
---|
40 | REAL(KIND = JPRB), INTENT(IN) :: PAPH(KLON, KLEV + 1) |
---|
41 | REAL(KIND = JPRB), INTENT(IN) :: PAP(KLON, KLEV) |
---|
42 | REAL(KIND = JPRB), INTENT(IN) :: PTS(KLON) |
---|
43 | REAL(KIND = JPRB), INTENT(IN) :: PTH(KLON, KLEV + 1) |
---|
44 | REAL(KIND = JPRB), INTENT(IN) :: PT(KLON, KLEV) |
---|
45 | REAL(KIND = JPRB), INTENT(IN) :: PQ(KLON, KLEV) |
---|
46 | REAL(KIND = JPRB), INTENT(IN) :: PCCO2 |
---|
47 | REAL(KIND = JPRB), INTENT(IN) :: POZN(KLON, KLEV) |
---|
48 | REAL(KIND = JPRB), INTENT(IN) :: PRMU0(KLON) |
---|
49 | REAL(KIND = JPRB), INTENT(IN) :: PFRCL(KLON, KLEV) ! bottom to top |
---|
50 | REAL(KIND = JPRB), INTENT(IN) :: PTAUC(KLON, KSW, KLEV) ! bottom to top |
---|
51 | REAL(KIND = JPRB), INTENT(IN) :: PASYC(KLON, KSW, KLEV) ! bottom to top |
---|
52 | REAL(KIND = JPRB), INTENT(IN) :: POMGC(KLON, KSW, KLEV) ! bottom to top |
---|
53 | REAL(KIND = JPRB) :: PALBT(KLON, KSW) ! Argument NOT used |
---|
54 | REAL(KIND = JPRB), INTENT(OUT) :: PFSUX(KLON, 2, KLEV + 1) |
---|
55 | REAL(KIND = JPRB), INTENT(OUT) :: PFSUC(KLON, 2, KLEV + 1) |
---|
56 | !INTEGER_M :: KMOL, KCLDATM, KNFLAG, KCEFLAG, KIQFLAG, KSTR |
---|
57 | |
---|
58 | !-- Output arguments |
---|
59 | |
---|
60 | !----------------------------------------------------------------------- |
---|
61 | |
---|
62 | !-- dummy integers |
---|
63 | |
---|
64 | INTEGER(KIND = JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, I_NMOL, I_NSTR |
---|
65 | |
---|
66 | INTEGER(KIND = JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW |
---|
67 | |
---|
68 | !-- dummy reals |
---|
69 | |
---|
70 | REAL(KIND = JPRB) :: Z_PZ(0:JPLAY), Z_TZ(0:JPLAY), Z_PAVEL(JPLAY), Z_TAVEL(JPLAY) |
---|
71 | REAL(KIND = JPRB) :: Z_COLDRY(JPLAY), Z_COLMOL(JPLAY), Z_WKL(35, JPLAY) |
---|
72 | REAL(KIND = JPRB) :: Z_CO2MULT(JPLAY), Z_COLCH4(JPLAY), Z_COLCO2(JPLAY), Z_COLH2O(JPLAY) |
---|
73 | REAL(KIND = JPRB) :: Z_COLN2O(JPLAY), Z_COLO2(JPLAY), Z_COLO3(JPLAY) |
---|
74 | REAL(KIND = JPRB) :: Z_FORFAC(JPLAY), Z_FORFRAC(JPLAY), Z_SELFFAC(JPLAY), Z_SELFFRAC(JPLAY) |
---|
75 | REAL(KIND = JPRB) :: Z_FAC00(JPLAY), Z_FAC01(JPLAY), Z_FAC10(JPLAY), Z_FAC11(JPLAY) |
---|
76 | REAL(KIND = JPRB) :: Z_TBOUND, Z_ONEMINUS, ZRMU0, ZADJI0 |
---|
77 | REAL(KIND = JPRB) :: ZALBD(KSW), ZALBP(KSW), ZFRCL(JPLAY) |
---|
78 | REAL(KIND = JPRB) :: ZTAUC(JPLAY, KSW), ZASYC(JPLAY, KSW), ZOMGC(JPLAY, KSW) |
---|
79 | REAL(KIND = JPRB) :: ZTAUA(JPLAY, KSW), ZASYA(JPLAY, KSW), ZOMGA(JPLAY, KSW) |
---|
80 | |
---|
81 | REAL(KIND = JPRB) :: ZBBCD(JPLAY + 1), ZBBCU(JPLAY + 1), ZBBFD(JPLAY + 1), ZBBFU(JPLAY + 1) |
---|
82 | REAL(KIND = JPRB) :: ZUVCD(JPLAY + 1), ZUVCU(JPLAY + 1), ZUVFD(JPLAY + 1), ZUVFU(JPLAY + 1) |
---|
83 | REAL(KIND = JPRB) :: ZVSCD(JPLAY + 1), ZVSCU(JPLAY + 1), ZVSFD(JPLAY + 1), ZVSFU(JPLAY + 1) |
---|
84 | REAL(KIND = JPRB) :: ZNICD(JPLAY + 1), ZNICU(JPLAY + 1), ZNIFD(JPLAY + 1), ZNIFU(JPLAY + 1) |
---|
85 | |
---|
86 | INTEGER(KIND = JPIM) :: I_LAYTROP, I_LAYSWTCH, I_LAYLOW |
---|
87 | INTEGER(KIND = JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY) |
---|
88 | INTEGER(KIND = JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY) |
---|
89 | |
---|
90 | REAL(KIND = JPRB) :: Z_AMD ! Effective molecular weight of dry air (g/mol) |
---|
91 | REAL(KIND = JPRB) :: Z_AMW ! Molecular weight of water vapor (g/mol) |
---|
92 | REAL(KIND = JPRB) :: Z_AMCO2 ! Molecular weight of carbon dioxide (g/mol) |
---|
93 | REAL(KIND = JPRB) :: Z_AMO ! Molecular weight of ozone (g/mol) |
---|
94 | REAL(KIND = JPRB) :: Z_AMCH4 ! Molecular weight of methane (g/mol) |
---|
95 | REAL(KIND = JPRB) :: Z_AMN2O ! Molecular weight of nitrous oxide (g/mol) |
---|
96 | REAL(KIND = JPRB) :: Z_AMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3 |
---|
97 | REAL(KIND = JPRB) :: Z_AMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2 |
---|
98 | REAL(KIND = JPRB) :: Z_AVGDRO ! Avogadro's number (molecules/mole) |
---|
99 | REAL(KIND = JPRB) :: Z_GRAVIT ! Gravitational acceleration (cm/sec2) |
---|
100 | REAL(KIND = JPRB) :: Z_AMM |
---|
101 | |
---|
102 | ! Atomic weights for conversion from mass to volume mixing ratios; these |
---|
103 | ! are the same values used in ECRT to assure accurate conversion to vmr |
---|
104 | data Z_AMD / 28.970_JPRB / |
---|
105 | data Z_AMW / 18.0154_JPRB / |
---|
106 | data Z_AMCO2 / 44.011_JPRB / |
---|
107 | data Z_AMO / 47.9982_JPRB / |
---|
108 | data Z_AMCH4 / 16.043_JPRB / |
---|
109 | data Z_AMN2O / 44.013_JPRB / |
---|
110 | data Z_AMC11 / 137.3686_JPRB / |
---|
111 | data Z_AMC12 / 120.9140_JPRB / |
---|
112 | data Z_AVGDRO/ 6.02214E23_JPRB / |
---|
113 | data Z_GRAVIT/ 9.80665E02_JPRB / |
---|
114 | |
---|
115 | REAL(KIND = JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC |
---|
116 | |
---|
117 | INTEGER(KIND = JPIM) :: IOVLP |
---|
118 | REAL(KIND = JPRB) :: ZHOOK_HANDLE |
---|
119 | |
---|
120 | |
---|
121 | #include "srtm_setcoef.intfb.h" |
---|
122 | #include "srtm_spcvrt.intfb.h" |
---|
123 | |
---|
124 | |
---|
125 | !----------------------------------------------------------------------- |
---|
126 | !-- calculate information needed ny the radiative transfer routine |
---|
127 | |
---|
128 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 0, ZHOOK_HANDLE) |
---|
129 | ZEPSEC = 1.E-06_JPRB |
---|
130 | Z_ONEMINUS = 1.0_JPRB - ZEPSEC |
---|
131 | ZADJI0 = RII0 / RI0 |
---|
132 | !-- overlap: 1=max-ran, 2=maximum, 3=random |
---|
133 | IOVLP = 3 |
---|
134 | |
---|
135 | !PRINT *,'Entering srtm_srtm_224gp' |
---|
136 | |
---|
137 | ICLDATM = 1 |
---|
138 | INFLAG = 2 |
---|
139 | ICEFLAG = 3 |
---|
140 | I_LIQFLAG = 1 |
---|
141 | I_NMOL = 6 |
---|
142 | I_NSTR = 2 |
---|
143 | |
---|
144 | DO JL = KIDIA, KFDIA |
---|
145 | ZRMU0 = PRMU0(JL) |
---|
146 | IF (ZRMU0 > 0.0_JPRB) THEN |
---|
147 | |
---|
148 | !- coefficients related to the cloud optical properties (original RRTM_SW) |
---|
149 | |
---|
150 | ! PRINT *,'just before SRTM_CLDPROP' |
---|
151 | |
---|
152 | ! DO JK=1,KLEV |
---|
153 | ! CLDFRAC(JK) = PFRCL (JL,JK) |
---|
154 | ! CLDDAT1(JK) = PSCLA1(JL,JK) |
---|
155 | ! CLDDAT2(JK) = PSCLA2(JL,JK) |
---|
156 | ! CLDDAT3(JK) = PSCLA3(JL,JK) |
---|
157 | ! CLDDAT4(JK) = PSCLA4(JL,JK) |
---|
158 | ! DO JMOM=0,16 |
---|
159 | ! CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK) |
---|
160 | ! ENDDO |
---|
161 | ! print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)& |
---|
162 | ! &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR) |
---|
163 | 9101 format(1x, 'srtm_srtm_224gp Cld :', I3, f7.4, 7E12.5) |
---|
164 | ! ENDDO |
---|
165 | |
---|
166 | ! CALL SRTM_CLDPROP & |
---|
167 | ! &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR & |
---|
168 | ! &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM & |
---|
169 | ! &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM & |
---|
170 | ! &) |
---|
171 | |
---|
172 | !- coefficients for the temperature and pressure dependence of the |
---|
173 | ! molecular absorption coefficients |
---|
174 | |
---|
175 | DO J1 = 1, 35 |
---|
176 | DO J2 = 1, KLEV |
---|
177 | Z_WKL(J1, J2) = 0.0_JPRB |
---|
178 | ENDDO |
---|
179 | ENDDO |
---|
180 | |
---|
181 | Z_TBOUND = PTS(JL) |
---|
182 | Z_PZ(0) = paph(JL, klev + 1) / 100._JPRB |
---|
183 | Z_TZ(0) = pth (JL, klev + 1) |
---|
184 | |
---|
185 | ZCLEAR = 1.0_JPRB |
---|
186 | ZCLOUD = 0.0_JPRB |
---|
187 | ZTOTCC = 0.0_JPRB |
---|
188 | DO JK = 1, KLEV |
---|
189 | Z_PAVEL(JK) = pap(JL, KLEV - JK + 1) / 100._JPRB |
---|
190 | Z_TAVEL(JK) = pt (JL, KLEV - JK + 1) |
---|
191 | Z_PZ(JK) = paph(JL, KLEV - JK + 1) / 100._JPRB |
---|
192 | Z_TZ(JK) = pth (JL, KLEV - JK + 1) |
---|
193 | Z_WKL(1, JK) = pq(JL, KLEV - JK + 1) * Z_AMD / Z_AMW |
---|
194 | Z_WKL(2, JK) = pcco2 * Z_AMD / Z_AMCO2 |
---|
195 | Z_WKL(3, JK) = pozn(JL, KLEV - JK + 1) * Z_AMD / Z_AMO |
---|
196 | Z_WKL(4, JK) = rn2o * Z_AMD / Z_AMN2O |
---|
197 | Z_WKL(6, JK) = rch4 * Z_AMD / Z_AMCH4 |
---|
198 | Z_AMM = (1 - Z_WKL(1, JK)) * Z_AMD + Z_WKL(1, JK) * Z_AMW |
---|
199 | Z_COLDRY(JK) = (Z_PZ(JK - 1) - Z_PZ(JK)) * 1.E3_JPRB * Z_AVGDRO / (Z_GRAVIT * Z_AMM * (1 + Z_WKL(1, JK))) |
---|
200 | ! print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK) |
---|
201 | 9200 format(1x, 'SRTM ', I3, 2F7.1, 6E13.5) |
---|
202 | |
---|
203 | IF (KOVLP == 1) THEN |
---|
204 | ZCLEAR = ZCLEAR * (1.0_JPRB - MAX(PFRCL(JL, JK), ZCLOUD)) & |
---|
205 | & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC)) |
---|
206 | ZCLOUD = PFRCL(JL, JK) |
---|
207 | ZTOTCC = 1.0_JPRB - ZCLEAR |
---|
208 | ELSEIF (KOVLP == 2) THEN |
---|
209 | ZCLOUD = MAX(ZCLOUD, PFRCL(JL, JK)) |
---|
210 | ZCLEAR = 1.0_JPRB - ZCLOUD |
---|
211 | ZTOTCC = ZCLOUD |
---|
212 | ELSEIF (KOVLP == 3) THEN |
---|
213 | ZCLEAR = ZCLEAR * (1.0_JPRB - PFRCL(JL, JK)) |
---|
214 | ZCLOUD = 1.0_JPRB - ZCLEAR |
---|
215 | ZTOTCC = ZCLOUD |
---|
216 | ENDIF |
---|
217 | |
---|
218 | ENDDO |
---|
219 | |
---|
220 | ! PRINT *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR |
---|
221 | |
---|
222 | DO IMOL = 1, I_NMOL |
---|
223 | DO JK = 1, KLEV |
---|
224 | Z_WKL(IMOL, JK) = Z_COLDRY(JK) * Z_WKL(IMOL, JK) |
---|
225 | ENDDO |
---|
226 | ENDDO |
---|
227 | |
---|
228 | ! IF (ZTOTCC == 0.0_JPRB) THEN |
---|
229 | ! DO JK=1,KLEV |
---|
230 | ! ZFRCL(JK)=0.0_JPRB |
---|
231 | ! ENDDO |
---|
232 | ! ELSE |
---|
233 | ! DO JK=1,KLEV |
---|
234 | ! ZFRCL(JK)=PFRCL(JL,JK)/ZTOTCC |
---|
235 | ! ENDDO |
---|
236 | ! ENDIF |
---|
237 | |
---|
238 | ! PRINT *,'just before SRTM_SETCOEF' |
---|
239 | |
---|
240 | ZFRCL(1:KLEV) = PFRCL(JL, 1:KLEV) |
---|
241 | ZCLEAR = 0._JPRB |
---|
242 | ZCLOUD = 1._JPRB |
---|
243 | |
---|
244 | CALL SRTM_SETCOEF & |
---|
245 | & (KLEV, I_NMOL, & |
---|
246 | & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, & |
---|
247 | & Z_COLDRY, Z_WKL, & |
---|
248 | & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, & |
---|
249 | & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, & |
---|
250 | & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, & |
---|
251 | & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, & |
---|
252 | & JP, JT, JT1 & |
---|
253 | &) |
---|
254 | |
---|
255 | ! PRINT *,'just after SRTM_SETCOEF' |
---|
256 | |
---|
257 | !- call the radiation transfer routine |
---|
258 | |
---|
259 | DO JSW = 1, KSW |
---|
260 | ZALBD(JSW) = PALBD(JL, JSW) |
---|
261 | ZALBP(JSW) = PALBP(JL, JSW) |
---|
262 | DO JK = 1, KLEV |
---|
263 | ZTAUC(JK, JSW) = PTAUC(JL, JSW, JK) |
---|
264 | ZASYC(JK, JSW) = PASYC(JL, JSW, JK) |
---|
265 | ZOMGC(JK, JSW) = POMGC(JL, JSW, JK) |
---|
266 | ! print 9002,JSW,JK,ZFRCL(JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW) |
---|
267 | 9002 format(1x, 'srtm_224gp ClOPropECmodel ', 2I3, f8.4, 3E12.5) |
---|
268 | ENDDO |
---|
269 | ENDDO |
---|
270 | |
---|
271 | !- mixing of aerosols |
---|
272 | |
---|
273 | ! PRINT *,'Aerosol optical properties computations' |
---|
274 | ! DO JSW=1,KSW |
---|
275 | ! print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6) |
---|
276 | 9012 format(I3, (/, I3, 3E13.5)) |
---|
277 | ! ENDDO |
---|
278 | |
---|
279 | ! DO JK=1,KLEV |
---|
280 | ! print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6) |
---|
281 | 9013 format(1x, I3, 6E12.5) |
---|
282 | ! ENDDO |
---|
283 | |
---|
284 | IF (NAER == 0) THEN |
---|
285 | DO JSW = 1, KSW |
---|
286 | DO JK = 1, KLEV |
---|
287 | ZTAUA(JK, JSW) = 0.0_JPRB |
---|
288 | ZASYA(JK, JSW) = 0.0_JPRB |
---|
289 | ZOMGA(JK, JSW) = 1.0_JPRB |
---|
290 | ENDDO |
---|
291 | ENDDO |
---|
292 | ELSE |
---|
293 | DO JSW = 1, KSW |
---|
294 | DO JK = 1, KLEV |
---|
295 | IK = KLEV + 1 - JK |
---|
296 | ZTAUA(JK, JSW) = 0.0_JPRB |
---|
297 | ZASYA(JK, JSW) = 0.0_JPRB |
---|
298 | ZOMGA(JK, JSW) = 0.0_JPRB |
---|
299 | DO JAE = 1, 6 |
---|
300 | ZTAUA(JK, JSW) = ZTAUA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) |
---|
301 | ZOMGA(JK, JSW) = ZOMGA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) & |
---|
302 | & * RSRPIZA(JSW, JAE) |
---|
303 | ZASYA(JK, JSW) = ZASYA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) & |
---|
304 | & * RSRPIZA(JSW, JAE) * RSRASYA(JSW, JAE) |
---|
305 | ENDDO |
---|
306 | IF (ZOMGA(JK, JSW) /= 0.0_JPRB) THEN |
---|
307 | ZASYA(JK, JSW) = ZASYA(JK, JSW) / ZOMGA(JK, JSW) |
---|
308 | ENDIF |
---|
309 | IF (ZTAUA(JK, JSW) /= 0.0_JPRB) THEN |
---|
310 | ZOMGA(JK, JSW) = ZOMGA(JK, JSW) / ZTAUA(JK, JSW) |
---|
311 | ENDIF |
---|
312 | ! print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW) |
---|
313 | 9003 format(1x, 'Aerosols ', 2I3, 3F10.4) |
---|
314 | ENDDO |
---|
315 | ENDDO |
---|
316 | ENDIF |
---|
317 | |
---|
318 | DO JK = 1, KLEV + 1 |
---|
319 | ZBBCU(JK) = 0.0_JPRB |
---|
320 | ZBBCD(JK) = 0.0_JPRB |
---|
321 | ZBBFU(JK) = 0.0_JPRB |
---|
322 | ZBBFD(JK) = 0.0_JPRB |
---|
323 | ZUVCU(JK) = 0.0_JPRB |
---|
324 | ZUVCD(JK) = 0.0_JPRB |
---|
325 | ZUVFU(JK) = 0.0_JPRB |
---|
326 | ZUVFD(JK) = 0.0_JPRB |
---|
327 | ZVSCU(JK) = 0.0_JPRB |
---|
328 | ZVSCD(JK) = 0.0_JPRB |
---|
329 | ZVSFU(JK) = 0.0_JPRB |
---|
330 | ZVSFD(JK) = 0.0_JPRB |
---|
331 | ZNICU(JK) = 0.0_JPRB |
---|
332 | ZNICD(JK) = 0.0_JPRB |
---|
333 | ZNIFU(JK) = 0.0_JPRB |
---|
334 | ZNIFD(JK) = 0.0_JPRB |
---|
335 | ENDDO |
---|
336 | |
---|
337 | ! PRINT *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0 |
---|
338 | |
---|
339 | CALL SRTM_SPCVRT & |
---|
340 | & (KLEV, I_NMOL, KSW, Z_ONEMINUS, & |
---|
341 | & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, ZALBD, ZALBP, & |
---|
342 | & ZFRCL, ZTAUC, ZASYC, ZOMGC, ZTAUA, ZASYA, ZOMGA, ZRMU0, & |
---|
343 | & Z_COLDRY, Z_WKL, & |
---|
344 | & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, & |
---|
345 | & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, & |
---|
346 | & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, & |
---|
347 | & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, & |
---|
348 | & JP, JT, JT1, & |
---|
349 | & ZBBFD, ZBBFU, ZUVFD, ZUVFU, ZVSFD, ZVSFU, ZNIFD, ZNIFU, & |
---|
350 | & ZBBCD, ZBBCU, ZUVCD, ZUVCU, ZVSCD, ZVSCU, ZNICD, ZNICU & |
---|
351 | &) |
---|
352 | |
---|
353 | ! PRINT *,'SRTM_SRTM_224GP before potential scaling' |
---|
354 | ! IF (IOVLP == 3) THEN |
---|
355 | ! DO JK=1,KLEV+1 |
---|
356 | !! print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK) |
---|
357 | 9004 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3) |
---|
358 | ! PFSUC(JL,1,JK)=ZBBCU(JK) |
---|
359 | ! PFSUC(JL,2,JK)=ZBBCD(JK) |
---|
360 | ! PFSUX(JL,1,JK)=ZBBFU(JK) |
---|
361 | ! PFSUX(JL,2,JK)=ZBBFD(JK) |
---|
362 | ! ENDDO |
---|
363 | ! ELSE |
---|
364 | ! PRINT *,'SRTM_SRTM_224GP after potential scaling' |
---|
365 | DO JK = 1, KLEV + 1 |
---|
366 | PFSUC(JL, 1, JK) = ZADJI0 * ZBBCU(JK) |
---|
367 | PFSUC(JL, 2, JK) = ZADJI0 * ZBBCD(JK) |
---|
368 | PFSUX(JL, 1, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFU(JK) + ZCLEAR * ZBBCU(JK)) |
---|
369 | PFSUX(JL, 2, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFD(JK) + ZCLEAR * ZBBCD(JK)) |
---|
370 | ENDDO |
---|
371 | ! ENDIF |
---|
372 | |
---|
373 | ! DO JK=1,KLEV+1 |
---|
374 | ! print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK) |
---|
375 | 9005 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3) |
---|
376 | ! ENDDO |
---|
377 | |
---|
378 | ELSE |
---|
379 | DO JK = 1, KLEV + 1 |
---|
380 | PFSUC(JL, 1, JK) = 0.0_JPRB |
---|
381 | PFSUC(JL, 2, JK) = 0.0_JPRB |
---|
382 | PFSUX(JL, 1, JK) = 0.0_JPRB |
---|
383 | PFSUX(JL, 2, JK) = 0.0_JPRB |
---|
384 | ENDDO |
---|
385 | ENDIF |
---|
386 | ENDDO |
---|
387 | |
---|
388 | !PRINT *,'OUT OF SRTM_224GP' |
---|
389 | |
---|
390 | !----------------------------------------------------------------------- |
---|
391 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 1, ZHOOK_HANDLE) |
---|
392 | END SUBROUTINE SRTM_SRTM_224GP |
---|
393 | |
---|