Context Navigation

recmwf_aero.F90 @ 5213

Last change on this file since 5213 was 4875, checked in by lguez, 8 months ago
Indent file
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.7 KB

Line
1	!
2	! $Id: recmwf_aero.F90 4875 2024-03-26 10:29:06Z evignon $
3	!
4	!OPTIONS XOPT(NOEVAL)
5	SUBROUTINE 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
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	REAL(KIND=JPRB) :: PPIZA_ZERO(KPROMA,KLEV,NSW)
207	REAL(KIND=JPRB) :: PCGA_ZERO(KPROMA,KLEV,NSW)
208	REAL(KIND=JPRB) :: PTAU_ZERO(KPROMA,KLEV,NSW)
209	!--fin
210	!--C.Kleinschmitt
211	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	REAL(KIND=JPRB) :: ZRAER (KPROMA,6,KLEV)
272	REAL(KIND=JPRB) :: ZRCLC (KPROMA,KLEV)
273	REAL(KIND=JPRB) :: ZRMU0 (KPROMA)
274	REAL(KIND=JPRB) :: ZRPR (KPROMA,KLEV)
275	REAL(KIND=JPRB) :: ZRTI (KPROMA,KLEV)
276	REAL(KIND=JPRB) :: ZQLWP (KPROMA,KLEV ) , ZQIWP (KPROMA,KLEV )
277
278	REAL(KIND=JPRB) :: ZPQO3 (KPROMA,KLEV)
279	REAL(KIND=JPRB) :: ZQOZ (NGPTOT,KLEV)
280	REAL(KIND=JPRB) :: ZQS (KPROMA,KLEV)
281	REAL(KIND=JPRB) :: ZQ (KPROMA,KLEV)
282	REAL(KIND=JPRB) :: ZEMTD (KPROMA,KLEV+1)
283	REAL(KIND=JPRB) :: ZEMTU (KPROMA,KLEV+1)
284	REAL(KIND=JPRB) :: ZTRSOC (KPROMA,2)
285	REAL(KIND=JPRB) :: ZEMTC (KPROMA,2)
286
287	REAL(KIND=JPRB) :: ZNBAS (KPROMA)
288	REAL(KIND=JPRB) :: ZNTOP (KPROMA)
289	REAL(KIND=JPRB) :: ZQRAIN (KPROMA,KLEV)
290	REAL(KIND=JPRB) :: ZQRAINT(KPROMA,KLEV)
291	REAL(KIND=JPRB) :: ZCCNL (KPROMA)
292	REAL(KIND=JPRB) :: ZCCNO (KPROMA)
293
294	! output of radlsw
295
296	REAL(KIND=JPRB) :: ZEMIT (KPROMA)
297	REAL(KIND=JPRB) :: ZFCT (KPROMA,KLEV+1)
298	REAL(KIND=JPRB) :: ZFLT (KPROMA,KLEV+1)
299	REAL(KIND=JPRB) :: ZFCS (KPROMA,KLEV+1)
300	REAL(KIND=JPRB) :: ZFLS (KPROMA,KLEV+1)
301	REAL(KIND=JPRB) :: ZFRSOD (KPROMA),ZSUDU(KPROMA)
302	REAL(KIND=JPRB) :: ZPARF (KPROMA),ZUVDF(KPROMA),ZPARCF(KPROMA),ZTINCF(KPROMA)
303
304	INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
305
306	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	REAL(KIND=JPRB) :: ZFSUP_AERO(KPROMA,KLEV+1,5)
338	REAL(KIND=JPRB) :: ZFSDN_AERO(KPROMA,KLEV+1,5)
339	REAL(KIND=JPRB) :: ZFSUP0_AERO(KPROMA,KLEV+1,5)
340	REAL(KIND=JPRB) :: ZFSDN0_AERO(KPROMA,KLEV+1,5)
341	!--LW (CK):
342	REAL(KIND=JPRB) :: LWUP_AERO(KPROMA,KLEV+1,5)
343	REAL(KIND=JPRB) :: LWDN_AERO(KPROMA,KLEV+1,5)
344	REAL(KIND=JPRB) :: LWUP0_AERO(KPROMA,KLEV+1,5)
345	REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5)
346
347	#include "radlsw.intfb.h"
348
349	IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',0,ZHOOK_HANDLE)
350	IBEG=KST
351	IEND=KEND
352
353	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	ZFSUP_AERO (:,:,:)=0.
363	ZFSDN_AERO (:,:,:)=0.
364	ZFSUP0_AERO(:,:,:)=0.
365	ZFSDN0_AERO(:,:,:)=0.
366
367	LWUP_AERO (:,:,:)=0.
368	LWDN_AERO (:,:,:)=0.
369	LWUP0_AERO(:,:,:)=0.
370	LWDN0_AERO(:,:,:)=0.
371
372	PTAU_ZERO(:,:,:) =1.e-15
373	PPIZA_ZERO(:,:,:)=1.0
374	PCGA_ZERO(:,:,:) =0.0
375
376	PTAU_LW_ZERO(:,:,:) =1.e-15
377
378
379	!* 1.1 LOCAL CONSTANTS
380	! ---------------
381
382	ZRII0=RII0
383	ZCRAE=RRAE*(RRAE+2.0_JPRB)
384
385	!* 2.1 FULL-LEVEL QUANTITIES
386
387	ZRPR =PAPRSF
388
389	DO JK=1,KLEV
390	DO JL=IBEG,IEND
391	! ZPQO3(JL,JK)=PQO3(JL,JK)PDP(JL,JK)RMD/RMO3
392	ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)
393	ZRCLC(JL,JK)=MAX( 0.0_JPRB ,MIN( 1.0_JPRB ,PCLFR(JL,JK)))
394	IF (ZRCLC(JL,JK) > REPCLC) THEN
395	ZQLWP(JL,JK)=PQLWP(JL,JK)
396	ZQIWP(JL,JK)=PQIWP(JL,JK)
397	ELSE
398	ZQLWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
399	ZQIWP(JL,JK)=REPH2O*ZRCLC(JL,JK)
400	ENDIF
401	ZQRAIN(JL,JK)=0.
402	ZQRAINT(JL,JK)=0.
403	ZRTI(JL,JK) =PT(JL,JK)
404	ZQS (JL,JK)=MAX(2.0_JPRB*REPH2O,PQS(JL,JK))
405	ZQ (JL,JK)=MAX(REPH2O,MIN(PQ(JL,JK),ZQS(JL,JK)*(1.0_JPRB-REPH2O)))
406	ZEMIW(JL)=PEMIS(JL)
407	ENDDO
408	ENDDO
409
410	IF (NAER == 0) THEN
411	ZRAER=RCAEROS
412	ELSE
413	DO JK=1,KLEV
414	DO JL=IBEG,IEND
415	ZRAER(JL,1,JK)=PAER(JL,JK,1)
416	ZRAER(JL,2,JK)=PAER(JL,JK,2)
417	ZRAER(JL,3,JK)=PAER(JL,JK,3)
418	ZRAER(JL,4,JK)=PAER(JL,JK,4)
419	ZRAER(JL,5,JK)=RCAEROS
420	ZRAER(JL,6,JK)=PAER(JL,JK,6)
421	ENDDO
422	ENDDO
423	ENDIF
424
425	!* 2.2 HALF-LEVEL QUANTITIES
426
427	DO JK=2,KLEV
428	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	& (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	DO JL=IBEG,IEND
439	PTH(JL,KLEV+1)=PTS(JL)
440	PTH(JL,1)=PT(JL,1)-PAPRSF(JL,1)*(PT(JL,1)-PTH(JL,2))&
441	& /(PAPRSF(JL,1)-PAPRS(JL,2))
442	ZNBAS(JL)=1.
443	ZNTOP(JL)=1.
444	ZCCNL(JL)=RCCNLND
445	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	DO JL=IBEG,IEND
458	IF (PMU0(JL) > 1.E-10_JPRB) THEN
459	ZRMU0(JL)=RRAE/(SQRT(PMU0(JL)**2+ZCRAE)-PMU0(JL))
460	ELSE
461	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	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	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	& PFSDN , PFSUP , PFSCDN , PFSCUP )
657
658	!* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
659	ZFSUP0_AERO(:,:,5) = PFSCUP(:,:)
660	ZFSDN0_AERO(:,:,5) = PFSCDN(:,:)
661
662	ZFSUP_AERO(:,:,5) = PFSUP(:,:)
663	ZFSDN_AERO(:,:,5) = PFSDN(:,:)
664
665	LWUP0_AERO(:,:,5) = PFLUC(:,1,:)
666	LWDN0_AERO(:,:,5) = PFLUC(:,2,:)
667
668	LWUP_AERO(:,:,5) = PFLUX(:,1,:)
669	LWDN_AERO(:,:,5) = PFLUX(:,2,:)
670
671	ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE
672
673	!* 4.2 TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
674
675	DO JK=1,KLEV+1
676	DO JL=IBEG,IEND
677	PSWFT(JL,JK)=ZFLS(JL,JK)/(ZRII0*ZRMU0(JL))
678	PLWFT(JL,JK)=ZFLT(JL,JK)
679	ENDDO
680	ENDDO
681
682	ZEMTD=PLWFT
683	ZEMTU=PLWFT
684
685	DO JL=IBEG,IEND
686	ZTRSOC(JL, 1)=ZFCS(JL, 1)/(ZRII0*ZRMU0(JL))
687	ZTRSOC(JL, 2)=ZFCS(JL,KLEV+1)/(ZRII0*ZRMU0(JL))
688	ZEMTC (JL, 1)=ZFCT(JL, 1)
689	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	DO JK=1,KLEV+1
697	DO JL=IBEG,IEND
698	PEMTD(JL,JK)=ZEMTD(JL,JK)
699	PEMTU(JL,JK)=ZEMTU(JL,JK)
700	PTRSO(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PSWFT(JL,JK)))
701	ENDDO
702	ENDDO
703	DO JK=1,2
704	DO JL=IBEG,IEND
705	PCEMTR(JL,JK)=ZEMTC (JL,JK)
706	PCTRSO(JL,JK)=MAX( 0.0_JPRB,MIN(1.0_JPRB,ZTRSOC(JL,JK)))
707	ENDDO
708	ENDDO
709	DO JL=IBEG,IEND
710	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	DO JL=IBEG,IEND
716	IF (PMU0(JL) < 1.E-10_JPRB) ZRMU0(JL)=0.0_JPRB
717	ENDDO
718	DO JK=1,KLEV+1
719	DO JL=IBEG,IEND
720	PLWFT(JL,JK)=PEMTD(JL,JK)
721	PSWFT(JL,JK)=ZRMU0(JL)ZRII0PTRSO(JL,JK)
722	ENDDO
723	ENDDO
724	DO JK=1,2
725	DO JL=IBEG,IEND
726	PSWFC(JL,JK)=ZRMU0(JL)ZRII0PCTRSO(JL,JK)
727	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	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	PFSUP(:,:) = ZFSUP_AERO(:,:,5)
791	PFSDN(:,:) = ZFSDN_AERO(:,:,5)
792	PFSCUP(:,:) = ZFSUP0_AERO(:,:,5)
793	PFSCDN(:,:) = ZFSDN0_AERO(:,:,5)
794
795	PFLUX(:,1,:) = LWUP_AERO(:,:,5)
796	PFLUX(:,2,:) = LWDN_AERO(:,:,5)
797	PFLUC(:,1,:) = LWUP0_AERO(:,:,5)
798	PFLUC(:,2,:) = LWDN0_AERO(:,:,5)
799
800	ENDIF
801
802	!--VolMIP Strat/Surf
803	!--only ok_ade + ok_aie case treated
804	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	IF (swaerofree_diag) THEN
824	! copy shortwave clear-sky clean (no aerosol) case
825	PFSCCUP(:,:) = ZFSUP0_AERO(:,:,5)
826	PFSCCDN(:,:) = ZFSDN0_AERO(:,:,5)
827	! copy longwave clear-sky clean (no aerosol) case
828	PFLCCUP(:,:) = LWUP0_AERO(:,:,5)
829	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	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	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	IF (LHOOK) CALL DR_HOOK('RECMWF_AERO',1,ZHOOK_HANDLE)
1011	END SUBROUTINE RECMWF_AERO

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format