Changeset 4875
- Timestamp:
- Mar 26, 2024, 11:29:06 AM (6 weeks ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/rrtm/recmwf_aero.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/rrtm/recmwf_aero.F90
r3989 r4875 4 4 !OPTIONS XOPT(NOEVAL) 5 5 SUBROUTINE RECMWF_AERO (KST, KEND, KPROMA, KTDIA , KLEV,& 6 & KMODE,&7 & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&8 & PQO3 , PAER , PDP , PEMIS , PMU0,&9 & PQ , PQS , PQIWP , PQLWP , PSLM , PT , PTS,&10 & PREF_LIQ, PREF_ICE,&11 !--OB12 & PREF_LIQ_PI, PREF_ICE_PI,&13 !--fin14 & PEMTD , PEMTU , PTRSO,&15 & PTH , PCTRSO, PCEMTR, PTRSOD,&16 & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,&17 & PFSDNN, PFSDNV,&18 & PPIZA_TOT,PCGA_TOT,PTAU_TOT, &19 !--OB20 & PPIZA_NAT,PCGA_NAT,PTAU_NAT, &21 !--fin OB22 !--C.Kleinschmitt23 & PTAU_LW_TOT, PTAU_LW_NAT, &24 !--end25 & PFLUX,PFLUC,&26 & PFSDN ,PFSUP , PFSCDN , PFSCUP, PFSCCDN, PFSCCUP, PFLCCDN, PFLCCUP,&27 !--OB diagnostics28 & PTOPSWADAERO,PSOLSWADAERO,&29 & PTOPSWAD0AERO,PSOLSWAD0AERO,&30 & PTOPSWAIAERO,PSOLSWAIAERO,&31 & PTOPSWCFAERO,PSOLSWCFAERO,&32 & PSWADAERO,& !--NL33 !--LW diagnostics CK34 & PTOPLWADAERO,PSOLLWADAERO,&35 & PTOPLWAD0AERO,PSOLLWAD0AERO,&36 & PTOPLWAIAERO,PSOLLWAIAERO,&37 & PLWADAERO,& !--NL38 !--ajout volmip39 & volmip_solsw, flag_volc_surfstrat,&40 !..end41 & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&42 & flag_aer_feedback)43 !--fin44 45 !**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME46 47 ! PURPOSE.48 ! --------49 ! SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION)50 51 !** INTERFACE.52 ! ----------53 54 ! EXPLICIT ARGUMENTS :55 ! --------------------56 ! KST : START INDEX OF DATA IN KPROMA-LONG VECTOR57 ! KEND : END INDEX OF DATA IN KPROMA-LONG VECTOR58 ! KPROMA : VECTOR LENGTH59 ! KTDIA : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE60 ! KLEV : NUMBER OF LEVELS61 ! PAER : (KPROMA,KLEV ,6) ; OPTICAL THICKNESS OF THE AEROSOLS62 ! PALBD : (KPROMA,NSW) ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS63 ! PALBP : (KPROMA,NSW) ; PARALLEL ALBEDO IN THE 2 SW INTERVALS64 ! PAPRS : (KPROMA,KLEV+1) ; HALF LEVEL PRESSURE65 ! PAPRSF : (KPROMA,KLEV ) ; FULL LEVEL PRESSURE66 ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA)67 ! PCLFR : (KPROMA,KLEV ) ; CLOUD FRACTIONAL COVER68 ! PQO3 : (KPROMA,KLEV ) ; OZONE MIXING RATIO (MASS)69 ! PDP : (KPROMA,KLEV) ; LAYER PRESSURE THICKNESS70 ! PEMIS : (KPROMA) ; SURFACE EMISSIVITY71 ! PMU0 : (KPROMA) ; SOLAR ANGLE72 ! PQ : (KPROMA,KLEV ) ; SPECIFIC HUMIDITY PA/PA73 ! PQS : (KPROMA,KLEV ) ; SATURATION SPECIFIC HUMIDITY PA/PA74 ! PQIWP : (KPROMA,KLEV ) ; ICE WATER KG/KG75 ! PQLWP : (KPROMA,KLEV ) ; LIQUID WATER KG/KG76 ! PSLM : (KPROMA) ; LAND-SEA MASK77 ! PT : (KPROMA,KLEV) ; FULL LEVEL TEMPERATURE78 ! PTS : (KPROMA) ; SURFACE TEMPERATURE79 ! PPIZA_TOT : (KPROMA,KLEV,NSW); Single scattering albedo of total aerosol80 ! PCGA_TOT : (KPROMA,KLEV,NSW); Assymetry factor for total aerosol81 ! PTAU_TOT: (KPROMA,KLEV,NSW) ; Optical depth of total aerosol82 ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) - present-day83 ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) - present-day84 !--OB85 ! PREF_LIQ_PI (KPROMA,KLEV) ; Liquid droplet radius (um) - pre-industrial86 ! PREF_ICE_PI (KPROMA,KLEV) ; Ice crystal radius (um) - pre-industrial87 ! ok_ade---input-L- apply the Aerosol Direct Effect or not?88 ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?89 ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)90 ! flag_aerosol-input-I- aerosol flag from 0 to 791 ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)92 ! flag_aer_feedback-input-I- use aerosols radiative effect flag (T/F)93 ! PPIZA_NAT : (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosol94 ! PCGA_NAT : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol95 ! PTAU_NAT: (KPROMA,KLEV,NSW) ; Optical depth of natural aerosol96 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols97 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols98 !--fin OB99 100 ! ==== OUTPUTS ===101 ! PEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY102 ! PEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY103 ! PTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY104 ! PTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE105 ! PCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY106 ! PCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY107 ! PTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY108 ! PLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES109 ! PLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES110 ! PSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES111 ! PSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES112 ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)113 ! PFLUX (KPROMA,2,KLEV+1) ; LW total sky flux (1=up, 2=down)114 ! PFLUC (KPROMA,2,KLEV+1) ; LW clear sky flux (1=up, 2=down)115 ! PFSDN(KPROMA,KLEV+1) ; SW total sky flux down116 ! PFSUP(KPROMA,KLEV+1) ; SW total sky flux up117 ! PFSCDN(KPROMA,KLEV+1) ; SW clear sky flux down118 ! PFSCUP(KPROMA,KLEV+1) ; SW clear sky flux up119 ! PFSCCDN(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux down120 ! PFSCCUP(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux up121 ! PFLCCDN(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux down122 ! PFLCCUP(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux up123 124 125 ! IMPLICIT ARGUMENTS : NONE126 ! --------------------127 128 ! METHOD.129 ! -------130 ! SEE DOCUMENTATION131 132 ! EXTERNALS.133 ! ----------134 135 ! REFERENCE.136 ! ----------137 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS138 139 ! AUTHORS.140 ! --------141 ! ORIGINAL BY B. RITTER *ECMWF* 83-10-13142 ! REWRITING FOR IFS BY J.-J. MORCRETTE 94-11-15143 ! 96-11: Ph. Dandin. Meteo-France144 ! REWRITING FOR DM BY J.PH. PIEDELIEVRE 1998-07145 ! Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003146 ! Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004147 ! 04-11-18 : 4 New arguments for AROME : Y. Seity148 ! 2005-10-10 Y. Seity : 3 optional arguments for dust optical properties149 ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF)150 ! Olivier Boucher: added LMD radiation diagnostics 2014-03151 152 !-----------------------------------------------------------------------153 154 USE PARKIND1 ,ONLY : JPIM ,JPRB155 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK156 USE YOEAERD , ONLY : RCAEROS157 USE YOMCST , ONLY : RMD ,RMO3158 USE YOMPHY3 , ONLY : RII0159 USE YOERAD , ONLY : NLW, NAER, RCCNLND ,RCCNSEA160 USE YOERAD , ONLY : NAER, RCCNLND ,RCCNSEA161 USE YOERDU , ONLY : REPSCQ162 USE YOMGEM , ONLY : NGPTOT163 USE YOERDI , ONLY : RRAE ,REPCLC ,REPH2O164 USE YOMARPHY , ONLY : LRDUST165 USE phys_output_mod, ONLY : swaerofree_diag, swaero_diag166 167 !-----------------------------------------------------------------------168 169 !* 0.1 ARGUMENTS.170 ! ----------171 172 IMPLICIT NONE173 INCLUDE "clesphys.h"174 175 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA176 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV177 INTEGER(KIND=JPIM),INTENT(IN) :: KST178 INTEGER(KIND=JPIM),INTENT(IN) :: KEND179 INTEGER(KIND=JPIM) :: KTDIA ! Argument NOT used180 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE181 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KPROMA,NSW)182 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KPROMA,NSW)183 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRS(KPROMA,KLEV+1)184 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRSF(KPROMA,KLEV)185 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2186 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KPROMA,KLEV)187 REAL(KIND=JPRB) ,INTENT(IN) :: PQO3(KPROMA,KLEV)188 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KPROMA,KLEV,6)189 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KPROMA,KLEV)190 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KPROMA)191 REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(KPROMA)192 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KPROMA,KLEV)193 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KPROMA,KLEV)194 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KPROMA,KLEV)195 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KPROMA,KLEV)196 REAL(KIND=JPRB) ,INTENT(IN) :: PSLM(KPROMA)197 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KPROMA,KLEV)198 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KPROMA)199 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_TOT(KPROMA,KLEV,NSW)200 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_TOT(KPROMA,KLEV,NSW)201 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_TOT(KPROMA,KLEV,NSW)202 !--OB203 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_NAT(KPROMA,KLEV,NSW)204 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_NAT(KPROMA,KLEV,NSW)205 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_NAT(KPROMA,KLEV,NSW)206 REAL(KIND=JPRB) :: PPIZA_ZERO(KPROMA,KLEV,NSW)207 REAL(KIND=JPRB) :: PCGA_ZERO(KPROMA,KLEV,NSW)208 REAL(KIND=JPRB) :: PTAU_ZERO(KPROMA,KLEV,NSW)209 !--fin210 !--C.Kleinschmitt211 REAL(KIND=JPRB) :: PTAU_LW_ZERO(KPROMA,KLEV,NLW)212 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_TOT(KPROMA,KLEV,NLW)213 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_NAT(KPROMA,KLEV,NLW)214 !--end215 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KPROMA,KLEV)216 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KPROMA,KLEV)217 !--OB218 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ_PI(KPROMA,KLEV)219 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_PI(KPROMA,KLEV)220 LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not221 LOGICAL, INTENT(in) :: ok_volcan ! produce volcanic diags (SW/LW heat flux and rate)222 INTEGER, INTENT(in) :: flag_aerosol ! takes value 0 (no aerosol) or 1 to 6 (aerosols)223 LOGICAL, INTENT(in) :: flag_aerosol_strat ! use stratospheric aerosols224 LOGICAL, INTENT(in) :: flag_aer_feedback ! use aerosols radiative feedback225 REAL(KIND=JPRB) ,INTENT(out) :: PTOPSWADAERO(KPROMA), PSOLSWADAERO(KPROMA) ! Aerosol direct forcing at TOA and surface226 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAD0AERO(KPROMA), PSOLSWAD0AERO(KPROMA) ! Aerosol direct forcing at TOA and surface227 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAIAERO(KPROMA), PSOLSWAIAERO(KPROMA) ! ditto, indirect228 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ?229 !--fin230 !--NL231 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWADAERO(KPROMA, KLEV+1) ! SW Aerosol direct forcing232 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWADAERO(KPROMA, KLEV+1) ! LW Aerosol direct forcing233 !--CK234 REAL(KIND=JPRB) ,INTENT(out) :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface235 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface236 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA) ! LW Aer. indirect forcing at TOA + surface237 !--end238 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTD(KPROMA,KLEV+1)239 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTU(KPROMA,KLEV+1)240 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSO(KPROMA,KLEV+1)241 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1)242 REAL(KIND=JPRB) ,INTENT(OUT) :: PCTRSO(KPROMA,2)243 REAL(KIND=JPRB) ,INTENT(OUT) :: PCEMTR(KPROMA,2)244 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSOD(KPROMA)245 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFC(KPROMA,2)246 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFT(KPROMA,KLEV+1)247 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFC(KPROMA,2)248 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFT(KPROMA,KLEV+1)249 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(KPROMA,NSW)250 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(KPROMA,NSW)251 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(KPROMA)252 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(KPROMA)253 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down)254 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)255 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(KPROMA,KLEV+1) ! SW total sky flux down256 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(KPROMA,KLEV+1) ! SW total sky flux up257 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(KPROMA,KLEV+1) ! SW clear sky flux down258 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(KPROMA,KLEV+1) ! SW clear sky flux up259 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCDN(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux down260 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCUP(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux up261 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down262 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up263 !--ajout VOLMIP264 REAL(KIND=JPRB) ,INTENT(OUT) :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP265 INTEGER, INTENT(IN) :: flag_volc_surfstrat !--VOlMIP Modif266 267 ! ==== COMPUTED IN RADITE ===268 ! ------------------------------------------------------------------269 !* 0.2 LOCAL ARRAYS.270 ! -------------271 REAL(KIND=JPRB) :: ZRAER (KPROMA,6,KLEV)272 REAL(KIND=JPRB) :: ZRCLC (KPROMA,KLEV)273 REAL(KIND=JPRB) :: ZRMU0 (KPROMA)274 REAL(KIND=JPRB) :: ZRPR (KPROMA,KLEV)275 REAL(KIND=JPRB) :: ZRTI (KPROMA,KLEV)276 REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )277 278 REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)279 REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)280 REAL(KIND=JPRB) :: ZQS (KPROMA,KLEV)281 REAL(KIND=JPRB) :: ZQ (KPROMA,KLEV)282 REAL(KIND=JPRB) :: ZEMTD (KPROMA,KLEV+1)283 REAL(KIND=JPRB) :: ZEMTU (KPROMA,KLEV+1)284 REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)285 REAL(KIND=JPRB) :: ZEMTC (KPROMA,2)286 287 REAL(KIND=JPRB) :: ZNBAS (KPROMA)288 REAL(KIND=JPRB) :: ZNTOP (KPROMA)289 REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)290 REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)291 REAL(KIND=JPRB) :: ZCCNL (KPROMA)292 REAL(KIND=JPRB) :: ZCCNO (KPROMA)293 294 ! output of radlsw295 296 REAL(KIND=JPRB) :: ZEMIT (KPROMA)297 REAL(KIND=JPRB) :: ZFCT (KPROMA,KLEV+1)298 REAL(KIND=JPRB) :: ZFLT (KPROMA,KLEV+1)299 REAL(KIND=JPRB) :: ZFCS (KPROMA,KLEV+1)300 REAL(KIND=JPRB) :: ZFLS (KPROMA,KLEV+1)301 REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)302 REAL(KIND=JPRB) :: ZPARF (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)303 304 INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL305 306 REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA)307 REAL(KIND=JPRB) :: ZHOOK_HANDLE308 309 !---aerosol radiative diagnostics310 ! Key to define the aerosol effect acting on climate311 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL312 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT313 ! FALSE: fluxes use no aerosols (case 1)314 ! to be used only for maintaining bit reproducibility with aerosol diagnostics activated315 LOGICAL :: AEROSOLFEEDBACK_ACTIVE ! now externalized from .def files316 317 !OB - Fluxes including aerosol effects318 ! | direct effect319 !ind effect | no aerosol NATural TOTal320 !standard | 5321 !natural (PI) | 1 3322 !total (PD) | 2 4323 ! so we need which case when ?324 ! if flag_aerosol is on325 ! ok_ade and ok_aie = 4-2, 4-3 and 4 to proceed326 ! ok_ade and not ok_aie = 3-1 and 3 to proceed327 ! not ok_ade and ok_aie = 2-1 and 2 to proceed328 ! not ok_ade and not ok_aie = 1 to proceed329 ! therefore the cases have the following corresponding switches330 ! 1 = not ok_ade and not ok_aie OR not ok_ade and ok_aie and swaero_diag OR ok_ade and not ok_aie and swaero_diag331 ! 2 = not ok_ade and ok_aie OR ok_aie and ok_ade and swaero_diag332 ! 3 = ok_ade and not ok_aie OR ok_aie and ok_ade and swaero_diag333 ! 4 = ok_ade and ok_aie334 ! 5 = no aerosol feedback wanted or no aerosol at all335 ! if they are called in this order then the correct call is used to proceed336 337 REAL(KIND=JPRB) :: ZFSUP_AERO(KPROMA,KLEV+1,5)338 REAL(KIND=JPRB) :: ZFSDN_AERO(KPROMA,KLEV+1,5)339 REAL(KIND=JPRB) :: ZFSUP0_AERO(KPROMA,KLEV+1,5)340 REAL(KIND=JPRB) :: ZFSDN0_AERO(KPROMA,KLEV+1,5)341 !--LW (CK):342 REAL(KIND=JPRB) :: LWUP_AERO(KPROMA,KLEV+1,5)343 REAL(KIND=JPRB) :: LWDN_AERO(KPROMA,KLEV+1,5)344 REAL(KIND=JPRB) :: LWUP0_AERO(KPROMA,KLEV+1,5)345 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5)6 & KMODE,& 7 & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,& 8 & PQO3 , PAER , PDP , PEMIS , PMU0,& 9 & PQ , PQS , PQIWP , PQLWP , PSLM , PT , PTS,& 10 & PREF_LIQ, PREF_ICE,& 11 !--OB 12 & PREF_LIQ_PI, PREF_ICE_PI,& 13 !--fin 14 & PEMTD , PEMTU , PTRSO,& 15 & PTH , PCTRSO, PCEMTR, PTRSOD,& 16 & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,& 17 & PFSDNN, PFSDNV,& 18 & PPIZA_TOT,PCGA_TOT,PTAU_TOT, & 19 !--OB 20 & PPIZA_NAT,PCGA_NAT,PTAU_NAT, & 21 !--fin OB 22 !--C.Kleinschmitt 23 & PTAU_LW_TOT, PTAU_LW_NAT, & 24 !--end 25 & PFLUX,PFLUC,& 26 & PFSDN ,PFSUP , PFSCDN , PFSCUP, PFSCCDN, PFSCCUP, PFLCCDN, PFLCCUP,& 27 !--OB diagnostics 28 & PTOPSWADAERO,PSOLSWADAERO,& 29 & PTOPSWAD0AERO,PSOLSWAD0AERO,& 30 & PTOPSWAIAERO,PSOLSWAIAERO,& 31 & PTOPSWCFAERO,PSOLSWCFAERO,& 32 & PSWADAERO,& !--NL 33 !--LW diagnostics CK 34 & PTOPLWADAERO,PSOLLWADAERO,& 35 & PTOPLWAD0AERO,PSOLLWAD0AERO,& 36 & PTOPLWAIAERO,PSOLLWAIAERO,& 37 & PLWADAERO,& !--NL 38 !--ajout volmip 39 & volmip_solsw, flag_volc_surfstrat,& 40 !..end 41 & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,& 42 & flag_aer_feedback) 43 !--fin 44 45 !**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME 46 47 ! PURPOSE. 48 ! -------- 49 ! SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION) 50 51 !** INTERFACE. 52 ! ---------- 53 54 ! EXPLICIT ARGUMENTS : 55 ! -------------------- 56 ! KST : START INDEX OF DATA IN KPROMA-LONG VECTOR 57 ! KEND : END INDEX OF DATA IN KPROMA-LONG VECTOR 58 ! KPROMA : VECTOR LENGTH 59 ! KTDIA : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE 60 ! KLEV : NUMBER OF LEVELS 61 ! PAER : (KPROMA,KLEV ,6) ; OPTICAL THICKNESS OF THE AEROSOLS 62 ! PALBD : (KPROMA,NSW) ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS 63 ! PALBP : (KPROMA,NSW) ; PARALLEL ALBEDO IN THE 2 SW INTERVALS 64 ! PAPRS : (KPROMA,KLEV+1) ; HALF LEVEL PRESSURE 65 ! PAPRSF : (KPROMA,KLEV ) ; FULL LEVEL PRESSURE 66 ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) 67 ! PCLFR : (KPROMA,KLEV ) ; CLOUD FRACTIONAL COVER 68 ! PQO3 : (KPROMA,KLEV ) ; OZONE MIXING RATIO (MASS) 69 ! PDP : (KPROMA,KLEV) ; LAYER PRESSURE THICKNESS 70 ! PEMIS : (KPROMA) ; SURFACE EMISSIVITY 71 ! PMU0 : (KPROMA) ; SOLAR ANGLE 72 ! PQ : (KPROMA,KLEV ) ; SPECIFIC HUMIDITY PA/PA 73 ! PQS : (KPROMA,KLEV ) ; SATURATION SPECIFIC HUMIDITY PA/PA 74 ! PQIWP : (KPROMA,KLEV ) ; ICE WATER KG/KG 75 ! PQLWP : (KPROMA,KLEV ) ; LIQUID WATER KG/KG 76 ! PSLM : (KPROMA) ; LAND-SEA MASK 77 ! PT : (KPROMA,KLEV) ; FULL LEVEL TEMPERATURE 78 ! PTS : (KPROMA) ; SURFACE TEMPERATURE 79 ! PPIZA_TOT : (KPROMA,KLEV,NSW); Single scattering albedo of total aerosol 80 ! PCGA_TOT : (KPROMA,KLEV,NSW); Assymetry factor for total aerosol 81 ! PTAU_TOT: (KPROMA,KLEV,NSW) ; Optical depth of total aerosol 82 ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) - present-day 83 ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) - present-day 84 !--OB 85 ! PREF_LIQ_PI (KPROMA,KLEV) ; Liquid droplet radius (um) - pre-industrial 86 ! PREF_ICE_PI (KPROMA,KLEV) ; Ice crystal radius (um) - pre-industrial 87 ! ok_ade---input-L- apply the Aerosol Direct Effect or not? 88 ! ok_aie---input-L- apply the Aerosol Indirect Effect or not? 89 ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux) 90 ! flag_aerosol-input-I- aerosol flag from 0 to 7 91 ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F) 92 ! flag_aer_feedback-input-I- use aerosols radiative effect flag (T/F) 93 ! PPIZA_NAT : (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosol 94 ! PCGA_NAT : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol 95 ! PTAU_NAT: (KPROMA,KLEV,NSW) ; Optical depth of natural aerosol 96 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols 97 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 98 !--fin OB 99 100 ! ==== OUTPUTS === 101 ! PEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY 102 ! PEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY 103 ! PTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY 104 ! PTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE 105 ! PCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY 106 ! PCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY 107 ! PTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY 108 ! PLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES 109 ! PLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES 110 ! PSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES 111 ! PSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES 112 ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08) 113 ! PFLUX (KPROMA,2,KLEV+1) ; LW total sky flux (1=up, 2=down) 114 ! PFLUC (KPROMA,2,KLEV+1) ; LW clear sky flux (1=up, 2=down) 115 ! PFSDN(KPROMA,KLEV+1) ; SW total sky flux down 116 ! PFSUP(KPROMA,KLEV+1) ; SW total sky flux up 117 ! PFSCDN(KPROMA,KLEV+1) ; SW clear sky flux down 118 ! PFSCUP(KPROMA,KLEV+1) ; SW clear sky flux up 119 ! PFSCCDN(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux down 120 ! PFSCCUP(KPROMA,KLEV+1) ; SW clear sky clean (no aerosol) flux up 121 ! PFLCCDN(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux down 122 ! PFLCCUP(KPROMA,KLEV+1) ; LW clear sky clean (no aerosol) flux up 123 124 125 ! IMPLICIT ARGUMENTS : NONE 126 ! -------------------- 127 128 ! METHOD. 129 ! ------- 130 ! SEE DOCUMENTATION 131 132 ! EXTERNALS. 133 ! ---------- 134 135 ! REFERENCE. 136 ! ---------- 137 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS 138 139 ! AUTHORS. 140 ! -------- 141 ! ORIGINAL BY B. RITTER *ECMWF* 83-10-13 142 ! REWRITING FOR IFS BY J.-J. MORCRETTE 94-11-15 143 ! 96-11: Ph. Dandin. Meteo-France 144 ! REWRITING FOR DM BY J.PH. PIEDELIEVRE 1998-07 145 ! Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003 146 ! Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004 147 ! 04-11-18 : 4 New arguments for AROME : Y. Seity 148 ! 2005-10-10 Y. Seity : 3 optional arguments for dust optical properties 149 ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF) 150 ! Olivier Boucher: added LMD radiation diagnostics 2014-03 151 152 !----------------------------------------------------------------------- 153 154 USE PARKIND1 ,ONLY : JPIM ,JPRB 155 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 156 USE YOEAERD , ONLY : RCAEROS 157 USE YOMCST , ONLY : RMD ,RMO3 158 USE YOMPHY3 , ONLY : RII0 159 USE YOERAD , ONLY : NLW, NAER, RCCNLND ,RCCNSEA 160 USE YOERAD , ONLY : NAER, RCCNLND ,RCCNSEA 161 USE YOERDU , ONLY : REPSCQ 162 USE YOMGEM , ONLY : NGPTOT 163 USE YOERDI , ONLY : RRAE ,REPCLC ,REPH2O 164 USE YOMARPHY , ONLY : LRDUST 165 USE phys_output_mod, ONLY : swaerofree_diag, swaero_diag 166 167 !----------------------------------------------------------------------- 168 169 !* 0.1 ARGUMENTS. 170 ! ---------- 171 172 IMPLICIT NONE 173 INCLUDE "clesphys.h" 174 175 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA 176 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV 177 INTEGER(KIND=JPIM),INTENT(IN) :: KST 178 INTEGER(KIND=JPIM),INTENT(IN) :: KEND 179 INTEGER(KIND=JPIM) :: KTDIA ! Argument NOT used 180 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE 181 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KPROMA,NSW) 182 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KPROMA,NSW) 183 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRS(KPROMA,KLEV+1) 184 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRSF(KPROMA,KLEV) 185 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 186 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KPROMA,KLEV) 187 REAL(KIND=JPRB) ,INTENT(IN) :: PQO3(KPROMA,KLEV) 188 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KPROMA,KLEV,6) 189 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KPROMA,KLEV) 190 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KPROMA) 191 REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(KPROMA) 192 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KPROMA,KLEV) 193 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(KPROMA,KLEV) 194 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(KPROMA,KLEV) 195 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(KPROMA,KLEV) 196 REAL(KIND=JPRB) ,INTENT(IN) :: PSLM(KPROMA) 197 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KPROMA,KLEV) 198 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KPROMA) 199 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_TOT(KPROMA,KLEV,NSW) 200 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_TOT(KPROMA,KLEV,NSW) 201 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_TOT(KPROMA,KLEV,NSW) 202 !--OB 203 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_NAT(KPROMA,KLEV,NSW) 204 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_NAT(KPROMA,KLEV,NSW) 205 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_NAT(KPROMA,KLEV,NSW) 206 REAL(KIND=JPRB) :: PPIZA_ZERO(KPROMA,KLEV,NSW) 207 REAL(KIND=JPRB) :: PCGA_ZERO(KPROMA,KLEV,NSW) 208 REAL(KIND=JPRB) :: PTAU_ZERO(KPROMA,KLEV,NSW) 209 !--fin 210 !--C.Kleinschmitt 211 REAL(KIND=JPRB) :: PTAU_LW_ZERO(KPROMA,KLEV,NLW) 212 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_TOT(KPROMA,KLEV,NLW) 213 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_NAT(KPROMA,KLEV,NLW) 214 !--end 215 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KPROMA,KLEV) 216 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KPROMA,KLEV) 217 !--OB 218 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ_PI(KPROMA,KLEV) 219 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_PI(KPROMA,KLEV) 220 LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not 221 LOGICAL, INTENT(in) :: ok_volcan ! produce volcanic diags (SW/LW heat flux and rate) 222 INTEGER, INTENT(in) :: flag_aerosol ! takes value 0 (no aerosol) or 1 to 6 (aerosols) 223 LOGICAL, INTENT(in) :: flag_aerosol_strat ! use stratospheric aerosols 224 LOGICAL, INTENT(in) :: flag_aer_feedback ! use aerosols radiative feedback 225 REAL(KIND=JPRB) ,INTENT(out) :: PTOPSWADAERO(KPROMA), PSOLSWADAERO(KPROMA) ! Aerosol direct forcing at TOA and surface 226 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAD0AERO(KPROMA), PSOLSWAD0AERO(KPROMA) ! Aerosol direct forcing at TOA and surface 227 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAIAERO(KPROMA), PSOLSWAIAERO(KPROMA) ! ditto, indirect 228 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ? 229 !--fin 230 !--NL 231 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWADAERO(KPROMA, KLEV+1) ! SW Aerosol direct forcing 232 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWADAERO(KPROMA, KLEV+1) ! LW Aerosol direct forcing 233 !--CK 234 REAL(KIND=JPRB) ,INTENT(out) :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface 235 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface 236 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA) ! LW Aer. indirect forcing at TOA + surface 237 !--end 238 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTD(KPROMA,KLEV+1) 239 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTU(KPROMA,KLEV+1) 240 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSO(KPROMA,KLEV+1) 241 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1) 242 REAL(KIND=JPRB) ,INTENT(OUT) :: PCTRSO(KPROMA,2) 243 REAL(KIND=JPRB) ,INTENT(OUT) :: PCEMTR(KPROMA,2) 244 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSOD(KPROMA) 245 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFC(KPROMA,2) 246 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFT(KPROMA,KLEV+1) 247 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFC(KPROMA,2) 248 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFT(KPROMA,KLEV+1) 249 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(KPROMA,NSW) 250 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(KPROMA,NSW) 251 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(KPROMA) 252 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(KPROMA) 253 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down) 254 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down) 255 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(KPROMA,KLEV+1) ! SW total sky flux down 256 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(KPROMA,KLEV+1) ! SW total sky flux up 257 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(KPROMA,KLEV+1) ! SW clear sky flux down 258 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(KPROMA,KLEV+1) ! SW clear sky flux up 259 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCDN(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux down 260 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCCUP(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux up 261 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down 262 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up 263 !--ajout VOLMIP 264 REAL(KIND=JPRB) ,INTENT(OUT) :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP 265 INTEGER, INTENT(IN) :: flag_volc_surfstrat !--VOlMIP Modif 266 267 ! ==== COMPUTED IN RADITE === 268 ! ------------------------------------------------------------------ 269 !* 0.2 LOCAL ARRAYS. 270 ! ------------- 271 REAL(KIND=JPRB) :: ZRAER (KPROMA,6,KLEV) 272 REAL(KIND=JPRB) :: ZRCLC (KPROMA,KLEV) 273 REAL(KIND=JPRB) :: ZRMU0 (KPROMA) 274 REAL(KIND=JPRB) :: ZRPR (KPROMA,KLEV) 275 REAL(KIND=JPRB) :: ZRTI (KPROMA,KLEV) 276 REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV ) 277 278 REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV) 279 REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV) 280 REAL(KIND=JPRB) :: ZQS (KPROMA,KLEV) 281 REAL(KIND=JPRB) :: ZQ (KPROMA,KLEV) 282 REAL(KIND=JPRB) :: ZEMTD (KPROMA,KLEV+1) 283 REAL(KIND=JPRB) :: ZEMTU (KPROMA,KLEV+1) 284 REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2) 285 REAL(KIND=JPRB) :: ZEMTC (KPROMA,2) 286 287 REAL(KIND=JPRB) :: ZNBAS (KPROMA) 288 REAL(KIND=JPRB) :: ZNTOP (KPROMA) 289 REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV) 290 REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV) 291 REAL(KIND=JPRB) :: ZCCNL (KPROMA) 292 REAL(KIND=JPRB) :: ZCCNO (KPROMA) 293 294 ! output of radlsw 295 296 REAL(KIND=JPRB) :: ZEMIT (KPROMA) 297 REAL(KIND=JPRB) :: ZFCT (KPROMA,KLEV+1) 298 REAL(KIND=JPRB) :: ZFLT (KPROMA,KLEV+1) 299 REAL(KIND=JPRB) :: ZFCS (KPROMA,KLEV+1) 300 REAL(KIND=JPRB) :: ZFLS (KPROMA,KLEV+1) 301 REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA) 302 REAL(KIND=JPRB) :: ZPARF (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA) 303 304 INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL 305 306 REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA) 307 REAL(KIND=JPRB) :: ZHOOK_HANDLE 308 309 !---aerosol radiative diagnostics 310 ! Key to define the aerosol effect acting on climate 311 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL 312 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT 313 ! FALSE: fluxes use no aerosols (case 1) 314 ! to be used only for maintaining bit reproducibility with aerosol diagnostics activated 315 LOGICAL :: AEROSOLFEEDBACK_ACTIVE ! now externalized from .def files 316 317 !OB - Fluxes including aerosol effects 318 ! | direct effect 319 !ind effect | no aerosol NATural TOTal 320 !standard | 5 321 !natural (PI) | 1 3 322 !total (PD) | 2 4 323 ! so we need which case when ? 324 ! if flag_aerosol is on 325 ! ok_ade and ok_aie = 4-2, 4-3 and 4 to proceed 326 ! ok_ade and not ok_aie = 3-1 and 3 to proceed 327 ! not ok_ade and ok_aie = 2-1 and 2 to proceed 328 ! not ok_ade and not ok_aie = 1 to proceed 329 ! therefore the cases have the following corresponding switches 330 ! 1 = not ok_ade and not ok_aie OR not ok_ade and ok_aie and swaero_diag OR ok_ade and not ok_aie and swaero_diag 331 ! 2 = not ok_ade and ok_aie OR ok_aie and ok_ade and swaero_diag 332 ! 3 = ok_ade and not ok_aie OR ok_aie and ok_ade and swaero_diag 333 ! 4 = ok_ade and ok_aie 334 ! 5 = no aerosol feedback wanted or no aerosol at all 335 ! if they are called in this order then the correct call is used to proceed 336 337 REAL(KIND=JPRB) :: ZFSUP_AERO(KPROMA,KLEV+1,5) 338 REAL(KIND=JPRB) :: ZFSDN_AERO(KPROMA,KLEV+1,5) 339 REAL(KIND=JPRB) :: ZFSUP0_AERO(KPROMA,KLEV+1,5) 340 REAL(KIND=JPRB) :: ZFSDN0_AERO(KPROMA,KLEV+1,5) 341 !--LW (CK): 342 REAL(KIND=JPRB) :: LWUP_AERO(KPROMA,KLEV+1,5) 343 REAL(KIND=JPRB) :: LWDN_AERO(KPROMA,KLEV+1,5) 344 REAL(KIND=JPRB) :: LWUP0_AERO(KPROMA,KLEV+1,5) 345 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5) 346 346 347 347 #include "radlsw.intfb.h" 348 348 349 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE) 350 IBEG=KST 351 IEND=KEND 352 353 AEROSOLFEEDBACK_ACTIVE = flag_aer_feedback !NL: externalize aer feedback 354 355 356 !* 1. PREPARATORY WORK 357 ! ---------------- 358 !--OB 359 ! 1.0 INITIALIZATIONS 360 ! -------------- 361 362 ZFSUP_AERO (:,:,:)=0. 363 ZFSDN_AERO (:,:,:)=0. 364 ZFSUP0_AERO(:,:,:)=0. 365 ZFSDN0_AERO(:,:,:)=0. 366 367 LWUP_AERO (:,:,:)=0. 368 LWDN_AERO (:,:,:)=0. 369 LWUP0_AERO(:,:,:)=0. 370 LWDN0_AERO(:,:,:)=0. 371 372 PTAU_ZERO(:,:,:) =1.e-15 373 PPIZA_ZERO(:,:,:)=1.0 374 PCGA_ZERO(:,:,:) =0.0 375 376 PTAU_LW_ZERO(:,:,:) =1.e-15 377 378 379 !* 1.1 LOCAL CONSTANTS 380 ! --------------- 381 382 ZRII0=RII0 383 ZCRAE=RRAE*(RRAE+2.0_JPRB) 384 385 !* 2.1 FULL-LEVEL QUANTITIES 386 387 ZRPR =PAPRSF 388 389 DO JK=1,KLEV 349 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE) 350 IBEG=KST 351 IEND=KEND 352 353 AEROSOLFEEDBACK_ACTIVE = flag_aer_feedback !NL: externalize aer feedback 354 355 356 !* 1. PREPARATORY WORK 357 ! ---------------- 358 !--OB 359 ! 1.0 INITIALIZATIONS 360 ! -------------- 361 362 ZFSUP_AERO (:,:,:)=0. 363 ZFSDN_AERO (:,:,:)=0. 364 ZFSUP0_AERO(:,:,:)=0. 365 ZFSDN0_AERO(:,:,:)=0. 366 367 LWUP_AERO (:,:,:)=0. 368 LWDN_AERO (:,:,:)=0. 369 LWUP0_AERO(:,:,:)=0. 370 LWDN0_AERO(:,:,:)=0. 371 372 PTAU_ZERO(:,:,:) =1.e-15 373 PPIZA_ZERO(:,:,:)=1.0 374 PCGA_ZERO(:,:,:) =0.0 375 376 PTAU_LW_ZERO(:,:,:) =1.e-15 377 378 379 !* 1.1 LOCAL CONSTANTS 380 ! --------------- 381 382 ZRII0=RII0 383 ZCRAE=RRAE*(RRAE+2.0_JPRB) 384 385 !* 2.1 FULL-LEVEL QUANTITIES 386 387 ZRPR =PAPRSF 388 389 DO JK=1,KLEV 390 DO JL=IBEG,IEND 391 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3 392 ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK) 393 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK))) 394 IF (ZRCLC(JL,JK) > REPCLC) THEN 395 ZQLWP(JL,JK)=PQLWP(JL,JK) 396 ZQIWP(JL,JK)=PQIWP(JL,JK) 397 ELSE 398 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 399 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 400 ENDIF 401 ZQRAIN(JL,JK)=0. 402 ZQRAINT(JL,JK)=0. 403 ZRTI(JL,JK) =PT(JL,JK) 404 ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK)) 405 ZQ (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O))) 406 ZEMIW(JL)=PEMIS(JL) 407 ENDDO 408 ENDDO 409 410 IF (NAER == 0) THEN 411 ZRAER=RCAEROS 412 ELSE 413 DO JK=1,KLEV 414 DO JL=IBEG,IEND 415 ZRAER(JL,1,JK)=PAER(JL,JK,1) 416 ZRAER(JL,2,JK)=PAER(JL,JK,2) 417 ZRAER(JL,3,JK)=PAER(JL,JK,3) 418 ZRAER(JL,4,JK)=PAER(JL,JK,4) 419 ZRAER(JL,5,JK)=RCAEROS 420 ZRAER(JL,6,JK)=PAER(JL,JK,6) 421 ENDDO 422 ENDDO 423 ENDIF 424 425 !* 2.2 HALF-LEVEL QUANTITIES 426 427 DO JK=2,KLEV 428 DO JL=IBEG,IEND 429 PTH(JL,JK)=& 430 & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))& 431 & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))& 432 & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1)))) 433 ENDDO 434 ENDDO 435 436 !* 2.3 QUANTITIES AT BOUNDARIES 437 390 438 DO JL=IBEG,IEND 391 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3 392 ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK) 393 ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK))) 394 IF (ZRCLC(JL,JK) > REPCLC) THEN 395 ZQLWP(JL,JK)=PQLWP(JL,JK) 396 ZQIWP(JL,JK)=PQIWP(JL,JK) 397 ELSE 398 ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 399 ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK) 400 ENDIF 401 ZQRAIN(JL,JK)=0. 402 ZQRAINT(JL,JK)=0. 403 ZRTI(JL,JK) =PT(JL,JK) 404 ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK)) 405 ZQ (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O))) 406 ZEMIW(JL)=PEMIS(JL) 407 ENDDO 408 ENDDO 409 410 IF (NAER == 0) THEN 411 ZRAER=RCAEROS 412 ELSE 413 DO JK=1,KLEV 414 DO JL=IBEG,IEND 415 ZRAER(JL,1,JK)=PAER(JL,JK,1) 416 ZRAER(JL,2,JK)=PAER(JL,JK,2) 417 ZRAER(JL,3,JK)=PAER(JL,JK,3) 418 ZRAER(JL,4,JK)=PAER(JL,JK,4) 419 ZRAER(JL,5,JK)=RCAEROS 420 ZRAER(JL,6,JK)=PAER(JL,JK,6) 421 ENDDO 422 ENDDO 423 ENDIF 424 425 !* 2.2 HALF-LEVEL QUANTITIES 426 427 DO JK=2,KLEV 439 PTH(JL,KLEV+1)=PTS(JL) 440 PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))& 441 & /(PAPRSF(JL,1)-PAPRS(JL,2)) 442 ZNBAS(JL)=1. 443 ZNTOP(JL)=1. 444 ZCCNL(JL)=RCCNLND 445 ZCCNO(JL)=RCCNSEA 446 ENDDO 447 448 !* 3.1 SOLAR ZENITH ANGLE IS EARTH'S CURVATURE 449 ! CORRECTED 450 451 ! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010 452 ! 2eme essai en 3D MPL 20052010 453 !DO JL=IBEG,IEND 454 ! ZRMU0(JL)=PMU0(JL) 455 !ENDDO 456 !!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4 428 457 DO JL=IBEG,IEND 429 PTH(JL,JK)=& 430 & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))& 431 & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))& 432 & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1)))) 433 ENDDO 434 ENDDO 435 436 !* 2.3 QUANTITIES AT BOUNDARIES 437 438 DO JL=IBEG,IEND 439 PTH(JL,KLEV+1)=PTS(JL) 440 PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))& 441 & /(PAPRSF(JL,1)-PAPRS(JL,2)) 442 ZNBAS(JL)=1. 443 ZNTOP(JL)=1. 444 ZCCNL(JL)=RCCNLND 445 ZCCNO(JL)=RCCNSEA 446 ENDDO 447 448 !* 3.1 SOLAR ZENITH ANGLE IS EARTH'S CURVATURE 449 ! CORRECTED 450 451 ! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010 452 ! 2eme essai en 3D MPL 20052010 453 !DO JL=IBEG,IEND 454 ! ZRMU0(JL)=PMU0(JL) 455 !ENDDO 456 !!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4 457 DO JL=IBEG,IEND 458 IF (PMU0(JL) > 1.E-10_JPRB) THEN 459 ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL)) 460 ELSE 461 ZRMU0(JL)= RRAE/SQRT(ZCRAE) 462 ENDIF 463 ENDDO 464 465 !* 4.1 CALL TO ACTUAL RADIATION SCHEME 466 ! 467 !----now we make multiple calls to the radiation according to which 468 !----aerosol flags are on 469 470 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN 471 472 !--Case 1 473 IF ( ( .not. ok_ade .AND. .not. ok_aie ) .OR. & 474 & ( .not. ok_ade .AND. ok_aie .AND. swaero_diag ) .OR. & 475 & ( ok_ade .AND. .not. ok_aie .AND. swaero_diag ) ) THEN 476 477 ! natural aerosols for direct and indirect effect 478 ! PI cloud optical properties 479 ! use PREF_LIQ_PI and PREF_ICE_PI 480 ! use NAT aerosol optical properties 481 ! store fluxes in index 1 482 483 CALL RADLSW (& 484 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 485 & ZRII0 ,& 486 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 487 & ZCCNL , ZCCNO ,& 488 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 489 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 490 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 491 & PREF_LIQ_PI, PREF_ICE_PI,& 492 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 493 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 494 & PSFSWDIF,PFSDNN, PFSDNV ,& 495 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 496 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 497 498 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 499 ZFSUP0_AERO(:,:,1) = PFSCUP(:,:) 500 ZFSDN0_AERO(:,:,1) = PFSCDN(:,:) 501 502 ZFSUP_AERO(:,:,1) = PFSUP(:,:) 503 ZFSDN_AERO(:,:,1) = PFSDN(:,:) 504 505 LWUP0_AERO(:,:,1) = PFLUC(:,1,:) 506 LWDN0_AERO(:,:,1) = PFLUC(:,2,:) 507 508 LWUP_AERO(:,:,1) = PFLUX(:,1,:) 509 LWDN_AERO(:,:,1) = PFLUX(:,2,:) 510 511 ENDIF 512 513 !--Case 2 514 IF ( ( .not. ok_ade .AND. ok_aie ) .OR. & 515 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN 516 517 ! natural aerosols for direct indirect effect 518 ! use NAT aerosol optical properties 519 ! PD cloud optical properties 520 ! use PREF_LIQ and PREF_ICE 521 ! store fluxes in index 2 522 523 CALL RADLSW (& 524 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 525 & ZRII0 ,& 526 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 527 & ZCCNL , ZCCNO ,& 528 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 529 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 530 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 531 & PREF_LIQ, PREF_ICE,& 532 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 533 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 534 & PSFSWDIF,PFSDNN, PFSDNV ,& 535 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 536 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 537 538 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 539 ZFSUP0_AERO(:,:,2) = PFSCUP(:,:) 540 ZFSDN0_AERO(:,:,2) = PFSCDN(:,:) 541 542 ZFSUP_AERO(:,:,2) = PFSUP(:,:) 543 ZFSDN_AERO(:,:,2) = PFSDN(:,:) 544 545 LWUP0_AERO(:,:,2) = PFLUC(:,1,:) 546 LWDN0_AERO(:,:,2) = PFLUC(:,2,:) 547 548 LWUP_AERO(:,:,2) = PFLUX(:,1,:) 549 LWDN_AERO(:,:,2) = PFLUX(:,2,:) 550 551 ENDIF ! ok_aie 552 553 !--Case 3 554 IF ( ( ok_ade .AND. .not. ok_aie ) .OR. & 555 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN 556 557 ! direct effect of total aerosol activated 558 ! TOT aerosols for direct effect 559 ! PI cloud optical properties 560 ! use PREF_LIQ_PI and PREF_ICE_PI 561 ! STORE fluxes in index 3 562 563 CALL RADLSW (& 564 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 565 & ZRII0 ,& 566 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 567 & ZCCNL , ZCCNO ,& 568 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 569 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 570 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 571 & PREF_LIQ_PI, PREF_ICE_PI,& 572 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 573 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 574 & PSFSWDIF,PFSDNN, PFSDNV ,& 575 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 576 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 577 578 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 579 ZFSUP0_AERO(:,:,3) = PFSCUP(:,:) 580 ZFSDN0_AERO(:,:,3) = PFSCDN(:,:) 581 582 ZFSUP_AERO(:,:,3) = PFSUP(:,:) 583 ZFSDN_AERO(:,:,3) = PFSDN(:,:) 584 585 LWUP0_AERO(:,:,3) = PFLUC(:,1,:) 586 LWDN0_AERO(:,:,3) = PFLUC(:,2,:) 587 588 LWUP_AERO(:,:,3) = PFLUX(:,1,:) 589 LWDN_AERO(:,:,3) = PFLUX(:,2,:) 590 591 ENDIF !-end ok_ade 592 593 !--Case 4 594 IF (ok_ade .and. ok_aie) THEN 595 596 ! total aerosols for direct indirect effect 597 ! use TOT aerosol optical properties 598 ! PD cloud optical properties 599 ! use PREF_LIQ and PREF_ICE 600 ! store fluxes in index 4 601 602 CALL RADLSW (& 603 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 604 & ZRII0 ,& 605 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 606 & ZCCNL , ZCCNO ,& 607 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 608 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 609 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 610 & PREF_LIQ, PREF_ICE,& 611 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 612 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 613 & PSFSWDIF,PFSDNN, PFSDNV ,& 614 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 615 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 616 617 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 618 ZFSUP0_AERO(:,:,4) = PFSCUP(:,:) 619 ZFSDN0_AERO(:,:,4) = PFSCDN(:,:) 620 621 ZFSUP_AERO(:,:,4) = PFSUP(:,:) 622 ZFSDN_AERO(:,:,4) = PFSDN(:,:) 623 624 LWUP0_AERO(:,:,4) = PFLUC(:,1,:) 625 LWDN0_AERO(:,:,4) = PFLUC(:,2,:) 626 627 LWUP_AERO(:,:,4) = PFLUX(:,1,:) 628 LWDN_AERO(:,:,4) = PFLUX(:,2,:) 629 630 ENDIF ! ok_ade .and. ok_aie 631 632 ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat 633 634 ! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false 635 IF (.not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 .OR. swaerofree_diag) THEN 636 637 ! ZERO aerosol effect 638 ! ZERO aerosol optical depth 639 ! STANDARD cloud optical properties 640 ! STORE fluxes in index 5 641 642 CALL RADLSW (& 643 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 644 & ZRII0 ,& 645 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 646 & ZCCNL , ZCCNO ,& 647 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 648 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 649 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 650 !--this needs to be changed to fixed cloud optical properties 651 & PREF_LIQ_PI, PREF_ICE_PI,& 652 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 653 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 654 & PSFSWDIF,PFSDNN, PFSDNV ,& 655 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,& 656 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 657 658 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 659 ZFSUP0_AERO(:,:,5) = PFSCUP(:,:) 660 ZFSDN0_AERO(:,:,5) = PFSCDN(:,:) 661 662 ZFSUP_AERO(:,:,5) = PFSUP(:,:) 663 ZFSDN_AERO(:,:,5) = PFSDN(:,:) 664 665 LWUP0_AERO(:,:,5) = PFLUC(:,1,:) 666 LWDN0_AERO(:,:,5) = PFLUC(:,2,:) 667 668 LWUP_AERO(:,:,5) = PFLUX(:,1,:) 669 LWDN_AERO(:,:,5) = PFLUX(:,2,:) 670 671 ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE 672 673 !* 4.2 TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES 674 675 DO JK=1,KLEV+1 458 IF (PMU0(JL) > 1.E-10_JPRB) THEN 459 ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL)) 460 ELSE 461 ZRMU0(JL)= RRAE/SQRT(ZCRAE) 462 ENDIF 463 ENDDO 464 465 !* 4.1 CALL TO ACTUAL RADIATION SCHEME 466 ! 467 !----now we make multiple calls to the radiation according to which 468 !----aerosol flags are on 469 470 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN 471 472 !--Case 1 473 IF ( ( .not. ok_ade .AND. .not. ok_aie ) .OR. & 474 & ( .not. ok_ade .AND. ok_aie .AND. swaero_diag ) .OR. & 475 & ( ok_ade .AND. .not. ok_aie .AND. swaero_diag ) ) THEN 476 477 ! natural aerosols for direct and indirect effect 478 ! PI cloud optical properties 479 ! use PREF_LIQ_PI and PREF_ICE_PI 480 ! use NAT aerosol optical properties 481 ! store fluxes in index 1 482 483 CALL RADLSW (& 484 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 485 & ZRII0 ,& 486 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 487 & ZCCNL , ZCCNO ,& 488 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 489 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 490 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 491 & PREF_LIQ_PI, PREF_ICE_PI,& 492 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 493 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 494 & PSFSWDIF,PFSDNN, PFSDNV ,& 495 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 496 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 497 498 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 499 ZFSUP0_AERO(:,:,1) = PFSCUP(:,:) 500 ZFSDN0_AERO(:,:,1) = PFSCDN(:,:) 501 502 ZFSUP_AERO(:,:,1) = PFSUP(:,:) 503 ZFSDN_AERO(:,:,1) = PFSDN(:,:) 504 505 LWUP0_AERO(:,:,1) = PFLUC(:,1,:) 506 LWDN0_AERO(:,:,1) = PFLUC(:,2,:) 507 508 LWUP_AERO(:,:,1) = PFLUX(:,1,:) 509 LWDN_AERO(:,:,1) = PFLUX(:,2,:) 510 511 ENDIF 512 513 !--Case 2 514 IF ( ( .not. ok_ade .AND. ok_aie ) .OR. & 515 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN 516 517 ! natural aerosols for direct indirect effect 518 ! use NAT aerosol optical properties 519 ! PD cloud optical properties 520 ! use PREF_LIQ and PREF_ICE 521 ! store fluxes in index 2 522 523 CALL RADLSW (& 524 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 525 & ZRII0 ,& 526 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 527 & ZCCNL , ZCCNO ,& 528 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 529 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 530 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 531 & PREF_LIQ, PREF_ICE,& 532 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 533 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 534 & PSFSWDIF,PFSDNN, PFSDNV ,& 535 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 536 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 537 538 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 539 ZFSUP0_AERO(:,:,2) = PFSCUP(:,:) 540 ZFSDN0_AERO(:,:,2) = PFSCDN(:,:) 541 542 ZFSUP_AERO(:,:,2) = PFSUP(:,:) 543 ZFSDN_AERO(:,:,2) = PFSDN(:,:) 544 545 LWUP0_AERO(:,:,2) = PFLUC(:,1,:) 546 LWDN0_AERO(:,:,2) = PFLUC(:,2,:) 547 548 LWUP_AERO(:,:,2) = PFLUX(:,1,:) 549 LWDN_AERO(:,:,2) = PFLUX(:,2,:) 550 551 ENDIF ! ok_aie 552 553 !--Case 3 554 IF ( ( ok_ade .AND. .not. ok_aie ) .OR. & 555 & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN 556 557 ! direct effect of total aerosol activated 558 ! TOT aerosols for direct effect 559 ! PI cloud optical properties 560 ! use PREF_LIQ_PI and PREF_ICE_PI 561 ! STORE fluxes in index 3 562 563 CALL RADLSW (& 564 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 565 & ZRII0 ,& 566 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 567 & ZCCNL , ZCCNO ,& 568 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 569 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 570 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 571 & PREF_LIQ_PI, PREF_ICE_PI,& 572 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 573 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 574 & PSFSWDIF,PFSDNN, PFSDNV ,& 575 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 576 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 577 578 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 579 ZFSUP0_AERO(:,:,3) = PFSCUP(:,:) 580 ZFSDN0_AERO(:,:,3) = PFSCDN(:,:) 581 582 ZFSUP_AERO(:,:,3) = PFSUP(:,:) 583 ZFSDN_AERO(:,:,3) = PFSDN(:,:) 584 585 LWUP0_AERO(:,:,3) = PFLUC(:,1,:) 586 LWDN0_AERO(:,:,3) = PFLUC(:,2,:) 587 588 LWUP_AERO(:,:,3) = PFLUX(:,1,:) 589 LWDN_AERO(:,:,3) = PFLUX(:,2,:) 590 591 ENDIF !-end ok_ade 592 593 !--Case 4 594 IF (ok_ade .and. ok_aie) THEN 595 596 ! total aerosols for direct indirect effect 597 ! use TOT aerosol optical properties 598 ! PD cloud optical properties 599 ! use PREF_LIQ and PREF_ICE 600 ! store fluxes in index 4 601 602 CALL RADLSW (& 603 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 604 & ZRII0 ,& 605 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 606 & ZCCNL , ZCCNO ,& 607 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 608 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 609 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 610 & PREF_LIQ, PREF_ICE,& 611 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 612 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 613 & PSFSWDIF,PFSDNN, PFSDNV ,& 614 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 615 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 616 617 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 618 ZFSUP0_AERO(:,:,4) = PFSCUP(:,:) 619 ZFSDN0_AERO(:,:,4) = PFSCDN(:,:) 620 621 ZFSUP_AERO(:,:,4) = PFSUP(:,:) 622 ZFSDN_AERO(:,:,4) = PFSDN(:,:) 623 624 LWUP0_AERO(:,:,4) = PFLUC(:,1,:) 625 LWDN0_AERO(:,:,4) = PFLUC(:,2,:) 626 627 LWUP_AERO(:,:,4) = PFLUX(:,1,:) 628 LWDN_AERO(:,:,4) = PFLUX(:,2,:) 629 630 ENDIF ! ok_ade .and. ok_aie 631 632 ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat 633 634 ! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false 635 IF (.not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 .OR. swaerofree_diag) THEN 636 637 ! ZERO aerosol effect 638 ! ZERO aerosol optical depth 639 ! STANDARD cloud optical properties 640 ! STORE fluxes in index 5 641 642 CALL RADLSW (& 643 & IBEG , IEND , KPROMA , KLEV , KMODE , NAER,& 644 & ZRII0 ,& 645 & ZRAER , PALBD , PALBP , PAPRS , ZRPR ,& 646 & ZCCNL , ZCCNO ,& 647 & PCCO2 , ZRCLC , PDP , PEMIS , ZEMIW ,PSLM , ZRMU0 , ZPQO3,& 648 & ZQ , ZQIWP , ZQLWP , ZQS , ZQRAIN,ZQRAINT ,& 649 & PTH , ZRTI , PTS , ZNBAS , ZNTOP ,& 650 !--this needs to be changed to fixed cloud optical properties 651 & PREF_LIQ_PI, PREF_ICE_PI,& 652 & ZEMIT , ZFCT , ZFLT , ZFCS , ZFLS ,& 653 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 654 & PSFSWDIF,PFSDNN, PFSDNV ,& 655 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,& 656 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 657 658 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4 659 ZFSUP0_AERO(:,:,5) = PFSCUP(:,:) 660 ZFSDN0_AERO(:,:,5) = PFSCDN(:,:) 661 662 ZFSUP_AERO(:,:,5) = PFSUP(:,:) 663 ZFSDN_AERO(:,:,5) = PFSDN(:,:) 664 665 LWUP0_AERO(:,:,5) = PFLUC(:,1,:) 666 LWDN0_AERO(:,:,5) = PFLUC(:,2,:) 667 668 LWUP_AERO(:,:,5) = PFLUX(:,1,:) 669 LWDN_AERO(:,:,5) = PFLUX(:,2,:) 670 671 ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE 672 673 !* 4.2 TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES 674 675 DO JK=1,KLEV+1 676 DO JL=IBEG,IEND 677 PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL)) 678 PLWFT(JL,JK)=ZFLT(JL,JK) 679 ENDDO 680 ENDDO 681 682 ZEMTD=PLWFT 683 ZEMTU=PLWFT 684 676 685 DO JL=IBEG,IEND 677 PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL)) 678 PLWFT(JL,JK)=ZFLT(JL,JK) 679 ENDDO 680 ENDDO 681 682 ZEMTD=PLWFT 683 ZEMTU=PLWFT 684 685 DO JL=IBEG,IEND 686 ZTRSOC(JL, 1)=ZFCS(JL, 1)/(ZRII0*ZRMU0(JL)) 687 ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL)) 688 ZEMTC (JL, 1)=ZFCT(JL, 1) 689 ZEMTC (JL, 2)=ZFCT(JL,KLEV+1) 690 ENDDO 691 692 ! ------------ -- ------- -- ---- ----- 693 !* 5.1 STORAGE OF TRANSMISSIVITY AND EMISSIVITIES 694 !* IN KPROMA-LONG ARRAYS 695 696 DO JK=1,KLEV+1 686 ZTRSOC(JL, 1)=ZFCS(JL, 1)/(ZRII0*ZRMU0(JL)) 687 ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL)) 688 ZEMTC (JL, 1)=ZFCT(JL, 1) 689 ZEMTC (JL, 2)=ZFCT(JL,KLEV+1) 690 ENDDO 691 692 ! ------------ -- ------- -- ---- ----- 693 !* 5.1 STORAGE OF TRANSMISSIVITY AND EMISSIVITIES 694 !* IN KPROMA-LONG ARRAYS 695 696 DO JK=1,KLEV+1 697 DO JL=IBEG,IEND 698 PEMTD(JL,JK)=ZEMTD(JL,JK) 699 PEMTU(JL,JK)=ZEMTU(JL,JK) 700 PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK))) 701 ENDDO 702 ENDDO 703 DO JK=1,2 704 DO JL=IBEG,IEND 705 PCEMTR(JL,JK)=ZEMTC (JL,JK) 706 PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK))) 707 ENDDO 708 ENDDO 697 709 DO JL=IBEG,IEND 698 PEMTD(JL,JK)=ZEMTD(JL,JK) 699 PEMTU(JL,JK)=ZEMTU(JL,JK) 700 PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK))) 701 ENDDO 702 ENDDO 703 DO JK=1,2 710 PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL)))) 711 ENDDO 712 713 !* 7.3 RECONSTRUCT FLUXES FOR DIAGNOSTICS 714 704 715 DO JL=IBEG,IEND 705 PCEMTR(JL,JK)=ZEMTC (JL,JK) 706 PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK))) 707 ENDDO 708 ENDDO 709 DO JL=IBEG,IEND 710 PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL)))) 711 ENDDO 712 713 !* 7.3 RECONSTRUCT FLUXES FOR DIAGNOSTICS 714 715 DO JL=IBEG,IEND 716 IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB 717 ENDDO 718 DO JK=1,KLEV+1 719 DO JL=IBEG,IEND 720 PLWFT(JL,JK)=PEMTD(JL,JK) 721 PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK) 722 ENDDO 723 ENDDO 724 DO JK=1,2 725 DO JL=IBEG,IEND 726 PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK) 727 PLWFC(JL,JK)=PCEMTR(JL,JK) 728 ENDDO 729 ENDDO 730 731 !* 8.0 DIAGNOSTICS 732 !---Now we copy back the correct fields to proceed to the next timestep 733 734 IF ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN 735 736 IF ( ok_ade .and. ok_aie ) THEN 737 PFSUP(:,:) = ZFSUP_AERO(:,:,4) 738 PFSDN(:,:) = ZFSDN_AERO(:,:,4) 739 PFSCUP(:,:) = ZFSUP0_AERO(:,:,4) 740 PFSCDN(:,:) = ZFSDN0_AERO(:,:,4) 741 742 PFLUX(:,1,:) = LWUP_AERO(:,:,4) 743 PFLUX(:,2,:) = LWDN_AERO(:,:,4) 744 PFLUC(:,1,:) = LWUP0_AERO(:,:,4) 745 PFLUC(:,2,:) = LWDN0_AERO(:,:,4) 716 IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB 717 ENDDO 718 DO JK=1,KLEV+1 719 DO JL=IBEG,IEND 720 PLWFT(JL,JK)=PEMTD(JL,JK) 721 PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK) 722 ENDDO 723 ENDDO 724 DO JK=1,2 725 DO JL=IBEG,IEND 726 PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK) 727 PLWFC(JL,JK)=PCEMTR(JL,JK) 728 ENDDO 729 ENDDO 730 731 !* 8.0 DIAGNOSTICS 732 !---Now we copy back the correct fields to proceed to the next timestep 733 734 IF ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN 735 736 IF ( ok_ade .and. ok_aie ) THEN 737 PFSUP(:,:) = ZFSUP_AERO(:,:,4) 738 PFSDN(:,:) = ZFSDN_AERO(:,:,4) 739 PFSCUP(:,:) = ZFSUP0_AERO(:,:,4) 740 PFSCDN(:,:) = ZFSDN0_AERO(:,:,4) 741 742 PFLUX(:,1,:) = LWUP_AERO(:,:,4) 743 PFLUX(:,2,:) = LWDN_AERO(:,:,4) 744 PFLUC(:,1,:) = LWUP0_AERO(:,:,4) 745 PFLUC(:,2,:) = LWDN0_AERO(:,:,4) 746 ENDIF 747 748 IF ( ok_ade .and. (.not. ok_aie) ) THEN 749 PFSUP(:,:) = ZFSUP_AERO(:,:,3) 750 PFSDN(:,:) = ZFSDN_AERO(:,:,3) 751 PFSCUP(:,:) = ZFSUP0_AERO(:,:,3) 752 PFSCDN(:,:) = ZFSDN0_AERO(:,:,3) 753 754 PFLUX(:,1,:) = LWUP_AERO(:,:,3) 755 PFLUX(:,2,:) = LWDN_AERO(:,:,3) 756 PFLUC(:,1,:) = LWUP0_AERO(:,:,3) 757 PFLUC(:,2,:) = LWDN0_AERO(:,:,3) 758 ENDIF 759 760 IF ( (.not. ok_ade) .and. ok_aie ) THEN 761 PFSUP(:,:) = ZFSUP_AERO(:,:,2) 762 PFSDN(:,:) = ZFSDN_AERO(:,:,2) 763 PFSCUP(:,:) = ZFSUP0_AERO(:,:,2) 764 PFSCDN(:,:) = ZFSDN0_AERO(:,:,2) 765 766 PFLUX(:,1,:) = LWUP_AERO(:,:,2) 767 PFLUX(:,2,:) = LWDN_AERO(:,:,2) 768 PFLUC(:,1,:) = LWUP0_AERO(:,:,2) 769 PFLUC(:,2,:) = LWDN0_AERO(:,:,2) 770 ENDiF 771 772 IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN 773 PFSUP(:,:) = ZFSUP_AERO(:,:,1) 774 PFSDN(:,:) = ZFSDN_AERO(:,:,1) 775 PFSCUP(:,:) = ZFSUP0_AERO(:,:,1) 776 PFSCDN(:,:) = ZFSDN0_AERO(:,:,1) 777 778 PFLUX(:,1,:) = LWUP_AERO(:,:,1) 779 PFLUX(:,2,:) = LWDN_AERO(:,:,1) 780 PFLUC(:,1,:) = LWUP0_AERO(:,:,1) 781 PFLUC(:,2,:) = LWDN0_AERO(:,:,1) 782 ENDIF 783 784 ! The following allows to compute the forcing diagostics without 785 ! letting the aerosol forcing act on the meteorology 786 ! SEE logic above 787 788 ELSE !--not AEROSOLFEEDBACK_ACTIVE 789 790 PFSUP(:,:) = ZFSUP_AERO(:,:,5) 791 PFSDN(:,:) = ZFSDN_AERO(:,:,5) 792 PFSCUP(:,:) = ZFSUP0_AERO(:,:,5) 793 PFSCDN(:,:) = ZFSDN0_AERO(:,:,5) 794 795 PFLUX(:,1,:) = LWUP_AERO(:,:,5) 796 PFLUX(:,2,:) = LWDN_AERO(:,:,5) 797 PFLUC(:,1,:) = LWUP0_AERO(:,:,5) 798 PFLUC(:,2,:) = LWDN0_AERO(:,:,5) 799 746 800 ENDIF 747 801 748 IF ( ok_ade .and. (.not. ok_aie) ) THEN 749 PFSUP(:,:) = ZFSUP_AERO(:,:,3) 750 PFSDN(:,:) = ZFSDN_AERO(:,:,3) 751 PFSCUP(:,:) = ZFSUP0_AERO(:,:,3) 752 PFSCDN(:,:) = ZFSDN0_AERO(:,:,3) 753 754 PFLUX(:,1,:) = LWUP_AERO(:,:,3) 755 PFLUX(:,2,:) = LWDN_AERO(:,:,3) 756 PFLUC(:,1,:) = LWUP0_AERO(:,:,3) 757 PFLUC(:,2,:) = LWDN0_AERO(:,:,3) 802 !--VolMIP Strat/Surf 803 !--only ok_ade + ok_aie case treated 804 IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN 805 !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2 806 IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING 807 volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2) 808 ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING 809 !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4 810 PFSUP(:,:) = ZFSUP_AERO(:,:,2) 811 PFSDN(:,:) = ZFSDN_AERO(:,:,2) 812 PFSCUP(:,:) = ZFSUP0_AERO(:,:,2) 813 PFSCDN(:,:) = ZFSDN0_AERO(:,:,2) 814 PFLUX(:,1,:) = LWUP_AERO(:,:,2) 815 PFLUX(:,2,:) = LWDN_AERO(:,:,2) 816 PFLUC(:,1,:) = LWDN0_AERO(:,:,2) 817 PFLUC(:,2,:) = LWDN0_AERO(:,:,2) 818 volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4) 819 ENDIF 758 820 ENDIF 759 760 IF ( (.not. ok_ade) .and. ok_aie ) THEN 761 PFSUP(:,:) = ZFSUP_AERO(:,:,2) 762 PFSDN(:,:) = ZFSDN_AERO(:,:,2) 763 PFSCUP(:,:) = ZFSUP0_AERO(:,:,2) 764 PFSCDN(:,:) = ZFSDN0_AERO(:,:,2) 765 766 PFLUX(:,1,:) = LWUP_AERO(:,:,2) 767 PFLUX(:,2,:) = LWDN_AERO(:,:,2) 768 PFLUC(:,1,:) = LWUP0_AERO(:,:,2) 769 PFLUC(:,2,:) = LWDN0_AERO(:,:,2) 770 ENDiF 771 772 IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN 773 PFSUP(:,:) = ZFSUP_AERO(:,:,1) 774 PFSDN(:,:) = ZFSDN_AERO(:,:,1) 775 PFSCUP(:,:) = ZFSUP0_AERO(:,:,1) 776 PFSCDN(:,:) = ZFSDN0_AERO(:,:,1) 777 778 PFLUX(:,1,:) = LWUP_AERO(:,:,1) 779 PFLUX(:,2,:) = LWDN_AERO(:,:,1) 780 PFLUC(:,1,:) = LWUP0_AERO(:,:,1) 781 PFLUC(:,2,:) = LWDN0_AERO(:,:,1) 821 !--End VolMIP Strat/Surf 822 823 IF (swaerofree_diag) THEN 824 ! copy shortwave clear-sky clean (no aerosol) case 825 PFSCCUP(:,:) = ZFSUP0_AERO(:,:,5) 826 PFSCCDN(:,:) = ZFSDN0_AERO(:,:,5) 827 ! copy longwave clear-sky clean (no aerosol) case 828 PFLCCUP(:,:) = LWUP0_AERO(:,:,5) 829 PFLCCDN(:,:) = LWDN0_AERO(:,:,5) 782 830 ENDIF 783 831 784 ! The following allows to compute the forcing diagostics without 785 ! letting the aerosol forcing act on the meteorology 786 ! SEE logic above 787 788 ELSE !--not AEROSOLFEEDBACK_ACTIVE 789 790 PFSUP(:,:) = ZFSUP_AERO(:,:,5) 791 PFSDN(:,:) = ZFSDN_AERO(:,:,5) 792 PFSCUP(:,:) = ZFSUP0_AERO(:,:,5) 793 PFSCDN(:,:) = ZFSDN0_AERO(:,:,5) 794 795 PFLUX(:,1,:) = LWUP_AERO(:,:,5) 796 PFLUX(:,2,:) = LWDN_AERO(:,:,5) 797 PFLUC(:,1,:) = LWUP0_AERO(:,:,5) 798 PFLUC(:,2,:) = LWDN0_AERO(:,:,5) 799 800 ENDIF 801 802 !--VolMIP Strat/Surf 803 !--only ok_ade + ok_aie case treated 804 IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN 805 !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2 806 IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING 807 volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2) 808 ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING 809 !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4 810 PFSUP(:,:) = ZFSUP_AERO(:,:,2) 811 PFSDN(:,:) = ZFSDN_AERO(:,:,2) 812 PFSCUP(:,:) = ZFSUP0_AERO(:,:,2) 813 PFSCDN(:,:) = ZFSDN0_AERO(:,:,2) 814 PFLUX(:,1,:) = LWUP_AERO(:,:,2) 815 PFLUX(:,2,:) = LWDN_AERO(:,:,2) 816 PFLUC(:,1,:) = LWDN0_AERO(:,:,2) 817 PFLUC(:,2,:) = LWDN0_AERO(:,:,2) 818 volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4) 819 ENDIF 820 ENDIF 821 !--End VolMIP Strat/Surf 822 823 IF (swaerofree_diag) THEN 824 ! copy shortwave clear-sky clean (no aerosol) case 825 PFSCCUP(:,:) = ZFSUP0_AERO(:,:,5) 826 PFSCCDN(:,:) = ZFSDN0_AERO(:,:,5) 827 ! copy longwave clear-sky clean (no aerosol) case 828 PFLCCUP(:,:) = LWUP0_AERO(:,:,5) 829 PFLCCDN(:,:) = LWDN0_AERO(:,:,5) 830 ENDIF 831 832 !OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!! 833 ! net anthropogenic forcing direct and 1st indirect effect diagnostics 834 ! requires a natural aerosol field read and used 835 ! Difference of net fluxes from double call to radiation 836 ! Will need to be extended to LW radiation -> done by CK (2014-05-23) 837 838 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN 839 840 IF (ok_ade.AND.ok_aie) THEN 841 842 ! direct anthropogenic forcing 843 PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) 844 PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,4) -ZFSUP_AERO(:,KLEV+1,4)) -(ZFSDN_AERO(:,KLEV+1,2) -ZFSUP_AERO(:,KLEV+1,2)) 845 PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 846 PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 847 IF(ok_volcan) THEN 848 PSWADAERO(:,:) = (ZFSDN_AERO(:,:,4) -ZFSUP_AERO(:,:,4)) -(ZFSDN_AERO(:,:,2) -ZFSUP_AERO(:,:,2)) !--NL 832 !OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!! 833 ! net anthropogenic forcing direct and 1st indirect effect diagnostics 834 ! requires a natural aerosol field read and used 835 ! Difference of net fluxes from double call to radiation 836 ! Will need to be extended to LW radiation -> done by CK (2014-05-23) 837 838 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN 839 840 IF (ok_ade.AND.ok_aie) THEN 841 842 ! direct anthropogenic forcing 843 PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) 844 PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,4) -ZFSUP_AERO(:,KLEV+1,4)) -(ZFSDN_AERO(:,KLEV+1,2) -ZFSUP_AERO(:,KLEV+1,2)) 845 PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 846 PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 847 IF(ok_volcan) THEN 848 PSWADAERO(:,:) = (ZFSDN_AERO(:,:,4) -ZFSUP_AERO(:,:,4)) -(ZFSDN_AERO(:,:,2) -ZFSUP_AERO(:,:,2)) !--NL 849 ENDIF 850 851 ! indirect anthropogenic forcing 852 PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) 853 PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3)) 854 855 ! Cloud radiative forcing with natural aerosol for direct effect 856 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 857 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 858 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 859 PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4)) 860 PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4)) 861 ! Cloud radiative forcing with no direct effect at all 862 PSOLSWCFAERO(:,3) = 0.0 863 PTOPSWCFAERO(:,3) = 0.0 864 865 ! LW direct anthropogenic forcing 866 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) 867 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2)) 868 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4) -LWUP0_AERO(:,1,4)) -(-LWDN0_AERO(:,1,2) -LWUP0_AERO(:,1,2)) 869 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2)) 870 IF(ok_volcan) THEN 871 PLWADAERO(:,:) = (-LWDN_AERO(:,:,4) -LWUP_AERO(:,:,4)) -(-LWDN_AERO(:,:,2) -LWUP_AERO(:,:,2)) !--NL 872 ENDIF 873 874 ! LW indirect anthropogenic forcing 875 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) 876 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3)) 877 849 878 ENDIF 850 879 851 ! indirect anthropogenic forcing 852 PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) 853 PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3)) 854 855 ! Cloud radiative forcing with natural aerosol for direct effect 856 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 857 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 858 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 859 PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,4) -ZFSUP_AERO(:,1,4)) -(ZFSDN0_AERO(:,1,4) -ZFSUP0_AERO(:,1,4)) 860 PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4)) 861 ! Cloud radiative forcing with no direct effect at all 862 PSOLSWCFAERO(:,3) = 0.0 863 PTOPSWCFAERO(:,3) = 0.0 864 865 ! LW direct anthropogenic forcing 866 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) 867 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2)) 868 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4) -LWUP0_AERO(:,1,4)) -(-LWDN0_AERO(:,1,2) -LWUP0_AERO(:,1,2)) 869 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2)) 870 IF(ok_volcan) THEN 871 PLWADAERO(:,:) = (-LWDN_AERO(:,:,4) -LWUP_AERO(:,:,4)) -(-LWDN_AERO(:,:,2) -LWUP_AERO(:,:,2)) !--NL 880 IF (ok_ade.AND..NOT.ok_aie) THEN 881 882 ! direct anthropogenic forcing 883 PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) 884 PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,3) -ZFSUP_AERO(:,KLEV+1,3)) -(ZFSDN_AERO(:,KLEV+1,1) -ZFSUP_AERO(:,KLEV+1,1)) 885 PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 886 PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 887 IF(ok_volcan) THEN 888 PSWADAERO(:,:) = (ZFSDN_AERO(:,:,3) -ZFSUP_AERO(:,:,3)) -(ZFSDN_AERO(:,:,1) -ZFSUP_AERO(:,:,1)) !--NL 889 ENDIF 890 891 ! indirect anthropogenic forcing 892 PSOLSWAIAERO(:) = 0.0 893 PTOPSWAIAERO(:) = 0.0 894 895 ! Cloud radiative forcing with natural aerosol for direct effect 896 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 897 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 898 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 899 PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3)) 900 PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3)) 901 ! Cloud radiative forcing with no direct effect at all 902 PSOLSWCFAERO(:,3) = 0.0 903 PTOPSWCFAERO(:,3) = 0.0 904 905 ! LW direct anthropogenic forcing 906 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 907 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1)) 908 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3) -LWUP0_AERO(:,1,3)) -(-LWDN0_AERO(:,1,1) -LWUP0_AERO(:,1,1)) 909 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1)) 910 IF(ok_volcan) THEN 911 PLWADAERO(:,:) = (-LWDN_AERO(:,:,3) -LWUP_AERO(:,:,3)) -(-LWDN_AERO(:,:,1) -LWUP_AERO(:,:,1)) !--NL 912 ENDIF 913 914 ! LW indirect anthropogenic forcing 915 PSOLLWAIAERO(:) = 0.0 916 PTOPLWAIAERO(:) = 0.0 917 872 918 ENDIF 873 919 874 ! LW indirect anthropogenic forcing 875 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) 876 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3)) 877 878 ENDIF 879 880 IF (ok_ade.AND..NOT.ok_aie) THEN 881 882 ! direct anthropogenic forcing 883 PSOLSWADAERO(:) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) 884 PTOPSWADAERO(:) = (ZFSDN_AERO(:,KLEV+1,3) -ZFSUP_AERO(:,KLEV+1,3)) -(ZFSDN_AERO(:,KLEV+1,1) -ZFSUP_AERO(:,KLEV+1,1)) 885 PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 886 PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 887 IF(ok_volcan) THEN 888 PSWADAERO(:,:) = (ZFSDN_AERO(:,:,3) -ZFSUP_AERO(:,:,3)) -(ZFSDN_AERO(:,:,1) -ZFSUP_AERO(:,:,1)) !--NL 920 IF (.NOT.ok_ade.AND.ok_aie) THEN 921 922 ! direct anthropogenic forcing 923 PSOLSWADAERO(:) = 0.0 924 PTOPSWADAERO(:) = 0.0 925 PSOLSWAD0AERO(:) = 0.0 926 PTOPSWAD0AERO(:) = 0.0 927 IF(ok_volcan) THEN 928 PSWADAERO(:,:) = 0.0 !--NL 929 ENDIF 930 931 ! indirect anthropogenic forcing 932 PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) 933 PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1)) 934 935 ! Cloud radiative forcing with natural aerosol for direct effect 936 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 937 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 938 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 939 PSOLSWCFAERO(:,2) = 0.0 940 PTOPSWCFAERO(:,2) = 0.0 941 ! Cloud radiative forcing with no direct effect at all 942 PSOLSWCFAERO(:,3) = 0.0 943 PTOPSWCFAERO(:,3) = 0.0 944 945 ! LW direct anthropogenic forcing 946 PSOLLWADAERO(:) = 0.0 947 PTOPLWADAERO(:) = 0.0 948 PSOLLWAD0AERO(:) = 0.0 949 PTOPLWAD0AERO(:) = 0.0 950 IF(ok_volcan) THEN 951 PLWADAERO(:,:) = 0.0 !--NL 952 ENDIF 953 954 ! LW indirect anthropogenic forcing 955 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 956 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1)) 957 889 958 ENDIF 890 959 891 ! indirect anthropogenic forcing 892 PSOLSWAIAERO(:) = 0.0 893 PTOPSWAIAERO(:) = 0.0 894 895 ! Cloud radiative forcing with natural aerosol for direct effect 896 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 897 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 898 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 899 PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,3) -ZFSUP_AERO(:,1,3)) -(ZFSDN0_AERO(:,1,3) -ZFSUP0_AERO(:,1,3)) 900 PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3)) 901 ! Cloud radiative forcing with no direct effect at all 902 PSOLSWCFAERO(:,3) = 0.0 903 PTOPSWCFAERO(:,3) = 0.0 904 905 ! LW direct anthropogenic forcing 906 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 907 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1)) 908 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3) -LWUP0_AERO(:,1,3)) -(-LWDN0_AERO(:,1,1) -LWUP0_AERO(:,1,1)) 909 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1)) 910 IF(ok_volcan) THEN 911 PLWADAERO(:,:) = (-LWDN_AERO(:,:,3) -LWUP_AERO(:,:,3)) -(-LWDN_AERO(:,:,1) -LWUP_AERO(:,:,1)) !--NL 960 IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN 961 962 ! direct anthropogenic forcing 963 PSOLSWADAERO(:) = 0.0 964 PTOPSWADAERO(:) = 0.0 965 PSOLSWAD0AERO(:) = 0.0 966 PTOPSWAD0AERO(:) = 0.0 967 IF(ok_volcan) THEN 968 PSWADAERO(:,:) = 0.0 !--NL 969 ENDIF 970 971 ! indirect anthropogenic forcing 972 PSOLSWAIAERO(:) = 0.0 973 PTOPSWAIAERO(:) = 0.0 974 975 ! Cloud radiative forcing with natural aerosol for direct effect 976 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 977 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 978 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 979 PSOLSWCFAERO(:,2) = 0.0 980 PTOPSWCFAERO(:,2) = 0.0 981 ! Cloud radiative forcing with no direct effect at all 982 PSOLSWCFAERO(:,3) = 0.0 983 PTOPSWCFAERO(:,3) = 0.0 984 985 ! LW direct anthropogenic forcing 986 PSOLLWADAERO(:) = 0.0 987 PTOPLWADAERO(:) = 0.0 988 PSOLLWAD0AERO(:) = 0.0 989 PTOPLWAD0AERO(:) = 0.0 990 IF(ok_volcan) THEN 991 PLWADAERO(:,:) = 0.0 !--NL 992 ENDIF 993 994 ! LW indirect anthropogenic forcing 995 PSOLLWAIAERO(:) = 0.0 996 PTOPLWAIAERO(:) = 0.0 997 912 998 ENDIF 913 914 ! LW indirect anthropogenic forcing 915 PSOLLWAIAERO(:) = 0.0 916 PTOPLWAIAERO(:) = 0.0 917 918 ENDIF 919 920 IF (.NOT.ok_ade.AND.ok_aie) THEN 921 922 ! direct anthropogenic forcing 923 PSOLSWADAERO(:) = 0.0 924 PTOPSWADAERO(:) = 0.0 925 PSOLSWAD0AERO(:) = 0.0 926 PTOPSWAD0AERO(:) = 0.0 927 IF(ok_volcan) THEN 928 PSWADAERO(:,:) = 0.0 !--NL 929 ENDIF 930 931 ! indirect anthropogenic forcing 932 PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) 933 PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1)) 934 935 ! Cloud radiative forcing with natural aerosol for direct effect 936 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2) -ZFSUP_AERO(:,1,2)) -(ZFSDN0_AERO(:,1,2) -ZFSUP0_AERO(:,1,2)) 937 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2)) 938 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 939 PSOLSWCFAERO(:,2) = 0.0 940 PTOPSWCFAERO(:,2) = 0.0 941 ! Cloud radiative forcing with no direct effect at all 942 PSOLSWCFAERO(:,3) = 0.0 943 PTOPSWCFAERO(:,3) = 0.0 944 945 ! LW direct anthropogenic forcing 946 PSOLLWADAERO(:) = 0.0 947 PTOPLWADAERO(:) = 0.0 948 PSOLLWAD0AERO(:) = 0.0 949 PTOPLWAD0AERO(:) = 0.0 950 IF(ok_volcan) THEN 951 PLWADAERO(:,:) = 0.0 !--NL 952 ENDIF 953 954 ! LW indirect anthropogenic forcing 955 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 956 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1)) 957 958 ENDIF 959 960 IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN 961 962 ! direct anthropogenic forcing 963 PSOLSWADAERO(:) = 0.0 964 PTOPSWADAERO(:) = 0.0 965 PSOLSWAD0AERO(:) = 0.0 966 PTOPSWAD0AERO(:) = 0.0 967 IF(ok_volcan) THEN 968 PSWADAERO(:,:) = 0.0 !--NL 969 ENDIF 970 971 ! indirect anthropogenic forcing 972 PSOLSWAIAERO(:) = 0.0 973 PTOPSWAIAERO(:) = 0.0 974 975 ! Cloud radiative forcing with natural aerosol for direct effect 976 PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1) -ZFSUP_AERO(:,1,1)) -(ZFSDN0_AERO(:,1,1) -ZFSUP0_AERO(:,1,1)) 977 PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1)) 978 ! Cloud radiative forcing with anthropogenic aerosol for direct effect 979 PSOLSWCFAERO(:,2) = 0.0 980 PTOPSWCFAERO(:,2) = 0.0 981 ! Cloud radiative forcing with no direct effect at all 982 PSOLSWCFAERO(:,3) = 0.0 983 PTOPSWCFAERO(:,3) = 0.0 984 985 ! LW direct anthropogenic forcing 986 PSOLLWADAERO(:) = 0.0 987 PTOPLWADAERO(:) = 0.0 988 PSOLLWAD0AERO(:) = 0.0 989 PTOPLWAD0AERO(:) = 0.0 990 IF(ok_volcan) THEN 991 PLWADAERO(:,:) = 0.0 !--NL 992 ENDIF 993 994 ! LW indirect anthropogenic forcing 995 PSOLLWAIAERO(:) = 0.0 996 PTOPLWAIAERO(:) = 0.0 997 998 ENDIF 999 1000 ENDIF 1001 1002 !IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN 1003 IF (.NOT. AEROSOLFEEDBACK_ACTIVE) THEN 1004 ! Cloudforcing without aerosol at all 999 1000 ENDIF 1001 1002 !IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN 1003 IF (.NOT. AEROSOLFEEDBACK_ACTIVE) THEN 1004 ! Cloudforcing without aerosol at all 1005 1005 PSOLSWCFAERO(:,3) = (ZFSDN_AERO(:,1,5) -ZFSUP_AERO(:,1,5)) -(ZFSDN0_AERO(:,1,5) -ZFSUP0_AERO(:,1,5)) 1006 1006 PTOPSWCFAERO(:,3) = (ZFSDN_AERO(:,KLEV+1,5)-ZFSUP_AERO(:,KLEV+1,5))-(ZFSDN0_AERO(:,KLEV+1,5)-ZFSUP0_AERO(:,KLEV+1,5)) 1007 1007 1008 ENDIF1009 1010 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE)1008 ENDIF 1009 1010 IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE) 1011 1011 END SUBROUTINE RECMWF_AERO
Note: See TracChangeset
for help on using the changeset viewer.
