| [2027] | 1 | ! $Id: lwu.F90 5185 2024-09-11 14:27:07Z fhourdin $ |
|---|
| [5159] | 2 | |
|---|
| [1989] | 3 | SUBROUTINE LWU & |
|---|
| [5154] | 4 | & (KIDIA, KFDIA, KLON, KLEV, & |
|---|
| 5 | & PAER, PCCO2, PDP, PPMB, PQOF, PTAVE, PVIEW, PWV, & |
|---|
| 6 | & PABCU & |
|---|
| 7 | &) |
|---|
| [1989] | 8 | |
|---|
| [5154] | 9 | !**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS |
|---|
| [1989] | 10 | |
|---|
| [5154] | 11 | ! PURPOSE. |
|---|
| 12 | ! -------- |
|---|
| 13 | ! COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND |
|---|
| 14 | ! TEMPERATURE EFFECTS |
|---|
| [1989] | 15 | |
|---|
| [5154] | 16 | !** INTERFACE. |
|---|
| 17 | ! ---------- |
|---|
| [1989] | 18 | |
|---|
| [5154] | 19 | ! EXPLICIT ARGUMENTS : |
|---|
| 20 | ! -------------------- |
|---|
| 21 | ! ==== INPUTS === |
|---|
| 22 | ! PAER : (KLON,6,KLEV) ; OPTICAL THICKNESS OF THE AEROSOLS |
|---|
| 23 | ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) |
|---|
| 24 | ! PDP : (KLON,KLEV) ; LAYER PRESSURE THICKNESS (PA) |
|---|
| 25 | ! PPMB : (KLON,KLEV+1) ; HALF LEVEL PRESSURE |
|---|
| 26 | ! PQOF : (KLON,KLEV) ; CONCENTRATION IN OZONE (PA/PA) |
|---|
| 27 | ! PTAVE : (KLON,KLEV) ; TEMPERATURE |
|---|
| 28 | ! PWV : (KLON,KLEV) ; SPECIFIC HUMIDITY PA/PA |
|---|
| 29 | ! PVIEW : (KLON) ; COSECANT OF VIEWING ANGLE |
|---|
| 30 | ! ==== OUTPUTS === |
|---|
| 31 | ! PABCU :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS |
|---|
| [1989] | 32 | |
|---|
| [5154] | 33 | ! IMPLICIT ARGUMENTS : NONE |
|---|
| 34 | ! -------------------- |
|---|
| [1989] | 35 | |
|---|
| [5154] | 36 | ! METHOD. |
|---|
| 37 | ! ------- |
|---|
| [1989] | 38 | |
|---|
| [5154] | 39 | ! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
|---|
| 40 | ! ABSORBERS. |
|---|
| [1989] | 41 | |
|---|
| [5154] | 42 | ! EXTERNALS. |
|---|
| 43 | ! ---------- |
|---|
| [1989] | 44 | |
|---|
| [5154] | 45 | ! NONE |
|---|
| [1989] | 46 | |
|---|
| [5154] | 47 | ! REFERENCE. |
|---|
| 48 | ! ---------- |
|---|
| [1989] | 49 | |
|---|
| [5154] | 50 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
|---|
| 51 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
|---|
| [1989] | 52 | |
|---|
| [5154] | 53 | ! AUTHOR. |
|---|
| 54 | ! ------- |
|---|
| 55 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
|---|
| [1989] | 56 | |
|---|
| [5154] | 57 | ! MODIFICATIONS. |
|---|
| 58 | ! -------------- |
|---|
| 59 | ! ORIGINAL : 89-07-14 |
|---|
| 60 | ! JJ Morcrette 97-04-18 Revised Continuum + Clean-up |
|---|
| 61 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning |
|---|
| [1989] | 62 | |
|---|
| [5154] | 63 | !----------------------------------------------------------------------- |
|---|
| [1989] | 64 | |
|---|
| [5154] | 65 | USE PARKIND1, ONLY: JPIM, JPRB |
|---|
| 66 | USE YOMHOOK, ONLY: LHOOK, DR_HOOK |
|---|
| [1989] | 67 | |
|---|
| [5154] | 68 | USE YOMCST, ONLY: RG |
|---|
| 69 | USE YOESW, ONLY: RAER |
|---|
| 70 | USE YOELW, ONLY: NSIL, NUA, NG1, NG1P1, & |
|---|
| 71 | & ALWT, BLWT, RO3T, RT1, TREF, & |
|---|
| 72 | & RVGCO2, RVGH2O, RVGO3 |
|---|
| 73 | !USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12 |
|---|
| 74 | USE YOERDU, ONLY: R10E, REPSCO, REPSCQ |
|---|
| [5185] | 75 | USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS |
|---|
| 76 | USE lmdz_reprobus_wrappers, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d |
|---|
| 77 | USE infotrac_phy, ONLY: type_trac |
|---|
| [5154] | 78 | USE lmdz_clesphys |
|---|
| [1989] | 79 | |
|---|
| [5154] | 80 | IMPLICIT NONE |
|---|
| [2027] | 81 | |
|---|
| [5154] | 82 | INTEGER(KIND = JPIM), INTENT(IN) :: KLON |
|---|
| 83 | INTEGER(KIND = JPIM), INTENT(IN) :: KLEV |
|---|
| 84 | INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA |
|---|
| 85 | INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA |
|---|
| 86 | REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV) |
|---|
| 87 | REAL(KIND = JPRB), INTENT(IN) :: PCCO2 |
|---|
| 88 | REAL(KIND = JPRB), INTENT(IN) :: PDP(KLON, KLEV) |
|---|
| 89 | REAL(KIND = JPRB), INTENT(IN) :: PPMB(KLON, KLEV + 1) |
|---|
| 90 | REAL(KIND = JPRB), INTENT(IN) :: PQOF(KLON, KLEV) |
|---|
| 91 | REAL(KIND = JPRB), INTENT(IN) :: PTAVE(KLON, KLEV) |
|---|
| 92 | REAL(KIND = JPRB), INTENT(IN) :: PVIEW(KLON) |
|---|
| 93 | REAL(KIND = JPRB), INTENT(IN) :: PWV(KLON, KLEV) |
|---|
| 94 | REAL(KIND = JPRB), INTENT(OUT) :: PABCU(KLON, NUA, 3 * KLEV + 1) |
|---|
| [1989] | 95 | |
|---|
| [5154] | 96 | !----------------------------------------------------------------------- |
|---|
| [2027] | 97 | |
|---|
| [5154] | 98 | !* 0.1 ARGUMENTS |
|---|
| 99 | ! --------- |
|---|
| [1989] | 100 | |
|---|
| [5154] | 101 | !----------------------------------------------------------------------- |
|---|
| [1989] | 102 | |
|---|
| [5154] | 103 | ! ------------ |
|---|
| 104 | REAL(KIND = JPRB) :: ZABLY(KLON, 7, 3 * KLEV + 1), ZDPM(KLON, 3 * KLEV)& |
|---|
| 105 | &, ZDUC(KLON, 3 * KLEV + 1), ZFACT(KLON)& |
|---|
| 106 | &, ZUPM(KLON, 3 * KLEV) |
|---|
| 107 | REAL(KIND = JPRB) :: ZPHIO(KLON), ZPSC2(KLON), ZPSC3(KLON), ZPSH1(KLON)& |
|---|
| 108 | &, ZPSH2(KLON), ZPSH3(KLON), ZPSH4(KLON), ZPSH5(KLON)& |
|---|
| 109 | &, ZPSH6(KLON), ZPSIO(KLON), ZTCON(KLON)& |
|---|
| 110 | &, ZPHM6(KLON), ZPSM6(KLON), ZPHN6(KLON), ZPSN6(KLON) |
|---|
| 111 | REAL(KIND = JPRB) :: ZSSIG(KLON, 3 * KLEV + 1), ZTAVI(KLON)& |
|---|
| 112 | &, ZUAER(KLON, NSIL), ZXOZ(KLON), ZXWV(KLON) |
|---|
| [1989] | 113 | |
|---|
| [5154] | 114 | INTEGER(KIND = JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN, & |
|---|
| 115 | & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, & |
|---|
| 116 | & JK, JKI, JKK, JL |
|---|
| [1989] | 117 | |
|---|
| [5154] | 118 | REAL(KIND = JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4, & |
|---|
| 119 | & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, & |
|---|
| 120 | & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, & |
|---|
| 121 | & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, & |
|---|
| 122 | & ZUPMH2O, ZUPMO3, ZZABLY |
|---|
| 123 | REAL(KIND = JPRB) :: ZHOOK_HANDLE |
|---|
| [1989] | 124 | |
|---|
| 125 | |
|---|
| [5154] | 126 | !----------------------------------------------------------------------- |
|---|
| [2027] | 127 | |
|---|
| [5154] | 128 | !* 1. INITIALIZATION |
|---|
| 129 | ! -------------- |
|---|
| [1989] | 130 | |
|---|
| [5154] | 131 | !----------------------------------------------------------------------- |
|---|
| [1989] | 132 | |
|---|
| [5154] | 133 | !* 2. PRESSURE OVER GAUSS SUB-LEVELS |
|---|
| 134 | ! ------------------------------ |
|---|
| [1989] | 135 | |
|---|
| [5154] | 136 | IF (LHOOK) CALL DR_HOOK('LWU', 0, ZHOOK_HANDLE) |
|---|
| 137 | DO JL = KIDIA, KFDIA |
|---|
| 138 | ZSSIG(JL, 1) = PPMB(JL, 1) * 100._JPRB |
|---|
| 139 | ENDDO |
|---|
| [1989] | 140 | |
|---|
| [5154] | 141 | DO JK = 1, KLEV |
|---|
| 142 | IKJ = (JK - 1) * NG1P1 + 1 |
|---|
| 143 | IKJR = IKJ |
|---|
| 144 | IKJP = IKJ + NG1P1 |
|---|
| 145 | DO JL = KIDIA, KFDIA |
|---|
| 146 | ZSSIG(JL, IKJP) = PPMB(JL, JK + 1) * 100._JPRB |
|---|
| [1989] | 147 | ENDDO |
|---|
| [5154] | 148 | DO IG1 = 1, NG1 |
|---|
| 149 | IKJ = IKJ + 1 |
|---|
| 150 | DO JL = KIDIA, KFDIA |
|---|
| 151 | ZSSIG(JL, IKJ) = (ZSSIG(JL, IKJR) + ZSSIG(JL, IKJP)) * 0.5_JPRB & |
|---|
| 152 | & + RT1(IG1) * (ZSSIG(JL, IKJP) - ZSSIG(JL, IKJR)) * 0.5_JPRB |
|---|
| 153 | ENDDO |
|---|
| 154 | ENDDO |
|---|
| [1989] | 155 | ENDDO |
|---|
| 156 | |
|---|
| [5154] | 157 | !----------------------------------------------------------------------- |
|---|
| [1989] | 158 | |
|---|
| [5154] | 159 | !* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS |
|---|
| 160 | ! -------------------------------------------------- |
|---|
| [1989] | 161 | |
|---|
| [5154] | 162 | DO JKI = 1, 3 * KLEV |
|---|
| 163 | IKIP1 = JKI + 1 |
|---|
| 164 | DO JL = KIDIA, KFDIA |
|---|
| 165 | ZUPM(JL, JKI) = (ZSSIG(JL, JKI) + ZSSIG(JL, IKIP1)) * 0.5_JPRB |
|---|
| 166 | ZDPM(JL, JKI) = (ZSSIG(JL, JKI) - ZSSIG(JL, IKIP1)) / (10._JPRB * RG) |
|---|
| 167 | ENDDO |
|---|
| [1989] | 168 | ENDDO |
|---|
| 169 | |
|---|
| [5154] | 170 | DO JK = 1, KLEV |
|---|
| 171 | IKL = KLEV + 1 - JK |
|---|
| 172 | DO JL = KIDIA, KFDIA |
|---|
| 173 | ZXWV(JL) = MAX (PWV(JL, IKL), REPSCQ) |
|---|
| 174 | ZXOZ(JL) = MAX (PQOF(JL, IKL) / PDP(JL, IKL), REPSCO) |
|---|
| [1989] | 175 | ENDDO |
|---|
| [5154] | 176 | IKJ = (JK - 1) * NG1P1 + 1 |
|---|
| 177 | IKJPN = IKJ + NG1 |
|---|
| 178 | DO JKK = IKJ, IKJPN |
|---|
| 179 | DO JL = KIDIA, KFDIA |
|---|
| 180 | ZDPMG = ZDPM(JL, JKK) |
|---|
| 181 | ZDPMP0 = ZDPMG / 101325._JPRB |
|---|
| 182 | ZUPMG = ZUPM(JL, JKK) * ZDPMP0 |
|---|
| 183 | ZUPMCO2 = (ZUPM(JL, JKK) + RVGCO2) * ZDPMP0 |
|---|
| 184 | ZUPMH2O = (ZUPM(JL, JKK) + RVGH2O) * ZDPMP0 |
|---|
| 185 | ZUPMO3 = (ZUPM(JL, JKK) + RVGO3) * ZDPMP0 |
|---|
| 186 | ZDUC(JL, JKK) = ZDPMG |
|---|
| 187 | ZABLY(JL, 6, JKK) = ZXOZ(JL) * ZDPMG |
|---|
| 188 | ZABLY(JL, 7, JKK) = ZXOZ(JL) * ZUPMO3 |
|---|
| 189 | ZU6 = ZXWV(JL) * ZUPMG |
|---|
| 190 | ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB + 0.608_JPRB * ZXWV(JL)) |
|---|
| 191 | ZABLY(JL, 1, JKK) = ZXWV(JL) * ZUPMH2O |
|---|
| 192 | ZABLY(JL, 5, JKK) = ZU6 * ZFPPW |
|---|
| 193 | ZABLY(JL, 4, JKK) = ZU6 * (1.0_JPRB - ZFPPW) |
|---|
| 194 | ZABLY(JL, 3, JKK) = PCCO2 * ZUPMCO2 |
|---|
| 195 | ZABLY(JL, 2, JKK) = PCCO2 * ZDPMG |
|---|
| 196 | ENDDO |
|---|
| 197 | ENDDO |
|---|
| [1989] | 198 | ENDDO |
|---|
| 199 | |
|---|
| [5154] | 200 | !----------------------------------------------------------------------- |
|---|
| [1989] | 201 | |
|---|
| [5154] | 202 | !* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE |
|---|
| 203 | ! -------------------------------------------------- |
|---|
| [1989] | 204 | |
|---|
| [5154] | 205 | DO JA = 1, NUA |
|---|
| 206 | DO JL = KIDIA, KFDIA |
|---|
| 207 | PABCU(JL, JA, 3 * KLEV + 1) = 0.0_JPRB |
|---|
| 208 | ENDDO |
|---|
| [1989] | 209 | ENDDO |
|---|
| 210 | |
|---|
| [5154] | 211 | DO JK = 1, KLEV |
|---|
| 212 | IJ = (JK - 1) * NG1P1 + 1 |
|---|
| 213 | IJPN = IJ + NG1 |
|---|
| 214 | IKL = KLEV + 1 - JK |
|---|
| [1989] | 215 | |
|---|
| [5154] | 216 | !* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE |
|---|
| 217 | ! -------------------------------------------------- |
|---|
| 218 | ! -- NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM |
|---|
| [1989] | 219 | |
|---|
| [5154] | 220 | IAE1 = 3 * KLEV + 1 - IJ |
|---|
| 221 | IAE2 = 3 * KLEV + 1 - (IJ + 1) |
|---|
| 222 | IAE3 = 3 * KLEV + 1 - IJPN |
|---|
| [5160] | 223 | ! PRINT *,'IAE1= ',IAE1 |
|---|
| 224 | ! PRINT *,'IAE2= ',IAE2 |
|---|
| 225 | ! PRINT *,'IAE3= ',IAE3 |
|---|
| 226 | ! PRINT *,'KIDIA= ',KIDIA |
|---|
| 227 | ! PRINT *,'KFDIA= ',KFDIA |
|---|
| 228 | ! PRINT *,'KLEV= ',KLEV |
|---|
| [5154] | 229 | DO JAE = 1, 6 |
|---|
| 230 | DO JL = KIDIA, KFDIA |
|---|
| [5160] | 231 | ! PRINT *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL |
|---|
| [5154] | 232 | ZUAER(JL, JAE) = & |
|---|
| 233 | & (RAER(JAE, 1) * PAER(JL, 1, JK) + RAER(JAE, 2) * PAER(JL, 2, JK)& |
|---|
| 234 | & + RAER(JAE, 3) * PAER(JL, 3, JK) + RAER(JAE, 4) * PAER(JL, 4, JK)& |
|---|
| 235 | & + RAER(JAE, 5) * PAER(JL, 5, JK) + RAER(JAE, 6) * PAER(JL, 6, JK))& |
|---|
| 236 | & / (ZDUC(JL, IAE1) + ZDUC(JL, IAE2) + ZDUC(JL, IAE3)) |
|---|
| 237 | ENDDO |
|---|
| [1989] | 238 | ENDDO |
|---|
| 239 | |
|---|
| [5154] | 240 | !* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS |
|---|
| 241 | ! -------------------------------------------------- |
|---|
| [1989] | 242 | |
|---|
| [5154] | 243 | DO JL = KIDIA, KFDIA |
|---|
| 244 | ZTAVI(JL) = PTAVE(JL, IKL) |
|---|
| 245 | ZFACT(JL) = 1.0_JPRB - ZTAVI(JL) / 296._JPRB |
|---|
| 246 | ZTCON(JL) = EXP(6.08_JPRB * (296._JPRB / ZTAVI(JL) - 1.0_JPRB)) |
|---|
| 247 | ! ZTCON(JL)=EXP(6.08*ZFACT(JL)) |
|---|
| 248 | ZTX = ZTAVI(JL) - TREF |
|---|
| 249 | ZTX2 = ZTX * ZTX |
|---|
| 250 | ZZABLY = ZABLY(JL, 1, IAE1) + ZABLY(JL, 1, IAE2) + ZABLY(JL, 1, IAE3) |
|---|
| 251 | ZUP = MIN(MAX(0.5_JPRB * R10E * LOG(ZZABLY) + 5._JPRB, 0.0_JPRB), 6.0_JPRB) |
|---|
| 252 | ZCAH1 = ALWT(1, 1) + ZUP * (ALWT(1, 2) + ZUP * (ALWT(1, 3))) |
|---|
| 253 | ZCBH1 = BLWT(1, 1) + ZUP * (BLWT(1, 2) + ZUP * (BLWT(1, 3))) |
|---|
| 254 | ZPSH1(JL) = EXP(ZCAH1 * ZTX + ZCBH1 * ZTX2) |
|---|
| 255 | ZCAH2 = ALWT(2, 1) + ZUP * (ALWT(2, 2) + ZUP * (ALWT(2, 3))) |
|---|
| 256 | ZCBH2 = BLWT(2, 1) + ZUP * (BLWT(2, 2) + ZUP * (BLWT(2, 3))) |
|---|
| 257 | ZPSH2(JL) = EXP(ZCAH2 * ZTX + ZCBH2 * ZTX2) |
|---|
| 258 | ZCAH3 = ALWT(3, 1) + ZUP * (ALWT(3, 2) + ZUP * (ALWT(3, 3))) |
|---|
| 259 | ZCBH3 = BLWT(3, 1) + ZUP * (BLWT(3, 2) + ZUP * (BLWT(3, 3))) |
|---|
| 260 | ZPSH3(JL) = EXP(ZCAH3 * ZTX + ZCBH3 * ZTX2) |
|---|
| 261 | ZCAH4 = ALWT(4, 1) + ZUP * (ALWT(4, 2) + ZUP * (ALWT(4, 3))) |
|---|
| 262 | ZCBH4 = BLWT(4, 1) + ZUP * (BLWT(4, 2) + ZUP * (BLWT(4, 3))) |
|---|
| 263 | ZPSH4(JL) = EXP(ZCAH4 * ZTX + ZCBH4 * ZTX2) |
|---|
| 264 | ZCAH5 = ALWT(5, 1) + ZUP * (ALWT(5, 2) + ZUP * (ALWT(5, 3))) |
|---|
| 265 | ZCBH5 = BLWT(5, 1) + ZUP * (BLWT(5, 2) + ZUP * (BLWT(5, 3))) |
|---|
| 266 | ZPSH5(JL) = EXP(ZCAH5 * ZTX + ZCBH5 * ZTX2) |
|---|
| 267 | ZCAH6 = ALWT(6, 1) + ZUP * (ALWT(6, 2) + ZUP * (ALWT(6, 3))) |
|---|
| 268 | ZCBH6 = BLWT(6, 1) + ZUP * (BLWT(6, 2) + ZUP * (BLWT(6, 3))) |
|---|
| 269 | ZPSH6(JL) = EXP(ZCAH6 * ZTX + ZCBH6 * ZTX2) |
|---|
| 270 | ZPHM6(JL) = EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2) |
|---|
| 271 | ZPSM6(JL) = EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2) |
|---|
| 272 | ZPHN6(JL) = EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2) |
|---|
| 273 | ZPSN6(JL) = EXP(3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2) |
|---|
| 274 | ENDDO |
|---|
| [1989] | 275 | |
|---|
| [5154] | 276 | DO JL = KIDIA, KFDIA |
|---|
| 277 | ZTAVI(JL) = PTAVE(JL, IKL) |
|---|
| 278 | ZTX = ZTAVI(JL) - TREF |
|---|
| 279 | ZTX2 = ZTX * ZTX |
|---|
| 280 | ZZABLY = ZABLY(JL, 3, IAE1) + ZABLY(JL, 3, IAE2) + ZABLY(JL, 3, IAE3) |
|---|
| 281 | ZALUP = R10E * LOG (ZZABLY) |
|---|
| 282 | ZUP = MAX(0.0_JPRB, 5.0_JPRB + 0.5_JPRB * ZALUP) |
|---|
| 283 | ZPSC2(JL) = (ZTAVI(JL) / TREF) ** ZUP |
|---|
| 284 | ZCAC8 = ALWT(8, 1) + ZUP * (ALWT(8, 2) + ZUP * (ALWT(8, 3))) |
|---|
| 285 | ZCBC8 = BLWT(8, 1) + ZUP * (BLWT(8, 2) + ZUP * (BLWT(8, 3))) |
|---|
| 286 | ZPSC3(JL) = EXP(ZCAC8 * ZTX + ZCBC8 * ZTX2) |
|---|
| 287 | ZPHIO(JL) = EXP(RO3T(1) * ZTX + RO3T(2) * ZTX2) |
|---|
| 288 | ZPSIO(JL) = EXP(2.0_JPRB * (RO3T(3) * ZTX + RO3T(4) * ZTX2)) |
|---|
| 289 | ENDDO |
|---|
| [1989] | 290 | |
|---|
| [5154] | 291 | DO JKK = IJ, IJPN |
|---|
| 292 | IC = 3 * KLEV + 1 - JKK |
|---|
| 293 | ICP1 = IC + 1 |
|---|
| 294 | DO JL = KIDIA, KFDIA |
|---|
| 295 | ZDIFF = PVIEW(JL) |
|---|
| 296 | !- H2O continuum |
|---|
| 297 | PABCU(JL, 10, IC) = PABCU(JL, 10, ICP1) + ZABLY(JL, 4, IC) * ZDIFF |
|---|
| 298 | PABCU(JL, 11, IC) = PABCU(JL, 11, ICP1) + ZABLY(JL, 5, IC) * ZTCON(JL) * ZDIFF |
|---|
| 299 | !- O3 |
|---|
| 300 | PABCU(JL, 12, IC) = PABCU(JL, 12, ICP1) + ZABLY(JL, 6, IC) * ZPHIO(JL) * ZDIFF |
|---|
| 301 | PABCU(JL, 13, IC) = PABCU(JL, 13, ICP1) + ZABLY(JL, 7, IC) * ZPSIO(JL) * ZDIFF |
|---|
| 302 | !- CO2 |
|---|
| 303 | PABCU(JL, 7, IC) = PABCU(JL, 7, ICP1) + ZABLY(JL, 3, IC) * ZPSC2(JL) * ZDIFF |
|---|
| 304 | PABCU(JL, 8, IC) = PABCU(JL, 8, ICP1) + ZABLY(JL, 3, IC) * ZPSC3(JL) * ZDIFF |
|---|
| 305 | PABCU(JL, 9, IC) = PABCU(JL, 9, ICP1) + ZABLY(JL, 3, IC) * ZPSC3(JL) * ZDIFF |
|---|
| 306 | !- H2O |
|---|
| 307 | PABCU(JL, 1, IC) = PABCU(JL, 1, ICP1) + ZABLY(JL, 1, IC) * ZPSH1(JL) |
|---|
| 308 | PABCU(JL, 2, IC) = PABCU(JL, 2, ICP1) + ZABLY(JL, 1, IC) * ZPSH2(JL) |
|---|
| 309 | PABCU(JL, 3, IC) = PABCU(JL, 3, ICP1) + ZABLY(JL, 1, IC) * ZPSH5(JL) * ZDIFF |
|---|
| 310 | PABCU(JL, 4, IC) = PABCU(JL, 4, ICP1) + ZABLY(JL, 1, IC) * ZPSH3(JL) |
|---|
| 311 | PABCU(JL, 5, IC) = PABCU(JL, 5, ICP1) + ZABLY(JL, 1, IC) * ZPSH4(JL) |
|---|
| 312 | PABCU(JL, 6, IC) = PABCU(JL, 6, ICP1) + ZABLY(JL, 1, IC) * ZPSH6(JL) * ZDIFF |
|---|
| 313 | !- aerosols |
|---|
| 314 | PABCU(JL, 14, IC) = PABCU(JL, 14, ICP1) + ZUAER(JL, 1) * ZDUC(JL, IC) * ZDIFF |
|---|
| 315 | PABCU(JL, 15, IC) = PABCU(JL, 15, ICP1) + ZUAER(JL, 2) * ZDUC(JL, IC) * ZDIFF |
|---|
| 316 | PABCU(JL, 16, IC) = PABCU(JL, 16, ICP1) + ZUAER(JL, 3) * ZDUC(JL, IC) * ZDIFF |
|---|
| 317 | PABCU(JL, 17, IC) = PABCU(JL, 17, ICP1) + ZUAER(JL, 4) * ZDUC(JL, IC) * ZDIFF |
|---|
| 318 | PABCU(JL, 18, IC) = PABCU(JL, 18, ICP1) + ZUAER(JL, 5) * ZDUC(JL, IC) * ZDIFF |
|---|
| [5185] | 319 | IF (CPPKEY_REPROBUS .AND. type_trac=='repr'.AND. ok_rtime2d) THEN |
|---|
| 320 | !- CH4 |
|---|
| 321 | PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)& |
|---|
| 322 | & + ZABLY(JL, 2, IC) * RCH42D(JL, IC) / PCCO2 * ZPHM6(JL) * ZDIFF |
|---|
| 323 | PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)& |
|---|
| 324 | & + ZABLY(JL, 3, IC) * RCH42D(JL, IC) / PCCO2 * ZPSM6(JL) * ZDIFF |
|---|
| 325 | !- N2O |
|---|
| 326 | PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)& |
|---|
| 327 | & + ZABLY(JL, 2, IC) * RN2O2D(JL, IC) / PCCO2 * ZPHN6(JL) * ZDIFF |
|---|
| 328 | PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)& |
|---|
| 329 | & + ZABLY(JL, 3, IC) * RN2O2D(JL, IC) / PCCO2 * ZPSN6(JL) * ZDIFF |
|---|
| 330 | !- CFC11 |
|---|
| 331 | PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)& |
|---|
| 332 | & + ZABLY(JL, 2, IC) * RCFC112D(JL, IC) / PCCO2 * ZDIFF |
|---|
| 333 | !- CFC12 |
|---|
| 334 | PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)& |
|---|
| 335 | & + ZABLY(JL, 2, IC) * RCFC122D(JL, IC) / PCCO2 * ZDIFF |
|---|
| [3666] | 336 | |
|---|
| [5185] | 337 | ELSE |
|---|
| 338 | !- CH4 |
|---|
| 339 | PABCU(JL, 19, IC) = PABCU(JL, 19, ICP1)& |
|---|
| 340 | & + ZABLY(JL, 2, IC) * RCH4 / PCCO2 * ZPHM6(JL) * ZDIFF |
|---|
| 341 | PABCU(JL, 20, IC) = PABCU(JL, 20, ICP1)& |
|---|
| 342 | & + ZABLY(JL, 3, IC) * RCH4 / PCCO2 * ZPSM6(JL) * ZDIFF |
|---|
| 343 | !- N2O |
|---|
| 344 | PABCU(JL, 21, IC) = PABCU(JL, 21, ICP1)& |
|---|
| 345 | & + ZABLY(JL, 2, IC) * RN2O / PCCO2 * ZPHN6(JL) * ZDIFF |
|---|
| 346 | PABCU(JL, 22, IC) = PABCU(JL, 22, ICP1)& |
|---|
| 347 | & + ZABLY(JL, 3, IC) * RN2O / PCCO2 * ZPSN6(JL) * ZDIFF |
|---|
| 348 | !- CFC11 |
|---|
| 349 | PABCU(JL, 23, IC) = PABCU(JL, 23, ICP1)& |
|---|
| 350 | & + ZABLY(JL, 2, IC) * RCFC11 / PCCO2 * ZDIFF |
|---|
| 351 | !- CFC12 |
|---|
| 352 | PABCU(JL, 24, IC) = PABCU(JL, 24, ICP1)& |
|---|
| 353 | & + ZABLY(JL, 2, IC) * RCFC12 / PCCO2 * ZDIFF |
|---|
| [3666] | 354 | END IF |
|---|
| [5154] | 355 | ENDDO |
|---|
| [1989] | 356 | ENDDO |
|---|
| [5154] | 357 | |
|---|
| [1989] | 358 | ENDDO |
|---|
| [5160] | 359 | ! PRINT *,'END OF LWU' |
|---|
| [1989] | 360 | |
|---|
| 361 | |
|---|
| [2027] | 362 | |
|---|
| [5154] | 363 | !----------------------------------------------------------------------- |
|---|
| [2027] | 364 | |
|---|
| [5154] | 365 | IF (LHOOK) CALL DR_HOOK('LWU', 1, ZHOOK_HANDLE) |
|---|
| [1989] | 366 | END SUBROUTINE LWU |
|---|
