[2027] | 1 | ! |
---|
| 2 | ! $Id: srtm_srtm_224gp.F90 2027 2014-04-29 13:38:53Z abarral $ |
---|
| 3 | ! |
---|
[1989] | 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 |
---|
[2027] | 20 | !USE YOERDI , ONLY : RCH4 , RN2O |
---|
[1989] | 21 | USE YOERAD , ONLY : NAER |
---|
| 22 | USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA |
---|
| 23 | USE YOMPHY3 , ONLY : RII0 |
---|
| 24 | USE YOMCST , ONLY : RI0 |
---|
| 25 | |
---|
[2027] | 26 | |
---|
| 27 | |
---|
[1989] | 28 | IMPLICIT NONE |
---|
| 29 | |
---|
[2027] | 30 | #include "clesphys.h" |
---|
| 31 | |
---|
[1989] | 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 | |
---|