GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/recmwf_aero.F90 Lines: 166 349 47.6 %
Date: 2023-06-30 12:51:15 Branches: 227 818 27.8 %

Line Branch Exec Source
1
!
2
! $Id: recmwf_aero.F90 3989 2021-10-10 07:18:17Z oboucher $
3
!
4
!OPTIONS XOPT(NOEVAL)
5
72
SUBROUTINE RECMWF_AERO (KST, KEND, KPROMA, KTDIA , KLEV,&
6
 & KMODE,&
7
72
 & PALBD , PALBP , PAPRS , PAPRSF , PCCO2 , PCLFR,&
8
72
 & 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
72
 & PTH   , PCTRSO, PCEMTR, PTRSOD,&
16
 & PLWFC, PLWFT, PSWFC, PSWFT, PSFSWDIR, PSFSWDIF,&
17
 & PFSDNN, PFSDNV,&
18
 & PPIZA_TOT,PCGA_TOT,PTAU_TOT, &
19
!--OB
20
72
 & PPIZA_NAT,PCGA_NAT,PTAU_NAT, &
21
!--fin OB
22
!--C.Kleinschmitt
23
72
 & PTAU_LW_TOT, PTAU_LW_NAT, &
24
!--end
25
72
 & PFLUX,PFLUC,&
26
 & PFSDN ,PFSUP , PFSCDN , PFSCUP, PFSCCDN, PFSCCUP, PFLCCDN, PFLCCUP,&
27
!--OB diagnostics
28
 & PTOPSWADAERO,PSOLSWADAERO,&
29
 & PTOPSWAD0AERO,PSOLSWAD0AERO,&
30
 & PTOPSWAIAERO,PSOLSWAIAERO,&
31
72
 & 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
167
!-----------------------------------------------------------------------
168
169
!*       0.1   ARGUMENTS.
170
!              ----------
171
172
IMPLICIT NONE
173
INCLUDE "clesphys.h"
174
175
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
176
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
177
INTEGER(KIND=JPIM),INTENT(IN)    :: KST
178
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND
179
INTEGER(KIND=JPIM)               :: KTDIA ! Argument NOT used
180
INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
181
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KPROMA,NSW)
182
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KPROMA,NSW)
183
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KPROMA,KLEV+1)
184
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KPROMA,KLEV)
185
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
186
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KPROMA,KLEV)
187
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQO3(KPROMA,KLEV)
188
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KPROMA,KLEV,6)
189
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KPROMA,KLEV)
190
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KPROMA)
191
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KPROMA)
192
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KPROMA,KLEV)
193
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KPROMA,KLEV)
194
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KPROMA,KLEV)
195
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KPROMA,KLEV)
196
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM(KPROMA)
197
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KLEV)
198
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KPROMA)
199
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_TOT(KPROMA,KLEV,NSW)
200
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_TOT(KPROMA,KLEV,NSW)
201
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_TOT(KPROMA,KLEV,NSW)
202
!--OB
203
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_NAT(KPROMA,KLEV,NSW)
204
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_NAT(KPROMA,KLEV,NSW)
205
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_NAT(KPROMA,KLEV,NSW)
206
144
REAL(KIND=JPRB)                  :: PPIZA_ZERO(KPROMA,KLEV,NSW)
207
144
REAL(KIND=JPRB)                  :: PCGA_ZERO(KPROMA,KLEV,NSW)
208
144
REAL(KIND=JPRB)                  :: PTAU_ZERO(KPROMA,KLEV,NSW)
209
!--fin
210
!--C.Kleinschmitt
211
144
REAL(KIND=JPRB)                  :: PTAU_LW_ZERO(KPROMA,KLEV,NLW)
212
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW_TOT(KPROMA,KLEV,NLW)
213
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW_NAT(KPROMA,KLEV,NLW)
214
!--end
215
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KPROMA,KLEV)
216
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KPROMA,KLEV)
217
!--OB
218
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ_PI(KPROMA,KLEV)
219
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE_PI(KPROMA,KLEV)
220
LOGICAL, INTENT(in)  :: ok_ade, ok_aie         ! switches whether to use aerosol direct (indirect) effects or not
221
LOGICAL, INTENT(in)  :: ok_volcan              ! produce volcanic diags (SW/LW heat flux and rate)
222
INTEGER, INTENT(in)  :: flag_aerosol           ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
223
LOGICAL, INTENT(in)  :: flag_aerosol_strat     ! use stratospheric aerosols
224
LOGICAL, INTENT(in)  :: flag_aer_feedback      ! use aerosols radiative feedback
225
REAL(KIND=JPRB)   ,INTENT(out)   :: PTOPSWADAERO(KPROMA), PSOLSWADAERO(KPROMA)       ! Aerosol direct forcing at TOA and surface
226
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWAD0AERO(KPROMA), PSOLSWAD0AERO(KPROMA)     ! Aerosol direct forcing at TOA and surface
227
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWAIAERO(KPROMA), PSOLSWAIAERO(KPROMA)       ! ditto, indirect
228
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ?
229
!--fin
230
!--NL
231
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWADAERO(KPROMA, KLEV+1)                        ! SW Aerosol direct forcing
232
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWADAERO(KPROMA, KLEV+1)                        ! LW Aerosol direct forcing
233
!--CK
234
REAL(KIND=JPRB)   ,INTENT(out)   :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA)       ! LW Aerosol direct forcing at TOA + surface
235
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA)     ! LW Aerosol direct forcing at TOA + surface
236
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA)       ! LW Aer. indirect forcing at TOA + surface
237
!--end
238
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTD(KPROMA,KLEV+1)
239
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMTU(KPROMA,KLEV+1)
240
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSO(KPROMA,KLEV+1)
241
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTH(KPROMA,KLEV+1)
242
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCTRSO(KPROMA,2)
243
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCEMTR(KPROMA,2)
244
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTRSOD(KPROMA)
245
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFC(KPROMA,2)
246
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLWFT(KPROMA,KLEV+1)
247
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFC(KPROMA,2)
248
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSWFT(KPROMA,KLEV+1)
249
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIR(KPROMA,NSW)
250
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KPROMA,NSW)
251
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KPROMA)
252
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KPROMA)
253
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KPROMA,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
254
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KPROMA,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
255
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KPROMA,KLEV+1)   ! SW total sky flux down
256
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KPROMA,KLEV+1)   ! SW total sky flux up
257
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KPROMA,KLEV+1)  ! SW clear sky flux down
258
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KPROMA,KLEV+1)  ! SW clear sky flux up
259
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCCDN(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux down
260
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCCUP(KPROMA,KLEV+1) ! SW clear sky clean (no aerosol) flux up
261
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down
262
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up
263
!--ajout VOLMIP
264
REAL(KIND=JPRB)   ,INTENT(OUT)   :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP
265
INTEGER, INTENT(IN)              :: flag_volc_surfstrat !--VOlMIP Modif
266
267
!     ==== COMPUTED IN RADITE ===
268
!     ------------------------------------------------------------------
269
!*       0.2   LOCAL ARRAYS.
270
!              -------------
271
144
REAL(KIND=JPRB) :: ZRAER  (KPROMA,6,KLEV)
272
144
REAL(KIND=JPRB) :: ZRCLC  (KPROMA,KLEV)
273
144
REAL(KIND=JPRB) :: ZRMU0  (KPROMA)
274
144
REAL(KIND=JPRB) :: ZRPR   (KPROMA,KLEV)
275
144
REAL(KIND=JPRB) :: ZRTI   (KPROMA,KLEV)
276
144
REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )
277
278
144
REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)
279
REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)
280
144
REAL(KIND=JPRB) :: ZQS    (KPROMA,KLEV)
281
144
REAL(KIND=JPRB) :: ZQ     (KPROMA,KLEV)
282
144
REAL(KIND=JPRB) :: ZEMTD  (KPROMA,KLEV+1)
283
144
REAL(KIND=JPRB) :: ZEMTU  (KPROMA,KLEV+1)
284
144
REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)
285
144
REAL(KIND=JPRB) :: ZEMTC  (KPROMA,2)
286
287
144
REAL(KIND=JPRB) :: ZNBAS  (KPROMA)
288
144
REAL(KIND=JPRB) :: ZNTOP  (KPROMA)
289
144
REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)
290
144
REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)
291
144
REAL(KIND=JPRB) :: ZCCNL  (KPROMA)
292
144
REAL(KIND=JPRB) :: ZCCNO  (KPROMA)
293
294
!  output of radlsw
295
296
144
REAL(KIND=JPRB) :: ZEMIT  (KPROMA)
297
144
REAL(KIND=JPRB) :: ZFCT   (KPROMA,KLEV+1)
298
144
REAL(KIND=JPRB) :: ZFLT   (KPROMA,KLEV+1)
299
144
REAL(KIND=JPRB) :: ZFCS   (KPROMA,KLEV+1)
300
144
REAL(KIND=JPRB) :: ZFLS   (KPROMA,KLEV+1)
301
144
REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)
302
144
REAL(KIND=JPRB) :: ZPARF  (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)
303
304
INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
305
306
144
REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(KPROMA)
307
REAL(KIND=JPRB) :: ZHOOK_HANDLE
308
309
!---aerosol radiative diagnostics
310
! Key to define the aerosol effect acting on climate
311
! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
312
! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
313
! FALSE: fluxes use no aerosols (case 1)
314
! to be used only for maintaining bit reproducibility with aerosol diagnostics activated
315
 LOGICAL :: AEROSOLFEEDBACK_ACTIVE ! now externalized from .def files
