source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/rrtm/recmwf_aero.F90 @ 5421

Last change on this file since 5421 was 3609, checked in by jghattas, 5 years ago

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