| 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,& |
|---|
| 14 | & PTAU_LW,& |
|---|
| 15 | & 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 | INTEGER(KIND=JPIM) :: IBAS(KLON) , ITOP(KLON) |
|---|
| 238 | |
|---|
| 239 | REAL(KIND=JPRB) ::& |
|---|
| 240 | & ZALBD(KLON,NSW) , ZALBP(KLON,NSW)& |
|---|
| 241 | & , ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)& |
|---|
| 242 | & , ZTAU (KLON,NSW,KLEV) & |
|---|
| 243 | & , ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON) |
|---|
| 244 | REAL(KIND=JPRB) ::& |
|---|
| 245 | & ZCLDLD(KLON,KLEV) , ZCLDLU(KLON,KLEV)& |
|---|
| 246 | & , ZCLDSW(KLON,KLEV) , ZCLD0(KLON,KLEV)& |
|---|
| 247 | & , ZDT0(KLON) & |
|---|
| 248 | & , ZEMIS(KLON) , ZEMIW(KLON)& |
|---|
| 249 | & , ZFIWP(KLON) , ZFLWP(KLON) , ZFRWP(KLON)& |
|---|
| 250 | & , ZIWC(KLON) , ZLWC(KLON)& |
|---|
| 251 | !cc , ZRWC(KLON) |
|---|
| 252 | & , ZMU0(KLON) , ZOZ(KLON,KLEV) , ZOZN(KLON,KLEV)& |
|---|
| 253 | & , ZPMB(KLON,KLEV+1) , ZPSOL(KLON)& |
|---|
| 254 | & , ZTAVE (KLON,KLEV) , ZTL(KLON,KLEV+1)& |
|---|
| 255 | & , ZVIEW(KLON) |
|---|
| 256 | REAL(KIND=JPRB) ::& |
|---|
| 257 | & ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)& |
|---|
| 258 | & , ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)& |
|---|
| 259 | & , ZFSUPN(KLON) , ZFSUPV(KLON)& |
|---|
| 260 | & , ZFCUPN(KLON) , ZFCUPV(KLON)& |
|---|
| 261 | & , ZFSDNN(KLON) , ZFSDNV(KLON)& |
|---|
| 262 | & , ZFCDNN(KLON) , ZFCDNV(KLON)& |
|---|
| 263 | & , ZDIRFS(KLON,NSW) , ZDIFFS(KLON,NSW) |
|---|
| 264 | REAL(KIND=JPRB) ::& |
|---|
| 265 | & ZALFICE(KLON) , ZGAMICE(KLON) , ZBICE(KLON) , ZDESR(KLON)& |
|---|
| 266 | & , ZRADIP(KLON) , ZRADLP(KLON) & |
|---|
| 267 | !cc , ZRADRD(KLON) |
|---|
| 268 | & , ZRAINT(KLON) , ZRES(KLON)& |
|---|
| 269 | & , ZTICE(KLON) , ZEMIT(KLON), ZBICFU(KLON)& |
|---|
| 270 | & , ZKICFU(KLON) |
|---|
| 271 | 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 | REAL(KIND=JPRB) :: ZAVTO(KLON), ZSQTO(KLON) |
|---|
| 287 | 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 | #include "lw.intfb.h" |
|---|
| 295 | #include "rrtm_rrtm_140gp.intfb.h" |
|---|
| 296 | #include "sw.intfb.h" |
|---|
| 297 | |
|---|
| 298 | ! ----------------------------------------------------------------- |
|---|
| 299 | |
|---|
| 300 | !* 1. SET-UP INPUT QUANTITIES FOR RADIATION |
|---|
| 301 | ! ------------------------------------- |
|---|
| 302 | |
|---|
| 303 | IF (LHOOK) CALL DR_HOOK('RADLSW',0,ZHOOK_HANDLE) |
|---|
| 304 | |
|---|
| 305 | LLDEBUG=.FALSE. |
|---|
| 306 | ZRefDe = RRe2De |
|---|
| 307 | ZDefRe = 1.0_JPRB / ZRefDe |
|---|
| 308 | |
|---|
| 309 | DO JL = KIDIA,KFDIA |
|---|
| 310 | ZFCUP(JL,KLEV+1) = 0.0_JPRB |
|---|
| 311 | ZFCDWN(JL,KLEV+1) = REPLOG |
|---|
| 312 | ZFSUP(JL,KLEV+1) = 0.0_JPRB |
|---|
| 313 | ZFSDWN(JL,KLEV+1) = REPLOG |
|---|
| 314 | PFLUX(JL,1,KLEV+1) = 0.0_JPRB |
|---|
| 315 | PFLUX(JL,2,KLEV+1) = 0.0_JPRB |
|---|
| 316 | PFLUC(JL,1,KLEV+1) = 0.0_JPRB |
|---|
| 317 | PFLUC(JL,2,KLEV+1) = 0.0_JPRB |
|---|
| 318 | ZFSDNN(JL) = 0.0_JPRB |
|---|
| 319 | ZFSDNV(JL) = 0.0_JPRB |
|---|
| 320 | ZFCDNN(JL) = 0.0_JPRB |
|---|
| 321 | ZFCDNV(JL) = 0.0_JPRB |
|---|
| 322 | ZFSUPN(JL) = 0.0_JPRB |
|---|
| 323 | ZFSUPV(JL) = 0.0_JPRB |
|---|
| 324 | ZFCUPN(JL) = 0.0_JPRB |
|---|
| 325 | ZFCUPV(JL) = 0.0_JPRB |
|---|
| 326 | ZPSOL(JL) = PAPH(JL,KLEV+1) |
|---|
| 327 | ZPMB(JL,1) = ZPSOL(JL) / 100.0_JPRB |
|---|
| 328 | ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1) |
|---|
| 329 | PSUDU(JL) = 0.0_JPRB |
|---|
| 330 | PPARF(JL) = 0.0_JPRB |
|---|
| 331 | PPARCF(JL)= 0.0_JPRB |
|---|
| 332 | PUVDF(JL) = 0.0_JPRB |
|---|
| 333 | PSFSWDIR(JL,:)=0.0_JPRB |
|---|
| 334 | PSFSWDIF(JL,:)=0.0_JPRB |
|---|
| 335 | IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) ) |
|---|
| 336 | ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) ) |
|---|
| 337 | ENDDO |
|---|
| 338 | |
|---|
| 339 | !* 1.1 INITIALIZE VARIOUS FIELDS |
|---|
| 340 | ! ------------------------- |
|---|
| 341 | |
|---|
| 342 | DO JSW=1,NSW |
|---|
| 343 | DO JL = KIDIA,KFDIA |
|---|
| 344 | ZALBD(JL,JSW)=PALBD(JL,JSW) |
|---|
| 345 | ZALBP(JL,JSW)=PALBP(JL,JSW) |
|---|
| 346 | ENDDO |
|---|
| 347 | ENDDO |
|---|
| 348 | DO JL = KIDIA,KFDIA |
|---|
| 349 | ZEMIS(JL) =PEMIS(JL) |
|---|
| 350 | ZEMIW(JL) =PEMIW(JL) |
|---|
| 351 | ZMU0(JL) =PMU0(JL) |
|---|
| 352 | ENDDO |
|---|
| 353 | |
|---|
| 354 | DO JK = 1 , KLEV |
|---|
| 355 | JKP1 = JK + 1 |
|---|
| 356 | JKL = KLEV+ 1 - JK |
|---|
| 357 | JKLP1 = JKL + 1 |
|---|
| 358 | DO JL = KIDIA,KFDIA |
|---|
| 359 | ZPMB(JL,JK+1)=PAPH(JL,JKL)/100.0_JPRB |
|---|
| 360 | |
|---|
| 361 | !-- ZOZ in cm.atm for SW scheme |
|---|
| 362 | ZOZ(JL,JK) = POZON(JL,JKL) * 46.6968_JPRB / RG |
|---|
| 363 | |
|---|
| 364 | ZCLD0(JL,JK) = 0.0_JPRB |
|---|
| 365 | ZFCUP(JL,JK) = 0.0_JPRB |
|---|
| 366 | ZFCDWN(JL,JK) = 0.0_JPRB |
|---|
| 367 | ZFSUP(JL,JK) = 0.0_JPRB |
|---|
| 368 | ZFSDWN(JL,JK) = 0.0_JPRB |
|---|
| 369 | PFLUX(JL,1,JK) = 0.0_JPRB |
|---|
| 370 | PFLUX(JL,2,JK) = 0.0_JPRB |
|---|
| 371 | PFLUC(JL,1,JK) = 0.0_JPRB |
|---|
| 372 | PFLUC(JL,2,JK) = 0.0_JPRB |
|---|
| 373 | ENDDO |
|---|
| 374 | ENDDO |
|---|
| 375 | |
|---|
| 376 | DO JK=1,KLEV |
|---|
| 377 | JKL=KLEV+1-JK |
|---|
| 378 | JKLP1=JKL+1 |
|---|
| 379 | DO JL=KIDIA,KFDIA |
|---|
| 380 | ZTL(JL,JK)=PTH(JL,JKLP1) |
|---|
| 381 | ZTAVE(JL,JK)=PT(JL,JKL) |
|---|
| 382 | ENDDO |
|---|
| 383 | ENDDO |
|---|
| 384 | DO JL=KIDIA,KFDIA |
|---|
| 385 | ZTL(JL,KLEV+1)= PTH(JL,1) |
|---|
| 386 | ZPMB(JL,KLEV+1) = PAPH(JL,1)/100.0_JPRB |
|---|
| 387 | ENDDO |
|---|
| 388 | !*** |
|---|
| 389 | |
|---|
| 390 | ! ------------------------------------------------------------------ |
|---|
| 391 | |
|---|
| 392 | !* 2. CLOUD AND AEROSOL PARAMETERS |
|---|
| 393 | ! ---------------------------- |
|---|
| 394 | |
|---|
| 395 | DO JK = 1 , KLEV |
|---|
| 396 | IKL = KLEV + 1 - JK |
|---|
| 397 | |
|---|
| 398 | ! 2.1 INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES |
|---|
| 399 | ! ------------------------------------------------- |
|---|
| 400 | |
|---|
| 401 | DO JSW = 1,NSW |
|---|
| 402 | DO JL = KIDIA,KFDIA |
|---|
| 403 | ZTAU(JL,JSW,JK) = 0.0_JPRB |
|---|
| 404 | ZOMEGA(JL,JSW,JK)= 1.0_JPRB |
|---|
| 405 | ZCG(JL,JSW,JK) = 0.0_JPRB |
|---|
| 406 | ENDDO |
|---|
| 407 | ENDDO |
|---|
| 408 | DO JL = KIDIA,KFDIA |
|---|
| 409 | ZCLDSW(JL,JK) = 0.0_JPRB |
|---|
| 410 | ZCLDLD(JL,JK) = 0.0_JPRB |
|---|
| 411 | ZCLDLU(JL,JK) = 0.0_JPRB |
|---|
| 412 | ENDDO |
|---|
| 413 | |
|---|
| 414 | ! 2.2 CLOUD ICE AND LIQUID CONTENT AND PATH |
|---|
| 415 | ! ------------------------------------- |
|---|
| 416 | |
|---|
| 417 | DO JL = KIDIA,KFDIA |
|---|
| 418 | |
|---|
| 419 | ! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) |
|---|
| 420 | IF (PCLFR(JL,IKL) > REPSC ) THEN |
|---|
| 421 | ZLWGKG=MAX(PQLWP(JL,IKL)*1000.0_JPRB,0.0_JPRB) |
|---|
| 422 | ZIWGKG=MAX(PQIWP(JL,IKL)*1000.0_JPRB,0.0_JPRB) |
|---|
| 423 | ZLWGKG=ZLWGKG/PCLFR(JL,IKL) |
|---|
| 424 | ZIWGKG=ZIWGKG/PCLFR(JL,IKL) |
|---|
| 425 | ELSE |
|---|
| 426 | ZLWGKG=0.0_JPRB |
|---|
| 427 | ZIWGKG=0.0_JPRB |
|---|
| 428 | ENDIF |
|---|
| 429 | ZRWGKG=0.0_JPRB |
|---|
| 430 | ZRAINT(JL)=0.0_JPRB |
|---|
| 431 | |
|---|
| 432 | ! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2) |
|---|
| 433 | ! IF (PRAINT(JL,IKL) >= REPSCW) THEN |
|---|
| 434 | ! ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0) |
|---|
| 435 | ! ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000. |
|---|
| 436 | !- no radiative effect of rain (for the moment) |
|---|
| 437 | ! ZRWGKG=0. |
|---|
| 438 | ! ZRAINT(JL)=0. |
|---|
| 439 | ! =========================================================== |
|---|
| 440 | |
|---|
| 441 | ! Modifications Martin et al. |
|---|
| 442 | ! ELSE |
|---|
| 443 | ! ENDIF |
|---|
| 444 | ZDPOG=PDP(JL,IKL)/RG |
|---|
| 445 | ZFLWP(JL)= ZLWGKG*ZDPOG |
|---|
| 446 | ZFIWP(JL)= ZIWGKG*ZDPOG |
|---|
| 447 | ZFRWP(JL)= ZRWGKG*ZDPOG |
|---|
| 448 | ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL)) |
|---|
| 449 | ZLWC(JL)=ZLWGKG*ZPODT |
|---|
| 450 | ZIWC(JL)=ZIWGKG*ZPODT |
|---|
| 451 | ! ZRWC(JL)=ZRWGKG*ZPODT |
|---|
| 452 | |
|---|
| 453 | ENDDO |
|---|
| 454 | DO JL = KIDIA,KFDIA |
|---|
| 455 | ! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES |
|---|
| 456 | |
|---|
| 457 | ! very old parametrization as f(pressure) |
|---|
| 458 | |
|---|
| 459 | IF (NRADLP == 0) THEN |
|---|
| 460 | !-- very old parametrization as f(pressure) ERA-15 |
|---|
| 461 | ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,IKL))*3.5_JPRB |
|---|
| 462 | |
|---|
| 463 | ELSEIF (NRADLP == 1) THEN |
|---|
| 464 | ! simple distinction between land (10) and ocean (13) Zhang and Rossow |
|---|
| 465 | IF (PLSM(JL) < 0.5_JPRB) THEN |
|---|
| 466 | ZRADLP(JL)=13.0_JPRB |
|---|
| 467 | ELSE |
|---|
| 468 | ZRADLP(JL)=10.0_JPRB |
|---|
| 469 | ENDIF |
|---|
| 470 | |
|---|
| 471 | ELSEIF (NRADLP == 2) THEN |
|---|
| 472 | !-- based on Martin et al., 1994, JAS |
|---|
| 473 | IF (PLSM(JL) < 0.5_JPRB) THEN |
|---|
| 474 | IF (LCCNO) THEN |
|---|
| 475 | ! ZASEA=50.0_JPRB |
|---|
| 476 | ZASEA=PCCNO(JL) |
|---|
| 477 | ELSE |
|---|
| 478 | ZASEA=RCCNSEA |
|---|
| 479 | ENDIF |
|---|
| 480 | ZD=0.33_JPRB |
|---|
| 481 | ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB |
|---|
| 482 | ELSE |
|---|
| 483 | IF (LCCNL) THEN |
|---|
| 484 | ! ZALND=900.0_JPRB |
|---|
| 485 | ZALND=PCCNL(JL) |
|---|
| 486 | ELSE |
|---|
| 487 | ZALND=RCCNLND |
|---|
| 488 | ENDIF |
|---|
| 489 | ZD=0.43_JPRB |
|---|
| 490 | ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB |
|---|
| 491 | ENDIF |
|---|
| 492 | ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2 |
|---|
| 493 | ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3 |
|---|
| 494 | IF((ZNUM/ZDEN) > REPLOG)THEN |
|---|
| 495 | ZRADLP(JL)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN)) |
|---|
| 496 | ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB) |
|---|
| 497 | ZRADLP(JL)=MIN(ZRADLP(JL),16.0_JPRB) |
|---|
| 498 | ELSE |
|---|
| 499 | ZRADLP(JL)=4.0_JPRB |
|---|
| 500 | ENDIF |
|---|
| 501 | |
|---|
| 502 | ELSEIF (NRADLP == 3) THEN |
|---|
| 503 | ! one uses the cloud droplet radius from newmicro |
|---|
| 504 | ! IKL or JK ?? - I think IKL but needs to be verified > ref_liq_i |
|---|
| 505 | ! (inverted) is used in the call of RECMWF_AERO in radlwsw_m.F90, |
|---|
| 506 | ! so everything is fine - JBM 6/2019 |
|---|
| 507 | ZRADLP(JL)=PREF_LIQ(JL,IKL) |
|---|
| 508 | ENDIF |
|---|
| 509 | |
|---|
| 510 | ! =========================================================== |
|---|
| 511 | ! ___________________________________________________________ |
|---|
| 512 | |
|---|
| 513 | ! rain drop from : unused as ZRAINT is 0. |
|---|
| 514 | ! ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB |
|---|
| 515 | ! IF (ZFLWP(JL).GT.0.) THEN |
|---|
| 516 | ! ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL) |
|---|
| 517 | ! ENDIF |
|---|
| 518 | |
|---|
| 519 | ENDDO |
|---|
| 520 | DO JL = KIDIA,KFDIA |
|---|
| 521 | |
|---|
| 522 | ! diagnosing the ice particle effective radius/diameter |
|---|
| 523 | |
|---|
| 524 | !- ice particle effective radius =f(T) from Liou and Ou (1994) |
|---|
| 525 | |
|---|
| 526 | IF (PT(JL,IKL) < RTICE) THEN |
|---|
| 527 | ZTEMPC=PT(JL,IKL)-RTT |
|---|
| 528 | ELSE |
|---|
| 529 | ZTEMPC=RTICE-RTT |
|---|
| 530 | ENDIF |
|---|
| 531 | ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*& |
|---|
| 532 | & 0.0012_JPRB)) |
|---|
| 533 | |
|---|
| 534 | IF (NRADIP == 0) THEN |
|---|
| 535 | !-- fixed 40 micron effective radius |
|---|
| 536 | ZRADIP(JL)= 40.0_JPRB |
|---|
| 537 | ZDESR(JL) = ZDefRe * ZRADIP(JL) |
|---|
| 538 | |
|---|
| 539 | ELSEIF (NRADIP == 1) THEN |
|---|
| 540 | |
|---|
| 541 | !-- old formulation based on Liou & Ou (1994) temperature (40-130microns) |
|---|
| 542 | ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB) |
|---|
| 543 | ZDESR(JL) = ZDefRe * ZRADIP(JL) |
|---|
| 544 | |
|---|
| 545 | ELSEIF (NRADIP == 2) THEN |
|---|
| 546 | !-- formulation following Jakob, Klein modifications to ice content |
|---|
| 547 | ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB) |
|---|
| 548 | ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB) |
|---|
| 549 | ZDESR(JL)= ZDefRe * ZRADIP(JL) |
|---|
| 550 | |
|---|
| 551 | ELSEIF (NRADIP == 3 ) THEN |
|---|
| 552 | |
|---|
| 553 | !- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999) |
|---|
| 554 | ! revised by Sun (2001) |
|---|
| 555 | IF (ZIWC(JL) > 0.0_JPRB ) THEN |
|---|
| 556 | ZTEMPC = PT(JL,IKL)-83.15_JPRB |
|---|
| 557 | ZTCELS = PT(JL,IKL)-RTT |
|---|
| 558 | ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS |
|---|
| 559 | ! Sun, 2001 (corrected from Sun & Rikus, 1999) |
|---|
| 560 | ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB |
|---|
| 561 | ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB |
|---|
| 562 | ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC) |
|---|
| 563 | !-new ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB) |
|---|
| 564 | ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB) |
|---|
| 565 | ZRADIP(JL)= ZRefDe * ZDESR(JL) |
|---|
| 566 | ELSE |
|---|
| 567 | ! ZDESR(JL) = 92.5_JPRB |
|---|
| 568 | ZDESR(JL) = 80.0_JPRB |
|---|
| 569 | ZRADIP(JL)= ZRefDe * ZDESR(JL) |
|---|
| 570 | ENDIF |
|---|
| 571 | |
|---|
| 572 | ELSEIF (NRADIP == 4 ) THEN |
|---|
| 573 | ! one uses the cloud droplet radius from newmicro |
|---|
| 574 | ! IKL or JK ?? - I think IKL but needs to be verified |
|---|
| 575 | ZRADIP(JL)=PREF_ICE(JL,IKL) |
|---|
| 576 | ENDIF |
|---|
| 577 | |
|---|
| 578 | ENDDO |
|---|
| 579 | |
|---|
| 580 | ! 2.3 CLOUD SHORTWAVE OPTICAL PROPERTIES |
|---|
| 581 | ! ---------------------------------- |
|---|
| 582 | |
|---|
| 583 | ! ------------------------- |
|---|
| 584 | ! --+ SW OPTICAL PARAMETERS + Water clouds after Fouquart (1987) |
|---|
| 585 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 586 | |
|---|
| 587 | DO JSW=1,NSW |
|---|
| 588 | DO JL = KIDIA,KFDIA |
|---|
| 589 | ZTOL=0.0_JPRB |
|---|
| 590 | ZGL =0.0_JPRB |
|---|
| 591 | ZOL =0.0_JPRB |
|---|
| 592 | ZTOI=0.0_JPRB |
|---|
| 593 | ZGI =0.0_JPRB |
|---|
| 594 | ZOI =0.0_JPRB |
|---|
| 595 | ZTOR=0.0_JPRB |
|---|
| 596 | ZGR =0.0_JPRB |
|---|
| 597 | ZOR =0.0_JPRB |
|---|
| 598 | IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN |
|---|
| 599 | IF (ZFLWP(JL) >= REPSCW ) THEN |
|---|
| 600 | IF (NLIQOPT /= 0 ) THEN |
|---|
| 601 | !-- SW: Slingo, 1989 |
|---|
| 602 | ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL)) |
|---|
| 603 | ZGL = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL) |
|---|
| 604 | ZOL = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL) |
|---|
| 605 | ELSE |
|---|
| 606 | !-- SW: Fouquart, 1991 |
|---|
| 607 | ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL)) |
|---|
| 608 | ZGL = RYFWCF(JSW) |
|---|
| 609 | ! ZOL = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL) |
|---|
| 610 | !-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with |
|---|
| 611 | ! the previous. Should be cleaned when RRTM_SW becomes active |
|---|
| 612 | ZOL = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF) |
|---|
| 613 | ENDIF |
|---|
| 614 | ENDIF |
|---|
| 615 | |
|---|
| 616 | IF (ZFIWP(JL) >= REPSCW ) THEN |
|---|
| 617 | IF (NICEOPT <= 1) THEN |
|---|
| 618 | !-- SW: Ebert-Curry |
|---|
| 619 | ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL)) |
|---|
| 620 | ZGI = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL) |
|---|
| 621 | ZOI = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL) |
|---|
| 622 | |
|---|
| 623 | ELSEIF (NICEOPT == 2) THEN |
|---|
| 624 | !-- SW: Fu-Liou 1993 |
|---|
| 625 | Z1RADI = 1.0_JPRB / ZDESR(JL) |
|---|
| 626 | ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW) |
|---|
| 627 | ZTOI = ZFIWP(JL) * ZBETAI |
|---|
| 628 | ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) & |
|---|
| 629 | & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) )) |
|---|
| 630 | ZOI = 1.0_JPRB - ZOMGI |
|---|
| 631 | ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) & |
|---|
| 632 | & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) )) |
|---|
| 633 | ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) & |
|---|
| 634 | & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) )) |
|---|
| 635 | ZGI = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB |
|---|
| 636 | |
|---|
| 637 | ELSEIF (NICEOPT == 3) THEN |
|---|
| 638 | !-- SW: Fu 1996 |
|---|
| 639 | Z1RADI = 1.0_JPRB / ZDESR(JL) |
|---|
| 640 | ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW) |
|---|
| 641 | ZTOI = ZFIWP(JL) * ZBETAI |
|---|
| 642 | ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) & |
|---|
| 643 | & *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) )) |
|---|
| 644 | ZOI = 1.0_JPRB - ZOMGI |
|---|
| 645 | ZGI = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) & |
|---|
| 646 | & *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) )) |
|---|
| 647 | ZGI = MIN(1.0_JPRB, ZGI) |
|---|
| 648 | |
|---|
| 649 | ENDIF |
|---|
| 650 | ENDIF |
|---|
| 651 | |
|---|
| 652 | ! IF (ZFRWP(JL) >= REPSCW ) THEN |
|---|
| 653 | ! ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB) |
|---|
| 654 | ! ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW) |
|---|
| 655 | ! ZGR = RRASY(JSW) |
|---|
| 656 | ! ENDIF |
|---|
| 657 | |
|---|
| 658 | ! - MIX of WATER and ICE CLOUDS |
|---|
| 659 | ZTAUMX= ZTOL + ZTOI + ZTOR |
|---|
| 660 | ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR |
|---|
| 661 | ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR |
|---|
| 662 | |
|---|
| 663 | ZASYMX= ZASYMX/ZOMGMX |
|---|
| 664 | ZOMGMX= ZOMGMX/ZTAUMX |
|---|
| 665 | |
|---|
| 666 | ! --- SW FINAL CLOUD OPTICAL PARAMETERS |
|---|
| 667 | |
|---|
| 668 | ZCLDSW(JL,JK) = PCLFR(JL,IKL) |
|---|
| 669 | ZTAU(JL,JSW,JK) = ZTAUMX |
|---|
| 670 | ZOMEGA(JL,JSW,JK)= ZOMGMX |
|---|
| 671 | ZCG(JL,JSW,JK) = ZASYMX |
|---|
| 672 | ENDIF |
|---|
| 673 | ENDDO |
|---|
| 674 | ENDDO |
|---|
| 675 | |
|---|
| 676 | IF(LLDEBUG) THEN |
|---|
| 677 | call writefield_phy("radlsw_ztau",ztau(:,1,:),klev) |
|---|
| 678 | ENDIF |
|---|
| 679 | |
|---|
| 680 | ! 2.4 CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE |
|---|
| 681 | ! -------------------------------------------- |
|---|
| 682 | |
|---|
| 683 | ! ------------------------- |
|---|
| 684 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Smith and Shi (1992) |
|---|
| 685 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 686 | |
|---|
| 687 | IF (.NOT.LRRTM) THEN |
|---|
| 688 | |
|---|
| 689 | DO JL = KIDIA,KFDIA |
|---|
| 690 | ZALFICE(JL)=0.0_JPRB |
|---|
| 691 | ZGAMICE(JL)=0.0_JPRB |
|---|
| 692 | ZBICE(JL)=0.0_JPRB |
|---|
| 693 | ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND |
|---|
| 694 | IF (NICEOPT == 1) THEN |
|---|
| 695 | ZBICFU(JL)=1.0_JPRB |
|---|
| 696 | ELSE |
|---|
| 697 | ZBICFU(JL)=0.0_JPRB |
|---|
| 698 | ENDIF |
|---|
| 699 | ZKICFU(JL)=0.0_JPRB |
|---|
| 700 | ENDDO |
|---|
| 701 | |
|---|
| 702 | DO JNU= 1,NSIL |
|---|
| 703 | DO JL = KIDIA,KFDIA |
|---|
| 704 | ZRES(JL) = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,& |
|---|
| 705 | & JNU)& |
|---|
| 706 | & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,& |
|---|
| 707 | & JNU)& |
|---|
| 708 | & ))))) |
|---|
| 709 | ZBICE(JL) = ZBICE(JL) + ZRES(JL) |
|---|
| 710 | ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL) |
|---|
| 711 | ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL) |
|---|
| 712 | ENDDO |
|---|
| 713 | ENDDO |
|---|
| 714 | |
|---|
| 715 | !-- Fu et al. (1998) with M'91 LW scheme |
|---|
| 716 | IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN |
|---|
| 717 | DO JRTM=1,16 |
|---|
| 718 | DO JL=KIDIA,KFDIA |
|---|
| 719 | IF (PT(JL,IKL) < 160.0_JPRB) THEN |
|---|
| 720 | INDLAY=1 |
|---|
| 721 | ZTBLAY =PT(JL,IKL)-160.0_JPRB |
|---|
| 722 | ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN |
|---|
| 723 | INDLAY=PT(JL,IKL)-159.0_JPRB |
|---|
| 724 | INDLAY=MAX(INDLAY,1) |
|---|
| 725 | ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL)) |
|---|
| 726 | ELSE |
|---|
| 727 | INDLAY=180 |
|---|
| 728 | ZTBLAY =PT(JL,IKL)-339.0_JPRB |
|---|
| 729 | ENDIF |
|---|
| 730 | ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM) |
|---|
| 731 | ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK) |
|---|
| 732 | ZBICFU(JL) = ZBICFU(JL) + ZPLANCK |
|---|
| 733 | |
|---|
| 734 | IF (ZIWC(JL) > 0.0_JPRB ) THEN |
|---|
| 735 | ZRATIO = 1.0_JPRB / ZDESR(JL) |
|---|
| 736 | IF (NICEOPT == 2) THEN |
|---|
| 737 | ! ice cloud spectral emissivity a la Fu & Liou (1993) |
|---|
| 738 | ZMABSD = RFULIO(JRTM,1) + ZRATIO & |
|---|
| 739 | & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) |
|---|
| 740 | |
|---|
| 741 | ! ice cloud spectral emissivity a la Fu et al (1998) |
|---|
| 742 | ELSEIF (NICEOPT == 3) THEN |
|---|
| 743 | ZMABSD = RFUETA(JRTM,1) + ZRATIO & |
|---|
| 744 | & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3)) |
|---|
| 745 | ENDIF |
|---|
| 746 | ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK |
|---|
| 747 | ENDIF |
|---|
| 748 | ENDDO |
|---|
| 749 | ENDDO |
|---|
| 750 | ENDIF |
|---|
| 751 | |
|---|
| 752 | DO JL = KIDIA,KFDIA |
|---|
| 753 | ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL) |
|---|
| 754 | ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL) |
|---|
| 755 | ZKICFU(JL) = ZKICFU(JL) / ZBICFU(JL) |
|---|
| 756 | |
|---|
| 757 | IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN |
|---|
| 758 | |
|---|
| 759 | IF (NLIQOPT == 0) THEN |
|---|
| 760 | ! water cloud emissivity a la Smith & Shi (1992) |
|---|
| 761 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) |
|---|
| 762 | ZMSALD= 0.158_JPRB*ZMULTL |
|---|
| 763 | ZMSALU= 0.130_JPRB*ZMULTL |
|---|
| 764 | |
|---|
| 765 | ELSE |
|---|
| 766 | ! water cloud emissivity a la Savijarvi (1997) |
|---|
| 767 | ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL) |
|---|
| 768 | ZMSALD= 1.2154_JPRB*ZMSALU |
|---|
| 769 | |
|---|
| 770 | ENDIF |
|---|
| 771 | |
|---|
| 772 | IF (NICEOPT == 0) THEN |
|---|
| 773 | ! ice cloud emissivity a la Smith & Shi (1992) |
|---|
| 774 | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) |
|---|
| 775 | ZMSAID= 0.113_JPRB*ZMULTI |
|---|
| 776 | ZMSAIU= 0.093_JPRB*ZMULTI |
|---|
| 777 | |
|---|
| 778 | ELSEIF (NICEOPT == 1) THEN |
|---|
| 779 | ! ice cloud emissivity a la Ebert & Curry (1992) |
|---|
| 780 | ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL)) |
|---|
| 781 | ZMSAIU= ZMSAID |
|---|
| 782 | |
|---|
| 783 | ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN |
|---|
| 784 | ! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998) |
|---|
| 785 | ZMSAID= 1.66_JPRB*ZKICFU(JL) |
|---|
| 786 | ZMSAIU= ZMSAID |
|---|
| 787 | ENDIF |
|---|
| 788 | |
|---|
| 789 | IF (NINHOM == 1) THEN |
|---|
| 790 | ZZFLWP= ZFLWP(JL) * RLWINHF |
|---|
| 791 | ZZFIWP= ZFIWP(JL) * RLWINHF |
|---|
| 792 | ELSE |
|---|
| 793 | ZZFLWP= ZFLWP(JL) |
|---|
| 794 | ZZFIWP= ZFIWP(JL) |
|---|
| 795 | ENDIF |
|---|
| 796 | |
|---|
| 797 | ! effective cloudiness accounting for condensed water |
|---|
| 798 | ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* & |
|---|
| 799 | & ZZFIWP)) |
|---|
| 800 | ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* & |
|---|
| 801 | & ZZFIWP)) |
|---|
| 802 | ENDIF |
|---|
| 803 | ENDDO |
|---|
| 804 | |
|---|
| 805 | ELSE |
|---|
| 806 | |
|---|
| 807 | ! 2.5 CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM |
|---|
| 808 | ! ------------------------------------------ |
|---|
| 809 | |
|---|
| 810 | ! ------------------------- |
|---|
| 811 | ! --+ LW OPTICAL PARAMETERS + Water (and Ice) from Savijarvi (1998) |
|---|
| 812 | ! ------------------------- Ice clouds (Ebert, Curry, 1992) |
|---|
| 813 | |
|---|
| 814 | ! No need for a fixed diffusivity factor, accounted for spectrally below |
|---|
| 815 | ! The detailed spectral structure does not require defining upward and |
|---|
| 816 | ! downward effective optical properties |
|---|
| 817 | |
|---|
| 818 | DO JRTM=1,16 |
|---|
| 819 | DO JL = KIDIA,KFDIA |
|---|
| 820 | ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB |
|---|
| 821 | ZMSALD = 0.0_JPRB |
|---|
| 822 | ZMSAID = 0.0_JPRB |
|---|
| 823 | |
|---|
| 824 | IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN |
|---|
| 825 | |
|---|
| 826 | IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN |
|---|
| 827 | ! water cloud total emissivity a la Smith and Shi (1992) |
|---|
| 828 | ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL) |
|---|
| 829 | ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB |
|---|
| 830 | |
|---|
| 831 | ELSEIF (NLIQOPT == 1) THEN |
|---|
| 832 | ! water cloud spectral emissivity a la Savijarvi (1997) |
|---|
| 833 | ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)& |
|---|
| 834 | & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) |
|---|
| 835 | |
|---|
| 836 | ELSEIF (NLIQOPT == 2) THEN |
|---|
| 837 | ! water cloud spectral emissivity a la Lindner and Li (2000) |
|---|
| 838 | Z1RADL = 1.0_JPRB / ZRADLP(JL) |
|---|
| 839 | ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*& |
|---|
| 840 | & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*& |
|---|
| 841 | & RLILIA(JRTM,5) )) |
|---|
| 842 | Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) & |
|---|
| 843 | & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) ) |
|---|
| 844 | ZRSALD = Z1MOMG * ZEXTCF |
|---|
| 845 | ENDIF |
|---|
| 846 | |
|---|
| 847 | IF (NICEOPT == 0) THEN |
|---|
| 848 | ! ice cloud spectral emissivity a la Smith & Shi (1992) |
|---|
| 849 | ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL) |
|---|
| 850 | ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB |
|---|
| 851 | |
|---|
| 852 | ELSEIF (NICEOPT == 1) THEN |
|---|
| 853 | ! ice cloud spectral emissivity a la Ebert-Curry (1992) |
|---|
| 854 | ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL) |
|---|
| 855 | |
|---|
| 856 | ELSEIF (NICEOPT == 2) THEN |
|---|
| 857 | ! ice cloud spectral emissivity a la Fu & Liou (1993) |
|---|
| 858 | Z1RADI = 1.0_JPRB / ZDESR(JL) |
|---|
| 859 | ZRSAID = RFULIO(JRTM,1) + Z1RADI & |
|---|
| 860 | & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3)) |
|---|
| 861 | |
|---|
| 862 | ELSEIF (NICEOPT == 3) THEN |
|---|
| 863 | ! ice cloud spectral emissivity a la Fu et al (1998) including |
|---|
| 864 | ! parametrisation for LW scattering effect |
|---|
| 865 | Z1RADI = 1.0_JPRB / ZDESR(JL) |
|---|
| 866 | ZRSAIE = RFUETA(JRTM,1) + Z1RADI & |
|---|
| 867 | &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3)) |
|---|
| 868 | ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4)))) |
|---|
| 869 | ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4))) |
|---|
| 870 | ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) ) |
|---|
| 871 | ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE |
|---|
| 872 | ENDIF |
|---|
| 873 | |
|---|
| 874 | ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL) |
|---|
| 875 | |
|---|
| 876 | ! Diffusivity correction within clouds a la Savijarvi |
|---|
| 877 | IF (LDIFFC) THEN |
|---|
| 878 | ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), & |
|---|
| 879 | & 2.0_JPRB) |
|---|
| 880 | ELSE |
|---|
| 881 | ZDIFFD=1.66_JPRB |
|---|
| 882 | ENDIF |
|---|
| 883 | |
|---|
| 884 | ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD |
|---|
| 885 | ENDIF |
|---|
| 886 | |
|---|
| 887 | ENDDO |
|---|
| 888 | ENDDO |
|---|
| 889 | |
|---|
| 890 | ENDIF |
|---|
| 891 | |
|---|
| 892 | ENDDO |
|---|
| 893 | |
|---|
| 894 | NUAER = NUA |
|---|
| 895 | NTRAER = NTRA |
|---|
| 896 | |
|---|
| 897 | ! ------------------------------------------------------------------ |
|---|
| 898 | ! |
|---|
| 899 | ! 2.6 SCALING OF OPTICAL THICKNESS |
|---|
| 900 | ! SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY |
|---|
| 901 | |
|---|
| 902 | JEXPLR=NLAYINH |
|---|
| 903 | JXPLDN=2*JEXPLR+1 |
|---|
| 904 | |
|---|
| 905 | IF (NINHOM == 1) THEN |
|---|
| 906 | !-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW |
|---|
| 907 | DO JSW=1,NSW |
|---|
| 908 | DO JK=1,KLEV |
|---|
| 909 | DO JL=KIDIA,KFDIA |
|---|
| 910 | ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF |
|---|
| 911 | ENDDO |
|---|
| 912 | ENDDO |
|---|
| 913 | ENDDO |
|---|
| 914 | |
|---|
| 915 | DO JRTM=1,16 |
|---|
| 916 | DO JK=1,KLEV |
|---|
| 917 | DO JL=KIDIA,KFDIA |
|---|
| 918 | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF |
|---|
| 919 | ENDDO |
|---|
| 920 | ENDDO |
|---|
| 921 | ENDDO |
|---|
| 922 | |
|---|
| 923 | ELSEIF (JEXPLR /= 0) THEN |
|---|
| 924 | DO JSW=1,NSW |
|---|
| 925 | DO JK=1,KLEV |
|---|
| 926 | DO JL=KIDIA,KFDIA |
|---|
| 927 | ZSQUAR(JL,JK)=0.0_JPRB |
|---|
| 928 | ZVARIA(JL,JK)=1.0_JPRB |
|---|
| 929 | ENDDO |
|---|
| 930 | ENDDO |
|---|
| 931 | !-- range should be defined from Hogan & Illingworth |
|---|
| 932 | DO JK=1+JEXPLR,KLEV-JEXPLR |
|---|
| 933 | DO JL=KIDIA,KFDIA |
|---|
| 934 | ! ZAVDP(JL)=0.0_JPRB |
|---|
| 935 | ZAVTO(JL)=0.0_JPRB |
|---|
| 936 | ZSQTO(JL)=0.0_JPRB |
|---|
| 937 | ENDDO |
|---|
| 938 | DO JKI=JK-JEXPLR,JK+JEXPLR |
|---|
| 939 | IKI=KLEV+1-JKI |
|---|
| 940 | DO JL=KIDIA,KFDIA |
|---|
| 941 | ! ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG |
|---|
| 942 | ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI) |
|---|
| 943 | ENDDO |
|---|
| 944 | ENDDO |
|---|
| 945 | DO JL=KIDIA,KFDIA |
|---|
| 946 | ! ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL) |
|---|
| 947 | ZAVTO(JL)=ZAVTO(JL)/JXPLDN |
|---|
| 948 | ENDDO |
|---|
| 949 | DO JKI=JK-JEXPLR,JK+JEXPLR |
|---|
| 950 | IKI=KLEV+1-JKI |
|---|
| 951 | DO JL=KIDIA,KFDIA |
|---|
| 952 | ! ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2 |
|---|
| 953 | ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2 |
|---|
| 954 | ENDDO |
|---|
| 955 | ENDDO |
|---|
| 956 | DO JL=KIDIA,KFDIA |
|---|
| 957 | ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1))) |
|---|
| 958 | IF (ZAVTO(JL) > 0.0_JPRB) THEN |
|---|
| 959 | ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2 |
|---|
| 960 | ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK)) |
|---|
| 961 | ELSE |
|---|
| 962 | ZVARIA(JL,JK)=0.0_JPRB |
|---|
| 963 | ZSQUAR(JL,JK)=1.0_JPRB |
|---|
| 964 | ENDIF |
|---|
| 965 | |
|---|
| 966 | !-- scaling a la Barker |
|---|
| 967 | IF (NINHOM ==2) THEN |
|---|
| 968 | ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK) |
|---|
| 969 | |
|---|
| 970 | !-- scaling a la Cairns et al. |
|---|
| 971 | ELSEIF (NINHOM == 3) THEN |
|---|
| 972 | ZVI=ZVARIA(JL,JK) |
|---|
| 973 | ZTAU(JL,JSW,JK) = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI) |
|---|
| 974 | ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) & |
|---|
| 975 | & /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) ) |
|---|
| 976 | ZCG(JL,JSW,JK) = ZCG(JL,JSW,JK) & |
|---|
| 977 | & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) & |
|---|
| 978 | & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK))) |
|---|
| 979 | ENDIF |
|---|
| 980 | ENDDO |
|---|
| 981 | ! JL=KIDIA |
|---|
| 982 | ! print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK) |
|---|
| 983 | 9261 format(1x,'Varia1 ',2I3,7F10.4) |
|---|
| 984 | ENDDO |
|---|
| 985 | ENDDO |
|---|
| 986 | |
|---|
| 987 | |
|---|
| 988 | DO JRTM=1,16 |
|---|
| 989 | DO JK=1,KLEV |
|---|
| 990 | DO JL=KIDIA,KFDIA |
|---|
| 991 | ZSQUAR(JL,JK)=0.0_JPRB |
|---|
| 992 | ZVARIA(JL,JK)=1.0_JPRB |
|---|
| 993 | ENDDO |
|---|
| 994 | ENDDO |
|---|
| 995 | !-- range to be defined from Hogan & Illingworth |
|---|
| 996 | DO JK=1+JEXPLR,KLEV-JEXPLR |
|---|
| 997 | DO JL=KIDIA,KFDIA |
|---|
| 998 | ! ZAVDP(JL)=0.0_JPRB |
|---|
| 999 | ZAVTO(JL)=0.0_JPRB |
|---|
| 1000 | ZSQTO(JL)=0.0_JPRB |
|---|
| 1001 | ENDDO |
|---|
| 1002 | DO JKI=JK-JEXPLR,JK+JEXPLR |
|---|
| 1003 | IKI=KLEV+1-JKI |
|---|
| 1004 | DO JL=KIDIA,KFDIA |
|---|
| 1005 | ! ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG |
|---|
| 1006 | ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM) |
|---|
| 1007 | ENDDO |
|---|
| 1008 | ENDDO |
|---|
| 1009 | DO JL=KIDIA,KFDIA |
|---|
| 1010 | ! ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL) |
|---|
| 1011 | ZAVTO(JL)=ZAVTO(JL)/JXPLDN |
|---|
| 1012 | ENDDO |
|---|
| 1013 | DO JKI=JK-JEXPLR,JK+JEXPLR |
|---|
| 1014 | IKI=KLEV+1-JKI |
|---|
| 1015 | DO JL=KIDIA,KFDIA |
|---|
| 1016 | ! ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2 |
|---|
| 1017 | ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2 |
|---|
| 1018 | ENDDO |
|---|
| 1019 | ENDDO |
|---|
| 1020 | DO JL=KIDIA,KFDIA |
|---|
| 1021 | ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1))) |
|---|
| 1022 | IF (ZAVTO(JL) > 0.0_JPRB) THEN |
|---|
| 1023 | ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2 |
|---|
| 1024 | ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK)) |
|---|
| 1025 | ELSE |
|---|
| 1026 | ZVARIA(JL,JK)=0.0_JPRB |
|---|
| 1027 | ZSQUAR(JL,JK)=1.0_JPRB |
|---|
| 1028 | ENDIF |
|---|
| 1029 | |
|---|
| 1030 | !-- scaling a la Barker |
|---|
| 1031 | IF (NINHOM ==2) THEN |
|---|
| 1032 | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK) |
|---|
| 1033 | |
|---|
| 1034 | !-- scaling a la Cairns et al. |
|---|
| 1035 | ELSEIF (NINHOM == 3) THEN |
|---|
| 1036 | ZVI=ZVARIA(JL,JK) |
|---|
| 1037 | ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI) |
|---|
| 1038 | ENDIF |
|---|
| 1039 | ENDDO |
|---|
| 1040 | ! JL=KIDIA |
|---|
| 1041 | ! print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK) |
|---|
| 1042 | 9262 format(1x,'Varia2 ',2I3,7F10.4) |
|---|
| 1043 | ENDDO |
|---|
| 1044 | ENDDO |
|---|
| 1045 | ENDIF |
|---|
| 1046 | |
|---|
| 1047 | |
|---|
| 1048 | |
|---|
| 1049 | ! ------------------------------------------------------------------ |
|---|
| 1050 | ! |
|---|
| 1051 | !* 2.7 DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE |
|---|
| 1052 | ! --------------------------------------------- |
|---|
| 1053 | |
|---|
| 1054 | DO JL = KIDIA,KFDIA |
|---|
| 1055 | ZVIEW(JL) = DIFF |
|---|
| 1056 | ENDDO |
|---|
| 1057 | |
|---|
| 1058 | ! ------------------------------------------------------------------ |
|---|
| 1059 | |
|---|
| 1060 | !* 3. CALL LONGWAVE RADIATION CODE |
|---|
| 1061 | ! ---------------------------- |
|---|
| 1062 | |
|---|
| 1063 | !* 3.1 FULL LONGWAVE RADIATION COMPUTATIONS |
|---|
| 1064 | ! ------------------------------------ |
|---|
| 1065 | |
|---|
| 1066 | !print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM |
|---|
| 1067 | IF (.NOT.LPHYLIN) THEN |
|---|
| 1068 | IF ( .NOT. LRRTM) THEN |
|---|
| 1069 | |
|---|
| 1070 | CALL LW & |
|---|
| 1071 | & ( KIDIA , KFDIA , KLON , KLEV , KMODE,& |
|---|
| 1072 | & PCCO2 , ZCLDLD, ZCLDLU,& |
|---|
| 1073 | & PDP , ZDT0 , ZEMIS , ZEMIW,& |
|---|
| 1074 | & ZPMB , POZON , ZTL,& |
|---|
| 1075 | & PAER , ZTAVE , ZVIEW , PQ,& |
|---|
| 1076 | & ZEMIT , PFLUX , PFLUC & |
|---|
| 1077 | & ) |
|---|
| 1078 | ! print *,'RADLSW: apres CALL LW' |
|---|
| 1079 | IF(LLDEBUG) THEN |
|---|
| 1080 | call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1) |
|---|
| 1081 | call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1) |
|---|
| 1082 | call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1) |
|---|
| 1083 | call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1) |
|---|
| 1084 | ENDIF |
|---|
| 1085 | |
|---|
| 1086 | ELSE |
|---|
| 1087 | |
|---|
| 1088 | !* 3.2 FULL LONGWAVE RADIATION COMPUTATIONS - RRTM |
|---|
| 1089 | ! ------------------------------------ ---- |
|---|
| 1090 | |
|---|
| 1091 | ! i) pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure |
|---|
| 1092 | ! weighting applied to POZON in driverMC (below) |
|---|
| 1093 | ! ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM |
|---|
| 1094 | ! iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM, |
|---|
| 1095 | ! computed from equations above |
|---|
| 1096 | ! iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM |
|---|
| 1097 | ! in module rrtm_ecrt.f |
|---|
| 1098 | |
|---|
| 1099 | DO JL = KIDIA,KFDIA |
|---|
| 1100 | DO JK = 1, KLEV |
|---|
| 1101 | ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK) |
|---|
| 1102 | ENDDO |
|---|
| 1103 | ENDDO |
|---|
| 1104 | |
|---|
| 1105 | ! print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:) |
|---|
| 1106 | CALL RRTM_RRTM_140GP & |
|---|
| 1107 | & ( KIDIA , KFDIA , KLON , KLEV,& |
|---|
| 1108 | & PAER , PAPH , PAP,& |
|---|
| 1109 | & PTS , PTH , PT,& |
|---|
| 1110 | & ZEMIS , ZEMIW,& |
|---|
| 1111 | & PQ , PCCO2 , ZOZN ,& |
|---|
| 1112 | & ZCLDSW , ZTAUCLD,& |
|---|
| 1113 | & PTAU_LW,& |
|---|
| 1114 | & ZEMIT , PFLUX , PFLUC , ZTCLEAR ) |
|---|
| 1115 | ! print *,'RADLSW: apres CALL RRTM_RRTM_140GP' |
|---|
| 1116 | |
|---|
| 1117 | ENDIF |
|---|
| 1118 | ELSE |
|---|
| 1119 | ZEMIT (:) = 0.0_JPRB |
|---|
| 1120 | PFLUX(:,:,:)= 0.0_JPRB |
|---|
| 1121 | PFLUC(:,:,:)= 0.0_JPRB |
|---|
| 1122 | ! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0' |
|---|
| 1123 | ENDIF |
|---|
| 1124 | |
|---|
| 1125 | ! ------------------------------------------------------------------ |
|---|
| 1126 | |
|---|
| 1127 | !* 4. CALL SHORTWAVE RADIATION CODE |
|---|
| 1128 | ! ----------------------------- |
|---|
| 1129 | |
|---|
| 1130 | ZRMUZ=0.0_JPRB |
|---|
| 1131 | DO JL = KIDIA,KFDIA |
|---|
| 1132 | ZRMUZ = MAX (ZRMUZ, ZMU0(JL)) |
|---|
| 1133 | ENDDO |
|---|
| 1134 | |
|---|
| 1135 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
|---|
| 1136 | WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA) |
|---|
| 1137 | WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW) |
|---|
| 1138 | WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW) |
|---|
| 1139 | WRITE(NULOUT,'("PQ ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV) |
|---|
| 1140 | WRITE(NULOUT,'("PQS ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV) |
|---|
| 1141 | WRITE(NULOUT,'("PDP ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV) |
|---|
| 1142 | WRITE(NULOUT,'("ZPMB ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1) |
|---|
| 1143 | WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV) |
|---|
| 1144 | WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV) |
|---|
| 1145 | WRITE(NULOUT,'("ZTAU ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1146 | WRITE(NULOUT,'("ZCG ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1147 | WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1148 | WRITE(NULOUT,'("ZOZ ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV) |
|---|
| 1149 | WRITE(NULOUT,'("PAER ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1150 | ENDIF |
|---|
| 1151 | |
|---|
| 1152 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
|---|
| 1153 | WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA) |
|---|
| 1154 | WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW) |
|---|
| 1155 | WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW) |
|---|
| 1156 | WRITE(NULOUT,'("PQ ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV) |
|---|
| 1157 | WRITE(NULOUT,'("PQS ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV) |
|---|
| 1158 | WRITE(NULOUT,'("PDP ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV) |
|---|
| 1159 | WRITE(NULOUT,'("ZPMB ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1) |
|---|
| 1160 | WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV) |
|---|
| 1161 | WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV) |
|---|
| 1162 | WRITE(NULOUT,'("ZTAU ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1163 | WRITE(NULOUT,'("ZCG ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1164 | WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1165 | WRITE(NULOUT,'("ZOZ ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV) |
|---|
| 1166 | WRITE(NULOUT,'("PAER ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW) |
|---|
| 1167 | ENDIF |
|---|
| 1168 | CALL SW & |
|---|
| 1169 | & ( KIDIA , KFDIA , KLON , KLEV , KAER,& |
|---|
| 1170 | & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ , PQS,& |
|---|
| 1171 | & ZMU0 , ZCG , ZCLDSW, PDP , ZOMEGA, ZOZ , ZPMB,& |
|---|
| 1172 | & ZTAU , ZTAVE , PAER,& |
|---|
| 1173 | & PFSDN , PFSUP , PFSCDN, PFSCUP,& |
|---|
| 1174 | & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,& |
|---|
| 1175 | & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,& |
|---|
| 1176 | & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, & |
|---|
| 1177 | & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST& |
|---|
| 1178 | & ) |
|---|
| 1179 | PFSDNV=ZFSDNV |
|---|
| 1180 | PFSDNN=ZFSDNN |
|---|
| 1181 | IF (SIZE(PSFSWDIR,2)>1) THEN |
|---|
| 1182 | PSFSWDIR= ZDIRFS |
|---|
| 1183 | PSFSWDIF= ZDIFFS |
|---|
| 1184 | ELSE |
|---|
| 1185 | PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:) |
|---|
| 1186 | PSFSWDIF (:,:) = 0. |
|---|
| 1187 | ENDIF |
|---|
| 1188 | |
|---|
| 1189 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
|---|
| 1190 | WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV) |
|---|
| 1191 | WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV) |
|---|
| 1192 | WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV) |
|---|
| 1193 | WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV) |
|---|
| 1194 | LEDBUG=.FALSE. |
|---|
| 1195 | ENDIF |
|---|
| 1196 | IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN |
|---|
| 1197 | WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV) |
|---|
| 1198 | WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV) |
|---|
| 1199 | WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV) |
|---|
| 1200 | WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV) |
|---|
| 1201 | LEDBUG=.FALSE. |
|---|
| 1202 | ENDIF |
|---|
| 1203 | ! ------------------------------------------------------------------ |
|---|
| 1204 | |
|---|
| 1205 | !* 5. FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES |
|---|
| 1206 | ! ------------------------------------------------ |
|---|
| 1207 | |
|---|
| 1208 | DO JKL = 1 , KLEV+1 |
|---|
| 1209 | JK = KLEV+1 + 1 - JKL |
|---|
| 1210 | DO JL = KIDIA,KFDIA |
|---|
| 1211 | PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK) |
|---|
| 1212 | PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK) |
|---|
| 1213 | PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK) |
|---|
| 1214 | PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK) |
|---|
| 1215 | ENDDO |
|---|
| 1216 | ENDDO |
|---|
| 1217 | |
|---|
| 1218 | DO JL = KIDIA,KFDIA |
|---|
| 1219 | PFRSOD(JL)=ZFSDWN(JL,1) |
|---|
| 1220 | PEMIT (JL)=ZEMIT (JL) |
|---|
| 1221 | PSUDU (JL)=ZSUDU (JL) |
|---|
| 1222 | PUVDF (JL)=ZUVDF (JL) |
|---|
| 1223 | PPARF (JL)=ZPARF (JL) |
|---|
| 1224 | PPARCF(JL)=ZPARCF(JL) |
|---|
| 1225 | PTINCF(JL)=PRII0 * ZMU0(JL) |
|---|
| 1226 | ENDDO |
|---|
| 1227 | !print 9501,(PUVDF(JL),JL=KIDIA,KFDIA) |
|---|
| 1228 | 9501 format(1x,'RADLSW PUVDF: ',30f6.1) |
|---|
| 1229 | !print 9502,(PPARF(JL),JL=KIDIA,KFDIA) |
|---|
| 1230 | 9502 format(1x,'RADLSW PPARF: ',30f6.1) |
|---|
| 1231 | |
|---|
| 1232 | ! -------------------------------------------------------------- |
|---|
| 1233 | |
|---|
| 1234 | IF (LHOOK) CALL DR_HOOK('RADLSW',1,ZHOOK_HANDLE) |
|---|
| 1235 | END SUBROUTINE RADLSW |
|---|
| 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 | |
|---|
| 1261 | |
|---|
| 1262 | |
|---|
| 1263 | |
|---|
| 1264 | |
|---|
| 1265 | |
|---|
| 1266 | |
|---|
| 1267 | |
|---|
| 1268 | |
|---|
| 1269 | |
|---|
