[3908] | 1 | SUBROUTINE RRTM_ECRT_140GP_MCICA & |
---|
| 2 | &( KIDIA, KFDIA, KLON, KLEV, KCOLS ,& |
---|
| 3 | & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, & |
---|
| 4 | & PTS , PTH , PT , & |
---|
| 5 | & PEMIS, PEMIW, & |
---|
| 6 | & PQ , PCO2 , PCH4, PN2O , PNO2, PC11, PC12, PC22, PCL4, POZN, PCLDF , PTAUCLDI, & |
---|
| 7 | & PCLDFRAC, PTAUCLD, PCOLDRY, PWBRODL, PWKL, PWX , & |
---|
| 8 | & PTAUAERL, PAVEL , PTAVEL , PZ , PTZ , PTBOUND, PSEMISS , KREFLECT) |
---|
| 9 | |
---|
| 10 | !----compiled for Cray with -h nopattern---- |
---|
| 11 | |
---|
| 12 | ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
---|
| 13 | |
---|
| 14 | ! Read in atmospheric profile from ECMWF radiation code, and prepare it |
---|
| 15 | ! for use in RRTM. Set other RRTM input parameters. Values are passed |
---|
| 16 | ! back through existing RRTM arrays and commons. |
---|
| 17 | |
---|
| 18 | !- Modifications |
---|
| 19 | |
---|
| 20 | ! 2000-05-15 Deborah Salmond Speed-up |
---|
| 21 | ! JJMorcrette 20050110 McICA version |
---|
| 22 | ! NEC 25-Oct-2007 Optimisations |
---|
| 23 | ! PBechtold+NSemane 09-Jul-2012 Gravity |
---|
| 24 | ! 201305 ABozzo PWBRODL,O2 |
---|
| 25 | |
---|
| 26 | USE PARKIND1 , ONLY : JPIM, JPRB |
---|
| 27 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK |
---|
| 28 | USE YOMCST , ONLY : RG |
---|
| 29 | USE PARRRTM , ONLY : JPBAND, JPXSEC, JPINPX |
---|
| 30 | USE YOERAD , ONLY : NSPMAPL |
---|
| 31 | USE YOESW , ONLY : RAER |
---|
| 32 | USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL |
---|
| 33 | USE YOM_YGFL , ONLY : YGFL |
---|
| 34 | USE YOMDYNCORE,ONLY : RPLRG |
---|
| 35 | |
---|
| 36 | !------------------------------Arguments-------------------------------- |
---|
| 37 | |
---|
| 38 | IMPLICIT NONE |
---|
| 39 | |
---|
| 40 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes) |
---|
| 41 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers |
---|
| 42 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA |
---|
| 43 | INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS |
---|
| 44 | |
---|
| 45 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness |
---|
| 46 | REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16) |
---|
| 47 | REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa) |
---|
| 48 | REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa) |
---|
| 49 | REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (K) |
---|
| 50 | REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (K) |
---|
| 51 | REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (K) |
---|
| 52 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) ! Non-window surface emissivity |
---|
| 53 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) ! Window surface emissivity |
---|
| 54 | REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr) |
---|
| 55 | REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio |
---|
| 56 | REAL(KIND=JPRB) ,INTENT(IN) :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio |
---|
| 57 | REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV) ! N2O mass mixing ratio |
---|
| 58 | REAL(KIND=JPRB) ,INTENT(IN) :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio |
---|
| 59 | REAL(KIND=JPRB) ,INTENT(IN) :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio |
---|
| 60 | REAL(KIND=JPRB) ,INTENT(IN) :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio |
---|
| 61 | REAL(KIND=JPRB) ,INTENT(IN) :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio |
---|
| 62 | REAL(KIND=JPRB) ,INTENT(IN) :: PCL4(KLON,KLEV) ! CCL4 mass mixing ratio |
---|
| 63 | REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio |
---|
| 64 | |
---|
| 65 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KCOLS,KLEV) ! Cloud fraction |
---|
| 66 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLDI(KLON,KLEV,KCOLS) ! Cloud optical depth |
---|
| 67 | |
---|
| 68 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV) ! Cloud fraction |
---|
| 69 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUCLD(KIDIA:KFDIA,KLEV,KCOLS) ! Spectral optical thickness |
---|
| 70 | |
---|
| 71 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLDRY(KIDIA:KFDIA,KLEV) |
---|
| 72 | REAL(KIND=JPRB) ,INTENT(OUT) :: PWBRODL(KIDIA:KFDIA,KLEV) ! broadening gas column density (mol/cm2) |
---|
| 73 | REAL(KIND=JPRB) ,INTENT(OUT) :: PWKL(KIDIA:KFDIA,JPINPX,KLEV) |
---|
| 74 | REAL(KIND=JPRB) ,INTENT(OUT) :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases |
---|
| 75 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND) |
---|
| 76 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAVEL(KIDIA:KFDIA,KLEV) |
---|
| 77 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTAVEL(KIDIA:KFDIA,KLEV) |
---|
| 78 | REAL(KIND=JPRB) ,INTENT(OUT) :: PZ(KIDIA:KFDIA,0:KLEV) |
---|
| 79 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTZ(KIDIA:KFDIA,0:KLEV) |
---|
| 80 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTBOUND(KIDIA:KFDIA) |
---|
| 81 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSEMISS(KIDIA:KFDIA,JPBAND) |
---|
| 82 | INTEGER(KIND=JPIM),INTENT(OUT) :: KREFLECT(KIDIA:KFDIA) |
---|
| 83 | |
---|
| 84 | ! real rch4 ! CH4 mass mixing ratio |
---|
| 85 | ! real rn2o ! N2O mass mixing ratio |
---|
| 86 | ! real rcfc11 ! CFC11 mass mixing ratio |
---|
| 87 | ! real rcfc12 ! CFC12 mass mixing ratio |
---|
| 88 | ! real rcfc22 ! CFC22 mass mixing ratio |
---|
| 89 | ! real rccl4 ! CCl4 mass mixing ratio |
---|
| 90 | !- from AER |
---|
| 91 | !- from PROFILE |
---|
| 92 | !- from SURFACE |
---|
| 93 | REAL(KIND=JPRB) :: ztauaer(5) |
---|
| 94 | REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol) |
---|
| 95 | REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol) |
---|
| 96 | REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol) |
---|
| 97 | REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol) |
---|
| 98 | REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol) |
---|
| 99 | REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol) |
---|
| 100 | REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3 |
---|
| 101 | REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2 |
---|
| 102 | REAL(KIND=JPRB) :: ZAMC22 ! Molecular weight of CFC22 (g/mol) - CHF2CL |
---|
| 103 | REAL(KIND=JPRB) :: ZAMCL4 ! Molecular weight of CCl4 (g/mol) - CCL4 |
---|
| 104 | REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole) |
---|
| 105 | REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/s**2) |
---|
| 106 | |
---|
| 107 | REAL(KIND=JPRB) :: ZSUMMOL |
---|
| 108 | |
---|
| 109 | ! Atomic weights for conversion from mass to volume mixing ratios; these |
---|
| 110 | ! are the same values used in ECRT to assure accurate conversion to vmr |
---|
| 111 | data ZAMD / 28.970_JPRB / |
---|
| 112 | data ZAMW / 18.0154_JPRB / |
---|
| 113 | data ZAMCO2 / 44.011_JPRB / |
---|
| 114 | data ZAMO / 47.9982_JPRB / |
---|
| 115 | data ZAMCH4 / 16.043_JPRB / |
---|
| 116 | data ZAMN2O / 44.013_JPRB / |
---|
| 117 | data ZAMC11 / 137.3686_JPRB / |
---|
| 118 | data ZAMC12 / 120.9140_JPRB / |
---|
| 119 | data ZAMC22 / 86.4690_JPRB / |
---|
| 120 | data ZAMCL4 / 153.8230_JPRB / |
---|
| 121 | data ZAVGDRO/ 6.02214E23_JPRB / |
---|
| 122 | |
---|
| 123 | INTEGER(KIND=JPIM) :: IATM, JMOL, IXMAX, J1, J2, IAE, IKL, JK, JCOLS, JL, JLW |
---|
| 124 | INTEGER(KIND=JPIM) :: ITMOL, INXMOL |
---|
| 125 | |
---|
| 126 | REAL(KIND=JPRB) :: ZAMM |
---|
| 127 | |
---|
| 128 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 129 | |
---|
| 130 | ! *** |
---|
| 131 | |
---|
| 132 | ! *** mji |
---|
| 133 | ! Initialize all molecular amounts and aerosol optical depths to zero here, |
---|
| 134 | ! then pass ECRT amounts into RRTM arrays below. |
---|
| 135 | |
---|
| 136 | ! DATA ZWKL /MAXPRDW*0.0/ |
---|
| 137 | ! DATA ZWX /MAXPROD*0.0/ |
---|
| 138 | ! DATA KREFLECT /0/ |
---|
| 139 | |
---|
| 140 | ! Activate cross section molecules: |
---|
| 141 | ! NXMOL - number of cross-sections input by user |
---|
| 142 | ! IXINDX(I) - index of cross-section molecule corresponding to Ith |
---|
| 143 | ! cross-section specified by user |
---|
| 144 | ! = 0 -- not allowed in RRTM |
---|
| 145 | ! = 1 -- CCL4 |
---|
| 146 | ! = 2 -- CFC11 |
---|
| 147 | ! = 3 -- CFC12 |
---|
| 148 | ! = 4 -- CFC22 |
---|
| 149 | ! DATA KXMOL /2/ |
---|
| 150 | ! DATA KXINDX /0,2,3,0,31*0/ |
---|
| 151 | |
---|
| 152 | ! IREFLECT=KREFLECT |
---|
| 153 | ! NXMOL=KXMOL |
---|
| 154 | |
---|
| 155 | ASSOCIATE(NFLEVG=>KLEV, & |
---|
| 156 | & NACTAERO=>YGFL%NACTAERO) |
---|
| 157 | IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',0,ZHOOK_HANDLE) |
---|
| 158 | |
---|
| 159 | ZGRAVIT=(RG/RPLRG)*1.E2_JPRB |
---|
| 160 | |
---|
| 161 | DO JL = KIDIA, KFDIA |
---|
| 162 | KREFLECT(JL)=0 |
---|
| 163 | INXMOL=2 |
---|
| 164 | ENDDO |
---|
| 165 | |
---|
| 166 | !DO J1=1,35 |
---|
| 167 | ! IXINDX(J1)=0 |
---|
| 168 | DO J2=1,KLEV |
---|
| 169 | DO J1=1,35 |
---|
| 170 | DO JL = KIDIA, KFDIA |
---|
| 171 | PWKL(JL,J1,J2)=0.0_JPRB |
---|
| 172 | ENDDO |
---|
| 173 | ENDDO |
---|
| 174 | ENDDO |
---|
| 175 | !IXINDX(2)=2 |
---|
| 176 | !IXINDX(3)=3 |
---|
| 177 | |
---|
| 178 | ! Set parameters needed for RRTM execution: |
---|
| 179 | IATM = 0 |
---|
| 180 | ! IXSECT = 1 |
---|
| 181 | ! NUMANGS = 0 |
---|
| 182 | ! IOUT = -1 |
---|
| 183 | IXMAX = 4 |
---|
| 184 | |
---|
| 185 | ! Bands 6,7,8 are considered the 'window' and allowed to have a |
---|
| 186 | ! different surface emissivity (as in ECMWF). Eli wrote this part.... |
---|
| 187 | DO JL = KIDIA, KFDIA |
---|
| 188 | PSEMISS(JL,1) = PEMIS(JL) |
---|
| 189 | PSEMISS(JL,2) = PEMIS(JL) |
---|
| 190 | PSEMISS(JL,3) = PEMIS(JL) |
---|
| 191 | PSEMISS(JL,4) = PEMIS(JL) |
---|
| 192 | PSEMISS(JL,5) = PEMIS(JL) |
---|
| 193 | PSEMISS(JL,6) = PEMIW(JL) |
---|
| 194 | PSEMISS(JL,7) = PEMIW(JL) |
---|
| 195 | PSEMISS(JL,8) = PEMIW(JL) |
---|
| 196 | PSEMISS(JL,9) = PEMIS(JL) |
---|
| 197 | PSEMISS(JL,10) = PEMIS(JL) |
---|
| 198 | PSEMISS(JL,11) = PEMIS(JL) |
---|
| 199 | PSEMISS(JL,12) = PEMIS(JL) |
---|
| 200 | PSEMISS(JL,13) = PEMIS(JL) |
---|
| 201 | PSEMISS(JL,14) = PEMIS(JL) |
---|
| 202 | PSEMISS(JL,15) = PEMIS(JL) |
---|
| 203 | PSEMISS(JL,16) = PEMIS(JL) |
---|
| 204 | |
---|
| 205 | ! Set surface temperature. |
---|
| 206 | |
---|
| 207 | PTBOUND(JL) = PTS(JL) |
---|
| 208 | |
---|
| 209 | ! Install ECRT arrays into RRTM arrays for pressure, temperature, |
---|
| 210 | ! and molecular amounts. Pressures are converted from Pascals |
---|
| 211 | ! (ECRT) to mb (RRTM). H2O, CO2, O3 and trace gas amounts are |
---|
| 212 | ! converted from mass mixing ratio to volume mixing ratio. CO2 |
---|
| 213 | ! converted with same dry air and CO2 molecular weights used in |
---|
| 214 | ! ECRT to assure correct conversion back to the proper CO2 vmr. |
---|
| 215 | ! The dry air column COLDRY (in molec/cm2) is calculated from |
---|
| 216 | ! the level pressures PZ (in mb) based on the hydrostatic equation |
---|
| 217 | ! and includes a correction to account for H2O in the layer. The |
---|
| 218 | ! molecular weight of moist air (amm) is calculated for each layer. |
---|
| 219 | ! Note: RRTM levels count from bottom to top, while the ECRT input |
---|
| 220 | ! variables count from the top down and must be reversed |
---|
| 221 | ITMOL = 7 |
---|
| 222 | PZ(JL,0) = PAPH(JL,KLEV+1)/100._JPRB |
---|
| 223 | PTZ(JL,0) = PTH(JL,KLEV+1) |
---|
| 224 | ENDDO |
---|
| 225 | |
---|
| 226 | DO JK = 1, KLEV |
---|
| 227 | DO JL = KIDIA, KFDIA |
---|
| 228 | PAVEL(JL,JK) = PAP(JL,KLEV-JK+1)/100._JPRB |
---|
| 229 | PTAVEL(JL,JK) = PT(JL,KLEV-JK+1) |
---|
| 230 | PZ(JL,JK) = PAPH(JL,KLEV-JK+1)/100._JPRB |
---|
| 231 | PTZ(JL,JK) = PTH(JL,KLEV-JK+1) |
---|
| 232 | PWKL(JL,1,JK) = PQ(JL,KLEV-JK+1)*ZAMD/ZAMW |
---|
| 233 | PWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD/ZAMCO2 |
---|
| 234 | PWKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*ZAMD/ZAMO |
---|
| 235 | PWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD/ZAMN2O |
---|
| 236 | PWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD/ZAMCH4 |
---|
| 237 | PWKL(JL,7,JK) = 0.209488_JPRB |
---|
| 238 | ZAMM = (1.0_JPRB-PWKL(JL,1,JK))*ZAMD + PWKL(JL,1,JK)*ZAMW |
---|
| 239 | PCOLDRY(JL,JK) = (PZ(JL,JK-1)-PZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1.0_JPRB+PWKL(JL,1,JK))) |
---|
| 240 | ENDDO |
---|
| 241 | ENDDO |
---|
| 242 | |
---|
| 243 | !- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays |
---|
| 244 | |
---|
| 245 | IF (LAERRRTM) THEN |
---|
| 246 | IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN |
---|
| 247 | DO JLW=1,16 |
---|
| 248 | DO JK=1,KLEV |
---|
| 249 | IKL=KLEV-JK+1 |
---|
| 250 | DO JL=KIDIA,KFDIA |
---|
| 251 | PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW) |
---|
| 252 | ENDDO |
---|
| 253 | ENDDO |
---|
| 254 | ENDDO |
---|
| 255 | |
---|
| 256 | ELSEIF (.NOT.LAERCSTR) THEN |
---|
| 257 | DO JLW=1,16 |
---|
| 258 | DO JK=1,KLEV |
---|
| 259 | IKL=KLEV-JK+1 |
---|
| 260 | DO JL=KIDIA,KFDIA |
---|
| 261 | PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW)+RAER(NSPMAPL(JLW),6)*PAER(JL,6,IKL) |
---|
| 262 | ENDDO |
---|
| 263 | ENDDO |
---|
| 264 | ENDDO |
---|
| 265 | ENDIF |
---|
| 266 | |
---|
| 267 | ELSE |
---|
| 268 | |
---|
| 269 | !- Fill RRTM aerosol arrays with operational ECMWF aerosols, |
---|
| 270 | ! do the mixing and distribute over the 16 spectral intervals |
---|
| 271 | |
---|
| 272 | DO JK=1,KLEV |
---|
| 273 | IKL=KLEV-JK+1 |
---|
| 274 | DO JL = KIDIA, KFDIA |
---|
| 275 | IAE=1 |
---|
| 276 | ZTAUAER(IAE) =& |
---|
| 277 | & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& |
---|
| 278 | & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& |
---|
| 279 | & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) |
---|
| 280 | PTAUAERL(JL,JK, 1)=ZTAUAER(1) |
---|
| 281 | PTAUAERL(JL,JK, 2)=ZTAUAER(1) |
---|
| 282 | IAE=2 |
---|
| 283 | ZTAUAER(IAE) =& |
---|
| 284 | & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& |
---|
| 285 | & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& |
---|
| 286 | & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) |
---|
| 287 | PTAUAERL(JL,JK, 3)=ZTAUAER(2) |
---|
| 288 | PTAUAERL(JL,JK, 4)=ZTAUAER(2) |
---|
| 289 | PTAUAERL(JL,JK, 5)=ZTAUAER(2) |
---|
| 290 | IAE=3 |
---|
| 291 | ZTAUAER(IAE) =& |
---|
| 292 | & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& |
---|
| 293 | & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& |
---|
| 294 | & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) |
---|
| 295 | PTAUAERL(JL,JK, 6)=ZTAUAER(3) |
---|
| 296 | PTAUAERL(JL,JK, 8)=ZTAUAER(3) |
---|
| 297 | PTAUAERL(JL,JK, 9)=ZTAUAER(3) |
---|
| 298 | IAE=4 |
---|
| 299 | ZTAUAER(IAE) =& |
---|
| 300 | & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& |
---|
| 301 | & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& |
---|
| 302 | & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) |
---|
| 303 | PTAUAERL(JL,JK, 7)=ZTAUAER(4) |
---|
| 304 | IAE=5 |
---|
| 305 | ZTAUAER(IAE) =& |
---|
| 306 | & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& |
---|
| 307 | & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& |
---|
| 308 | & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) |
---|
| 309 | PTAUAERL(JL,JK,10)=ZTAUAER(5) |
---|
| 310 | PTAUAERL(JL,JK,11)=ZTAUAER(5) |
---|
| 311 | PTAUAERL(JL,JK,12)=ZTAUAER(5) |
---|
| 312 | PTAUAERL(JL,JK,13)=ZTAUAER(5) |
---|
| 313 | PTAUAERL(JL,JK,14)=ZTAUAER(5) |
---|
| 314 | PTAUAERL(JL,JK,15)=ZTAUAER(5) |
---|
| 315 | PTAUAERL(JL,JK,16)=ZTAUAER(5) |
---|
| 316 | ENDDO |
---|
| 317 | ENDDO |
---|
| 318 | ENDIF |
---|
| 319 | |
---|
| 320 | DO J2=1,KLEV |
---|
| 321 | DO J1=1,JPXSEC |
---|
| 322 | DO JL = KIDIA, KFDIA |
---|
| 323 | PWX(JL,J1,J2)=0.0_JPRB |
---|
| 324 | ENDDO |
---|
| 325 | ENDDO |
---|
| 326 | ENDDO |
---|
| 327 | |
---|
| 328 | DO JK = 1, KLEV |
---|
| 329 | DO JL = KIDIA, KFDIA |
---|
| 330 | !- Set cross section molecule amounts from ECRT; convert to vmr |
---|
| 331 | PWX(JL,1,JK) = PCL4(JL,KLEV-JK+1) * ZAMD/ZAMCL4 |
---|
| 332 | PWX(JL,2,JK) = PC11(JL,KLEV-JK+1) * ZAMD/ZAMC11 |
---|
| 333 | PWX(JL,3,JK) = PC12(JL,KLEV-JK+1) * ZAMD/ZAMC12 |
---|
| 334 | PWX(JL,4,JK) = PC22(JL,KLEV-JK+1) * ZAMD/ZAMC22 |
---|
| 335 | PWX(JL,1,JK) = PCOLDRY(JL,JK) * PWX(JL,1,JK) * 1.E-20_JPRB |
---|
| 336 | PWX(JL,2,JK) = PCOLDRY(JL,JK) * PWX(JL,2,JK) * 1.E-20_JPRB |
---|
| 337 | PWX(JL,3,JK) = PCOLDRY(JL,JK) * PWX(JL,3,JK) * 1.E-20_JPRB |
---|
| 338 | PWX(JL,4,JK) = PCOLDRY(JL,JK) * PWX(JL,4,JK) * 1.E-20_JPRB |
---|
| 339 | |
---|
| 340 | !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to |
---|
| 341 | ! molec/cm2 based on COLDRY for use in RRTM |
---|
| 342 | |
---|
| 343 | !CDIR UNROLL=6 |
---|
| 344 | ZSUMMOL = 0.0_JPRB |
---|
| 345 | !AB broadening gases |
---|
| 346 | DO JMOL = 2, ITMOL |
---|
| 347 | ZSUMMOL = ZSUMMOL + PWKL(JL,JMOL,JK) |
---|
| 348 | ENDDO |
---|
| 349 | PWBRODL(JL,JK) = PCOLDRY(JL,JK) * (1._JPRB - ZSUMMOL) |
---|
| 350 | DO JMOL = 1, ITMOL |
---|
| 351 | PWKL(JL,JMOL,JK) = PCOLDRY(JL,JK) * PWKL(JL,JMOL,JK) |
---|
| 352 | ENDDO |
---|
| 353 | ENDDO |
---|
| 354 | ENDDO |
---|
| 355 | |
---|
| 356 | !- McICA: No overlap; simple copy of optical thickness; layer cloud cover is 0. or 1. |
---|
| 357 | |
---|
| 358 | DO JK=1,KLEV |
---|
| 359 | DO JCOLS=1,KCOLS |
---|
| 360 | DO JL = KIDIA, KFDIA |
---|
| 361 | PCLDFRAC(JL,JCOLS,JK)=PCLDF(JL,JCOLS,JK) |
---|
| 362 | PTAUCLD(JL,JK,JCOLS) =PTAUCLDI(JL,JK,JCOLS) |
---|
| 363 | ENDDO |
---|
| 364 | ENDDO |
---|
| 365 | ENDDO |
---|
| 366 | |
---|
| 367 | ! ------------------------------------------------------------------ |
---|
| 368 | IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',1,ZHOOK_HANDLE) |
---|
| 369 | END ASSOCIATE |
---|
| 370 | END SUBROUTINE RRTM_ECRT_140GP_MCICA |
---|