| 1 | !OPTIONS XOPT(HSFUN) |
|---|
| 2 | SUBROUTINE SWU & |
|---|
| 3 | &( KIDIA, KFDIA , KLON , KLEV & |
|---|
| 4 | &, PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV & |
|---|
| 5 | &, PAKI , PCLD , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD & |
|---|
| 6 | &) |
|---|
| 7 | |
|---|
| 8 | !**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS |
|---|
| 9 | |
|---|
| 10 | ! PURPOSE. |
|---|
| 11 | ! -------- |
|---|
| 12 | ! COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION |
|---|
| 13 | ! CALCULATIONS |
|---|
| 14 | |
|---|
| 15 | !** INTERFACE. |
|---|
| 16 | ! ---------- |
|---|
| 17 | ! *SWU* IS CALLED BY *SW* |
|---|
| 18 | |
|---|
| 19 | |
|---|
| 20 | ! IMPLICIT ARGUMENTS : |
|---|
| 21 | ! -------------------- |
|---|
| 22 | |
|---|
| 23 | ! ==== INPUTS === |
|---|
| 24 | ! ==== OUTPUTS === |
|---|
| 25 | |
|---|
| 26 | ! METHOD. |
|---|
| 27 | ! ------- |
|---|
| 28 | |
|---|
| 29 | ! 1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE |
|---|
| 30 | ! SCALING. |
|---|
| 31 | |
|---|
| 32 | ! EXTERNALS. |
|---|
| 33 | ! ---------- |
|---|
| 34 | |
|---|
| 35 | ! *SWTT* |
|---|
| 36 | |
|---|
| 37 | ! REFERENCE. |
|---|
| 38 | ! ---------- |
|---|
| 39 | |
|---|
| 40 | ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT |
|---|
| 41 | ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) |
|---|
| 42 | |
|---|
| 43 | ! AUTHOR. |
|---|
| 44 | ! ------- |
|---|
| 45 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
|---|
| 46 | |
|---|
| 47 | ! MODIFICATIONS. |
|---|
| 48 | ! -------------- |
|---|
| 49 | ! ORIGINAL : 89-07-14 |
|---|
| 50 | |
|---|
| 51 | ! ------------------------------------------------------------------ |
|---|
| 52 | |
|---|
| 53 | |
|---|
| 54 | #include "tsmbkind.h" |
|---|
| 55 | |
|---|
| 56 | USE YOECLD , ONLY : REPSEC |
|---|
| 57 | USE YOERAD , ONLY : NOVLP ,NSW |
|---|
| 58 | USE YOERDU , ONLY : REPSCQ |
|---|
| 59 | USE YOESW , ONLY : RPDH1 ,RPDU1 ,RPNH ,RPNU ,& |
|---|
| 60 | &RTDH2O ,RTDUMG ,RTH2O ,RTUMG |
|---|
| 61 | USE YOEOVLP , ONLY : RA1OVLP |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | IMPLICIT NONE |
|---|
| 65 | |
|---|
| 66 | |
|---|
| 67 | ! DUMMY INTEGER SCALARS |
|---|
| 68 | INTEGER_M :: KFDIA |
|---|
| 69 | INTEGER_M :: KIDIA |
|---|
| 70 | INTEGER_M :: KKIND |
|---|
| 71 | INTEGER_M :: KLEV |
|---|
| 72 | INTEGER_M :: KLON |
|---|
| 73 | |
|---|
| 74 | ! DUMMY REAL SCALARS |
|---|
| 75 | REAL_B :: PCARDI |
|---|
| 76 | REAL_B :: PSCT |
|---|
| 77 | |
|---|
| 78 | |
|---|
| 79 | |
|---|
| 80 | ! ------------------------------------------------------------------ |
|---|
| 81 | |
|---|
| 82 | !* 0.1 ARGUMENTS |
|---|
| 83 | ! --------- |
|---|
| 84 | |
|---|
| 85 | REAL_B :: PCLDSW(KLON,KLEV), PPMB(KLON,KLEV+1), PPSOL(KLON)& |
|---|
| 86 | &, PRMU0(KLON) , PTAVE(KLON,KLEV) , PWV(KLON,KLEV) |
|---|
| 87 | |
|---|
| 88 | REAL_B :: PAKI(KLON,2,NSW)& |
|---|
| 89 | &, PCLD(KLON,KLEV) , PCLEAR(KLON)& |
|---|
| 90 | &, PDSIG(KLON,KLEV) , PFACT(KLON) , PRMU(KLON)& |
|---|
| 91 | &, PSEC(KLON) , PUD(KLON,5,KLEV+1) |
|---|
| 92 | |
|---|
| 93 | INTEGER_M :: INUIR |
|---|
| 94 | |
|---|
| 95 | ! ------------------------------------------------------------------ |
|---|
| 96 | |
|---|
| 97 | !* 0.2 LOCAL ARRAYS |
|---|
| 98 | ! ------------ |
|---|
| 99 | |
|---|
| 100 | INTEGER_M :: IIND(2) |
|---|
| 101 | REAL_B :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)& |
|---|
| 102 | &, ZN175(KLON), ZN190(KLON), ZO175(KLON)& |
|---|
| 103 | &, ZO190(KLON), ZSIGN(KLON)& |
|---|
| 104 | &, ZR(KLON,2) , ZSIGO(KLON), ZUD(KLON,2) |
|---|
| 105 | |
|---|
| 106 | ! LOCAL INTEGER SCALARS |
|---|
| 107 | INTEGER_M :: JA, JK, JKL, JKLP1, JKP1, JL, JNU |
|---|
| 108 | |
|---|
| 109 | ! LOCAL REAL SCALARS |
|---|
| 110 | REAL_B :: ZDSCO2, ZDSH2O, ZFPPW, ZRTH, ZRTU, ZWH2O, ZALPHA1 |
|---|
| 111 | |
|---|
| 112 | |
|---|
| 113 | ! ------------------------------------------------------------------ |
|---|
| 114 | |
|---|
| 115 | !* 1. COMPUTES AMOUNTS OF ABSORBERS |
|---|
| 116 | ! ----------------------------- |
|---|
| 117 | |
|---|
| 118 | |
|---|
| 119 | IIND(1)=1 |
|---|
| 120 | IIND(2)=2 |
|---|
| 121 | |
|---|
| 122 | |
|---|
| 123 | !* 1.1 INITIALIZES QUANTITIES |
|---|
| 124 | ! ---------------------- |
|---|
| 125 | |
|---|
| 126 | |
|---|
| 127 | DO JL = KIDIA,KFDIA |
|---|
| 128 | PUD(JL,1,KLEV+1)=_ZERO_ |
|---|
| 129 | PUD(JL,2,KLEV+1)=_ZERO_ |
|---|
| 130 | PUD(JL,3,KLEV+1)=_ZERO_ |
|---|
| 131 | PUD(JL,4,KLEV+1)=_ZERO_ |
|---|
| 132 | PUD(JL,5,KLEV+1)=_ZERO_ |
|---|
| 133 | PFACT(JL)= PRMU0(JL) * PSCT |
|---|
| 134 | !- already accounted for in RADINT |
|---|
| 135 | ! PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35. |
|---|
| 136 | PRMU(JL)=PRMU0(JL) |
|---|
| 137 | ! Martin control |
|---|
| 138 | ! PRINT*,'PRMU(',JL,')=',PRMU(JL) |
|---|
| 139 | ! Martin modif to avoid cos(sza)=0 for LMDZ: |
|---|
| 140 | IF (PRMU(JL) .LE. 1E-3) PRMU(JL) = 1E-3 |
|---|
| 141 | PSEC(JL)=_ONE_/PRMU(JL) |
|---|
| 142 | ZC1J(JL,KLEV+1)=_ZERO_ |
|---|
| 143 | ENDDO |
|---|
| 144 | |
|---|
| 145 | !* 1.3 AMOUNTS OF ABSORBERS |
|---|
| 146 | ! -------------------- |
|---|
| 147 | |
|---|
| 148 | |
|---|
| 149 | DO JL= KIDIA,KFDIA |
|---|
| 150 | ZUD(JL,1) = _ZERO_ |
|---|
| 151 | ZUD(JL,2) = _ZERO_ |
|---|
| 152 | ZO175(JL) = PPSOL(JL)** RPDU1 |
|---|
| 153 | ZO190(JL) = PPSOL(JL)** RPDH1 |
|---|
| 154 | ZSIGO(JL) = PPSOL(JL) |
|---|
| 155 | ZCLEAR(JL)=_ONE_ |
|---|
| 156 | ZCLOUD(JL)=_ZERO_ |
|---|
| 157 | ENDDO |
|---|
| 158 | |
|---|
| 159 | DO JK = 1 , KLEV |
|---|
| 160 | JKP1 = JK + 1 |
|---|
| 161 | JKL = KLEV+1 - JK |
|---|
| 162 | JKLP1 = JKL+1 |
|---|
| 163 | DO JL = KIDIA,KFDIA |
|---|
| 164 | ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O |
|---|
| 165 | ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG |
|---|
| 166 | ZWH2O = MAX (PWV(JL,JKL) , REPSCQ ) |
|---|
| 167 | ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1) |
|---|
| 168 | PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL) |
|---|
| 169 | ZN175(JL) = ZSIGN(JL) ** RPDU1 |
|---|
| 170 | ZN190(JL) = ZSIGN(JL) ** RPDH1 |
|---|
| 171 | ZDSCO2 = ZO175(JL) - ZN175(JL) |
|---|
| 172 | ZDSH2O = ZO190(JL) - ZN190(JL) |
|---|
| 173 | PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O * ZRTH |
|---|
| 174 | PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU |
|---|
| 175 | ZFPPW=1.6078_JPRB*ZWH2O/(_ONE_+0.608_JPRB*ZWH2O) |
|---|
| 176 | PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW |
|---|
| 177 | PUD(JL,5,JK)=PUD(JL,1,JK)*(_ONE_-ZFPPW) |
|---|
| 178 | ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK) |
|---|
| 179 | ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK) |
|---|
| 180 | ZSIGO(JL) = ZSIGN(JL) |
|---|
| 181 | ZO175(JL) = ZN175(JL) |
|---|
| 182 | ZO190(JL) = ZN190(JL) |
|---|
| 183 | |
|---|
| 184 | IF (NOVLP == 1) THEN |
|---|
| 185 | ZCLEAR(JL)=ZCLEAR(JL)& |
|---|
| 186 | &*(_ONE_-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))& |
|---|
| 187 | &/(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC)) |
|---|
| 188 | ZC1J(JL,JKL)= _ONE_ - ZCLEAR(JL) |
|---|
| 189 | ZCLOUD(JL) = PCLDSW(JL,JKL) |
|---|
| 190 | ELSEIF (NOVLP == 2) THEN |
|---|
| 191 | ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL)) |
|---|
| 192 | ZC1J(JL,JKL) = ZCLOUD(JL) |
|---|
| 193 | ELSEIF (NOVLP == 3) THEN |
|---|
| 194 | ZCLEAR(JL) = ZCLEAR(JL)*(_ONE_-PCLDSW(JL,JKL)) |
|---|
| 195 | ZCLOUD(JL) = _ONE_ - ZCLEAR(JL) |
|---|
| 196 | ZC1J(JL,JKL) = ZCLOUD(JL) |
|---|
| 197 | ELSEIF (NOVLP == 4) THEN |
|---|
| 198 | !** Hogan & Illingworth (2001) |
|---|
| 199 | ZALPHA1=RA1OVLP(KLEV+1-JK) |
|---|
| 200 | ZCLEAR(JL)=ZCLEAR(JL)*( & |
|---|
| 201 | & ZALPHA1*(_ONE_-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) & |
|---|
| 202 | & /(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPSEC)) & |
|---|
| 203 | & +(_ONE_-ZALPHA1)*(_ONE_-PCLDSW(JL,JKL)) ) |
|---|
| 204 | ZC1J(JL,JKL) = _ONE_ - ZCLEAR(JL) |
|---|
| 205 | ZCLOUD(JL) = PCLDSW(JL,JKL) |
|---|
| 206 | ENDIF |
|---|
| 207 | ENDDO |
|---|
| 208 | ENDDO |
|---|
| 209 | DO JL=KIDIA,KFDIA |
|---|
| 210 | PCLEAR(JL)=_ONE_-ZC1J(JL,1) |
|---|
| 211 | ENDDO |
|---|
| 212 | DO JK=1,KLEV |
|---|
| 213 | DO JL=KIDIA,KFDIA |
|---|
| 214 | IF (PCLEAR(JL) < _ONE_) THEN |
|---|
| 215 | PCLD(JL,JK)=PCLDSW(JL,JK)/(_ONE_-PCLEAR(JL)) |
|---|
| 216 | ELSE |
|---|
| 217 | PCLD(JL,JK)=_ZERO_ |
|---|
| 218 | ENDIF |
|---|
| 219 | ENDDO |
|---|
| 220 | ENDDO |
|---|
| 221 | |
|---|
| 222 | |
|---|
| 223 | !* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS |
|---|
| 224 | ! ----------------------------------------------- |
|---|
| 225 | |
|---|
| 226 | |
|---|
| 227 | DO JA = 1,2 |
|---|
| 228 | DO JL = KIDIA,KFDIA |
|---|
| 229 | ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL) |
|---|
| 230 | ENDDO |
|---|
| 231 | ENDDO |
|---|
| 232 | |
|---|
| 233 | IF (NSW.LE.4) THEN |
|---|
| 234 | INUIR=2 |
|---|
| 235 | ELSE IF (NSW.EQ.6) THEN |
|---|
| 236 | INUIR=4 |
|---|
| 237 | END IF |
|---|
| 238 | |
|---|
| 239 | |
|---|
| 240 | DO JNU= INUIR,NSW |
|---|
| 241 | |
|---|
| 242 | KKIND=2 |
|---|
| 243 | CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, KKIND, IIND & |
|---|
| 244 | &, ZUD & |
|---|
| 245 | &, ZR ) |
|---|
| 246 | |
|---|
| 247 | DO JA = 1,2 |
|---|
| 248 | DO JL = KIDIA,KFDIA |
|---|
| 249 | PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA) |
|---|
| 250 | ENDDO |
|---|
| 251 | ENDDO |
|---|
| 252 | ENDDO |
|---|
| 253 | |
|---|
| 254 | |
|---|
| 255 | ! ------------------------------------------------------------------ |
|---|
| 256 | |
|---|
| 257 | RETURN |
|---|
| 258 | END SUBROUTINE SWU |
|---|
