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

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

Revert commit [3604]. This is only done temporary because we need to make a correction for Jean-Zay and to have a revision without these changes to go into IPSLCM6.1.10.

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