316
317
!OB - Fluxes including aerosol effects
318
!              |        direct effect
319
!ind effect    | no aerosol  NATural  TOTal
320
!standard      |   5
321
!natural (PI)  |               1       3
322
!total   (PD)  |               2       4
323
! so we need which case when ?
324
! if flag_aerosol is on
325
! ok_ade and ok_aie         = 4-2, 4-3 and 4 to proceed
326
! ok_ade and not ok_aie     = 3-1 and 3 to proceed
327
! not ok_ade and ok_aie     = 2-1 and 2 to proceed
328
! not ok_ade and not ok_aie = 1 to proceed
329
! therefore the cases have the following corresponding switches
330
! 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
331
! 2 = not ok_ade and ok_aie OR ok_aie and ok_ade and swaero_diag
332
! 3 = ok_ade and not ok_aie OR ok_aie and ok_ade and swaero_diag
333
! 4 = ok_ade and ok_aie
334
! 5 = no aerosol feedback wanted or no aerosol at all
335
! if they are called in this order then the correct call is used to proceed
336
337
144
REAL(KIND=JPRB) ::  ZFSUP_AERO(KPROMA,KLEV+1,5)
338
144
REAL(KIND=JPRB) ::  ZFSDN_AERO(KPROMA,KLEV+1,5)
339
144
REAL(KIND=JPRB) ::  ZFSUP0_AERO(KPROMA,KLEV+1,5)
340
144
REAL(KIND=JPRB) ::  ZFSDN0_AERO(KPROMA,KLEV+1,5)
341
!--LW (CK):
342
144
REAL(KIND=JPRB) ::  LWUP_AERO(KPROMA,KLEV+1,5)
343
144
REAL(KIND=JPRB) ::  LWDN_AERO(KPROMA,KLEV+1,5)
344
144
REAL(KIND=JPRB) ::  LWUP0_AERO(KPROMA,KLEV+1,5)
345
144
REAL(KIND=JPRB) ::  LWDN0_AERO(KPROMA,KLEV+1,5)
346
347
#include "radlsw.intfb.h"
348
349
72
IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE)
350
72
IBEG=KST
351
72
IEND=KEND
352
353
72
AEROSOLFEEDBACK_ACTIVE = flag_aer_feedback !NL: externalize aer feedback
354
355
356
!*       1.    PREPARATORY WORK
357
!              ----------------
358
!--OB
359
!        1.0    INITIALIZATIONS
360
!               --------------
361
362

