| Directory: | ./ |
|---|---|
| File: | rad/radlsw.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 226 | 467 | 48.4% |
| Branches: | 122 | 330 | 37.0% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | 4652040 | SUBROUTINE RADLSW & | |
| 2 | & ( KIDIA, KFDIA , KLON , KLEV , KMODE, KAER,& | ||
| 3 | & PRII0,& | ||
| 4 | 120 | & PAER , PALBD , PALBP, PAPH , PAP,& | |
| 5 | & PCCNL, PCCNO,& | ||
| 6 | 120 | & PCCO2, PCLFR , PDP , PEMIS, PEMIW , PLSM , PMU0, POZON,& | |
| 7 | & PQ , PQIWP , PQLWP, PQS , PQRAIN, PRAINT,& | ||
| 8 | 120 | & PTH , PT , PTS , PNBAS, PNTOP,& | |
| 9 | & PREF_LIQ, PREF_ICE,& | ||
| 10 | & PEMIT, PFCT , PFLT , PFCS , PFLS,& | ||
| 11 | & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,& | ||
| 12 | 120 | & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,& | |
| 13 | & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,& | ||
| 14 | 120 | & PTAU_LW,& | |
| 15 | 120 | & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP) | |
| 16 | |||
| 17 | use write_field_phy | ||
| 18 | |||
| 19 | !**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES | ||
| 20 | |||
| 21 | ! PURPOSE. | ||
| 22 | ! -------- | ||
| 23 | ! CONTROLS RADIATION COMPUTATIONS | ||
| 24 | |||
| 25 | !** INTERFACE. | ||
| 26 | ! ---------- | ||
| 27 | |||
| 28 | ! EXPLICIT ARGUMENTS : | ||
| 29 | ! -------------------- | ||
| 30 | ! PAER : (KLON,6,KLEV) ; OPTICAL THICKNESS OF THE AEROSOLS | ||
| 31 | ! PALBD : (KLON,NSW) ; SURF. SW ALBEDO FOR DIFFUSE RADIATION | ||
| 32 | ! PALBP : (KLON,NSW) ; SURF. SW ALBEDO FOR PARALLEL RADIATION | ||
| 33 | ! PAPH : (KLON,KLEV+1) ; HALF LEVEL PRESSURE | ||
| 34 | ! PAP : (KLON,KLEV) ; FULL LEVEL PRESSURE | ||
| 35 | ! PCCNL : (KLON) ; CCN CONCENTRATION OVER LAND | ||
| 36 | ! PCCNO : (KLON) ; CCN CONCENTRATION OVER OCEAN | ||
| 37 | ! PCCO2 : ; CONCENTRATION IN CO2 (KG/KG) | ||
| 38 | ! PCLFR : (KLON,KLEV) ; CLOUD FRACTIONAL COVER | ||
| 39 | ! PDP : (KLON,KLEV) ; LAYER PRESSURE THICKNESS | ||
| 40 | ! PEMIS : (KLON) ; SURFACE LW EMISSIVITY | ||
| 41 | ! PEMIW : (KLON) ; SURFACE LW WINDOW EMISSIVITY | ||
| 42 | ! PLSM : (KLON) ; LAND-SEA MASK | ||
| 43 | ! PMU0 : (KLON) ; SOLAR ANGLE | ||
| 44 | ! PNBAS : (KLON) ; INDEX OF BASE OF CONVECTIVE LAYER | ||
| 45 | ! PNTOP : (KLON) ; INDEX OF TOP OF CONVECTIVE LAYER | ||
| 46 | ! POZON : (KLON,KLEV) ; OZONE AMOUNT in LAYER (KG/KG*PA) | ||
| 47 | ! PQ : (KLON,KLEV) ; SPECIFIC HUMIDITY KG/KG | ||
| 48 | ! PQIWP : (KLON,KLEV) ; SOLID WATER KG/KG | ||
| 49 | ! PQLWP : (KLON,KLEV) ; LIQUID WATER KG/KG | ||
| 50 | ! PQS : (KLON,KLEV) ; SATURATION WATER VAPOR KG/KG | ||
| 51 | ! PQRAIN : (KLON,KLEV) ; RAIN WATER KG/KG | ||
| 52 | ! PRAINT : (KLON,KLEV) ; RAIN RATE (m/s) | ||
| 53 | ! PTH : (KLON,KLEV+1) ; HALF LEVEL TEMPERATURE | ||
| 54 | ! PT : (KLON,KLEV) ; FULL LEVEL TEMPERATURE | ||
| 55 | ! PTS : (KLON) ; SURFACE TEMPERATURE | ||
| 56 | ! LDDUST ; Dust properties switch | ||
| 57 | ! PPIZA_DST : (KPROMA,KLEV,NSW); Single scattering albedo of dust | ||
| 58 | ! PCGA_DST : (KPROMA,KLEV,NSW); Assymetry factor for dust | ||
| 59 | ! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm | ||
| 60 | ! PTAU_LW (KPROMA,KLEV,NLW); LW Optical depth of aerosols | ||
| 61 | ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) | ||
| 62 | ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) | ||
| 63 | ! ==== OUTPUTS === | ||
| 64 | ! PFCT : (KLON,KLEV+1) ; CLEAR-SKY LW NET FLUXES | ||
| 65 | ! PFLT : (KLON,KLEV+1) ; TOTAL LW NET FLUXES | ||
| 66 | ! PFCS : (KLON,KLEV+1) ; CLEAR-SKY SW NET FLUXES | ||
| 67 | ! PFLS : (KLON,KLEV+1) ; TOTAL SW NET FLUXES | ||
| 68 | ! PFRSOD : (KLON) ; TOTAL-SKY SURFACE SW DOWNWARD FLUX | ||
| 69 | ! PEMIT : (KLON) ; SURFACE TOTAL LONGWAVE EMISSIVITY | ||
| 70 | ! PSUDU : (KLON) ; SOLAR RADIANCE IN SUN'S DIRECTION | ||
| 71 | ! PPARF : (KLON) ; PHOTOSYNTHETICALLY ACTIVE RADIATION | ||
| 72 | ! PUVDF : (KLON) ; UV(-B) RADIATION | ||
| 73 | ! PPARCF : (KLON) ; CLEAR-SKY PHOTOSYNTHETICALLY ACTIVE RADIATION | ||
| 74 | ! PTINCF : (KLON) ; TOA INCIDENT SOLAR RADIATION | ||
| 75 | ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08) | ||
| 76 | ! PFLUX : (KLON,2,KLEV+1) ; LW total sky flux (1=up, 2=down) | ||
| 77 | ! PFLUC : (KLON,2,KLEV+1) ; LW clear sky flux (1=up, 2=down) | ||
| 78 | ! PFSDN(KLON,KLEV+1) ; SW total sky flux down | ||
| 79 | ! PFSUP(KLON,KLEV+1) ; SW total sky flux up | ||
| 80 | ! PFSCDN(KLON,KLEV+1) ; SW clear sky flux down | ||
| 81 | ! PFSCUP(KLON,KLEV+1) ; SW clear sky flux up | ||
| 82 | |||
| 83 | |||
| 84 | |||
| 85 | ! IMPLICIT ARGUMENTS : NONE | ||
| 86 | ! -------------------- | ||
| 87 | |||
| 88 | ! METHOD. | ||
| 89 | ! ------- | ||
| 90 | ! SEE DOCUMENTATION | ||
| 91 | |||
| 92 | ! EXTERNALS. | ||
| 93 | ! ---------- | ||
| 94 | |||
| 95 | ! REFERENCE. | ||
| 96 | ! ---------- | ||
| 97 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS | ||
| 98 | |||
| 99 | ! AUTHORS. | ||
| 100 | ! -------- | ||
| 101 | ! J.-J. MORCRETTE *ECMWF* | ||
| 102 | |||
| 103 | ! MODIFICATIONS. | ||
| 104 | ! -------------- | ||
| 105 | ! ORIGINAL : 88-02-04 | ||
| 106 | ! J.-J. MORCRETTE 94-11-15 DIRECT/DIFFUSE SURFACE ALBEDO | ||
| 107 | ! 08/96: J.-J. Morcrette/Ph. Dandin: tests of eff. radius param. | ||
| 108 | ! 9909 : JJMorcrette effect.radius + inhomogeneity factors | ||
| 109 | ! JJMorcrette 990128 : sunshine duration | ||
| 110 | ! JJMorcrette : 990831 RRTM-140gp | ||
| 111 | ! JJMorcrette : 010112 Sun-Rikus ice particle Diameter | ||
| 112 | ! JJMorcrette : 010301 cleaning liq/ice cloud optical properties | ||
| 113 | ! JJMorcrette : 011005 CCN --> Re liquid water clouds | ||
| 114 | ! JJMorcrette : 011108 Safety checks | ||
| 115 | ! JJMorcrette : 011108 Safety checks | ||
| 116 | ! DJSalmond : 020211 Check before R-To-R | ||
| 117 | ! JJMorcrette : 020901 PAR & UV | ||
| 118 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
| 119 | ! JJMorcrette : 050402 New sets of optical properties (NB: inactive) | ||
| 120 | ! Y.Seity 04-11-18 : add 4 arguments for AROME externalized surface | ||
| 121 | ! Y.Seity 05-10-10 : add 3 optional arg. for dust SW properties | ||
| 122 | ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation | ||
| 123 | !----------------------------------------------------------------------- | ||
| 124 | |||
| 125 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 126 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
| 127 | |||
| 128 | USE YOMCST , ONLY : RG ,RD ,RTT ,RPI | ||
| 129 | !USE YOERAD , ONLY : NSW ,LRRTM ,LCCNL ,LCCNO, LDIFFC, & | ||
| 130 | ! NSW mis dans .def MPL 20140211 | ||
| 131 | USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO, LDIFFC, & | ||
| 132 | & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,& | ||
| 133 | & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,& | ||
| 134 | & LEDBUG | ||
| 135 | USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP | ||
| 136 | USE YOESW , ONLY : RYFWCA ,RYFWCB ,RYFWCC ,RYFWCD ,& | ||
| 137 | & RYFWCE ,RYFWCF ,REBCUA ,REBCUB ,REBCUC ,& | ||
| 138 | & REBCUD ,REBCUE ,REBCUF ,REBCUI ,REBCUJ ,& | ||
| 139 | & REBCUG ,REBCUH ,RHSAVI ,RFULIO ,RFLAA0 ,& | ||
| 140 | & RFLAA1 ,RFLBB0 ,RFLBB1 ,RFLBB2 ,RFLBB3 ,& | ||
| 141 | & RFLCC0 ,RFLCC1 ,RFLCC2 ,RFLCC3 ,RFLDD0 ,& | ||
| 142 | & RFLDD1 ,RFLDD2 ,RFLDD3 ,RFUETA ,RFUETB ,RFUETC ,RASWCA ,& | ||
| 143 | & RASWCB ,RASWCC ,RASWCD ,RASWCE ,RASWCF ,& | ||
| 144 | & RFUAA0 ,RFUAA1 ,RFUBB0 ,RFUBB1 ,RFUBB2 ,& | ||
| 145 | & RFUBB3 ,RFUCC0 ,RFUCC1 ,RFUCC2 ,RFUCC3 ,& | ||
| 146 | & RLILIA ,RLILIB | ||
| 147 | USE YOERDU , ONLY : NUAER ,NTRAER ,REPLOG ,REPSC ,REPSCW ,DIFF | ||
| 148 | !USE YOETHF , ONLY : RTICE | ||
| 149 | USE YOEPHLI , ONLY : LPHYLIN | ||
| 150 | USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK | ||
| 151 | |||
| 152 | USE YOMLUN_IFSAUX , ONLY : NULOUT | ||
| 153 | USE YOMCT3 , ONLY : NSTEP | ||
| 154 | |||
| 155 | IMPLICIT NONE | ||
| 156 | |||
| 157 | include "clesphys.h" | ||
| 158 | !!include "clesrrtm.h" | ||
| 159 | include "YOETHF.h" | ||
| 160 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 161 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
| 162 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 163 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 164 | INTEGER(KIND=JPIM),INTENT(IN) :: KMODE | ||
| 165 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
| 166 | REAL(KIND=JPRB) ,INTENT(IN) :: PRII0 | ||
| 167 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
| 168 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
| 169 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
| 170 | REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) | ||
| 171 | REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) | ||
| 172 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCNL(KLON) | ||
| 173 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCNO(KLON) | ||
| 174 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 | ||
| 175 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV) | ||
| 176 | REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) | ||
| 177 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) | ||
| 178 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) | ||
| 179 | REAL(KIND=JPRB) ,INTENT(IN) :: PLSM(KLON) | ||
| 180 | REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(KLON) | ||
| 181 | REAL(KIND=JPRB) ,INTENT(IN) :: POZON(KLON,KLEV) | ||
| 182 | REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) | ||
| 183 | REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KLON,KLEV) | ||
| 184 | REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KLON,KLEV) | ||
| 185 | REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) | ||
| 186 | REAL(KIND=JPRB) :: PQRAIN(KLON,KLEV) ! Argument NOT used | ||
| 187 | REAL(KIND=JPRB) :: PRAINT(KLON,KLEV) ! Argument NOT used | ||
| 188 | REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) | ||
| 189 | REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) | ||
| 190 | REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) | ||
| 191 | REAL(KIND=JPRB) ,INTENT(IN) :: PNBAS(KLON) | ||
| 192 | REAL(KIND=JPRB) ,INTENT(IN) :: PNTOP(KLON) | ||
| 193 | LOGICAL ,INTENT(IN) :: LRDUST | ||
| 194 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW) | ||
| 195 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) | ||
| 196 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) | ||
| 197 | !--C.Kleinschmitt | ||
| 198 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) | ||
| 199 | !--end | ||
| 200 | REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KLON,KLEV) | ||
| 201 | REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KLON,KLEV) | ||
| 202 | REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) | ||
| 203 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFCT(KLON,KLEV+1) | ||
| 204 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLT(KLON,KLEV+1) | ||
| 205 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFCS(KLON,KLEV+1) | ||
| 206 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLS(KLON,KLEV+1) | ||
| 207 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFRSOD(KLON) | ||
| 208 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON) | ||
| 209 | REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON) | ||
| 210 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON) | ||
| 211 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON), PTINCF(KLON) | ||
| 212 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(KLON,NSW) | ||
| 213 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(KLON,NSW) | ||
| 214 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(KLON) | ||
| 215 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(KLON) | ||
| 216 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down) | ||
| 217 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down) | ||
| 218 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(KLON,KLEV+1) ! SW total sky flux down | ||
| 219 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(KLON,KLEV+1) ! SW total sky flux up | ||
| 220 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(KLON,KLEV+1) ! SW clear sky flux down | ||
| 221 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(KLON,KLEV+1) ! SW clear sky flux up | ||
| 222 | |||
| 223 | |||
| 224 | ! ----------------------------------------------------------------- | ||
| 225 | |||
| 226 | !* 0.1 ARGUMENTS. | ||
| 227 | ! ---------- | ||
| 228 | ! ==== COMPUTED IN RADLSW === | ||
| 229 | ! ----------------------------------------------------------------- | ||
| 230 | |||
| 231 | !* 0.2 LOCAL ARRAYS. | ||
| 232 | ! ------------- | ||
| 233 | ! ----------------------------------------------------------------- | ||
| 234 | |||
| 235 | !-- ARRAYS FOR LOCAL VARIABLES ----------------------------------------- | ||
| 236 | |||
| 237 | 240 | INTEGER(KIND=JPIM) :: IBAS(KLON) , ITOP(KLON) | |
| 238 | |||
| 239 | REAL(KIND=JPRB) ::& | ||
| 240 | 240 | & ZALBD(KLON,NSW) , ZALBP(KLON,NSW)& | |
| 241 | 240 | & , ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)& | |
| 242 | 240 | & , ZTAU (KLON,NSW,KLEV) & | |
| 243 | 240 | & , ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON) | |
| 244 | REAL(KIND=JPRB) ::& | ||
| 245 | 240 | & ZCLDLD(KLON,KLEV) , ZCLDLU(KLON,KLEV)& | |
| 246 | 240 | & , ZCLDSW(KLON,KLEV) , ZCLD0(KLON,KLEV)& | |
| 247 | 240 | & , ZDT0(KLON) & | |
| 248 | 240 | & , ZEMIS(KLON) , ZEMIW(KLON)& | |
| 249 | 240 | & , ZFIWP(KLON) , ZFLWP(KLON) , ZFRWP(KLON)& | |
| 250 | 240 | & , ZIWC(KLON) , ZLWC(KLON)& | |
| 251 | !cc , ZRWC(KLON) | ||
| 252 | 240 | & , ZMU0(KLON) , ZOZ(KLON,KLEV) , ZOZN(KLON,KLEV)& | |
| 253 | 240 | & , ZPMB(KLON,KLEV+1) , ZPSOL(KLON)& | |
| 254 | 240 | & , ZTAVE (KLON,KLEV) , ZTL(KLON,KLEV+1)& | |
| 255 | 240 | & , ZVIEW(KLON) | |
| 256 | REAL(KIND=JPRB) ::& | ||
| 257 | 240 | & ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)& | |
| 258 | 240 | & , ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)& | |
| 259 | 240 | & , ZFSUPN(KLON) , ZFSUPV(KLON)& | |
| 260 | 240 | & , ZFCUPN(KLON) , ZFCUPV(KLON)& | |
| 261 | 240 | & , ZFSDNN(KLON) , ZFSDNV(KLON)& | |
| 262 | 240 | & , ZFCDNN(KLON) , ZFCDNV(KLON)& | |
| 263 | 240 | & , ZDIRFS(KLON,NSW) , ZDIFFS(KLON,NSW) | |
| 264 | REAL(KIND=JPRB) ::& | ||
| 265 | 240 | & ZALFICE(KLON) , ZGAMICE(KLON) , ZBICE(KLON) , ZDESR(KLON)& | |
| 266 | 240 | & , ZRADIP(KLON) , ZRADLP(KLON) & | |
| 267 | !cc , ZRADRD(KLON) | ||
| 268 | 240 | & , ZRAINT(KLON) , ZRES(KLON)& | |
| 269 | 240 | & , ZTICE(KLON) , ZEMIT(KLON), ZBICFU(KLON)& | |
| 270 | 240 | & , ZKICFU(KLON) | |
| 271 | 240 | REAL(KIND=JPRB) :: ZSUDU(KLON) , ZPARF(KLON) , ZUVDF(KLON), ZPARCF(KLON) | |
| 272 | INTEGER(KIND=JPIM) :: IKL, JK, JKL, JKLP1, JKP1, JL, JNU, JRTM, JSW, INDLAY | ||
| 273 | |||
| 274 | REAL(KIND=JPRB) :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR, ZIWGKG, ZLWGKG,& | ||
| 275 | & ZMSAID, ZMSAIU, ZMSALD, ZMSALU, ZRSAIA, ZRSAID, ZRSAIE, ZRSAIF, ZRSAIG, ZRSALD, & | ||
| 276 | & ZMULTI, ZMULTL, ZOI , ZOL, & | ||
| 277 | & ZOMGMX, ZOR, ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, & | ||
| 278 | & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT | ||
| 279 | |||
| 280 | REAL(KIND=JPRB) :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, Z1RADI, & | ||
| 281 | & Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZTCELS, ZFSR, ZAIWC, & | ||
| 282 | & ZBIWC, ZTBLAY, ZADDPLK, ZPLANCK, ZEXTCF, Z1MOMG, & | ||
| 283 | & ZDefRe, ZRefDe, ZVI , ZMABSD | ||
| 284 | |||
| 285 | !REAL(KIND=JPRB) :: ZAVDP(KLON), ZAVTO(KLON), ZSQTO(KLON) | ||
| 286 | 240 | REAL(KIND=JPRB) :: ZAVTO(KLON), ZSQTO(KLON) | |
| 287 | 240 | REAL(KIND=JPRB) :: ZSQUAR(KLON,KLEV), ZVARIA(KLON,KLEV) | |
| 288 | INTEGER(KIND=JPIM) :: IKI, JKI, JEXPLR, JXPLDN | ||
| 289 | LOGICAL :: LLDEBUG | ||
| 290 | |||
| 291 | |||
| 292 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
| 293 | |||
| 294 | INTERFACE | ||
| 295 | SUBROUTINE LW& | ||
| 296 | & ( KIDIA, KFDIA , KLON , KLEV , KMODE,& | ||
| 297 | & PCCO2, PCLDLD, PCLDLU,& | ||
| 298 | & PDP , PDT0 , PEMIS , PEMIW,& | ||
| 299 | & PPMB , PQOF , PTL,& | ||
| 300 | & PAER , PTAVE , PVIEW , PWV,& | ||
| 301 | & PEMIT, PFLUX , PFLUC& | ||
| 302 | & ) | ||
| 303 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 304 | USE YOELW , ONLY : NUA | ||
| 305 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 306 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
| 307 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 308 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 309 | INTEGER(KIND=JPIM),INTENT(IN) :: KMODE | ||
| 310 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 | ||
| 311 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLD(KLON,KLEV) | ||
| 312 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLU(KLON,KLEV) | ||
| 313 | REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) | ||
| 314 | REAL(KIND=JPRB) ,INTENT(IN) :: PDT0(KLON) | ||
| 315 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) | ||
| 316 | REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) | ||
| 317 | REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) | ||
| 318 | REAL(KIND=JPRB) ,INTENT(IN) :: PQOF(KLON,KLEV) | ||
| 319 | REAL(KIND=JPRB) ,INTENT(IN) :: PTL(KLON,KLEV+1) | ||
| 320 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
| 321 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) | ||
| 322 | REAL(KIND=JPRB) ,INTENT(IN) :: PVIEW(KLON) | ||
| 323 | REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) | ||
| 324 | REAL(KIND=JPRB) ,INTENT(INOUT) :: PEMIT(KLON) | ||
| 325 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) | ||
| 326 | REAL(KIND=JPRB) ,INTENT(INOUT) :: PFLUC(KLON,2,KLEV+1) | ||
| 327 | END SUBROUTINE LW | ||
| 328 | END INTERFACE | ||
| 329 | INTERFACE | ||
| 330 | SUBROUTINE RRTM_RRTM_140GP & | ||
| 331 | & ( KIDIA , KFDIA , KLON , KLEV,& | ||
| 332 | & PAER , PAPH , PAP,& | ||
| 333 | & PTS , PTH , PT,& | ||
| 334 | & P_ZEMIS , P_ZEMIW,& | ||
| 335 | & PQ , PCCO2 , POZN,& | ||
| 336 | & PCLDF , PTAUCLD,& | ||
| 337 | & PTAU_LW,& | ||
| 338 | & PEMIT , PFLUX , PFLUC, PTCLEAR ) | ||
| 339 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 340 | USE YOERAD ,ONLY : NLW !--C.Kleinschmitt | ||
| 341 | USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPGPT ,JPLAY ,& | ||
| 342 | & JPINPX | ||
| 343 | !-NLW in clesphys now OB | ||
| 344 | include "clesphys.h" | ||
| 345 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 346 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
| 347 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 348 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 349 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
| 350 | REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) | ||
| 351 | REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) | ||
| 352 | REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) | ||
| 353 | REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) | ||
| 354 | REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) | ||
| 355 | REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIS(KLON) | ||
| 356 | REAL(KIND=JPRB) ,INTENT(IN) :: P_ZEMIW(KLON) | ||
| 357 | REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) | ||
| 358 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 | ||
| 359 | REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) | ||
| 360 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) | ||
| 361 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) | ||
| 362 | !--C.Kleinschmitt | ||
| 363 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols | ||
| 364 | !--end | ||
| 365 | REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) | ||
| 366 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) | ||
| 367 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) | ||
| 368 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR(KLON) | ||
| 369 | END SUBROUTINE RRTM_RRTM_140GP | ||
| 370 | END INTERFACE | ||
| 371 | INTERFACE | ||
| 372 | SUBROUTINE SW& | ||
| 373 | & ( KIDIA, KFDIA , KLON , KLEV , KAER,& | ||
| 374 | & PSCT , PCARDI, PPSOL , PALBD, PALBP , PWV, PQS,& | ||
| 375 | & PRMU0, PCG , PCLDSW, PDP , POMEGA, POZ, PPMB,& | ||
| 376 | & PTAU , PTAVE , PAER,& | ||
| 377 | & PFDOWN, PFUP,& | ||
| 378 | & PCDOWN, PCUP,& | ||
| 379 | & PFDNN, PFDNV , PFUPN, PFUPV,& | ||
| 380 | & PCDNN, PCDNV , PCUPN, PCUPV,& | ||
| 381 | & PSUDU, PUVDF , PPARF, PPARCF, PDIFFS , PDIRFS,& | ||
| 382 | & LRDUST, PPIZA_DST,PCGA_DST,PTAUREL_DST& | ||
| 383 | & ) | ||
| 384 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
| 385 | include "clesphys.h" | ||
| 386 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON | ||
| 387 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
| 388 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA | ||
| 389 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA | ||
| 390 | INTEGER(KIND=JPIM),INTENT(IN) :: KAER | ||
| 391 | REAL(KIND=JPRB) ,INTENT(IN) :: PSCT | ||
| 392 | REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI | ||
| 393 | REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON) | ||
| 394 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,NSW) | ||
| 395 | REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,NSW) | ||
| 396 | REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) | ||
| 397 | REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KLON,KLEV) | ||
| 398 | REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON) | ||
| 399 | REAL(KIND=JPRB) ,INTENT(IN) :: PCG(KLON,NSW,KLEV) | ||
| 400 | REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV) | ||
| 401 | REAL(KIND=JPRB) :: PDP(KLON,KLEV) | ||
| 402 | REAL(KIND=JPRB) ,INTENT(IN) :: POMEGA(KLON,NSW,KLEV) | ||
| 403 | REAL(KIND=JPRB) ,INTENT(IN) :: POZ(KLON,KLEV) | ||
| 404 | REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) | ||
| 405 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAU(KLON,NSW,KLEV) | ||
| 406 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) | ||
| 407 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) | ||
| 408 | LOGICAL ,INTENT(IN) :: LRDUST | ||
| 409 | REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_DST(KLON,KLEV,NSW) | ||
| 410 | REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) | ||
| 411 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) | ||
| 412 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDOWN(KLON,KLEV+1) | ||
| 413 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUP(KLON,KLEV+1) | ||
| 414 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDOWN(KLON,KLEV+1) | ||
| 415 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUP(KLON,KLEV+1) | ||
| 416 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNN(KLON) | ||
| 417 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFDNV(KLON) | ||
| 418 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPN(KLON) | ||
| 419 | REAL(KIND=JPRB) ,INTENT(OUT) :: PFUPV(KLON) | ||
| 420 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNN(KLON) | ||
| 421 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCDNV(KLON) | ||
| 422 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPN(KLON) | ||
| 423 | REAL(KIND=JPRB) ,INTENT(OUT) :: PCUPV(KLON) | ||
| 424 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON) | ||
| 425 | REAL(KIND=JPRB) ,INTENT(OUT) :: PUVDF(KLON) | ||
| 426 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KLON) | ||
| 427 | REAL(KIND=JPRB) ,INTENT(OUT) :: PPARCF(KLON) | ||
| 428 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIFFS(KLON,NSW) | ||
| 429 | REAL(KIND=JPRB) ,INTENT(OUT) :: PDIRFS(KLON,NSW) | ||
| 430 | END SUBROUTINE SW | ||
| 431 | END INTERFACE | ||
| 432 | |||
| 433 | ! ----------------------------------------------------------------- | ||
| 434 | |||
| 435 | !* 1. SET-UP INPUT QUANTITIES FOR RADIATION | ||
| 436 | ! ------------------------------------- | ||
| 437 | |||
| 438 |
1/2✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
|
120 | IF (LHOOK) CALL DR_HOOK('RADLSW',0,ZHOOK_HANDLE) |
| 439 | |||
| 440 | LLDEBUG=.FALSE. | ||
| 441 | 120 | ZRefDe = RRe2De | |
| 442 | 120 | ZDefRe = 1.0_JPRB / ZRefDe | |
| 443 | |||
| 444 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL = KIDIA,KFDIA |
| 445 | 119280 | ZFCUP(JL,KLEV+1) = 0.0_JPRB | |
| 446 | 119280 | ZFCDWN(JL,KLEV+1) = REPLOG | |
| 447 | 119280 | ZFSUP(JL,KLEV+1) = 0.0_JPRB | |
| 448 | 119280 | ZFSDWN(JL,KLEV+1) = REPLOG | |
| 449 | 119280 | PFLUX(JL,1,KLEV+1) = 0.0_JPRB | |
| 450 | 119280 | PFLUX(JL,2,KLEV+1) = 0.0_JPRB | |
| 451 | 119280 | PFLUC(JL,1,KLEV+1) = 0.0_JPRB | |
| 452 | 119280 | PFLUC(JL,2,KLEV+1) = 0.0_JPRB | |
| 453 | 119280 | ZFSDNN(JL) = 0.0_JPRB | |
| 454 | 119280 | ZFSDNV(JL) = 0.0_JPRB | |
| 455 | 119280 | ZFCDNN(JL) = 0.0_JPRB | |
| 456 | 119280 | ZFCDNV(JL) = 0.0_JPRB | |
| 457 | 119280 | ZFSUPN(JL) = 0.0_JPRB | |
| 458 | 119280 | ZFSUPV(JL) = 0.0_JPRB | |
| 459 | 119280 | ZFCUPN(JL) = 0.0_JPRB | |
| 460 | 119280 | ZFCUPV(JL) = 0.0_JPRB | |
| 461 | 119280 | ZPSOL(JL) = PAPH(JL,KLEV+1) | |
| 462 | 119280 | ZPMB(JL,1) = ZPSOL(JL) / 100.0_JPRB | |
| 463 | 119280 | ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1) | |
| 464 | 119280 | PSUDU(JL) = 0.0_JPRB | |
| 465 | 119280 | PPARF(JL) = 0.0_JPRB | |
| 466 | 119280 | PPARCF(JL)= 0.0_JPRB | |
| 467 | 119280 | PUVDF(JL) = 0.0_JPRB | |
| 468 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 119280 times.
|
834960 | PSFSWDIR(JL,:)=0.0_JPRB |
| 469 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 119280 times.
|
834960 | PSFSWDIF(JL,:)=0.0_JPRB |
| 470 | 119280 | IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) ) | |
| 471 | 119400 | ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) ) | |
| 472 | ENDDO | ||
| 473 | |||
| 474 | !* 1.1 INITIALIZE VARIOUS FIELDS | ||
| 475 | ! ------------------------- | ||
| 476 | |||
| 477 |
2/2✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
|
840 | DO JSW=1,NSW |
| 478 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716520 | DO JL = KIDIA,KFDIA |
| 479 | 715680 | ZALBD(JL,JSW)=PALBD(JL,JSW) | |
| 480 | 716400 | ZALBP(JL,JSW)=PALBP(JL,JSW) | |
| 481 | ENDDO | ||
| 482 | ENDDO | ||
| 483 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL = KIDIA,KFDIA |
| 484 | 119280 | ZEMIS(JL) =PEMIS(JL) | |
| 485 | 119280 | ZEMIW(JL) =PEMIW(JL) | |
| 486 | 119400 | ZMU0(JL) =PMU0(JL) | |
| 487 | ENDDO | ||
| 488 | |||
| 489 |
2/2✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
|
4800 | DO JK = 1 , KLEV |
| 490 | 4680 | JKP1 = JK + 1 | |
| 491 | 4680 | JKL = KLEV+ 1 - JK | |
| 492 | JKLP1 = JKL + 1 | ||
| 493 |
2/2✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 4651920 times.
|
4656720 | DO JL = KIDIA,KFDIA |
| 494 | 4651920 | ZPMB(JL,JK+1)=PAPH(JL,JKL)/100.0_JPRB | |
| 495 | |||
| 496 | !-- ZOZ in cm.atm for SW scheme | ||
| 497 | 4651920 | ZOZ(JL,JK) = POZON(JL,JKL) * 46.6968_JPRB / RG | |
| 498 | |||
| 499 | 4651920 | ZCLD0(JL,JK) = 0.0_JPRB | |
| 500 | 4651920 | ZFCUP(JL,JK) = 0.0_JPRB | |
| 501 | 4651920 | ZFCDWN(JL,JK) = 0.0_JPRB | |
| 502 | 4651920 | ZFSUP(JL,JK) = 0.0_JPRB | |
| 503 | 4651920 | ZFSDWN(JL,JK) = 0.0_JPRB | |
| 504 | 4651920 | PFLUX(JL,1,JK) = 0.0_JPRB | |
| 505 | 4651920 | PFLUX(JL,2,JK) = 0.0_JPRB | |
| 506 | 4651920 | PFLUC(JL,1,JK) = 0.0_JPRB | |
| 507 | 4656600 | PFLUC(JL,2,JK) = 0.0_JPRB | |
| 508 | ENDDO | ||
| 509 | ENDDO | ||
| 510 | |||
| 511 |
2/2✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
|
4800 | DO JK=1,KLEV |
| 512 | 4680 | JKL=KLEV+1-JK | |
| 513 | 4680 | JKLP1=JKL+1 | |
| 514 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
|
4656720 | DO JL=KIDIA,KFDIA |
| 515 | 4651920 | ZTL(JL,JK)=PTH(JL,JKLP1) | |
| 516 | 4656600 | ZTAVE(JL,JK)=PT(JL,JKL) | |
| 517 | ENDDO | ||
| 518 | ENDDO | ||
| 519 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL=KIDIA,KFDIA |
| 520 | 119280 | ZTL(JL,KLEV+1)= PTH(JL,1) | |
| 521 | 119400 | ZPMB(JL,KLEV+1) = PAPH(JL,1)/100.0_JPRB | |
| 522 | ENDDO | ||
| 523 | !*** | ||
| 524 | |||
| 525 | ! ------------------------------------------------------------------ | ||
| 526 | |||
| 527 | !* 2. CLOUD AND AEROSOL PARAMETERS | ||
| 528 | ! ---------------------------- | ||
| 529 | |||
| 530 |
2/2✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
|
4800 | DO JK = 1 , KLEV |
| 531 | 4680 | IKL = KLEV + 1 - JK | |
| 532 | |||
| 533 | ! 2.1 INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES | ||
| 534 | ! ------------------------------------------------- | ||
| 535 | |||
| 536 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 4680 times.
|
32760 | DO JSW = 1,NSW |
| 537 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27944280 | DO JL = KIDIA,KFDIA |
| 538 | 27911520 | ZTAU(JL,JSW,JK) = 0.0_JPRB | |
| 539 | 27911520 | ZOMEGA(JL,JSW,JK)= 1.0_JPRB | |
| 540 | 27939600 | ZCG(JL,JSW,JK) = 0.0_JPRB | |
| 541 | ENDDO | ||
| 542 | ENDDO | ||
| 543 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
|
4656600 | DO JL = KIDIA,KFDIA |
| 544 | 4651920 | ZCLDSW(JL,JK) = 0.0_JPRB | |
| 545 | 4651920 | ZCLDLD(JL,JK) = 0.0_JPRB | |
| 546 | 4656600 | ZCLDLU(JL,JK) = 0.0_JPRB | |
| 547 | ENDDO | ||
| 548 | |||
| 549 | ! 2.2 CLOUD ICE AND LIQUID CONTENT AND PATH | ||
| 550 | ! ------------------------------------- | ||
| 551 | |||
| 552 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
|
4656600 | DO JL = KIDIA,KFDIA |
| 553 | |||
| 554 | ! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) | ||
| 555 |
2/2✓ Branch 0 taken 1092084 times.
✓ Branch 1 taken 3559836 times.
|
4651920 | IF (PCLFR(JL,IKL) > REPSC ) THEN |
| 556 | 1092084 | ZLWGKG=MAX(PQLWP(JL,IKL)*1000.0_JPRB,0.0_JPRB) | |
| 557 | 1092084 | ZIWGKG=MAX(PQIWP(JL,IKL)*1000.0_JPRB,0.0_JPRB) | |
| 558 | 1092084 | ZLWGKG=ZLWGKG/PCLFR(JL,IKL) | |
| 559 | 1092084 | ZIWGKG=ZIWGKG/PCLFR(JL,IKL) | |
| 560 | ELSE | ||
| 561 | ZLWGKG=0.0_JPRB | ||
| 562 | ZIWGKG=0.0_JPRB | ||
| 563 | ENDIF | ||
| 564 | ZRWGKG=0.0_JPRB | ||
| 565 | 4651920 | ZRAINT(JL)=0.0_JPRB | |
| 566 | |||
| 567 | ! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) | ||
| 568 | ! IF (PRAINT(JL,IKL) >= REPSCW) THEN | ||
| 569 | ! ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0) | ||
| 570 | ! ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000. | ||
| 571 | !- no radiative effect of rain (for the moment) | ||
| 572 | ! ZRWGKG=0. | ||
| 573 | ! ZRAINT(JL)=0. | ||
| 574 | ! =========================================================== | ||
| 575 | |||
| 576 | ! Modifications Martin et al. | ||
| 577 | ! ELSE | ||
| 578 | ! ENDIF | ||
| 579 | 4651920 | ZDPOG=PDP(JL,IKL)/RG | |
| 580 | 4651920 | ZFLWP(JL)= ZLWGKG*ZDPOG | |
| 581 | 4651920 | ZFIWP(JL)= ZIWGKG*ZDPOG | |
| 582 | 4651920 | ZFRWP(JL)= ZRWGKG*ZDPOG | |
| 583 | 4651920 | ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL)) | |
| 584 | 4651920 | ZLWC(JL)=ZLWGKG*ZPODT | |
| 585 | 4656600 | ZIWC(JL)=ZIWGKG*ZPODT | |
| 586 | ! ZRWC(JL)=ZRWGKG*ZPODT | ||
| 587 | |||
| 588 | ENDDO | ||
| 589 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
|
4656600 | DO JL = KIDIA,KFDIA |
| 590 | ! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES | ||
| 591 | |||
| 592 | ! very old parametrization as f(pressure) | ||
| 593 | |||
| 594 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4656600 | IF (NRADLP == 0) THEN |
| 595 | !-- very old parametrization as f(pressure) ERA-15 | ||
| 596 | ✗ | ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,IKL))*3.5_JPRB | |
| 597 | |||
| 598 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (NRADLP == 1) THEN |
| 599 | ! simple distinction between land (10) and ocean (13) Zhang and Rossow | ||
| 600 | ✗ | IF (PLSM(JL) < 0.5_JPRB) THEN | |
| 601 | ✗ | ZRADLP(JL)=13.0_JPRB | |
| 602 | ELSE | ||
| 603 | ✗ | ZRADLP(JL)=10.0_JPRB | |
| 604 | ENDIF | ||
| 605 | |||
| 606 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (NRADLP == 2) THEN |
| 607 | !-- based on Martin et al., 1994, JAS | ||
| 608 | ✗ | IF (PLSM(JL) < 0.5_JPRB) THEN | |
| 609 | ✗ | IF (LCCNO) THEN | |
| 610 | ! ZASEA=50.0_JPRB | ||
| 611 | ✗ | ZASEA=PCCNO(JL) | |
| 612 | ELSE | ||
| 613 | ✗ | ZASEA=RCCNSEA | |
| 614 | ENDIF | ||
| 615 | ZD=0.33_JPRB | ||
| 616 | ✗ | ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB | |
| 617 | ELSE | ||
| 618 | ✗ | IF (LCCNL) THEN | |
| 619 | ! ZALND=900.0_JPRB | ||
| 620 | ✗ | ZALND=PCCNL(JL) | |
| 621 | ELSE | ||
| 622 | ✗ | ZALND=RCCNLND | |
| 623 | ENDIF | ||
| 624 | ZD=0.43_JPRB | ||
| 625 | ✗ | ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB | |
| 626 | ENDIF | ||
| 627 | ✗ | ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2 | |
| 628 | ✗ | ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3 | |
| 629 | ✗ | IF((ZNUM/ZDEN) > REPLOG)THEN | |
| 630 | ✗ | ZRADLP(JL)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN)) | |
| 631 | ✗ | ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB) | |
| 632 | ✗ | ZRADLP(JL)=MIN(ZRADLP(JL),16.0_JPRB) | |
| 633 | ELSE | ||
| 634 | ✗ | ZRADLP(JL)=4.0_JPRB | |
| 635 | ENDIF | ||
| 636 | |||
| 637 |
1/2✓ Branch 0 taken 4651920 times.
✗ Branch 1 not taken.
|
4651920 | ELSEIF (NRADLP == 3) THEN |
| 638 | ! one uses the cloud droplet radius from newmicro | ||
| 639 | ! IKL or JK ?? - I think IKL but needs to be verified > ref_liq_i | ||
| 640 | ! (inverted) is used in the call of RECMWF_AERO in radlwsw_m.F90, | ||
| 641 | ! so everything is fine - JBM 6/2019 | ||
| 642 | 4651920 | ZRADLP(JL)=PREF_LIQ(JL,IKL) | |
| 643 | ENDIF | ||
| 644 | |||
| 645 | ! =========================================================== | ||
| 646 | ! ___________________________________________________________ | ||
| 647 | |||
| 648 | ! rain drop from : unused as ZRAINT is 0. | ||
| 649 | ! ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB | ||
| 650 | ! IF (ZFLWP(JL).GT.0.) THEN | ||
| 651 | ! ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL) | ||
| 652 | ! ENDIF | ||
| 653 | |||
| 654 | ENDDO | ||
| 655 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
|
4656600 | DO JL = KIDIA,KFDIA |
| 656 | |||
| 657 | ! diagnosing the ice particle effective radius/diameter | ||
| 658 | |||
| 659 | !- ice particle effective radius =f(T) from Liou and Ou (1994) | ||
| 660 | |||
| 661 |
2/2✓ Branch 0 taken 3185418 times.
✓ Branch 1 taken 1466502 times.
|
4651920 | IF (PT(JL,IKL) < RTICE) THEN |
| 662 | 3185418 | ZTEMPC=PT(JL,IKL)-RTT | |
| 663 | ELSE | ||
| 664 | 1466502 | ZTEMPC=RTICE-RTT | |
| 665 | ENDIF | ||
| 666 | ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*& | ||
| 667 | 4651920 | & 0.0012_JPRB)) | |
| 668 | |||
| 669 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4656600 | IF (NRADIP == 0) THEN |
| 670 | !-- fixed 40 micron effective radius | ||
| 671 | ✗ | ZRADIP(JL)= 40.0_JPRB | |
| 672 | ✗ | ZDESR(JL) = ZDefRe * ZRADIP(JL) | |
| 673 | |||
| 674 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (NRADIP == 1) THEN |
| 675 | |||
| 676 | !-- old formulation based on Liou & Ou (1994) temperature (40-130microns) | ||
| 677 | ✗ | ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB) | |
| 678 | ✗ | ZDESR(JL) = ZDefRe * ZRADIP(JL) | |
| 679 | |||
| 680 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (NRADIP == 2) THEN |
| 681 | !-- formulation following Jakob, Klein modifications to ice content | ||
| 682 | ✗ | ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB) | |
| 683 | ✗ | ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB) | |
| 684 | ✗ | ZDESR(JL)= ZDefRe * ZRADIP(JL) | |
| 685 | |||
| 686 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (NRADIP == 3 ) THEN |
| 687 | |||
| 688 | !- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999) | ||
| 689 | ! revised by Sun (2001) | ||
| 690 | ✗ | IF (ZIWC(JL) > 0.0_JPRB ) THEN | |
| 691 | ✗ | ZTEMPC = PT(JL,IKL)-83.15_JPRB | |
| 692 | ✗ | ZTCELS = PT(JL,IKL)-RTT | |
| 693 | ✗ | ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS | |
| 694 | ! Sun, 2001 (corrected from Sun & Rikus, 1999) | ||
| 695 | ✗ | ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB | |
| 696 | ✗ | ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB | |
| 697 | ✗ | ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC) | |
| 698 | !-new ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB) | ||
| 699 | ✗ | ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB) | |
| 700 | ✗ | ZRADIP(JL)= ZRefDe * ZDESR(JL) | |
| 701 | ELSE | ||
| 702 | ! ZDESR(JL) = 92.5_JPRB | ||
| 703 | ✗ | ZDESR(JL) = 80.0_JPRB | |
| 704 | ✗ | ZRADIP(JL)= ZRefDe * ZDESR(JL) | |
| 705 | ENDIF | ||
| 706 | |||
| 707 |
1/2✓ Branch 0 taken 4651920 times.
✗ Branch 1 not taken.
|
4651920 | ELSEIF (NRADIP == 4 ) THEN |
| 708 | ! one uses the cloud droplet radius from newmicro | ||
| 709 | ! IKL or JK ?? - I think IKL but needs to be verified | ||
| 710 | 4651920 | ZRADIP(JL)=PREF_ICE(JL,IKL) | |
| 711 | ENDIF | ||
| 712 | |||
| 713 | ENDDO | ||
| 714 | |||
| 715 | ! 2.3 CLOUD SHORTWAVE OPTICAL PROPERTIES | ||
| 716 | ! ---------------------------------- | ||
| 717 | |||
| 718 | ! ------------------------- | ||
| 719 | ! --+ SW OPTICAL PARAMETERS + Water clouds after Fouquart (1987) | ||
| 720 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) | ||
| 721 | |||
| 722 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 4680 times.
|
32760 | DO JSW=1,NSW |
| 723 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27944280 | DO JL = KIDIA,KFDIA |
| 724 | ZTOL=0.0_JPRB | ||
| 725 | ZGL =0.0_JPRB | ||
| 726 | ZOL =0.0_JPRB | ||
| 727 | ZTOI=0.0_JPRB | ||
| 728 | ZGI =0.0_JPRB | ||
| 729 | ZOI =0.0_JPRB | ||
| 730 | ZTOR=0.0_JPRB | ||
| 731 | ZGR =0.0_JPRB | ||
| 732 | ZOR =0.0_JPRB | ||
| 733 |
2/2✓ Branch 0 taken 6552222 times.
✓ Branch 1 taken 21359298 times.
|
27939600 | IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN |
| 734 |
2/2✓ Branch 0 taken 3233190 times.
✓ Branch 1 taken 3319032 times.
|
6552222 | IF (ZFLWP(JL) >= REPSCW ) THEN |
| 735 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 3233190 times.
|
3233190 | IF (NLIQOPT /= 0 ) THEN |
| 736 | !-- SW: Slingo, 1989 | ||
| 737 | ✗ | ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL)) | |
| 738 | ✗ | ZGL = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL) | |
| 739 | ✗ | ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL) | |
| 740 | ELSE | ||
| 741 | !-- SW: Fouquart, 1991 | ||
| 742 | 3233190 | ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL)) | |
| 743 | 3233190 | ZGL = RYFWCF(JSW) | |
| 744 | ! ZOL = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL) | ||
| 745 | !-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with | ||
| 746 | ! the previous. Should be cleaned when RRTM_SW becomes active | ||
| 747 | 3233190 | ZOL = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF) | |
| 748 | ENDIF | ||
| 749 | ENDIF | ||
| 750 | |||
| 751 |
2/2✓ Branch 0 taken 5543472 times.
✓ Branch 1 taken 1008750 times.
|
6552222 | IF (ZFIWP(JL) >= REPSCW ) THEN |
| 752 |
1/2✓ Branch 0 taken 5543472 times.
✗ Branch 1 not taken.
|
5543472 | IF (NICEOPT <= 1) THEN |
| 753 | !-- SW: Ebert-Curry | ||
| 754 | 5543472 | ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL)) | |
| 755 | 5543472 | ZGI = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL) | |
| 756 | 5543472 | ZOI = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL) | |
| 757 | |||
| 758 | ✗ | ELSEIF (NICEOPT == 2) THEN | |
| 759 | !-- SW: Fu-Liou 1993 | ||
| 760 | ✗ | Z1RADI = 1.0_JPRB / ZDESR(JL) | |
| 761 | ✗ | ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW) | |
| 762 | ✗ | ZTOI = ZFIWP(JL) * ZBETAI | |
| 763 | ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) & | ||
| 764 | ✗ | & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) )) | |
| 765 | ✗ | ZOI = 1.0_JPRB - ZOMGI | |
| 766 | ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) & | ||
| 767 | ✗ | & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) )) | |
| 768 | ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) & | ||
| 769 | ✗ | & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) )) | |
| 770 | ✗ | ZGI = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB | |
| 771 | |||
| 772 | ✗ | ELSEIF (NICEOPT == 3) THEN | |
| 773 | !-- SW: Fu 1996 | ||
| 774 | ✗ | Z1RADI = 1.0_JPRB / ZDESR(JL) | |
| 775 | ✗ | ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW) | |
| 776 | ✗ | ZTOI = ZFIWP(JL) * ZBETAI | |
| 777 | ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) & | ||
| 778 | ✗ | & *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) )) | |
| 779 | ✗ | ZOI = 1.0_JPRB - ZOMGI | |
| 780 | ZGI = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) & | ||
| 781 | ✗ | & *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) )) | |
| 782 | ✗ | ZGI = MIN(1.0_JPRB, ZGI) | |
| 783 | |||
| 784 | ENDIF | ||
| 785 | ENDIF | ||
| 786 | |||
| 787 | ! IF (ZFRWP(JL) >= REPSCW ) THEN | ||
| 788 | ! ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB) | ||
| 789 | ! ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW) | ||
| 790 | ! ZGR = RRASY(JSW) | ||
| 791 | ! ENDIF | ||
| 792 | |||
| 793 | ! - MIX of WATER and ICE CLOUDS | ||
| 794 | 6552222 | ZTAUMX= ZTOL + ZTOI + ZTOR | |
| 795 | 6552222 | ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR | |
| 796 | 6552222 | ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR | |
| 797 | |||
| 798 | 6552222 | ZASYMX= ZASYMX/ZOMGMX | |
| 799 | 6552222 | ZOMGMX= ZOMGMX/ZTAUMX | |
| 800 | |||
| 801 | ! --- SW FINAL CLOUD OPTICAL PARAMETERS | ||
| 802 | |||
| 803 | 6552222 | ZCLDSW(JL,JK) = PCLFR(JL,IKL) | |
| 804 | 6552222 | ZTAU(JL,JSW,JK) = ZTAUMX | |
| 805 | 6552222 | ZOMEGA(JL,JSW,JK)= ZOMGMX | |
| 806 | 6552222 | ZCG(JL,JSW,JK) = ZASYMX | |
| 807 | ENDIF | ||
| 808 | ENDDO | ||
| 809 | ENDDO | ||
| 810 | |||
| 811 | IF(LLDEBUG) THEN | ||
| 812 | call writefield_phy("radlsw_ztau",ztau(:,1,:),klev) | ||
| 813 | ENDIF | ||
| 814 | |||
| 815 | ! 2.4 CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE | ||
| 816 | ! -------------------------------------------- | ||
| 817 | |||
| 818 | ! ------------------------- | ||
| 819 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Smith and Shi (1992) | ||
| 820 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) | ||
| 821 | |||
| 822 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4680 times.
|
4800 | IF (.NOT.LRRTM) THEN |
| 823 | |||
| 824 | ✗ | DO JL = KIDIA,KFDIA | |
| 825 | ✗ | ZALFICE(JL)=0.0_JPRB | |
| 826 | ✗ | ZGAMICE(JL)=0.0_JPRB | |
| 827 | ✗ | ZBICE(JL)=0.0_JPRB | |
| 828 | ✗ | ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND | |
| 829 | ✗ | IF (NICEOPT == 1) THEN | |
| 830 | ✗ | ZBICFU(JL)=1.0_JPRB | |
| 831 | ELSE | ||
| 832 | ✗ | ZBICFU(JL)=0.0_JPRB | |
| 833 | ENDIF | ||
| 834 | ✗ | ZKICFU(JL)=0.0_JPRB | |
| 835 | ENDDO | ||
| 836 | |||
| 837 | ✗ | DO JNU= 1,NSIL | |
| 838 | ✗ | DO JL = KIDIA,KFDIA | |
| 839 | ZRES(JL) = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,& | ||
| 840 | & JNU)& | ||
| 841 | & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,& | ||
| 842 | & JNU)& | ||
| 843 | ✗ | & ))))) | |
| 844 | ✗ | ZBICE(JL) = ZBICE(JL) + ZRES(JL) | |
| 845 | ✗ | ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL) | |
| 846 | ✗ | ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL) | |
| 847 | ENDDO | ||
| 848 | ENDDO | ||
| 849 | |||
| 850 | !-- Fu et al. (1998) with M'91 LW scheme | ||
| 851 | ✗ | IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN | |
| 852 | ✗ | DO JRTM=1,16 | |
| 853 | ✗ | DO JL=KIDIA,KFDIA | |
| 854 | ✗ | IF (PT(JL,IKL) < 160.0_JPRB) THEN | |
| 855 | INDLAY=1 | ||
| 856 | ✗ | ZTBLAY =PT(JL,IKL)-160.0_JPRB | |
| 857 | ✗ | ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN | |
| 858 | ✗ | INDLAY=PT(JL,IKL)-159.0_JPRB | |
| 859 | ✗ | INDLAY=MAX(INDLAY,1) | |
| 860 | ✗ | ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL)) | |
| 861 | ELSE | ||
| 862 | INDLAY=180 | ||
| 863 | ✗ | ZTBLAY =PT(JL,IKL)-339.0_JPRB | |
| 864 | ENDIF | ||
| 865 | ✗ | ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM) | |
| 866 | ✗ | ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK) | |
| 867 | ✗ | ZBICFU(JL) = ZBICFU(JL) + ZPLANCK | |
| 868 | |||
| 869 | ✗ | IF (ZIWC(JL) > 0.0_JPRB ) THEN | |
| 870 | ✗ | ZRATIO = 1.0_JPRB / ZDESR(JL) | |
| 871 | ✗ | IF (NICEOPT == 2) THEN | |
| 872 | ! ice cloud spectral emissivity a la Fu & Liou (1993) | ||
| 873 | ZMABSD = RFULIO(JRTM,1) + ZRATIO & | ||
| 874 | ✗ | & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) | |
| 875 | |||
| 876 | ! ice cloud spectral emissivity a la Fu et al (1998) | ||
| 877 | ELSEIF (NICEOPT == 3) THEN | ||
| 878 | ZMABSD = RFUETA(JRTM,1) + ZRATIO & | ||
| 879 | ✗ | & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3)) | |
| 880 | ENDIF | ||
| 881 | ✗ | ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK | |
| 882 | ENDIF | ||
| 883 | ENDDO | ||
| 884 | ENDDO | ||
| 885 | ENDIF | ||
| 886 | |||
| 887 | ✗ | DO JL = KIDIA,KFDIA | |
| 888 | ✗ | ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL) | |
| 889 | ✗ | ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL) | |
| 890 | ✗ | ZKICFU(JL) = ZKICFU(JL) / ZBICFU(JL) | |
| 891 | |||
| 892 | ✗ | IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN | |
| 893 | |||
| 894 | ✗ | IF (NLIQOPT == 0) THEN | |
| 895 | ! water cloud emissivity a la Smith & Shi (1992) | ||
| 896 | ✗ | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) | |
| 897 | ✗ | ZMSALD= 0.158_JPRB*ZMULTL | |
| 898 | ✗ | ZMSALU= 0.130_JPRB*ZMULTL | |
| 899 | |||
| 900 | ELSE | ||
| 901 | ! water cloud emissivity a la Savijarvi (1997) | ||
| 902 | ✗ | ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL) | |
| 903 | ✗ | ZMSALD= 1.2154_JPRB*ZMSALU | |
| 904 | |||
| 905 | ENDIF | ||
| 906 | |||
| 907 | ✗ | IF (NICEOPT == 0) THEN | |
| 908 | ! ice cloud emissivity a la Smith & Shi (1992) | ||
| 909 | ✗ | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) | |
| 910 | ✗ | ZMSAID= 0.113_JPRB*ZMULTI | |
| 911 | ✗ | ZMSAIU= 0.093_JPRB*ZMULTI | |
| 912 | |||
| 913 | ✗ | ELSEIF (NICEOPT == 1) THEN | |
| 914 | ! ice cloud emissivity a la Ebert & Curry (1992) | ||
| 915 | ✗ | ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL)) | |
| 916 | ZMSAIU= ZMSAID | ||
| 917 | |||
| 918 | ✗ | ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN | |
| 919 | ! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998) | ||
| 920 | ✗ | ZMSAID= 1.66_JPRB*ZKICFU(JL) | |
| 921 | ZMSAIU= ZMSAID | ||
| 922 | ENDIF | ||
| 923 | |||
| 924 | ✗ | IF (NINHOM == 1) THEN | |
| 925 | ✗ | ZZFLWP= ZFLWP(JL) * RLWINHF | |
| 926 | ✗ | ZZFIWP= ZFIWP(JL) * RLWINHF | |
| 927 | ELSE | ||
| 928 | ZZFLWP= ZFLWP(JL) | ||
| 929 | ZZFIWP= ZFIWP(JL) | ||
| 930 | ENDIF | ||
| 931 | |||
| 932 | ! effective cloudiness accounting for condensed water | ||
| 933 | ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* & | ||
| 934 | ✗ | & ZZFIWP)) | |
| 935 | ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* & | ||
| 936 | ✗ | & ZZFIWP)) | |
| 937 | ENDIF | ||
| 938 | ENDDO | ||
| 939 | |||
| 940 | ELSE | ||
| 941 | |||
| 942 | ! 2.5 CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM | ||
| 943 | ! ------------------------------------------ | ||
| 944 | |||
| 945 | ! ------------------------- | ||
| 946 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Savijarvi (1998) | ||
| 947 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) | ||
| 948 | |||
| 949 | ! No need for a fixed diffusivity factor, accounted for spectrally below | ||
| 950 | ! The detailed spectral structure does not require defining upward and | ||
| 951 | ! downward effective optical properties | ||
| 952 | |||
| 953 |
2/2✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 74880 times.
|
79560 | DO JRTM=1,16 |
| 954 |
2/2✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 74880 times.
|
74510280 | DO JL = KIDIA,KFDIA |
| 955 | 74430720 | ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB | |
| 956 | ZMSALD = 0.0_JPRB | ||
| 957 | ZMSAID = 0.0_JPRB | ||
| 958 | |||
| 959 |
2/2✓ Branch 0 taken 17472592 times.
✓ Branch 1 taken 56958128 times.
|
74505600 | IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN |
| 960 | |||
| 961 |
1/2✓ Branch 0 taken 17472592 times.
✗ Branch 1 not taken.
|
17472592 | IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN |
| 962 | ! water cloud total emissivity a la Smith and Shi (1992) | ||
| 963 | 17472592 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) | |
| 964 | 17472592 | ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB | |
| 965 | |||
| 966 | ✗ | ELSEIF (NLIQOPT == 1) THEN | |
| 967 | ! water cloud spectral emissivity a la Savijarvi (1997) | ||
| 968 | ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)& | ||
| 969 | ✗ | & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) | |
| 970 | |||
| 971 | ✗ | ELSEIF (NLIQOPT == 2) THEN | |
| 972 | ! water cloud spectral emissivity a la Lindner and Li (2000) | ||
| 973 | ✗ | Z1RADL = 1.0_JPRB / ZRADLP(JL) | |
| 974 | ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*& | ||
| 975 | & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*& | ||
| 976 | ✗ | & RLILIA(JRTM,5) )) | |
| 977 | Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) & | ||
| 978 | ✗ | & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) ) | |
| 979 | ✗ | ZRSALD = Z1MOMG * ZEXTCF | |
| 980 | ENDIF | ||
| 981 | |||
| 982 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17472592 times.
|
17472592 | IF (NICEOPT == 0) THEN |
| 983 | ! ice cloud spectral emissivity a la Smith & Shi (1992) | ||
| 984 | ✗ | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) | |
| 985 | ✗ | ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB | |
| 986 | |||
| 987 |
1/2✓ Branch 0 taken 17472592 times.
✗ Branch 1 not taken.
|
17472592 | ELSEIF (NICEOPT == 1) THEN |
| 988 | ! ice cloud spectral emissivity a la Ebert-Curry (1992) | ||
| 989 | 17472592 | ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL) | |
| 990 | |||
| 991 | ✗ | ELSEIF (NICEOPT == 2) THEN | |
| 992 | ! ice cloud spectral emissivity a la Fu & Liou (1993) | ||
| 993 | ✗ | Z1RADI = 1.0_JPRB / ZDESR(JL) | |
| 994 | ZRSAID = RFULIO(JRTM,1) + Z1RADI & | ||
| 995 | ✗ | & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3)) | |
| 996 | |||
| 997 | ✗ | ELSEIF (NICEOPT == 3) THEN | |
| 998 | ! ice cloud spectral emissivity a la Fu et al (1998) including | ||
| 999 | ! parametrisation for LW scattering effect | ||
| 1000 | ✗ | Z1RADI = 1.0_JPRB / ZDESR(JL) | |
| 1001 | ZRSAIE = RFUETA(JRTM,1) + Z1RADI & | ||
| 1002 | ✗ | &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3)) | |
| 1003 | ✗ | ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4)))) | |
| 1004 | ✗ | ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4))) | |
| 1005 | ✗ | ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) ) | |
| 1006 | ✗ | ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE | |
| 1007 | ENDIF | ||
| 1008 | |||
| 1009 | 17472592 | ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL) | |
| 1010 | |||
| 1011 | ! Diffusivity correction within clouds a la Savijarvi | ||
| 1012 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 17472592 times.
|
17472592 | IF (LDIFFC) THEN |
| 1013 | ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), & | ||
| 1014 | ✗ | & 2.0_JPRB) | |
| 1015 | ELSE | ||
| 1016 | ZDIFFD=1.66_JPRB | ||
| 1017 | ENDIF | ||
| 1018 | |||
| 1019 | 17472592 | ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD | |
| 1020 | ENDIF | ||
| 1021 | |||
| 1022 | ENDDO | ||
| 1023 | ENDDO | ||
| 1024 | |||
| 1025 | ENDIF | ||
| 1026 | |||
| 1027 | ENDDO | ||
| 1028 | |||
| 1029 | 120 | NUAER = NUA | |
| 1030 | 120 | NTRAER = NTRA | |
| 1031 | |||
| 1032 | ! ------------------------------------------------------------------ | ||
| 1033 | ! | ||
| 1034 | ! 2.6 SCALING OF OPTICAL THICKNESS | ||
| 1035 | ! SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY | ||
| 1036 | |||
| 1037 | 120 | JEXPLR=NLAYINH | |
| 1038 | 120 | JXPLDN=2*JEXPLR+1 | |
| 1039 | |||
| 1040 |
1/2✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
|
120 | IF (NINHOM == 1) THEN |
| 1041 | !-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW | ||
| 1042 |
2/2✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
|
840 | DO JSW=1,NSW |
| 1043 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28920 | DO JK=1,KLEV |
| 1044 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO JL=KIDIA,KFDIA |
| 1045 | 27939600 | ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF | |
| 1046 | ENDDO | ||
| 1047 | ENDDO | ||
| 1048 | ENDDO | ||
| 1049 | |||
| 1050 |
2/2✓ Branch 0 taken 120 times.
✓ Branch 1 taken 1920 times.
|
2040 | DO JRTM=1,16 |
| 1051 |
2/2✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
|
76920 | DO JK=1,KLEV |
| 1052 |
2/2✓ Branch 0 taken 74430720 times.
✓ Branch 1 taken 74880 times.
|
74507520 | DO JL=KIDIA,KFDIA |
| 1053 | 74505600 | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF | |
| 1054 | ENDDO | ||
| 1055 | ENDDO | ||
| 1056 | ENDDO | ||
| 1057 | |||
| 1058 | ✗ | ELSEIF (JEXPLR /= 0) THEN | |
| 1059 | ✗ | DO JSW=1,NSW | |
| 1060 | ✗ | DO JK=1,KLEV | |
| 1061 | ✗ | DO JL=KIDIA,KFDIA | |
| 1062 | ✗ | ZSQUAR(JL,JK)=0.0_JPRB | |
| 1063 | ✗ | ZVARIA(JL,JK)=1.0_JPRB | |
| 1064 | ENDDO | ||
| 1065 | ENDDO | ||
| 1066 | !-- range should be defined from Hogan & Illingworth | ||
| 1067 | ✗ | DO JK=1+JEXPLR,KLEV-JEXPLR | |
| 1068 | ✗ | DO JL=KIDIA,KFDIA | |
| 1069 | ! ZAVDP(JL)=0.0_JPRB | ||
| 1070 | ✗ | ZAVTO(JL)=0.0_JPRB | |
| 1071 | ✗ | ZSQTO(JL)=0.0_JPRB | |
| 1072 | ENDDO | ||
| 1073 | ✗ | DO JKI=JK-JEXPLR,JK+JEXPLR | |
| 1074 | IKI=KLEV+1-JKI | ||
| 1075 | ✗ | DO JL=KIDIA,KFDIA | |
| 1076 | ! ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG | ||
| 1077 | ✗ | ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI) | |
| 1078 | ENDDO | ||
| 1079 | ENDDO | ||
| 1080 | ✗ | DO JL=KIDIA,KFDIA | |
| 1081 | ! ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL) | ||
| 1082 | ✗ | ZAVTO(JL)=ZAVTO(JL)/JXPLDN | |
| 1083 | ENDDO | ||
| 1084 | ✗ | DO JKI=JK-JEXPLR,JK+JEXPLR | |
| 1085 | IKI=KLEV+1-JKI | ||
| 1086 | ✗ | DO JL=KIDIA,KFDIA | |
| 1087 | ! ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2 | ||
| 1088 | ✗ | ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2 | |
| 1089 | ENDDO | ||
| 1090 | ENDDO | ||
| 1091 | ✗ | DO JL=KIDIA,KFDIA | |
| 1092 | ✗ | ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1))) | |
| 1093 | ✗ | IF (ZAVTO(JL) > 0.0_JPRB) THEN | |
| 1094 | ✗ | ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2 | |
| 1095 | ✗ | ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK)) | |
| 1096 | ELSE | ||
| 1097 | ✗ | ZVARIA(JL,JK)=0.0_JPRB | |
| 1098 | ✗ | ZSQUAR(JL,JK)=1.0_JPRB | |
| 1099 | ENDIF | ||
| 1100 | |||
| 1101 | !-- scaling a la Barker | ||
| 1102 | ✗ | IF (NINHOM ==2) THEN | |
| 1103 | ✗ | ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK) | |
| 1104 | |||
| 1105 | !-- scaling a la Cairns et al. | ||
| 1106 | ✗ | ELSEIF (NINHOM == 3) THEN | |
| 1107 | ✗ | ZVI=ZVARIA(JL,JK) | |
| 1108 | ✗ | ZTAU(JL,JSW,JK) = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI) | |
| 1109 | ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) & | ||
| 1110 | ✗ | & /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) ) | |
| 1111 | ZCG(JL,JSW,JK) = ZCG(JL,JSW,JK) & | ||
| 1112 | & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) & | ||
| 1113 | ✗ | & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK))) | |
| 1114 | ENDIF | ||
| 1115 | ENDDO | ||
| 1116 | ! JL=KIDIA | ||
| 1117 | ! print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK) | ||
| 1118 | 9261 format(1x,'Varia1 ',2I3,7F10.4) | ||
| 1119 | ENDDO | ||
| 1120 | ENDDO | ||
| 1121 | |||
| 1122 | |||
| 1123 | ✗ | DO JRTM=1,16 | |
| 1124 | ✗ | DO JK=1,KLEV | |
| 1125 | ✗ | DO JL=KIDIA,KFDIA | |
| 1126 | ✗ | ZSQUAR(JL,JK)=0.0_JPRB | |
| 1127 | ✗ | ZVARIA(JL,JK)=1.0_JPRB | |
| 1128 | ENDDO | ||
| 1129 | ENDDO | ||
| 1130 | !-- range to be defined from Hogan & Illingworth | ||
| 1131 | ✗ | DO JK=1+JEXPLR,KLEV-JEXPLR | |
| 1132 | ✗ | DO JL=KIDIA,KFDIA | |
| 1133 | ! ZAVDP(JL)=0.0_JPRB | ||
| 1134 | ✗ | ZAVTO(JL)=0.0_JPRB | |
| 1135 | ✗ | ZSQTO(JL)=0.0_JPRB | |
| 1136 | ENDDO | ||
| 1137 | ✗ | DO JKI=JK-JEXPLR,JK+JEXPLR | |
| 1138 | IKI=KLEV+1-JKI | ||
| 1139 | ✗ | DO JL=KIDIA,KFDIA | |
| 1140 | ! ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG | ||
| 1141 | ✗ | ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM) | |
| 1142 | ENDDO | ||
| 1143 | ENDDO | ||
| 1144 | ✗ | DO JL=KIDIA,KFDIA | |
| 1145 | ! ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL) | ||
| 1146 | ✗ | ZAVTO(JL)=ZAVTO(JL)/JXPLDN | |
| 1147 | ENDDO | ||
| 1148 | ✗ | DO JKI=JK-JEXPLR,JK+JEXPLR | |
| 1149 | IKI=KLEV+1-JKI | ||
| 1150 | ✗ | DO JL=KIDIA,KFDIA | |
| 1151 | ! ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2 | ||
| 1152 | ✗ | ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2 | |
| 1153 | ENDDO | ||
| 1154 | ENDDO | ||
| 1155 | ✗ | DO JL=KIDIA,KFDIA | |
| 1156 | ✗ | ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1))) | |
| 1157 | ✗ | IF (ZAVTO(JL) > 0.0_JPRB) THEN | |
| 1158 | ✗ | ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2 | |
| 1159 | ✗ | ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK)) | |
| 1160 | ELSE | ||
| 1161 | ✗ | ZVARIA(JL,JK)=0.0_JPRB | |
| 1162 | ✗ | ZSQUAR(JL,JK)=1.0_JPRB | |
| 1163 | ENDIF | ||
| 1164 | |||
| 1165 | !-- scaling a la Barker | ||
| 1166 | ✗ | IF (NINHOM ==2) THEN | |
| 1167 | ✗ | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK) | |
| 1168 | |||
| 1169 | !-- scaling a la Cairns et al. | ||
| 1170 | ✗ | ELSEIF (NINHOM == 3) THEN | |
| 1171 | ✗ | ZVI=ZVARIA(JL,JK) | |
| 1172 | ✗ | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI) | |
| 1173 | ENDIF | ||
| 1174 | ENDDO | ||
| 1175 | ! JL=KIDIA | ||
| 1176 | ! print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK) | ||
| 1177 | 9262 format(1x,'Varia2 ',2I3,7F10.4) | ||
| 1178 | ENDDO | ||
| 1179 | ENDDO | ||
| 1180 | ENDIF | ||
| 1181 | |||
| 1182 | |||
| 1183 | |||
| 1184 | ! ------------------------------------------------------------------ | ||
| 1185 | ! | ||
| 1186 | !* 2.7 DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE | ||
| 1187 | ! --------------------------------------------- | ||
| 1188 | |||
| 1189 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL = KIDIA,KFDIA |
| 1190 | 119400 | ZVIEW(JL) = DIFF | |
| 1191 | ENDDO | ||
| 1192 | |||
| 1193 | ! ------------------------------------------------------------------ | ||
| 1194 | |||
| 1195 | !* 3. CALL LONGWAVE RADIATION CODE | ||
| 1196 | ! ---------------------------- | ||
| 1197 | |||
| 1198 | !* 3.1 FULL LONGWAVE RADIATION COMPUTATIONS | ||
| 1199 | ! ------------------------------------ | ||
| 1200 | |||
| 1201 | !print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM | ||
| 1202 |
1/2✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
|
120 | IF (.NOT.LPHYLIN) THEN |
| 1203 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 120 times.
|
120 | IF ( .NOT. LRRTM) THEN |
| 1204 | |||
| 1205 | CALL LW & | ||
| 1206 | & ( KIDIA , KFDIA , KLON , KLEV , KMODE,& | ||
| 1207 | & PCCO2 , ZCLDLD, ZCLDLU,& | ||
| 1208 | & PDP , ZDT0 , ZEMIS , ZEMIW,& | ||
| 1209 | & ZPMB , POZON , ZTL,& | ||
| 1210 | & PAER , ZTAVE , ZVIEW , PQ,& | ||
| 1211 | & ZEMIT , PFLUX , PFLUC & | ||
| 1212 | ✗ | & ) | |
| 1213 | ! print *,'RADLSW: apres CALL LW' | ||
| 1214 | IF(LLDEBUG) THEN | ||
| 1215 | call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1) | ||
| 1216 | call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1) | ||
| 1217 | call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1) | ||
| 1218 | call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1) | ||
| 1219 | ENDIF | ||
| 1220 | |||
| 1221 | ELSE | ||
| 1222 | |||
| 1223 | !* 3.2 FULL LONGWAVE RADIATION COMPUTATIONS - RRTM | ||
| 1224 | ! ------------------------------------ ---- | ||
| 1225 | |||
| 1226 | ! i) pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure | ||
| 1227 | ! weighting applied to POZON in driverMC (below) | ||
| 1228 | ! ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM | ||
| 1229 | ! iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM, | ||
| 1230 | ! computed from equations above | ||
| 1231 | ! iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM | ||
| 1232 | ! in module rrtm_ecrt.f | ||
| 1233 | |||
| 1234 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL = KIDIA,KFDIA |
| 1235 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
|
4771320 | DO JK = 1, KLEV |
| 1236 | 4771200 | ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK) | |
| 1237 | ENDDO | ||
| 1238 | ENDDO | ||
| 1239 | |||
| 1240 | ! print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:) | ||
| 1241 | CALL RRTM_RRTM_140GP & | ||
| 1242 | & ( KIDIA , KFDIA , KLON , KLEV,& | ||
| 1243 | & PAER , PAPH , PAP,& | ||
| 1244 | & PTS , PTH , PT,& | ||
| 1245 | & ZEMIS , ZEMIW,& | ||
| 1246 | & PQ , PCCO2 , ZOZN ,& | ||
| 1247 | & ZCLDSW , ZTAUCLD,& | ||
| 1248 | & PTAU_LW,& | ||
| 1249 | 120 | & ZEMIT , PFLUX , PFLUC , ZTCLEAR ) | |
| 1250 | ! print *,'RADLSW: apres CALL RRTM_RRTM_140GP' | ||
| 1251 | |||
| 1252 | ENDIF | ||
| 1253 | ELSE | ||
| 1254 | ✗ | ZEMIT (:) = 0.0_JPRB | |
| 1255 | ✗ | PFLUX(:,:,:)= 0.0_JPRB | |
| 1256 | ✗ | PFLUC(:,:,:)= 0.0_JPRB | |
| 1257 | ! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0' | ||
| 1258 | ENDIF | ||
| 1259 | |||
| 1260 | ! ------------------------------------------------------------------ | ||
| 1261 | |||
| 1262 | !* 4. CALL SHORTWAVE RADIATION CODE | ||
| 1263 | ! ----------------------------- | ||
| 1264 | |||
| 1265 | ZRMUZ=0.0_JPRB | ||
| 1266 | DO JL = KIDIA,KFDIA | ||
| 1267 | ZRMUZ = MAX (ZRMUZ, ZMU0(JL)) | ||
| 1268 | ENDDO | ||
| 1269 | |||
| 1270 |
2/6✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
120 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
| 1271 | ✗ | WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA) | |
| 1272 | ✗ | WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW) | |
| 1273 | ✗ | WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW) | |
| 1274 | ✗ | WRITE(NULOUT,'("PQ ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV) | |
| 1275 | ✗ | WRITE(NULOUT,'("PQS ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV) | |
| 1276 | ✗ | WRITE(NULOUT,'("PDP ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV) | |
| 1277 | ✗ | WRITE(NULOUT,'("ZPMB ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1) | |
| 1278 | ✗ | WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV) | |
| 1279 | ✗ | WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV) | |
| 1280 | ✗ | WRITE(NULOUT,'("ZTAU ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1281 | ✗ | WRITE(NULOUT,'("ZCG ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1282 | ✗ | WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1283 | ✗ | WRITE(NULOUT,'("ZOZ ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV) | |
| 1284 | ✗ | WRITE(NULOUT,'("PAER ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1285 | ENDIF | ||
| 1286 | |||
| 1287 |
2/6✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
120 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
| 1288 | ✗ | WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA) | |
| 1289 | ✗ | WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW) | |
| 1290 | ✗ | WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW) | |
| 1291 | ✗ | WRITE(NULOUT,'("PQ ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV) | |
| 1292 | ✗ | WRITE(NULOUT,'("PQS ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV) | |
| 1293 | ✗ | WRITE(NULOUT,'("PDP ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV) | |
| 1294 | ✗ | WRITE(NULOUT,'("ZPMB ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1) | |
| 1295 | ✗ | WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV) | |
| 1296 | ✗ | WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV) | |
| 1297 | ✗ | WRITE(NULOUT,'("ZTAU ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1298 | ✗ | WRITE(NULOUT,'("ZCG ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1299 | ✗ | WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1300 | ✗ | WRITE(NULOUT,'("ZOZ ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV) | |
| 1301 | ✗ | WRITE(NULOUT,'("PAER ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) | |
| 1302 | ENDIF | ||
| 1303 | CALL SW & | ||
| 1304 | & ( KIDIA , KFDIA , KLON , KLEV , KAER,& | ||
| 1305 | & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ , PQS,& | ||
| 1306 | & ZMU0 , ZCG , ZCLDSW, PDP , ZOMEGA, ZOZ , ZPMB,& | ||
| 1307 | & ZTAU , ZTAVE , PAER,& | ||
| 1308 | & PFSDN , PFSUP , PFSCDN, PFSCUP,& | ||
| 1309 | & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,& | ||
| 1310 | & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,& | ||
| 1311 | & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, & | ||
| 1312 | & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST& | ||
| 1313 | 120 | & ) | |
| 1314 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | PFSDNV=ZFSDNV |
| 1315 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | PFSDNN=ZFSDNN |
| 1316 |
1/2✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
|
120 | IF (SIZE(PSFSWDIR,2)>1) THEN |
| 1317 |
4/4✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 715680 times.
✓ Branch 3 taken 720 times.
|
716520 | PSFSWDIR= ZDIRFS |
| 1318 |
4/4✓ Branch 0 taken 720 times.
✓ Branch 1 taken 120 times.
✓ Branch 2 taken 715680 times.
✓ Branch 3 taken 720 times.
|
716520 | PSFSWDIF= ZDIFFS |
| 1319 | ELSE | ||
| 1320 | ✗ | PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:) | |
| 1321 | ✗ | PSFSWDIF (:,:) = 0. | |
| 1322 | ENDIF | ||
| 1323 | |||
| 1324 |
2/6✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
120 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
| 1325 | ✗ | WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV) | |
| 1326 | ✗ | WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV) | |
| 1327 | ✗ | WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV) | |
| 1328 | ✗ | WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV) | |
| 1329 | ✗ | LEDBUG=.FALSE. | |
| 1330 | ENDIF | ||
| 1331 |
2/6✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 120 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
120 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
| 1332 | ✗ | WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV) | |
| 1333 | ✗ | WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV) | |
| 1334 | ✗ | WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV) | |
| 1335 | ✗ | WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV) | |
| 1336 | ✗ | LEDBUG=.FALSE. | |
| 1337 | ENDIF | ||
| 1338 | ! ------------------------------------------------------------------ | ||
| 1339 | |||
| 1340 | !* 5. FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES | ||
| 1341 | ! ------------------------------------------------ | ||
| 1342 | |||
| 1343 |
2/2✓ Branch 0 taken 4800 times.
✓ Branch 1 taken 120 times.
|
4920 | DO JKL = 1 , KLEV+1 |
| 1344 | 4800 | JK = KLEV+1 + 1 - JKL | |
| 1345 |
2/2✓ Branch 0 taken 4771200 times.
✓ Branch 1 taken 4800 times.
|
4776120 | DO JL = KIDIA,KFDIA |
| 1346 | 4771200 | PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK) | |
| 1347 | 4771200 | PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK) | |
| 1348 | 4771200 | PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK) | |
| 1349 | 4776000 | PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK) | |
| 1350 | ENDDO | ||
| 1351 | ENDDO | ||
| 1352 | |||
| 1353 |
2/2✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
|
119400 | DO JL = KIDIA,KFDIA |
| 1354 | 119280 | PFRSOD(JL)=ZFSDWN(JL,1) | |
| 1355 | 119280 | PEMIT (JL)=ZEMIT (JL) | |
| 1356 | 119280 | PSUDU (JL)=ZSUDU (JL) | |
| 1357 | 119280 | PUVDF (JL)=ZUVDF (JL) | |
| 1358 | 119280 | PPARF (JL)=ZPARF (JL) | |
| 1359 | 119280 | PPARCF(JL)=ZPARCF(JL) | |
| 1360 | 119400 | PTINCF(JL)=PRII0 * ZMU0(JL) | |
| 1361 | ENDDO | ||
| 1362 | !print 9501,(PUVDF(JL),JL=KIDIA,KFDIA) | ||
| 1363 | 9501 format(1x,'RADLSW PUVDF: ',30f6.1) | ||
| 1364 | !print 9502,(PPARF(JL),JL=KIDIA,KFDIA) | ||
| 1365 | 9502 format(1x,'RADLSW PPARF: ',30f6.1) | ||
| 1366 | |||
| 1367 | ! -------------------------------------------------------------- | ||
| 1368 | |||
| 1369 |
1/2✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
|
120 | IF (LHOOK) CALL DR_HOOK('RADLSW',1,ZHOOK_HANDLE) |
| 1370 | 120 | END SUBROUTINE RADLSW | |
| 1371 | |||
| 1372 | |||
| 1373 | |||
| 1374 | |||
| 1375 | |||
| 1376 | |||
| 1377 | |||
| 1378 | |||
| 1379 | |||
| 1380 | |||
| 1381 | |||
| 1382 | |||
| 1383 | |||
| 1384 | |||
| 1385 | |||
| 1386 | |||
| 1387 | |||
| 1388 | |||
| 1389 | |||
| 1390 | |||
| 1391 | |||
| 1392 | |||
| 1393 | |||
| 1394 | |||
| 1395 | |||
| 1396 | |||
| 1397 | |||
| 1398 | |||
| 1399 | |||
| 1400 | |||
| 1401 | |||
| 1402 | |||
| 1403 | |||
| 1404 | |||
| 1405 |