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

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

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