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