source: LMDZ5/branches/testing/libf/phylmd/rrtm/recmwf_aero.F90 @ 2160

Last change on this file since 2160 was 2160, checked in by Laurent Fairhead, 10 years ago

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