14328432
ZFSUP_AERO (:,:,:)=0.
363

14328432
ZFSDN_AERO (:,:,:)=0.
364

14328432
ZFSUP0_AERO(:,:,:)=0.
365

14328432
ZFSDN0_AERO(:,:,:)=0.
366
367

14328432
LWUP_AERO (:,:,:)=0.
368

14328432
LWDN_AERO (:,:,:)=0.
369

14328432
LWUP0_AERO(:,:,:)=0.
370

14328432
LWDN0_AERO(:,:,:)=0.
371
372

16764264
PTAU_ZERO(:,:,:) =1.e-15
373

16764264
PPIZA_ZERO(:,:,:)=1.0
374

16764264
PCGA_ZERO(:,:,:) =0.0
375
376

44704584
PTAU_LW_ZERO(:,:,:) =1.e-15
377
378
379
!*       1.1    LOCAL CONSTANTS
380
!                ---------------
381
382
72
ZRII0=RII0
383
72
ZCRAE=RRAE*(RRAE+2.0_JPRB)
384
385
!*       2.1    FULL-LEVEL QUANTITIES
386
387

2794032
ZRPR =PAPRSF
388
389
2880
DO JK=1,KLEV
390
2794032
  DO JL=IBEG,IEND
391
!   ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
392
2791152
    ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)
393
2791152
    ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))
394
2791152
    IF (ZRCLC(JL,JK) > REPCLC) THEN
395
620301
      ZQLWP(JL,JK)=PQLWP(JL,JK)
396
620301
      ZQIWP(JL,JK)=PQIWP(JL,JK)
397
    ELSE
398
2170851
      ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
399
2170851
      ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
400
    ENDIF
401
2791152
    ZQRAIN(JL,JK)=0.
402
2791152
    ZQRAINT(JL,JK)=0.
403
2791152
    ZRTI(JL,JK) =PT(JL,JK)
404
2791152
    ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK))
405
2791152
    ZQ  (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O)))
406
2793960
    ZEMIW(JL)=PEMIS(JL)
407
  ENDDO
408
ENDDO
409
410
72
IF (NAER == 0) THEN
411
  ZRAER=RCAEROS
412
ELSE
413
2880
  DO JK=1,KLEV
414
2794032
    DO JL=IBEG,IEND
415
2791152
      ZRAER(JL,1,JK)=PAER(JL,JK,1)
416
2791152
      ZRAER(JL,2,JK)=PAER(JL,JK,2)
417
2791152
      ZRAER(JL,3,JK)=PAER(JL,JK,3)
418
2791152
      ZRAER(JL,4,JK)=PAER(JL,JK,4)
419
2791152
      ZRAER(JL,5,JK)=RCAEROS
420
2793960
      ZRAER(JL,6,JK)=PAER(JL,JK,6)
421
    ENDDO
422
  ENDDO
423
ENDIF
424
425
!*       2.2    HALF-LEVEL QUANTITIES
426
427
2808
DO JK=2,KLEV
428
2722392
  DO JL=IBEG,IEND
429
    PTH(JL,JK)=&
430
     & (PT(JL,JK-1)*PAPRSF(JL,JK-1)*(PAPRSF(JL,JK)-PAPRS(JL,JK))&
431
     & +PT(JL,JK)*PAPRSF(JL,JK)*(PAPRS(JL,JK)-PAPRSF(JL,JK-1)))&
432
2722320
     & *(1.0_JPRB/(PAPRS(JL,JK)*(PAPRSF(JL,JK)-PAPRSF(JL,JK-1))))
433
  ENDDO
434
ENDDO
435
436
!*       2.3     QUANTITIES AT BOUNDARIES
437
438
71640
DO JL=IBEG,IEND
439
71568
  PTH(JL,KLEV+1)=PTS(JL)
440
  PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
441
71568
   & /(PAPRSF(JL,1)-PAPRS(JL,2))
442
71568
  ZNBAS(JL)=1.
443
71568
  ZNTOP(JL)=1.
444
71568
  ZCCNL(JL)=RCCNLND
445
71640
  ZCCNO(JL)=RCCNSEA
446
ENDDO
447
448
!*       3.1     SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
449
!                CORRECTED
450
451
! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010
452
! 2eme essai en 3D MPL 20052010
453
!DO JL=IBEG,IEND
454
! ZRMU0(JL)=PMU0(JL)
455
!ENDDO
456
!!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4
457
71640
 DO JL=IBEG,IEND
458
71640
   IF (PMU0(JL) > 1.E-10_JPRB) THEN
459
37967
     ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
460
   ELSE
461
33601
     ZRMU0(JL)= RRAE/SQRT(ZCRAE)
462
   ENDIF
