Context Navigation

recmwf_aero.F90 @ 5903

Last change on this file since 5903 was 5903, checked in by fcheruy, 3 hours ago
correction les flux spectraux
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: 43.0 KB

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

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

Download in other formats:

Original Format