[1989] | 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 |
---|
[2641] | 18 | !MPL/IM 20160915 on prend GES de phylmd USE YOERDI , ONLY : RCH4 , RN2O |
---|
[1989] | 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" |
---|
[2641] | 135 | !MPL/IM 20160915 on prend GES de phylmd |
---|
| 136 | #include "clesphys.h" |
---|
[1989] | 137 | |
---|
| 138 | !----------------------------------------------------------------------- |
---|
| 139 | !-- calculate information needed ny the radiative transfer routine |
---|
| 140 | |
---|
| 141 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE) |
---|
| 142 | ZEPSEC = 1.E-06_JPRB |
---|
| 143 | ZONEMINUS=1.0_JPRB - ZEPSEC |
---|
| 144 | ZADJI0 = RII0 / RI0 |
---|
| 145 | !-- overlap: 1=max-ran, 2=maximum, 3=random |
---|
| 146 | IOVLP=3 |
---|
| 147 | |
---|
| 148 | !print *,'Entering srtm_srtm_224gp_mcica' |
---|
| 149 | |
---|
| 150 | ICLDATM = 1 |
---|
| 151 | INFLAG = 2 |
---|
| 152 | ICEFLAG = 3 |
---|
| 153 | I_LIQFLAG= 1 |
---|
| 154 | ITMOL = 6 |
---|
| 155 | I_NSTR = 2 |
---|
| 156 | |
---|
| 157 | DO JL = KIDIA, KFDIA |
---|
| 158 | ZRMU0=PRMU0(JL) |
---|
| 159 | IF (ZRMU0 > 0.0_JPRB) THEN |
---|
| 160 | |
---|
| 161 | !- coefficients related to the cloud optical properties (original RRTM_SW) |
---|
| 162 | |
---|
| 163 | ! print *,'just before SRTM_CLDPROP' |
---|
| 164 | |
---|
| 165 | ! DO JK=1,KLEV |
---|
| 166 | ! CLDFRAC(JK) = PFRCL (JL,JK) |
---|
| 167 | ! CLDDAT1(JK) = PSCLA1(JL,JK) |
---|
| 168 | ! CLDDAT2(JK) = PSCLA2(JL,JK) |
---|
| 169 | ! CLDDAT3(JK) = PSCLA3(JL,JK) |
---|
| 170 | ! CLDDAT4(JK) = PSCLA4(JL,JK) |
---|
| 171 | ! DO JMOM=0,16 |
---|
| 172 | ! CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK) |
---|
| 173 | ! ENDDO |
---|
| 174 | ! print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)& |
---|
| 175 | ! &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR) |
---|
| 176 | 9101 format(1x,'srtm_srtm_224gp Cld :',I3,f7.4,7E12.5) |
---|
| 177 | ! ENDDO |
---|
| 178 | |
---|
| 179 | ! CALL SRTM_CLDPROP & |
---|
| 180 | ! &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR & |
---|
| 181 | ! &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM & |
---|
| 182 | ! &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM & |
---|
| 183 | ! &) |
---|
| 184 | |
---|
| 185 | !- coefficients for the temperature and pressure dependence of the |
---|
| 186 | ! molecular absorption coefficients |
---|
| 187 | |
---|
| 188 | DO J1=1,35 |
---|
| 189 | DO J2=1,KLEV |
---|
| 190 | ZWKL(J1,J2)=0.0_JPRB |
---|
| 191 | ENDDO |
---|
| 192 | ENDDO |
---|
| 193 | |
---|
| 194 | ZTBOUND=PTS(JL) |
---|
| 195 | ZPZ(0) = paph(JL,klev+1)*0.01_JPRB |
---|
| 196 | ZTZ(0) = pth (JL,klev+1) |
---|
| 197 | |
---|
| 198 | ZCLEAR=1.0_JPRB |
---|
| 199 | ZCLOUD=0.0_JPRB |
---|
| 200 | ZTOTCC=0.0_JPRB |
---|
| 201 | DO JK = 1, KLEV |
---|
| 202 | ZPAVEL(JK) = pap(JL,KLEV-JK+1) *0.01_JPRB |
---|
| 203 | ZTAVEL(JK) = pt (JL,KLEV-JK+1) |
---|
| 204 | ZPZ(JK) = paph(JL,KLEV-JK+1) *0.01_JPRB |
---|
| 205 | ZTZ(JK) = pth (JL,KLEV-JK+1) |
---|
| 206 | ZWKL(1,JK) = pq(JL,KLEV-JK+1) *ZAMD*RAMW |
---|
| 207 | ZWKL(2,JK) = pcco2 *ZAMD*RAMCO2 |
---|
| 208 | ZWKL(3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*RAMO |
---|
| 209 | ZWKL(4,JK) = rn2o *ZAMD*RAMN2O |
---|
| 210 | ZWKL(6,JK) = rch4 *ZAMD*RAMCH4 |
---|
| 211 | ZAMM = (1-ZWKL(1,JK))*ZAMD + ZWKL(1,JK)*ZAMW |
---|
| 212 | ZCOLDRY(JK) = (ZPZ(JK-1)-ZPZ(JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1+ZWKL(1,JK))) |
---|
| 213 | ! print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK) |
---|
| 214 | 9200 format(1x,'SRTM ',I3,2F7.1,6E13.5) |
---|
| 215 | |
---|
| 216 | |
---|
| 217 | |
---|
| 218 | ENDDO |
---|
| 219 | |
---|
| 220 | ! print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR |
---|
| 221 | |
---|
| 222 | DO IMOL=1,ITMOL |
---|
| 223 | DO JK=1,KLEV |
---|
| 224 | ZWKL(IMOL,JK)=ZCOLDRY(JK)* ZWKL(IMOL,JK) |
---|
| 225 | ENDDO |
---|
| 226 | ENDDO |
---|
| 227 | |
---|
| 228 | ! print *,'just before SRTM_SETCOEF' |
---|
| 229 | |
---|
| 230 | CALL SRTM_SETCOEF & |
---|
| 231 | & ( KLEV , ITMOL,& |
---|
| 232 | & ZPAVEL , ZTAVEL , ZPZ , ZTZ , ZTBOUND,& |
---|
| 233 | & ZCOLDRY , ZWKL,& |
---|
| 234 | & ILAYTROP, ILAYSWTCH, ILAYLOW,& |
---|
| 235 | & ZCO2MULT, ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLN2O , ZCOLO2 , ZCOLO3,& |
---|
| 236 | & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, & |
---|
| 237 | & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,& |
---|
| 238 | & JP , JT , JT1 & |
---|
| 239 | & ) |
---|
| 240 | |
---|
| 241 | ! print *,'just after SRTM_SETCOEF' |
---|
| 242 | |
---|
| 243 | !- call the radiation transfer routine |
---|
| 244 | |
---|
| 245 | DO JSW=1,KSW |
---|
| 246 | ZALBD(JSW)=PALBD(JL,JSW) |
---|
| 247 | ZALBP(JSW)=PALBP(JL,JSW) |
---|
| 248 | ENDDO |
---|
| 249 | |
---|
| 250 | DO JSW=1,KCOLS |
---|
| 251 | DO JK=1,KLEV |
---|
| 252 | ZFRCL(JSW,JK) = PFRCL(JL,JSW,JK) |
---|
| 253 | ZTAUC(JK,JSW) = PTAUC(JL,JSW,JK) |
---|
| 254 | ZASYC(JK,JSW) = PASYC(JL,JSW,JK) |
---|
| 255 | ZOMGC(JK,JSW) = POMGC(JL,JSW,JK) |
---|
| 256 | |
---|
| 257 | !---- security: might have to be moved upstream to radlswr ------- |
---|
| 258 | ! IF(ZTAUC(JK,JSW) == 0._JPRB) ZFRCL(JSW,JK) = 0._JPRB |
---|
| 259 | !----------------------------------------------------------------- |
---|
| 260 | |
---|
| 261 | |
---|
| 262 | ! IF (ZFRCL(JSW,JK) /= 0._JPRB) THEN |
---|
| 263 | ! print 9002,JSW,JK,ZFRCL(JSW,JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW) |
---|
| 264 | 9002 format(1x,'srtm_224gp_McICA ClOPropECmodel ',2I3,f8.4,3E12.5) |
---|
| 265 | ! ENDIF |
---|
| 266 | ENDDO |
---|
| 267 | ENDDO |
---|
| 268 | |
---|
| 269 | !- mixing of aerosols |
---|
| 270 | |
---|
| 271 | ! print *,'Aerosol optical properties computations' |
---|
| 272 | ! DO JSW=1,KSW |
---|
| 273 | ! print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6) |
---|
| 274 | 9012 format(I3,(/,I3,3E13.5)) |
---|
| 275 | ! ENDDO |
---|
| 276 | |
---|
| 277 | ! DO JK=1,KLEV |
---|
| 278 | ! print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6) |
---|
| 279 | 9013 format(1x,I3,6E12.5) |
---|
| 280 | ! ENDDO |
---|
| 281 | |
---|
| 282 | IF (NAER == 0) THEN |
---|
| 283 | DO JSW=1,KSW |
---|
| 284 | DO JK=1,KLEV |
---|
| 285 | ZTAUA(JK,JSW)= 0.0_JPRB |
---|
| 286 | ZASYA(JK,JSW)= 0.0_JPRB |
---|
| 287 | ZOMGA(JK,JSW)= 1.0_JPRB |
---|
| 288 | ENDDO |
---|
| 289 | ENDDO |
---|
| 290 | ELSE |
---|
| 291 | DO JSW=1,KSW |
---|
| 292 | DO JK=1,KLEV |
---|
| 293 | IK=KLEV+1-JK |
---|
| 294 | ZTAUA(JK,JSW)=0.0_JPRB |
---|
| 295 | ZASYA(JK,JSW)=0.0_JPRB |
---|
| 296 | ZOMGA(JK,JSW)=0.0_JPRB |
---|
| 297 | DO JAE=1,6 |
---|
| 298 | ZTAUA(JK,JSW)=ZTAUA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) |
---|
| 299 | ZOMGA(JK,JSW)=ZOMGA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) & |
---|
| 300 | & *RSRPIZA(JSW,JAE) |
---|
| 301 | ZASYA(JK,JSW)=ZASYA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) & |
---|
| 302 | & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE) |
---|
| 303 | ENDDO |
---|
| 304 | IF (ZOMGA(JK,JSW) /= 0.0_JPRB) THEN |
---|
| 305 | ZASYA(JK,JSW)=ZASYA(JK,JSW)/ZOMGA(JK,JSW) |
---|
| 306 | ENDIF |
---|
| 307 | IF (ZTAUA(JK,JSW) /= 0.0_JPRB) THEN |
---|
| 308 | ZOMGA(JK,JSW)=ZOMGA(JK,JSW)/ZTAUA(JK,JSW) |
---|
| 309 | ENDIF |
---|
| 310 | ! print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW) |
---|
| 311 | 9003 format(1x,'Aerosols ',2I3,3F10.4) |
---|
| 312 | ENDDO |
---|
| 313 | ENDDO |
---|
| 314 | ENDIF |
---|
| 315 | |
---|
| 316 | DO JK=1,KLEV+1 |
---|
| 317 | ZBBCU(JK)=0.0_JPRB |
---|
| 318 | ZBBCD(JK)=0.0_JPRB |
---|
| 319 | ZBBFU(JK)=0.0_JPRB |
---|
| 320 | ZBBFD(JK)=0.0_JPRB |
---|
| 321 | ! ZUVCU(JK)=0.0_JPRB |
---|
| 322 | ! ZUVCD(JK)=0.0_JPRB |
---|
| 323 | ! ZUVFU(JK)=0.0_JPRB |
---|
| 324 | ! ZUVFD(JK)=0.0_JPRB |
---|
| 325 | ! ZVSCU(JK)=0.0_JPRB |
---|
| 326 | ! ZVSCD(JK)=0.0_JPRB |
---|
| 327 | ! ZVSFU(JK)=0.0_JPRB |
---|
| 328 | ! ZVSFD(JK)=0.0_JPRB |
---|
| 329 | ! ZNICU(JK)=0.0_JPRB |
---|
| 330 | ! ZNICD(JK)=0.0_JPRB |
---|
| 331 | ! ZNIFU(JK)=0.0_JPRB |
---|
| 332 | ! ZNIFD(JK)=0.0_JPRB |
---|
| 333 | ENDDO |
---|
| 334 | |
---|
| 335 | ! print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0 |
---|
| 336 | |
---|
| 337 | CALL SRTM_SPCVRT_MCICA & |
---|
| 338 | &( KLEV , ITMOL , KSW , KCOLS , ZONEMINUS,& |
---|
| 339 | & ZPAVEL , ZTAVEL , ZPZ , ZTZ , ZTBOUND , ZALBD , ZALBP,& |
---|
| 340 | & ZFRCL , ZTAUC , ZASYC , ZOMGC , ZTAUA , ZASYA , ZOMGA , ZRMU0,& |
---|
| 341 | & ZCOLDRY , ZWKL ,& |
---|
| 342 | & ILAYTROP, ILAYSWTCH, ILAYLOW,& |
---|
| 343 | & ZCO2MULT, ZCOLCH4 , ZCOLCO2, ZCOLH2O , ZCOLMOL , ZCOLN2O, ZCOLO2 , ZCOLO3,& |
---|
| 344 | & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,& |
---|
| 345 | & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,& |
---|
| 346 | & JP , JT , JT1 ,& |
---|
| 347 | & ZBBFD , ZBBFU , ZBBCD , ZBBCU ) |
---|
| 348 | |
---|
| 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 | !-- for testing only |
---|
| 371 | PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK) |
---|
| 372 | PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK) |
---|
| 373 | PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JK) |
---|
| 374 | PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JK) |
---|
| 375 | ENDDO |
---|
| 376 | ! ENDIF |
---|
| 377 | |
---|
| 378 | ! DO JK=1,KLEV+1 |
---|
| 379 | ! print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK) |
---|
| 380 | 9005 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3) |
---|
| 381 | ! ENDDO |
---|
| 382 | |
---|
| 383 | ELSE |
---|
| 384 | DO JK=1,KLEV+1 |
---|
| 385 | PFSUC(JL,1,JK)=0.0_JPRB |
---|
| 386 | PFSUC(JL,2,JK)=0.0_JPRB |
---|
| 387 | PFSUX(JL,1,JK)=0.0_JPRB |
---|
| 388 | PFSUX(JL,2,JK)=0.0_JPRB |
---|
| 389 | ENDDO |
---|
| 390 | ENDIF |
---|
| 391 | ENDDO |
---|
| 392 | |
---|
| 393 | !PRINT *,'OUT OF SRTM_224GP_MCICA' |
---|
| 394 | |
---|
| 395 | !----------------------------------------------------------------------- |
---|
| 396 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE) |
---|
| 397 | END SUBROUTINE SRTM_SRTM_224GP_MCICA |
---|