463
 ENDDO
464
465
!*         4.1     CALL TO ACTUAL RADIATION SCHEME
466
!
467
!----now we make multiple calls to the radiation according to which
468
!----aerosol flags are on
469
470

72
IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
471
472
!--Case 1
473
IF ( ( .not. ok_ade .AND. .not. ok_aie ) .OR.             &
474
   & ( .not. ok_ade .AND. ok_aie .AND. swaero_diag ) .OR. &
475
   & ( ok_ade .AND. .not. ok_aie .AND. swaero_diag ) ) THEN
476
477
! natural aerosols for direct and indirect effect
478
! PI cloud optical properties
479
! use PREF_LIQ_PI and PREF_ICE_PI
480
! use NAT aerosol optical properties
481
! store fluxes in index 1
482
483
CALL RADLSW (&
484
 & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
485
 & ZRII0 ,&
486
 & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
487
 & ZCCNL , ZCCNO  ,&
488
 & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
489
 & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
490
 & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
491
 & PREF_LIQ_PI, PREF_ICE_PI,&
492
 & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
493
 & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
494
 & PSFSWDIF,PFSDNN, PFSDNV  ,&
495
 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
496
 & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
497
498
!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
499
ZFSUP0_AERO(:,:,1) = PFSCUP(:,:)
500
ZFSDN0_AERO(:,:,1) = PFSCDN(:,:)
501
502
ZFSUP_AERO(:,:,1) =  PFSUP(:,:)
503
ZFSDN_AERO(:,:,1) =  PFSDN(:,:)
504
505
LWUP0_AERO(:,:,1) = PFLUC(:,1,:)
506
LWDN0_AERO(:,:,1) = PFLUC(:,2,:)
507
508
LWUP_AERO(:,:,1) = PFLUX(:,1,:)
509
LWDN_AERO(:,:,1) = PFLUX(:,2,:)
510
511
ENDIF
512
513
!--Case 2
514
IF ( ( .not. ok_ade .AND. ok_aie ) .OR. &
515
   & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
516
517
! natural aerosols for direct indirect effect
518
! use NAT aerosol optical properties
519
! PD cloud optical properties
520
! use PREF_LIQ and PREF_ICE
521
! store fluxes in index 2
522
523
CALL RADLSW (&
524
 & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
525
 & ZRII0 ,&
526
 & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
527
 & ZCCNL , ZCCNO  ,&
528
 & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
529
 & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
530
 & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
531
 & PREF_LIQ, PREF_ICE,&
532
 & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
533
 & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
534
 & PSFSWDIF,PFSDNN, PFSDNV  ,&
535
 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,&
536
 & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
537
538
!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
539
ZFSUP0_AERO(:,:,2) = PFSCUP(:,:)
540
ZFSDN0_AERO(:,:,2) = PFSCDN(:,:)
541
542
ZFSUP_AERO(:,:,2) =  PFSUP(:,:)
543
ZFSDN_AERO(:,:,2) =  PFSDN(:,:)
544
545
LWUP0_AERO(:,:,2) = PFLUC(:,1,:)
546
LWDN0_AERO(:,:,2) = PFLUC(:,2,:)
547
548
LWUP_AERO(:,:,2) = PFLUX(:,1,:)
549
LWDN_AERO(:,:,2) = PFLUX(:,2,:)
550
551
ENDIF ! ok_aie
552
553
!--Case 3
554
IF ( ( ok_ade .AND. .not. ok_aie ) .OR. &
555
   & ( ok_ade .AND. ok_aie .AND. swaero_diag ) ) THEN
556
557
! direct effect of total aerosol activated
558
! TOT aerosols for direct effect
559
! PI cloud optical properties
560
! use PREF_LIQ_PI and PREF_ICE_PI
561
! STORE fluxes in index 3
562
563
CALL RADLSW (&
564
 & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
565
 & ZRII0 ,&
566
 & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
567
 & ZCCNL , ZCCNO  ,&
568
 & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
569
 & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
570
 & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
571
 & PREF_LIQ_PI, PREF_ICE_PI,&
572
 & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
573
 & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
574
 & PSFSWDIF,PFSDNN, PFSDNV  ,&
575
 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
576
 & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
577
578
!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
579
ZFSUP0_AERO(:,:,3) = PFSCUP(:,:)
580
ZFSDN0_AERO(:,:,3) = PFSCDN(:,:)
581
582
ZFSUP_AERO(:,:,3) =  PFSUP(:,:)
583
ZFSDN_AERO(:,:,3) =  PFSDN(:,:)
584
585
LWUP0_AERO(:,:,3) = PFLUC(:,1,:)
586
LWDN0_AERO(:,:,3) = PFLUC(:,2,:)
587
588
LWUP_AERO(:,:,3) = PFLUX(:,1,:)
589
LWDN_AERO(:,:,3) = PFLUX(:,2,:)
590
591
ENDIF !-end ok_ade
592
593
!--Case 4
594
IF (ok_ade .and. ok_aie) THEN
595
596
! total aerosols for direct indirect effect
597
! use TOT aerosol optical properties
598
! PD cloud optical properties
599
! use PREF_LIQ and PREF_ICE
600
! store fluxes in index 4
601
602
CALL RADLSW (&
603
 & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
604
 & ZRII0 ,&
605
 & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
606
 & ZCCNL , ZCCNO  ,&
607
 & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
608
 & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
609
 & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
610
 & PREF_LIQ, PREF_ICE,&
611
 & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
612
 & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
613
 & PSFSWDIF,PFSDNN, PFSDNV  ,&
614
 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,&
615
 & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
616
617
!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
618
ZFSUP0_AERO(:,:,4) = PFSCUP(:,:)
619
ZFSDN0_AERO(:,:,4) = PFSCDN(:,:)
620
621
ZFSUP_AERO(:,:,4) =  PFSUP(:,:)
622
ZFSDN_AERO(:,:,4) =  PFSDN(:,:)
623
624
LWUP0_AERO(:,:,4) = PFLUC(:,1,:)
625
LWDN0_AERO(:,:,4) = PFLUC(:,2,:)
626
627
LWUP_AERO(:,:,4) = PFLUX(:,1,:)
628
LWDN_AERO(:,:,4) = PFLUX(:,2,:)
629
630
ENDIF ! ok_ade .and. ok_aie
631
632
ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
633
634
! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false
635

72
IF (.not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 .OR. swaerofree_diag) THEN
636
637
! ZERO aerosol effect
638
! ZERO aerosol optical depth
639
! STANDARD cloud optical properties
640
! STORE fluxes in index 5
641
642
CALL RADLSW (&
643
 & IBEG  , IEND   , KPROMA  , KLEV  , KMODE , NAER,&
644
 & ZRII0 ,&
645
 & ZRAER , PALBD  , PALBP   , PAPRS , ZRPR  ,&
646
 & ZCCNL , ZCCNO  ,&
647
 & PCCO2 , ZRCLC  , PDP     , PEMIS , ZEMIW ,PSLM    , ZRMU0 , ZPQO3,&
648
 & ZQ    , ZQIWP  , ZQLWP   , ZQS   , ZQRAIN,ZQRAINT ,&
649
 & PTH   , ZRTI   , PTS     , ZNBAS , ZNTOP ,&
650
!--this needs to be changed to fixed cloud optical properties
651
 & PREF_LIQ_PI, PREF_ICE_PI,&
652
 & ZEMIT , ZFCT   , ZFLT    , ZFCS    , ZFLS  ,&
653
 & ZFRSOD, ZSUDU  , ZUVDF   , ZPARF   , ZPARCF, ZTINCF, PSFSWDIR,&
654
 & PSFSWDIF,PFSDNN, PFSDNV  ,&
655
 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,&
656
72
 & PFSDN , PFSUP  , PFSCDN  , PFSCUP )
657
658
!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
659

2865672
ZFSUP0_AERO(:,:,5) = PFSCUP(:,:)
660

2865672
ZFSDN0_AERO(:,:,5) = PFSCDN(:,:)
661
662

2865672
ZFSUP_AERO(:,:,5) =  PFSUP(:,:)
663

2865672
ZFSDN_AERO(:,:,5) =  PFSDN(:,:)
664
665

2865672
LWUP0_AERO(:,:,5) = PFLUC(:,1,:)
666

2865672
LWDN0_AERO(:,:,5) = PFLUC(:,2,:)
667
668

2865672
LWUP_AERO(:,:,5) = PFLUX(:,1,:)
669

2865672
LWDN_AERO(:,:,5) = PFLUX(:,2,:)
670
671
ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE
672
673
!*         4.2     TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
674
675
2952
DO JK=1,KLEV+1
676
2865672
  DO JL=IBEG,IEND
677
2862720
    PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL))
678
2865600
    PLWFT(JL,JK)=ZFLT(JL,JK)
679
  ENDDO
680
ENDDO
681
682

2865672
ZEMTD=PLWFT
683

2865672
ZEMTU=PLWFT
684
685
71640
DO JL=IBEG,IEND
686
71568
  ZTRSOC(JL, 1)=ZFCS(JL,     1)/(ZRII0*ZRMU0(JL))
687
71568
  ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
688
71568
  ZEMTC (JL, 1)=ZFCT(JL,     1)
689
71640
  ZEMTC (JL, 2)=ZFCT(JL,KLEV+1)
690
ENDDO
691
692
!                 ------------ -- ------- -- ---- -----
693
!*         5.1    STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
694
!*                IN KPROMA-LONG ARRAYS
695
696
2952
DO JK=1,KLEV+1
697
2865672
  DO JL=IBEG,IEND
698
2862720
    PEMTD(JL,JK)=ZEMTD(JL,JK)
699
2862720
    PEMTU(JL,JK)=ZEMTU(JL,JK)
700
2865600
    PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK)))
