[3880] | 1 | SUBROUTINE SRTM_SRTM_224GP_MCICA & |
---|
| 2 | & ( KIDIA, KFDIA, KLON , KLEV , KSW , KCOLS , KCLDLY ,& |
---|
| 3 | & PAER , PALBD, PALBP, PAPH , PAP , PAERTAUS, PAERASYS, PAEROMGS ,& |
---|
| 4 | & PTS , PTH , PT ,& |
---|
| 5 | & PQ , PCO2 , PCH4 , PN2O , PNO2 , POZN , PRMU0 ,& |
---|
| 6 | & PFRCL, PTAUC, PASYC, POMGC,& |
---|
| 7 | & PFSUX, PFSUC, PFUVF, PFUVC, PPARF, PPARCF, PSUDU ,& |
---|
| 8 | & PFDIR, PCDIR, PFDIF, PCDIF, PSwDiffuseBand, PSwDirectBand, RII0) |
---|
| 9 | |
---|
| 10 | !----compiled for Cray with -h nopaattern---- |
---|
| 11 | |
---|
| 12 | !-- interface to RRTM_SW |
---|
| 13 | ! JJMorcrette 030225 |
---|
| 14 | ! JJMorcrette 20050110 McICA version |
---|
| 15 | ! JJMorcrette 20070614 bug-fix for solar duration |
---|
| 16 | ! JJMorcrette 20071015 3D fields of CO2, CH4, N2O and NO2 |
---|
| 17 | ! D.Salmond 31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC |
---|
| 18 | ! JJMorcrette 20091201 Total and clear-sky downward direct flux |
---|
| 19 | ! PBechtold+NSemane 09-Jul-2012 Gravity |
---|
| 20 | ! R J Hogan 20140627 Passing through PSwDn*SurfBand |
---|
| 21 | |
---|
| 22 | USE PARKIND1 , ONLY : JPIM, JPRB |
---|
| 23 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK |
---|
| 24 | USE YOMCST , ONLY : RG, RI0 |
---|
| 25 | USE YOERAD , ONLY : NSW, NAER, LApproxSwUpdate |
---|
| 26 | USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA |
---|
| 27 | USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL |
---|
| 28 | !USE YOMPHY3 , ONLY : RII0 |
---|
| 29 | USE YOMDYNCORE,ONLY : RPLRG |
---|
| 30 | USE YOM_YGFL , ONLY : YGFL |
---|
| 31 | |
---|
| 32 | IMPLICIT NONE |
---|
| 33 | |
---|
| 34 | !-- Input arguments |
---|
| 35 | |
---|
| 36 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
---|
| 37 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
---|
| 38 | INTEGER(KIND=JPIM),INTENT(IN) :: KSW |
---|
| 39 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
---|
| 40 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
---|
| 41 | INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS |
---|
| 42 | INTEGER(KIND=JPIM),INTENT(IN) :: KCLDLY(KCOLS) |
---|
| 43 | |
---|
| 44 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! top to bottom |
---|
| 45 | REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUS(KLON,KLEV,14), PAERASYS(KLON,KLEV,14), PAEROMGS(KLON,KLEV,14) |
---|
| 46 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,KSW) |
---|
| 47 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,KSW) |
---|
| 48 | REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) |
---|
| 49 | REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) |
---|
| 50 | REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) |
---|
| 51 | REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) |
---|
| 52 | REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) |
---|
| 53 | REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) |
---|
| 54 | REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV), PCH4(KLON,KLEV) |
---|
| 55 | REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV), PNO2(KLON,KLEV) |
---|
| 56 | REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) |
---|
| 57 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) |
---|
| 58 | |
---|
| 59 | REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top |
---|
| 60 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top |
---|
| 61 | REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KLON,KCOLS,KLEV) ! bottom to top |
---|
| 62 | REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KLON,KCOLS,KLEV) ! bottom to top |
---|
| 63 | |
---|
| 64 | !-- Output arguments |
---|
| 65 | |
---|
| 66 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUX(KLON,2,KLEV+1) |
---|
| 67 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUC(KLON,2,KLEV+1) |
---|
| 68 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUVF(KLON), PFUVC(KLON), PPARF(KLON), PPARCF(KLON) |
---|
| 69 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON) |
---|
| 70 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIF(KLON,KLEV+1), PCDIF(KLON,KLEV+1) |
---|
| 71 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIR(KLON,KLEV+1), PCDIR(KLON,KLEV+1) |
---|
| 72 | |
---|
| 73 | ! Surface diffuse and direct downwelling shortwave flux in each |
---|
| 74 | ! shortwave albedo band, used in RADINTG to update the surface fluxes |
---|
| 75 | ! accounting for high-resolution albedo information |
---|
| 76 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDiffuseBand(KLON,NSW) |
---|
| 77 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDirectBand (KLON,NSW) |
---|
| 78 | |
---|
| 79 | REAL(KIND=JPRB) ,INTENT(IN) :: RII0 |
---|
| 80 | !----------------------------------------------------------------------- |
---|
| 81 | |
---|
| 82 | !-- dummy integers |
---|
| 83 | |
---|
| 84 | INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR |
---|
| 85 | |
---|
| 86 | INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW, JB |
---|
| 87 | |
---|
| 88 | !-- dummy reals |
---|
| 89 | |
---|
| 90 | REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV) , ZPAVEL(KIDIA:KFDIA,KLEV) |
---|
| 91 | REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV) |
---|
| 92 | REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV) , ZCOLMOL(KIDIA:KFDIA,KLEV) , ZWKL(KIDIA:KFDIA,35,KLEV) |
---|
| 93 | REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV) , ZCOLCO2(KIDIA:KFDIA,KLEV) |
---|
| 94 | REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV) |
---|
| 95 | REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV) , ZCOLO3(KIDIA:KFDIA,KLEV) |
---|
| 96 | REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV) , ZFORFRAC(KIDIA:KFDIA,KLEV), ZSELFFAC(KIDIA:KFDIA,KLEV) |
---|
| 97 | REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV) |
---|
| 98 | REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV) , ZFAC01(KIDIA:KFDIA,KLEV) , ZFAC10(KIDIA:KFDIA,KLEV) |
---|
| 99 | REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV) |
---|
| 100 | REAL(KIND=JPRB) :: ZONEMINUS(KIDIA:KFDIA) , ZRMU0(KIDIA:KFDIA) , ZADJI0 |
---|
| 101 | REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW) , ZALBP(KIDIA:KFDIA,KSW) |
---|
| 102 | |
---|
| 103 | REAL(KIND=JPRB) :: ZFRCL(KIDIA:KFDIA,KCOLS,KLEV), ZTAUC(KIDIA:KFDIA,KLEV,KCOLS), & |
---|
| 104 | & ZASYC(KIDIA:KFDIA,KLEV,KCOLS) |
---|
| 105 | REAL(KIND=JPRB) :: ZOMGC(KIDIA:KFDIA,KLEV,KCOLS) |
---|
| 106 | REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,KLEV,KSW), ZASYA(KIDIA:KFDIA,KLEV,KSW), ZOMGA(KIDIA:KFDIA,KLEV,KSW) |
---|
| 107 | REAL(KIND=JPRB) :: ZFUVF(KIDIA:KFDIA), ZFUVC(KIDIA:KFDIA), ZPARF(KIDIA:KFDIA), ZPARCF(KIDIA:KFDIA), ZSUDU(KIDIA:KFDIA) |
---|
| 108 | |
---|
| 109 | REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,KLEV+1), ZBBCU(KIDIA:KFDIA,KLEV+1), ZBBFD(KIDIA:KFDIA,KLEV+1), & |
---|
| 110 | & ZBBFU(KIDIA:KFDIA,KLEV+1) |
---|
| 111 | REAL(KIND=JPRB) :: ZBBFDIR(KIDIA:KFDIA,KLEV+1),ZBBCDIR(KIDIA:KFDIA,KLEV+1) |
---|
| 112 | |
---|
| 113 | ! As PSw*Band but dimensioned KIDIA:KFDIA |
---|
| 114 | REAL(KIND=JPRB) :: ZSwDiffuseBand(KIDIA:KFDIA,NSW) |
---|
| 115 | REAL(KIND=JPRB) :: ZSwDirectBand (KIDIA:KFDIA,NSW) |
---|
| 116 | |
---|
| 117 | INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA) |
---|
| 118 | INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV), INDSELF(KIDIA:KFDIA,KLEV) |
---|
| 119 | INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV), JT(KIDIA:KFDIA,KLEV), JT1(KIDIA:KFDIA,KLEV) |
---|
| 120 | |
---|
| 121 | REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol) |
---|
| 122 | REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol) |
---|
| 123 | REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol) |
---|
| 124 | REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol) |
---|
| 125 | REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol) |
---|
| 126 | REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol) |
---|
| 127 | REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3 |
---|
| 128 | REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2 |
---|
| 129 | REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole) |
---|
| 130 | REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/sec2) |
---|
| 131 | REAL(KIND=JPRB) :: ZAMM(KIDIA:KFDIA) |
---|
| 132 | |
---|
| 133 | REAL(KIND=JPRB) :: ZRAMW ! Molecular weight of water vapor (g/mol) |
---|
| 134 | REAL(KIND=JPRB) :: ZRAMCO2 ! Molecular weight of carbon dioxide (g/mol) |
---|
| 135 | REAL(KIND=JPRB) :: ZRAMO ! Molecular weight of ozone (g/mol) |
---|
| 136 | REAL(KIND=JPRB) :: ZRAMCH4 ! Molecular weight of methane (g/mol) |
---|
| 137 | REAL(KIND=JPRB) :: ZRAMN2O ! Molecular weight of nitrous oxide (g/mol) |
---|
| 138 | |
---|
| 139 | ! Atomic weights for conversion from mass to volume mixing ratios; these |
---|
| 140 | ! are the same values used in ECRT to assure accurate conversion to vmr |
---|
| 141 | data ZAMD / 28.970_JPRB / |
---|
| 142 | data ZAMW / 18.0154_JPRB / |
---|
| 143 | data ZAMCO2 / 44.011_JPRB / |
---|
| 144 | data ZAMO / 47.9982_JPRB / |
---|
| 145 | data ZAMCH4 / 16.043_JPRB / |
---|
| 146 | data ZAMN2O / 44.013_JPRB / |
---|
| 147 | data ZAMC11 / 137.3686_JPRB / |
---|
| 148 | data ZAMC12 / 120.9140_JPRB / |
---|
| 149 | data ZAVGDRO/ 6.02214E23_JPRB / |
---|
| 150 | data ZRAMW / 0.05550_JPRB / |
---|
| 151 | data ZRAMCO2 / 0.02272_JPRB / |
---|
| 152 | data ZRAMO / 0.02083_JPRB / |
---|
| 153 | data ZRAMCH4 / 0.06233_JPRB / |
---|
| 154 | data ZRAMN2O / 0.02272_JPRB / |
---|
| 155 | |
---|
| 156 | |
---|
| 157 | !REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZTOTCC |
---|
| 158 | REAL(KIND=JPRB) :: ZEPSEC |
---|
| 159 | |
---|
| 160 | INTEGER(KIND=JPIM) :: IOVLP, IC, ICOUNT, INDEX(KIDIA:KFDIA) |
---|
| 161 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 162 | |
---|
| 163 | |
---|
| 164 | #include "srtm_setcoef.intfb.h" |
---|
| 165 | #include "srtm_spcvrt_mcica.intfb.h" |
---|
| 166 | |
---|
| 167 | |
---|
| 168 | !----------------------------------------------------------------------- |
---|
| 169 | !-- calculate information needed ny the radiative transfer routine |
---|
| 170 | |
---|
| 171 | ASSOCIATE(NFLEVG=>KLEV, & |
---|
| 172 | & NACTAERO=>YGFL%NACTAERO) |
---|
| 173 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE) |
---|
| 174 | ZGRAVIT =(RG/RPLRG)*1.E2_JPRB |
---|
| 175 | ZEPSEC = 1.E-06_JPRB |
---|
| 176 | ZONEMINUS=1.0_JPRB - ZEPSEC |
---|
| 177 | ZADJI0 = RII0 / RI0 |
---|
| 178 | !-- overlap: 1=max-ran, 2=maximum, 3=random N.B.: irrelevant in McICA version |
---|
| 179 | IOVLP=3 |
---|
| 180 | |
---|
| 181 | IC=0 |
---|
| 182 | DO JL = KIDIA, KFDIA |
---|
| 183 | IF (PRMU0(JL) > 0.0_JPRB) THEN |
---|
| 184 | IC=IC+1 |
---|
| 185 | INDEX(IC)=JL |
---|
| 186 | ENDIF |
---|
| 187 | ENDDO |
---|
| 188 | ICOUNT=IC |
---|
| 189 | |
---|
| 190 | ICLDATM = 1 |
---|
| 191 | INFLAG = 2 |
---|
| 192 | ICEFLAG = 3 |
---|
| 193 | I_LIQFLAG= 1 |
---|
| 194 | ITMOL = 7 |
---|
| 195 | I_NSTR = 2 |
---|
| 196 | |
---|
| 197 | DO JSW=1,KCOLS |
---|
| 198 | DO JK=1,KLEV |
---|
| 199 | DO JL = KIDIA, KFDIA |
---|
| 200 | ZFRCL(JL,JSW,JK) = PFRCL(JL,JSW,JK) |
---|
| 201 | ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK) |
---|
| 202 | ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK) |
---|
| 203 | ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK) |
---|
| 204 | ENDDO |
---|
| 205 | ENDDO |
---|
| 206 | ENDDO |
---|
| 207 | |
---|
| 208 | ZRMU0(KIDIA:KFDIA)=PRMU0(KIDIA:KFDIA) |
---|
| 209 | PFUVF(KIDIA:KFDIA)=0._JPRB |
---|
| 210 | PFUVC(KIDIA:KFDIA)=0._JPRB |
---|
| 211 | PPARF(KIDIA:KFDIA)=0._JPRB |
---|
| 212 | PPARCF(KIDIA:KFDIA)=0._JPRB |
---|
| 213 | |
---|
| 214 | !- coefficients related to the cloud optical properties (original RRTM_SW) |
---|
| 215 | |
---|
| 216 | !- coefficients for the temperature and pressure dependence of the |
---|
| 217 | ! molecular absorption coefficients |
---|
| 218 | |
---|
| 219 | DO J1=1,35 |
---|
| 220 | DO J2=1,KLEV |
---|
| 221 | DO IC=1,ICOUNT |
---|
| 222 | JL=INDEX(IC) |
---|
| 223 | ZWKL(JL,J1,J2)=0.0_JPRB |
---|
| 224 | ENDDO |
---|
| 225 | ENDDO |
---|
| 226 | ENDDO |
---|
| 227 | |
---|
| 228 | DO IC=1,ICOUNT |
---|
| 229 | JL=INDEX(IC) |
---|
| 230 | ZPZ(JL,0) = paph(JL,klev+1)*0.01_JPRB |
---|
| 231 | ENDDO |
---|
| 232 | |
---|
| 233 | !ZCLEAR=1.0_JPRB |
---|
| 234 | !ZCLOUD=0.0_JPRB |
---|
| 235 | !ZTOTCC=0.0_JPRB |
---|
| 236 | |
---|
| 237 | DO JK = 1, KLEV |
---|
| 238 | DO IC=1,ICOUNT |
---|
| 239 | JL=INDEX(IC) |
---|
| 240 | ZPAVEL(JL,JK) = pap(JL,KLEV-JK+1) *0.01_JPRB |
---|
| 241 | ZTAVEL(JL,JK) = pt (JL,KLEV-JK+1) |
---|
| 242 | ZPZ(JL,JK) = paph(JL,KLEV-JK+1) *0.01_JPRB |
---|
| 243 | ZWKL(JL,1,JK) = pq(JL,KLEV-JK+1) *ZAMD*ZRAMW |
---|
| 244 | ZWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD*ZRAMCO2 |
---|
| 245 | ZWKL(JL,3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*ZRAMO |
---|
| 246 | ZWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD*ZRAMN2O |
---|
| 247 | ZWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD*ZRAMCH4 |
---|
| 248 | !O2 volume mixing ratio |
---|
| 249 | ZWKL(JL,7,JK) = 0.20944_JPRB |
---|
| 250 | ZAMM(JL) = (1-ZWKL(JL,1,JK))*ZAMD + ZWKL(JL,1,JK)*ZAMW |
---|
| 251 | ZCOLDRY(JL,JK) = (ZPZ(JL,JK-1)-ZPZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM(JL)*(1+ZWKL(JL,1,JK))) |
---|
| 252 | ENDDO |
---|
| 253 | ENDDO |
---|
| 254 | |
---|
| 255 | DO IMOL=1,ITMOL |
---|
| 256 | DO JK=1,KLEV |
---|
| 257 | DO IC=1,ICOUNT |
---|
| 258 | JL=INDEX(IC) |
---|
| 259 | ZWKL(JL,IMOL,JK)=ZCOLDRY(JL,JK)* ZWKL(JL,IMOL,JK) |
---|
| 260 | ENDDO |
---|
| 261 | ENDDO |
---|
| 262 | ENDDO |
---|
| 263 | |
---|
| 264 | CALL SRTM_SETCOEF & |
---|
| 265 | & ( KIDIA , KFDIA , KLEV,& |
---|
| 266 | & ZPAVEL , ZTAVEL,& |
---|
| 267 | & ZCOLDRY , ZWKL,& |
---|
| 268 | & ILAYTROP,& |
---|
| 269 | & ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLO2 , ZCOLO3,& |
---|
| 270 | & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, & |
---|
| 271 | & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,& |
---|
| 272 | & JP , JT , JT1 , ZRMU0 & |
---|
| 273 | & ) |
---|
| 274 | |
---|
| 275 | !- call the radiation transfer routine |
---|
| 276 | |
---|
| 277 | DO JSW=1,KSW |
---|
| 278 | DO IC=1,ICOUNT |
---|
| 279 | JL=INDEX(IC) |
---|
| 280 | ZALBD(JL,JSW)=PALBD(JL,JSW) |
---|
| 281 | ZALBP(JL,JSW)=PALBP(JL,JSW) |
---|
| 282 | ENDDO |
---|
| 283 | ENDDO |
---|
| 284 | |
---|
| 285 | !- mixing of aerosols |
---|
| 286 | |
---|
| 287 | IF (NAER == 0) THEN |
---|
| 288 | DO JSW=1,KSW |
---|
| 289 | DO JK=1,KLEV |
---|
| 290 | DO IC=1,ICOUNT |
---|
| 291 | JL=INDEX(IC) |
---|
| 292 | ZTAUA(JL,JK,JSW)= 0.0_JPRB |
---|
| 293 | ZASYA(JL,JK,JSW)= 0.0_JPRB |
---|
| 294 | ZOMGA(JL,JK,JSW)= 1.0_JPRB |
---|
| 295 | ENDDO |
---|
| 296 | ENDDO |
---|
| 297 | ENDDO |
---|
| 298 | ELSE |
---|
| 299 | |
---|
| 300 | !- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays |
---|
| 301 | |
---|
| 302 | IF (LAERRRTM) THEN |
---|
| 303 | IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN |
---|
| 304 | DO JSW=1,KSW |
---|
| 305 | DO JK=1,KLEV |
---|
| 306 | IK=KLEV-JK+1 |
---|
| 307 | DO IC=1,ICOUNT |
---|
| 308 | JL=INDEX(IC) |
---|
| 309 | ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW) |
---|
| 310 | ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW) |
---|
| 311 | ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW) |
---|
| 312 | ENDDO |
---|
| 313 | ENDDO |
---|
| 314 | ENDDO |
---|
| 315 | |
---|
| 316 | ELSEIF (.NOT.LAERCSTR) THEN |
---|
| 317 | DO JSW=1,KSW |
---|
| 318 | DO JK=1,KLEV |
---|
| 319 | IK=KLEV-JK+1 |
---|
| 320 | DO IC=1,ICOUNT |
---|
| 321 | JL=INDEX(IC) |
---|
| 322 | ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK) |
---|
| 323 | ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6) |
---|
| 324 | ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)*RSRASYA(JSW,6) |
---|
| 325 | IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN |
---|
| 326 | ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW) |
---|
| 327 | ENDIF |
---|
| 328 | IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN |
---|
| 329 | ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW) |
---|
| 330 | ENDIF |
---|
| 331 | ENDDO |
---|
| 332 | ENDDO |
---|
| 333 | ENDDO |
---|
| 334 | ENDIF |
---|
| 335 | |
---|
| 336 | ELSE |
---|
| 337 | |
---|
| 338 | !- Otherwise, fill RRTM aerosol arrays with operational ECMWF aerosols, |
---|
| 339 | ! do the mixing and distribute over the 14 spectral intervals |
---|
| 340 | |
---|
| 341 | DO JSW=1,KSW |
---|
| 342 | DO JK=1,KLEV |
---|
| 343 | DO IC=1,ICOUNT |
---|
| 344 | JL=INDEX(IC) |
---|
| 345 | IK=KLEV+1-JK |
---|
| 346 | ZTAUA(JL,JK,JSW)=0.0_JPRB |
---|
| 347 | ZASYA(JL,JK,JSW)=0.0_JPRB |
---|
| 348 | ZOMGA(JL,JK,JSW)=0.0_JPRB |
---|
| 349 | !CDIR UNROLL=6 |
---|
| 350 | DO JAE=1,6 |
---|
| 351 | ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) |
---|
| 352 | ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) & |
---|
| 353 | & *RSRPIZA(JSW,JAE) |
---|
| 354 | ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) & |
---|
| 355 | & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE) |
---|
| 356 | ENDDO |
---|
| 357 | IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN |
---|
| 358 | ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW) |
---|
| 359 | ENDIF |
---|
| 360 | IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN |
---|
| 361 | ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW) |
---|
| 362 | ENDIF |
---|
| 363 | ENDDO |
---|
| 364 | ENDDO |
---|
| 365 | ENDDO |
---|
| 366 | ENDIF |
---|
| 367 | ENDIF |
---|
| 368 | |
---|
| 369 | DO JK=1,KLEV+1 |
---|
| 370 | DO IC=1,ICOUNT |
---|
| 371 | JL=INDEX(IC) |
---|
| 372 | ZBBCU(JL,JK)=0.0_JPRB |
---|
| 373 | ZBBCD(JL,JK)=0.0_JPRB |
---|
| 374 | ZBBFU(JL,JK)=0.0_JPRB |
---|
| 375 | ZBBFD(JL,JK)=0.0_JPRB |
---|
| 376 | ZBBFDIR(JL,JK)=0.0_JPRB |
---|
| 377 | ZBBCDIR(JL,JK)=0.0_JPRB |
---|
| 378 | ENDDO |
---|
| 379 | ENDDO |
---|
| 380 | |
---|
| 381 | DO IC=1,ICOUNT |
---|
| 382 | JL=INDEX(IC) |
---|
| 383 | ZFUVF(JL)=0.0_JPRB |
---|
| 384 | ZFUVC(JL)=0.0_JPRB |
---|
| 385 | ZPARF(JL)=0.0_JPRB |
---|
| 386 | ZPARCF(JL)=0.0_JPRB |
---|
| 387 | ZSUDU(JL)=0.0_JPRB |
---|
| 388 | ENDDO |
---|
| 389 | |
---|
| 390 | CALL SRTM_SPCVRT_MCICA & |
---|
| 391 | &( KIDIA , KFDIA , KLEV , KSW , KCOLS , ZONEMINUS,& |
---|
| 392 | & ZALBD , ZALBP,& |
---|
| 393 | & ZFRCL , ZTAUC , ZASYC , ZOMGC ,& |
---|
| 394 | & ZTAUA , ZASYA , ZOMGA , ZRMU0,& |
---|
| 395 | & ILAYTROP,& |
---|
| 396 | & ZCOLCH4 , ZCOLCO2 , ZCOLH2O, ZCOLMOL , ZCOLO2 , ZCOLO3,& |
---|
| 397 | & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,& |
---|
| 398 | & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,& |
---|
| 399 | & JP , JT , JT1 ,& |
---|
| 400 | & ZBBFD , ZBBFU , ZBBCD , ZBBCU , ZFUVF , ZFUVC, ZPARF, ZPARCF, ZSUDU,& |
---|
| 401 | & ZBBFDIR , ZBBCDIR , ZSwDiffuseBand, ZSwDirectBand) |
---|
| 402 | |
---|
| 403 | DO JK=1,KLEV+1 |
---|
| 404 | DO IC=1,ICOUNT |
---|
| 405 | JL=INDEX(IC) |
---|
| 406 | PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK) |
---|
| 407 | PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK) |
---|
| 408 | PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JL,JK) |
---|
| 409 | PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JL,JK) |
---|
| 410 | PFDIR(JL,JK) =ZADJI0 * ZBBFDIR(JL,JK) |
---|
| 411 | PCDIR(JL,JK) =ZADJI0 * ZBBCDIR(JL,JK) |
---|
| 412 | PFDIF(JL,JK) =PFSUX(JL,2,JK)-PFDIR(JL,JK) |
---|
| 413 | PCDIF(JL,JK) =PFSUC(JL,2,JK)-PCDIR(JL,JK) |
---|
| 414 | ENDDO |
---|
| 415 | ENDDO |
---|
| 416 | |
---|
| 417 | IF (LApproxSwUpdate) THEN |
---|
| 418 | DO JB=1,NSW |
---|
| 419 | DO IC=1,ICOUNT |
---|
| 420 | JL=INDEX(IC) |
---|
| 421 | PSwDiffuseBand(JL,JB) = ZADJI0 * ZSwDiffuseBand(JL,JB) |
---|
| 422 | PSwDirectBand (JL,JB) = ZADJI0 * ZSwDirectBand (JL,JB) |
---|
| 423 | ENDDO |
---|
| 424 | ENDDO |
---|
| 425 | ENDIF |
---|
| 426 | |
---|
| 427 | DO IC=1,ICOUNT |
---|
| 428 | JL=INDEX(IC) |
---|
| 429 | PFUVF(JL) =ZADJI0 * ZFUVF(JL) |
---|
| 430 | PFUVC(JL) =ZADJI0 * ZFUVC(JL) |
---|
| 431 | PPARF(JL) =ZADJI0 * ZPARF(JL) |
---|
| 432 | PPARCF(JL)=ZADJI0 * ZPARCF(JL) |
---|
| 433 | PSUDU(JL) =ZADJI0 * ZSUDU(JL) |
---|
| 434 | ENDDO |
---|
| 435 | |
---|
| 436 | DO JK=1,KLEV+1 |
---|
| 437 | DO IC=1,ICOUNT |
---|
| 438 | JL=INDEX(IC) |
---|
| 439 | IF (PRMU0(JL) <= 0.0_JPRB) THEN |
---|
| 440 | PFSUC(JL,1,JK)=0.0_JPRB |
---|
| 441 | PFSUC(JL,2,JK)=0.0_JPRB |
---|
| 442 | PFSUX(JL,1,JK)=0.0_JPRB |
---|
| 443 | PFSUX(JL,2,JK)=0.0_JPRB |
---|
| 444 | PFDIR(JL,JK) =0.0_JPRB |
---|
| 445 | PCDIR(JL,JK) =0.0_JPRB |
---|
| 446 | ENDIF |
---|
| 447 | ENDDO |
---|
| 448 | ENDDO |
---|
| 449 | DO IC=1,ICOUNT |
---|
| 450 | JL=INDEX(IC) |
---|
| 451 | IF (PRMU0(JL) <= 0.0_JPRB) THEN |
---|
| 452 | PFUVF(JL) =0.0_JPRB |
---|
| 453 | PFUVC(JL) =0.0_JPRB |
---|
| 454 | PPARF(JL) =0.0_JPRB |
---|
| 455 | PPARCF(JL)=0.0_JPRB |
---|
| 456 | PSUDU(JL)=0.0_JPRB |
---|
| 457 | ENDIF |
---|
| 458 | ENDDO |
---|
| 459 | |
---|
| 460 | !----------------------------------------------------------------------- |
---|
| 461 | IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE) |
---|
| 462 | END ASSOCIATE |
---|
| 463 | END SUBROUTINE SRTM_SRTM_224GP_MCICA |
---|