source: LMDZ6/branches/Ocean_skin/libf/phylmd/rrtm/recmwf_aero.F90 @ 3428

Last change on this file since 3428 was 3412, checked in by oboucher, 6 years ago

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