701
  ENDDO
702
ENDDO
703
216
DO JK=1,2
704
143352
  DO JL=IBEG,IEND
705
143136
    PCEMTR(JL,JK)=ZEMTC (JL,JK)
706
143280
    PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
707
  ENDDO
708
ENDDO
709
71640
DO JL=IBEG,IEND
710
71640
  PTRSOD(JL)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZFRSOD(JL)/(ZRII0*ZRMU0(JL))))
711
ENDDO
712
713
!*         7.3   RECONSTRUCT FLUXES FOR DIAGNOSTICS
714
715
71640
DO JL=IBEG,IEND
716
71640
  IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
717
ENDDO
718
2952
DO JK=1,KLEV+1
719
2865672
  DO JL=IBEG,IEND
720
2862720
    PLWFT(JL,JK)=PEMTD(JL,JK)
721
2865600
    PSWFT(JL,JK)=ZRMU0(JL)*ZRII0*PTRSO(JL,JK)
722
  ENDDO
723
ENDDO
724
216
DO JK=1,2
725
143352
  DO JL=IBEG,IEND
726
143136
    PSWFC(JL,JK)=ZRMU0(JL)*ZRII0*PCTRSO(JL,JK)
727
143280
    PLWFC(JL,JK)=PCEMTR(JL,JK)
728
  ENDDO
