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