source: LMDZ6/trunk/libf/phylmd/rrtm/recmwf_aero.F90 @ 3592

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

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