729
ENDDO
730
731
!*  8.0 DIAGNOSTICS
732
!---Now we copy back the correct fields to proceed to the next timestep
733
734

72
IF  ( AEROSOLFEEDBACK_ACTIVE .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
735
736
  IF ( ok_ade .and. ok_aie  ) THEN
737
    PFSUP(:,:) =    ZFSUP_AERO(:,:,4)
738
    PFSDN(:,:) =    ZFSDN_AERO(:,:,4)
739
    PFSCUP(:,:) =   ZFSUP0_AERO(:,:,4)
740
    PFSCDN(:,:) =   ZFSDN0_AERO(:,:,4)
741
742
    PFLUX(:,1,:) =  LWUP_AERO(:,:,4)
743
    PFLUX(:,2,:) =  LWDN_AERO(:,:,4)
744
    PFLUC(:,1,:) =  LWUP0_AERO(:,:,4)
745
    PFLUC(:,2,:) =  LWDN0_AERO(:,:,4)
746
  ENDIF
747
748
  IF ( ok_ade .and. (.not. ok_aie) )  THEN
749
    PFSUP(:,:) =    ZFSUP_AERO(:,:,3)
750
    PFSDN(:,:) =    ZFSDN_AERO(:,:,3)
751
    PFSCUP(:,:) =   ZFSUP0_AERO(:,:,3)
752
    PFSCDN(:,:) =   ZFSDN0_AERO(:,:,3)
753
754
    PFLUX(:,1,:) =  LWUP_AERO(:,:,3)
755
    PFLUX(:,2,:) =  LWDN_AERO(:,:,3)
756
    PFLUC(:,1,:) =  LWUP0_AERO(:,:,3)
757
    PFLUC(:,2,:) =  LWDN0_AERO(:,:,3)
758
  ENDIF
759
760
  IF ( (.not. ok_ade) .and. ok_aie  )  THEN
761
    PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
762
    PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
763
    PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
764
    PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
765
766
    PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
767
    PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
768
    PFLUC(:,1,:) =  LWUP0_AERO(:,:,2)
769
    PFLUC(:,2,:) =  LWDN0_AERO(:,:,2)
770
  ENDiF
771
772
  IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
773
    PFSUP(:,:) =    ZFSUP_AERO(:,:,1)
774
    PFSDN(:,:) =    ZFSDN_AERO(:,:,1)
775
    PFSCUP(:,:) =   ZFSUP0_AERO(:,:,1)
776
    PFSCDN(:,:) =   ZFSDN0_AERO(:,:,1)
777
778
    PFLUX(:,1,:) =  LWUP_AERO(:,:,1)
779
    PFLUX(:,2,:) =  LWDN_AERO(:,:,1)
780
    PFLUC(:,1,:) =  LWUP0_AERO(:,:,1)
781
    PFLUC(:,2,:) =  LWDN0_AERO(:,:,1)
782
  ENDIF
783
784
! The following allows to compute the forcing diagostics without
785
! letting the aerosol forcing act on the meteorology
786
! SEE logic above
787
788
ELSE  !--not AEROSOLFEEDBACK_ACTIVE
789
790

2865672
    PFSUP(:,:) =    ZFSUP_AERO(:,:,5)
791

2865672
    PFSDN(:,:) =    ZFSDN_AERO(:,:,5)
792

2865672
    PFSCUP(:,:) =   ZFSUP0_AERO(:,:,5)
793

2865672
    PFSCDN(:,:) =   ZFSDN0_AERO(:,:,5)
794
795

2865672
    PFLUX(:,1,:) =  LWUP_AERO(:,:,5)
796

2865672
    PFLUX(:,2,:) =  LWDN_AERO(:,:,5)
797

2865672
    PFLUC(:,1,:) =  LWUP0_AERO(:,:,5)
798

2865672
    PFLUC(:,2,:) =  LWDN0_AERO(:,:,5)
799
800
ENDIF
801
802
!--VolMIP Strat/Surf
803
!--only ok_ade + ok_aie case treated
804

72
IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN
805
   !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2
806
   IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING
807
      volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2)
808
   ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING
809
      !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4
810
      PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
811
      PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
812
      PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
813
      PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
814
      PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
815
      PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
816
      PFLUC(:,1,:) =  LWDN0_AERO(:,:,2)
817
      PFLUC(:,2,:) =  LWDN0_AERO(:,:,2)
818
      volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4)
819
   ENDIF
820
ENDIF
821
!--End VolMIP Strat/Surf
822
823
72
IF (swaerofree_diag) THEN
824
! copy shortwave clear-sky clean (no aerosol) case
825

2865672
  PFSCCUP(:,:) =   ZFSUP0_AERO(:,:,5)
826

2865672
  PFSCCDN(:,:) =   ZFSDN0_AERO(:,:,5)
827
! copy longwave clear-sky clean (no aerosol) case
828

2865672
  PFLCCUP(:,:) =   LWUP0_AERO(:,:,5)
829

2865672
  PFLCCDN(:,:) =   LWDN0_AERO(:,:,5)
830
ENDIF
831
832
!OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!!
833
! net anthropogenic forcing direct and 1st indirect effect diagnostics
834
! requires a natural aerosol field read and used
835
! Difference of net fluxes from double call to radiation
836
! Will need to be extended to LW radiation -> done by CK (2014-05-23)
837
838

72
IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
839
840
IF (ok_ade.AND.ok_aie) THEN
841
842
! direct anthropogenic forcing
843
     PSOLSWADAERO(:)  = (ZFSDN_AERO(:,1,4)      -ZFSUP_AERO(:,1,4))      -(ZFSDN_AERO(:,1,2)      -ZFSUP_AERO(:,1,2))
