[1989] | 1 | SUBROUTINE RRTM_RTRN1A_140GP (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,& |
---|
| 2 | & P_OD,P_TAUSF1,P_CLFNET,P_CLHTR,P_FNET,P_HTR,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,& |
---|
| 3 | & P_TAVEL,PZ,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW,K_IREFLECT) |
---|
| 4 | |
---|
| 5 | ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
---|
| 6 | ! Speed-up by D.Salmond, ECMWF, 9907 |
---|
| 7 | ! Bug-fix by M.J. Iacono, AER, Inc., 9911 |
---|
| 8 | ! Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization) |
---|
| 9 | ! Speed-up by D. Salmond, ECMWF, 9912 |
---|
| 10 | ! Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K) |
---|
| 11 | ! Speed-up by D. Salmond, ECMWF, 000515 |
---|
| 12 | |
---|
| 13 | !-* This program calculates the upward fluxes, downward fluxes, |
---|
| 14 | ! and heating rates for an arbitrary atmosphere. The input to |
---|
| 15 | ! this program is the atmospheric profile and all Planck function |
---|
| 16 | ! information. First-order "numerical" quadrature is used for the |
---|
| 17 | ! angle integration, i.e. only one exponential is computed per layer |
---|
| 18 | ! per g-value per band. Cloud overlap is treated with a generalized |
---|
| 19 | ! maximum/random method in which adjacent cloud layers are treated |
---|
| 20 | ! with maximum overlap, and non-adjacent cloud groups are treated |
---|
| 21 | ! with random overlap. For adjacent cloud layers, cloud information |
---|
| 22 | ! is carried from the previous two layers. |
---|
| 23 | |
---|
| 24 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
| 25 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
---|
| 26 | |
---|
| 27 | USE PARRRTM , ONLY : JPBAND ,JPGPT ,JPLAY |
---|
| 28 | USE YOERRTAB , ONLY : BPADE |
---|
| 29 | USE YOERRTWN , ONLY : TOTPLNK ,DELWAVE |
---|
| 30 | USE YOERRTFTR, ONLY : NGB |
---|
| 31 | |
---|
| 32 | IMPLICIT NONE |
---|
| 33 | |
---|
| 34 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
---|
| 35 | INTEGER(KIND=JPIM),INTENT(IN) :: K_ISTART |
---|
| 36 | INTEGER(KIND=JPIM),INTENT(IN) :: K_IEND |
---|
| 37 | INTEGER(KIND=JPIM),INTENT(IN) :: K_ICLDLYR(JPLAY) ! Cloud indicator |
---|
| 38 | REAL(KIND=JPRB) ,INTENT(IN) :: P_CLDFRAC(JPLAY) ! Cloud fraction |
---|
| 39 | REAL(KIND=JPRB) :: Z_CLDFRAC(JPLAY) ! Cloud fraction |
---|
| 40 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness |
---|
| 41 | REAL(KIND=JPRB) ,INTENT(IN) :: P_ABSS1(JPGPT*JPLAY) |
---|
| 42 | REAL(KIND=JPRB) ,INTENT(IN) :: P_OD(JPGPT,JPLAY) |
---|
| 43 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUSF1(JPGPT*JPLAY) |
---|
| 44 | REAL(KIND=JPRB) :: P_CLFNET(0:JPLAY) ! Argument NOT used |
---|
| 45 | REAL(KIND=JPRB) :: P_CLHTR(0:JPLAY) ! Argument NOT used |
---|
| 46 | REAL(KIND=JPRB) :: P_FNET(0:JPLAY) ! Argument NOT used |
---|
| 47 | REAL(KIND=JPRB) :: P_HTR(0:JPLAY) ! Argument NOT used |
---|
| 48 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUC(0:JPLAY) |
---|
| 49 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUX(0:JPLAY) |
---|
| 50 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUC(0:JPLAY) |
---|
| 51 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUX(0:JPLAY) |
---|
| 52 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY) |
---|
| 53 | REAL(KIND=JPRB) :: PZ(0:JPLAY) ! Argument NOT used |
---|
| 54 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TZ(0:JPLAY) |
---|
| 55 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TBOUND |
---|
| 56 | REAL(KIND=JPRB) ,INTENT(IN) :: PFRAC(JPGPT,JPLAY) |
---|
| 57 | REAL(KIND=JPRB) ,INTENT(IN) :: P_SEMISS(JPBAND) |
---|
| 58 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISLW |
---|
| 59 | INTEGER(KIND=JPIM) :: K_IREFLECT ! Argument NOT used |
---|
| 60 | !- from PROFILE |
---|
| 61 | !- from SP |
---|
| 62 | !- from SURFACE |
---|
| 63 | INTEGER(KIND=JPIM) :: INDLAY(JPLAY),INDLEV(0:JPLAY) |
---|
| 64 | |
---|
| 65 | REAL(KIND=JPRB) :: Z_BBU1(JPGPT*JPLAY),Z_BBUTOT1(JPGPT*JPLAY) |
---|
| 66 | REAL(KIND=JPRB) :: Z_TLAYFRAC(JPLAY),Z_TLEVFRAC(0:JPLAY) |
---|
| 67 | REAL(KIND=JPRB) :: Z_BGLEV(JPGPT) |
---|
| 68 | !-- DS_000515 |
---|
| 69 | REAL(KIND=JPRB) :: Z_PLVL(JPBAND+1,0:JPLAY),Z_PLAY(JPBAND+1,0:JPLAY),Z_WTNUM(3) |
---|
| 70 | !-- DS_000515 |
---|
| 71 | REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY) |
---|
| 72 | REAL(KIND=JPRB) :: Z_SEMIS(JPGPT),Z_RADUEMIT(JPGPT) |
---|
| 73 | |
---|
| 74 | REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT) ,Z_RADCLRD1(JPGPT) |
---|
| 75 | REAL(KIND=JPRB) :: Z_RADLU1(JPGPT) ,Z_RADLD1(JPGPT) |
---|
| 76 | !-- DS_000515 |
---|
| 77 | REAL(KIND=JPRB) :: Z_TRNCLD(JPLAY,JPBAND+1) |
---|
| 78 | !-- DS_000515 |
---|
| 79 | REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY) |
---|
| 80 | REAL(KIND=JPRB) :: Z_ATOT1(JPGPT*JPLAY) |
---|
| 81 | |
---|
| 82 | REAL(KIND=JPRB) :: Z_SURFEMIS(JPBAND),Z_PLNKEMIT(JPBAND) |
---|
| 83 | |
---|
| 84 | ! dimension of arrays required for cloud overlap calculations |
---|
| 85 | |
---|
| 86 | REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt) |
---|
| 87 | REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1) |
---|
| 88 | REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1) |
---|
| 89 | REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1) |
---|
| 90 | REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay) |
---|
| 91 | REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay) |
---|
| 92 | REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt) |
---|
| 93 | INTEGER(KIND=JPIM) :: istcld(jplay+1),istcldd(0:jplay) |
---|
| 94 | !****** |
---|
| 95 | |
---|
| 96 | !REAL_B :: ZPLVL(JPGPT+1,JPLAY) ,ZPLAY(JPGPT+1,JPLAY) |
---|
| 97 | !REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY) |
---|
| 98 | |
---|
| 99 | INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI |
---|
| 100 | |
---|
| 101 | REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,& |
---|
| 102 | & Z_DELBGDN, Z_DELBGUP, Z_DRAD1, Z_DRADCL1, Z_FACTOT1, & |
---|
| 103 | & Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1, Z_RAT2, Z_SUMPL, & |
---|
| 104 | & Z_SUMPLEM, Z_TBNDFRAC, Z_TRNS, Z_TTOT, Z_URAD1, Z_URADCL1, ZEXTAU |
---|
| 105 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 106 | |
---|
[2160] | 107 | |
---|
| 108 | |
---|
| 109 | REAL(KIND=JPRB) :: CLFNET(0:JPLAY) ! Argument NOT used |
---|
| 110 | REAL(KIND=JPRB) :: CLHTR(0:JPLAY) ! Argument NOT used |
---|
| 111 | REAL(KIND=JPRB) :: FNET(0:JPLAY) ! Argument NOT used |
---|
| 112 | REAL(KIND=JPRB) :: HTR(0:JPLAY) ! Argument NOT used |
---|
| 113 | |
---|
| 114 | |
---|
| 115 | |
---|
[1989] | 116 | !-------------------------------------------------------------------------- |
---|
| 117 | ! Input |
---|
| 118 | ! JPLAY ! Maximum number of model layers |
---|
| 119 | ! JPGPT ! Total number of g-point subintervals |
---|
| 120 | ! JPBAND ! Number of longwave spectral bands |
---|
| 121 | ! SECANG ! Diffusivity angle |
---|
| 122 | ! WTNUM ! Weight for radiance to flux conversion |
---|
| 123 | ! KLEV ! Number of model layers |
---|
| 124 | ! PAVEL(JPLAY) ! Mid-layer pressures (hPa) |
---|
| 125 | ! PZ(0:JPLAY) ! Interface pressures (hPa) |
---|
| 126 | ! TAVEL(JPLAY) ! Mid-layer temperatures (K) |
---|
| 127 | ! TZ(0:JPLAY) ! Interface temperatures (K) |
---|
| 128 | ! TBOUND ! Surface temperature |
---|
| 129 | ! CLDFRAC(JPLAY) ! Layer cloud fraction |
---|
| 130 | ! TAUCLD(JPLAY,JPBAND) ! Layer cloud optical thickness |
---|
| 131 | ! ITR |
---|
| 132 | ! PFRAC(JPGPT,JPLAY) ! Planck function fractions |
---|
| 133 | ! ICLDLYR(JPLAY) ! Flag for cloudy layers |
---|
| 134 | ! ICLD ! Flag for cloudy column |
---|
| 135 | ! IREFLECT ! Flag for specular reflection |
---|
| 136 | ! SEMISS(JPBAND) ! Surface spectral emissivity |
---|
| 137 | ! BPADE ! Pade constant |
---|
| 138 | ! OD ! Clear-sky optical thickness |
---|
| 139 | ! TAUSF1 ! |
---|
| 140 | ! ABSS1 ! |
---|
| 141 | |
---|
| 142 | ! ABSS(JPGPT*JPLAY) ! |
---|
| 143 | ! ABSCLD(JPLAY) ! |
---|
| 144 | ! ATOT(JPGPT*JPLAY) ! |
---|
| 145 | ! ODCLR(JPGPT,JPLAY) ! |
---|
| 146 | ! ODCLD(JPBAND,JPLAY) ! |
---|
| 147 | ! EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction |
---|
| 148 | ! RADLU(JPGPT) ! Upward radiance |
---|
| 149 | ! URAD ! Spectrally summed upward radiance |
---|
| 150 | ! RADCLRU(JPGPT) ! Clear-sky upward radiance |
---|
| 151 | ! CLRURAD ! Spectrally summed clear-sky upward radiance |
---|
| 152 | ! RADLD(JPGPT) ! Downward radiance |
---|
| 153 | ! DRAD ! Spectrally summed downward radiance |
---|
| 154 | ! RADCLRD(JPGPT) ! Clear-sky downward radiance |
---|
| 155 | ! CLRDRAD ! Spectrally summed clear-sky downward radiance |
---|
| 156 | |
---|
| 157 | ! Output |
---|
| 158 | ! TOTUFLUX(0:JPLAY) ! Upward longwave flux |
---|
| 159 | ! TOTDFLUX(0:JPLAY) ! Downward longwave flux |
---|
| 160 | ! TOTUFLUC(0:JPLAY) ! Clear-sky upward longwave flux |
---|
| 161 | ! TOTDFLUC(0:JPLAY) ! Clear-sky downward longwave flux |
---|
| 162 | |
---|
| 163 | ! Maximum/Random cloud overlap variables |
---|
| 164 | ! for upward radiaitve transfer |
---|
| 165 | ! FACCLR2 fraction of clear radiance from previous layer that needs to |
---|
| 166 | ! be switched to cloudy stream |
---|
| 167 | ! FACCLR1 fraction of the radiance that had been switched in the previous |
---|
| 168 | ! layer from cloudy to clear that needs to be switched back to |
---|
| 169 | ! cloudy in the current layer |
---|
| 170 | ! FACCLD2 fraction of cloudy radiance from previous layer that needs to |
---|
| 171 | ! be switched to clear stream |
---|
| 172 | ! be switched to cloudy stream |
---|
| 173 | ! FACCLD1 fraction of the radiance that had been switched in the previous |
---|
| 174 | ! layer from clear to cloudy that needs to be switched back to |
---|
| 175 | ! clear in the current layer |
---|
| 176 | ! for downward radiaitve transfer |
---|
| 177 | ! FACCLR2D fraction of clear radiance from previous layer that needs to |
---|
| 178 | ! be switched to cloudy stream |
---|
| 179 | ! FACCLR1D fraction of the radiance that had been switched in the previous |
---|
| 180 | ! layer from cloudy to clear that needs to be switched back to |
---|
| 181 | ! cloudy in the current layer |
---|
| 182 | ! FACCLD2D fraction of cloudy radiance from previous layer that needs to |
---|
| 183 | ! be switched to clear stream |
---|
| 184 | ! be switched to cloudy stream |
---|
| 185 | ! FACCLD1D fraction of the radiance that had been switched in the previous |
---|
| 186 | ! layer from clear to cloudy that needs to be switched back to |
---|
| 187 | ! clear in the current layer |
---|
| 188 | |
---|
| 189 | !-------------------------------------------------------------------------- |
---|
| 190 | |
---|
| 191 | ! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH |
---|
| 192 | ! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne |
---|
| 193 | ! a 100 mais apparemment non initialise en klev+1 |
---|
| 194 | Z_CLDFRAC(1:KLEV)=P_CLDFRAC(1:KLEV) |
---|
| 195 | Z_CLDFRAC(KLEV+1)=0.0_JPRB |
---|
| 196 | IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE) |
---|
| 197 | Z_WTNUM(1)=0.5_JPRB |
---|
| 198 | Z_WTNUM(2)=0.0_JPRB |
---|
| 199 | Z_WTNUM(3)=0.0_JPRB |
---|
| 200 | |
---|
| 201 | DO I_LAY = 0, KLEV |
---|
| 202 | ENDDO |
---|
| 203 | !-start JJM_000511 |
---|
| 204 | IF (P_TBOUND < 339._JPRB .AND. P_TBOUND >= 160._JPRB ) THEN |
---|
| 205 | INDBOUND = P_TBOUND - 159._JPRB |
---|
| 206 | Z_TBNDFRAC = P_TBOUND - INT(P_TBOUND) |
---|
| 207 | ELSEIF (P_TBOUND >= 339._JPRB ) THEN |
---|
| 208 | INDBOUND = 180 |
---|
| 209 | Z_TBNDFRAC = P_TBOUND - 339._JPRB |
---|
| 210 | ELSEIF (P_TBOUND < 160._JPRB ) THEN |
---|
| 211 | INDBOUND = 1 |
---|
| 212 | Z_TBNDFRAC = P_TBOUND - 160._JPRB |
---|
| 213 | ENDIF |
---|
| 214 | !-end JJM_000511 |
---|
| 215 | |
---|
| 216 | DO I_LAY = 0, KLEV |
---|
| 217 | P_TOTUFLUC(I_LAY) = 0.0_JPRB |
---|
| 218 | P_TOTDFLUC(I_LAY) = 0.0_JPRB |
---|
| 219 | P_TOTUFLUX(I_LAY) = 0.0_JPRB |
---|
| 220 | P_TOTDFLUX(I_LAY) = 0.0_JPRB |
---|
| 221 | !-start JJM_000511 |
---|
| 222 | IF (P_TZ(I_LAY) < 339._JPRB .AND. P_TZ(I_LAY) >= 160._JPRB ) THEN |
---|
| 223 | INDLEV(I_LAY) = P_TZ(I_LAY) - 159._JPRB |
---|
| 224 | Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - INT(P_TZ(I_LAY)) |
---|
| 225 | ELSEIF (P_TZ(I_LAY) >= 339._JPRB ) THEN |
---|
| 226 | INDLEV(I_LAY) = 180 |
---|
| 227 | Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 339._JPRB |
---|
| 228 | ELSEIF (P_TZ(I_LAY) < 160._JPRB ) THEN |
---|
| 229 | INDLEV(I_LAY) = 1 |
---|
| 230 | Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 160._JPRB |
---|
| 231 | ENDIF |
---|
| 232 | !-end JJM_000511 |
---|
| 233 | ENDDO |
---|
| 234 | |
---|
| 235 | !_start_jjm 991209 |
---|
| 236 | DO I_LEV=0,KLEV |
---|
| 237 | Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
---|
| 238 | Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
---|
| 239 | Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
---|
| 240 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 241 | Z_FACCMB1(I_LEV+1) = 0.0_JPRB |
---|
| 242 | Z_FACCMB2(I_LEV+1) = 0.0_JPRB |
---|
| 243 | Z_FACCLD1D(I_LEV) = 0.0_JPRB |
---|
| 244 | Z_FACCLD2D(I_LEV) = 0.0_JPRB |
---|
| 245 | Z_FACCLR1D(I_LEV) = 0.0_JPRB |
---|
| 246 | Z_FACCLR2D(I_LEV) = 0.0_JPRB |
---|
| 247 | Z_FACCMB1D(I_LEV) = 0.0_JPRB |
---|
| 248 | Z_FACCMB2D(I_LEV) = 0.0_JPRB |
---|
| 249 | ENDDO |
---|
[2160] | 250 | |
---|
[1989] | 251 | Z_RAT1 = 0.0_JPRB |
---|
| 252 | Z_RAT2 = 0.0_JPRB |
---|
[2160] | 253 | |
---|
[1989] | 254 | !_end_jjm 991209 |
---|
| 255 | |
---|
| 256 | Z_SUMPL = 0.0_JPRB |
---|
| 257 | Z_SUMPLEM = 0.0_JPRB |
---|
| 258 | |
---|
| 259 | ISTCLD(1) = 1 |
---|
| 260 | ISTCLDD(KLEV) = 1 |
---|
| 261 | |
---|
| 262 | DO I_LEV = 1, KLEV |
---|
| 263 | !-- DS_000515 |
---|
| 264 | !-start JJM_000511 |
---|
| 265 | IF (P_TAVEL(I_LEV) < 339._JPRB .AND. P_TAVEL(I_LEV) >= 160._JPRB ) THEN |
---|
| 266 | INDLAY(I_LEV) = P_TAVEL(I_LEV) - 159._JPRB |
---|
| 267 | Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - INT(P_TAVEL(I_LEV)) |
---|
| 268 | ELSEIF (P_TAVEL(I_LEV) >= 339._JPRB ) THEN |
---|
| 269 | INDLAY(I_LEV) = 180 |
---|
| 270 | Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 339._JPRB |
---|
| 271 | ELSEIF (P_TAVEL(I_LEV) < 160._JPRB ) THEN |
---|
| 272 | INDLAY(I_LEV) = 1 |
---|
| 273 | Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 160._JPRB |
---|
| 274 | ENDIF |
---|
| 275 | !-end JJM_000511 |
---|
| 276 | ENDDO |
---|
| 277 | !-- DS_000515 |
---|
| 278 | |
---|
| 279 | !-- DS_000515 |
---|
| 280 | !OCL SCALAR |
---|
| 281 | |
---|
| 282 | DO I_LEV = 1, KLEV |
---|
| 283 | IF (K_ICLDLYR(I_LEV) == 1) THEN |
---|
| 284 | |
---|
| 285 | !mji |
---|
| 286 | ISTCLD(I_LEV+1) = 0 |
---|
| 287 | IF (I_LEV == KLEV) THEN |
---|
| 288 | Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
---|
| 289 | Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
---|
| 290 | Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
---|
| 291 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 292 | !-- DS_000515 |
---|
[2160] | 293 | !SB debug >> |
---|
| 294 | Z_FACCMB1(I_LEV+1) =0.0_JPRB |
---|
| 295 | Z_FACCMB2(I_LEV+1) =0.0_JPRB |
---|
| 296 | !SB debug << |
---|
[1989] | 297 | !mji ISTCLD(LEV+1) = _ZERO_ |
---|
| 298 | ELSEIF (Z_CLDFRAC(I_LEV+1) >= Z_CLDFRAC(I_LEV)) THEN |
---|
| 299 | Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
---|
| 300 | Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
---|
| 301 | IF (ISTCLD(I_LEV) == 1) THEN |
---|
| 302 | !mji ISTCLD(LEV+1) = 0 |
---|
| 303 | Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
---|
| 304 | !mji |
---|
| 305 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 306 | IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN |
---|
| 307 | Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/& |
---|
| 308 | & (1.0_JPRB-Z_CLDFRAC(I_LEV)) |
---|
[2160] | 309 | ENDIF |
---|
| 310 | !SB debug >> |
---|
| 311 | Z_FACCLR2(I_LEV) = 0.0_JPRB |
---|
| 312 | Z_FACCLD2(I_LEV) = 0.0_JPRB |
---|
| 313 | !SB debug << |
---|
[1989] | 314 | ELSE |
---|
| 315 | Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1)) |
---|
| 316 | !mji |
---|
| 317 | IF (Z_CLDFRAC(I_LEV+1) > Z_FMAX) THEN |
---|
| 318 | Z_FACCLR1(I_LEV+1) = Z_RAT2 |
---|
| 319 | Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX) |
---|
| 320 | !mji |
---|
| 321 | ELSEIF (Z_CLDFRAC(I_LEV+1) < Z_FMAX) THEN |
---|
| 322 | Z_FACCLR1(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/& |
---|
| 323 | & (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV)) |
---|
| 324 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 325 | !mji |
---|
| 326 | ELSE |
---|
| 327 | Z_FACCLR1(I_LEV+1) = Z_RAT2 |
---|
| 328 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 329 | ENDIF |
---|
| 330 | ENDIF |
---|
| 331 | IF (Z_FACCLR1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLR2(I_LEV+1) > 0.0_JPRB) THEN |
---|
| 332 | Z_RAT1 = 1.0_JPRB |
---|
| 333 | Z_RAT2 = 0.0_JPRB |
---|
[2160] | 334 | !SB debug >> |
---|
| 335 | ! ENDIF |
---|
| 336 | ELSE |
---|
| 337 | Z_RAT1 = 0.0_JPRB |
---|
| 338 | Z_RAT2 = 0.0_JPRB |
---|
[1989] | 339 | ENDIF |
---|
[2160] | 340 | !SB debug << |
---|
[1989] | 341 | ELSE |
---|
| 342 | Z_FACCLR1(I_LEV+1) = 0.0_JPRB |
---|
| 343 | Z_FACCLR2(I_LEV+1) = 0.0_JPRB |
---|
| 344 | IF (ISTCLD(I_LEV) == 1) THEN |
---|
| 345 | !mji ISTCLD(LEV+1) = 0 |
---|
| 346 | Z_FACCLD1(I_LEV+1) = 0.0_JPRB |
---|
| 347 | Z_FACCLD2(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/Z_CLDFRAC(I_LEV) |
---|
[2160] | 348 | !SB debug >> |
---|
| 349 | Z_FACCLR2(I_LEV) = 0.0_JPRB |
---|
| 350 | Z_FACCLD2(I_LEV) = 0.0_JPRB |
---|
| 351 | !SB debug << |
---|
[1989] | 352 | ELSE |
---|
| 353 | Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1)) |
---|
| 354 | IF (Z_CLDFRAC(I_LEV+1) <= Z_FMIN) THEN |
---|
| 355 | Z_FACCLD1(I_LEV+1) = Z_RAT1 |
---|
| 356 | Z_FACCLD2(I_LEV+1) = (Z_FMIN-Z_CLDFRAC(I_LEV+1))/Z_FMIN |
---|
| 357 | ELSE |
---|
| 358 | Z_FACCLD1(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/& |
---|
| 359 | & (Z_CLDFRAC(I_LEV)-Z_FMIN) |
---|
| 360 | Z_FACCLD2(I_LEV+1) = 0.0_JPRB |
---|
| 361 | ENDIF |
---|
| 362 | ENDIF |
---|
| 363 | IF (Z_FACCLD1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLD2(I_LEV+1) > 0.0_JPRB) THEN |
---|
| 364 | Z_RAT1 = 0.0_JPRB |
---|
| 365 | Z_RAT2 = 1.0_JPRB |
---|
[2160] | 366 | !SB debug >> |
---|
| 367 | ! ENDIF |
---|
| 368 | ELSE |
---|
| 369 | Z_RAT1 = 0.0_JPRB |
---|
| 370 | Z_RAT2 = 0.0_JPRB |
---|
[1989] | 371 | ENDIF |
---|
[2160] | 372 | !SB debug << |
---|
[1989] | 373 | ENDIF |
---|
| 374 | !fcc |
---|
[2160] | 375 | |
---|
| 376 | !SB debug >> |
---|
| 377 | ! IF (I_LEV == 1) THEN |
---|
| 378 | ! Z_FACCMB1(I_LEV+1) = 0. |
---|
| 379 | ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) |
---|
| 380 | ! ELSE |
---|
| 381 | ! Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1) |
---|
| 382 | ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *& |
---|
| 383 | ! & (1.0_JPRB - Z_CLDFRAC(I_LEV-1)) |
---|
| 384 | ! ENDIF |
---|
[2488] | 385 | if(istcld(i_lev).ne.1.and.i_lev.ne.1) then |
---|
[2160] | 386 | z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), & |
---|
| 387 | z_cldfrac(i_lev-1)-z_cldfrac(i_lev))) |
---|
| 388 | z_faccmb2(i_lev+1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), & |
---|
| 389 | z_cldfrac(i_lev)-z_cldfrac(i_lev-1))) |
---|
| 390 | endif |
---|
| 391 | !SB debug << |
---|
[1989] | 392 | !end fcc |
---|
| 393 | ELSE |
---|
| 394 | !-- DS_000515 |
---|
| 395 | ISTCLD(I_LEV+1) = 1 |
---|
| 396 | ENDIF |
---|
| 397 | ENDDO |
---|
| 398 | |
---|
| 399 | !_start_jjm 991209 |
---|
| 400 | Z_RAT1 = 0.0_JPRB |
---|
| 401 | Z_RAT2 = 0.0_JPRB |
---|
| 402 | !_end_jjm 991209 |
---|
| 403 | |
---|
| 404 | !-- DS_000515 |
---|
| 405 | !OCL SCALAR |
---|
| 406 | |
---|
| 407 | DO I_LEV = KLEV, 1, -1 |
---|
| 408 | IF (K_ICLDLYR(I_LEV) == 1) THEN |
---|
| 409 | !mji |
---|
| 410 | ISTCLDD(I_LEV-1) = 0 |
---|
| 411 | IF (I_LEV == 1) THEN |
---|
| 412 | Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
---|
| 413 | Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
---|
| 414 | Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
---|
| 415 | Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
---|
| 416 | Z_FACCMB1D(I_LEV-1) = 0.0_JPRB |
---|
| 417 | Z_FACCMB2D(I_LEV-1) = 0.0_JPRB |
---|
| 418 | !mji ISTCLDD(LEV-1) = _ZERO_ |
---|
| 419 | ELSEIF (Z_CLDFRAC(I_LEV-1) >= Z_CLDFRAC(I_LEV)) THEN |
---|
| 420 | Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
---|
| 421 | Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
---|
| 422 | IF (ISTCLDD(I_LEV) == 1) THEN |
---|
| 423 | !mji ISTCLDD(LEV-1) = 0 |
---|
| 424 | Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
---|
| 425 | Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
---|
| 426 | IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN |
---|
| 427 | Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/& |
---|
| 428 | & (1.0_JPRB-Z_CLDFRAC(I_LEV)) |
---|
| 429 | ENDIF |
---|
[2160] | 430 | !SB debug >> |
---|
| 431 | z_facclr2d(i_lev)=0.0_JPRB |
---|
| 432 | z_faccld2d(i_lev)=0.0_JPRB |
---|
| 433 | !SB debug << |
---|
[1989] | 434 | ELSE |
---|
| 435 | Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1)) |
---|
| 436 | !mji |
---|
| 437 | IF (Z_CLDFRAC(I_LEV-1) > Z_FMAX) THEN |
---|
| 438 | Z_FACCLR1D(I_LEV-1) = Z_RAT2 |
---|
| 439 | Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX) |
---|
| 440 | !mji |
---|
| 441 | ELSEIF (Z_CLDFRAC(I_LEV-1) < Z_FMAX) THEN |
---|
| 442 | Z_FACCLR1D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/& |
---|
| 443 | & (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV)) |
---|
| 444 | Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
---|
| 445 | !mji |
---|
| 446 | ELSE |
---|
| 447 | Z_FACCLR1D(I_LEV-1) = Z_RAT2 |
---|
| 448 | Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
---|
| 449 | ENDIF |
---|
| 450 | ENDIF |
---|
| 451 | IF (Z_FACCLR1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(I_LEV-1) > 0.0_JPRB)THEN |
---|
| 452 | Z_RAT1 = 1.0_JPRB |
---|
| 453 | Z_RAT2 = 0.0_JPRB |
---|
[2160] | 454 | !SB debug >> |
---|
| 455 | ! ENDIF |
---|
| 456 | else |
---|
| 457 | Z_RAT1 = 0.0_JPRB |
---|
| 458 | Z_RAT2 = 0.0_JPRB |
---|
| 459 | endif |
---|
| 460 | !SB debug << |
---|
[1989] | 461 | ELSE |
---|
| 462 | Z_FACCLR1D(I_LEV-1) = 0.0_JPRB |
---|
| 463 | Z_FACCLR2D(I_LEV-1) = 0.0_JPRB |
---|
| 464 | IF (ISTCLDD(I_LEV) == 1) THEN |
---|
| 465 | !mji ISTCLDD(LEV-1) = 0 |
---|
| 466 | Z_FACCLD1D(I_LEV-1) = 0.0_JPRB |
---|
| 467 | Z_FACCLD2D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/Z_CLDFRAC(I_LEV) |
---|
[2160] | 468 | !SB debug >> |
---|
| 469 | z_facclr2d(i_lev)=0.0_JPRB |
---|
| 470 | z_faccld2d(i_lev)=0.0_JPRB |
---|
| 471 | !SB debug << |
---|
[1989] | 472 | ELSE |
---|
| 473 | Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1)) |
---|
| 474 | IF (Z_CLDFRAC(I_LEV-1) <= Z_FMIN) THEN |
---|
| 475 | Z_FACCLD1D(I_LEV-1) = Z_RAT1 |
---|
| 476 | Z_FACCLD2D(I_LEV-1) = (Z_FMIN-Z_CLDFRAC(I_LEV-1))/Z_FMIN |
---|
| 477 | ELSE |
---|
| 478 | Z_FACCLD1D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/& |
---|
| 479 | & (Z_CLDFRAC(I_LEV)-Z_FMIN) |
---|
| 480 | Z_FACCLD2D(I_LEV-1) = 0.0_JPRB |
---|
| 481 | ENDIF |
---|
| 482 | ENDIF |
---|
| 483 | IF (Z_FACCLD1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(I_LEV-1) > 0.0_JPRB)THEN |
---|
| 484 | Z_RAT1 = 0.0_JPRB |
---|
| 485 | Z_RAT2 = 1.0_JPRB |
---|
[2160] | 486 | !SB debug >> |
---|
| 487 | ! ENDIF |
---|
| 488 | ELSE |
---|
| 489 | Z_RAT1 = 0.0_JPRB |
---|
| 490 | Z_RAT2 = 0.0_JPRB |
---|
[1989] | 491 | ENDIF |
---|
[2160] | 492 | !SB debug << |
---|
[1989] | 493 | ENDIF |
---|
[2160] | 494 | !SB debug >> |
---|
| 495 | ! Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1) |
---|
| 496 | ! Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *& |
---|
| 497 | ! & (1.0_JPRB - Z_CLDFRAC(I_LEV+1)) |
---|
[2488] | 498 | if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then |
---|
[2160] | 499 | z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), & |
---|
| 500 | z_cldfrac(i_lev-1)-z_cldfrac(i_lev))) |
---|
| 501 | z_faccmb2d(i_lev-1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), & |
---|
| 502 | z_cldfrac(i_lev)-z_cldfrac(i_lev-1))) |
---|
| 503 | endif |
---|
| 504 | !SB debug << |
---|
[1989] | 505 | ELSE |
---|
| 506 | ISTCLDD(I_LEV-1) = 1 |
---|
| 507 | ENDIF |
---|
| 508 | ENDDO |
---|
| 509 | |
---|
| 510 | !- Loop over frequency bands. |
---|
| 511 | |
---|
| 512 | DO IBAND = K_ISTART, K_IEND |
---|
| 513 | Z_DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND) |
---|
| 514 | Z_PLANKBND = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + Z_TBNDFRAC * Z_DBDTLEV) |
---|
| 515 | Z_DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -TOTPLNK(INDLEV(0),IBAND) |
---|
| 516 | !-- DS_000515 |
---|
| 517 | Z_PLVL(IBAND,0) = DELWAVE(IBAND)& |
---|
| 518 | & * (TOTPLNK(INDLEV(0),IBAND) + Z_TLEVFRAC(0)*Z_DBDTLEV) |
---|
| 519 | |
---|
| 520 | Z_SURFEMIS(IBAND) = P_SEMISS(IBAND) |
---|
| 521 | Z_PLNKEMIT(IBAND) = Z_SURFEMIS(IBAND) * Z_PLANKBND |
---|
| 522 | Z_SUMPLEM = Z_SUMPLEM + Z_PLNKEMIT(IBAND) |
---|
| 523 | Z_SUMPL = Z_SUMPL + Z_PLANKBND |
---|
| 524 | !--DS |
---|
| 525 | ENDDO |
---|
| 526 | !--- |
---|
| 527 | |
---|
| 528 | !-- DS_000515 |
---|
| 529 | DO I_LEV = 1, KLEV |
---|
| 530 | DO IBAND = K_ISTART, K_IEND |
---|
| 531 | ! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV) |
---|
| 532 | !---- |
---|
| 533 | !- Calculate the integrated Planck functions for at the |
---|
| 534 | ! level and layer temperatures. |
---|
| 535 | ! Compute cloud transmittance for cloudy layers. |
---|
| 536 | Z_DBDTLEV = TOTPLNK(INDLEV(I_LEV)+1,IBAND) - TOTPLNK(INDLEV(I_LEV),IBAND) |
---|
| 537 | Z_DBDTLAY = TOTPLNK(INDLAY(I_LEV)+1,IBAND) - TOTPLNK(INDLAY(I_LEV),IBAND) |
---|
| 538 | !-- DS_000515 |
---|
| 539 | Z_PLAY(IBAND,I_LEV) = DELWAVE(IBAND)& |
---|
| 540 | & *(TOTPLNK(INDLAY(I_LEV),IBAND)+Z_TLAYFRAC(I_LEV)*Z_DBDTLAY) |
---|
| 541 | Z_PLVL(IBAND,I_LEV) = DELWAVE(IBAND)& |
---|
| 542 | & *(TOTPLNK(INDLEV(I_LEV),IBAND)+Z_TLEVFRAC(I_LEV)*Z_DBDTLEV) |
---|
| 543 | IF (K_ICLDLYR(I_LEV) > 0) THEN |
---|
| 544 | ZEXTAU = MIN( P_TAUCLD(I_LEV,IBAND), 200._JPRB) |
---|
| 545 | Z_TRNCLD(I_LEV,IBAND) = EXP( -ZEXTAU ) |
---|
| 546 | ENDIF |
---|
| 547 | !-- DS_000515 |
---|
| 548 | ENDDO |
---|
| 549 | |
---|
| 550 | ENDDO |
---|
| 551 | |
---|
| 552 | P_SEMISLW = Z_SUMPLEM / Z_SUMPL |
---|
| 553 | |
---|
| 554 | !--DS |
---|
| 555 | !O IPR = 1, JPGPT |
---|
| 556 | ! NBI = NGB(IPR) |
---|
| 557 | ! DO LEV = 1 , KLEV |
---|
| 558 | !-- DS_000515 |
---|
| 559 | ! ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR)) |
---|
| 560 | ! ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR)) |
---|
| 561 | ! ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR)) |
---|
| 562 | ! ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR)) |
---|
| 563 | !-- DS_000515 |
---|
| 564 | ! ENDDO |
---|
| 565 | !NDDO |
---|
| 566 | !---- |
---|
| 567 | |
---|
| 568 | !- For cloudy layers, set cloud parameters for radiative transfer. |
---|
| 569 | DO I_LEV = 1, KLEV |
---|
| 570 | IF (K_ICLDLYR(I_LEV) > 0) THEN |
---|
| 571 | DO IPR = 1, JPGPT |
---|
| 572 | !--DS |
---|
| 573 | ! NBI = NGB(IPR) |
---|
| 574 | Z_ODCLDNW(IPR,I_LEV) = P_TAUCLD(I_LEV,NGB(IPR)) |
---|
| 575 | Z_ABSCLDNW(IPR,I_LEV) = 1.0_JPRB - Z_TRNCLD(I_LEV,NGB(IPR)) |
---|
| 576 | !---- |
---|
| 577 | ! EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV) |
---|
| 578 | ENDDO |
---|
| 579 | ENDIF |
---|
| 580 | ENDDO |
---|
| 581 | |
---|
| 582 | !- Initialize for radiative transfer. |
---|
| 583 | DO IPR = 1, JPGPT |
---|
| 584 | Z_RADCLRD1(IPR) = 0.0_JPRB |
---|
| 585 | Z_RADLD1(IPR) = 0.0_JPRB |
---|
| 586 | I_NBI = NGB(IPR) |
---|
| 587 | Z_SEMIS(IPR) = Z_SURFEMIS(I_NBI) |
---|
| 588 | Z_RADUEMIT(IPR) = PFRAC(IPR,1) * Z_PLNKEMIT(I_NBI) |
---|
| 589 | !-- DS_000515 |
---|
| 590 | Z_BGLEV(IPR) = PFRAC(IPR,KLEV) * Z_PLVL(I_NBI,KLEV) |
---|
| 591 | ENDDO |
---|
| 592 | |
---|
| 593 | !- Downward radiative transfer. |
---|
| 594 | ! *** DRAD1 holds summed radiance for total sky stream |
---|
| 595 | ! *** DRADCL1 holds summed radiance for clear sky stream |
---|
| 596 | |
---|
| 597 | ICLDDN = 0 |
---|
| 598 | DO I_LEV = KLEV, 1, -1 |
---|
| 599 | Z_DRAD1 = 0.0_JPRB |
---|
| 600 | Z_DRADCL1 = 0.0_JPRB |
---|
| 601 | |
---|
| 602 | IF (K_ICLDLYR(I_LEV) == 1) THEN |
---|
| 603 | |
---|
| 604 | ! *** Cloudy layer |
---|
| 605 | ICLDDN = 1 |
---|
| 606 | IENT = JPGPT * (I_LEV-1) |
---|
| 607 | DO IPR = 1, JPGPT |
---|
| 608 | INDEX = IENT + IPR |
---|
| 609 | !--DS |
---|
| 610 | ! NBI = NGB(IPR) |
---|
| 611 | Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
---|
| 612 | !---- |
---|
| 613 | Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 614 | Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
---|
| 615 | !--DS |
---|
| 616 | Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
---|
| 617 | !---- |
---|
| 618 | Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 619 | Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
---|
| 620 | !- total-sky downward flux |
---|
| 621 | Z_ODSM = P_OD(IPR,I_LEV) + Z_ODCLDNW(IPR,I_LEV) |
---|
| 622 | Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM) |
---|
| 623 | Z_BBUTOT1(INDEX) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP |
---|
| 624 | Z_ATOT1(INDEX) = P_ABSS1(INDEX) + Z_ABSCLDNW(IPR,I_LEV)& |
---|
| 625 | & - P_ABSS1(INDEX) * Z_ABSCLDNW(IPR,I_LEV) |
---|
| 626 | Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN |
---|
| 627 | Z_GASSRC = Z_BBD * P_ABSS1(INDEX) |
---|
| 628 | !*** |
---|
| 629 | IF (ISTCLDD(I_LEV) == 1) THEN |
---|
| 630 | Z_CLDRADD(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLD1(IPR) |
---|
| 631 | Z_CLRRADD(IPR) = Z_RADLD1(IPR) - Z_CLDRADD(IPR) |
---|
| 632 | Z_OLDCLD(IPR) = Z_CLDRADD(IPR) |
---|
| 633 | Z_OLDCLR(IPR) = Z_CLRRADD(IPR) |
---|
| 634 | Z_RAD(IPR) = 0.0_JPRB |
---|
| 635 | ENDIF |
---|
| 636 | Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX) |
---|
| 637 | Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX) |
---|
| 638 | |
---|
| 639 | ! Separate RT equations for clear and cloudy streams |
---|
| 640 | Z_CLDRADD(IPR) = Z_CLDRADD(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC |
---|
| 641 | Z_CLRRADD(IPR) = Z_CLRRADD(IPR) * (1.0_JPRB-P_ABSS1(INDEX)) +& |
---|
| 642 | & (1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC |
---|
| 643 | |
---|
| 644 | ! Total sky downward radiance |
---|
| 645 | Z_RADLD1(IPR) = Z_CLDRADD(IPR) + Z_CLRRADD(IPR) |
---|
| 646 | Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
---|
| 647 | |
---|
| 648 | ! Clear-sky downward radiance |
---|
| 649 | Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX) |
---|
| 650 | Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR) |
---|
| 651 | |
---|
| 652 | !* Code to account for maximum/random overlap: |
---|
| 653 | ! Performs RT on the radiance most recently switched between clear and |
---|
| 654 | ! cloudy streams |
---|
| 655 | Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1D(I_LEV-1) * (1.0_JPRB-P_ABSS1(INDEX)) +& |
---|
| 656 | & Z_FACCLD1D(I_LEV-1) * Z_TTOT) - & |
---|
| 657 | & Z_FACCMB1D(I_LEV-1) * Z_GASSRC + & |
---|
| 658 | & Z_FACCMB2D(I_LEV-1) * Z_CLDSRC |
---|
| 659 | |
---|
| 660 | ! Computes what the clear and cloudy streams would have been had no |
---|
| 661 | ! radiance been switched |
---|
| 662 | Z_OLDCLD(IPR) = Z_CLDRADD(IPR) - Z_RADMOD |
---|
| 663 | Z_OLDCLR(IPR) = Z_CLRRADD(IPR) + Z_RADMOD |
---|
| 664 | |
---|
| 665 | ! Computes the radiance to be switched between clear and cloudy. |
---|
| 666 | Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2D(I_LEV-1)*Z_OLDCLR(IPR) -& |
---|
| 667 | & Z_FACCLD2D(I_LEV-1)*Z_OLDCLD(IPR) |
---|
| 668 | Z_CLDRADD(IPR) = Z_CLDRADD(IPR) + Z_RAD(IPR) |
---|
| 669 | Z_CLRRADD(IPR) = Z_CLRRADD(IPR) - Z_RAD(IPR) |
---|
| 670 | !*** |
---|
| 671 | |
---|
| 672 | ENDDO |
---|
| 673 | |
---|
| 674 | ELSE |
---|
| 675 | |
---|
| 676 | ! *** Clear layer |
---|
| 677 | ! *** DRAD1 holds summed radiance for total sky stream |
---|
| 678 | ! *** DRADCL1 holds summed radiance for clear sky stream |
---|
| 679 | |
---|
| 680 | IENT = JPGPT * (I_LEV-1) |
---|
| 681 | IF (ICLDDN == 1) THEN |
---|
| 682 | DO IPR = 1, JPGPT |
---|
| 683 | INDEX = IENT + IPR |
---|
| 684 | !--DS |
---|
| 685 | ! NBI = NGB(IPR) |
---|
| 686 | Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
---|
| 687 | !---- |
---|
| 688 | Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 689 | Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
---|
| 690 | !--DS |
---|
| 691 | Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
---|
| 692 | !---- |
---|
| 693 | Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 694 | Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
---|
| 695 | |
---|
| 696 | !- total-sky downward radiance |
---|
| 697 | Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX) |
---|
| 698 | Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
---|
| 699 | |
---|
| 700 | !- clear-sky downward radiance |
---|
| 701 | !- Set clear sky stream to total sky stream as long as layers |
---|
| 702 | !- remain clear. Streams diverge when a cloud is reached. |
---|
| 703 | Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX) |
---|
| 704 | Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR) |
---|
| 705 | ENDDO |
---|
| 706 | |
---|
| 707 | ELSE |
---|
| 708 | |
---|
| 709 | DO IPR = 1, JPGPT |
---|
| 710 | INDEX = IENT + IPR |
---|
| 711 | !--DS |
---|
| 712 | ! NBI = NGB(IPR) |
---|
| 713 | Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV) |
---|
| 714 | !---- |
---|
| 715 | Z_DELBGUP = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 716 | Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP |
---|
| 717 | !--DS |
---|
| 718 | Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1) |
---|
| 719 | !---- |
---|
| 720 | Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY |
---|
| 721 | Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN |
---|
| 722 | !- total-sky downward flux |
---|
| 723 | Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX) |
---|
| 724 | Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR) |
---|
| 725 | !- clear-sky downward flux |
---|
| 726 | !- Set clear sky stream to total sky stream as long as layers |
---|
| 727 | !- remain clear. Streams diverge when a cloud is reached. |
---|
| 728 | Z_RADCLRD1(IPR) = Z_RADLD1(IPR) |
---|
| 729 | ENDDO |
---|
| 730 | Z_DRADCL1 = Z_DRAD1 |
---|
| 731 | ENDIF |
---|
| 732 | |
---|
| 733 | ENDIF |
---|
| 734 | |
---|
| 735 | P_TOTDFLUC(I_LEV-1) = Z_DRADCL1 * Z_WTNUM(1) |
---|
| 736 | P_TOTDFLUX(I_LEV-1) = Z_DRAD1 * Z_WTNUM(1) |
---|
| 737 | |
---|
| 738 | ENDDO |
---|
| 739 | |
---|
| 740 | ! Spectral reflectivity and reflectance |
---|
| 741 | ! Includes the contribution of spectrally varying longwave emissivity |
---|
| 742 | ! and reflection from the surface to the upward radiative transfer. |
---|
| 743 | ! Note: Spectral and Lambertian reflections are identical for the one |
---|
| 744 | ! angle flux integration used here. |
---|
| 745 | |
---|
| 746 | Z_URAD1 = 0.0_JPRB |
---|
| 747 | Z_URADCL1 = 0.0_JPRB |
---|
| 748 | |
---|
| 749 | !start JJM_000511 |
---|
| 750 | !IF (IREFLECT == 0) THEN |
---|
| 751 | !- Lambertian reflection. |
---|
| 752 | DO IPR = 1, JPGPT |
---|
| 753 | ! Clear-sky radiance |
---|
| 754 | ! RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) ) |
---|
| 755 | Z_RADCLD = Z_RADCLRD1(IPR) |
---|
| 756 | Z_RADCLRU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADCLD |
---|
| 757 | Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
---|
| 758 | |
---|
| 759 | ! Total sky radiance |
---|
| 760 | ! RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) ) |
---|
| 761 | Z_RADD = Z_RADLD1(IPR) |
---|
| 762 | Z_RADLU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADD |
---|
| 763 | Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
---|
| 764 | ENDDO |
---|
| 765 | P_TOTUFLUC(0) = Z_URADCL1 * 0.5_JPRB |
---|
| 766 | P_TOTUFLUX(0) = Z_URAD1 * 0.5_JPRB |
---|
| 767 | !ELSE |
---|
| 768 | !!- Specular reflection. |
---|
| 769 | ! DO IPR = 1, JPGPT |
---|
| 770 | ! RADCLU = RADUEMIT(IPR) |
---|
| 771 | ! RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR) |
---|
| 772 | ! URADCL1 = URADCL1 + RADCLRU1(IPR) |
---|
| 773 | |
---|
| 774 | ! RADU = RADUEMIT(IPR) |
---|
| 775 | ! RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR) |
---|
| 776 | ! URAD1 = URAD1 + RADLU1(IPR) |
---|
| 777 | ! ENDDO |
---|
| 778 | ! TOTUFLUC(0) = URADCL1 * WTNUM(1) |
---|
| 779 | ! TOTUFLUX(0) = URAD1 * WTNUM(1) |
---|
| 780 | !ENDIF |
---|
| 781 | |
---|
| 782 | !- Upward radiative transfer. |
---|
| 783 | !- *** URAD1 holds the summed radiance for total sky stream |
---|
| 784 | !- *** URADCL1 holds the summed radiance for clear sky stream |
---|
| 785 | DO I_LEV = 1, KLEV |
---|
| 786 | Z_URAD1 = 0.0_JPRB |
---|
| 787 | Z_URADCL1 = 0.0_JPRB |
---|
| 788 | |
---|
| 789 | ! Check flag for cloud in current layer |
---|
| 790 | IF (K_ICLDLYR(I_LEV) == 1) THEN |
---|
| 791 | |
---|
| 792 | !- *** Cloudy layer |
---|
| 793 | IENT = JPGPT * (I_LEV-1) |
---|
| 794 | DO IPR = 1, JPGPT |
---|
| 795 | INDEX = IENT + IPR |
---|
| 796 | !- total-sky upward flux |
---|
| 797 | Z_GASSRC = Z_BBU1(INDEX) * P_ABSS1(INDEX) |
---|
| 798 | |
---|
| 799 | !- If first cloudy layer in sequence, split up radiance into clear and |
---|
| 800 | ! cloudy streams depending on cloud fraction |
---|
| 801 | IF (ISTCLD(I_LEV) == 1) THEN |
---|
| 802 | Z_CLDRADU(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLU1(IPR) |
---|
| 803 | Z_CLRRADU(IPR) = Z_RADLU1(IPR) - Z_CLDRADU(IPR) |
---|
| 804 | Z_OLDCLD(IPR) = Z_CLDRADU(IPR) |
---|
| 805 | Z_OLDCLR(IPR) = Z_CLRRADU(IPR) |
---|
| 806 | Z_RAD(IPR) = 0.0_JPRB |
---|
| 807 | ENDIF |
---|
| 808 | Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX) |
---|
| 809 | Z_TRNS = 1.0_JPRB - P_ABSS1(INDEX) |
---|
| 810 | Z_CLDSRC = Z_BBUTOT1(INDEX) * Z_ATOT1(INDEX) |
---|
| 811 | |
---|
| 812 | !- Separate RT equations for clear and cloudy streams |
---|
| 813 | Z_CLDRADU(IPR) = Z_CLDRADU(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC |
---|
| 814 | Z_CLRRADU(IPR) = Z_CLRRADU(IPR) * Z_TRNS +(1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC |
---|
| 815 | !*** |
---|
| 816 | |
---|
| 817 | !- total sky upward flux |
---|
| 818 | Z_RADLU1(IPR) = Z_CLDRADU(IPR) + Z_CLRRADU(IPR) |
---|
| 819 | Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
---|
| 820 | |
---|
| 821 | !- clear-sky upward flux |
---|
| 822 | Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR) + (Z_BBU1(INDEX)-Z_RADCLRU1(IPR))& |
---|
| 823 | & *P_ABSS1(INDEX) |
---|
| 824 | Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
---|
| 825 | |
---|
| 826 | !* Code to account for maximum/random overlap: |
---|
| 827 | ! Performs RT on the radiance most recently switched between clear and |
---|
| 828 | ! cloudy streams |
---|
| 829 | Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1(I_LEV+1) * Z_TRNS +& |
---|
| 830 | & Z_FACCLD1(I_LEV+1) * Z_TTOT) - & |
---|
| 831 | & Z_FACCMB1(I_LEV+1) * Z_GASSRC + & |
---|
| 832 | & Z_FACCMB2(I_LEV+1) * Z_CLDSRC |
---|
| 833 | |
---|
| 834 | ! Computes what the clear and cloudy streams would have been had no |
---|
| 835 | ! radiance been switched |
---|
| 836 | Z_OLDCLD(IPR) = Z_CLDRADU(IPR) - Z_RADMOD |
---|
| 837 | Z_OLDCLR(IPR) = Z_CLRRADU(IPR) + Z_RADMOD |
---|
| 838 | |
---|
| 839 | ! Computes the radiance to be switched between clear and cloudy. |
---|
| 840 | Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2(I_LEV+1)*Z_OLDCLR(IPR) -& |
---|
| 841 | & Z_FACCLD2(I_LEV+1)*Z_OLDCLD(IPR) |
---|
| 842 | Z_CLDRADU(IPR) = Z_CLDRADU(IPR) + Z_RAD(IPR) |
---|
| 843 | Z_CLRRADU(IPR) = Z_CLRRADU(IPR) - Z_RAD(IPR) |
---|
| 844 | !*** |
---|
| 845 | ENDDO |
---|
| 846 | |
---|
| 847 | ELSE |
---|
| 848 | |
---|
| 849 | !- *** Clear layer |
---|
| 850 | IENT = JPGPT * (I_LEV-1) |
---|
| 851 | DO IPR = 1, JPGPT |
---|
| 852 | INDEX = IENT + IPR |
---|
| 853 | !- total-sky upward flux |
---|
| 854 | Z_RADLU1(IPR) = Z_RADLU1(IPR)+(Z_BBU1(INDEX)-Z_RADLU1(IPR))*P_ABSS1(INDEX) |
---|
| 855 | Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR) |
---|
| 856 | !- clear-sky upward flux |
---|
| 857 | ! Upward clear and total sky streams must be separate because surface |
---|
| 858 | ! reflectance is different for each. |
---|
| 859 | Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR)+(Z_BBU1(INDEX)-Z_RADCLRU1(IPR))*P_ABSS1(INDEX) |
---|
| 860 | Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR) |
---|
| 861 | ENDDO |
---|
| 862 | |
---|
| 863 | ENDIF |
---|
| 864 | |
---|
| 865 | P_TOTUFLUC(I_LEV) = Z_URADCL1 * Z_WTNUM(1) |
---|
| 866 | P_TOTUFLUX(I_LEV) = Z_URAD1 * Z_WTNUM(1) |
---|
| 867 | |
---|
| 868 | ENDDO |
---|
| 869 | |
---|
| 870 | !* Convert radiances to fluxes and heating rates for total and clear sky. |
---|
| 871 | ! ** NB: moved to calling routine |
---|
| 872 | ! TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC |
---|
| 873 | ! TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC |
---|
| 874 | ! TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC |
---|
| 875 | ! TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC |
---|
| 876 | |
---|
[2160] | 877 | ! CLFNET(0) = (P_TOTUFLUC(0) - P_TOTDFLUC(0)) |
---|
| 878 | ! FNET(0) = (P_TOTUFLUX(0) - P_TOTDFLUX(0)) |
---|
[1989] | 879 | ! DO LEV = 1, KLEV |
---|
| 880 | ! TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC |
---|
| 881 | ! TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC |
---|
[2160] | 882 | ! CLFNET(LEV) =(P_TOTUFLUC(LEV) - P_TOTDFLUC(LEV)) |
---|
[1989] | 883 | |
---|
| 884 | ! TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC |
---|
| 885 | ! TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC |
---|
[2160] | 886 | ! FNET(LEV) = (P_TOTUFLUX(LEV) - P_TOTDFLUX(LEV)) |
---|
[1989] | 887 | ! L = LEV - 1 |
---|
| 888 | |
---|
| 889 | !- Calculate Heating Rates. |
---|
| 890 | ! CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV)) |
---|
| 891 | ! HTR(L) =HEATFAC*(FNET(L) -FNET(LEV)) /(PZ(L)-PZ(LEV)) |
---|
| 892 | ! END DO |
---|
| 893 | ! CLHTR(KLEV) = 0.0 |
---|
| 894 | ! HTR(KLEV) = 0.0 |
---|
| 895 | |
---|
[2160] | 896 | |
---|
| 897 | |
---|
[1989] | 898 | IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE) |
---|
| 899 | END SUBROUTINE RRTM_RTRN1A_140GP |
---|