source: LMDZ6/trunk/libf/phylmd/rrtm/recmwf_aero.F90 @ 5408

Last change on this file since 5408 was 5294, checked in by Laurent Fairhead, 7 weeks ago

Keeping clesphys.h was not the right solution
LF

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