source: LMDZ5/trunk/libf/phylmd/rrtm/recmwf_aero.F90 @ 2004

Last change on this file since 2004 was 2004, checked in by Laurent Fairhead, 11 years ago

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets directs
et indirects que l'ancienne version du rayonnement.
OB

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