844
     PTOPSWADAERO(:)  = (ZFSDN_AERO(:,KLEV+1,4) -ZFSUP_AERO(:,KLEV+1,4)) -(ZFSDN_AERO(:,KLEV+1,2) -ZFSUP_AERO(:,KLEV+1,2))
845
     PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,4)     -ZFSUP0_AERO(:,1,4))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
846
     PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
847
     IF(ok_volcan) THEN
848
        PSWADAERO(:,:)  = (ZFSDN_AERO(:,:,4) -ZFSUP_AERO(:,:,4)) -(ZFSDN_AERO(:,:,2) -ZFSUP_AERO(:,:,2)) !--NL
849
     ENDIF
850
851
! indirect anthropogenic forcing
852
     PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,4)     -ZFSUP_AERO(:,1,4))     -(ZFSDN_AERO(:,1,3)     -ZFSUP_AERO(:,1,3))
853
     PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))
854
855
! Cloud radiative forcing with natural aerosol for direct effect
856
     PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
857
     PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
858
! Cloud radiative forcing with anthropogenic aerosol for direct effect
859
     PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,4)     -ZFSUP_AERO(:,1,4))     -(ZFSDN0_AERO(:,1,4)     -ZFSUP0_AERO(:,1,4))
860
     PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,4)-ZFSUP_AERO(:,KLEV+1,4))-(ZFSDN0_AERO(:,KLEV+1,4)-ZFSUP0_AERO(:,KLEV+1,4))
861
! Cloud radiative forcing with no direct effect at all
862
     PSOLSWCFAERO(:,3) = 0.0
863
     PTOPSWCFAERO(:,3) = 0.0
864
865
! LW direct anthropogenic forcing
866
     PSOLLWADAERO(:)  = (-LWDN_AERO(:,1,4)      -LWUP_AERO(:,1,4))      -(-LWDN_AERO(:,1,2)      -LWUP_AERO(:,1,2))
867
     PTOPLWADAERO(:)  = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2))
868
     PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4)     -LWUP0_AERO(:,1,4))     -(-LWDN0_AERO(:,1,2)     -LWUP0_AERO(:,1,2))
869
     PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2))
870
     IF(ok_volcan) THEN
871
        PLWADAERO(:,:)  = (-LWDN_AERO(:,:,4) -LWUP_AERO(:,:,4)) -(-LWDN_AERO(:,:,2) -LWUP_AERO(:,:,2)) !--NL
872
     ENDIF
873
874
! LW indirect anthropogenic forcing
875
     PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4)     -LWUP_AERO(:,1,4))     -(-LWDN_AERO(:,1,3)     -LWUP_AERO(:,1,3))
876
     PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3))
877
878
ENDIF
879
880
IF (ok_ade.AND..NOT.ok_aie) THEN
881
882
! direct anthropogenic forcing
883
     PSOLSWADAERO(:)  = (ZFSDN_AERO(:,1,3)      -ZFSUP_AERO(:,1,3))      -(ZFSDN_AERO(:,1,1)      -ZFSUP_AERO(:,1,1))
884
     PTOPSWADAERO(:)  = (ZFSDN_AERO(:,KLEV+1,3) -ZFSUP_AERO(:,KLEV+1,3)) -(ZFSDN_AERO(:,KLEV+1,1) -ZFSUP_AERO(:,KLEV+1,1))
885
     PSOLSWAD0AERO(:) = (ZFSDN0_AERO(:,1,3)     -ZFSUP0_AERO(:,1,3))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
886
     PTOPSWAD0AERO(:) = (ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
887
     IF(ok_volcan) THEN
888
        PSWADAERO(:,:)  = (ZFSDN_AERO(:,:,3) -ZFSUP_AERO(:,:,3)) -(ZFSDN_AERO(:,:,1) -ZFSUP_AERO(:,:,1)) !--NL
889
     ENDIF
890
891
! indirect anthropogenic forcing
892
     PSOLSWAIAERO(:) = 0.0
893
     PTOPSWAIAERO(:) = 0.0
894
895
! Cloud radiative forcing with natural aerosol for direct effect
896
     PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
897
     PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
898
! Cloud radiative forcing with anthropogenic aerosol for direct effect
899
     PSOLSWCFAERO(:,2) = (ZFSDN_AERO(:,1,3)     -ZFSUP_AERO(:,1,3))     -(ZFSDN0_AERO(:,1,3)     -ZFSUP0_AERO(:,1,3))
900
     PTOPSWCFAERO(:,2) = (ZFSDN_AERO(:,KLEV+1,3)-ZFSUP_AERO(:,KLEV+1,3))-(ZFSDN0_AERO(:,KLEV+1,3)-ZFSUP0_AERO(:,KLEV+1,3))
901
! Cloud radiative forcing with no direct effect at all
902
     PSOLSWCFAERO(:,3) = 0.0
903
     PTOPSWCFAERO(:,3) = 0.0
904
905
! LW direct anthropogenic forcing
906
     PSOLLWADAERO(:)  = (-LWDN_AERO(:,1,3)      -LWUP_AERO(:,1,3))      -(-LWDN_AERO(:,1,1)      -LWUP_AERO(:,1,1))
907
     PTOPLWADAERO(:)  = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1))
908
     PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3)     -LWUP0_AERO(:,1,3))     -(-LWDN0_AERO(:,1,1)     -LWUP0_AERO(:,1,1))
909
     PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1))
910
     IF(ok_volcan) THEN
