| [2089] | 1 | SUBROUTINE RADLSW & |
|---|
| 2 | &( KIDIA, KFDIA , KLON , KTDIA, KLEV , KMODE, KAER, KBOX, NBOX & |
|---|
| 3 | &, NDUMP, KLWRAD & |
|---|
| 4 | &, PRII0 & |
|---|
| 5 | &, PAER , PALBD , PALBP, PAPH , PAP & |
|---|
| 6 | &, PCCO2, PFRCL , PDP , PEMIS, PEMIW , PLSM , PMU0, POZON & |
|---|
| 7 | &, PQ , PQIWP , PQLWP, PSQIW, PSQLW , PQS , PQRAIN, PRAINT & |
|---|
| 8 | &, PRLVRI,PRLVRL, PTH , PT , PTS , PNBAS, PNTOP & |
|---|
| 9 | &, PEMIT, PFCT , PFLT , PFCS , PFLS , PFRSOD, PSUDU, PUVDF, PPARF & |
|---|
| 10 | &, PFDCT, PFUCT , PFDLT, PFULT, PFDCS , PFUCS , PFDLS, PFULS & |
|---|
| 11 | &, ZTAU , ZTAUINT & |
|---|
| 12 | &, ASWBOX, OLRBOX, SLWBOX, SSWBOX, TAUBOX, PCLBX & |
|---|
| 13 | ! #DB &, k2iii, k2jjj & |
|---|
| 14 | &) |
|---|
| 15 | |
|---|
| 16 | !**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES |
|---|
| 17 | |
|---|
| 18 | ! PURPOSE. |
|---|
| 19 | ! -------- |
|---|
| 20 | ! CONTROLS RADIATION COMPUTATIONS |
|---|
| 21 | |
|---|
| 22 | !** INTERFACE. |
|---|
| 23 | ! ---------- |
|---|
| 24 | |
|---|
| 25 | ! EXPLICIT ARGUMENTS : |
|---|
| 26 | ! -------------------- |
|---|
| 27 | ! PAER : (KLON,6,KLEV) ; OPTICAL THICKNESS OF THE AEROSOLS |
|---|
| 28 | ! PALBD : (KLON,NSW) ; SURF. SW ALBEDO FOR DIFFUSE RADIATION |
|---|
| 29 | ! PALBP : (KLON,NSW) ; SURF. SW ALBEDO FOR PARALLEL RADIATION |
|---|
| 30 | ! PAPH : (KLON,KLEV+1) ; HALF LEVEL PRESSURE |
|---|
| 31 | ! PAP : (KLON,KLEV) ; FULL LEVEL PRESSURE |
|---|
| 32 | ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) |
|---|
| 33 | ! PFRCL : (KLON,KLEV) ; CLOUD FRACTIONAL COVER |
|---|
| 34 | ! PDP : (KLON,KLEV) ; LAYER PRESSURE THICKNESS |
|---|
| 35 | ! PEMIS : (KLON) ; SURFACE LW EMISSIVITY |
|---|
| 36 | ! PEMIW : (KLON) ; SURFACE LW WINDOW EMISSIVITY |
|---|
| 37 | ! PLSM : (KLON) ; LAND-SEA MASK |
|---|
| 38 | ! PMU0 : (KLON) ; SOLAR ANGLE |
|---|
| 39 | ! PNBAS : (KLON) ; INDEX OF BASE OF CONVECTIVE LAYER |
|---|
| 40 | ! PNTOP : (KLON) ; INDEX OF TOP OF CONVECTIVE LAYER |
|---|
| 41 | ! POZON : (KLON,KLEV) ; CONCENTRATION IN OZONE (PA/PA) |
|---|
| 42 | ! PQ : (KLON,KLEV) ; SPECIFIC HUMIDITY PA/PA |
|---|
| 43 | ! PQIWP : (KLON,KLEV) ; SOLID WATER KG/KG |
|---|
| 44 | ! PQLWP : (KLON,KLEV) ; LIQUID WATER KG/KG |
|---|
| 45 | ! PQS : (KLON,KLEV) ; SATURATION WATER VAPOR KG/KG |
|---|
| 46 | ! PQRAIN : (KLON,KLEV) ; RAIN WATER KG/KG |
|---|
| 47 | ! PRAINT : (KLON,KLEV) ; RAIN RATE (m/s) |
|---|
| 48 | ! PRLVRI : (KLON,KLEV) ; RELATIVE VARIANCE OF ICE WATER |
|---|
| 49 | ! PRLVRL : (KLON,KLEV) ; RELATIVE VARIANCE OF LIQUID WATER |
|---|
| 50 | ! PTH : (KLON,KLEV+1) ; HALF LEVEL TEMPERATURE |
|---|
| 51 | ! PT : (KLON,KLEV) ; FULL LEVEL TEMPERATURE |
|---|
| 52 | ! PTS : (KLON) ; SURFACE TEMPERATURE |
|---|
| 53 | ! ==== OUTPUTS === |
|---|
| 54 | ! PFCT : (KLON,KLEV+1) ; CLEAR-SKY LW NET FLUXES |
|---|
| 55 | ! PFLT : (KLON,KLEV+1) ; TOTAL LW NET FLUXES |
|---|
| 56 | ! PFCS : (KLON,KLEV+1) ; CLEAR-SKY SW NET FLUXES |
|---|
| 57 | ! PFLS : (KLON,KLEV+1) ; TOTAL SW NET FLUXES |
|---|
| 58 | ! PFRSOD : (KLON) ; TOTAL-SKY SURFACE SW DOWNWARD FLUX |
|---|
| 59 | ! PEMIT : (KLON) ; SURFACE TOTAL LONGWAVE EMISSIVITY |
|---|
| 60 | ! PSUDU : (KLON) ; SOLAR RADIANCE IN SUN'S DIRECTION |
|---|
| 61 | ! PUVDF : (KLON) ; SURFACE DOWNWARD U.V. RADIATION |
|---|
| 62 | ! PPARF : (KLON) ; PHOTOSYNTHETICALLY ACTIVE RADIATION |
|---|
| 63 | |
|---|
| 64 | ! IMPLICIT ARGUMENTS : NONE |
|---|
| 65 | ! -------------------- |
|---|
| 66 | |
|---|
| 67 | ! METHOD. |
|---|
| 68 | ! ------- |
|---|
| 69 | ! SEE DOCUMENTATION |
|---|
| 70 | |
|---|
| 71 | ! EXTERNALS. |
|---|
| 72 | ! ---------- |
|---|
| 73 | |
|---|
| 74 | ! REFERENCE. |
|---|
| 75 | ! ---------- |
|---|
| 76 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
|---|
| 77 | |
|---|
| 78 | ! AUTHORS. |
|---|
| 79 | ! -------- |
|---|
| 80 | ! J.-J. MORCRETTE *ECMWF* |
|---|
| 81 | |
|---|
| 82 | ! MODIFICATIONS. |
|---|
| 83 | ! -------------- |
|---|
| 84 | ! ORIGINAL : 88-02-04 |
|---|
| 85 | ! J.-J. MORCRETTE 94-11-15 DIRECT/DIFFUSE SURFACE ALBEDO |
|---|
| 86 | ! 08/96: J.-J. Morcrette/Ph. Dandin: tests of eff. radius param. |
|---|
| 87 | ! 9909 : JJMorcrette effect.radius + inhomogeneity factors |
|---|
| 88 | ! JJMorcrette 990128 : sunshine duration |
|---|
| 89 | ! JJMorcrette : 990831 RRTM-140gp |
|---|
| 90 | !----------------------------------------------------------------------- |
|---|
| 91 | |
|---|
| 92 | #include "tsmbkind.h" |
|---|
| 93 | |
|---|
| 94 | !USE YOMCT3 , ONLY : NSTEP |
|---|
| 95 | USE YOMCST , ONLY : RG ,RD ,RTT ,RPI |
|---|
| 96 | USE YOERAD , ONLY : NSW ,LRRTM ,LINHOM, & |
|---|
| 97 | &LOIFUEC, LTEMPDS, LOWASYF, LOWHSSS, NRADIP, NRADLP, & |
|---|
| 98 | &NICEOPT, NLIQOPT, NOVLP , NHOWINH, RMINICE |
|---|
| 99 | USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP |
|---|
| 100 | USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD ,& |
|---|
| 101 | &RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC ,& |
|---|
| 102 | &REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ ,& |
|---|
| 103 | &REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0 ,& |
|---|
| 104 | &RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3 ,& |
|---|
| 105 | &RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0 ,& |
|---|
| 106 | &RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUAA0 ,RFUAA1 ,& |
|---|
| 107 | &RFUBB0 ,RFUBB1 ,RFUBB2 ,RFUBB3 ,RFUCC0 ,& |
|---|
| 108 | &RFUCC1 ,RFUCC2 ,RFUCC3 ,RFUETA ,RASWCA ,& |
|---|
| 109 | &RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF ,& |
|---|
| 110 | &RLINLI |
|---|
| 111 | USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,DIFF |
|---|
| 112 | USE YOERDI , ONLY : REPCLC |
|---|
| 113 | USE YOETHF , ONLY : RTICE |
|---|
| 114 | USE YOEPHLI , ONLY : LPHYLIN |
|---|
| 115 | USE YOERRTWN , ONLY : NG ,NSPA ,NSPB ,WAVENUM1 ,& |
|---|
| 116 | &WAVENUM2 ,DELWAVE ,TOTPLNK ,TOTPLK16 |
|---|
| 117 | USE YOEDBUG , ONLY : LDEBUG |
|---|
| 118 | |
|---|
| 119 | |
|---|
| 120 | IMPLICIT NONE |
|---|
| 121 | |
|---|
| 122 | |
|---|
| 123 | ! DUMMY INTEGER SCALARS |
|---|
| 124 | INTEGER_M :: KAER |
|---|
| 125 | INTEGER_M :: KFDIA |
|---|
| 126 | INTEGER_M :: KIDIA |
|---|
| 127 | INTEGER_M :: KLEV |
|---|
| 128 | INTEGER_M :: KLON |
|---|
| 129 | INTEGER_M :: KMODE |
|---|
| 130 | INTEGER_M :: KTDIA |
|---|
| 131 | INTEGER_M :: KBOX |
|---|
| 132 | INTEGER_M :: NBOX |
|---|
| 133 | INTEGER_M :: NDUMP, KLWRAD |
|---|
| 134 | |
|---|
| 135 | ! DUMMY REAL SCALARS |
|---|
| 136 | REAL_B :: PRII0 |
|---|
| 137 | |
|---|
| 138 | |
|---|
| 139 | |
|---|
| 140 | ! ----------------------------------------------------------------- |
|---|
| 141 | |
|---|
| 142 | !* 0.1 ARGUMENTS. |
|---|
| 143 | ! ---------- |
|---|
| 144 | REAL_B :: PALBD(KLON,NSW) , PALBP(KLON,NSW) |
|---|
| 145 | REAL_B :: PEMIS(KLON) , PEMIW(KLON) |
|---|
| 146 | REAL_B :: PLSM(KLON) , PMU0(KLON) |
|---|
| 147 | REAL_B :: PCCO2 , POZON(KLON,KLEV) |
|---|
| 148 | REAL_B :: PTS(KLON) , PNBAS(KLON) , PNTOP(KLON) |
|---|
| 149 | REAL_B :: PT (KLON,KLEV) , PAP (KLON,KLEV) |
|---|
| 150 | REAL_B :: PTH(KLON,KLEV+1), PAPH(KLON,KLEV+1) |
|---|
| 151 | REAL_B :: PDP(KLON,KLEV) |
|---|
| 152 | REAL_B :: PQ (KLON,KLEV) , PQS(KLON,KLEV) |
|---|
| 153 | REAL_B :: PQIWP(KLON,KLEV), PQLWP(KLON,KLEV), PQRAIN(KLON,KLEV) |
|---|
| 154 | REAL_B :: PRAINT(KLON,KLEV) |
|---|
| 155 | REAL_B :: PRLVRI(KLON,KLEV),PRLVRL(KLON,KLEV) |
|---|
| 156 | REAL_B :: PSQIW(KLON,KLEV), PSQLW(KLON,KLEV) |
|---|
| 157 | REAL_B :: PFRCL(KLON,KLEV), PCLFR(KLON,KLEV), PCLBX(KLON,100,KLEV) |
|---|
| 158 | REAL_B :: PAER (KLON,6,KLEV) |
|---|
| 159 | |
|---|
| 160 | ! #DB integer :: k2iii(KLON),k2jjj(KLON),kio,kjo |
|---|
| 161 | |
|---|
| 162 | ! ==== COMPUTED IN RADLSW === |
|---|
| 163 | REAL_B :: PFCS(KLON,KLEV+1), PFCT(KLON,KLEV+1) |
|---|
| 164 | REAL_B :: PFLS(KLON,KLEV+1), PFLT(KLON,KLEV+1) |
|---|
| 165 | REAL_B :: PFRSOD(KLON) , PEMIT(KLON) |
|---|
| 166 | REAL_B :: PSUDU(KLON) , PUVDF(KLON) , PPARF(KLON) |
|---|
| 167 | REAL_B :: PFDCT(KLON,KLEV+1), PFUCT(KLON,KLEV+1) |
|---|
| 168 | REAL_B :: PFDLT(KLON,KLEV+1), PFULT(KLON,KLEV+1) |
|---|
| 169 | REAL_B :: PFDCS(KLON,KLEV+1), PFUCS(KLON,KLEV+1) |
|---|
| 170 | REAL_B :: PFDLS(KLON,KLEV+1), PFULS(KLON,KLEV+1) |
|---|
| 171 | |
|---|
| 172 | REAL_B :: ASWBOX(KLON, 100), OLRBOX(KLON, 100) |
|---|
| 173 | REAL_B :: SLWBOX(KLON, 100), SSWBOX(KLON, 100), TAUBOX(KLON, 100) |
|---|
| 174 | |
|---|
| 175 | ! ----------------------------------------------------------------- |
|---|
| 176 | |
|---|
| 177 | !* 0.2 LOCAL ARRAYS. |
|---|
| 178 | ! ------------- |
|---|
| 179 | ! ----------------------------------------------------------------- |
|---|
| 180 | |
|---|
| 181 | !-- ARRAYS FOR LOCAL VARIABLES ----------------------------------------- |
|---|
| 182 | |
|---|
| 183 | INTEGER_M :: IBAS(KLON) , ITOP(KLON) |
|---|
| 184 | |
|---|
| 185 | ! #DB integer :: jkjllw, jkjlsw, JAERmin, JAERmax, jTAUCLDmin, jTAUCLDmax |
|---|
| 186 | ! #DB real :: PAERmin, PAERmax, TAUCLDmin, TAUCLDmax |
|---|
| 187 | |
|---|
| 188 | REAL_B ::& |
|---|
| 189 | &ZALBD(KLON,NSW) , ZALBP(KLON,NSW)& |
|---|
| 190 | &, ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)& |
|---|
| 191 | &, ZTAU (KLON,NSW,KLEV) & |
|---|
| 192 | &, ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON) |
|---|
| 193 | REAL_B ::& |
|---|
| 194 | &ZCLDLD(KLON,KLEV) , ZCLDLU(KLON,KLEV)& |
|---|
| 195 | &, ZCLDSW(KLON,KLEV) , ZCLD0(KLON,KLEV)& |
|---|
| 196 | &, ZDT0(KLON) & |
|---|
| 197 | &, ZEMIS(KLON) , ZEMIW(KLON)& |
|---|
| 198 | &, ZFLUX (KLON,2,KLEV+1) , ZFLUC(KLON,2,KLEV+1)& |
|---|
| 199 | &, ZFIWP(KLON) , ZFLWP(KLON) , ZFRWP(KLON)& |
|---|
| 200 | &, ZIWC(KLON) , ZLWC(KLON)& |
|---|
| 201 | &, ZBICFU(KLON) , ZKICFU1(KLON) , ZKICFU2(KLON)& |
|---|
| 202 | !cc , ZRWC(KLON) |
|---|
| 203 | &, ZMU0(KLON) , ZOZ(KLON,KLEV) , ZOZN(KLON,KLEV)& |
|---|
| 204 | &, ZOZON(KLON,KLEV) , ZPMB(KLON,KLEV+1), ZPSOL(KLON)& |
|---|
| 205 | &, ZTAVE (KLON,KLEV) , ZTL(KLON,KLEV+1)& |
|---|
| 206 | &, ZVIEW(KLON) |
|---|
| 207 | REAL_B ::& |
|---|
| 208 | &ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)& |
|---|
| 209 | &, ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)& |
|---|
| 210 | &, ZFSUPN(KLON) , ZFSUPV(KLON)& |
|---|
| 211 | &, ZFCUPN(KLON) , ZFCUPV(KLON)& |
|---|
| 212 | &, ZFSDNN(KLON) , ZFSDNV(KLON)& |
|---|
| 213 | &, ZFCDNN(KLON) , ZFCDNV(KLON)& |
|---|
| 214 | &, ZCOOLR(KLON,KLEV) , ZCOOLC(KLON,KLEV)& |
|---|
| 215 | &, ZHEATR(KLON,KLEV) , ZHEATC(KLON,KLEV) |
|---|
| 216 | REAL_B ::& |
|---|
| 217 | &ZALFICE(KLON) , ZGAMICE(KLON) , ZBICE(KLON), ZDESR(KLON) & |
|---|
| 218 | &, ZRADIP(KLON) , ZRADLP(KLON) , ZCFUDG(KLON)& |
|---|
| 219 | !cc , ZRADRD(KLON) |
|---|
| 220 | &, ZRAINT(KLON) , ZRES(KLON)& |
|---|
| 221 | &, ZTICE(KLON) , ZEMIT(KLON) , ZTAUINT(KLON) |
|---|
| 222 | REAL_B :: ZSUDU(KLON) , ZUVDF(KLON) , ZPARF(KLON), ZCOL(KLON) & |
|---|
| 223 | &, ZTCC(KLON) , ZTCA(KLON) |
|---|
| 224 | |
|---|
| 225 | !-- box-type arrays |
|---|
| 226 | |
|---|
| 227 | REAL_B :: CPFCS(KLON,KLEV+1) , CPFCT(KLON,KLEV+1) |
|---|
| 228 | REAL_B :: CPFLS(KLON,KLEV+1) , CPFLT(KLON,KLEV+1) |
|---|
| 229 | REAL_B :: CPFRSOD(KLON) , CPEMIT(KLON) |
|---|
| 230 | REAL_B :: CPSUDU(KLON) , CPUVDF(KLON) , CPPARF(KLON) |
|---|
| 231 | REAL_B :: CPFDCT(KLON,KLEV+1), CPFUCT(KLON,KLEV+1) |
|---|
| 232 | REAL_B :: CPFDLT(KLON,KLEV+1), CPFULT(KLON,KLEV+1) |
|---|
| 233 | REAL_B :: CPFDCS(KLON,KLEV+1), CPFUCS(KLON,KLEV+1) |
|---|
| 234 | REAL_B :: CPFDLS(KLON,KLEV+1), CPFULS(KLON,KLEV+1) |
|---|
| 235 | |
|---|
| 236 | ! LOCAL INTEGER SCALARS |
|---|
| 237 | INTEGER_M :: IKL, JAE, JK, JKL, JKLP1, JKP1, JL, JNU, JRTM, JSW & |
|---|
| 238 | &, NBOXL, ICBOX, IMOV, INDLAY |
|---|
| 239 | |
|---|
| 240 | ! LOCAL LOGICAL SCALARS |
|---|
| 241 | LOGICAL :: LLINTRP |
|---|
| 242 | |
|---|
| 243 | ! LOCAL REAL SCALARS |
|---|
| 244 | REAL_B :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR, ZIWGKG, ZLWGKG,& |
|---|
| 245 | &ZMSAID, ZMSAIU, ZMSALD, ZMSALU, ZMTCONV, & |
|---|
| 246 | &ZMTFUDG, ZLWFUDG, ZSWFUDG, ZMULTL, ZOI, ZOL, ZOMGMX, ZOR, & |
|---|
| 247 | &ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, & |
|---|
| 248 | &ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT |
|---|
| 249 | REAL_B :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, ZCOEFF, Z1RADI,& |
|---|
| 250 | &Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZWGHT, ZVI, ZVL, ZVR |
|---|
| 251 | REAL_B :: ZASW, ZOLR, ZSLW, ZSSW, ZMULTI, ZAIWC, ZBIWC,& |
|---|
| 252 | &ZDICE, ZFSR, ZLGIWC, ZTCELS, ZTBLAY, ZADDPLK, ZPLANCK |
|---|
| 253 | REAL_B :: ZTOL1, ZTOI1, ZTOR1 |
|---|
| 254 | |
|---|
| 255 | |
|---|
| 256 | ! ----------------------------------------------------------------- |
|---|
| 257 | |
|---|
| 258 | ! #DB kio = 66 |
|---|
| 259 | ! #DB kjo = 53 |
|---|
| 260 | |
|---|
| 261 | !if (NDUMP.LE.3) then |
|---|
| 262 | ! JL=KIDIA |
|---|
| 263 | ! DO jk=1,klev |
|---|
| 264 | ! print 9104,jk,PAPH(JL,JK),PTH(JL,JK),PAP(JL,JK),PT(JL,JK)& |
|---|
| 265 | ! & ,PDP(JL,JK)& |
|---|
| 266 | ! & ,PQ(JL,JK),PFRCL(JL,JK),PQIWP(JL,JK),PQLWP(JL,JK)& |
|---|
| 267 | ! & ,POZON(JL,JK),PQS(JL,JK) |
|---|
| 268 | 9104 format(1x,i3,f9.1,f8.2,f9.1,f8.2,f9.1,e10.3,f7.4,4e10.3) |
|---|
| 269 | ! ENDDO |
|---|
| 270 | ! jk=klev+1 |
|---|
| 271 | ! print 9104,jk,PAPH(JL,JK),PTH(JL,JK) |
|---|
| 272 | ! print 9105,PTS(JL),(PALBD(JL,JSW),PALBP(JL,JSW),JSW=1,NSW) |
|---|
| 273 | 9105 FORMAT(13X,f8.2,12f8.4) |
|---|
| 274 | !end if |
|---|
| 275 | |
|---|
| 276 | !print *,'NICEOPT, NLIQOPT, NRADIP, NRADLP',NICEOPT,NLIQOPT,NRADIP,NRADLP |
|---|
| 277 | |
|---|
| 278 | !-- compute total cloud cover |
|---|
| 279 | DO JL=KIDIA,KFDIA |
|---|
| 280 | ZTCC(JL)=1.-PFRCL(JL,1) |
|---|
| 281 | ZTCA(JL)=0. |
|---|
| 282 | END DO |
|---|
| 283 | DO JK=2,KLEV |
|---|
| 284 | DO JL=KIDIA,KFDIA |
|---|
| 285 | ZTCC(JL)=ZTCC(JL)*(1.-MAX(PFRCL(JL,JK),PFRCL(JL,JK-1))) & |
|---|
| 286 | & /(1.-MIN(PFRCL(JL,JK-1),1.-REPCLC)) |
|---|
| 287 | END DO |
|---|
| 288 | END DO |
|---|
| 289 | DO JL=KIDIA,KFDIA |
|---|
| 290 | ZTCC(JL)=1.-ZTCC(JL) |
|---|
| 291 | END DO |
|---|
| 292 | |
|---|
| 293 | !JL=KIDIA |
|---|
| 294 | !print 9106,ZTCC(JL) |
|---|
| 295 | 9106 format(1x,'TCC :',F7.4) |
|---|
| 296 | !print 9107,LINHOM,NHOWINH |
|---|
| 297 | 9107 format(1x,'LINHOM=',L8,' NHOWINH=',I2) |
|---|
| 298 | |
|---|
| 299 | |
|---|
| 300 | |
|---|
| 301 | |
|---|
| 302 | |
|---|
| 303 | |
|---|
| 304 | !* 1. SET-UP INPUT QUANTITIES FOR RADIATION |
|---|
| 305 | ! ------------------------------------- |
|---|
| 306 | |
|---|
| 307 | IF (.NOT.LINHOM) THEN |
|---|
| 308 | ZMTFUDG=1.0_JPRB |
|---|
| 309 | ZMTCONV=1.0_JPRB |
|---|
| 310 | ZSWFUDG=1.0_JPRB |
|---|
| 311 | ZLWFUDG=1.0_JPRB |
|---|
| 312 | ELSE IF (LINHOM) THEN |
|---|
| 313 | IF (NHOWINH.EQ.1) THEN |
|---|
| 314 | ZMTFUDG=0.7_JPRB |
|---|
| 315 | ZMTCONV=0.7_JPRB |
|---|
| 316 | ZSWFUDG=0.7_JPRB |
|---|
| 317 | ZLWFUDG=0.7_JPRB |
|---|
| 318 | ELSE |
|---|
| 319 | ZMTFUDG=1.0_JPRB |
|---|
| 320 | ZMTCONV=1.0_JPRB |
|---|
| 321 | ZSWFUDG=1.0_JPRB |
|---|
| 322 | ZLWFUDG=1.0_JPRB |
|---|
| 323 | ENDIF |
|---|
| 324 | ENDIF |
|---|
| 325 | !print 9108,LINHOM,NHOWINH,ZSWFUDG |
|---|
| 326 | 9108 format(1x,'LINHOM=',L8,' NHOWINH=',I2,' FUDG=',f4.2) |
|---|
| 327 | |
|---|
| 328 | DO JL = KIDIA,KFDIA |
|---|
| 329 | ZFCUP(JL,KLEV+1) = _ZERO_ |
|---|
| 330 | ZFCDWN(JL,KLEV+1) = REPLOG |
|---|
| 331 | ZFSUP(JL,KLEV+1) = _ZERO_ |
|---|
| 332 | ZFSDWN(JL,KLEV+1) = REPLOG |
|---|
| 333 | ZFLUX(JL,1,KLEV+1) = _ZERO_ |
|---|
| 334 | ZFLUX(JL,2,KLEV+1) = _ZERO_ |
|---|
| 335 | ZFLUC(JL,1,KLEV+1) = _ZERO_ |
|---|
| 336 | ZFLUC(JL,2,KLEV+1) = _ZERO_ |
|---|
| 337 | ZFSDNN(JL) = _ZERO_ |
|---|
| 338 | ZFSDNV(JL) = _ZERO_ |
|---|
| 339 | ZFCDNN(JL) = _ZERO_ |
|---|
| 340 | ZFCDNV(JL) = _ZERO_ |
|---|
| 341 | ZFSUPN(JL) = _ZERO_ |
|---|
| 342 | ZFSUPV(JL) = _ZERO_ |
|---|
| 343 | ZFCUPN(JL) = _ZERO_ |
|---|
| 344 | ZFCUPV(JL) = _ZERO_ |
|---|
| 345 | ZPSOL(JL) = PAPH(JL,KLEV+1) |
|---|
| 346 | ZPMB(JL,1) = ZPSOL(JL) / 100._JPRB |
|---|
| 347 | ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1) |
|---|
| 348 | PSUDU(JL) = _ZERO_ |
|---|
| 349 | PUVDF(JL) = _ZERO_ |
|---|
| 350 | PPARF(JL) = _ZERO_ |
|---|
| 351 | ZSUDU(JL) = _ZERO_ |
|---|
| 352 | IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) ) |
|---|
| 353 | ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) ) |
|---|
| 354 | ENDDO |
|---|
| 355 | |
|---|
| 356 | DO JK=1,KLEV+1 |
|---|
| 357 | DO JL=KIDIA,KFDIA |
|---|
| 358 | CPFLS(JL,JK) = _ZERO_ |
|---|
| 359 | CPFLT(JL,JK) = _ZERO_ |
|---|
| 360 | CPFCS(JL,JK) = _ZERO_ |
|---|
| 361 | CPFCT(JL,JK) = _ZERO_ |
|---|
| 362 | CPFDCT(JL,JK) = _ZERO_ |
|---|
| 363 | CPFUCT(JL,JK) = _ZERO_ |
|---|
| 364 | CPFDLT(JL,JK) = _ZERO_ |
|---|
| 365 | CPFULT(JL,JK) = _ZERO_ |
|---|
| 366 | CPFDCS(JL,JK) = _ZERO_ |
|---|
| 367 | CPFUCS(JL,JK) = _ZERO_ |
|---|
| 368 | CPFDLS(JL,JK) = _ZERO_ |
|---|
| 369 | CPFULS(JL,JK) = _ZERO_ |
|---|
| 370 | ENDDO |
|---|
| 371 | ENDDO |
|---|
| 372 | |
|---|
| 373 | DO JL = KIDIA,KFDIA |
|---|
| 374 | CPFRSOD(JL) = _ZERO_ |
|---|
| 375 | CPEMIT (JL) = _ZERO_ |
|---|
| 376 | CPSUDU (JL) = _ZERO_ |
|---|
| 377 | CPUVDF (JL) = _ZERO_ |
|---|
| 378 | CPPARF (JL) = _ZERO_ |
|---|
| 379 | END DO |
|---|
| 380 | |
|---|
| 381 | |
|---|
| 382 | !* 1.1 INITIALIZE VARIOUS FIELDS |
|---|
| 383 | ! ------------------------- |
|---|
| 384 | |
|---|
| 385 | |
|---|
| 386 | DO JSW=1,NSW |
|---|
| 387 | DO JL = KIDIA,KFDIA |
|---|
| 388 | ZALBD(JL,JSW)=PALBD(JL,JSW) |
|---|
| 389 | ZALBP(JL,JSW)=PALBP(JL,JSW) |
|---|
| 390 | ENDDO |
|---|
| 391 | ENDDO |
|---|
| 392 | DO JL = KIDIA,KFDIA |
|---|
| 393 | ZEMIS(JL) =PEMIS(JL) |
|---|
| 394 | ZEMIW(JL) =PEMIW(JL) |
|---|
| 395 | ZMU0(JL) =PMU0(JL) |
|---|
| 396 | ZUVDF(JL) = _ZERO_ |
|---|
| 397 | ZSUDU(JL) = _ZERO_ |
|---|
| 398 | ZPARF(JL) = _ZERO_ |
|---|
| 399 | ENDDO |
|---|
| 400 | |
|---|
| 401 | DO JK = 1 , KLEV |
|---|
| 402 | JKP1 = JK + 1 |
|---|
| 403 | JKL = KLEV+ 1 - JK |
|---|
| 404 | JKLP1 = JKL + 1 |
|---|
| 405 | DO JL = KIDIA,KFDIA |
|---|
| 406 | ZPMB(JL,JK+1)=PAPH(JL,JKL)/100._JPRB |
|---|
| 407 | ZOZ(JL,JK) = POZON(JL,JKL) * 46.6968_JPRB / RG |
|---|
| 408 | ZOZON(JL,JK) = POZON(JL,JKL) |
|---|
| 409 | ZCLD0(JL,JK) = _ZERO_ |
|---|
| 410 | ZFCUP(JL,JK) = _ZERO_ |
|---|
| 411 | ZFCDWN(JL,JK) = _ZERO_ |
|---|
| 412 | ZFSUP(JL,JK) = _ZERO_ |
|---|
| 413 | ZFSDWN(JL,JK) = _ZERO_ |
|---|
| 414 | ZFLUX(JL,1,JK) = _ZERO_ |
|---|
| 415 | ZFLUX(JL,2,JK) = _ZERO_ |
|---|
| 416 | ZFLUC(JL,1,JK) = _ZERO_ |
|---|
| 417 | ZFLUC(JL,2,JK) = _ZERO_ |
|---|
| 418 | ENDDO |
|---|
| 419 | ENDDO |
|---|
| 420 | |
|---|
| 421 | |
|---|
| 422 | !** INPUTS ARE FULL LEVEL TEMPERATURES + SURFACE TEMPERATURE |
|---|
| 423 | ! INTERPOLATION TO GET HALF-LEVEL TEMPERATURES FOLLOWS |
|---|
| 424 | ! WHAT IS DONE IN *RADINT* AND *RADHEAT* |
|---|
| 425 | |
|---|
| 426 | !* LLINTRP=.T. Half-level temperatures on the coarse grid are |
|---|
| 427 | ! vertically interpolated linearly with horizontal |
|---|
| 428 | ! sampled pressure from the full-level temperatures |
|---|
| 429 | ! of the sampled grid. |
|---|
| 430 | |
|---|
| 431 | !* LLINTRP=.F. Half-level temperatures are those horizontally |
|---|
| 432 | ! sampled on the coarse grid |
|---|
| 433 | |
|---|
| 434 | LLINTRP=.FALSE. |
|---|
| 435 | IF (LLINTRP) THEN |
|---|
| 436 | DO JK=2,KLEV |
|---|
| 437 | DO JL=KIDIA,KFDIA |
|---|
| 438 | PTH(JL,JK)=(PT (JL,JK-1)*PAP (JL,JK-1)& |
|---|
| 439 | &*(PAP (JL,JK)-PAPH (JL,JK))& |
|---|
| 440 | &+PT (JL,JK)*PAP (JL,JK)*(PAPH (JL,JK)-PAP (JL,JK-1)))& |
|---|
| 441 | &*(_ONE_/(PAPH (JL,JK)*(PAP (JL,JK)-PAP (JL,JK-1)))) |
|---|
| 442 | ENDDO |
|---|
| 443 | ENDDO |
|---|
| 444 | IF (LTEMPDS) THEN |
|---|
| 445 | DO JL=KIDIA,KFDIA |
|---|
| 446 | PTH(JL,1)= PT (JL,1)-PAP (JL,1)*(PT (JL,1)-PTH(JL,2))& |
|---|
| 447 | &/(PAP (JL,1)-PAPH (JL,2)) |
|---|
| 448 | PTH(JL,KLEV+1)=PT(JL,KLEV)& |
|---|
| 449 | & +(PAPH(JL,KLEV+1)-PAP(JL,KLEV))& |
|---|
| 450 | & *(PT(JL,KLEV)-PTH(JL,KLEV))& |
|---|
| 451 | & /(PAP(JL,KLEV)-PAPH(JL,KLEV)) |
|---|
| 452 | ENDDO |
|---|
| 453 | ELSE |
|---|
| 454 | DO JL=KIDIA,KFDIA |
|---|
| 455 | PTH(JL,1)= PT (JL,1)-PAP (JL,1)*(PT (JL,1)-PTH(JL,2))& |
|---|
| 456 | &/(PAP (JL,1)-PAPH (JL,2)) |
|---|
| 457 | PTH(JL,KLEV+1)= PTS(JL) |
|---|
| 458 | ENDDO |
|---|
| 459 | ENDIF |
|---|
| 460 | ENDIF |
|---|
| 461 | |
|---|
| 462 | DO JK=1,KLEV |
|---|
| 463 | JKL=KLEV+1-JK |
|---|
| 464 | JKLP1=JKL+1 |
|---|
| 465 | DO JL=KIDIA,KFDIA |
|---|
| 466 | ZTL(JL,JK)=PTH(JL,JKLP1) |
|---|
| 467 | ZTAVE(JL,JK)=PT(JL,JKL) |
|---|
| 468 | ENDDO |
|---|
| 469 | ENDDO |
|---|
| 470 | DO JL=KIDIA,KFDIA |
|---|
| 471 | ZTL(JL,KLEV+1)= PTH(JL,1) |
|---|
| 472 | ZPMB(JL,KLEV+1) = PAPH(JL,1)/100._JPRB |
|---|
| 473 | ENDDO |
|---|
| 474 | !*** |
|---|
| 475 | |
|---|
| 476 | ! ------------------------------------------------------------------ |
|---|
| 477 | |
|---|
| 478 | !* 2. CLOUD AND AEROSOL PARAMETERS |
|---|
| 479 | ! ---------------------------- |
|---|
| 480 | |
|---|
| 481 | NBOXL=1 |
|---|
| 482 | IF (KBOX.EQ.1) THEN |
|---|
| 483 | CALL COL2BOX & |
|---|
| 484 | & ( KIDIA, KFDIA, KLON, KLEV, NBOX, NOVLP & |
|---|
| 485 | & , PFRCL, PCLBX & |
|---|
| 486 | & ) |
|---|
| 487 | NBOXL=NBOX |
|---|
| 488 | END IF |
|---|
| 489 | ZWGHT=1./FLOAT(NBOXL) |
|---|
| 490 | |
|---|
| 491 | !-- initialise box-type outputs OLR, ASW, SDLW, SDSW, TAU |
|---|
| 492 | DO ICBOX=1,NBOXL |
|---|
| 493 | DO JL=KIDIA,KFDIA |
|---|
| 494 | OLRBOX(JL,ICBOX)=_ZERO_ |
|---|
| 495 | ASWBOX(JL,ICBOX)=_ZERO_ |
|---|
| 496 | SLWBOX(JL,ICBOX)=_ZERO_ |
|---|
| 497 | SSWBOX(JL,ICBOX)=_ZERO_ |
|---|
| 498 | TAUBOX(JL,ICBOX)=_ZERO_ |
|---|
| 499 | END DO |
|---|
| 500 | END DO |
|---|
| 501 | |
|---|
| 502 | DO ICBOX=1,NBOXL |
|---|
| 503 | IF (KBOX.EQ.1) THEN |
|---|
| 504 | DO JK=1,KLEV |
|---|
| 505 | DO JL=KIDIA,KFDIA |
|---|
| 506 | PCLFR(JL,JK)=PCLBX(JL,ICBOX,JK) |
|---|
| 507 | END DO |
|---|
| 508 | END DO |
|---|
| 509 | |
|---|
| 510 | ELSE |
|---|
| 511 | DO JK=1,KLEV |
|---|
| 512 | DO JL=KIDIA,KFDIA |
|---|
| 513 | PCLFR(JL,JK)=PFRCL(JL,JK) |
|---|
| 514 | END DO |
|---|
| 515 | END DO |
|---|
| 516 | END IF |
|---|
| 517 | DO JL=KIDIA,KFDIA |
|---|
| 518 | PSUDU(JL) = _ZERO_ |
|---|
| 519 | ZTAUINT(JL) = _ZERO_ |
|---|
| 520 | END DO |
|---|
| 521 | |
|---|
| 522 | !-- compute total cloud cover for that particular calculation |
|---|
| 523 | DO JL=KIDIA,KFDIA |
|---|
| 524 | ZCOL(JL)=1.-PCLFR(JL,1) |
|---|
| 525 | END DO |
|---|
| 526 | DO JK=2,KLEV |
|---|
| 527 | DO JL=KIDIA,KFDIA |
|---|
| 528 | ZCOL(JL)=ZCOL(JL)*(1.-MAX(PCLFR(JL,JK),PCLFR(JL,JK-1))) & |
|---|
| 529 | & /(1.-MIN(PCLFR(JL,JK-1),1.-REPCLC)) |
|---|
| 530 | END DO |
|---|
| 531 | END DO |
|---|
| 532 | DO JL=KIDIA,KFDIA |
|---|
| 533 | ZCOL(JL)=1.-ZCOL(JL) |
|---|
| 534 | END DO |
|---|
| 535 | |
|---|
| 536 | |
|---|
| 537 | |
|---|
| 538 | |
|---|
| 539 | |
|---|
| 540 | |
|---|
| 541 | DO JK = 1 , KLEV |
|---|
| 542 | IKL = KLEV + 1 - JK |
|---|
| 543 | |
|---|
| 544 | ! 2.1 INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES |
|---|
| 545 | ! ------------------------------------------------- |
|---|
| 546 | |
|---|
| 547 | DO JSW = 1,NSW |
|---|
| 548 | DO JL = KIDIA,KFDIA |
|---|
| 549 | ZTAU(JL,JSW,JK) = _ZERO_ |
|---|
| 550 | ZOMEGA(JL,JSW,JK)= _ONE_ |
|---|
| 551 | ZCG(JL,JSW,JK) = _ZERO_ |
|---|
| 552 | ENDDO |
|---|
| 553 | ENDDO |
|---|
| 554 | DO JL = KIDIA,KFDIA |
|---|
| 555 | ZCLDSW(JL,JK) = _ZERO_ |
|---|
| 556 | ZCLDLD(JL,JK) = _ZERO_ |
|---|
| 557 | ZCLDLU(JL,JK) = _ZERO_ |
|---|
| 558 | ENDDO |
|---|
| 559 | |
|---|
| 560 | |
|---|
| 561 | ! 2.2 CLOUD ICE AND LIQUID CONTENT AND PATH |
|---|
| 562 | ! ------------------------------------- |
|---|
| 563 | |
|---|
| 564 | DO JL = KIDIA,KFDIA |
|---|
| 565 | ! PCLFR(JL,IKL)=MAX(REPSC,MIN(PCLFR(JL,IKL),_ONE_-REPSC)) |
|---|
| 566 | PCLFR(JL,IKL)=MAX( _ZERO_ ,MIN( PCLFR(JL,IKL), _ONE_ )) |
|---|
| 567 | |
|---|
| 568 | ! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) |
|---|
| 569 | ZLWGKG=MAX(PQLWP(JL,IKL)*1000._JPRB,_ZERO_) |
|---|
| 570 | ZIWGKG=MAX(PQIWP(JL,IKL)*1000._JPRB,_ZERO_) |
|---|
| 571 | !! IF (PCLFR(JL,IKL) > (_TWO_*REPCLC)) THEN |
|---|
| 572 | !! ZLWGKG=ZLWGKG/PCLFR(JL,IKL) |
|---|
| 573 | !! ZIWGKG=ZIWGKG/PCLFR(JL,IKL) |
|---|
| 574 | !! IF (PCLFR(JL,IKL) > REPCLC) THEN |
|---|
| 575 | IF (PCLFR(JL,IKL) > 15.E-06_JPRB) THEN |
|---|
| 576 | ZLWGKG=ZLWGKG/PFRCL(JL,IKL) |
|---|
| 577 | ZIWGKG=ZIWGKG/PFRCL(JL,IKL) |
|---|
| 578 | ELSE |
|---|
| 579 | ZLWGKG=_ZERO_ |
|---|
| 580 | ZIWGKG=_ZERO_ |
|---|
| 581 | ENDIF |
|---|
| 582 | |
|---|
| 583 | ! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) |
|---|
| 584 | ! IF (PRAINT(JL,IKL).GT.(2.*REPCLC)) THEN |
|---|
| 585 | ! ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0) |
|---|
| 586 | ! ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000. |
|---|
| 587 | !- no radiative effect of rain (for the moment) |
|---|
| 588 | ! ZRWGKG=0. |
|---|
| 589 | ! ZRAINT(JL)=0. |
|---|
| 590 | ! =========================================================== |
|---|
| 591 | |
|---|
| 592 | ! Modifications Martin et al. |
|---|
| 593 | ! ELSE |
|---|
| 594 | ZRWGKG=_ZERO_ |
|---|
| 595 | ZRAINT(JL)=_ZERO_ |
|---|
| 596 | ! END IF |
|---|
| 597 | |
|---|
| 598 | IF (IBAS(JL) /= 1.AND. ITOP(JL) /= 1 ) THEN |
|---|
| 599 | ZCFUDG(JL)=ZMTCONV |
|---|
| 600 | ELSE |
|---|
| 601 | ZCFUDG(JL)=ZMTFUDG |
|---|
| 602 | ENDIF |
|---|
| 603 | |
|---|
| 604 | ZDPOG=PDP(JL,IKL)/RG |
|---|
| 605 | ZFLWP(JL)= ZLWGKG*ZDPOG |
|---|
| 606 | ZFIWP(JL)= ZIWGKG*ZDPOG |
|---|
| 607 | ZFRWP(JL)= ZRWGKG*ZDPOG |
|---|
| 608 | ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL)) |
|---|
| 609 | ZLWC(JL)=ZLWGKG*ZPODT |
|---|
| 610 | ZIWC(JL)=ZIWGKG*ZPODT |
|---|
| 611 | ! ZRWC(JL)=ZRWGKG*ZPODT |
|---|
| 612 | |
|---|
| 613 | ! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES |
|---|
| 614 | |
|---|
| 615 | IF (NRADLP.EQ.0) THEN |
|---|
| 616 | ! very old parametrization as f(pressure) |
|---|
| 617 | ZRADLP(JL)=10._JPRB + (100000._JPRB-PAP(JL,IKL))*3.5E-04_JPRB |
|---|
| 618 | |
|---|
| 619 | ELSE IF (NRADLP.EQ.1) THEN |
|---|
| 620 | ! old simple distinction between land (10) and ocean (13) |
|---|
| 621 | IF (PLSM(JL) < _HALF_) THEN |
|---|
| 622 | ZRADLP(JL)=13._JPRB |
|---|
| 623 | ELSE |
|---|
| 624 | ZRADLP(JL)=10._JPRB |
|---|
| 625 | ENDIF |
|---|
| 626 | |
|---|
| 627 | ELSE IF (NRADLP.EQ.2) THEN |
|---|
| 628 | !-- based on Martin et al., 1994, JAS |
|---|
| 629 | IF (PLSM(JL) < _HALF_) THEN |
|---|
| 630 | ZASEA=150._JPRB |
|---|
| 631 | ZD=0.33_JPRB |
|---|
| 632 | ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB |
|---|
| 633 | ELSE |
|---|
| 634 | ZALND=900._JPRB |
|---|
| 635 | ! ZALND=600._JPRB |
|---|
| 636 | ! ZALND=300._JPRB |
|---|
| 637 | ! ZALND=1200._JPRB |
|---|
| 638 | ZD=0.43_JPRB |
|---|
| 639 | ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB |
|---|
| 640 | ENDIF |
|---|
| 641 | |
|---|
| 642 | ZNUM=3._JPRB*ZLWC(JL)*(1._JPRB+3._JPRB*ZD*ZD)**2 |
|---|
| 643 | ZDEN=4._JPRB*RPI*ZNTOT*(1._JPRB+ZD*ZD)**3 |
|---|
| 644 | ZRADLP(JL)=100.*(ZNUM/ZDEN)**0.333_JPRB |
|---|
| 645 | |
|---|
| 646 | ! 9001 format(1x,I3,1E13.5,F5.0,F5.2,f8.2,3E13.5) |
|---|
| 647 | ZRADLP(JL)=MAX(ZRADLP(JL), 4._JPRB) |
|---|
| 648 | ZRADLP(JL)=MIN(ZRADLP(JL),16._JPRB) |
|---|
| 649 | END IF |
|---|
| 650 | ! print *,'ZRADLP(JL) for JK=',JK,ZRADLP(JL) |
|---|
| 651 | |
|---|
| 652 | ! =========================================================== |
|---|
| 653 | ! ___________________________________________________________ |
|---|
| 654 | |
|---|
| 655 | ! rain drop from : unused as ZRAINT is 0. |
|---|
| 656 | ! ZRADRD(JL)=500._JPRB*ZRAINT(JL)**0.22_JPRB |
|---|
| 657 | ! IF (ZFLWP(JL).GT.0.) THEN |
|---|
| 658 | ! ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL) |
|---|
| 659 | ! END IF |
|---|
| 660 | |
|---|
| 661 | !- ice particle effective radius =f(T) from Liou and Ou (1994) |
|---|
| 662 | |
|---|
| 663 | IF (PT(JL,IKL) < RTICE) THEN |
|---|
| 664 | ZTEMPC=PT(JL,IKL)-RTT |
|---|
| 665 | ELSE |
|---|
| 666 | ZTEMPC=RTICE-RTT |
|---|
| 667 | ENDIF |
|---|
| 668 | |
|---|
| 669 | ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*& |
|---|
| 670 | &0.0012_JPRB)) |
|---|
| 671 | ZDESR(JL)=2._JPRB*ZRADIP(JL) |
|---|
| 672 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 673 | |
|---|
| 674 | IF (NRADIP.EQ. 0) THEN |
|---|
| 675 | ZRADIP(JL)= 40._JPRB |
|---|
| 676 | ZDESR(JL)=2._JPRB*ZRADIP(JL) |
|---|
| 677 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 678 | |
|---|
| 679 | ELSE IF (NRADIP.EQ. 1) THEN |
|---|
| 680 | !-- old formulation based on temperature (40-130microns) |
|---|
| 681 | ZRADIP(JL)=MAX(ZRADIP(JL),40._JPRB) |
|---|
| 682 | ZDESR(JL)=2._JPRB*ZRADIP(JL) |
|---|
| 683 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 684 | |
|---|
| 685 | ELSE IF (NRADIP.EQ. 2) THEN |
|---|
| 686 | !-- formulation following Jakob, Klein modifications to ice content |
|---|
| 687 | ZRADIP(JL)=MAX(ZRADIP(JL),30._JPRB) |
|---|
| 688 | ZRADIP(JL)=MIN(ZRADIP(JL),60._JPRB) |
|---|
| 689 | ZDESR(JL)=2._JPRB*ZRADIP(JL) |
|---|
| 690 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 691 | |
|---|
| 692 | !-- new Sun and Rikus, 1999 D_ice = f(T, IWC) |
|---|
| 693 | ELSE IF (NRADIP.EQ. 3 .AND. ZIWC(JL).GT. _ZERO_ ) THEN |
|---|
| 694 | ZTEMPC=PT(JL,IKL)-83.15_JPRB |
|---|
| 695 | ZTCELS=PT(JL,IKL)-RTT |
|---|
| 696 | ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS |
|---|
| 697 | ! Sun & Rikus, 1999 |
|---|
| 698 | ! ZLGIWC=LOG10( REPCLC + ZIWC(JL)) |
|---|
| 699 | ! ZAIWC=26.1571_JPRB / ( ABS(ZLGIWC) **0.5995_JPRB ) |
|---|
| 700 | ! ZBIWC=0.6402_JPRB + 0.1810_JPRB * ZLGIWC |
|---|
| 701 | ! Sun, 2001 |
|---|
| 702 | ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB |
|---|
| 703 | ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB |
|---|
| 704 | ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC) |
|---|
| 705 | ZDESR(JL) = MIN ( MAX( ZDESR(JL), RMINICE ), 350._JPRB) |
|---|
| 706 | ZRADIP(JL)= 0.5 * ZDESR(JL) |
|---|
| 707 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 708 | END IF |
|---|
| 709 | |
|---|
| 710 | !-- ERA-15 definition of effective radii |
|---|
| 711 | IF (KLWRAD.EQ.2 .AND. NSW.EQ.2) THEN |
|---|
| 712 | ZRADIP(JL)=40._JPRB |
|---|
| 713 | ZRADLP(JL)=10._JPRB + (100000._JPRB-PAP(JL,IKL))*3.5_JPRB |
|---|
| 714 | ! ZSWFUDG=1._JPRB |
|---|
| 715 | ! ZLWFUDG=1._JPRB |
|---|
| 716 | LOWASYF=.FALSE. |
|---|
| 717 | LOIFUEC=.FALSE. |
|---|
| 718 | LRRTM=.FALSE. |
|---|
| 719 | ZDESR(JL)=2._JPRB*ZRADIP(JL) |
|---|
| 720 | ! print *,'ZRADIP(JL) for JK=',JK,ZRADIP(JL),ZDESR(JL) |
|---|
| 721 | END IF |
|---|
| 722 | |
|---|
| 723 | ENDDO |
|---|
| 724 | |
|---|
| 725 | |
|---|
| 726 | |
|---|
| 727 | ! 2.3 CLOUD SHORTWAVE OPTICAL PROPERTIES |
|---|
| 728 | ! ---------------------------------- |
|---|
| 729 | |
|---|
| 730 | ! ------------------------- |
|---|
| 731 | ! --+ SW OPTICAL PARAMETERS + Water clouds after Fouquart (1987) |
|---|
| 732 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 733 | |
|---|
| 734 | DO JSW=1,NSW |
|---|
| 735 | DO JL = KIDIA,KFDIA |
|---|
| 736 | ZTOL=_ZERO_ |
|---|
| 737 | ZGL =_ZERO_ |
|---|
| 738 | ZOL =_ZERO_ |
|---|
| 739 | ZTOI=_ZERO_ |
|---|
| 740 | ZGI =_ZERO_ |
|---|
| 741 | ZOI =_ZERO_ |
|---|
| 742 | ZTOR=_ZERO_ |
|---|
| 743 | ZGR =_ZERO_ |
|---|
| 744 | ZOR =_ZERO_ |
|---|
| 745 | IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) /= _ZERO_) THEN |
|---|
| 746 | IF (ZFLWP(JL) /= _ZERO_) THEN |
|---|
| 747 | IF (NLIQOPT.NE.0 ) THEN |
|---|
| 748 | !-- SW: Slingo, 1989 |
|---|
| 749 | ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL)) |
|---|
| 750 | ZGL = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL) |
|---|
| 751 | ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL) |
|---|
| 752 | ELSE |
|---|
| 753 | !-- SW: Fouquart, 1991 |
|---|
| 754 | ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL)) |
|---|
| 755 | ZGL = RYFWCF(JSW) |
|---|
| 756 | ZOL = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL) |
|---|
| 757 | ENDIF |
|---|
| 758 | ENDIF |
|---|
| 759 | |
|---|
| 760 | IF (ZFIWP(JL) /= _ZERO_) THEN |
|---|
| 761 | IF (NICEOPT.LE.1) THEN |
|---|
| 762 | !-- SW: Ebert-Curry |
|---|
| 763 | ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL)) |
|---|
| 764 | ZGI = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL) |
|---|
| 765 | ZOI = _ONE_ - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL) |
|---|
| 766 | |
|---|
| 767 | ELSE IF (NICEOPT.EQ.2) THEN |
|---|
| 768 | !-- SW: Fu-Liou, 1993 |
|---|
| 769 | Z1RADI = 0.5 / ZRADIP(JL) |
|---|
| 770 | ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW) |
|---|
| 771 | ZTOI = ZFIWP(JL) * ZBETAI |
|---|
| 772 | ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) & |
|---|
| 773 | & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) )) |
|---|
| 774 | ZOI = _ONE_ - ZOMGI |
|---|
| 775 | ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) & |
|---|
| 776 | & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) )) |
|---|
| 777 | ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) & |
|---|
| 778 | & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) )) |
|---|
| 779 | ZGI = ((1.-ZFDEL)*ZOMGP + ZFDEL*3.) / 3. |
|---|
| 780 | |
|---|
| 781 | ELSE IF (NICEOPT.EQ.3) THEN |
|---|
| 782 | !-- SW: Fu 1996 |
|---|
| 783 | Z1RADI = _ONE_ / ZDESR(JL) |
|---|
| 784 | ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW) |
|---|
| 785 | ZTOI = ZFIWP(JL) * ZBETAI |
|---|
| 786 | ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) & |
|---|
| 787 | & *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) )) |
|---|
| 788 | ZOI = _ONE_ - ZOMGI |
|---|
| 789 | ZGI = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) & |
|---|
| 790 | & *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) )) |
|---|
| 791 | |
|---|
| 792 | ENDIF |
|---|
| 793 | ENDIF |
|---|
| 794 | |
|---|
| 795 | ! IF (ZFRWP(JL) .NE. 0.) THEN |
|---|
| 796 | ! ZTOR= ZFRWP(JL)*0.003_JPRB*_JPRBZRAINT(JL)**(-0.22_JPRB) |
|---|
| 797 | ! ZOR = 1._JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW) |
|---|
| 798 | ! ZGR = RRASY(JSW) |
|---|
| 799 | ! END IF |
|---|
| 800 | |
|---|
| 801 | ! - MIX of WATER and ICE CLOUDS |
|---|
| 802 | ! ZTAUMX= ZTOL + ZTOI + ZTOR |
|---|
| 803 | ! ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR |
|---|
| 804 | ! ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR |
|---|
| 805 | ! |
|---|
| 806 | ! ZASYMX= ZASYMX/ZOMGMX |
|---|
| 807 | ! ZOMGMX= ZOMGMX/ZTAUMX |
|---|
| 808 | |
|---|
| 809 | IF (.NOT.LINHOM .OR. (LINHOM .AND. NHOWINH.EQ.1) ) THEN |
|---|
| 810 | ZVL=ZSWFUDG |
|---|
| 811 | ZVI=ZSWFUDG |
|---|
| 812 | ZVR=0. |
|---|
| 813 | ZTAUMX= ZTOL*ZVL + ZTOI*ZVI + ZTOR*ZVR |
|---|
| 814 | ZOMGMX= ZTOL*ZVL*ZOL + ZTOI*ZVI*ZOI + ZTOR*ZVR*ZOR |
|---|
| 815 | ZASYMX= ZTOL*ZVL*ZOL*ZGL + ZTOI*ZVI*ZOI*ZGI + ZTOR*ZVR*ZOR*ZGR |
|---|
| 816 | ZASYMX= ZASYMX/ZOMGMX |
|---|
| 817 | ZOMGMX= ZOMGMX/ZTAUMX |
|---|
| 818 | ELSE IF (LINHOM .AND. NHOWINH.EQ.2) THEN |
|---|
| 819 | ZVL=PSQLW(JL,IKL) |
|---|
| 820 | ZVI=PSQIW(JL,IKL) |
|---|
| 821 | ZVR=0. |
|---|
| 822 | ZTAUMX= ZTOL*ZVL + ZTOI*ZVI + ZTOR*ZVR |
|---|
| 823 | ZOMGMX= ZTOL*ZVL*ZOL + ZTOI*ZVI*ZOI + ZTOR*ZVR*ZOR |
|---|
| 824 | ZASYMX= ZTOL*ZVL*ZOL*ZGL + ZTOI*ZVI*ZOI*ZGI + ZTOR*ZVR*ZOR*ZGR |
|---|
| 825 | ZASYMX= ZASYMX/ZOMGMX |
|---|
| 826 | ZOMGMX= ZOMGMX/ZTAUMX |
|---|
| 827 | ELSE IF (LINHOM .AND. NHOWINH.EQ.3) THEN |
|---|
| 828 | ZVL=PRLVRL(JL,IKL) |
|---|
| 829 | ZVI=PRLVRI(JL,IKL) |
|---|
| 830 | ZVR=0. |
|---|
| 831 | ZTOL1 = ZTOL/(1.+ZVL) |
|---|
| 832 | ZTOI1 = ZTOI/(1.+ZVI) |
|---|
| 833 | ZTOR1 = ZTOR/(1.+ZVR) |
|---|
| 834 | ZTAUMX= ZTOL1 + ZTOI1 + ZTOR1 |
|---|
| 835 | ZOI=ZOI/(1.+ZVI*(1.-ZOI)) |
|---|
| 836 | ZGI=ZGI*(1.+ZVI*(1.-ZOI))/(1.+ZVI*(1.-ZOI*ZGI)) |
|---|
| 837 | ZOL=ZOL/(1.+ZVL*(1.-ZOL)) |
|---|
| 838 | ZGL=ZGL*(1.+ZVL*(1.-ZOL))/(1.+ZVL*(1.-ZOL*ZGL)) |
|---|
| 839 | |
|---|
| 840 | ZOMGMX= ZTOL1*ZOL + ZTOI1*ZOI + ZTOR1*ZOR |
|---|
| 841 | ZASYMX= ZTOL1*ZOL*ZGL + ZTOI1*ZOI*ZGI + ZTOR1*ZOR*ZGR |
|---|
| 842 | ZASYMX= ZASYMX/ZOMGMX |
|---|
| 843 | ZOMGMX= ZOMGMX/ZTAUMX |
|---|
| 844 | END IF |
|---|
| 845 | ! print 9009,JK,JL,JSW,ZSWFUDG,PSQLW(JL,IKL),PSQIW(JL,IKL) & |
|---|
| 846 | ! & , PRLVRL(JL,IKL),PRLVRI(JL,IKL),ZTOL,ZOL,ZGL,ZTOI,ZOI,ZGI & |
|---|
| 847 | ! & , ZTAUMX,ZOMGMX,ZASYMX |
|---|
| 848 | 9009 format(1x,3I3,14E13.6) |
|---|
| 849 | |
|---|
| 850 | ! --- SW FINAL CLOUD OPTICAL PARAMETERS |
|---|
| 851 | |
|---|
| 852 | ZCLDSW(JL,JK) = PCLFR(JL,IKL) |
|---|
| 853 | ZTAU(JL,JSW,JK) = ZTAUMX |
|---|
| 854 | ZOMEGA(JL,JSW,JK)= ZOMGMX |
|---|
| 855 | ZCG(JL,JSW,JK) = ZASYMX |
|---|
| 856 | ENDIF |
|---|
| 857 | |
|---|
| 858 | ! #DB jkjlsw = 0 |
|---|
| 859 | ! #DB IF (ZTAU(JL,JSW,JK) .LT.00..OR.ZTAU(JL,JSW,JK) .GT.75. .OR. & |
|---|
| 860 | ! #DB & (k2iii(JL) .EQ.kio.AND.k2jjj(JL) .EQ.kjo) ) THEN |
|---|
| 861 | ! #DB IF (mod(jkjlsw,20).EQ.0) & |
|---|
| 862 | ! #DB & write(6,575) NLIQOPT,NICEOPT |
|---|
| 863 | ! #DB 575 format('IN RADLSW: CLOUD SHrtWAVE OPTICAL PROPERTIES ' & |
|---|
| 864 | ! #DB & ,3x,' NLIQOPT =',I3,' NICEOPT =',I3,/ & |
|---|
| 865 | ! #DB & ,' i j JL JK',7x,'ZTAU',5x,'ZCLDSW',6x,'ZDESR' & |
|---|
| 866 | ! #DB & ,5x,'PRLVRL',5x,'PRLVRI',6x,'PQIWP',6x,'PQLWP',3x,'JSW') |
|---|
| 867 | ! #DB jkjlsw=jkjlsw+1 |
|---|
| 868 | ! #DB write(6,603) k2iii(JL),k2jjj(JL),JL,IKL,ZTAU(JL,JSW,JK) ,ZCLDSW(JL,JK) , ZDESR(JL) & |
|---|
| 869 | ! #DB & ,PRLVRL(JL,IKL),PRLVRI(JL,IKL) & |
|---|
| 870 | ! #DB & ,PQIWP(JL,IKL), PQLWP(JL,IKL),JSW |
|---|
| 871 | ! #DB 603 format(4i5,7e11.3,I6) |
|---|
| 872 | ! #DB ENDIF |
|---|
| 873 | |
|---|
| 874 | ENDDO |
|---|
| 875 | ENDDO |
|---|
| 876 | |
|---|
| 877 | DO JL=KIDIA,KFDIA |
|---|
| 878 | ZTAUINT(JL)=ZTAUINT(JL)+ZTAU(JL,1,JK) |
|---|
| 879 | END DO |
|---|
| 880 | |
|---|
| 881 | |
|---|
| 882 | !JL=KIDIA |
|---|
| 883 | !print 9109,JK,ZCLDSW(JL,JK),ZRADLP(JL),ZRADIP(JL) & |
|---|
| 884 | ! & , (ZTAU(JL,JSW,JK),ZOMEGA(JL,JSW,JK),ZCG(JL,JSW,JK),JSW=1,NSW) |
|---|
| 885 | 9109 format(1x,'ClOptProp: ',I2,f7.4,2f6.1,6(1x,F7.2,1x,F7.4,1x,f6.3)) |
|---|
| 886 | !print *,'Radlsw after SW cloud optical properties for level JK=',JK |
|---|
| 887 | |
|---|
| 888 | |
|---|
| 889 | |
|---|
| 890 | ! 2.4 CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE |
|---|
| 891 | ! -------------------------------------------- |
|---|
| 892 | |
|---|
| 893 | ! ------------------------- |
|---|
| 894 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Smith and Shi (1992) |
|---|
| 895 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 896 | |
|---|
| 897 | IF (.NOT.LRRTM) THEN |
|---|
| 898 | |
|---|
| 899 | DO JL = KIDIA,KFDIA |
|---|
| 900 | ZALFICE(JL)=_ZERO_ |
|---|
| 901 | ZGAMICE(JL)=_ZERO_ |
|---|
| 902 | ZBICE(JL)=_ZERO_ |
|---|
| 903 | ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND |
|---|
| 904 | ZBICFU(JL)=_ZERO_ |
|---|
| 905 | ZKICFU1(JL)=_ZERO_ |
|---|
| 906 | ZKICFU2(JL)=_ZERO_ |
|---|
| 907 | ENDDO |
|---|
| 908 | |
|---|
| 909 | DO JNU= 1,NSIL |
|---|
| 910 | DO JL = KIDIA,KFDIA |
|---|
| 911 | ZRES(JL) = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,& |
|---|
| 912 | &JNU)& |
|---|
| 913 | &+ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,& |
|---|
| 914 | &JNU)& |
|---|
| 915 | &))))) |
|---|
| 916 | ZBICE(JL) = ZBICE(JL) + ZRES(JL) |
|---|
| 917 | ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL) |
|---|
| 918 | ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL) |
|---|
| 919 | ENDDO |
|---|
| 920 | ENDDO |
|---|
| 921 | |
|---|
| 922 | !-- Fu et al. (1998) with M'91 LW scheme |
|---|
| 923 | DO JRTM=1,16 |
|---|
| 924 | DO JL=KIDIA,KFDIA |
|---|
| 925 | IF (PT(JL,IKL) < 339._JPRB .AND. PT(JL,IKL) >= 160._JPRB) THEN |
|---|
| 926 | INDLAY=PT(JL,IKL)-159._JPRB |
|---|
| 927 | ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL)) |
|---|
| 928 | ELSE IF (PT(JL,IKL) >= 339._JPRB ) THEN |
|---|
| 929 | INDLAY=180 |
|---|
| 930 | ZTBLAY =PT(JL,IKL)-339._JPRB |
|---|
| 931 | ELSE IF (PT(JL,IKL) < 160._JPRB) THEN |
|---|
| 932 | INDLAY=1 |
|---|
| 933 | ZTBLAY =PT(JL,IKL)-160._JPRB |
|---|
| 934 | END IF |
|---|
| 935 | ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM) |
|---|
| 936 | ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK) |
|---|
| 937 | ZBICFU(JL) = ZBICFU(JL) + ZPLANCK |
|---|
| 938 | |
|---|
| 939 | IF (ZIWC(JL) > _ZERO_ ) THEN |
|---|
| 940 | ! ice cloud spectral emissivity a la Fu & Liou (1993) |
|---|
| 941 | ZRATIO= 0.5 / ZRADIP(JL) |
|---|
| 942 | ZMSAID = RFULIO(JRTM,1) + ZRATIO& |
|---|
| 943 | &*(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) |
|---|
| 944 | ZKICFU1(JL) = ZKICFU1(JL)+ ZMSAID*ZPLANCK |
|---|
| 945 | |
|---|
| 946 | ! ice cloud spectral emissivity a la Fu et al (1998) |
|---|
| 947 | Z1RADI = _ONE_ / ZDESR(JL) |
|---|
| 948 | ZMSAID = RFUETA(JRTM,1) + Z1RADI& |
|---|
| 949 | &*(RFUETA(JRTM,2) + Z1RADI*RFUETA(JRTM,3)) |
|---|
| 950 | ZKICFU2(JL) = ZKICFU2(JL)+ ZMSAID*ZPLANCK |
|---|
| 951 | END IF |
|---|
| 952 | END DO |
|---|
| 953 | END DO |
|---|
| 954 | |
|---|
| 955 | DO JL = KIDIA,KFDIA |
|---|
| 956 | ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL) |
|---|
| 957 | ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL) |
|---|
| 958 | ZKICFU1(JL) = ZKICFU1(JL) / ZBICFU(JL) |
|---|
| 959 | ZKICFU2(JL) = ZKICFU2(JL) / ZBICFU(JL) |
|---|
| 960 | |
|---|
| 961 | IF (ZFLWP(JL)+ZFIWP(JL) /= _ZERO_) THEN |
|---|
| 962 | |
|---|
| 963 | IF (KLWRAD.EQ.2) THEN |
|---|
| 964 | ! ice cloud emissivity a la Smith-Shi |
|---|
| 965 | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) |
|---|
| 966 | ZMSAID= 0.113_JPRB*ZMULTI |
|---|
| 967 | ZMSAIU= 0.093_JPRB*ZMULTI |
|---|
| 968 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) |
|---|
| 969 | ZMSALD= 0.158_JPRB*ZMULTL |
|---|
| 970 | ZMSALU= 0.130_JPRB*ZMULTL |
|---|
| 971 | ZZFLWP= ZFLWP(JL) |
|---|
| 972 | ZZFIWP= ZFIWP(JL) |
|---|
| 973 | |
|---|
| 974 | ELSE IF (KLWRAD.EQ.0) THEN |
|---|
| 975 | |
|---|
| 976 | IF (NLIQOPT.EQ.0) THEN |
|---|
| 977 | ! water cloud emissivity a la Smith & Shi (1992) |
|---|
| 978 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) |
|---|
| 979 | ZMSALD= 0.158_JPRB*ZMULTL |
|---|
| 980 | ZMSALU= 0.130_JPRB*ZMULTL |
|---|
| 981 | |
|---|
| 982 | ELSE |
|---|
| 983 | ! water cloud emissivity a la Savijarvi (1997) |
|---|
| 984 | ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL) |
|---|
| 985 | ZMSALD= 1.2154_JPRB*ZMSALU |
|---|
| 986 | |
|---|
| 987 | END IF |
|---|
| 988 | |
|---|
| 989 | IF (NICEOPT.EQ.0) THEN |
|---|
| 990 | ! ice cloud emissivity a la Smith & Shi (1992) |
|---|
| 991 | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) |
|---|
| 992 | ZMSAID= 0.113_JPRB*ZMULTI |
|---|
| 993 | ZMSAIU= 0.093_JPRB*ZMULTI |
|---|
| 994 | |
|---|
| 995 | ELSE IF (NICEOPT.EQ.1) THEN |
|---|
| 996 | ! ice cloud emissivity a la Ebert & Curry (1992) |
|---|
| 997 | ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL)) |
|---|
| 998 | ZMSAIU= ZMSAID |
|---|
| 999 | |
|---|
| 1000 | ELSE IF (NICEOPT.EQ.2) THEN |
|---|
| 1001 | ! ice cloud emissivity a la Fu & Liou (1993) |
|---|
| 1002 | ZMSAID= 1.66_JPRB*ZKICFU1(JL) |
|---|
| 1003 | ZMSAIU= ZMSAID |
|---|
| 1004 | |
|---|
| 1005 | ELSE IF (NICEOPT.EQ.3) THEN |
|---|
| 1006 | ! ice cloud emissivity a la Fu et al. (1998) |
|---|
| 1007 | ZMSAID= 1.66_JPRB*ZKICFU2(JL) |
|---|
| 1008 | ZMSAIU= ZMSAID |
|---|
| 1009 | END IF |
|---|
| 1010 | |
|---|
| 1011 | ! introduce inhomogeneity factor also in LW |
|---|
| 1012 | ZZFLWP= ZFLWP(JL) * ZLWFUDG |
|---|
| 1013 | ZZFIWP= ZFIWP(JL) * ZLWFUDG |
|---|
| 1014 | END IF |
|---|
| 1015 | |
|---|
| 1016 | ! effective cloudiness accounting for condensed water |
|---|
| 1017 | ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(_ONE_-EXP(-ZMSALD*ZZFLWP-ZMSAID* & |
|---|
| 1018 | &ZZFIWP)) |
|---|
| 1019 | ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(_ONE_-EXP(-ZMSALU*ZZFLWP-ZMSAIU* & |
|---|
| 1020 | &ZZFIWP)) |
|---|
| 1021 | |
|---|
| 1022 | END IF |
|---|
| 1023 | ENDDO |
|---|
| 1024 | |
|---|
| 1025 | ! print *,'Radlsw after LW0 cloud optical properties for level JK=',JK |
|---|
| 1026 | |
|---|
| 1027 | ELSE |
|---|
| 1028 | |
|---|
| 1029 | ! 2.5 CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM |
|---|
| 1030 | ! ------------------------------------------ |
|---|
| 1031 | |
|---|
| 1032 | ! ------------------------- |
|---|
| 1033 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Savijarvi (1998) |
|---|
| 1034 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 1035 | |
|---|
| 1036 | ! No need for a fixed diffusivity factor, accounted for spectrally below |
|---|
| 1037 | ! The detailed spectral structure does not require defining upward and |
|---|
| 1038 | ! downward effective optical properties |
|---|
| 1039 | |
|---|
| 1040 | ! #DB jkjllw=0 |
|---|
| 1041 | |
|---|
| 1042 | DO JRTM=1,16 |
|---|
| 1043 | DO JL = KIDIA,KFDIA |
|---|
| 1044 | ZTAUCLD(JL,JK,JRTM) = _ZERO_ |
|---|
| 1045 | ZMSALD = _ZERO_ |
|---|
| 1046 | ZMSAID = _ZERO_ |
|---|
| 1047 | |
|---|
| 1048 | IF (ZFLWP(JL)+ZFIWP(JL) /= _ZERO_) THEN |
|---|
| 1049 | |
|---|
| 1050 | IF (NLIQOPT.EQ.0) THEN |
|---|
| 1051 | ! water cloud total emissivity a la Smith and Shi (1992) |
|---|
| 1052 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) |
|---|
| 1053 | ZMSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB |
|---|
| 1054 | |
|---|
| 1055 | ELSE IF (NLIQOPT.EQ.1) THEN |
|---|
| 1056 | ! water cloud spectral emissivity a la Savijarvi (1997) |
|---|
| 1057 | ZMSALD= RHSAVI(JRTM,1) + ZRADLP(JL)& |
|---|
| 1058 | &*(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) |
|---|
| 1059 | |
|---|
| 1060 | ELSE IF (NLIQOPT.EQ.2) THEN |
|---|
| 1061 | ! water cloud spectral emissivity a la Lindner and Li (2000) |
|---|
| 1062 | Z1RADL = _ONE_ / ZRADLP(JL) |
|---|
| 1063 | ! ZMSALD = RLINLI(JRTM,1) + Z1RADL*(RLINLI(JRTM,2) + Z1RADL*& |
|---|
| 1064 | ! & (RLINLI(JRTM,3) + Z1RADL*(RLINLI(JRTM,4) + Z1RADL*& |
|---|
| 1065 | ! & RLINLI(JRTM,5) ))) |
|---|
| 1066 | |
|---|
| 1067 | ZMSALD = RLINLI(JRTM,1)+ZRADLP(JL)*RLINLI(JRTM,2)+ Z1RADL*& |
|---|
| 1068 | & (RLINLI(JRTM,3) + Z1RADL*(RLINLI(JRTM,4) + Z1RADL*& |
|---|
| 1069 | & RLINLI(JRTM,5) )) |
|---|
| 1070 | |
|---|
| 1071 | END IF |
|---|
| 1072 | |
|---|
| 1073 | IF (NICEOPT.EQ.0) THEN |
|---|
| 1074 | ! ice cloud emissivity a la Smith & Shi (1992) |
|---|
| 1075 | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) |
|---|
| 1076 | ZMSAID= 0.108_JPRB*ZMULTI / 1.66_JPRB |
|---|
| 1077 | |
|---|
| 1078 | ELSE IF (NICEOPT.EQ.1) THEN |
|---|
| 1079 | ! ice cloud spectral emissivity a la Ebert-Curry (1992) |
|---|
| 1080 | ZMSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL) |
|---|
| 1081 | |
|---|
| 1082 | ELSE IF (NICEOPT.EQ.2) THEN |
|---|
| 1083 | ! ice cloud spectral emissivity a la Fu & Liou (1993) |
|---|
| 1084 | ZRATIO= 0.5 / ZRADIP(JL) |
|---|
| 1085 | ZMSAID = RFULIO(JRTM,1) + ZRATIO& |
|---|
| 1086 | &*(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) |
|---|
| 1087 | |
|---|
| 1088 | ELSE IF (NICEOPT.EQ.3) THEN |
|---|
| 1089 | ! ice cloud spectral emissivity a la Fu et al (1998) |
|---|
| 1090 | Z1RADI = _ONE_ / ZDESR(JL) |
|---|
| 1091 | ZMSAID = RFUETA(JRTM,1) + Z1RADI& |
|---|
| 1092 | &*(RFUETA(JRTM,2) + Z1RADI*RFUETA(JRTM,3)) |
|---|
| 1093 | |
|---|
| 1094 | END IF |
|---|
| 1095 | |
|---|
| 1096 | IF (.NOT.LINHOM .OR. (LINHOM .AND. NHOWINH.EQ.1) ) THEN |
|---|
| 1097 | ZVL=ZLWFUDG |
|---|
| 1098 | ZVI=ZLWFUDG |
|---|
| 1099 | ELSE IF (LINHOM .AND. NHOWINH.EQ.2) THEN |
|---|
| 1100 | ZVL=PSQLW(JL,IKL) |
|---|
| 1101 | ZVI=PSQIW(JL,IKL) |
|---|
| 1102 | ELSE IF (LINHOM .AND. NHOWINH.EQ.3) THEN |
|---|
| 1103 | ZVL=_ONE_/(_ONE_+PRLVRL(JL,IKL)) |
|---|
| 1104 | ZVI=_ONE_/(_ONE_+PRLVRI(JL,IKL)) |
|---|
| 1105 | END IF |
|---|
| 1106 | |
|---|
| 1107 | ZTAUD = ZVL*ZMSALD*ZFLWP(JL)+ZVI*ZMSAID*ZFIWP(JL) |
|---|
| 1108 | |
|---|
| 1109 | ! #DB write(30,333) ZTAUD,ZVL,ZMSALD,ZFLWP(JL),ZVI,ZMSAID,ZFIWP(JL),PQIWP(JL,IKL),PQLWP(JL,IKL) |
|---|
| 1110 | ! #DB 333 format(9e14.6) |
|---|
| 1111 | |
|---|
| 1112 | ! Diffusivity correction within clouds a la Savijarvi |
|---|
| 1113 | ! ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , _ONE_) , _TWO_) |
|---|
| 1114 | |
|---|
| 1115 | ZDIFFD=1.66_JPRB |
|---|
| 1116 | ZTAUCLD(JL,JK,JRTM) = max(_ZERO_,ZTAUD*ZDIFFD) |
|---|
| 1117 | ENDIF |
|---|
| 1118 | |
|---|
| 1119 | ! #DB IF (ZTAUCLD(JL,JK,JRTM).LT.00..OR.ZTAUCLD(JL,JK,JRTM).GT.75. .OR. & |
|---|
| 1120 | ! #DB & (k2iii(JL) .EQ.kio.AND.k2jjj(JL) .EQ.kjo) ) THEN |
|---|
| 1121 | ! #DB IF (mod(jkjllw,20).EQ.0) & |
|---|
| 1122 | ! #DB & write(6,600) JRTM,NLIQOPT,NICEOPT |
|---|
| 1123 | ! #DB 600 format('IN RADLSW: CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM, JRTM =',I3 & |
|---|
| 1124 | ! #DB & ,' NLIQOPT =',I3,' NICEOPT =',I3,/ & |
|---|
| 1125 | ! #DB & ,' i j JL JK',7x,'ZTAU' ,6x,'ZFLWP' ,6x,'ZFIWP' & |
|---|
| 1126 | ! #DB & , 5x,'ZRADLP',5x,'ZRADIP',6x,'PQIWP',6x,'PQLWP') |
|---|
| 1127 | ! #DB jkjllw=jkjllw+1 |
|---|
| 1128 | ! #DB write(6,601) k2iii(JL),k2jjj(JL),JL,IKL,ZTAUCLD(JL,JK,JRTM), ZFLWP(JL) , ZFIWP(JL) & |
|---|
| 1129 | ! #DB & ,ZRADLP(JL) ,ZRADIP(JL) & |
|---|
| 1130 | ! #DB & ,PQIWP(JL,IKL), PQLWP(JL,IKL) |
|---|
| 1131 | ! #DB 601 format(4i5,10e11.3) |
|---|
| 1132 | ! #DB ENDIF |
|---|
| 1133 | |
|---|
| 1134 | ENDDO |
|---|
| 1135 | ENDDO |
|---|
| 1136 | ! print *,'Radlsw after LW1 cloud optical properties for level JK=',JK |
|---|
| 1137 | |
|---|
| 1138 | ENDIF |
|---|
| 1139 | |
|---|
| 1140 | ENDDO |
|---|
| 1141 | |
|---|
| 1142 | NUAER = NUA |
|---|
| 1143 | NTRAER = NTRA |
|---|
| 1144 | |
|---|
| 1145 | ! ------------------------------------------------------------------ |
|---|
| 1146 | |
|---|
| 1147 | !* 2.6 DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE |
|---|
| 1148 | ! --------------------------------------------- |
|---|
| 1149 | |
|---|
| 1150 | |
|---|
| 1151 | DO JL = KIDIA,KFDIA |
|---|
| 1152 | ZVIEW(JL) = DIFF |
|---|
| 1153 | ZEMIT(JL) = _ZERO_ |
|---|
| 1154 | ENDDO |
|---|
| 1155 | |
|---|
| 1156 | ! ------------------------------------------------------------------ |
|---|
| 1157 | |
|---|
| 1158 | !* 3. CALL LONGWAVE RADIATION CODE |
|---|
| 1159 | ! ---------------------------- |
|---|
| 1160 | |
|---|
| 1161 | |
|---|
| 1162 | !* 3.1 FULL LONGWAVE RADIATION COMPUTATIONS |
|---|
| 1163 | ! ------------------------------------ |
|---|
| 1164 | |
|---|
| 1165 | !print *,'Just before calling the radiation schemes' |
|---|
| 1166 | !JL=KIDIA |
|---|
| 1167 | !DO JK=1,KLEV |
|---|
| 1168 | ! IKL=KLEV+1-JK |
|---|
| 1169 | ! PRINT 9311,JK,PCLFR(JL,IKL),ZCLDLD(JL,JK),ZTAUCLD(JL,JK,1) & |
|---|
| 1170 | ! & ,(ZTAU(JL,JSW,JK),ZOMEGA(JL,JSW,JK),ZCG(JL,JSW,JK),JSW=1,NSW) & |
|---|
| 1171 | ! & ,(PAER(JL,JAE,JK),JAE=1,6) |
|---|
| 1172 | 9311 format(1x,I2,2F8.5,26E12.5) |
|---|
| 1173 | !END DO |
|---|
| 1174 | !print *,'KLWRAD=',KLWRAD,' LPHYLIN: ',LPHYLIN,' LRRTM: ',LRRTM |
|---|
| 1175 | |
|---|
| 1176 | IF (.NOT.LPHYLIN) THEN |
|---|
| 1177 | IF ( .NOT. LRRTM) THEN |
|---|
| 1178 | |
|---|
| 1179 | |
|---|
| 1180 | IF (KLWRAD .EQ. 2) THEN |
|---|
| 1181 | CALL OLW & |
|---|
| 1182 | & ( KIDIA, KFDIA , KLON , KLEV & |
|---|
| 1183 | & , PCCO2, ZCLDLD, ZCLDLU & |
|---|
| 1184 | & , PDP , ZDT0 , ZEMIS & |
|---|
| 1185 | & , PAPH , POZON , PTH & |
|---|
| 1186 | & , PAER , PT , ZVIEW , PQ & |
|---|
| 1187 | & , ZCOOLR,ZCOOLC, ZFLUX, ZFLUC & |
|---|
| 1188 | & ) |
|---|
| 1189 | |
|---|
| 1190 | ELSE IF (KLWRAD .EQ. 0) THEN |
|---|
| 1191 | |
|---|
| 1192 | CALL LW & |
|---|
| 1193 | &( KIDIA , KFDIA , KLON , KLEV , KMODE & |
|---|
| 1194 | &, PCCO2 , ZCLDLD, ZCLDLU & |
|---|
| 1195 | &, PDP , ZDT0 , ZEMIS , ZEMIW & |
|---|
| 1196 | &, ZPMB , POZON , ZTL & |
|---|
| 1197 | &, PAER , ZTAVE , ZVIEW , PQ & |
|---|
| 1198 | &, ZCOOLR, ZCOOLC, ZEMIT , ZFLUX, ZFLUC & |
|---|
| 1199 | &) |
|---|
| 1200 | |
|---|
| 1201 | END IF |
|---|
| 1202 | |
|---|
| 1203 | ELSE |
|---|
| 1204 | |
|---|
| 1205 | |
|---|
| 1206 | !* 3.2 FULL LONGWAVE RADIATION COMPUTATIONS - RRTM |
|---|
| 1207 | ! ------------------------------------ ---- |
|---|
| 1208 | |
|---|
| 1209 | ! i) pass POZN (ozone mmr concentration) to RRTM; remove pressure |
|---|
| 1210 | ! weighting applied to POZON in driverMC (below) |
|---|
| 1211 | ! ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM |
|---|
| 1212 | ! iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM, |
|---|
| 1213 | ! computed from equations above |
|---|
| 1214 | ! iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM |
|---|
| 1215 | ! in module rrtm_ecrt.f |
|---|
| 1216 | |
|---|
| 1217 | DO JL = KIDIA,KFDIA |
|---|
| 1218 | DO JK = 1, KLEV |
|---|
| 1219 | ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK) |
|---|
| 1220 | ENDDO |
|---|
| 1221 | ENDDO |
|---|
| 1222 | |
|---|
| 1223 | ! #DB jkjllw = 0 |
|---|
| 1224 | ! #DB DO JL = KIDIA,KFDIA |
|---|
| 1225 | ! #DB DO JK = 1, KLEV |
|---|
| 1226 | ! #DB IKL = KLEV + 1 - JK |
|---|
| 1227 | ! #DB JAERmin=1 |
|---|
| 1228 | ! #DB JAERmax=6 |
|---|
| 1229 | ! #DB PAERmin=1000. |
|---|
| 1230 | ! #DB PAERmax=0. |
|---|
| 1231 | ! #DB jTAUCLDmin=1 |
|---|
| 1232 | ! #DB jTAUCLDmax=16 |
|---|
| 1233 | ! #DB TAUCLDmin=1000. |
|---|
| 1234 | ! #DB TAUCLDmax=0. |
|---|
| 1235 | ! #DB DO JRTM=1,16 |
|---|
| 1236 | ! #DB IF (ZTAUCLD(JL,JK,JRTM).LT.TAUCLDmin) THEN |
|---|
| 1237 | ! #DB jTAUCLDmin=JRTM |
|---|
| 1238 | ! #DB TAUCLDmin=ZTAUCLD(JL,JK,JRTM) |
|---|
| 1239 | ! #DB END IF |
|---|
| 1240 | ! #DB IF (ZTAUCLD(JL,JK,JRTM).GT.TAUCLDmax) THEN |
|---|
| 1241 | ! #DB jTAUCLDmax=JRTM |
|---|
| 1242 | ! #DB TAUCLDmax=ZTAUCLD(JL,JK,JRTM) |
|---|
| 1243 | ! #DB END IF |
|---|
| 1244 | ! #DB ENDDO |
|---|
| 1245 | ! #DB DO JAE =1,6 |
|---|
| 1246 | ! #DB IF (PAER(JL,JAE,JK).LT.PAERmin) THEN |
|---|
| 1247 | ! #DB JAERmin=JAE |
|---|
| 1248 | ! #DB PAERmin=PAER(JL,JAE,JK) |
|---|
| 1249 | ! #DB END IF |
|---|
| 1250 | ! #DB IF (PAER(JL,JAE,JK).GT.PAERmax) THEN |
|---|
| 1251 | ! #DB JAERmax=JAE |
|---|
| 1252 | ! #DB PAERmax=PAER(JL,JAE,JK) |
|---|
| 1253 | ! #DB END IF |
|---|
| 1254 | ! #DB ENDDO |
|---|
| 1255 | ! #DB IF (TAUCLDmin.LT.0..OR.TAUCLDmax.GT.75.) THEN |
|---|
| 1256 | ! #DB IF (mod(jkjllw,20).EQ.0) & |
|---|
| 1257 | ! #DB & write(6,515) |
|---|
| 1258 | ! #DB 515 format('IN RADLSW: BEFORE RRTM_RRTM_140GP CALL',/ & |
|---|
| 1259 | ! #DB & ,' i j JL JK',7x,'ZOZN',5x,'ZCLDSW' & |
|---|
| 1260 | ! #DB & ,4x,'ZTAUCLDmin',4x,'ZTAUCLDmax' & |
|---|
| 1261 | ! #DB & ,4x,'PAERmin',4x,'PAERmax',6x,'PQIWP',6x,'PQLWP',9x,'PQ') |
|---|
| 1262 | ! #DB jkjllw = jkjllw + 1 |
|---|
| 1263 | ! #DB write(6,602) k2iii(JL),k2jjj(JL),JL,JK,ZOZN(JL,JK),ZCLDSW(JL,JK) & |
|---|
| 1264 | ! #DB & ,jTAUCLDmin,ZTAUCLD(JL,JK,jTAUCLDmin) & |
|---|
| 1265 | ! #DB & ,jTAUCLDmax,ZTAUCLD(JL,JK,jTAUCLDmax) & |
|---|
| 1266 | ! #DB & ,PAER(JL,JAERmin,JK),PAER(JL,JAERmax,JK) & |
|---|
| 1267 | ! #DB & ,PQIWP(JL,IKL),PQLWP(JL,IKL),PQ(JL,IKL) |
|---|
| 1268 | ! #DB 602 format(4i5,2e11.3,2(i3,e11.3),8e11.3) |
|---|
| 1269 | ! #DB ENDIF |
|---|
| 1270 | ! #DB ENDDO |
|---|
| 1271 | ! #DB ENDDO |
|---|
| 1272 | |
|---|
| 1273 | ! print *,'Just before calling RRTM' |
|---|
| 1274 | |
|---|
| 1275 | CALL RRTM_RRTM_140GP & |
|---|
| 1276 | &( KIDIA , KFDIA , KLON , KLEV & |
|---|
| 1277 | &, PAER , PAPH , PAP & |
|---|
| 1278 | &, PTS , PTH , PT & |
|---|
| 1279 | &, ZEMIS , ZEMIW & |
|---|
| 1280 | &, PQ , PCCO2 , ZOZN , ZCLDSW , ZTAUCLD & |
|---|
| 1281 | &, ZEMIT , ZFLUX , ZFLUC , ZTCLEAR & |
|---|
| 1282 | &) |
|---|
| 1283 | |
|---|
| 1284 | ! print *,'just after RRTM' |
|---|
| 1285 | |
|---|
| 1286 | ENDIF |
|---|
| 1287 | ELSE |
|---|
| 1288 | ZCOOLR(:,:) = _ZERO_ |
|---|
| 1289 | ZCOOLC(:,:) = _ZERO_ |
|---|
| 1290 | ZEMIT (:) = _ZERO_ |
|---|
| 1291 | ZFLUX(:,:,:)= _ZERO_ |
|---|
| 1292 | ZFLUC(:,:,:)= _ZERO_ |
|---|
| 1293 | ENDIF |
|---|
| 1294 | |
|---|
| 1295 | ! ------------------------------------------------------------------ |
|---|
| 1296 | |
|---|
| 1297 | !* 4. CALL SHORTWAVE RADIATION CODE |
|---|
| 1298 | ! ----------------------------- |
|---|
| 1299 | |
|---|
| 1300 | |
|---|
| 1301 | ZRMUZ=_ZERO_ |
|---|
| 1302 | DO JL = KIDIA,KFDIA |
|---|
| 1303 | ZRMUZ = MAX (ZRMUZ, ZMU0(JL)) |
|---|
| 1304 | ENDDO |
|---|
| 1305 | |
|---|
| 1306 | IF (ZRMUZ > _ZERO_) THEN |
|---|
| 1307 | !print *,'CALL SW' |
|---|
| 1308 | |
|---|
| 1309 | CALL SW & |
|---|
| 1310 | &( KIDIA , KFDIA , KLON , KLEV , KAER & |
|---|
| 1311 | &, PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ , PQS & |
|---|
| 1312 | &, ZMU0 , ZCG , ZCLDSW, PDP , ZOMEGA, ZOZ , ZPMB & |
|---|
| 1313 | &, ZTAU , ZTAVE , PAER & |
|---|
| 1314 | &, ZHEATR, ZFSDWN, ZFSUP , ZHEATC, ZFCDWN, ZFCUP & |
|---|
| 1315 | &, ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV & |
|---|
| 1316 | &, ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV & |
|---|
| 1317 | &, ZSUDU , ZUVDF , ZPARF & |
|---|
| 1318 | &) |
|---|
| 1319 | |
|---|
| 1320 | ! print *,'just after SW' |
|---|
| 1321 | ! JL=KIDIA |
|---|
| 1322 | ! print *,'just after SW UV & PAR ',ZUVDF(JL),ZPARF(JL) |
|---|
| 1323 | |
|---|
| 1324 | ENDIF |
|---|
| 1325 | |
|---|
| 1326 | ! #DB jkjlsw = 0 |
|---|
| 1327 | ! #DB DO JL = KIDIA,KFDIA |
|---|
| 1328 | ! #DB DO JK = 1,KLEV |
|---|
| 1329 | ! #DB IF (k2iii(JL).EQ.kio.AND.k2jjj(JL).EQ.kjo) THEN |
|---|
| 1330 | ! #DB IF (mod(jkjlsw,20).EQ.0) & |
|---|
| 1331 | ! #DB write(6,525) |
|---|
| 1332 | ! #DB 525 format('IN RADLSW: AFTER SW CALL',/ & |
|---|
| 1333 | ! #DB & ,' i j JL JK' & |
|---|
| 1334 | ! #DB & ,4x,'ZFCDWN',5x,'ZFCUP' ,4x,'ZFSDNN',4x,'ZFCDNN' & |
|---|
| 1335 | ! #DB & ,4x,'ZFSDNV',4x,'ZFSUPN',4x,'ZFSUPV',4x,'ZFCDNN' & |
|---|
| 1336 | ! #DB & ,4x,'ZFCDNV',4x,'ZFCUPN',4x,'ZFCUPV') |
|---|
| 1337 | ! #DB jkjlsw = jkjlsw + 1 |
|---|
| 1338 | ! #DB write(6,605) k2iii(JL),k2jjj(JL),JL,JK,ZFCDWN(JL,JK),ZFCUP(JL,JK) & |
|---|
| 1339 | ! #DB & ,ZFSDNN(JL),ZFCDNN(JL),ZFSDNV(JL),ZFSUPN(JL),ZFSUPV(JL) & |
|---|
| 1340 | ! #DB & ,ZFCDNN(JL),ZFCDNV(JL),ZFCUPN(JL),ZFCUPV(JL) |
|---|
| 1341 | ! #DB 605 format(4i5,11e10.3) |
|---|
| 1342 | ! #DB ENDIF |
|---|
| 1343 | ! #DB ENDDO |
|---|
| 1344 | ! #DB ENDDO |
|---|
| 1345 | |
|---|
| 1346 | ! ------------------------------------------------------------------ |
|---|
| 1347 | |
|---|
| 1348 | !* 5. FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES |
|---|
| 1349 | ! ------------------------------------------------ |
|---|
| 1350 | |
|---|
| 1351 | |
|---|
| 1352 | DO JKL = 1 , KLEV+1 |
|---|
| 1353 | JK = KLEV+1 + 1 - JKL |
|---|
| 1354 | DO JL = KIDIA,KFDIA |
|---|
| 1355 | ! print 9506,JK,ZFSDWN(JL,JK),ZFSUP(JL,JK),ZFLUX(JL,1,JK),ZFLUX(JL,2,JK) & |
|---|
| 1356 | ! & , ZFCDWN(JL,JK),ZFCUP(JL,JK),ZFLUC(JL,1,JK),ZFLUC(JL,2,JK) |
|---|
| 1357 | 9506 format(1x,I3,8f10.3) |
|---|
| 1358 | |
|---|
| 1359 | CPFLS(JL,JKL) =CPFLS(JL,JKL) +ZWGHT*(ZFSDWN(JL,JK) - ZFSUP(JL,JK)) |
|---|
| 1360 | CPFLT(JL,JKL) =CPFLT(JL,JKL) +ZWGHT*(- ZFLUX(JL,1,JK) - ZFLUX(JL,2,JK)) |
|---|
| 1361 | CPFCS(JL,JKL) =CPFCS(JL,JKL) +ZWGHT*(ZFCDWN(JL,JK) - ZFCUP(JL,JK)) |
|---|
| 1362 | CPFCT(JL,JKL) =CPFCT(JL,JKL) +ZWGHT*(- ZFLUC(JL,1,JK) - ZFLUC(JL,2,JK)) |
|---|
| 1363 | CPFDCT(JL,JKL)=CPFDCT(JL,JKL)+ZWGHT*ZFLUC(JL,2,JK) |
|---|
| 1364 | CPFUCT(JL,JKL)=CPFUCT(JL,JKL)+ZWGHT*ZFLUC(JL,1,JK) |
|---|
| 1365 | CPFDLT(JL,JKL)=CPFDLT(JL,JKL)+ZWGHT*ZFLUX(JL,2,JK) |
|---|
| 1366 | CPFULT(JL,JKL)=CPFULT(JL,JKL)+ZWGHT*ZFLUX(JL,1,JK) |
|---|
| 1367 | CPFDCS(JL,JKL)=CPFDCS(JL,JKL)+ZWGHT*ZFCDWN(JL,JK) |
|---|
| 1368 | CPFUCS(JL,JKL)=CPFUCS(JL,JKL)+ZWGHT*ZFCUP(JL,JK) |
|---|
| 1369 | CPFDLS(JL,JKL)=CPFDLS(JL,JKL)+ZWGHT*ZFSDWN(JL,JK) |
|---|
| 1370 | CPFULS(JL,JKL)=CPFULS(JL,JKL)+ZWGHT*ZFSUP(JL,JK) |
|---|
| 1371 | ENDDO |
|---|
| 1372 | ENDDO |
|---|
| 1373 | |
|---|
| 1374 | DO JL = KIDIA,KFDIA |
|---|
| 1375 | ! print 9507,ZFSDWN(JL,1),ZSUDU(JL),ZUVDF(JL),ZPARF(JL) |
|---|
| 1376 | 9507 format(1x,'SW Global Normal UV & PAR:',5f10.3) |
|---|
| 1377 | |
|---|
| 1378 | CPFRSOD(JL) = CPFRSOD(JL) + ZWGHT*ZFSDWN(JL,1) |
|---|
| 1379 | CPEMIT (JL) = CPEMIT (JL) + ZWGHT*ZEMIT (JL) |
|---|
| 1380 | CPSUDU (JL) = CPSUDU (JL) + ZWGHT*ZSUDU (JL) |
|---|
| 1381 | CPUVDF (JL) = CPUVDF (JL) + ZWGHT*ZUVDF (JL) |
|---|
| 1382 | CPPARF (JL) = CPPARF (JL) + ZWGHT*ZPARF (JL) |
|---|
| 1383 | |
|---|
| 1384 | ASWBOX(JL,ICBOX) = -ZFSDWN(JL,KLEV+1) + ZFSUP(JL,KLEV+1) |
|---|
| 1385 | OLRBOX(JL,ICBOX) = -ZFLUX(JL,1,KLEV+1) |
|---|
| 1386 | SLWBOX(JL,ICBOX) = -ZFLUX(JL,2,1) |
|---|
| 1387 | SSWBOX(JL,ICBOX) = -ZFSDWN(JL,1) |
|---|
| 1388 | TAUBOX(JL,ICBOX) = ZTAUINT(JL) |
|---|
| 1389 | ZTCA(JL) = ZTCA(JL) + ZWGHT*ZCOL(JL) |
|---|
| 1390 | ! print 9508,ICBOX,ASWBOX(JL,ICBOX),OLRBOX(JL,ICBOX),SLWBOX(JL,ICBOX) & |
|---|
| 1391 | ! & ,SSWBOX(JL,ICBOX),TAUBOX(JL,ICBOX),ZCOL(JL),ZTCA(JL),ZTCC(JL) |
|---|
| 1392 | 9508 format(1x,'radlsw',I3,5F10.3,1x,3F7.4) |
|---|
| 1393 | ENDDO |
|---|
| 1394 | |
|---|
| 1395 | |
|---|
| 1396 | ENDDO |
|---|
| 1397 | ! |
|---|
| 1398 | !-- end of box-type calculations |
|---|
| 1399 | ! |
|---|
| 1400 | |
|---|
| 1401 | DO JK = 1 , KLEV+1 |
|---|
| 1402 | DO JL = KIDIA,KFDIA |
|---|
| 1403 | PFLS(JL,JK) = CPFLS(JL,JK) |
|---|
| 1404 | PFLT(JL,JK) = CPFLT(JL,JK) |
|---|
| 1405 | PFCS(JL,JK) = CPFCS(JL,JK) |
|---|
| 1406 | PFCT(JL,JK) = CPFCT(JL,JK) |
|---|
| 1407 | PFDCT(JL,JK) = CPFDCT(JL,JK) |
|---|
| 1408 | PFUCT(JL,JK) = CPFUCT(JL,JK) |
|---|
| 1409 | PFDLT(JL,JK) = CPFDLT(JL,JK) |
|---|
| 1410 | PFULT(JL,JK) = CPFULT(JL,JK) |
|---|
| 1411 | PFDCS(JL,JK) = CPFDCS(JL,JK) |
|---|
| 1412 | PFUCS(JL,JK) = CPFUCS(JL,JK) |
|---|
| 1413 | PFDLS(JL,JK) = CPFDLS(JL,JK) |
|---|
| 1414 | PFULS(JL,JK) = CPFULS(JL,JK) |
|---|
| 1415 | ENDDO |
|---|
| 1416 | ENDDO |
|---|
| 1417 | |
|---|
| 1418 | DO JL = KIDIA,KFDIA |
|---|
| 1419 | PFRSOD(JL) = CPFRSOD(JL) |
|---|
| 1420 | PEMIT (JL) = CPEMIT (JL) |
|---|
| 1421 | PSUDU (JL) = CPSUDU (JL) |
|---|
| 1422 | PUVDF (JL) = CPUVDF (JL) |
|---|
| 1423 | PPARF (JL) = CPPARF (JL) |
|---|
| 1424 | ENDDO |
|---|
| 1425 | |
|---|
| 1426 | !-- re-organize the box-tyoe output arrays in decreasing order of TAU |
|---|
| 1427 | DO JL=KIDIA,KFDIA |
|---|
| 1428 | DO ICBOX=2,NBOX |
|---|
| 1429 | ZTOI=TAUBOX(JL,ICBOX) |
|---|
| 1430 | DO IMOV=ICBOX-1,1,-1 |
|---|
| 1431 | IF(TAUBOX(JL,IMOV).LE.ZTOI) GO TO 8001 |
|---|
| 1432 | TAUBOX(JL,IMOV+1)=TAUBOX(JL,IMOV) |
|---|
| 1433 | END DO |
|---|
| 1434 | IMOV=0 |
|---|
| 1435 | 8001 CONTINUE |
|---|
| 1436 | TAUBOX(JL,IMOV+1)=ZTOI |
|---|
| 1437 | END DO |
|---|
| 1438 | END DO |
|---|
| 1439 | |
|---|
| 1440 | !-- re-organize the box-type output arrays in decreasing order of ASW |
|---|
| 1441 | DO JL=KIDIA,KFDIA |
|---|
| 1442 | DO ICBOX=2,NBOX |
|---|
| 1443 | ZASW=ASWBOX(JL,ICBOX) |
|---|
| 1444 | DO IMOV=ICBOX-1,1,-1 |
|---|
| 1445 | IF(ASWBOX(JL,IMOV).LE.ZASW) GO TO 8002 |
|---|
| 1446 | ASWBOX(JL,IMOV+1)=ASWBOX(JL,IMOV) |
|---|
| 1447 | END DO |
|---|
| 1448 | IMOV=0 |
|---|
| 1449 | 8002 CONTINUE |
|---|
| 1450 | ASWBOX(JL,IMOV+1)=ZASW |
|---|
| 1451 | END DO |
|---|
| 1452 | END DO |
|---|
| 1453 | |
|---|
| 1454 | !-- re-organize the box-tyoe output arrays in decreasing order of -OLR |
|---|
| 1455 | DO JL=KIDIA,KFDIA |
|---|
| 1456 | DO ICBOX=2,NBOX |
|---|
| 1457 | ZOLR=OLRBOX(JL,ICBOX) |
|---|
| 1458 | DO IMOV=ICBOX-1,1,-1 |
|---|
| 1459 | IF(OLRBOX(JL,IMOV).LE.ZOLR) GO TO 8003 |
|---|
| 1460 | OLRBOX(JL,IMOV+1)=OLRBOX(JL,IMOV) |
|---|
| 1461 | END DO |
|---|
| 1462 | IMOV=0 |
|---|
| 1463 | 8003 CONTINUE |
|---|
| 1464 | OLRBOX(JL,IMOV+1)=ZOLR |
|---|
| 1465 | END DO |
|---|
| 1466 | END DO |
|---|
| 1467 | |
|---|
| 1468 | !-- re-organize the box-tyoe output arrays in decreasing order of SLW |
|---|
| 1469 | DO JL=KIDIA,KFDIA |
|---|
| 1470 | DO ICBOX=2,NBOX |
|---|
| 1471 | ZSLW=SLWBOX(JL,ICBOX) |
|---|
| 1472 | DO IMOV=ICBOX-1,1,-1 |
|---|
| 1473 | IF(SLWBOX(JL,IMOV).LE.ZSLW) GO TO 8004 |
|---|
| 1474 | SLWBOX(JL,IMOV+1)=SLWBOX(JL,IMOV) |
|---|
| 1475 | END DO |
|---|
| 1476 | IMOV=0 |
|---|
| 1477 | 8004 CONTINUE |
|---|
| 1478 | SLWBOX(JL,IMOV+1)=ZSLW |
|---|
| 1479 | END DO |
|---|
| 1480 | END DO |
|---|
| 1481 | |
|---|
| 1482 | !-- re-organize the box-type output arrays in decreasing order of -SSW |
|---|
| 1483 | DO JL=KIDIA,KFDIA |
|---|
| 1484 | DO ICBOX=2,NBOX |
|---|
| 1485 | ZSSW=SSWBOX(JL,ICBOX) |
|---|
| 1486 | DO IMOV=ICBOX-1,1,-1 |
|---|
| 1487 | IF(SSWBOX(JL,IMOV).LE.ZSSW) GO TO 8005 |
|---|
| 1488 | SSWBOX(JL,IMOV+1)=SSWBOX(JL,IMOV) |
|---|
| 1489 | END DO |
|---|
| 1490 | IMOV=0 |
|---|
| 1491 | 8005 CONTINUE |
|---|
| 1492 | SSWBOX(JL,IMOV+1)=ZSSW |
|---|
| 1493 | END DO |
|---|
| 1494 | END DO |
|---|
| 1495 | |
|---|
| 1496 | !-- put all arrays as positive numbers for plotting |
|---|
| 1497 | DO JL=KIDIA,KFDIA |
|---|
| 1498 | DO ICBOX=1,NBOX |
|---|
| 1499 | ASWBOX(JL,ICBOX)=-ASWBOX(JL,ICBOX) |
|---|
| 1500 | OLRBOX(JL,ICBOX)=-OLRBOX(JL,ICBOX) |
|---|
| 1501 | SSWBOX(JL,ICBOX)=-SSWBOX(JL,ICBOX) |
|---|
| 1502 | END DO |
|---|
| 1503 | END DO |
|---|
| 1504 | |
|---|
| 1505 | ! -------------------------------------------------------------- |
|---|
| 1506 | |
|---|
| 1507 | RETURN |
|---|
| 1508 | END SUBROUTINE RADLSW |
|---|
