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

Last change on this file since 3408 was 3408, checked in by Laurent Fairhead, 6 years ago

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