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