911
        PLWADAERO(:,:)  = (-LWDN_AERO(:,:,3) -LWUP_AERO(:,:,3)) -(-LWDN_AERO(:,:,1) -LWUP_AERO(:,:,1)) !--NL
912
     ENDIF
913
914
! LW indirect anthropogenic forcing
915
     PSOLLWAIAERO(:) = 0.0
916
     PTOPLWAIAERO(:) = 0.0
917
918
ENDIF
919
920
IF (.NOT.ok_ade.AND.ok_aie) THEN
921
922
! direct anthropogenic forcing
923
     PSOLSWADAERO(:)  = 0.0
924
     PTOPSWADAERO(:)  = 0.0
925
     PSOLSWAD0AERO(:) = 0.0
926
     PTOPSWAD0AERO(:) = 0.0
927
     IF(ok_volcan) THEN
928
        PSWADAERO(:,:)  = 0.0 !--NL
929
     ENDIF
930
931
! indirect anthropogenic forcing
932
     PSOLSWAIAERO(:) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))
933
     PTOPSWAIAERO(:) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))
934
935
! Cloud radiative forcing with natural aerosol for direct effect
936
     PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,2)     -ZFSUP_AERO(:,1,2))     -(ZFSDN0_AERO(:,1,2)     -ZFSUP0_AERO(:,1,2))
937
     PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,2)-ZFSUP_AERO(:,KLEV+1,2))-(ZFSDN0_AERO(:,KLEV+1,2)-ZFSUP0_AERO(:,KLEV+1,2))
938
! Cloud radiative forcing with anthropogenic aerosol for direct effect
939
     PSOLSWCFAERO(:,2) = 0.0
940
     PTOPSWCFAERO(:,2) = 0.0
941
! Cloud radiative forcing with no direct effect at all
942
     PSOLSWCFAERO(:,3) = 0.0
943
     PTOPSWCFAERO(:,3) = 0.0
944
945
! LW direct anthropogenic forcing
946
     PSOLLWADAERO(:)  = 0.0
947
     PTOPLWADAERO(:)  = 0.0
948
     PSOLLWAD0AERO(:) = 0.0
949
     PTOPLWAD0AERO(:) = 0.0
950
     IF(ok_volcan) THEN
951
        PLWADAERO(:,:)  = 0.0 !--NL
952
     ENDIF
953
954
! LW indirect anthropogenic forcing
955
     PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2)     -LWUP_AERO(:,1,2))     -(-LWDN_AERO(:,1,1)     -LWUP_AERO(:,1,1))
956
     PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1))
957
958
ENDIF
959
960
IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN
961
962
! direct anthropogenic forcing
963
     PSOLSWADAERO(:)  = 0.0
964
     PTOPSWADAERO(:)  = 0.0
965
     PSOLSWAD0AERO(:) = 0.0
966
     PTOPSWAD0AERO(:) = 0.0
967
     IF(ok_volcan) THEN
968
        PSWADAERO(:,:)  = 0.0 !--NL
969
     ENDIF
970
971
! indirect anthropogenic forcing
972
     PSOLSWAIAERO(:) = 0.0
973
     PTOPSWAIAERO(:) = 0.0
974
975
! Cloud radiative forcing with natural aerosol for direct effect
976
     PSOLSWCFAERO(:,1) = (ZFSDN_AERO(:,1,1)     -ZFSUP_AERO(:,1,1))     -(ZFSDN0_AERO(:,1,1)     -ZFSUP0_AERO(:,1,1))
977
     PTOPSWCFAERO(:,1) = (ZFSDN_AERO(:,KLEV+1,1)-ZFSUP_AERO(:,KLEV+1,1))-(ZFSDN0_AERO(:,KLEV+1,1)-ZFSUP0_AERO(:,KLEV+1,1))
978
! Cloud radiative forcing with anthropogenic aerosol for direct effect
979
     PSOLSWCFAERO(:,2) = 0.0
980
     PTOPSWCFAERO(:,2) = 0.0
981
! Cloud radiative forcing with no direct effect at all
982
     PSOLSWCFAERO(:,3) = 0.0
983
     PTOPSWCFAERO(:,3) = 0.0
984
985
! LW direct anthropogenic forcing
986
     PSOLLWADAERO(:)  = 0.0
987
     PTOPLWADAERO(:)  = 0.0
988
     PSOLLWAD0AERO(:) = 0.0
989
     PTOPLWAD0AERO(:) = 0.0
990
     IF(ok_volcan) THEN
991
        PLWADAERO(:,:)  = 0.0 !--NL
992
     ENDIF
993
994
! LW indirect anthropogenic forcing
995
     PSOLLWAIAERO(:) = 0.0
996
     PTOPLWAIAERO(:) = 0.0
997
998
ENDIF
999
1000
ENDIF
1001
1002
!IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN
1003
72
IF (.NOT. AEROSOLFEEDBACK_ACTIVE) THEN
1004
! Cloudforcing without aerosol at all
1005
     PSOLSWCFAERO(:,3) = (ZFSDN_AERO(:,1,5)     -ZFSUP_AERO(:,1,5))     -(ZFSDN0_AERO(:,1,5)     -ZFSUP0_AERO(:,1,5))
1006
     PTOPSWCFAERO(:,3) = (ZFSDN_AERO(:,KLEV+1,5)-ZFSUP_AERO(:,KLEV+1,5))-(ZFSDN0_AERO(:,KLEV+1,5)-ZFSUP0_AERO(:,KLEV+1,5))
1007
1008
ENDIF
1009
1010
72
IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE)
1011
72
END SUBROUTINE RECMWF_AERO