Context Navigation

lmdz_phytracr_spl.F90 @ 5185

Last change on this file since 5185 was 5182, checked in by abarral, 3 months ago
(WIP) Replace REPROBUS CPP KEY by logical properly name modules
File size: 173.2 KB

Line
1	! $Id: physiq.F90 2298 2015-06-14 19:13:32Z fairhead $
2
3	MODULE lmdz_phytracr_spl
4	USE lmdz_chem, ONLY: masse_s
5	USE lmdz_chem_spla, ONLY: ss_bins
6
7	IMPLICIT NONE
8
9	REAL, SAVE :: scale_param_ssacc !Scaling parameter for Fine Sea Salt
10	REAL, SAVE :: scale_param_sscoa !Scaling parameter for Coarse Sea Salt
11
12	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ind !Scaling parameter for industrial emissions of SO2
13	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_bb !Scaling parameter for biomas burning (SO2,BC & OM)
14	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_ff !Scaling parameter for industrial emissions (fossil fuel)
15	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustacc !Scaling parameter for Fine Dust
16	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustcoa !Scaling parameter for Coarse Dust
17	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: scale_param_dustsco !Scaling parameter for SCoarse Dust
18	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarBLperregion !parameter for ..
19	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: param_wstarWAKEperregion !parameter for ..
20	!$OMP THREADPRIVATE(scale_param_ind,scale_param_bb,scale_param_ff)
21	!$OMP THREADPRIVATE(scale_param_dustacc,scale_param_dustcoa,scale_param_dustsco)
22	!$OMP THREADPRIVATE(scale_param_ssacc,scale_param_sscoa)
23	!$OMP THREADPRIVATE(param_wstarBLperregion,param_wstarWAKEperregion)
24	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dust_ec, u10m_ec, v10m_ec
25	!$OMP THREADPRIVATE(dust_ec, u10m_ec, v10m_ec)
26
27	CHARACTER*800 fileregionsdimsind
28	CHARACTER*800 fileregionsdimsdust
29	CHARACTER*800 fileregionsdimsbb
30	CHARACTER*800 fileregionsdimswstar
31	CHARACTER*100 paramname_ind
32	CHARACTER*100 paramname_bb
33	CHARACTER*100 paramname_ff
34	CHARACTER*100 paramname_dustacc
35	CHARACTER*100 paramname_dustcoa
36	CHARACTER*100 paramname_dustsco
37	CHARACTER*100 paramname_ssacc
38	CHARACTER*100 paramname_sscoa
39	CHARACTER*100 paramname_wstarBL
40	CHARACTER*100 paramname_wstarWAKE
41
42	CHARACTER*800 filescaleparams
43	CHARACTER*800 paramsname
44
45
46	!!------------------------ SULFUR emissions ----------------------------
47	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_cont ! emissions so2 volcan continuous
48	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_cont ! altitude so2 volcan continuous
49	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2volc_expl ! emissions so2 volcan explosive
50	!$OMP THREADPRIVATE( lmt_so2volc_cont,lmt_altvolc_cont,lmt_so2volc_expl )
51	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_altvolc_expl ! altitude so2 volcan explosive
52	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_l ! emissions so2 fossil fuel (low)
53	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ff_h ! emissions so2 fossil fuel (high)
54	!$OMP THREADPRIVATE( lmt_altvolc_expl,lmt_so2ff_l,lmt_so2ff_h )
55	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2nff ! emissions so2 non-fossil fuel
56	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2ba ! emissions de so2 bateau
57	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_l ! emissions de so2 biomass burning (low)
58	!$OMP THREADPRIVATE( lmt_so2nff,lmt_so2ba,lmt_so2bb_l )
59	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_so2bb_h ! emissions de so2 biomass burning (high)
60	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsconc ! concentration de dms oceanique
61	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_dmsbio ! emissions de dms bio
62	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_h2sbio ! emissions de h2s bio
63	!$OMP THREADPRIVATE(lmt_so2bb_h,lmt_dmsconc,lmt_dmsbio,lmt_h2sbio )
64	!------------------------- BLACK CARBON emissions ----------------------
65	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcff ! emissions de BC fossil fuels
66	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcnff ! emissions de BC non-fossil fuels
67	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_l ! emissions de BC biomass basses
68	!$OMP THREADPRIVATE( lmt_bcff,lmt_bcnff,lmt_bcbb_l)
69	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcbb_h ! emissions de BC biomass hautes
70	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_bcba ! emissions de BC bateau
71	!$OMP THREADPRIVATE(lmt_bcbb_h,lmt_bcba)
72	!------------------------ ORGANIC MATTER emissions ---------------------
73	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omff ! emissions de OM fossil fuels
74	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnff ! emissions de OM non-fossil fuels
75	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_l ! emissions de OM biomass basses
76	!$OMP THREADPRIVATE( lmt_omff,lmt_omnff,lmt_ombb_l)
77	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_ombb_h ! emissions de OM biomass hautes
78	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omnat ! emissions de OM Natural
79	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lmt_omba ! emissions de OM bateau
80	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: lmt_sea_salt ! emissions de OM Natural
81	!$OMP THREADPRIVATE(lmt_ombb_h,lmt_omnat,lmt_omba,lmt_sea_salt)
82
83	!JE20141224 >>
84	! others
85	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tsol
86	!$OMP THREADPRIVATE(tsol)
87	INTEGER :: ijulday
88	LOGICAL, parameter :: edgar = .TRUE.
89	INTEGER, parameter :: flag_dms = 4
90	INTEGER(kind = 4) nbjour
91
92	! Tracer tendencies, for outputs
93	!-------------------------------
94	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl ! Td couche
95	!. limite/traceur
96	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dec
97	!RomP
98	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv ! Td
99	!onvection/traceur
100	! RomP >>>
101	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc
102	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav
103	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls
104	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls
105	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp
106	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav
107	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat
108	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav
109	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPr, qDi ! concentration tra
110	!dans pluie,air descente insaturee
111	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qPa, qMel
112	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: qTrdi, dtrcvMA ! conc traceur
113	!descente air insaturee et td convective MA
114	!! RomP <<<
115	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th ! Td thermique
116	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_impa ! Td du
117	!lessivage par impaction
118	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_lessi_nucl ! Td du
119	!lessivage par nucleation
120	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: qPrls !jyg:
121	!oncentration tra dans pluie LS a la surf.
122	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dry ! Td depot
123	!sec/traceur (1st layer),ALLOCATABLE,SAVE jyg
124	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: flux_tr_dry ! depot
125	!sec/traceur (surface),ALLOCATABLE,SAVE jyg
126
127	! Index of each traceur
128	INTEGER, SAVE :: id_prec, id_fine, id_coss, id_codu, id_scdu
129
130	!$OMP THREADPRIVATE(d_tr_cl,d_tr_dec,d_tr_cv,d_tr_insc,d_tr_bcscav,d_tr_evapls)
131	!$OMP THREADPRIVATE(d_tr_ls,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav)
132	!$OMP THREADPRIVATE(qPr,qDi,qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa)
133	!$OMP THREADPRIVATE(d_tr_lessi_nucl,qPrls,d_tr_dry,flux_tr_dry)
134	!$OMP THREADPRIVATE(id_prec,id_fine,id_coss,id_codu,id_scdu)
135
136	! JE20141224 <<
137
138	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tot ! epaisseur optique total aerosol 550 nm
139	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tot ! epaisseur optique total aerosol 670 nm
140	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tot ! epaisseur optique total aerosol 865 nm
141	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_aod550_tr2 ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic
142	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_tr2 ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic
143	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_tr2 ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic
144	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_ss ! epaisseur optique Sels marins aerosol 550 nm, diagnostic
145	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_ss ! epaisseur optique Sels marins aerosol 670 nm, diagnostic
146	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_ss ! epaisseur optique Sels marins aerosol 865 nm, diagnostic
147	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dust ! epaisseur optique Dust aerosol 550 nm, diagnostic
148	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dust ! epaisseur optique Dust aerosol 670 nm, diagnostic
149	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dust ! epaisseur optique Dust aerosol 865 nm, diagnostic
150	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod550_dustsco ! epaisseur optique Dust SCOarse aerosol 550 nm, diagnostic
151	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod670_dustsco ! epaisseur optique Dust SCOarse aerosol 670 nm, diagnostic
152	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diag_aod865_dustsco ! epaisseur optique Dust SCOarse aerosol 865 nm, diagnostic
153
154	!$OMP THREADPRIVATE(diff_aod550_tot,diag_aod670_tot,diag_aod865_tot)
155	!$OMP THREADPRIVATE(diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2)
156	!$OMP THREADPRIVATE(diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,diag_aod550_dust)
157	!$OMP THREADPRIVATE(diag_aod670_dust,diag_aod865_dust,diag_aod550_dustsco)
158	!$OMP THREADPRIVATE(diag_aod670_dustsco,diag_aod865_dustsco)
159
160	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_terra ! AOD at terra overpass time ( 10.30 local hour)
161	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
162	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
163	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
164	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
165	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_terra ! AOD at terra overpass time ( 10.30 local hour)
166	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
167	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
168	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
169	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
170	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_terra ! AOD at terra overpass time ( 10.30 local hour)
171	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_terra ! AOD at terra overpass time ( 10.30 local hour)
172	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_terra ! AOD at terra overpass time ( 10.30 local hour)
173	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_terra ! AOD at terra overpass time ( 10.30 local hour)
174	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour)
175
176	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_aqua ! AOD at aqua overpass time ( 13.30 local hour)
177	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
178	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
179	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
180	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
181	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_aqua ! AOD at aqua overpass time ( 13.30 local hour)
182	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
183	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
184	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
185	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
186	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_aqua ! AOD at aqua overpass time ( 13.30 local hour)
187	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour)
188	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour)
189	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour)
190	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour)
191
192	!$OMP THREADPRIVATE(aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua)
193	!$OMP THREADPRIVATE(aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua)
194	!$OMP THREADPRIVATE(aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua)
195	!$OMP THREADPRIVATE(aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra)
196	!$OMP THREADPRIVATE(aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra)
197	!$OMP THREADPRIVATE(aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra)
198
199	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc01 ! surface concentration
200	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm01 ! burden
201	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc02 ! surface concentration
202	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm02 ! burden
203	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc03 ! surface concentration
204	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm03 ! burden
205	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc04 ! surface concentration
206	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm04 ! burden
207	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc05 ! surface concentration
208	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm05 ! burden
209	!$OMP THREADPRIVATE(sconc01,sconc02,sconc03,sconc04,sconc05)
210	!$OMP THREADPRIVATE(trm01,trm02,trm03,trm04,trm05)
211	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux01
212	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux02
213	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux03
214	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux04
215	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux05
216	!$OMP THREADPRIVATE(flux01,flux02,flux03,flux04,flux05)
217	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds01
218	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds02
219	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds03
220	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds04
221	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds05
222	!$OMP THREADPRIVATE(ds01,ds02,ds03,ds04,ds05)
223	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh01
224	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh02
225	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh03
226	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh04
227	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh05
228	!$OMP THREADPRIVATE(dh01,dh02,dh03,dh04,dh05)
229	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv01
230	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv02
231	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv03
232	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv04
233	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv05
234	!$OMP THREADPRIVATE(dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05)
235	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm01
236	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm02
237	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm03
238	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm04
239	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm05
240	!$OMP THREADPRIVATE(dtherm01,dtherm02,dtherm03,dtherm04,dtherm05)
241	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv01
242	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv02
243	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv03
244	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv04
245	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv05
246	!$OMP THREADPRIVATE(dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05)
247	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds01
248	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds02
249	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds03
250	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds04
251	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds05
252	!$OMP THREADPRIVATE(d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05)
253	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc01
254	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc02
255	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc03
256	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc04
257	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc05
258	!$OMP THREADPRIVATE(dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05)
259	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv01
260	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv02
261	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv03
262	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv04
263	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cv05
264	!$OMP THREADPRIVATE(d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05)
265	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp01
266	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp02
267	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp03
268	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp04
269	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_trsp05
270	!$OMP THREADPRIVATE(d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05)
271	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav01
272	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav02
273	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav03
274	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav04
275	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sscav05
276	!$OMP THREADPRIVATE(d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05)
277	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat01
278	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat02
279	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat03
280	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat04
281	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_sat05
282	!$OMP THREADPRIVATE(d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05)
283	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav01
284	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav02
285	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav03
286	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav04
287	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_uscav05
288	!$OMP THREADPRIVATE(d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05)
289
290	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
291	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
292	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
293
294	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc01
295	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc02
296	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc03
297	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc04
298	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_insc05
299	!$OMP THREADPRIVATE(d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05)
300	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav01
301	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav02
302	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav03
303	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav04
304	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_bcscav05
305	!$OMP THREADPRIVATE(d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05)
306	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls01
307	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls02
308	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls03
309	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls04
310	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_evapls05
311	!$OMP THREADPRIVATE(d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05)
312	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls01
313	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls02
314	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls03
315	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls04
316	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_ls05
317	!$OMP THREADPRIVATE(d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05)
318
319	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn01
320	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn02
321	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn03
322	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn04
323	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_dyn05
324	!$OMP THREADPRIVATE(d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05)
325
326	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl01
327	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl02
328	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl03
329	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl04
330	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_cl05
331	!$OMP THREADPRIVATE(d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05)
332
333	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th01
334	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th02
335	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th03
336	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th04
337	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: d_tr_th05
338	!$OMP THREADPRIVATE(d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05)
339
340	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_ss3D ! corresponds to tracer 3
341	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dust3D ! corresponds to tracer 4
342	REAL, DIMENSION(:, :), ALLOCATABLE, SAVE :: sed_dustsco3D ! corresponds to tracer 4
343	!$OMP THREADPRIVATE(sed_ss3D,sed_dust3D,sed_dustsco3D)
344
345	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
346	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
347	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_ss ! corresponds to tracer 3
348	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dust ! corresponds to tracer 4
349	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dustsco ! corresponds to tracer 4
350	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2pgas ! corresponds to tracer 4
351	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2paer ! corresponds to tracer 4
352	!$OMP THREADPRIVATE(sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer)
353
354	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbb
355	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxff
356	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcbb
357	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcff
358	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcnff
359	!$OMP THREADPRIVATE(fluxbb,fluxff,fluxbcbb,fluxbcff,fluxbcnff)
360	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcba
361	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbc
362	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxombb
363	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomff
364	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnff
365	!$OMP THREADPRIVATE(fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff)
366	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomba
367	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnat
368	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxom
369	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sff
370	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2snff
371	!$OMP THREADPRIVATE(fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff)
372	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ff
373	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2nff
374	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2bb
375	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2vol
376	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ba
377	!$OMP THREADPRIVATE(fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba)
378	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2
379	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ff
380	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4nff
381	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4bb
382	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ba
383	!$OMP THREADPRIVATE(fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb)
384	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4
385	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdms
386	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sbio
387	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdustec
388	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddfine
389	!$OMP THREADPRIVATE(fluxso4,fluxdms,fluxh2sbio,fluxdustec,fluxddfine)
390	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddcoa
391	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddsco
392	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdd
393	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxssfine
394	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxsscoa
395	!$OMP THREADPRIVATE(fluxddcoa,fluxddsco,fluxdd,fluxssfine,fluxsscoa)
396	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxss
397	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ind
398	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_bb
399	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ff
400	!$OMP THREADPRIVATE(fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff)
401	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddfine
402	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddcoa
403	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddsco
404	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ssfine
405	!$OMP THREADPRIVATE(flux_sparam_ddfine,flux_sparam_ddcoa)
406	!$OMP THREADPRIVATE(flux_sparam_ddsco,flux_sparam_ssfine)
407	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_sscoa
408	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: u10m_ss
409	REAL, DIMENSION(:), ALLOCATABLE, SAVE :: v10m_ss
410	!$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss)
411
412	! Select dust emission scheme for the Sahara:
413	! LOGICAL,PARAMETER,SAVE :: ok_chimeredust=.FALSE.
414	LOGICAL, PARAMETER :: ok_chimeredust = .TRUE.
415	!!!!!! !$OMP THREADPRIVATE(ok_chimeredust)
416
417
418	CONTAINS
419
420	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
421	SUBROUTINE phytracr_spl_out_init()
422	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
423	!AS : This SUBROUTINE centralises the ALLOCATE needed for the 1st CALL of
424	! phys_output_write_spl in physiq
425
426	USE dimphy
427	USE infotrac_phy, ONLY: nbtr
428	USE dustemission_mod, ONLY: dustemis_out_init
429
430	! pour les variables m[1-3]dflux
431	CALL dustemis_out_init()
432
433	!traceur
434	ALLOCATE(diff_aod550_tot(klon))
435	ALLOCATE(diag_aod670_tot(klon))
436	ALLOCATE(diag_aod865_tot(klon))
437	ALLOCATE(diff_aod550_tr2(klon))
438	ALLOCATE(diag_aod670_tr2(klon))
439	ALLOCATE(diag_aod865_tr2(klon))
440	ALLOCATE(diag_aod550_ss(klon))
441	ALLOCATE(diag_aod670_ss(klon))
442	ALLOCATE(diag_aod865_ss(klon))
443	ALLOCATE(diag_aod550_dust(klon))
444	ALLOCATE(diag_aod670_dust(klon))
445	ALLOCATE(diag_aod865_dust(klon))
446	ALLOCATE(diag_aod550_dustsco(klon))
447	ALLOCATE(diag_aod670_dustsco(klon))
448	ALLOCATE(diag_aod865_dustsco(klon))
449	!AS: les 15 vars _terra et 15 _aqua suivantes sont groupees differemment dans spla_output_write.h
450	ALLOCATE(aod550_terra(klon))
451	ALLOCATE(aod550_tr2_terra(klon))
452	ALLOCATE(aod550_ss_terra(klon))
453	ALLOCATE(aod550_dust_terra(klon))
454	ALLOCATE(aod550_dustsco_terra(klon))
455	ALLOCATE(aod670_terra(klon))
456	ALLOCATE(aod670_tr2_terra(klon))
457	ALLOCATE(aod670_ss_terra(klon))
458	ALLOCATE(aod670_dust_terra(klon))
459	ALLOCATE(aod670_dustsco_terra(klon))
460	ALLOCATE(aod865_terra(klon))
461	ALLOCATE(aod865_tr2_terra(klon))
462	ALLOCATE(aod865_ss_terra(klon))
463	ALLOCATE(aod865_dust_terra(klon))
464	ALLOCATE(aod865_dustsco_terra(klon))
465
466	ALLOCATE(aod550_aqua(klon))
467	ALLOCATE(aod550_tr2_aqua(klon))
468	ALLOCATE(aod550_ss_aqua(klon))
469	ALLOCATE(aod550_dust_aqua(klon))
470	ALLOCATE(aod550_dustsco_aqua(klon))
471	ALLOCATE(aod670_aqua(klon))
472	ALLOCATE(aod670_tr2_aqua(klon))
473	ALLOCATE(aod670_ss_aqua(klon))
474	ALLOCATE(aod670_dust_aqua(klon))
475	ALLOCATE(aod670_dustsco_aqua(klon))
476	ALLOCATE(aod865_aqua(klon))
477	ALLOCATE(aod865_tr2_aqua(klon))
478	ALLOCATE(aod865_ss_aqua(klon))
479	ALLOCATE(aod865_dust_aqua(klon))
480	ALLOCATE(aod865_dustsco_aqua(klon))
481
482	ALLOCATE(sconc01(klon))
483	ALLOCATE(trm01(klon))
484	ALLOCATE(sconc02(klon))
485	ALLOCATE(trm02(klon))
486	ALLOCATE(sconc03(klon))
487	ALLOCATE(trm03(klon))
488	ALLOCATE(sconc04(klon))
489	ALLOCATE(trm04(klon))
490	ALLOCATE(sconc05(klon))
491	ALLOCATE(trm05(klon))
492
493	! Lessivage
494	ALLOCATE(flux01(klon))
495	ALLOCATE(flux02(klon))
496	ALLOCATE(flux03(klon))
497	ALLOCATE(flux04(klon))
498	ALLOCATE(flux05(klon))
499	ALLOCATE(ds01(klon))
500	ALLOCATE(ds02(klon))
501	ALLOCATE(ds03(klon))
502	ALLOCATE(ds04(klon))
503	ALLOCATE(ds05(klon))
504	ALLOCATE(dh01(klon))
505	ALLOCATE(dh02(klon))
506	ALLOCATE(dh03(klon))
507	ALLOCATE(dh04(klon))
508	ALLOCATE(dh05(klon))
509	ALLOCATE(dtrconv01(klon))
510	ALLOCATE(dtrconv02(klon))
511	ALLOCATE(dtrconv03(klon))
512	ALLOCATE(dtrconv04(klon))
513	ALLOCATE(dtrconv05(klon))
514	ALLOCATE(dtherm01(klon))
515	ALLOCATE(dtherm02(klon))
516	ALLOCATE(dtherm03(klon))
517	ALLOCATE(dtherm04(klon))
518	ALLOCATE(dtherm05(klon))
519	ALLOCATE(dhkecv01(klon))
520	ALLOCATE(dhkecv02(klon))
521	ALLOCATE(dhkecv03(klon))
522	ALLOCATE(dhkecv04(klon))
523	ALLOCATE(dhkecv05(klon))
524	ALLOCATE(d_tr_ds01(klon))
525	ALLOCATE(d_tr_ds02(klon))
526	ALLOCATE(d_tr_ds03(klon))
527	ALLOCATE(d_tr_ds04(klon))
528	ALLOCATE(d_tr_ds05(klon))
529	ALLOCATE(dhkelsc01(klon))
530	ALLOCATE(dhkelsc02(klon))
531	ALLOCATE(dhkelsc03(klon))
532	ALLOCATE(dhkelsc04(klon))
533	ALLOCATE(dhkelsc05(klon))
534	ALLOCATE(d_tr_cv01(klon, klev))
535	ALLOCATE(d_tr_cv02(klon, klev))
536	ALLOCATE(d_tr_cv03(klon, klev))
537	ALLOCATE(d_tr_cv04(klon, klev))
538	ALLOCATE(d_tr_cv05(klon, klev))
539	ALLOCATE(d_tr_trsp01(klon, klev))
540	ALLOCATE(d_tr_trsp02(klon, klev))
541	ALLOCATE(d_tr_trsp03(klon, klev))
542	ALLOCATE(d_tr_trsp04(klon, klev))
543	ALLOCATE(d_tr_trsp05(klon, klev))
544	ALLOCATE(d_tr_sscav01(klon, klev))
545	ALLOCATE(d_tr_sscav02(klon, klev))
546	ALLOCATE(d_tr_sscav03(klon, klev))
547	ALLOCATE(d_tr_sscav04(klon, klev))
548	ALLOCATE(d_tr_sscav05(klon, klev))
549	ALLOCATE(d_tr_sat01(klon, klev))
550	ALLOCATE(d_tr_sat02(klon, klev))
551	ALLOCATE(d_tr_sat03(klon, klev))
552	ALLOCATE(d_tr_sat04(klon, klev))
553	ALLOCATE(d_tr_sat05(klon, klev))
554	ALLOCATE(d_tr_uscav01(klon, klev))
555	ALLOCATE(d_tr_uscav02(klon, klev))
556	ALLOCATE(d_tr_uscav03(klon, klev))
557	ALLOCATE(d_tr_uscav04(klon, klev))
558	ALLOCATE(d_tr_uscav05(klon, klev))
559	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
560	ALLOCATE(d_tr_insc01(klon, klev))
561	ALLOCATE(d_tr_insc02(klon, klev))
562	ALLOCATE(d_tr_insc03(klon, klev))
563	ALLOCATE(d_tr_insc04(klon, klev))
564	ALLOCATE(d_tr_insc05(klon, klev))
565	ALLOCATE(d_tr_bcscav01(klon, klev))
566	ALLOCATE(d_tr_bcscav02(klon, klev))
567	ALLOCATE(d_tr_bcscav03(klon, klev))
568	ALLOCATE(d_tr_bcscav04(klon, klev))
569	ALLOCATE(d_tr_bcscav05(klon, klev))
570	ALLOCATE(d_tr_evapls01(klon, klev))
571	ALLOCATE(d_tr_evapls02(klon, klev))
572	ALLOCATE(d_tr_evapls03(klon, klev))
573	ALLOCATE(d_tr_evapls04(klon, klev))
574	ALLOCATE(d_tr_evapls05(klon, klev))
575	ALLOCATE(d_tr_ls01(klon, klev))
576	ALLOCATE(d_tr_ls02(klon, klev))
577	ALLOCATE(d_tr_ls03(klon, klev))
578	ALLOCATE(d_tr_ls04(klon, klev))
579	ALLOCATE(d_tr_ls05(klon, klev))
580
581	ALLOCATE(d_tr_dyn01(klon, klev))
582	ALLOCATE(d_tr_dyn02(klon, klev))
583	ALLOCATE(d_tr_dyn03(klon, klev))
584	ALLOCATE(d_tr_dyn04(klon, klev))
585	ALLOCATE(d_tr_dyn05(klon, klev))
586
587	ALLOCATE(d_tr_cl01(klon, klev))
588	ALLOCATE(d_tr_cl02(klon, klev))
589	ALLOCATE(d_tr_cl03(klon, klev))
590	ALLOCATE(d_tr_cl04(klon, klev))
591	ALLOCATE(d_tr_cl05(klon, klev))
592	ALLOCATE(d_tr_th01(klon, klev))
593	ALLOCATE(d_tr_th02(klon, klev))
594	ALLOCATE(d_tr_th03(klon, klev))
595	ALLOCATE(d_tr_th04(klon, klev))
596	ALLOCATE(d_tr_th05(klon, klev))
597
598	ALLOCATE(sed_ss(klon))
599	ALLOCATE(sed_dust(klon))
600	ALLOCATE(sed_dustsco(klon))
601	ALLOCATE(his_g2pgas(klon))
602	ALLOCATE(his_g2paer(klon))
603
604	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
605	ALLOCATE(sed_ss3D(klon, klev))
606	ALLOCATE(sed_dust3D(klon, klev))
607	ALLOCATE(sed_dustsco3D(klon, klev))
608	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
609
610	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
611	! histrac_spl
612
613	ALLOCATE(fluxbb(klon))
614	ALLOCATE(fluxff(klon))
615	ALLOCATE(fluxbcbb(klon))
616	ALLOCATE(fluxbcff(klon))
617	ALLOCATE(fluxbcnff(klon))
618	ALLOCATE(fluxbcba(klon))
619	ALLOCATE(fluxbc(klon))
620	ALLOCATE(fluxombb(klon))
621	ALLOCATE(fluxomff(klon))
622	ALLOCATE(fluxomnff(klon))
623	ALLOCATE(fluxomba(klon))
624	ALLOCATE(fluxomnat(klon))
625	ALLOCATE(fluxom(klon))
626	ALLOCATE(fluxh2sff(klon))
627	ALLOCATE(fluxh2snff(klon))
628	ALLOCATE(fluxso2ff(klon))
629	ALLOCATE(fluxso2nff(klon))
630	ALLOCATE(fluxso2bb(klon))
631	ALLOCATE(fluxso2vol(klon))
632	ALLOCATE(fluxso2ba(klon))
633	ALLOCATE(fluxso2(klon))
634	ALLOCATE(fluxso4ff(klon))
635	ALLOCATE(fluxso4nff(klon))
636	ALLOCATE(fluxso4bb(klon))
637	ALLOCATE(fluxso4ba(klon))
638	ALLOCATE(fluxso4(klon))
639	ALLOCATE(fluxdms(klon))
640	ALLOCATE(fluxh2sbio(klon))
641	ALLOCATE(fluxdustec(klon))
642	ALLOCATE(fluxddfine(klon))
643	ALLOCATE(fluxddcoa(klon))
644	ALLOCATE(fluxddsco(klon))
645	ALLOCATE(fluxdd(klon))
646	ALLOCATE(fluxssfine(klon))
647	ALLOCATE(fluxsscoa(klon))
648	ALLOCATE(fluxss(klon))
649	ALLOCATE(flux_sparam_ind(klon))
650	ALLOCATE(flux_sparam_bb(klon))
651	ALLOCATE(flux_sparam_ff(klon))
652	ALLOCATE(flux_sparam_ddfine(klon))
653	ALLOCATE(flux_sparam_ddcoa(klon))
654	ALLOCATE(flux_sparam_ddsco(klon))
655	ALLOCATE(flux_sparam_ssfine(klon))
656	ALLOCATE(flux_sparam_sscoa(klon))
657	ALLOCATE(u10m_ss(klon))
658	ALLOCATE(v10m_ss(klon))
659
660	!AS: in phys_output_write_spl, but not in spla_output_write.h
661	!------------------------------------------------------
662	ALLOCATE(d_tr_cl(klon, klev, nbtr))
663	ALLOCATE(d_tr_th(klon, klev, nbtr))
664	ALLOCATE(d_tr_cv(klon, klev, nbtr))
665	ALLOCATE(d_tr_lessi_impa(klon, klev, nbtr))
666	ALLOCATE(d_tr_lessi_nucl(klon, klev, nbtr))
667	ALLOCATE(d_tr_insc(klon, klev, nbtr))
668	ALLOCATE(d_tr_bcscav(klon, klev, nbtr))
669	ALLOCATE(d_tr_evapls(klon, klev, nbtr))
670	ALLOCATE(d_tr_ls(klon, klev, nbtr))
671	ALLOCATE(d_tr_trsp(klon, klev, nbtr))
672	ALLOCATE(d_tr_sscav(klon, klev, nbtr))
673	ALLOCATE(d_tr_sat(klon, klev, nbtr))
674	ALLOCATE(d_tr_uscav(klon, klev, nbtr))
675
676	END SUBROUTINE phytracr_spl_out_init
677
678	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
679	SUBROUTINE phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
680	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
681
682	IMPLICIT NONE
683	INTEGER klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust
684
685	ALLOCATE(tsol(klon))
686
687	!AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
688	! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
689	! avant d'appeler la SUBROUTINE presente, phytracr_spl_ini
690	! (phytracr_spl_ini appele readregionsdims2_spl,
691	! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
692	IF("ASSIM"=="YES") THEN
693	fileregionsdimsind = 'regions_ind_meta'
694	fileregionsdimsdust = 'regions_dustacc_meta'
695	! fileregionsdimsdust='regions_dust_meta'
696	fileregionsdimsbb = 'regions_bb_meta'
697	fileregionsdimswstar = 'regions_pwstarwake_meta'
698	CALL readregionsdims2_spl(nbreg_ind, fileregionsdimsind)
699	CALL readregionsdims2_spl(nbreg_dust, fileregionsdimsdust)
700	CALL readregionsdims2_spl(nbreg_bb, fileregionsdimsbb)
701	CALL readregionsdims2_spl(nbreg_wstardust, fileregionsdimswstar)
702	ENDIF ! ASSIM
703	! fin debranchage
704
705	!readregions_spl()
706
707	ALLOCATE(scale_param_ind(nbreg_ind))
708	ALLOCATE(scale_param_bb(nbreg_bb))
709	ALLOCATE(scale_param_ff(nbreg_ind))
710	ALLOCATE(scale_param_dustacc(nbreg_dust))
711	ALLOCATE(scale_param_dustcoa(nbreg_dust))
712	ALLOCATE(scale_param_dustsco(nbreg_dust))
713	ALLOCATE(param_wstarBLperregion(nbreg_wstardust))
714	ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust))
715	ALLOCATE(dust_ec(klon))
716	ALLOCATE(u10m_ec(klon))
717	ALLOCATE(v10m_ec(klon))
718	ALLOCATE(lmt_so2volc_cont(klon))
719	ALLOCATE(lmt_altvolc_cont(klon))
720	ALLOCATE(lmt_so2volc_expl(klon))
721	ALLOCATE(lmt_altvolc_expl(klon))
722	ALLOCATE(lmt_so2ff_l(klon))
723	ALLOCATE(lmt_so2ff_h(klon))
724	ALLOCATE(lmt_so2nff(klon))
725	ALLOCATE(lmt_so2ba(klon))
726	ALLOCATE(lmt_so2bb_l(klon))
727	ALLOCATE(lmt_so2bb_h(klon))
728	ALLOCATE(lmt_dmsconc(klon))
729	ALLOCATE(lmt_dmsbio(klon))
730	ALLOCATE(lmt_h2sbio(klon))
731	ALLOCATE(lmt_bcff(klon))
732	ALLOCATE(lmt_bcnff(klon))
733	ALLOCATE(lmt_bcbb_l(klon))
734	ALLOCATE(lmt_bcbb_h(klon))
735	ALLOCATE(lmt_bcba(klon))
736	ALLOCATE(lmt_omff(klon))
737	ALLOCATE(lmt_omnff(klon))
738	ALLOCATE(lmt_ombb_l(klon))
739	ALLOCATE(lmt_ombb_h(klon))
740	ALLOCATE(lmt_omnat(klon))
741	ALLOCATE(lmt_omba(klon))
742	ALLOCATE(lmt_sea_salt(klon, ss_bins))
743
744
745
746
747	!temporal hardcoded null inicialization of assimilation emmision factors
748	!AS: scale_param sont ensuite lus dans modvalues.nc
749	! par la SUBROUTINE read_scalenc, appelee par readscaleparamsnc_spl
750	scale_param_ssacc = 1.
751	scale_param_sscoa = 1.
752	scale_param_ind(:) = 1.
753	scale_param_bb(:) = 1.
754	scale_param_ff(:) = 1.
755	scale_param_dustacc(:) = 1.
756	scale_param_dustcoa(:) = 1.
757	scale_param_dustsco(:) = 1.
758	param_wstarBLperregion(:) = 0.
759	param_wstarWAKEperregion(:) = 0.
760
761	END SUBROUTINE phytracr_spl_ini
762
763
764	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
765	SUBROUTINE phytracr_spl(debutphy, lafin, jD_cur, jH_cur, iflag_conv, & ! I
766	pdtphys, ftsol, & ! I
767	t_seri, q_seri, paprs, pplay, RHcl, & ! I
768	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & ! I
769	coefh, cdragh, cdragm, yu1, yv1, & ! I
770	u_seri, v_seri, rlat, rlon, & ! I
771	pphis, pctsrf, pmflxr, pmflxs, prfl, psfl, & ! I
772	da, phi, phi2, d1a, dam, mp, ep, sigd, sij, clw, elij, & ! I
773	epmlmMm, eplaMm, upwd, dnwd, itop_con, ibas_con, & ! I
774	evapls, wdtrainA, wdtrainM, wght_cvfd, & ! I
775	fm_therm, entr_therm, rneb, & ! I
776	beta_fisrt, beta_v1, & ! I
777	zu10m, zv10m, wstar, ale_bl, ale_wake, & ! I
778	d_tr_dyn, tr_seri) ! O
779	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
780
781	USE lmdz_grid_phy
782	USE lmdz_phys_para
783	USE IOIPSL
784	USE dimphy
785	USE lmdz_infotrac
786	USE indice_sol_mod
787	USE lmdz_writefield_phy
788
789	USE lmdz_phys_transfert_para
790	USE lmdz_thermcell_dq, ONLY: thermcell_dq
791	USE phys_cal_mod, ONLY: jD_1jan, year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
792	mth_cur, phys_cal_update
793
794	USE lmdz_yomcst
795	USE lmdz_alpale
796	USE lmdz_yoethf
797	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
798	USE lmdz_paramet
799	USE lmdz_chem, ONLY: masse_s
800	USE lmdz_chem_spla, ONLY: ss_bins
801	USE lmdz_read_newemissions, ONLY: read_newemissions
802	USE lmdz_precureemission, ONLY: precuremission
803
804	IMPLICIT NONE
805
806	!======================================================================
807	! Auteur(s) FH
808	! Objet: Moniteur general des tendances traceurs
809
810	! Remarques en vrac:
811	! ------------------
812	! 1/ le CALL phytrac se fait avec nqmax-2 donc nous avons bien
813	! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
814	!! AS : nqmax-2 devrait etre nqmax-3 apres introducton de H2Oi ;
815	!! et c'est encore different avec le parser de DC ?
816	!======================================================================
817
818	! Arguments:
819
820	! EN ENTREE:
821	! ==========
822
823	! divers:
824	! -------
825
826	REAL, INTENT(IN) :: pdtphys ! pas d'integration pour la physique (seconde)
827	REAL, INTENT(IN) :: jD_cur, jH_cur
828	REAL, INTENT(IN) :: ftsol(klon, nbsrf) ! temperature du sol par type
829	REAL, INTENT(IN) :: t_seri(klon, klev) ! temperature
830	REAL, INTENT(IN) :: u_seri(klon, klev) ! vent
831	REAL, INTENT(IN) :: v_seri(klon, klev) ! vent
832	REAL, INTENT(IN) :: q_seri(klon, klev) ! vapeur d eau kg/kg
833
834	LOGICAL, INTENT(IN) :: lafin
835
836	REAL tr_seri(klon, klev, nbtr) ! traceur
837	REAL tmp_var(klon, klev) ! auxiliary variable to replace traceur
838	REAL tmp_var2(klon, nbtr) ! auxiliary variable to replace source
839	REAL tmp_var3(klon, klev, nbtr) ! auxiliary variable 3D
840	REAL dummy1d ! JE auxiliary variable
841	REAL aux_var2(klon) ! auxiliary variable to replace traceur
842	REAL aux_var3(klon, klev) ! auxiliary variable to replace traceur
843	REAL d_tr(klon, klev, nbtr) ! traceur tendance
844	REAL sconc_seri(klon, nbtr) ! surface concentration of traceur
845
846	INTEGER nbjour
847	save nbjour
848	!$OMP THREADPRIVATE(nbjour)
849
850	INTEGER masque_aqua_cur(klon)
851	INTEGER masque_terra_cur(klon)
852	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua !mask for 1 day
853	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra !
854	!$OMP THREADPRIVATE(masque_aqua,masque_terra)
855
856	INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss, nbreg_wstardust
857	!$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust)
858
859	REAL lmt_dms(klon) ! emissions de dms
860
861	!JE20150518<<
862	REAL, DIMENSION(klon_glo) :: aod550_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
863	REAL, DIMENSION(klon_glo) :: aod550_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
864	REAL, DIMENSION(klon_glo) :: aod550_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
865	REAL, DIMENSION(klon_glo) :: aod550_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
866	REAL, DIMENSION(klon_glo) :: aod550_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
867	REAL, DIMENSION(klon_glo) :: aod670_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
868	REAL, DIMENSION(klon_glo) :: aod670_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
869	REAL, DIMENSION(klon_glo) :: aod670_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
870	REAL, DIMENSION(klon_glo) :: aod670_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
871	REAL, DIMENSION(klon_glo) :: aod670_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
872	REAL, DIMENSION(klon_glo) :: aod865_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
873	REAL, DIMENSION(klon_glo) :: aod865_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
874	REAL, DIMENSION(klon_glo) :: aod865_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
875	REAL, DIMENSION(klon_glo) :: aod865_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
876	REAL, DIMENSION(klon_glo) :: aod865_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour)
877
878	REAL, DIMENSION(klon_glo) :: aod550_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
879	REAL, DIMENSION(klon_glo) :: aod550_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
880	REAL, DIMENSION(klon_glo) :: aod550_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
881	REAL, DIMENSION(klon_glo) :: aod550_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
882	REAL, DIMENSION(klon_glo) :: aod550_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
883	REAL, DIMENSION(klon_glo) :: aod670_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
884	REAL, DIMENSION(klon_glo) :: aod670_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
885	REAL, DIMENSION(klon_glo) :: aod670_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
886	REAL, DIMENSION(klon_glo) :: aod670_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
887	REAL, DIMENSION(klon_glo) :: aod670_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
888	REAL, DIMENSION(klon_glo) :: aod865_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
889	REAL, DIMENSION(klon_glo) :: aod865_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
890	REAL, DIMENSION(klon_glo) :: aod865_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
891	REAL, DIMENSION(klon_glo) :: aod865_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
892	REAL, DIMENSION(klon_glo) :: aod865_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour)
893	!!!!!!!!!!!!!
894	!JE20150518>>
895
896	REAL, INTENT(IN) :: paprs(klon, klev + 1) ! pression pour chaque inter-couche (en Pa)
897	REAL, INTENT(IN) :: pplay(klon, klev) ! pression pour le mileu de chaque couche (en Pa)
898	REAL, INTENT(IN) :: RHcl(klon, klev) ! humidite relativen ciel clair
899	REAL znivsig(klev) ! indice des couches
900	REAL paire(klon)
901	REAL, INTENT(IN) :: pphis(klon)
902	REAL, INTENT(IN) :: pctsrf(klon, nbsrf)
903	logical, INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
904
905	! Scaling Parameters:
906	! ----------------------
907
908	CHARACTER*50 c_Directory
909	CHARACTER*80 c_FileName1
910	CHARACTER*80 c_FileName2
911	CHARACTER*130 c_FullName1
912	CHARACTER*130 c_FullName2
913	INTEGER :: xidx, yidx
914	INTEGER, DIMENSION(klon) :: mask_bbreg
915	INTEGER, DIMENSION(klon) :: mask_ffso2reg
916	INTEGER :: aux_mask1
917	INTEGER :: aux_mask2
918	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
919	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind !Defines regions for SO2, BC & OM
920	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb !Defines regions for SO2, BC & OM
921	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines dust regions
922	INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines dust regions
923	!$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust)
924
925	! Emissions:
926
927	!---------------------------- SEA SALT & DUST emissions ------------------------
928	REAL lmt_sea_salt(klon, ss_bins) !Sea salt 0.03-8.0 um
929	REAL u10m_ec1(klon), v10m_ec1(klon)
930	REAL u10m_ec2(klon), v10m_ec2(klon), dust_ec2(klon)
931	REAL dust_ec(klon)
932	! new dust emission chimere je20140522
933	REAL, DIMENSION(klon), INTENT(IN) :: zu10m
934	REAL, DIMENSION(klon), INTENT(IN) :: zv10m
935	REAL, DIMENSION(klon), INTENT(IN) :: wstar, ale_bl, ale_wake
936
937	! Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
938
939	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
940	!Dynamique
941	!--------
942	REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: d_tr_dyn
943
944	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
945	! convection:
946	! -----------
947
948	REAL, INTENT(IN) :: pmfu(klon, klev) ! flux de masse dans le panache montant
949	REAL, INTENT(IN) :: pmfd(klon, klev) ! flux de masse dans le panache descendant
950	REAL, INTENT(IN) :: pen_u(klon, klev) ! flux entraine dans le panache montant
951	REAL, INTENT(IN) :: pde_u(klon, klev) ! flux detraine dans le panache montant
952	REAL, INTENT(IN) :: pen_d(klon, klev) ! flux entraine dans le panache descendant
953	REAL, INTENT(IN) :: pde_d(klon, klev) ! flux detraine dans le panache descendant
954
955	! Convection KE scheme:
956	! ---------------------
957
958	!! Variables pour le lessivage convectif
959	REAL, DIMENSION(klon, klev), INTENT(IN) :: da
960	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi
961	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: phi2
962	REAL, DIMENSION(klon, klev), INTENT(IN) :: d1a, dam
963	REAL, DIMENSION(klon, klev), INTENT(IN) :: mp
964	REAL, DIMENSION(klon, klev), INTENT(IN) :: upwd ! saturated
965	! updraft mass flux
966	REAL, DIMENSION(klon, klev), INTENT(IN) :: dnwd ! saturated
967	! downdraft mass flux
968	INTEGER, DIMENSION(klon), INTENT(IN) :: itop_con
969	INTEGER, DIMENSION(klon), INTENT(IN) :: ibas_con
970	REAL, DIMENSION(klon, klev) :: evapls
971	REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainA
972	REAL, DIMENSION(klon, klev), INTENT(IN) :: wdtrainM
973
974	REAL, DIMENSION(klon, klev), INTENT(IN) :: ep
975	REAL, DIMENSION(klon), INTENT(IN) :: sigd
976	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: sij
977	REAL, DIMENSION(klon, klev), INTENT(IN) :: clw
978	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: elij
979	REAL, DIMENSION(klon, klev, klev), INTENT(IN) :: epmlmMm
980	REAL, DIMENSION(klon, klev), INTENT(IN) :: eplaMm
981	REAL, DIMENSION(klon, klev), INTENT(IN) :: wght_cvfd !RL
982
983
984	! KE: Tendances de traceurs (Td) et flux de traceurs:
985	! ------------------------
986	REAL, DIMENSION(klon, klev) :: Mint
987	REAL, DIMENSION(klon, klev, nbtr) :: zmfd1a
988	REAL, DIMENSION(klon, klev, nbtr) :: zmfdam
989	REAL, DIMENSION(klon, klev, nbtr) :: zmfphi2
990
991	! !tra dans pluie LS a la surf.
992	! outputs for cvltr_spl
993	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cv_o
994	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_trsp_o
995	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sscav_o
996	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_sat_o
997	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_uscav_o
998	!!!!!!!!!!!!!!!!!
999	!!!!!!!!!!!!!!!!!
1000	!!!!!!!!!!!!!!!!!
1001	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_insc_o
1002	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_bcscav_o
1003	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_evapls_o
1004	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_ls_o
1005	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_dyn_o
1006	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_cl_o
1007	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: d_tr_th_o
1008	!!!!!!!!!!!!!!!!!
1009	!!!!!!!!!!!!!!!!!
1010	!!!!!!!!!!!!!!!!!
1011
1012	!$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o)
1013	!$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o)
1014	!$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o)
1015
1016	INTEGER :: nsplit
1017
1018	! Lessivage
1019	! ---------
1020
1021	REAL, INTENT(IN) :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1) !--convection
1022	REAL, INTENT(IN) :: prfl(klon, klev + 1), psfl(klon, klev + 1) !--large-scale
1023	REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
1024	REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
1025
1026	REAL, DIMENSION(klon, klev), INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
1027
1028	REAL, DIMENSION(klon, klev) :: beta_fisrt ! taux de conversion
1029	! ! de l'eau cond (de fisrtilp)
1030	REAL, DIMENSION(klon, klev) :: beta_v1 ! -- (originale version)
1031	INTEGER, SAVE :: iflag_lscav_omp, iflag_lscav
1032	!$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav)
1033
1034
1035
1036
1037	!Thermiques:
1038	!----------
1039	REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: fm_therm
1040	REAL, DIMENSION(klon, klev), INTENT(INOUT) :: entr_therm
1041
1042	! Couche limite:
1043	! --------------
1044
1045	REAL, INTENT(IN) :: coefh(klon, klev) ! coeff melange CL
1046	REAL, INTENT(IN) :: cdragh(klon), cdragm(klon)
1047	REAL, INTENT(IN) :: yu1(klon) ! vent dans la 1iere couche
1048	REAL, INTENT(IN) :: yv1(klon) ! vent dans la 1iere couche
1049
1050
1051	!----------------------------------------------------------------------
1052	REAL his_ds(klon, nbtr)
1053	REAL his_dh(klon, nbtr)
1054	REAL his_dhlsc(klon, nbtr) ! in-cloud scavenging lsc
1055	REAL his_dhcon(klon, nbtr) ! in-cloud scavenging con
1056	REAL his_dhbclsc(klon, nbtr) ! below-cloud scavenging lsc
1057	REAL his_dhbccon(klon, nbtr) ! below-cloud scavenging con
1058	REAL trm(klon, nbtr)
1059
1060	REAL u10m_ec(klon), v10m_ec(klon)
1061
1062	REAL his_th(klon, nbtr)
1063	REAL his_dhkecv(klon, nbtr)
1064	REAL his_dhkelsc(klon, nbtr)
1065
1066	! Coordonnees
1067	! -----------
1068
1069	REAL, INTENT(IN) :: rlat(klon) ! latitudes pour chaque point
1070	REAL, INTENT(IN) :: rlon(klon) ! longitudes pour chaque point
1071
1072	INTEGER i, k, iq, itr, j, ig
1073
1074	! DEFINITION OF DIAGNOSTIC VARIABLES
1075
1076	REAL diag_trm(nbtr), diag_drydep(nbtr)
1077	REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
1078	REAL diag_emissn(nbtr), diag_g2part
1079	REAL diag_sedimt
1080	REAL trm_aux(nbtr), src_aux(nbtr)
1081
1082	! Variables locales pour effectuer les appels en serie
1083	!----------------------------------------------------
1084	REAL source_tr(klon, nbtr)
1085	REAL flux_tr(klon, nbtr)
1086	REAL m_conc(klon, klev)
1087	REAL henry(nbtr) !--cste de Henry mol/l/atm
1088	REAL kk(nbtr) !--coefficient de var avec T (K)
1089	REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
1090	REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
1091	REAL vdep_oce(nbtr), vdep_sic(nbtr)
1092	REAL vdep_ter(nbtr), vdep_lic(nbtr)
1093	REAL ccntrAA_spla(nbtr)
1094	REAL ccntrENV_spla(nbtr)
1095	REAL coefcoli_spla(nbtr)
1096	REAL dtrconv(klon, nbtr)
1097	REAL zrho(klon, klev), zdz(klon, klev)
1098	REAL zalt(klon, klev)
1099	REAL, DIMENSION(klon, klev) :: zmasse ! densité atmosphérique
1100	! . Kg/m2
1101	REAL, DIMENSION(klon, klev) :: ztra_th
1102	REAL qmin, qmax, aux
1103	! PARAMETER (qmin=0.0, qmax=1.e33)
1104	PARAMETER (qmin = 1.e33, qmax = -1.e33)
1105
1106	! Variables to save data into file
1107	!----------------------------------
1108
1109	CHARACTER*2 str2
1110	!!AS: LOGICAL ok_histrac
1111	!!!JE2014124 PARAMETER (ok_histrac=.TRUE.)
1112	!! PARAMETER (ok_histrac=.FALSE.)
1113	INTEGER ndex2d(iim * (jjm + 1)), ndex3d(iim * (jjm + 1) * klev)
1114	INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
1115	INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
1116	SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
1117	!$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5)
1118	INTEGER itra
1119	SAVE itra ! compteur pour la physique
1120	!$OMP THREADPRIVATE(itra)
1121	INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
1122	SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
1123	!$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m)
1124	REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
1125	REAL zx_tmp_2d(iim, jjm + 1), zx_tmp_3d(iim, jjm + 1, klev)
1126	REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
1127	REAL zx_lon_glo(nbp_lon, nbp_lat), zx_lat_glo(nbp_lon, nbp_lat)
1128	REAL zsto, zout, zout_h, zout_m, zjulian
1129
1130	!------Molar Masses
1131	REAL masse(nbtr)
1132
1133	REAL fracso2emis !--fraction so2 emis en so2
1134	PARAMETER (fracso2emis = 0.95)
1135	REAL frach2sofso2 !--fraction h2s from so2
1136	PARAMETER (frach2sofso2 = 0.0426)
1137
1138	! Controles
1139	!-------------
1140	LOGICAL convection, lessivage, lminmax, lcheckmass
1141	DATA convection, lessivage, lminmax, lcheckmass &
1142	/.TRUE., .TRUE., .TRUE., .FALSE./
1143
1144	REAL xconv(nbtr)
1145
1146	LOGICAL anthropo, bateau, edgar
1147	DATA anthropo, bateau, edgar/.TRUE., .TRUE., .TRUE./
1148
1149	!c bc_source
1150	INTEGER kminbc, kmaxbc
1151	!JE20150715 PARAMETER (kminbc=3, kmaxbc=5)
1152	PARAMETER (kminbc = 4, kmaxbc = 7)
1153
1154	REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
1155
1156	! JE for updating in cltrac
1157	REAL, DIMENSION(klon, klev) :: delp ! epaisseur de couche (Pa)
1158	!! JE for INCLUDE gas to particle conversion in output
1159	! REAL his_g2pgas(klon) ! gastoparticle in gas units (check!)
1160	! REAL his_g2paer(klon) ! gastoparticle in aerosol units (check!)
1161
1162	INTEGER, INTENT(IN) :: iflag_conv
1163	LOGICAL iscm3 ! debug variable. for checkmass ! JE
1164
1165	!------------------------------------------------------------------------
1166	! only to compute time consumption of each process
1167	!----
1168	INTEGER clock_start, clock_end, clock_rate, clock_start_spla
1169	INTEGER clock_end_outphytracr, clock_start_outphytracr
1170	INTEGER ti_init, dife, ti_inittype, ti_inittwrite
1171	INTEGER ti_spla, ti_emis, ti_depo, ti_cltr, ti_ther
1172	INTEGER ti_sedi, ti_gasp, ti_wetap, ti_cvltr, ti_lscs, ti_brop, ti_outs
1173	INTEGER ti_nophytracr, clock_per_max
1174	REAL tia_init, tia_inittype, tia_inittwrite
1175	REAL tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
1176	REAL tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
1177	REAL tia_brop, tia_outs
1178	REAL tia_nophytracr
1179
1180	SAVE tia_init, tia_inittype, tia_inittwrite
1181	SAVE tia_spla, tia_emis, tia_depo, tia_cltr, tia_ther
1182	SAVE tia_sedi, tia_gasp, tia_wetap, tia_cvltr, tia_lscs
1183	SAVE tia_brop, tia_outs
1184	SAVE ti_nophytracr
1185	SAVE tia_nophytracr
1186	SAVE clock_end_outphytracr, clock_start_outphytracr
1187	SAVE clock_per_max
1188	LOGICAL logitime
1189	!$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite)
1190	!$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther)
1191	!$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs)
1192	!$OMP THREADPRIVATE(tia_brop,tia_outs)
1193	!$OMP THREADPRIVATE(ti_nophytracr)
1194	!$OMP THREADPRIVATE(tia_nophytracr)
1195	!$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr)
1196	!$OMP THREADPRIVATE(clock_per_max)
1197
1198	! utils parallelization
1199	REAL :: auxklon_glo(klon_glo)
1200	INTEGER :: iauxklon_glo(klon_glo)
1201	REAL, DIMENSION(klon_glo, nbp_lev) :: auxklonnbp_lev
1202	REAL, DIMENSION(klon_glo, nbp_lev, nbtr) :: auxklonklevnbtr_glo
1203	REAL, DIMENSION(nbp_lon, nbp_lat) :: zx_tmp_2d_glo
1204	REAL, DIMENSION(nbp_lon, nbp_lat, nbp_lev) :: zx_tmp_3d_glo
1205	REAL, DIMENSION(klon_glo) :: zx_tmp_fi2d_glo
1206	REAL, DIMENSION(klon_glo, nbp_lev) :: zx_tmp_fi3d_glo
1207	REAL, DIMENSION(klon_glo, nbtr) :: auxklonnbtr_glo
1208
1209	source_tr = 0.
1210
1211	IF (debutphy) THEN
1212	#ifdef IOPHYS_DUST
1213	CALL iophys_ini(pdtphys)
1214	#endif
1215	nbreg_ind = 1
1216	nbreg_bb = 1
1217	nbreg_dust = 1
1218	nbreg_wstardust = 1
1219	CALL phytracr_spl_ini(klon, nbreg_ind, nbreg_bb, nbreg_dust, nbreg_wstardust)
1220	endif
1221
1222
1223	#ifdef IOPHYS_DUST
1224	itr = 0
1225	DO iq = 1, nqtot
1226	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
1227	itr = itr+1
1228	WRITE(str2,'(i2.2)') itrr
1229	CALL iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
1230	enddo
1231	#endif
1232
1233
1234
1235
1236	ijulday = jD_cur - jD_1jan + 1
1237	nbjour = 1
1238
1239	paramname_ind = 'ind'
1240	paramname_bb = 'bb'
1241	paramname_ff = 'ind'
1242	paramname_dustacc = 'dustacc'
1243	paramname_dustcoa = 'dustcoasco'
1244	paramname_dustsco = 'dustcoasco'
1245	! paramname_dustacc='dust'
1246	! paramname_dustcoa='dust'
1247	! paramname_dustsco='dust'
1248	paramname_wstarBL = 'pwstarbl'
1249	paramname_wstarWAKE = 'pwstarwake'
1250	paramname_ssacc = 'ssacc'
1251	paramname_sscoa = 'sscoa'
1252
1253	filescaleparams = 'modvalues.nc'
1254	!AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
1255	IF("ASSIM"=="YES") THEN
1256	CALL readscaleparamsnc_spl(scale_param_ind, &
1257	nbreg_ind, paramname_ind, &
1258	scale_param_ff, nbreg_ind, paramname_ff, &
1259	scale_param_bb, nbreg_bb, paramname_bb, &
1260	scale_param_dustacc, nbreg_dust, paramname_dustacc, &
1261	scale_param_dustcoa, nbreg_dust, paramname_dustcoa, &
1262	scale_param_dustsco, nbreg_dust, paramname_dustsco, &
1263	param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, &
1264	param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, &
1265	scale_param_ssacc, paramname_ssacc, &
1266	scale_param_sscoa, paramname_sscoa, &
1267	filescaleparams, ijulday, jH_cur, pdtphys, debutphy)
1268	ENDIF ! ASSIM
1269	!AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
1270	! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
1271	! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
1272	!! add seasalt
1273
1274	PRINT *, 'JE : check scale_params'
1275
1276	PRINT *, 'nbreg_ind', nbreg_ind
1277	PRINT *, 'nbreg_dust', nbreg_dust
1278	PRINT *, 'nbreg_bb', nbreg_bb
1279	PRINT *, 'ind', scale_param_ind
1280	PRINT *, 'dustacc', scale_param_dustacc
1281	PRINT *, 'dustcoa', scale_param_dustcoa
1282	PRINT *, 'dustsco', scale_param_dustsco
1283	PRINT *, 'wstardustBL', param_wstarBLperregion
1284	PRINT *, 'wstardustWAKE', param_wstarWAKEperregion
1285	PRINT *, 'ff', scale_param_ff
1286	PRINT *, 'bb', scale_param_bb
1287	PRINT *, 'ssacc', scale_param_ssacc
1288	PRINT *, 'sscoa', scale_param_sscoa
1289
1290	PRINT *, 'JE: before read_newemissions '
1291	PRINT *, 'JE: jD_cur:', jD_cur, ' ijulday:', ijulday, ' jH_cur:', jH_cur, ' pdtphys:', pdtphys
1292	PRINT *, 'JE: now read_newemissions:'
1293	!AS: La ligne suivante fait planter a l'execution : lmt_so2ff_l pas initialise
1294	! PRINT *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
1295	CALL read_newemissions(ijulday, jH_cur, edgar, flag_dms, debutphy, & !I
1296	pdtphys, lafin, nbjour, pctsrf, & !I
1297	t_seri, rlat, rlon, & !I
1298	pmflxr, pmflxs, prfl, psfl, & !I
1299	u10m_ec, v10m_ec, dust_ec, & !O
1300	lmt_sea_salt, lmt_so2ff_l, & !O
1301	lmt_so2ff_h, lmt_so2nff, & !O
1302	lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, & !O
1303	lmt_so2volc_cont, lmt_altvolc_cont, & !O
1304	lmt_so2volc_expl, lmt_altvolc_expl, & !O
1305	lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, & !O
1306	lmt_bcff, lmt_bcnff, lmt_bcbb_l, & !O
1307	lmt_bcbb_h, lmt_bcba, lmt_omff, & !O
1308	lmt_omnff, lmt_ombb_l, lmt_ombb_h, & !O
1309	lmt_omnat, lmt_omba) !O
1310
1311	PRINT *, 'Check emissions'
1312	PRINT *, 'lmt_so2ff_l', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
1313	PRINT *, 'lmt_so2ff_h', MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h)
1314	PRINT *, 'lmt_so2nff', MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff)
1315	PRINT *, 'lmt_so2ba', MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba)
1316	PRINT *, 'lmt_so2bb_l', MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l)
1317	PRINT *, 'lmt_so2bb_h', MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h)
1318	PRINT *, 'lmt_so2volc_cont', MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont)
1319	PRINT *, 'lmt_altvolc_cont', MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont)
1320	PRINT *, 'lmt_so2volc_expl', MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl)
1321	PRINT *, 'lmt_altvolc_expl', MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl)
1322	PRINT *, 'lmt_dmsbio', MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio)
1323	PRINT *, 'lmt_h2sbio', MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio)
1324	PRINT *, 'lmt_dmsconc', MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc)
1325	PRINT *, 'lmt_bcff', MINVAL(lmt_bcff), MAXVAL(lmt_bcff)
1326	PRINT *, 'lmt_bcnff', MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff)
1327	PRINT *, 'lmt_bcbb_l', MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l)
1328	PRINT *, 'lmt_bcbb_h', MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h)
1329	PRINT *, 'lmt_bcba', MINVAL(lmt_bcba), MAXVAL(lmt_bcba)
1330	PRINT *, 'lmt_omff', MINVAL(lmt_omff), MAXVAL(lmt_omff)
1331	PRINT *, 'lmt_omnff', MINVAL(lmt_omnff), MAXVAL(lmt_omnff)
1332	PRINT *, 'lmt_ombb_l', MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l)
1333	PRINT *, 'lmt_ombb_h', MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h)
1334	PRINT *, 'lmt_omnat', MINVAL(lmt_omnat), MAXVAL(lmt_omnat)
1335	PRINT *, 'lmt_omba', MINVAL(lmt_omba), MAXVAL(lmt_omba)
1336	PRINT *, 'JE iflag_con', iflag_conv
1337
1338
1339	!JE_dbg
1340	DO i = 1, klon
1341	tsol(i) = 0.0
1342	DO j = 1, nbsrf
1343	tsol(i) = tsol(i) + ftsol(i, j) * pctsrf(i, j)
1344	enddo
1345	enddo
1346
1347
1348	!======================================================================
1349	! INITIALISATIONS
1350	!======================================================================
1351	! CALL checknanqfi(da(:,:),1.,-1.,' da_ before
1352	! . phytracr_inphytracr')
1353
1354	! computing time
1355	! logitime=.TRUE.
1356	logitime = .FALSE.
1357	IF (logitime) THEN
1358	clock_start = 0
1359	clock_end = 0
1360	clock_rate = 0
1361	CALL SYSTEM_CLOCK(COUNT_RATE = clock_rate, COUNT_MAX = clock_per_max)
1362	CALL SYSTEM_CLOCK(COUNT = clock_start_spla)
1363	clock_start = clock_start_spla
1364	clock_end_outphytracr = clock_start_spla
1365	ENDIF
1366
1367
1368	! Definition of tracers index.
1369	PRINT*, 'OK ON PASSSE BIEN LA'
1370	CALL minmaxsource(source_tr, qmin, qmax, 'A1 maxsource init phytracr')
1371
1372	IF (debutphy) THEN
1373	id_prec = -1
1374	id_fine = -1
1375	id_coss = -1
1376	id_codu = -1
1377	id_scdu = -1
1378	itr = 0
1379	DO iq = 1, nqtot
1380	IF(.NOT.tracers(iq)%isInPhysics) CYCLE
1381	itr = itr + 1
1382	PRINT *, itr, TRIM(tracers(iq)%name)
1383	SELECT CASE(tracers(iq)%name)
1384	CASE('PREC'); id_prec = itr
1385	CASE('FINE'); id_fine = itr
1386	CASE('COSS'); id_coss = itr
1387	CASE('CODU'); id_codu = itr
1388	CASE('SCDU'); id_scdu = itr
1389	END SELECT
1390	enddo
1391	! check consistency with dust emission scheme:
1392	IF (ok_chimeredust) THEN
1393	IF (.NOT.(id_scdu>0 .AND. id_codu>0 .AND. id_fine>0)) THEN
1394	CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 0', 1)
1395	endif
1396	else
1397	IF (id_scdu>0) THEN
1398	CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU', 1)
1399	endif
1400	IF ((id_codu <= 0) .OR. (id_fine<=0)) THEN
1401	CALL abort_gcm('phytracr_mod', 'pb in ok_chimdust 1', 1)
1402	endif
1403	endif
1404
1405
1406	!PRINT *,id_prec,id_fine,id_coss,id_codu,id_scdu
1407	ENDIF
1408
1409
1410
1411
1412
1413
1414	!---fraction of tracer that is convected (Tiedke)
1415	xconv(:) = 0.
1416	IF(id_prec>0) xconv(id_prec) = 0.8
1417	IF(id_fine>0) xconv(id_fine) = 0.5
1418	IF(id_coss>0) xconv(id_coss) = 0.5
1419	IF(id_codu>0) xconv(id_codu) = 0.6
1420	IF(id_scdu>0) xconv(id_scdu) = 0.6 !!JE fix
1421
1422	masse(:) = 1.
1423	IF(id_prec>0) masse(id_prec) = 32.
1424	IF(id_fine>0) masse(id_fine) = 6.02e23
1425	IF(id_coss>0) masse(id_coss) = 6.02e23
1426	IF(id_codu>0) masse(id_codu) = 6.02e23
1427	IF(id_scdu>0) masse(id_scdu) = 6.02e23
1428
1429	henry(:) = 0.
1430	IF(id_prec>0) henry(id_prec) = 1.4
1431	IF(id_fine>0) henry(id_fine) = 0.0
1432	IF(id_coss>0) henry(id_coss) = 0.0
1433	IF(id_codu>0) henry(id_codu) = 0.0
1434	IF(id_scdu>0) henry(id_scdu) = 0.0
1435	!henry= (/1.4, 0.0, 0.0, 0.0/)
1436	kk(:) = 0.
1437	IF(id_prec>0) kk(id_prec) = 2900.
1438	IF(id_fine>0) kk(id_fine) = 0.0
1439	IF(id_coss>0) kk(id_coss) = 0.0
1440	IF(id_codu>0) kk(id_codu) = 0.0
1441	IF(id_scdu>0) kk(id_scdu) = 0.0
1442	!kk = (/2900., 0., 0., 0./)
1443	alpha_r(:) = 0.
1444	IF(id_prec>0) alpha_r(id_prec) = 0.0
1445	IF(id_fine>0) alpha_r(id_fine) = 0.001
1446	IF(id_coss>0) alpha_r(id_coss) = 0.001
1447	IF(id_codu>0) alpha_r(id_codu) = 0.001
1448	IF(id_scdu>0) alpha_r(id_scdu) = 0.001 !JE fix
1449	alpha_s(:) = 0.
1450	IF(id_prec>0) alpha_s(id_prec) = 0.0
1451	IF(id_fine>0) alpha_s(id_fine) = 0.01
1452	IF(id_coss>0) alpha_s(id_coss) = 0.01
1453	IF(id_codu>0) alpha_s(id_codu) = 0.01
1454	IF(id_scdu>0) alpha_s(id_scdu) = 0.01 !JE fix
1455
1456	! alpha_r = (/0., 0.001, 0.001, 0.001/)
1457	! alpha_s = (/0., 0.01, 0.01, 0.01/)
1458
1459	! nhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
1460	! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
1461	!vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
1462	vdep_oce(:) = 0.
1463	IF(id_prec>0) vdep_oce(id_prec) = 0.28
1464	IF(id_fine>0) vdep_oce(id_fine) = 0.28
1465	IF(id_coss>0) vdep_oce(id_coss) = 1.2
1466	IF(id_codu>0) vdep_oce(id_codu) = 1.2
1467	IF(id_scdu>0) vdep_oce(id_scdu) = 1.2
1468	vdep_sic(:) = 0.
1469	IF(id_prec>0) vdep_sic(id_prec) = 0.2
1470	IF(id_fine>0) vdep_sic(id_fine) = 0.17
1471	IF(id_coss>0) vdep_sic(id_coss) = 1.2
1472	IF(id_codu>0) vdep_sic(id_codu) = 1.2
1473	IF(id_scdu>0) vdep_sic(id_scdu) = 1.2
1474
1475	!vdep_sic = (/0.2, 0.17, 1.2, 1.2/)
1476	!vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
1477	vdep_ter(:) = 0.
1478	IF(id_prec>0) vdep_ter(id_prec) = 0.3
1479	IF(id_fine>0) vdep_ter(id_fine) = 0.14
1480	IF(id_coss>0) vdep_ter(id_coss) = 1.2
1481	IF(id_codu>0) vdep_ter(id_codu) = 1.2
1482	IF(id_scdu>0) vdep_ter(id_scdu) = 1.2
1483
1484	vdep_lic(:) = 0.
1485	IF(id_prec>0) vdep_lic(id_prec) = 0.2
1486	IF(id_fine>0) vdep_lic(id_fine) = 0.17
1487	IF(id_coss>0) vdep_lic(id_coss) = 1.2
1488	IF(id_codu>0) vdep_lic(id_codu) = 1.2
1489	IF(id_scdu>0) vdep_lic(id_scdu) = 1.2
1490
1491
1492	! convective KE lessivage aer params:
1493	! AS: #DFB (Binta) a aussi teste ccntrAA_spla=ccntrENV_spla=0.9/1.0/0.9/0.9
1494	! mais effet negligeable sur l'AOD
1495	ccntrAA_spla(:) = 0.
1496	IF(id_prec>0) ccntrAA_spla(id_prec) = -9999.
1497	IF(id_fine>0) ccntrAA_spla(id_fine) = 0.7
1498	IF(id_coss>0) ccntrAA_spla(id_coss) = 1.0
1499	IF(id_codu>0) ccntrAA_spla(id_codu) = 0.7
1500	IF(id_scdu>0) ccntrAA_spla(id_scdu) = 0.7
1501
1502	ccntrENV_spla(:) = 0.
1503	IF(id_prec>0) ccntrENV_spla(id_prec) = -9999.
1504	IF(id_fine>0) ccntrENV_spla(id_fine) = 0.7
1505	IF(id_coss>0) ccntrENV_spla(id_coss) = 1.0
1506	IF(id_codu>0) ccntrENV_spla(id_codu) = 0.7
1507	IF(id_scdu>0) ccntrENV_spla(id_scdu) = 0.7
1508	! #DFB
1509	coefcoli_spla(:) = 0.
1510	IF(id_prec>0) coefcoli_spla(id_prec) = -9999.
1511	IF(id_fine>0) coefcoli_spla(id_fine) = 0.001
1512	IF(id_coss>0) coefcoli_spla(id_coss) = 0.001
1513	IF(id_codu>0) coefcoli_spla(id_codu) = 0.001
1514	IF(id_scdu>0) coefcoli_spla(id_scdu) = 0.001
1515
1516	!vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
1517
1518	iscm3 = .FALSE.
1519	IF (debutphy) THEN
1520	!$OMP MASTER
1521	CALL suphel
1522	PRINT *, 'let s check nbtr=', nbtr
1523	! JE before put in zero
1524	IF (lminmax) THEN
1525	DO itr = 1, nbtr
1526	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan init phytracr')
1527	ENDDO
1528	DO itr = 1, nbtr
1529	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'minmax init phytracr')
1530	ENDDO
1531	CALL minmaxsource(source_tr, qmin, qmax, 'maxsource init phytracr')
1532	ENDIF
1533	! JE initializon to cero the tracers
1534	! DO itr=1,nbtr
1535	! tr_seri(:,:,itr)=0.0
1536	! ENDDO
1537	! JE end
1538	! Initializing to zero tr_seri for comparison purposes
1539	! tr_seri(:,:,:)=0.0
1540
1541	! DO itr=1,nbtr
1542	! trm_aux(itr)=0.0
1543	! src_aux(itr)=0.0
1544	! diag_trm(itr)=0.0
1545	! diag_drydep(itr)=0.0
1546	! diag_wetdep(itr)=0.0
1547	! diag_cvtdep(itr)=0.0
1548	! diag_emissn(itr)=0.0
1549	! ENDDO
1550	! diag_g2part=0.0
1551	PRINT *, 'PREPARE FILES TO SAVE VARIABLES'
1552
1553	nbjour = 30
1554	ecrit_tra = NINT(86400. / pdtphys) !--1-day average
1555	ecrit_tra_h = NINT(86400. / pdtphys * 0.25) !--6-hour average
1556	ecrit_tra_m = NINT(86400. / pdtphys * FLOAT(nbjour)) !--1-mth average
1557	PRINT *, 'ecrit_tra=', pdtphys, ecrit_tra
1558
1559	!!AS deleting lines
1560	!! IF (ok_histrac) THEN
1561	!! IF (is_mpi_root .AND. is_omp_root) THEN
1562	!!-----many deleted lines----
1563	!!! nbjour=1
1564	!! ENDIF ! mpi root
1565	!! ENDIF !--ok_histrac
1566
1567	!$OMP END MASTER
1568	!$OMP BARRIER
1569	endif ! debutphy
1570
1571	!======================================================================
1572	! Initialisations
1573	!======================================================================
1574
1575
1576	! je KE init
1577	IF (debutphy) THEN
1578	!$OMP MASTER
1579
1580	ALLOCATE(d_tr_dry(klon, nbtr))
1581	ALLOCATE(flux_tr_dry(klon, nbtr), d_tr_dec(klon, klev, nbtr))
1582	ALLOCATE(qPrls(klon, nbtr), qPr(klon, klev, nbtr))
1583	ALLOCATE(qDi(klon, klev, nbtr))
1584	ALLOCATE(qPa(klon, klev, nbtr), qMel(klon, klev, nbtr))
1585	ALLOCATE(qTrdi(klon, klev, nbtr), dtrcvMA(klon, klev, nbtr))
1586
1587	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1588	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1589	ALLOCATE(d_tr_cv_o(klon, klev, nbtr))
1590	ALLOCATE(d_tr_trsp_o(klon, klev, nbtr))
1591	ALLOCATE(d_tr_sscav_o(klon, klev, nbtr), &
1592	d_tr_sat_o(klon, klev, nbtr))
1593	ALLOCATE(d_tr_uscav_o(klon, klev, nbtr))
1594
1595	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1596	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1597	ALLOCATE(d_tr_insc_o(klon, klev, nbtr))
1598	ALLOCATE(d_tr_bcscav_o(klon, klev, nbtr))
1599	ALLOCATE(d_tr_evapls_o(klon, klev, nbtr))
1600	ALLOCATE(d_tr_ls_o(klon, klev, nbtr))
1601	ALLOCATE(d_tr_dyn_o(klon, klev, nbtr))
1602	ALLOCATE(d_tr_cl_o(klon, klev, nbtr))
1603	ALLOCATE(d_tr_th_o(klon, klev, nbtr))
1604	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1605	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1606	ALLOCATE(iregion_so4(klon))
1607	ALLOCATE(iregion_bb(klon))
1608	ALLOCATE(iregion_ind(klon))
1609	ALLOCATE(iregion_dust(klon))
1610	ALLOCATE(iregion_wstardust(klon))
1611
1612	!JE20150518<<
1613	ALLOCATE(masque_aqua(klon))
1614	ALLOCATE(masque_terra(klon))
1615
1616	masque_aqua(:) = 0
1617	masque_terra(:) = 0
1618
1619	aod550_terra(:) = 0.
1620	aod550_tr2_terra(:) = 0.
1621	aod550_ss_terra(:) = 0.
1622	aod550_dust_terra(:) = 0.
1623	aod550_dustsco_terra(:) = 0.
1624	aod670_terra(:) = 0.
1625	aod670_tr2_terra(:) = 0.
1626	aod670_ss_terra(:) = 0.
1627	aod670_dust_terra(:) = 0.
1628	aod670_dustsco_terra(:) = 0.
1629	aod865_terra(:) = 0.
1630	aod865_tr2_terra(:) = 0.
1631	aod865_ss_terra(:) = 0.
1632	aod865_dust_terra(:) = 0.
1633	aod865_dustsco_terra(:) = 0.
1634	aod550_aqua(:) = 0.
1635	aod550_tr2_aqua(:) = 0.
1636	aod550_ss_aqua(:) = 0.
1637	aod550_dust_aqua(:) = 0.
1638	aod550_dustsco_aqua(:) = 0.
1639	aod670_aqua(:) = 0.
1640	aod670_tr2_aqua(:) = 0.
1641	aod670_ss_aqua(:) = 0.
1642	aod670_dust_aqua(:) = 0.
1643	aod670_dustsco_aqua(:) = 0.
1644	aod865_aqua(:) = 0.
1645	aod865_tr2_aqua(:) = 0.
1646	aod865_ss_aqua(:) = 0.
1647	aod865_dust_aqua(:) = 0.
1648	aod865_dustsco_aqua(:) = 0.
1649	!JE20150518>>
1650
1651	!Config Key = iflag_lscav
1652	!Config Desc = Large scale scavenging parametrization: 0=none,
1653	!1=old(Genthon92),
1654	! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
1655	!Config Def = 4
1656	!Config
1657	iflag_lscav_omp = 4
1658	CALL getin('iflag_lscav', iflag_lscav_omp)
1659	iflag_lscav = iflag_lscav_omp
1660	! initialiation for time computation
1661
1662	tia_spla = 0.
1663	tia_emis = 0.
1664	tia_depo = 0.
1665	tia_cltr = 0.
1666	tia_ther = 0.
1667	tia_sedi = 0.
1668	tia_gasp = 0.
1669	tia_wetap = 0.
1670	tia_cvltr = 0.
1671	tia_lscs = 0.
1672	tia_brop = 0.
1673	tia_outs = 0.
1674	tia_nophytracr = 0.
1675	clock_start_outphytracr = clock_end_outphytracr + 1
1676	!$OMP END MASTER
1677	!$OMP BARRIER
1678	ENDIF ! debutphy
1679
1680	lmt_dms(:) = 0.0
1681	aux_var2(:) = 0.0
1682	aux_var3(:, :) = 0.0
1683	source_tr(:, :) = 0.0
1684	flux_tr(:, :) = 0.0
1685	flux_sparam_bb(:) = 0.0
1686	flux_sparam_ff(:) = 0.0
1687	flux_sparam_ind(:) = 0.0
1688	flux_sparam_ddfine(:) = 0.0
1689	flux_sparam_ddcoa(:) = 0.0
1690	flux_sparam_ddsco(:) = 0.0
1691	flux_sparam_ssfine(:) = 0.0
1692	flux_sparam_sscoa(:) = 0.0
1693
1694	! initialiation for time computation
1695
1696	ti_spla = 0
1697	ti_emis = 0
1698	ti_depo = 0
1699	ti_cltr = 0
1700	ti_ther = 0
1701	ti_sedi = 0
1702	ti_gasp = 0
1703	ti_wetap = 0
1704	ti_cvltr = 0
1705	ti_lscs = 0
1706	ti_brop = 0
1707	ti_outs = 0
1708
1709	DO k = 1, klev
1710	DO i = 1, klon
1711	Mint(i, k) = 0.
1712	END DO
1713	END DO
1714
1715	DO itr = 1, nbtr
1716	DO k = 1, klev
1717	DO i = 1, klon
1718	d_tr_cv(i, k, itr) = 0.
1719	d_tr_trsp(i, k, itr) = 0.
1720	d_tr_sscav(i, k, itr) = 0.
1721	d_tr_sat(i, k, itr) = 0.
1722	d_tr_uscav(i, k, itr) = 0.
1723	d_tr(i, k, itr) = 0.
1724	d_tr_insc(i, k, itr) = 0.
1725	d_tr_bcscav(i, k, itr) = 0.
1726	d_tr_evapls(i, k, itr) = 0.
1727	d_tr_ls(i, k, itr) = 0.
1728	d_tr_cl(i, k, itr) = 0.
1729	d_tr_th(i, k, itr) = 0.
1730
1731	d_tr_cv_o(i, k, itr) = 0.
1732	d_tr_trsp_o(i, k, itr) = 0.
1733	d_tr_sscav_o(i, k, itr) = 0.
1734	d_tr_sat_o(i, k, itr) = 0.
1735	d_tr_uscav_o(i, k, itr) = 0.
1736
1737	qDi(i, k, itr) = 0.
1738	qPr(i, k, itr) = 0.
1739	qPa(i, k, itr) = 0.
1740	qMel(i, k, itr) = 0.
1741	qTrdi(i, k, itr) = 0.
1742	dtrcvMA(i, k, itr) = 0.
1743	zmfd1a(i, k, itr) = 0.
1744	zmfdam(i, k, itr) = 0.
1745	zmfphi2(i, k, itr) = 0.
1746	END DO
1747	END DO
1748	END DO
1749
1750	DO itr = 1, nbtr
1751	DO i = 1, klon
1752	qPrls(i, itr) = 0.0
1753	dtrconv(i, itr) = 0.0
1754	!JE20140507<<
1755	d_tr_dry(i, itr) = 0.0
1756	flux_tr_dry(i, itr) = 0.0
1757	!JE20140507>>
1758	ENDDO
1759	ENDDO
1760
1761	DO itr = 1, nbtr
1762	DO i = 1, klon
1763	his_dh(i, itr) = 0.0
1764	his_dhlsc(i, itr) = 0.0
1765	his_dhcon(i, itr) = 0.0
1766	his_dhbclsc(i, itr) = 0.0
1767	his_dhbccon(i, itr) = 0.0
1768	trm(i, itr) = 0.0
1769	his_th(i, itr) = 0.0
1770	his_dhkecv(i, itr) = 0.0
1771	his_ds(i, itr) = 0.0
1772	his_dhkelsc(i, itr) = 0.0
1773
1774	ENDDO
1775	ENDDO
1776	!JE:
1777	DO i = 1, klon
1778	his_g2pgas(i) = 0.0
1779	his_g2paer(i) = 0.0
1780	ENDDO
1781	! endJE
1782
1783	DO k = 1, klev
1784	DO i = 1, klon
1785	zrho(i, k) = pplay(i, k) / t_seri(i, k) / RD
1786	zdz(i, k) = (paprs(i, k) - paprs(i, k + 1)) / zrho(i, k) / RG
1787	zmasse(i, k) = (paprs(i, k) - paprs(i, k + 1)) / RG
1788	ENDDO
1789	ENDDO
1790
1791	DO i = 1, klon
1792	zalt(i, 1) = pphis(i) / RG
1793	ENDDO
1794	DO k = 1, klev - 1
1795	DO i = 1, klon
1796	zalt(i, k + 1) = zalt(i, k) + zdz(i, k)
1797	ENDDO
1798	ENDDO
1799
1800	IF (logitime) THEN
1801	CALL SYSTEM_CLOCK(COUNT = clock_end)
1802	dife = clock_end - clock_start
1803	ti_init = dife * MAX(0, SIGN(1, dife)) &
1804	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
1805	tia_init = tia_init + REAL(ti_init) / REAL(clock_rate)
1806	ENDIF
1807	IF (logitime) THEN
1808	CALL SYSTEM_CLOCK(COUNT = clock_start)
1809	ENDIF
1810
1811	IF (debutphy) THEN
1812	! AS: initialisation des indices par point de grille physique iregion_*
1813	! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
1814	iregion_dust(:) = 1
1815	iregion_ind(:) = 1
1816	iregion_bb(:) = 1
1817	iregion_wstardust(:) = 1
1818
1819	!AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
1820	IF("ASSIM"=="YES") THEN
1821	c_FullName1 = 'regions_dustacc'
1822	!c_FullName1='regions_dust'
1823	CALL readregions_spl(iregion_dust, c_FullName1)
1824	c_FullName1 = 'regions_ind'
1825	CALL readregions_spl(iregion_ind, c_FullName1)
1826	c_FullName1 = 'regions_bb'
1827	CALL readregions_spl(iregion_bb, c_FullName1)
1828	c_FullName1 = 'regions_pwstarwake'
1829	CALL readregions_spl(iregion_wstardust, c_FullName1)
1830
1831	!$OMP MASTER
1832	IF (is_mpi_root .AND. is_omp_root) THEN
1833
1834	OPEN(25, FILE = 'dustregions_pyvar_je.data')
1835	OPEN(55, FILE = 'indregions_pyvar_je.data')
1836	OPEN(75, FILE = 'bbregions_pyvar_je.data')
1837	OPEN(95, FILE = 'wstardustregions_pyvar_je.data')
1838	OPEN(76, FILE = 'xlat.data')
1839	OPEN(77, FILE = 'xlon.data')
1840	ENDIF ! mpi root
1841	!$OMP END MASTER
1842	!$OMP BARRIER
1843
1844	CALL gather(iregion_dust, iauxklon_glo)
1845	!$OMP MASTER
1846	IF (is_mpi_root .AND. is_omp_root) THEN
1847	DO k = 1, klon_glo
1848	WRITE(25, '(i10)') iauxklon_glo(k)
1849	ENDDO
1850	ENDIF ! mpi root
1851	!$OMP END MASTER
1852	!$OMP BARRIER
1853	CALL gather(iregion_ind, iauxklon_glo)
1854	!$OMP MASTER
1855	IF (is_mpi_root .AND. is_omp_root) THEN
1856	DO k = 1, klon_glo
1857	WRITE(55, '(i10)') iauxklon_glo(k)
1858	ENDDO
1859	ENDIF ! mpi root
1860	!$OMP END MASTER
1861	!$OMP BARRIER
1862	CALL gather(iregion_bb, iauxklon_glo)
1863	!$OMP MASTER
1864	IF (is_mpi_root .AND. is_omp_root) THEN
1865	DO k = 1, klon_glo
1866	WRITE(75, '(i10)') iauxklon_glo(k)
1867	ENDDO
1868	ENDIF ! mpi root
1869	!$OMP END MASTER
1870	!$OMP BARRIER
1871	CALL gather(iregion_wstardust, iauxklon_glo)
1872	!$OMP MASTER
1873	IF (is_mpi_root .AND. is_omp_root) THEN
1874	DO k = 1, klon_glo
1875	WRITE(95, '(i10)') iauxklon_glo(k)
1876	ENDDO
1877	ENDIF ! mpi root
1878	!$OMP END MASTER
1879	!$OMP BARRIER
1880
1881	CALL gather(rlat, auxklon_glo)
1882	!$OMP MASTER
1883	IF (is_mpi_root .AND. is_omp_root) THEN
1884	DO k = 1, klon_glo
1885	WRITE(76, *) auxklon_glo(k)
1886	ENDDO
1887	ENDIF ! mpi root
1888	!$OMP END MASTER
1889	!$OMP BARRIER
1890	CALL gather(rlon, auxklon_glo)
1891	!$OMP MASTER
1892	IF (is_mpi_root .AND. is_omp_root) THEN
1893	DO k = 1, klon_glo
1894	WRITE(77, *) auxklon_glo(k)
1895	ENDDO
1896
1897	CLOSE(25)
1898	CLOSE(55)
1899	CLOSE(75)
1900	CLOSE(76)
1901	CLOSE(77)
1902	CLOSE(95)
1903
1904	ENDIF ! mpi root
1905	!$OMP END MASTER
1906	!$OMP BARRIER
1907
1908	ENDIF ! ASSIM
1909
1910	ENDIF ! debutphy
1911
1912	IF (logitime) THEN
1913	CALL SYSTEM_CLOCK(COUNT = clock_end)
1914	dife = clock_end - clock_start
1915	ti_inittype = dife * MAX(0, SIGN(1, dife)) &
1916	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
1917	tia_inittype = tia_inittype + REAL(ti_inittype) / REAL(clock_rate)
1918	ENDIF
1919
1920	IF (logitime) THEN
1921	CALL SYSTEM_CLOCK(COUNT = clock_start)
1922	ENDIF
1923
1924	!=======================================================================
1925	! SAVING SURFACE TYPE
1926	!=======================================================================
1927	IF (debutphy) THEN
1928	!$OMP MASTER
1929	IF (is_mpi_root .AND. is_omp_root) THEN
1930
1931	OPEN(35, FILE = 'surface_ocean.data')
1932	OPEN(45, FILE = 'surface_seaice.data')
1933	OPEN(65, FILE = 'surface_land.data')
1934	OPEN(85, FILE = 'surface_landice.data')
1935	ENDIF ! mpi root
1936	!$OMP END MASTER
1937	!$OMP BARRIER
1938	DO i = 1, klon
1939	aux_var2(i) = pctsrf(i, is_oce)
1940	enddo
1941	CALL gather(aux_var2, auxklon_glo)
1942	!$OMP MASTER
1943	IF (is_mpi_root .AND. is_omp_root) THEN
1944	DO i = 1, klon_glo
1945	WRITE (35, 103) auxklon_glo(i)
1946	ENDDO
1947	ENDIF ! mpi root
1948	!$OMP END MASTER
1949	!$OMP BARRIER
1950
1951	DO i = 1, klon
1952	aux_var2(i) = pctsrf(i, is_sic)
1953	enddo
1954	CALL gather(aux_var2, auxklon_glo)
1955	!$OMP MASTER
1956	IF (is_mpi_root .AND. is_omp_root) THEN
1957	DO i = 1, klon_glo
1958	WRITE (45, 103) auxklon_glo(i)
1959	ENDDO
1960	ENDIF ! mpi root
1961	!$OMP END MASTER
1962	!$OMP BARRIER
1963
1964	DO i = 1, klon
1965	aux_var2(i) = pctsrf(i, is_ter)
1966	enddo
1967	CALL gather(aux_var2, auxklon_glo)
1968	!$OMP MASTER
1969	IF (is_mpi_root .AND. is_omp_root) THEN
1970	DO i = 1, klon_glo
1971	WRITE (65, 103) auxklon_glo(i)
1972	ENDDO
1973	ENDIF ! mpi root
1974	!$OMP END MASTER
1975	!$OMP BARRIER
1976
1977	DO i = 1, klon
1978	aux_var2(i) = pctsrf(i, is_lic)
1979	enddo
1980	CALL gather(aux_var2, auxklon_glo)
1981	!$OMP MASTER
1982	IF (is_mpi_root .AND. is_omp_root) THEN
1983	DO i = 1, klon_glo
1984	WRITE (85, 103) auxklon_glo(i)
1985	ENDDO
1986
1987	! DO i = 1, klon
1988	! WRITE (35,103) pctsrf(i,is_oce)
1989	! WRITE (45,103) pctsrf(i,is_sic)
1990	! WRITE (65,103) pctsrf(i,is_ter)
1991	! WRITE (85,103) pctsrf(i,is_lic)
1992	! ENDDO
1993	CLOSE(35)
1994	CLOSE(45)
1995	CLOSE(65)
1996	CLOSE(85)
1997	103 FORMAT (f6.2)
1998	ENDIF ! mpi root
1999	!$OMP END MASTER
2000	!$OMP BARRIER
2001	ENDIF ! debutphy
2002
2003	! stop
2004
2005	!=======================================================================
2006
2007	DO itr = 1, nbtr
2008	DO j = 1, klev
2009	DO i = 1, klon
2010	tmp_var(i, j) = tr_seri(i, j, itr)
2011	ENDDO
2012	ENDDO
2013	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2014	DO j = 1, klev
2015	DO i = 1, klon
2016	tr_seri(i, j, itr) = tmp_var(i, j)
2017	ENDDO
2018	ENDDO
2019	ENDDO
2020	iscm3 = .TRUE.
2021
2022	!=======================================================================
2023
2024	DO k = 1, klev
2025	DO i = 1, klon
2026	m_conc(i, k) = pplay(i, k) / t_seri(i, k) / RKBOL * 1.e-6
2027	ENDDO
2028	ENDDO
2029
2030	IF (lminmax) THEN
2031	DO itr = 1, nbtr
2032	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_avt_coarem')
2033	ENDDO
2034	DO itr = 1, nbtr
2035	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'avt coarem')
2036	ENDDO
2037	CALL minmaxsource(source_tr, qmin, qmax, 'src: avt coarem')
2038	ENDIF
2039
2040	IF (logitime) THEN
2041	CALL SYSTEM_CLOCK(COUNT = clock_end)
2042	dife = clock_end - clock_start
2043	ti_inittwrite = dife * MAX(0, SIGN(1, dife)) &
2044	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2045	tia_inittwrite = tia_inittwrite + REAL(ti_inittwrite) / REAL(clock_rate)
2046	ENDIF
2047
2048
2049	!=======================================================================
2050	! EMISSIONS OF COARSE AEROSOLS
2051	!=======================================================================
2052
2053	IF (logitime) THEN
2054	CALL SYSTEM_CLOCK(COUNT = clock_start)
2055	ENDIF
2056
2057	PRINT *, 'Number of tracers = ', nbtr
2058
2059	PRINT *, 'AT BEGINNING OF PHYTRACR_SPL'
2060	! PRINT *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
2061	! . MAXVAL(tr_seri(:,:,3))
2062	#ifdef IOPHYS_DUST
2063	DO itr=1,nbtr
2064	WRITE(str2,'(i2.2)') itr
2065	CALL iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,itr))
2066	CALL iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,itr))
2067	enddo
2068	DO itr=1,nbtr
2069	WRITE(str2,'(i2.2)') itr
2070	CALL iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2071	enddo
2072	#endif
2073
2074
2075	CALL coarsemission(pctsrf, pdtphys, t_seri, &
2076	pmflxr, pmflxs, prfl, psfl, &
2077	rlat, rlon, debutphy, &
2078	zu10m, zv10m, wstar, ale_bl, ale_wake, &
2079	scale_param_ssacc, scale_param_sscoa, &
2080	scale_param_dustacc, scale_param_dustcoa, &
2081	scale_param_dustsco, &
2082	nbreg_dust, &
2083	iregion_dust, dust_ec, &
2084	param_wstarBLperregion, param_wstarWAKEperregion, &
2085	nbreg_wstardust, &
2086	iregion_wstardust, &
2087	lmt_sea_salt, qmin, qmax, &
2088	flux_sparam_ddfine, flux_sparam_ddcoa, &
2089	flux_sparam_ddsco, &
2090	flux_sparam_ssfine, flux_sparam_sscoa, &
2091	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2092	ok_chimeredust, &
2093	source_tr, flux_tr)
2094
2095	#ifdef IOPHYS_DUST
2096	DO itr=1,nbtr
2097	WRITE(str2,'(i2.2)') itr
2098	CALL iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,itr))
2099	CALL iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,itr))
2100	enddo
2101	#endif
2102
2103	IF (lminmax) THEN
2104	DO itr = 1, nbtr
2105	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_coarem')
2106	ENDDO
2107	DO itr = 1, nbtr
2108	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after coarem')
2109	ENDDO
2110	CALL minmaxsource(source_tr, qmin, qmax, 'src: after coarem')
2111	ENDIF
2112
2113
2114
2115	!======================================================================
2116	! EMISSIONS OF AEROSOL PRECURSORS
2117	!======================================================================
2118
2119	#ifdef IOPHYS_DUST
2120	PRINT *,'INPUT TO PRECUREMISSION'
2121	CALL iophys_ecrit('ftsol',4,'ftsol','',ftsol)
2122	CALL iophys_ecrit('u10m_ec',1,'u10m_ec','',u10m_ec)
2123	CALL iophys_ecrit('v10m_ec',1,'v10m_ec','',v10m_ec)
2124	CALL iophys_ecrit('pctsrf',4,'pctsrf','',pctsrf)
2125	CALL iophys_ecrit('u_seri',klev,'u_seri','',u_seri)
2126	CALL iophys_ecrit('v_seri',klev,'v_seri','',v_seri)
2127	CALL iophys_ecrit('paprs',klev,'paprs','',paprs)
2128	CALL iophys_ecrit('pplay',klev,'pplay','',pplay)
2129	CALL iophys_ecrit('cdragh',1,'cdragh','',cdragh)
2130	CALL iophys_ecrit('cdragm',1,'cdragm','',cdragm)
2131	CALL iophys_ecrit('t_seri',klev,'t_seri','',t_seri)
2132	CALL iophys_ecrit('q_seri',klev,'q_seri','',q_seri)
2133	CALL iophys_ecrit('tsol',1,'tsol','',tsol)
2134	PRINT*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau
2135	PRINT*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys
2136	PRINT*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind
2137	PRINT*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb
2138	PRINT*,'id_prec,id_fine',id_prec,id_fine
2139	CALL iophys_ecrit('zdz',klev,'zdz','',zdz)
2140	CALL iophys_ecrit('zalt',klev,'zalt','',zalt)
2141	CALL iophys_ecrit('lmt_so2ff_l',1,'lmt_so2ff_l','',lmt_so2ff_l)
2142	CALL iophys_ecrit('lmt_so2ff_h',1,'lmt_so2ff_h','',lmt_so2ff_h)
2143	CALL iophys_ecrit('lmt_so2nff',1,'lmt_so2nff','',lmt_so2nff)
2144	CALL iophys_ecrit('lmt_so2ba',1,'lmt_so2ba','',lmt_so2ba)
2145	CALL iophys_ecrit('lmt_so2bb_l',1,'lmt_so2bb_l','',lmt_so2bb_l)
2146	CALL iophys_ecrit('lmt_so2bb_h',1,'lmt_so2bb_h','',lmt_so2bb_h)
2147	CALL iophys_ecrit('lmt_so2volc_cont',1,'lmt_so2volc_cont','',lmt_so2volc_cont)
2148	CALL iophys_ecrit('lmt_altvolc_cont',1,'lmt_altvolc_cont','',lmt_altvolc_cont)
2149	CALL iophys_ecrit('lmt_so2volc_expl',1,'lmt_so2volc_expl','',lmt_so2volc_expl)
2150	CALL iophys_ecrit('lmt_altvolc_expl',1,'lmt_altvolc_expl','',lmt_altvolc_expl)
2151	CALL iophys_ecrit('lmt_dmsbio',1,'lmt_dmsbio','',lmt_dmsbio)
2152	CALL iophys_ecrit('lmt_h2sbio',1,'lmt_h2sbio','',lmt_h2sbio)
2153	CALL iophys_ecrit('lmt_dmsconc',1,'lmt_dmsconc','',lmt_dmsconc)
2154	CALL iophys_ecrit('lmt_dms',1,'lmt_dms','',lmt_dms)
2155	CALL iophys_ecrit('flux_sparam_ind',1,'flux_sparam_ind','',flux_sparam_ind)
2156	CALL iophys_ecrit('flux_sparam_bb',1,'flux_sparam_bb','',flux_sparam_bb)
2157	#endif
2158
2159
2160
2161	PRINT*, 'ON PASSE DANS precuremission'
2162	CALL precuremission(ftsol, u10m_ec, v10m_ec, pctsrf, &
2163	u_seri, v_seri, paprs, pplay, cdragh, cdragm, &
2164	t_seri, q_seri, tsol, fracso2emis, frach2sofso2, &
2165	bateau, zdz, zalt, kminbc, kmaxbc, pdtphys, &
2166	scale_param_bb, scale_param_ind, &
2167	iregion_ind, iregion_bb, &
2168	nbreg_ind, nbreg_bb, &
2169	lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, lmt_so2ba, &
2170	lmt_so2bb_l, lmt_so2bb_h, &
2171	lmt_so2volc_cont, lmt_altvolc_cont, &
2172	lmt_so2volc_expl, lmt_altvolc_expl, &
2173	lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, lmt_dms, &
2174	id_prec, id_fine, &
2175	flux_sparam_ind, flux_sparam_bb, &
2176	source_tr, flux_tr, tr_seri)
2177
2178	IF (lminmax) THEN
2179	DO itr = 1, nbtr
2180	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after precur')
2181	ENDDO
2182	DO itr = 1, nbtr
2183	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after precur')
2184	ENDDO
2185	CALL minmaxsource(source_tr, qmin, qmax, 'src: after precur')
2186	ENDIF
2187
2188	!=======================================================================
2189	! EMISSIONS OF FINE AEROSOLS
2190	!=======================================================================
2191	#ifdef IOPHYS_DUST
2192
2193	DO itr=1,nbtr
2194	WRITE(str2,'(i2.2)') itr
2195	CALL iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,itr))
2196	CALL iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,itr))
2197	enddo
2198	#endif
2199
2200	CALL finemission(zdz, pdtphys, zalt, kminbc, kmaxbc, &
2201	scale_param_bb, scale_param_ff, &
2202	iregion_ind, iregion_bb, &
2203	nbreg_ind, nbreg_bb, &
2204	lmt_bcff, lmt_bcnff, lmt_bcbb_l, lmt_bcbb_h, &
2205	lmt_bcba, lmt_omff, lmt_omnff, &
2206	lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, &
2207	id_fine, &
2208	flux_sparam_bb, flux_sparam_ff, &
2209	source_tr, flux_tr, tr_seri)
2210
2211	IF (lminmax) THEN
2212	DO itr = 1, nbtr
2213	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_fineem')
2214	ENDDO
2215	DO itr = 1, nbtr
2216	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after fineem')
2217	ENDDO
2218	IF (lcheckmass) THEN
2219	DO itr = 1, nbtr
2220	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2221	pplay, t_seri, iscm3, 'after fineem')
2222	ENDDO
2223	ENDIF
2224	CALL minmaxsource(source_tr, qmin, qmax, 'src: after fineem')
2225	ENDIF
2226
2227	IF (logitime) THEN
2228	CALL SYSTEM_CLOCK(COUNT = clock_end)
2229	dife = clock_end - clock_start
2230	ti_emis = dife * MAX(0, SIGN(1, dife)) &
2231	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2232	tia_emis = tia_emis + REAL(ti_emis) / REAL(clock_rate)
2233	ENDIF
2234
2235
2236	#ifdef IOPHYS_DUST
2237	DO itr=1,nbtr
2238	WRITE(str2,'(i2.2)') itr
2239	CALL iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,itr))
2240	CALL iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,itr))
2241	enddo
2242	#endif
2243
2244
2245	!=======================================================================
2246	! DRY DEPOSITION AND BOUNDARY LAYER MIXING
2247	!=======================================================================
2248
2249	! DO itr=1,nbtr
2250	! CALL checkmass(tr_seri(:,:,itr),RNAVO,masse(itr),zdz,
2251	! . pplay,t_seri,iscm3,'')
2252	! ENDDO
2253
2254	!======================================================================
2255	! -- Dry deposition --
2256	!======================================================================
2257	IF (logitime) THEN
2258	CALL SYSTEM_CLOCK(COUNT = clock_start)
2259	ENDIF
2260
2261	DO itr = 1, nbtr
2262	DO j = 1, klev
2263	DO i = 1, klon
2264	tmp_var(i, j) = tr_seri(i, j, itr)
2265	ENDDO
2266	ENDDO
2267	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2268	DO j = 1, klev
2269	DO i = 1, klon
2270	tr_seri(i, j, itr) = tmp_var(i, j)
2271	ENDDO
2272	ENDDO
2273	ENDDO
2274	iscm3 = .FALSE.
2275	!----------------------------
2276	IF (lminmax) THEN
2277	DO itr = 1, nbtr
2278	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_depo')
2279	ENDDO
2280	DO itr = 1, nbtr
2281	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before depo')
2282	ENDDO
2283	IF (lcheckmass) THEN
2284	DO itr = 1, nbtr
2285	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2286	pplay, t_seri, iscm3, 'before depo')
2287	ENDDO
2288	ENDIF
2289	CALL minmaxsource(source_tr, qmin, qmax, 'src: before depo')
2290	ENDIF
2291
2292	#ifdef IOPHYS_DUST
2293	DO itr=1,nbtr
2294	WRITE(str2,'(i2.2)') itr
2295	CALL iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2296	enddo
2297	#endif
2298
2299	CALL deposition(vdep_oce, vdep_sic, vdep_ter, vdep_lic, pctsrf, &
2300	zrho, zdz, pdtphys, RHcl, masse, t_seri, pplay, paprs, &
2301	lminmax, qmin, qmax, &
2302	his_ds, source_tr, tr_seri)
2303
2304	IF (lminmax) THEN
2305	DO itr = 1, nbtr
2306	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_depo')
2307	ENDDO
2308	DO itr = 1, nbtr
2309	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after depo')
2310	ENDDO
2311	IF (lcheckmass) THEN
2312	DO itr = 1, nbtr
2313	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2314	pplay, t_seri, iscm3, 'after depo')
2315	ENDDO
2316	ENDIF
2317	CALL minmaxsource(source_tr, qmin, qmax, 'src: after depo')
2318	ENDIF
2319
2320	IF (logitime) THEN
2321	CALL SYSTEM_CLOCK(COUNT = clock_end)
2322	dife = clock_end - clock_start
2323	ti_depo = dife * MAX(0, SIGN(1, dife)) &
2324	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2325	tia_depo = tia_depo + REAL(ti_depo) / REAL(clock_rate)
2326	ENDIF
2327
2328	!======================================================================
2329	! -- Boundary layer mixing --
2330	!======================================================================
2331
2332	#ifdef IOPHYS_DUST
2333	DO itr=1,nbtr
2334	WRITE(str2,'(i2.2)') itr
2335	CALL iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2336	enddo
2337	#endif
2338
2339
2340
2341	IF (logitime) THEN
2342	CALL SYSTEM_CLOCK(COUNT = clock_start)
2343	ENDIF
2344
2345	DO k = 1, klev
2346	DO i = 1, klon
2347	delp(i, k) = paprs(i, k) - paprs(i, k + 1)
2348	END DO
2349	END DO
2350
2351	DO itr = 1, nbtr
2352	DO j = 1, klev
2353	DO i = 1, klon
2354	tmp_var(i, j) = tr_seri(i, j, itr)
2355	aux_var2(i) = source_tr(i, itr)
2356	ENDDO
2357	ENDDO
2358	IF (iflag_conv==2) THEN
2359	! Tiedke
2360	CALL cltrac_spl(pdtphys, coefh, yu1, yv1, t_seri, tmp_var, &
2361	aux_var2, paprs, pplay, aux_var3)
2362
2363	ELSE IF (iflag_conv>=3) THEN
2364	!KE
2365	CALL cltrac(pdtphys, coefh, t_seri, tmp_var, aux_var2, paprs, pplay, &
2366	delp, aux_var3, d_tr_dry, flux_tr_dry(:, itr))
2367	ENDIF
2368
2369	DO i = 1, klon
2370	DO j = 1, klev
2371	tr_seri(i, j, itr) = tmp_var(i, j)
2372	d_tr(i, j, itr) = aux_var3(i, j)
2373	d_tr_cl(i, j, itr) = d_tr(i, j, itr)
2374	ENDDO
2375	ENDDO
2376	DO k = 1, klev
2377	DO i = 1, klon
2378	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr(i, k, itr)
2379	ENDDO
2380	ENDDO
2381	PRINT *, ' AFTER Cltrac'
2382	IF (lminmax) THEN
2383	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after cltrac')
2384	ENDIF
2385	ENDDO !--end itr loop
2386
2387	IF (logitime) THEN
2388	CALL SYSTEM_CLOCK(COUNT = clock_end)
2389	dife = clock_end - clock_start
2390	ti_cltr = dife * MAX(0, SIGN(1, dife)) &
2391	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2392	tia_cltr = tia_cltr + REAL(ti_cltr) / REAL(clock_rate)
2393	ENDIF
2394
2395
2396
2397	!======================================================================
2398	! -- Calcul de l'effet des thermiques for KE--
2399	!======================================================================
2400
2401	#ifdef IOPHYS_DUST
2402	PRINT*,'iflag_conv=',iflag_conv
2403	CALL iophys_ecrit('coefh',klev,'coefh','',coefh)
2404	CALL iophys_ecrit('yu1',1,'yu1','',yu1)
2405	CALL iophys_ecrit('yv1',1,'yv1','',yv1)
2406	CALL iophys_ecrit('delp',klev,'delp','',delp)
2407	DO itr=1,nbtr
2408	WRITE(str2,'(i2.2)') itr
2409	CALL iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2410	enddo
2411	#endif
2412
2413
2414
2415	IF (iflag_conv>=3) THEN
2416
2417	IF (logitime) THEN
2418	CALL SYSTEM_CLOCK(COUNT = clock_start)
2419	ENDIF
2420
2421	IF (lminmax) THEN
2422	DO itr = 1, nbtr
2423	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before therm')
2424	ENDDO
2425	DO itr = 1, nbtr
2426	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before therm')
2427	ENDDO
2428	IF (lcheckmass) THEN
2429	DO itr = 1, nbtr
2430	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2431	pplay, t_seri, iscm3, 'before therm')
2432	ENDDO
2433	ENDIF
2434	CALL minmaxsource(source_tr, qmin, qmax, 'before therm')
2435	ENDIF
2436
2437	DO itr = 1, nbtr
2438	DO k = 1, klev
2439	DO i = 1, klon
2440	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2441	d_tr_th(i, k, itr) = 0.
2442	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr), 0.)
2443	!JE: precursor >>1e10 tr_seri(i,k,itr)=MIN(tr_seri(i,k,itr),1.e10)
2444	END DO
2445	END DO
2446	END DO
2447
2448	!JE new implicit scheme 20140323
2449	DO itr = 1, nbtr
2450	CALL thermcell_dq(klon, klev, 1, pdtphys, fm_therm, entr_therm, &
2451	zmasse, tr_seri(1:klon, 1:klev, itr), &
2452	d_tr(1:klon, 1:klev, itr), ztra_th, 0)
2453
2454	DO k = 1, klev
2455	DO i = 1, klon
2456	d_tr(i, k, itr) = pdtphys * d_tr(i, k, itr)
2457	d_tr_th(i, k, itr) = d_tr_th(i, k, itr) + d_tr(i, k, itr)
2458	tr_seri(i, k, itr) = MAX(tr_seri(i, k, itr) + d_tr(i, k, itr), 0.)
2459	END DO
2460	END DO
2461
2462	ENDDO
2463
2464	! old scheme explicit
2465	! nsplit=10
2466	! DO itr=1,nbtr
2467	! DO isplit=1,nsplit
2468	! CALL dqthermcell(klon,klev,pdtphys/nsplit,
2469	! . fm_therm,entr_therm,zmasse,
2470	! . tr_seri(1:klon,1:klev,itr),
2471	! . d_tr(1:klon,1:klev,itr),ztra_th)
2472	! DO k=1,klev
2473	! DO i=1,klon
2474	! d_tr(i,k,itr)=pdtphys*d_tr(i,k,itr)/nsplit
2475	! d_tr_th(i,k,itr)=d_tr_th(i,k,itr)+d_tr(i,k,itr)
2476	! tr_seri(i,k,itr)=MAX(tr_seri(i,k,itr)+d_tr(i,k,itr),0.)
2477	! END DO
2478	! END DO
2479	! END DO ! nsplit1
2480	! END DO ! it
2481	!JE end modif 20140323
2482
2483	DO itr = 1, nbtr
2484	DO k = 1, klev
2485	DO i = 1, klon
2486	tmp_var(i, k) = tr_seri(i, k, itr) - tmp_var3(i, k, itr)
2487	ENDDO
2488	ENDDO
2489	IF (lminmax) THEN
2490	IF (lcheckmass) THEN
2491	CALL checkmass(tmp_var(:, :), RNAVO, masse(itr), zdz, &
2492	pplay, t_seri, iscm3, 'dtr therm ')
2493	ENDIF
2494	ENDIF
2495	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2496
2497	DO k = 1, klev
2498	DO i = 1, klon
2499	his_th(i, itr) = his_th(i, itr) + &
2500	(tmp_var(i, k)) / RNAVO * &
2501	masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2502	END DO !klon
2503	END DO !klev
2504
2505	END DO !it
2506	IF (lminmax) THEN
2507	DO itr = 1, nbtr
2508	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after therm')
2509	ENDDO
2510	DO itr = 1, nbtr
2511	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after therm')
2512	ENDDO
2513	IF (lcheckmass) THEN
2514	DO itr = 1, nbtr
2515	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2516	pplay, t_seri, iscm3, 'after therm')
2517	ENDDO
2518	ENDIF
2519	CALL minmaxsource(source_tr, qmin, qmax, 'after therm')
2520	ENDIF
2521
2522	IF (logitime) THEN
2523	CALL SYSTEM_CLOCK(COUNT = clock_end)
2524	dife = clock_end - clock_start
2525	ti_ther = dife * MAX(0, SIGN(1, dife)) &
2526	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2527	tia_ther = tia_ther + REAL(ti_ther) / REAL(clock_rate)
2528	ENDIF
2529
2530	ENDIF ! iflag_conv KE
2531	!------------------------------------
2532	! Sedimentation
2533	!-----------------------------------
2534	IF (logitime) THEN
2535	CALL SYSTEM_CLOCK(COUNT = clock_start)
2536	ENDIF
2537
2538	DO itr = 1, nbtr
2539	DO j = 1, klev
2540	DO i = 1, klon
2541	tmp_var(i, j) = tr_seri(i, j, itr)
2542	ENDDO
2543	ENDDO
2544	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2545	DO j = 1, klev
2546	DO i = 1, klon
2547	tr_seri(i, j, itr) = tmp_var(i, j)
2548	ENDDO
2549	ENDDO
2550	ENDDO !--end itr loop
2551	iscm3 = .TRUE.
2552	!--------------------------------------
2553	PRINT *, ' BEFORE Sediment'
2554
2555	IF (lminmax) THEN
2556	DO itr = 1, nbtr
2557	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_sedi')
2558	ENDDO
2559	DO itr = 1, nbtr
2560	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before sedi')
2561	ENDDO
2562	IF (lcheckmass) THEN
2563	DO itr = 1, nbtr
2564	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2565	pplay, t_seri, iscm3, 'before sedi')
2566	ENDDO
2567	ENDIF
2568	CALL minmaxsource(source_tr, qmin, qmax, 'src: before sedi')
2569	ENDIF
2570
2571	PRINT *, 'SPLA VERSION OF SEDIMENTATION IS USED'
2572	CALL sediment_mod(t_seri, pplay, zrho, paprs, pdtphys, RHcl, &
2573	id_coss, id_codu, id_scdu, &
2574	ok_chimeredust, &
2575	sed_ss, sed_dust, sed_dustsco, &
2576	sed_ss3D, sed_dust3D, sed_dustsco3D, tr_seri)
2577	CALL cm3_to_kg(pplay, t_seri, sed_ss3D)
2578	CALL cm3_to_kg(pplay, t_seri, sed_dust3D)
2579	CALL cm3_to_kg(pplay, t_seri, sed_dustsco3D)
2580
2581	IF (lminmax) THEN
2582	DO itr = 1, nbtr
2583	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_sedi')
2584	ENDDO
2585	DO itr = 1, nbtr
2586	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after sedi')
2587	ENDDO
2588	IF (lcheckmass) THEN
2589	DO itr = 1, nbtr
2590	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2591	pplay, t_seri, iscm3, 'after sedi')
2592	ENDDO
2593	ENDIF
2594	CALL minmaxsource(source_tr, qmin, qmax, 'src: after sedi')
2595	ENDIF
2596
2597	!=======================================================================
2598	#ifdef IOPHYS_DUST
2599	DO itr=1,nbtr
2600	WRITE(str2,'(i2.2)') itr
2601	CALL iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2602	enddo
2603	#endif
2604
2605	IF (logitime) THEN
2606	CALL SYSTEM_CLOCK(COUNT = clock_end)
2607	dife = clock_end - clock_start
2608	ti_sedi = dife * MAX(0, SIGN(1, dife)) &
2609	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2610	tia_sedi = tia_sedi + REAL(ti_sedi) / REAL(clock_rate)
2611	ENDIF
2612
2613	DO itr = 1, nbtr
2614	DO j = 1, klev
2615	DO i = 1, klon
2616	tmp_var(i, j) = tr_seri(i, j, itr)
2617	ENDDO
2618	ENDDO
2619	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2620	DO j = 1, klev
2621	DO i = 1, klon
2622	tr_seri(i, j, itr) = tmp_var(i, j)
2623	ENDDO
2624	ENDDO
2625	ENDDO
2626	iscm3 = .FALSE.
2627
2628
2629	!======================================================================
2630	! GAS TO PARTICLE CONVERSION
2631	!======================================================================
2632
2633	IF (logitime) THEN
2634	CALL SYSTEM_CLOCK(COUNT = clock_start)
2635	ENDIF
2636
2637	IF (lminmax) THEN
2638	DO itr = 1, nbtr
2639	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_beforegastopar')
2640	ENDDO
2641	DO itr = 1, nbtr
2642	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before gastopar')
2643	ENDDO
2644	IF (lcheckmass) THEN
2645	DO itr = 1, nbtr
2646	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2647	pplay, t_seri, iscm3, 'before gastopar')
2648	ENDDO
2649	ENDIF
2650	CALL minmaxsource(source_tr, qmin, qmax, 'src: before gastopar')
2651	ENDIF
2652
2653	CALL gastoparticle(pdtphys, zdz, zrho, rlat, &
2654	pplay, t_seri, id_prec, id_fine, &
2655	tr_seri, his_g2pgas, his_g2paer)
2656
2657	IF (lminmax) THEN
2658	DO itr = 1, nbtr
2659	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_gastopar')
2660	ENDDO
2661	DO itr = 1, nbtr
2662	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after gastopar')
2663	ENDDO
2664	IF (lcheckmass) THEN
2665	DO itr = 1, nbtr
2666	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2667	pplay, t_seri, iscm3, 'after gastopar')
2668	ENDDO
2669	ENDIF
2670	CALL minmaxsource(source_tr, qmin, qmax, 'src: after gastopar')
2671	ENDIF
2672
2673	IF (logitime) THEN
2674	CALL SYSTEM_CLOCK(COUNT = clock_end)
2675	dife = clock_end - clock_start
2676	ti_gasp = dife * MAX(0, SIGN(1, dife)) &
2677	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2678	tia_gasp = tia_gasp + REAL(ti_gasp) / REAL(clock_rate)
2679	ENDIF
2680
2681	!======================================================================
2682	! EFFECT OF PRECIPITATION: iflag_conv=2
2683	!======================================================================
2684
2685	#ifdef IOPHYS_DUST
2686	DO itr=1,nbtr
2687	WRITE(str2,'(i2.2)') itr
2688	CALL iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2689	enddo
2690	#endif
2691
2692
2693	IF (iflag_conv==2) THEN
2694
2695	IF (logitime) THEN
2696	CALL SYSTEM_CLOCK(COUNT = clock_start)
2697	ENDIF
2698
2699	DO itr = 1, nbtr
2700	DO j = 1, klev
2701	DO i = 1, klon
2702	tmp_var(i, j) = tr_seri(i, j, itr)
2703	ENDDO
2704	ENDDO
2705	CALL kg_to_cm3(pplay, t_seri, tmp_var)
2706	DO j = 1, klev
2707	DO i = 1, klon
2708	tr_seri(i, j, itr) = tmp_var(i, j)
2709	ENDDO
2710	ENDDO
2711	ENDDO
2712	iscm3 = .TRUE.
2713	!------------------------------
2714
2715	PRINT *, 'iflag_conv bef lessiv', iflag_conv
2716	IF (lessivage) THEN
2717
2718	PRINT *, ' BEFORE Incloud'
2719
2720	IF (lminmax) THEN
2721	DO itr = 1, nbtr
2722	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_incloud')
2723	ENDDO
2724	DO itr = 1, nbtr
2725	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before incloud')
2726	ENDDO
2727	IF (lcheckmass) THEN
2728	DO itr = 1, nbtr
2729	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2730	pplay, t_seri, iscm3, 'before incloud')
2731	ENDDO
2732	ENDIF
2733	CALL minmaxsource(source_tr, qmin, qmax, 'src: before incloud')
2734	ENDIF
2735
2736
2737	! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
2738	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2739
2740	! . his_dhlsc,his_dhcon,tr_seri)
2741	PRINT *, 'iflag_conv bef incloud', iflag_conv
2742
2743	IF (iflag_conv==2) THEN
2744	! Tiedke
2745	CALL incloud_scav(.FALSE., qmin, qmax, masse, henry, kk, prfl, &
2746	psfl, pmflxr, pmflxs, zrho, zdz, t_seri, pdtphys, &
2747	his_dhlsc, his_dhcon, tr_seri)
2748
2749	!---------- to use this option please comment lsc_scav at the end
2750	! ELSE IF (iflag_conv.GE.3) THEN
2751
2752	! CALL incloud_scav_lsc(.FALSE.,qmin,qmax,masse,henry,kk,prfl,
2753	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
2754	! . his_dhlsc,his_dhcon,tr_seri)
2755	!--------------------------------------------------------------
2756
2757	ENDIF
2758
2759	PRINT *, ' BEFORE blcloud (after incloud)'
2760	IF (lminmax) THEN
2761	DO itr = 1, nbtr
2762	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_blcloud')
2763	ENDDO
2764	DO itr = 1, nbtr
2765	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before blcloud')
2766	ENDDO
2767	IF (lcheckmass) THEN
2768	DO itr = 1, nbtr
2769	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2770	pplay, t_seri, iscm3, 'before blcloud')
2771	ENDDO
2772	ENDIF
2773	CALL minmaxsource(source_tr, qmin, qmax, 'src: before blcloud')
2774	ENDIF
2775
2776	! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
2777	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2778	! . his_dhbclsc,his_dhbccon,tr_seri)
2779
2780	IF (iflag_conv==2) THEN
2781	! Tiedke
2782
2783	CALL blcloud_scav(.FALSE., qmin, qmax, pdtphys, prfl, psfl, &
2784	pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
2785	his_dhbclsc, his_dhbccon, tr_seri)
2786
2787	!---------- to use this option please comment lsc_scav at the end
2788	! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
2789
2790
2791	! ELSE IF (iflag_conv.GE.3) THEN
2792
2793	! CALL blcloud_scav_lsc(.FALSE.,qmin,qmax,pdtphys,prfl,psfl,
2794	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2795	! . his_dhbclsc,his_dhbccon,tr_seri)
2796
2797	!----------------------------------------------------------------------
2798	ENDIF
2799
2800	PRINT *, ' AFTER blcloud '
2801
2802	IF (lminmax) THEN
2803	DO itr = 1, nbtr
2804	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_blcloud')
2805	ENDDO
2806	DO itr = 1, nbtr
2807	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after blcloud')
2808	ENDDO
2809	IF (lcheckmass) THEN
2810	DO itr = 1, nbtr
2811	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2812	pplay, t_seri, iscm3, 'after blcloud')
2813	ENDDO
2814	ENDIF
2815	CALL minmaxsource(source_tr, qmin, qmax, 'src: after blcloud')
2816	ENDIF
2817
2818	ENDIF !--lessivage
2819
2820	DO itr = 1, nbtr
2821	DO j = 1, klev
2822	DO i = 1, klon
2823	tmp_var(i, j) = tr_seri(i, j, itr)
2824	ENDDO
2825	ENDDO
2826	CALL cm3_to_kg(pplay, t_seri, tmp_var)
2827	DO j = 1, klev
2828	DO i = 1, klon
2829	tr_seri(i, j, itr) = tmp_var(i, j)
2830	ENDDO
2831	ENDDO
2832	ENDDO
2833	iscm3 = .FALSE.
2834
2835	IF (logitime) THEN
2836	CALL SYSTEM_CLOCK(COUNT = clock_end)
2837	dife = clock_end - clock_start
2838	ti_wetap = dife * MAX(0, SIGN(1, dife)) &
2839	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
2840	tia_wetap = tia_wetap + REAL(ti_wetap) / REAL(clock_rate)
2841	ENDIF
2842
2843	ENDIF ! iflag_conv=2
2844
2845
2846	!======================================================================
2847	! EFFECT OF CONVECTION
2848	!======================================================================
2849
2850	#ifdef IOPHYS_DUST
2851	DO itr=1,nbtr
2852	WRITE(str2,'(i2.2)') itr
2853	CALL iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
2854	enddo
2855	#endif
2856
2857
2858	IF (logitime) THEN
2859	CALL SYSTEM_CLOCK(COUNT = clock_start)
2860	ENDIF
2861
2862	IF (convection) THEN
2863
2864	PRINT *, ' BEFORE trconvect'
2865
2866	IF (lminmax) THEN
2867	DO itr = 1, nbtr
2868	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_trconve')
2869	ENDDO
2870	DO itr = 1, nbtr
2871	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before trconve')
2872	ENDDO
2873	IF (lcheckmass) THEN
2874	DO itr = 1, nbtr
2875	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
2876	pplay, t_seri, iscm3, 'before trconve')
2877	ENDDO
2878	ENDIF
2879	CALL minmaxsource(source_tr, qmin, qmax, 'src: before trconve')
2880	ENDIF
2881
2882
2883	! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
2884	! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
2885	! . dtrconv,tr_seri)
2886	! -------------------------------------------------------------
2887	IF (iflag_conv==2) THEN
2888	! Tiedke
2889	CALL trconvect(pplay, t_seri, pdtphys, pmfu, pmfd, pen_u, pde_u, &
2890	pen_d, pde_d, paprs, zdz, xconv, qmin, qmax, .FALSE., masse, &
2891	dtrconv, tr_seri)
2892	DO itr = 1, nbtr
2893	d_tr_cv(:, :, itr) = 0.
2894	ENDDO
2895
2896	ELSE IF (iflag_conv>=3) THEN
2897	! KE
2898	PRINT *, 'JE: KE in phytracr_spl'
2899	DO itr = 1, nbtr
2900	DO k = 1, klev
2901	DO i = 1, klon
2902	tmp_var3(i, k, itr) = tr_seri(i, k, itr)
2903	END DO
2904	END DO
2905	ENDDO
2906
2907	DO itr = 1, nbtr
2908	! routine for aerosols . otherwise, check cvltrorig
2909	PRINT *, 'Check sum before cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2910	! IF (.FALSE.) THEN
2911	CALL cvltr_spl(pdtphys, da, phi, phi2, d1a, dam, mp, ep, &
2912	sigd, sij, wght_cvfd, clw, elij, epmlmMm, eplaMm, &
2913	pmflxr, pmflxs, evapls, t_seri, wdtrainA, wdtrainM, &
2914	! paprs,itr,tr_seri,upwd,dnwd,itop_con,ibas_con, &
2915	paprs, itr, tmp_var3, upwd, dnwd, itop_con, ibas_con, &
2916	henry, kk, zrho, ccntrAA_spla, ccntrENV_spla, coefcoli_spla, &
2917	id_prec, id_fine, id_coss, id_codu, id_scdu, &
2918	d_tr_cv, d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, qDi, qPr, &
2919	qPa, qMel, qTrdi, dtrcvMA, Mint, &
2920	zmfd1a, zmfphi2, zmfdam)
2921	! ENDIF
2922
2923	! IF (.FALSE.) THEN
2924	! CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
2925	! . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
2926	! . pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM,
2927	! . paprs,itr,tmp_var3,upwd,dnwd,itop_con,ibas_con,
2928	! . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
2929	! . qPa,qMel,qTrdi,dtrcvMA,Mint,
2930	! . zmfd1a,zmfphi2,zmfdam)
2931	!! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
2932	! ENDIF
2933
2934
2935
2936	!!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
2937	!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
2938	!!! . upwd,dnwd,d_tr_cv)
2939	! PRINT *,'justbefore cvltrnoscav it= ',it
2940	! CALL checknanqfi(da(:,:),1.,-1.,' da')
2941	! CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ')
2942	! CALL checknanqfi(mp(:,:),1.,-1.,'mp ')
2943	! CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ')
2944	! CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ')
2945	! CALL checknanqfi(tmp_var3(:,:,itr),1.,-1.,'tmp_var3 ')
2946	! CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ')
2947	! CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ')
2948	! CALL checknanqfi(d_tr_cv(:,:,itr),1.,-1.,'d_tr_cv ')
2949	! IF (.TRUE.) THEN
2950	! CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
2951	! . pplay,tmp_var3,upwd,dnwd,d_tr_cv)
2952	! ENDIF
2953	DO k = 1, klev
2954	DO i = 1, klon
2955	! tr_seri(i,k,itr) = tr_seri(i,k,itr) + d_tr_cv(i,k,itr)
2956	tr_seri(i, k, itr) = (tmp_var3(i, k, itr) + d_tr_cv(i, k, itr))
2957	tmp_var(i, k) = d_tr_cv(i, k, itr)
2958
2959	END DO
2960	END DO
2961
2962	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2963
2964	DO k = 1, klev
2965	DO i = 1, klon
2966	dtrconv(i, itr) = 0.0
2967	his_dhkecv(i, itr) = his_dhkecv(i, itr) - tmp_var(i, k) &
2968	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2969	END DO
2970	END DO
2971
2972	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2973	CALL kg_to_cm3(pplay, t_seri, tmp_var) !just for his_* computation
2974
2975	DO k = 1, klev
2976	DO i = 1, klon
2977	dtrconv(i, itr) = 0.0
2978	his_ds(i, itr) = his_ds(i, itr) - tmp_var(i, k) &
2979	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
2980	END DO
2981	END DO
2982	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2983	IF (lminmax) THEN
2984
2985	PRINT *, 'Check sum after cvltr itr)', itr, SUM(tr_seri(:, :, itr))
2986	CALL minmaxqfi2(d_tr_cv(:, :, itr), qmin, qmax, 'd_tr_cv:')
2987	CALL minmaxqfi2(d_tr_trsp(:, :, itr), qmin, qmax, 'd_tr_trsp:')
2988	CALL minmaxqfi2(d_tr_sscav(:, :, itr), qmin, qmax, 'd_tr_sscav:')
2989	CALL minmaxqfi2(d_tr_sat(:, :, itr), qmin, qmax, 'd_tr_sat:')
2990	CALL minmaxqfi2(d_tr_uscav(:, :, itr), qmin, qmax, 'd_tr_uscav:')
2991	IF (lcheckmass) THEN
2992	CALL checkmass(d_tr_cv(:, :, itr), RNAVO, masse(itr), zdz, &
2993	pplay, t_seri, .FALSE., 'd_tr_cv:')
2994	ENDIF
2995	ENDIF
2996	ENDDO ! it=1,nbtr
2997
2998	ENDIF ! iflag_conv
2999	IF (lminmax) THEN
3000	DO itr = 1, nbtr
3001	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_trcon')
3002	ENDDO
3003	DO itr = 1, nbtr
3004	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after trconv')
3005	ENDDO
3006	IF (lcheckmass) THEN
3007	DO itr = 1, nbtr
3008	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3009	pplay, t_seri, iscm3, 'after trconv')
3010	ENDDO
3011	ENDIF
3012	CALL minmaxsource(source_tr, qmin, qmax, 'src: after trconv')
3013	ENDIF
3014	ENDIF ! convection
3015
3016	IF (logitime) THEN
3017	CALL SYSTEM_CLOCK(COUNT = clock_end)
3018	dife = clock_end - clock_start
3019	ti_cvltr = dife * MAX(0, SIGN(1, dife)) &
3020	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3021	tia_cvltr = tia_cvltr + REAL(ti_cvltr) / REAL(clock_rate)
3022	ENDIF
3023
3024
3025	!=======================================================================
3026	! LARGE SCALE SCAVENGING KE
3027	!=======================================================================
3028
3029	#ifdef IOPHYS_DUST
3030	CALL iophys_ecrit('da',klev,'da','',da)
3031	CALL iophys_ecrit('phi',klev,'phi','',phi)
3032	CALL iophys_ecrit('phi2',klev,'phi2','',phi2)
3033	CALL iophys_ecrit('d1a',klev,'d1a','',d1a)
3034	CALL iophys_ecrit('dam',klev,'dam','',dam)
3035	CALL iophys_ecrit('mp',klev,'mp','',mp)
3036	CALL iophys_ecrit('ep',klev,'ep','',ep)
3037	CALL iophys_ecrit('sigd',klev,'sigd','',sigd)
3038	CALL iophys_ecrit('sij',klev,'sij','',sij)
3039	CALL iophys_ecrit('wght_cvfd',klev,'wght_cvfd','',wght_cvfd)
3040	CALL iophys_ecrit('clw',klev,'clw','',clw)
3041	CALL iophys_ecrit('elij',klev,'elij','',elij)
3042	CALL iophys_ecrit('epmlmMm',klev,'epmlmMm','',epmlmMm)
3043	CALL iophys_ecrit('eplaMm',klev,'eplaMm','',eplaMm)
3044	CALL iophys_ecrit('pmflxr',klev,'pmflxr','',pmflxr)
3045	CALL iophys_ecrit('pmflxs',klev,'pmflxs','',pmflxs)
3046	CALL iophys_ecrit('evapls',klev,'evapls','',evapls)
3047	CALL iophys_ecrit('wdtrainA',klev,'wdtrainA','',wdtrainA)
3048	CALL iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM)
3049
3050	DO itr=1,nbtr
3051	WRITE(str2,'(i2.2)') itr
3052	CALL iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3053	enddo
3054	#endif
3055
3056
3057	IF (iflag_conv>=3) THEN
3058	IF (logitime) THEN
3059	CALL SYSTEM_CLOCK(COUNT = clock_start)
3060	ENDIF
3061
3062	IF (lessivage) THEN
3063	PRINT *, ' BEFORE lsc_scav '
3064	IF (lminmax) THEN
3065	DO itr = 1, nbtr
3066	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_before_lsc_scav')
3067	ENDDO
3068	DO itr = 1, nbtr
3069	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'before lsc_scav')
3070	ENDDO
3071	IF (lcheckmass) THEN
3072	DO itr = 1, nbtr
3073	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3074	pplay, t_seri, iscm3, 'before lsc_scav')
3075	ENDDO
3076	ENDIF
3077	CALL minmaxsource(source_tr, qmin, qmax, 'src: before lsc_scav')
3078	ENDIF
3079
3080	ql_incloud_ref = 10.e-4
3081	ql_incloud_ref = 5.e-4
3082	! calcul du contenu en eau liquide au sein du nuage
3083	ql_incl = ql_incloud_ref
3084	! choix du lessivage
3085	IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
3086	!IF (.FALSE.) THEN ! test #DFB (Binta) sans lsc_scav_spl
3087	PRINT *, 'JE iflag_lscav', iflag_lscav
3088	DO itr = 1, nbtr
3089
3090	! incloud scavenging and removal by large scale rain ! orig : ql_incl
3091	! was replaced by 0.5e-3 kg/kg
3092	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
3093	! Liu (2001) proposed to use 1.5e-3 kg/kg
3094
3095	! CALL lsc_scav_orig(pdtphys,itr,iflag_lscav,ql_incl,prfl,psfl,
3096	! . rneb,beta_fisrt, beta_v1,pplay,paprs,
3097	! . t_seri,tr_seri,d_tr_insc,
3098	! . d_tr_bcscav,d_tr_evapls,qPrls)
3099	CALL lsc_scav_spl(pdtphys, itr, iflag_lscav, ql_incl, prfl, psfl, &
3100	rneb, beta_fisrt, beta_v1, pplay, paprs, &
3101	t_seri, tr_seri, d_tr_insc, &
3102	alpha_r, alpha_s, kk, henry, &
3103	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3104	d_tr_bcscav, d_tr_evapls, qPrls)
3105
3106	!large scale scavenging tendency
3107	DO k = 1, klev
3108	DO i = 1, klon
3109	d_tr_ls(i, k, itr) = d_tr_insc(i, k, itr) + d_tr_bcscav(i, k, itr) &
3110	+ d_tr_evapls(i, k, itr)
3111	tr_seri(i, k, itr) = tr_seri(i, k, itr) + d_tr_ls(i, k, itr)
3112	tmp_var(i, k) = d_tr_ls(i, k, itr)
3113	ENDDO
3114	ENDDO
3115
3116	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3117
3118	DO k = 1, klev
3119	DO i = 1, klon
3120	his_dhkelsc(i, itr) = his_dhkelsc(i, itr) - tmp_var(i, k) &
3121	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3122
3123	END DO
3124	END DO
3125
3126	END DO !it=1,nbtr
3127
3128	ELSE
3129	PRINT *, 'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
3130	DO itr = 1, nbtr
3131	DO i = 1, klon
3132	his_dhkelsc(i, itr) = 0.0
3133	END DO ! klon
3134	END DO !it=1,nbtr
3135	ENDIF !iflag_lscav
3136
3137	PRINT *, ' AFTER lsc_scav '
3138	IF (lminmax) THEN
3139	DO itr = 1, nbtr
3140	CALL checknanqfi(tr_seri(:, :, itr), qmin, qmax, 'nan_after_lsc_scav')
3141	ENDDO
3142	DO itr = 1, nbtr
3143	CALL minmaxqfi2(tr_seri(:, :, itr), qmin, qmax, 'after lsc_scav')
3144	ENDDO
3145	IF (lcheckmass) THEN
3146	DO itr = 1, nbtr
3147	CALL checkmass(tr_seri(:, :, itr), RNAVO, masse(itr), zdz, &
3148	pplay, t_seri, iscm3, 'after lsc_scav')
3149	ENDDO
3150	ENDIF
3151	CALL minmaxsource(source_tr, qmin, qmax, 'src: after lsc_scav')
3152	ENDIF
3153
3154	ENDIF ! lessivage
3155
3156	IF (logitime) THEN
3157	CALL SYSTEM_CLOCK(COUNT = clock_end)
3158	dife = clock_end - clock_start
3159	ti_lscs = dife * MAX(0, SIGN(1, dife)) &
3160	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3161	tia_lscs = tia_lscs + REAL(ti_lscs) / REAL(clock_rate)
3162	ENDIF
3163
3164	ENDIF !iflag_conv
3165
3166
3167	!=======================================================================
3168	! COMPUTING THE BURDEN
3169	!=======================================================================
3170	#ifdef IOPHYS_DUST
3171	DO itr=1,nbtr
3172	WRITE(str2,'(i2.2)') itr
3173	CALL iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3174	enddo
3175	#endif
3176
3177	IF (logitime) THEN
3178	CALL SYSTEM_CLOCK(COUNT = clock_start)
3179	ENDIF
3180
3181	DO itr = 1, nbtr
3182	DO j = 1, klev
3183	DO i = 1, klon
3184	tmp_var(i, j) = tr_seri(i, j, itr)
3185	ENDDO
3186	ENDDO
3187	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3188	DO j = 1, klev
3189	DO i = 1, klon
3190	tr_seri(i, j, itr) = tmp_var(i, j)
3191	ENDDO
3192	ENDDO
3193	ENDDO
3194	iscm3 = .TRUE.
3195
3196	! Computing burden in mg/m2
3197	DO itr = 1, nbtr
3198	DO k = 1, klev
3199	DO i = 1, klon
3200	trm(i, itr) = trm(i, itr) + tr_seri(i, k, itr) * 1.e6 * zdz(i, k) * &
3201	masse(itr) * 1.e3 / RNAVO !--mg S/m2
3202	ENDDO
3203	ENDDO
3204	ENDDO
3205
3206	! Computing Surface concentration in ug/m3
3207
3208	DO itr = 1, nbtr
3209	DO i = 1, klon
3210	sconc_seri(i, itr) = tr_seri(i, 1, itr) * 1.e6 * &
3211	masse(itr) * 1.e3 / RNAVO !--mg/m3 (tr_seri ist in g/cm3)
3212	ENDDO
3213	ENDDO
3214
3215	!=======================================================================
3216	! CALCULATION OF OPTICAL PROPERTIES
3217	!=======================================================================
3218
3219	CALL aeropt_spl(zdz, tr_seri, RHcl, &
3220	id_prec, id_fine, id_coss, id_codu, id_scdu, &
3221	ok_chimeredust, &
3222	diff_aod550_tot, diag_aod670_tot, diag_aod865_tot, &
3223	diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, &
3224	diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, &
3225	diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, &
3226	diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco)
3227
3228	IF (logitime) THEN
3229	CALL SYSTEM_CLOCK(COUNT = clock_end)
3230	dife = clock_end - clock_start
3231	ti_brop = dife * MAX(0, SIGN(1, dife)) &
3232	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
3233	tia_brop = tia_brop + REAL(ti_brop) / REAL(clock_rate)
3234	ENDIF
3235
3236
3237	!=======================================================================
3238	! MODIS terra/aqua simulation output
3239	!=======================================================================
3240	masque_aqua_cur(:) = 0
3241	masque_terra_cur(:) = 0
3242
3243	CALL satellite_out_spla(jD_cur, jH_cur, pdtphys, rlat, rlon, &
3244	masque_aqua_cur, masque_terra_cur)
3245	IF (jH_cur - pdtphys / 86400. < 0.) THEN
3246	!new utc day: put in 0 everything
3247	!JE20150518<<
3248	masque_aqua(:) = 0
3249	masque_terra(:) = 0
3250	aod550_terra(:) = 0.
3251	aod550_tr2_terra(:) = 0.
3252	aod550_ss_terra(:) = 0.
3253	aod550_dust_terra(:) = 0.
3254	aod550_dustsco_terra(:) = 0.
3255	aod670_terra(:) = 0.
3256	aod670_tr2_terra(:) = 0.
3257	aod670_ss_terra(:) = 0.
3258	aod670_dust_terra(:) = 0.
3259	aod670_dustsco_terra(:) = 0.
3260	aod865_terra(:) = 0.
3261	aod865_tr2_terra(:) = 0.
3262	aod865_ss_terra(:) = 0.
3263	aod865_dust_terra(:) = 0.
3264	aod865_dustsco_terra(:) = 0.
3265	aod550_aqua(:) = 0.
3266	aod550_tr2_aqua(:) = 0.
3267	aod550_ss_aqua(:) = 0.
3268	aod550_dust_aqua(:) = 0.
3269	aod550_dustsco_aqua(:) = 0.
3270	aod670_aqua(:) = 0.
3271	aod670_tr2_aqua(:) = 0.
3272	aod670_ss_aqua(:) = 0.
3273	aod670_dust_aqua(:) = 0.
3274	aod670_dustsco_aqua(:) = 0.
3275	aod865_aqua(:) = 0.
3276	aod865_tr2_aqua(:) = 0.
3277	aod865_ss_aqua(:) = 0.
3278	aod865_dust_aqua(:) = 0.
3279	aod865_dustsco_aqua(:) = 0.
3280	!JE20150518>>
3281	ENDIF
3282
3283	DO i = 1, klon
3284
3285	aod550_terra(i) = aod550_terra(i) + &
3286	masque_terra_cur(i) * diff_aod550_tot(i)
3287	aod550_tr2_terra(i) = aod550_tr2_terra(i) + &
3288	masque_terra_cur(i) * diff_aod550_tr2(i)
3289	aod550_ss_terra(i) = aod550_ss_terra(i) + &
3290	masque_terra_cur(i) * diag_aod550_ss(i)
3291	aod550_dust_terra(i) = aod550_dust_terra(i) + &
3292	masque_terra_cur(i) * diag_aod550_dust(i)
3293	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) + &
3294	masque_terra_cur(i) * diag_aod550_dustsco(i)
3295	aod670_terra(i) = aod670_terra(i) + &
3296	masque_terra_cur(i) * diag_aod670_tot(i)
3297	aod670_tr2_terra(i) = aod670_tr2_terra(i) + &
3298	masque_terra_cur(i) * diag_aod670_tr2(i)
3299	aod670_ss_terra(i) = aod670_ss_terra(i) + &
3300	masque_terra_cur(i) * diag_aod670_ss(i)
3301	aod670_dust_terra(i) = aod670_dust_terra(i) + &
3302	masque_terra_cur(i) * diag_aod670_dust(i)
3303	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) + &
3304	masque_terra_cur(i) * diag_aod670_dustsco(i)
3305	aod865_terra(i) = aod865_terra(i) + &
3306	masque_terra_cur(i) * diag_aod865_tot(i)
3307	aod865_tr2_terra(i) = aod865_tr2_terra(i) + &
3308	masque_terra_cur(i) * diag_aod865_tr2(i)
3309	aod865_ss_terra(i) = aod865_ss_terra(i) + &
3310	masque_terra_cur(i) * diag_aod865_ss(i)
3311	aod865_dust_terra(i) = aod865_dust_terra(i) + &
3312	masque_terra_cur(i) * diag_aod865_dust(i)
3313	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) + &
3314	masque_terra_cur(i) * diag_aod865_dustsco(i)
3315
3316	aod550_aqua(i) = aod550_aqua(i) + &
3317	masque_aqua_cur(i) * diff_aod550_tot(i)
3318	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) + &
3319	masque_aqua_cur(i) * diff_aod550_tr2(i)
3320	aod550_ss_aqua(i) = aod550_ss_aqua(i) + &
3321	masque_aqua_cur(i) * diag_aod550_ss(i)
3322	aod550_dust_aqua(i) = aod550_dust_aqua(i) + &
3323	masque_aqua_cur(i) * diag_aod550_dust(i)
3324	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) + &
3325	masque_aqua_cur(i) * diag_aod550_dustsco(i)
3326	aod670_aqua(i) = aod670_aqua(i) + &
3327	masque_aqua_cur(i) * diag_aod670_tot(i)
3328	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) + &
3329	masque_aqua_cur(i) * diag_aod670_tr2(i)
3330	aod670_ss_aqua(i) = aod670_ss_aqua(i) + &
3331	masque_aqua_cur(i) * diag_aod670_ss(i)
3332	aod670_dust_aqua(i) = aod670_dust_aqua(i) + &
3333	masque_aqua_cur(i) * diag_aod670_dust(i)
3334	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) + &
3335	masque_aqua_cur(i) * diag_aod670_dustsco(i)
3336	aod865_aqua(i) = aod865_aqua(i) + &
3337	masque_aqua_cur(i) * diag_aod865_tot(i)
3338	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) + &
3339	masque_aqua_cur(i) * diag_aod865_tr2(i)
3340	aod865_ss_aqua(i) = aod865_ss_aqua(i) + &
3341	masque_aqua_cur(i) * diag_aod865_ss(i)
3342	aod865_dust_aqua(i) = aod865_dust_aqua(i) + &
3343	masque_aqua_cur(i) * diag_aod865_dust(i)
3344	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) + &
3345	masque_aqua_cur(i) * diag_aod865_dustsco(i)
3346
3347	masque_aqua(i) = masque_aqua(i) + masque_aqua_cur(i)
3348	masque_terra(i) = masque_terra(i) + masque_terra_cur(i)
3349	ENDDO
3350
3351	IF (jH_cur + pdtphys / 86400. >= 1.) THEN
3352	! PRINT *,'last step of the day'
3353	DO i = 1, klon
3354	IF (masque_aqua(i)> 0) THEN
3355	aod550_aqua(i) = aod550_aqua(i) / masque_aqua(i)
3356	aod670_aqua(i) = aod670_aqua(i) / masque_aqua(i)
3357	aod865_aqua(i) = aod865_aqua(i) / masque_aqua(i)
3358	aod550_tr2_aqua(i) = aod550_tr2_aqua(i) / masque_aqua(i)
3359	aod670_tr2_aqua(i) = aod670_tr2_aqua(i) / masque_aqua(i)
3360	aod865_tr2_aqua(i) = aod865_tr2_aqua(i) / masque_aqua(i)
3361	aod550_ss_aqua(i) = aod550_ss_aqua(i) / masque_aqua(i)
3362	aod670_ss_aqua(i) = aod670_ss_aqua(i) / masque_aqua(i)
3363	aod865_ss_aqua(i) = aod865_ss_aqua(i) / masque_aqua(i)
3364	aod550_dust_aqua(i) = aod550_dust_aqua(i) / masque_aqua(i)
3365	aod670_dust_aqua(i) = aod670_dust_aqua(i) / masque_aqua(i)
3366	aod865_dust_aqua(i) = aod865_dust_aqua(i) / masque_aqua(i)
3367	aod550_dustsco_aqua(i) = aod550_dustsco_aqua(i) / masque_aqua(i)
3368	aod670_dustsco_aqua(i) = aod670_dustsco_aqua(i) / masque_aqua(i)
3369	aod865_dustsco_aqua(i) = aod865_dustsco_aqua(i) / masque_aqua(i)
3370	ELSE
3371	aod550_aqua(i) = -999.
3372	aod670_aqua(i) = -999.
3373	aod865_aqua(i) = -999.
3374	aod550_tr2_aqua(i) = -999.
3375	aod670_tr2_aqua(i) = -999.
3376	aod865_tr2_aqua(i) = -999.
3377	aod550_ss_aqua(i) = -999.
3378	aod670_ss_aqua(i) = -999.
3379	aod865_ss_aqua(i) = -999.
3380	aod550_dust_aqua(i) = -999.
3381	aod670_dust_aqua(i) = -999.
3382	aod865_dust_aqua(i) = -999.
3383	aod550_dustsco_aqua(i) = -999.
3384	aod670_dustsco_aqua(i) = -999.
3385	aod865_dustsco_aqua(i) = -999.
3386	ENDIF
3387	IF (masque_terra(i)> 0) THEN
3388	aod550_terra(i) = aod550_terra(i) / masque_terra(i)
3389	aod670_terra(i) = aod670_terra(i) / masque_terra(i)
3390	aod865_terra(i) = aod865_terra(i) / masque_terra(i)
3391	aod550_tr2_terra(i) = aod550_tr2_terra(i) / masque_terra(i)
3392	aod670_tr2_terra(i) = aod670_tr2_terra(i) / masque_terra(i)
3393	aod865_tr2_terra(i) = aod865_tr2_terra(i) / masque_terra(i)
3394	aod550_ss_terra(i) = aod550_ss_terra(i) / masque_terra(i)
3395	aod670_ss_terra(i) = aod670_ss_terra(i) / masque_terra(i)
3396	aod865_ss_terra(i) = aod865_ss_terra(i) / masque_terra(i)
3397	aod550_dust_terra(i) = aod550_dust_terra(i) / masque_terra(i)
3398	aod670_dust_terra(i) = aod670_dust_terra(i) / masque_terra(i)
3399	aod865_dust_terra(i) = aod865_dust_terra(i) / masque_terra(i)
3400	aod550_dustsco_terra(i) = aod550_dustsco_terra(i) / masque_terra(i)
3401	aod670_dustsco_terra(i) = aod670_dustsco_terra(i) / masque_terra(i)
3402	aod865_dustsco_terra(i) = aod865_dustsco_terra(i) / masque_terra(i)
3403	ELSE
3404	aod550_terra(i) = -999.
3405	aod670_terra(i) = -999.
3406	aod865_terra(i) = -999.
3407	aod550_tr2_terra(i) = -999.
3408	aod670_tr2_terra(i) = -999.
3409	aod865_tr2_terra(i) = -999.
3410	aod550_ss_terra(i) = -999.
3411	aod670_ss_terra(i) = -999.
3412	aod865_ss_terra(i) = -999.
3413	aod550_dust_terra(i) = -999.
3414	aod670_dust_terra(i) = -999.
3415	aod865_dust_terra(i) = -999.
3416	aod550_dustsco_terra(i) = -999.
3417	aod670_dustsco_terra(i) = -999.
3418	aod865_dustsco_terra(i) = -999.
3419	ENDIF
3420	ENDDO
3421
3422	!!AS deleting lines
3423	!! IF (ok_histrac) THEN
3424	!!!! write in output file
3425	!!----many deleted lines
3426	!! ENDIF !mpi_root
3427	!!!$OMP END MASTER
3428	!!!$OMP BARRIER
3429	!! ENDIF !--ok_histrac
3430
3431	ENDIF ! jH_cur...
3432
3433	!======================================================================
3434	! Stockage sur bande histoire
3435	!======================================================================
3436	#ifdef IOPHYS_DUST
3437	DO itr=1,nbtr
3438	WRITE(str2,'(i2.2)') itr
3439	CALL iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,itr))
3440	enddo
3441	#endif
3442
3443	IF (logitime) THEN
3444	CALL SYSTEM_CLOCK(COUNT = clock_start)
3445	ENDIF
3446
3447	DO itr = 1, nbtr
3448	DO j = 1, klev
3449	DO i = 1, klon
3450	tmp_var(i, j) = tr_seri(i, j, itr)
3451	ENDDO
3452	ENDDO
3453	CALL cm3_to_kg(pplay, t_seri, tmp_var)
3454	DO j = 1, klev
3455	DO i = 1, klon
3456	tr_seri(i, j, itr) = tmp_var(i, j)
3457	ENDDO
3458	ENDDO
3459	ENDDO
3460	iscm3 = .FALSE.
3461
3462
3463	!======================================================================
3464	! SAVING AEROSOL RELATED VARIABLES INTO FILE
3465	!======================================================================
3466
3467	ndex2d = 0
3468	ndex3d = 0
3469
3470	itra = itra + 1
3471
3472	PRINT *, 'SAVING VARIABLES FOR DAY ', itra
3473
3474	fluxbb(:) = 0.0
3475	fluxff(:) = 0.0
3476	fluxbcbb(:) = 0.0
3477	fluxbcff(:) = 0.0
3478	fluxbcnff(:) = 0.0
3479	fluxbcba(:) = 0.0
3480	fluxbc(:) = 0.0
3481	fluxombb(:) = 0.0
3482	fluxomff(:) = 0.0
3483	fluxomnat(:) = 0.0
3484	fluxomba(:) = 0.0
3485	fluxomnff(:) = 0.0
3486	fluxom(:) = 0.0
3487	fluxh2sff(:) = 0.0
3488	fluxh2snff(:) = 0.0
3489	fluxh2sbio(:) = 0.0
3490	fluxso2ff(:) = 0.0
3491	fluxso2nff(:) = 0.0
3492	fluxso2bb(:) = 0.0
3493	fluxso2vol(:) = 0.0
3494	fluxso2ba(:) = 0.0
3495	fluxso2(:) = 0.0
3496	fluxso4ff(:) = 0.0
3497	fluxso4nff(:) = 0.0
3498	fluxso4bb(:) = 0.0
3499	fluxso4ba(:) = 0.0
3500	fluxso4(:) = 0.0
3501	fluxdms(:) = 0.0
3502	fluxdustec(:) = 0.0
3503	fluxddfine(:) = 0.0
3504	fluxddcoa(:) = 0.0
3505	fluxddsco(:) = 0.0
3506	fluxdd(:) = 0.0
3507	fluxssfine(:) = 0.0
3508	fluxsscoa(:) = 0.0
3509	fluxss(:) = 0.0
3510	DO i = 1, klon
3511	IF (iregion_ind(i)>0) THEN ! LAND
3512	! SULFUR EMISSIONS
3513	fluxh2sff(i) = (lmt_so2ff_l(i) + lmt_so2ff_h(i)) * frach2sofso2 * &
3514	scale_param_ind(iregion_ind(i)) * &
3515	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3516	fluxso2ff(i) = scale_param_ind(iregion_ind(i)) * fracso2emis * &
3517	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3518	masse_s * 1.e3 ! mgS/m2/s
3519	! SULPHATE EMISSIONS
3520	fluxso4ff(i) = scale_param_ind(iregion_ind(i)) * (1 - fracso2emis) * &
3521	(lmt_so2ff_l(i) + lmt_so2ff_h(i)) * 1.e4 / RNAVO * &
3522	masse_s * 1.e3 ! mgS/m2/s
3523	! BLACK CARBON EMISSIONS
3524	fluxbcff(i) = scale_param_ff(iregion_ind(i)) * &
3525	lmt_bcff(i) * 1.e4 * 1.e3 !/g/m2/s
3526	! ORGANIC MATTER EMISSIONS
3527	fluxomff(i) = scale_param_ff(iregion_ind(i)) * &
3528	(lmt_omff(i)) * 1.e4 * 1.e3 !/g/m2/s
3529	! FOSSIL FUEL EMISSIONS
3530	fluxff(i) = fluxbcff(i) + fluxomff(i)
3531	ENDIF
3532	IF (iregion_bb(i)>0) THEN ! LAND
3533	! SULFUR EMISSIONS
3534	fluxso2bb(i) = scale_param_bb(iregion_bb(i)) * fracso2emis * &
3535	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3536	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3537	! SULPHATE EMISSIONS
3538	fluxso4bb(i) = scale_param_bb(iregion_bb(i)) * (1 - fracso2emis) * &
3539	(lmt_so2bb_l(i) + lmt_so2bb_h(i)) * &
3540	(1. - pctsrf(i, is_oce)) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3541	! BLACK CARBON EMISSIONS
3542	fluxbcbb(i) = scale_param_bb(iregion_bb(i)) * &
3543	(lmt_bcbb_l(i) + lmt_bcbb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3544	! ORGANIC MATTER EMISSIONS
3545	fluxombb(i) = scale_param_bb(iregion_bb(i)) * &
3546	(lmt_ombb_l(i) + lmt_ombb_h(i)) * 1.e4 * 1.e3 !mg/m2/s
3547	! BIOMASS BURNING EMISSIONS
3548	fluxbb(i) = fluxbcbb(i) + fluxombb(i)
3549	ENDIF
3550	! H2S EMISSIONS
3551	fluxh2sbio(i) = lmt_h2sbio(i) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3552	fluxh2snff(i) = lmt_so2nff(i) * frach2sofso2 * &
3553	1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3554	! SULFUR DIOXIDE EMISSIONS
3555	fluxso2nff(i) = fracso2emis * lmt_so2nff(i) * 1.e4 / RNAVO * &
3556	masse_s * 1.e3 ! mgS/m2/s
3557	fluxso2vol(i) = (lmt_so2volc_cont(i) + lmt_so2volc_expl(i)) &
3558	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3559	fluxso2ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 * &
3560	fracso2emis ! mgS/m2/s
3561	fluxso2(i) = fluxso2ff(i) + fluxso2bb(i) + fluxso2nff(i) + &
3562	fluxso2vol(i) + fluxso2ba(i)
3563	! DMS EMISSIONS
3564	fluxdms(i) = (lmt_dms(i) + lmt_dmsbio(i)) &
3565	* 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s
3566	! SULPHATE EMISSIONS
3567	fluxso4ba(i) = lmt_so2ba(i) * 1.e4 / RNAVO * masse_s * 1.e3 &
3568	* (1 - fracso2emis) ! mgS/m2/s
3569	fluxso4nff(i) = (1 - fracso2emis) * lmt_so2nff(i) * 1.e4 / RNAVO * &
3570	masse_s * 1.e3 ! mgS/m2/s
3571	fluxso4(i) = fluxso4ff(i) + fluxso4bb(i) + fluxso4ba(i) + fluxso4nff(i)
3572	! BLACK CARBON EMISSIONS
3573
3574	fluxbcnff(i) = lmt_bcnff(i) * 1.e4 * 1.e3 !mg/m2/s
3575	fluxbcba(i) = lmt_bcba(i) * 1.e4 * 1.e3 !mg/m2/s
3576	fluxbc(i) = fluxbcbb(i) + fluxbcff(i) + fluxbcnff(i) + fluxbcba(i)
3577	! ORGANIC MATTER EMISSIONS
3578	fluxomnat(i) = lmt_omnat(i) * 1.e4 * 1.e3 !mg/m2/s
3579	fluxomba(i) = lmt_omba(i) * 1.e4 * 1.e3 !mg/m2/s
3580	fluxomnff(i) = lmt_omnff(i) * 1.e4 * 1.e3 !mg/m2/s
3581	fluxom(i) = fluxombb(i) + fluxomff(i) + fluxomnat(i) + fluxomba(i) + &
3582	fluxomnff(i)
3583	! DUST EMISSIONS
3584	fluxdustec(i) = dust_ec(i) * 1.e6 ! old dust emission scheme
3585	!JE20140605<< old dust emission version
3586	! fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
3587	! . * dust_ec(i)0.0931.e6
3588	! fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
3589	! . * dust_ec(i)0.9051.e6
3590	! fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
3591	!JE20140605>>
3592	fluxddfine(i) = flux_sparam_ddfine(i)
3593	fluxddcoa(i) = flux_sparam_ddcoa(i)
3594	fluxddsco(i) = flux_sparam_ddsco(i)
3595	fluxdd(i) = fluxddfine(i) + fluxddcoa(i) + fluxddsco(i)
3596	! SEA SALT EMISSIONS
3597	fluxssfine(i) = scale_param_ssacc * lmt_sea_salt(i, 1) * 1.e4 * 1.e3
3598	fluxsscoa(i) = scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3
3599	fluxss(i) = fluxssfine(i) + fluxsscoa(i)
3600	ENDDO
3601
3602	! prepare outputs cvltr
3603
3604	DO itr = 1, nbtr
3605	DO k = 1, klev
3606	DO i = 1, klon
3607	tmp_var(i, k) = d_tr_cv(i, k, itr)
3608	ENDDO
3609	ENDDO
3610	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3611	DO k = 1, klev
3612	DO i = 1, klon
3613	d_tr_cv_o(i, k, itr) = tmp_var(i, k) &
3614	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3615	ENDDO
3616	ENDDO
3617	ENDDO
3618	DO itr = 1, nbtr
3619	DO k = 1, klev
3620	DO i = 1, klon
3621	tmp_var(i, k) = d_tr_trsp(i, k, itr)
3622	ENDDO
3623	ENDDO
3624	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3625	DO k = 1, klev
3626	DO i = 1, klon
3627	d_tr_trsp_o(i, k, itr) = tmp_var(i, k) &
3628	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3629	ENDDO
3630	ENDDO
3631	ENDDO
3632	DO itr = 1, nbtr
3633	DO k = 1, klev
3634	DO i = 1, klon
3635	tmp_var(i, k) = d_tr_sscav(i, k, itr)
3636	ENDDO
3637	ENDDO
3638	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3639	DO k = 1, klev
3640	DO i = 1, klon
3641	d_tr_sscav_o(i, k, itr) = tmp_var(i, k) &
3642	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3643	ENDDO
3644	ENDDO
3645	ENDDO
3646	DO itr = 1, nbtr
3647	DO k = 1, klev
3648	DO i = 1, klon
3649	tmp_var(i, k) = d_tr_sat(i, k, itr)
3650	ENDDO
3651	ENDDO
3652	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3653	DO k = 1, klev
3654	DO i = 1, klon
3655	d_tr_sat_o(i, k, itr) = tmp_var(i, k) &
3656	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3657	ENDDO
3658	ENDDO
3659	ENDDO
3660	DO itr = 1, nbtr
3661	DO k = 1, klev
3662	DO i = 1, klon
3663	tmp_var(i, k) = d_tr_uscav(i, k, itr)
3664	ENDDO
3665	ENDDO
3666	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3667	DO k = 1, klev
3668	DO i = 1, klon
3669	d_tr_uscav_o(i, k, itr) = tmp_var(i, k) &
3670	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3671	ENDDO
3672	ENDDO
3673	ENDDO
3674	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3675	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3676	DO itr = 1, nbtr
3677	DO k = 1, klev
3678	DO i = 1, klon
3679	tmp_var(i, k) = d_tr_insc(i, k, itr)
3680	ENDDO
3681	ENDDO
3682	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3683	DO k = 1, klev
3684	DO i = 1, klon
3685	d_tr_insc_o(i, k, itr) = tmp_var(i, k) &
3686	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3687	ENDDO
3688	ENDDO
3689	ENDDO
3690
3691	DO itr = 1, nbtr
3692	DO k = 1, klev
3693	DO i = 1, klon
3694	tmp_var(i, k) = d_tr_bcscav(i, k, itr)
3695	ENDDO
3696	ENDDO
3697	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3698	DO k = 1, klev
3699	DO i = 1, klon
3700	d_tr_bcscav_o(i, k, itr) = tmp_var(i, k) &
3701	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3702	ENDDO
3703	ENDDO
3704	ENDDO
3705
3706	DO itr = 1, nbtr
3707	DO k = 1, klev
3708	DO i = 1, klon
3709	tmp_var(i, k) = d_tr_evapls(i, k, itr)
3710	ENDDO
3711	ENDDO
3712	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3713	DO k = 1, klev
3714	DO i = 1, klon
3715	d_tr_evapls_o(i, k, itr) = tmp_var(i, k) &
3716	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3717	ENDDO
3718	ENDDO
3719	ENDDO
3720
3721	DO itr = 1, nbtr
3722	DO k = 1, klev
3723	DO i = 1, klon
3724	tmp_var(i, k) = d_tr_ls(i, k, itr)
3725	ENDDO
3726	ENDDO
3727	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3728	DO k = 1, klev
3729	DO i = 1, klon
3730	d_tr_ls_o(i, k, itr) = tmp_var(i, k) &
3731	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3732	ENDDO
3733	ENDDO
3734	ENDDO
3735
3736	DO itr = 1, nbtr
3737	DO k = 1, klev
3738	DO i = 1, klon
3739	tmp_var(i, k) = d_tr_dyn(i, k, itr)
3740	ENDDO
3741	ENDDO
3742	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3743	DO k = 1, klev
3744	DO i = 1, klon
3745	d_tr_dyn_o(i, k, itr) = tmp_var(i, k) &
3746	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3747	ENDDO
3748	ENDDO
3749	ENDDO
3750
3751	DO itr = 1, nbtr
3752	DO k = 1, klev
3753	DO i = 1, klon
3754	tmp_var(i, k) = d_tr_cl(i, k, itr)
3755	ENDDO
3756	ENDDO
3757	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3758	DO k = 1, klev
3759	DO i = 1, klon
3760	d_tr_cl_o(i, k, itr) = tmp_var(i, k) &
3761	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3762	ENDDO
3763	ENDDO
3764	ENDDO
3765
3766	DO itr = 1, nbtr
3767	DO k = 1, klev
3768	DO i = 1, klon
3769	tmp_var(i, k) = d_tr_th(i, k, itr)
3770	ENDDO
3771	ENDDO
3772	CALL kg_to_cm3(pplay, t_seri, tmp_var)
3773	DO k = 1, klev
3774	DO i = 1, klon
3775	d_tr_th_o(i, k, itr) = tmp_var(i, k) &
3776	/ RNAVO * masse(itr) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
3777	ENDDO
3778	ENDDO
3779	ENDDO
3780	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3781	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3782
3783	DO itr = 1, nbtr
3784	WRITE(str2, '(i2.2)') itr
3785	DO i = 1, klon
3786	his_dh(i, itr) = his_dhlsc(i, itr) + his_dhcon(i, itr) + &
3787	his_dhbclsc(i, itr) + his_dhbccon(i, itr)
3788
3789	ENDDO
3790	ENDDO
3791
3792	!AS: commenting out and deleting lines
3793	!! IF (ok_histrac) THEN
3794	!!
3795	!! SAVING VARIABLES IN TRACEUR
3796	!!----- many lines deleted----
3797	!! ENDIF ! ok_histrac
3798
3799
3800
3801
3802	!JE20141224
3803	! saving variables for output
3804	! 2D outputs
3805	DO i = 1, klon
3806	trm01(i) = 0.
3807	trm02(i) = 0.
3808	trm03(i) = 0.
3809	trm04(i) = 0.
3810	trm05(i) = 0.
3811	sconc01(i) = 0.
3812	sconc02(i) = 0.
3813	sconc03(i) = 0.
3814	sconc04(i) = 0.
3815	sconc05(i) = 0.
3816	flux01(i) = 0.
3817	flux02(i) = 0.
3818	flux03(i) = 0.
3819	flux04(i) = 0.
3820	flux05(i) = 0.
3821	ds01(i) = 0.
3822	ds02(i) = 0.
3823	ds03(i) = 0.
3824	ds04(i) = 0.
3825	ds05(i) = 0.
3826	dh01(i) = 0.
3827	dh02(i) = 0.
3828	dh03(i) = 0.
3829	dh04(i) = 0.
3830	dh05(i) = 0.
3831	dtrconv01(i) = 0.
3832	dtrconv02(i) = 0.
3833	dtrconv03(i) = 0.
3834	dtrconv04(i) = 0.
3835	dtrconv05(i) = 0.
3836	dtherm01(i) = 0.
3837	dtherm02(i) = 0.
3838	dtherm03(i) = 0.
3839	dtherm04(i) = 0.
3840	dtherm05(i) = 0.
3841	dhkecv01(i) = 0.
3842	dhkecv02(i) = 0.
3843	dhkecv03(i) = 0.
3844	dhkecv04(i) = 0.
3845	dhkecv05(i) = 0.
3846	d_tr_ds01(i) = 0.
3847	d_tr_ds02(i) = 0.
3848	d_tr_ds03(i) = 0.
3849	d_tr_ds04(i) = 0.
3850	d_tr_ds05(i) = 0.
3851	dhkelsc01(i) = 0.
3852	dhkelsc02(i) = 0.
3853	dhkelsc03(i) = 0.
3854	dhkelsc04(i) = 0.
3855	dhkelsc05(i) = 0.
3856	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3857
3858	IF(id_prec>0) trm01(i) = trm(i, id_prec)
3859	IF(id_fine>0) trm02(i) = trm(i, id_fine)
3860	IF(id_coss>0) trm03(i) = trm(i, id_coss)
3861	IF(id_codu>0) trm04(i) = trm(i, id_codu)
3862	IF(id_scdu>0) trm05(i) = trm(i, id_scdu)
3863	IF(id_prec>0) sconc01(i) = sconc_seri(i, id_prec)
3864	IF(id_fine>0) sconc02(i) = sconc_seri(i, id_fine)
3865	IF(id_coss>0) sconc03(i) = sconc_seri(i, id_coss)
3866	IF(id_codu>0) sconc04(i) = sconc_seri(i, id_codu)
3867	IF(id_scdu>0) sconc05(i) = sconc_seri(i, id_scdu)
3868	IF(id_prec>0) flux01(i) = flux_tr(i, id_prec)
3869	IF(id_fine>0) flux02(i) = flux_tr(i, id_fine)
3870	IF(id_coss>0) flux03(i) = flux_tr(i, id_coss)
3871	IF(id_codu>0) flux04(i) = flux_tr(i, id_codu)
3872	IF(id_scdu>0) flux05(i) = flux_tr(i, id_scdu)
3873	IF(id_prec>0) ds01(i) = his_ds(i, id_prec)
3874	IF(id_fine>0) ds02(i) = his_ds(i, id_fine)
3875	IF(id_coss>0) ds03(i) = his_ds(i, id_coss)
3876	IF(id_codu>0) ds04(i) = his_ds(i, id_codu)
3877	IF(id_scdu>0) ds05(i) = his_ds(i, id_scdu)
3878	IF(id_prec>0) dh01(i) = his_dh(i, id_prec)
3879	IF(id_fine>0) dh02(i) = his_dh(i, id_fine)
3880	IF(id_coss>0) dh03(i) = his_dh(i, id_coss)
3881	IF(id_codu>0) dh04(i) = his_dh(i, id_codu)
3882	IF(id_scdu>0) dh05(i) = his_dh(i, id_scdu)
3883	IF(id_prec>0) dtrconv01(i) = dtrconv(i, id_prec)
3884	IF(id_fine>0) dtrconv02(i) = dtrconv(i, id_fine)
3885	IF(id_coss>0) dtrconv03(i) = dtrconv(i, id_coss)
3886	IF(id_codu>0) dtrconv04(i) = dtrconv(i, id_codu)
3887	IF(id_scdu>0) dtrconv05(i) = dtrconv(i, id_scdu)
3888	IF(id_prec>0) dtherm01(i) = his_th(i, id_prec)
3889	IF(id_fine>0) dtherm02(i) = his_th(i, id_fine)
3890	IF(id_coss>0) dtherm03(i) = his_th(i, id_coss)
3891	IF(id_codu>0) dtherm04(i) = his_th(i, id_codu)
3892	IF(id_scdu>0) dtherm05(i) = his_th(i, id_scdu)
3893	IF(id_prec>0) dhkecv01(i) = his_dhkecv(i, id_prec)
3894	IF(id_fine>0) dhkecv02(i) = his_dhkecv(i, id_fine)
3895	IF(id_coss>0) dhkecv03(i) = his_dhkecv(i, id_coss)
3896	IF(id_codu>0) dhkecv04(i) = his_dhkecv(i, id_codu)
3897	IF(id_scdu>0) dhkecv05(i) = his_dhkecv(i, id_scdu)
3898	IF(id_prec>0) d_tr_ds01(i) = his_ds(i, id_prec)
3899	IF(id_fine>0) d_tr_ds02(i) = his_ds(i, id_fine)
3900	IF(id_coss>0) d_tr_ds03(i) = his_ds(i, id_coss)
3901	IF(id_codu>0) d_tr_ds04(i) = his_ds(i, id_codu)
3902	IF(id_scdu>0) d_tr_ds05(i) = his_ds(i, id_scdu)
3903	IF(id_prec>0) dhkelsc01(i) = his_dhkelsc(i, id_prec)
3904	IF(id_fine>0) dhkelsc02(i) = his_dhkelsc(i, id_fine)
3905	IF(id_coss>0) dhkelsc03(i) = his_dhkelsc(i, id_coss)
3906	IF(id_codu>0) dhkelsc04(i) = his_dhkelsc(i, id_codu)
3907	IF(id_scdu>0) dhkelsc05(i) = his_dhkelsc(i, id_scdu)
3908	u10m_ss(i) = u10m_ec(i)
3909	v10m_ss(i) = v10m_ec(i)
3910	ENDDO
3911	! 3D outs
3912	DO i = 1, klon
3913	DO k = 1, klev
3914	d_tr_cv01(i, k) = 0.
3915	d_tr_cv02(i, k) = 0.
3916	d_tr_cv03(i, k) = 0.
3917	d_tr_cv04(i, k) = 0.
3918	d_tr_cv05(i, k) = 0.
3919	d_tr_trsp01(i, k) = 0.
3920	d_tr_trsp02(i, k) = 0.
3921	d_tr_trsp03(i, k) = 0.
3922	d_tr_trsp04(i, k) = 0.
3923	d_tr_trsp05(i, k) = 0.
3924	d_tr_sscav01(i, k) = 0.
3925	d_tr_sscav02(i, k) = 0.
3926	d_tr_sscav03(i, k) = 0.
3927	d_tr_sscav04(i, k) = 0.
3928	d_tr_sscav05(i, k) = 0.
3929	d_tr_sat01(i, k) = 0.
3930	d_tr_sat02(i, k) = 0.
3931	d_tr_sat03(i, k) = 0.
3932	d_tr_sat04(i, k) = 0.
3933	d_tr_sat05(i, k) = 0.
3934	d_tr_uscav01(i, k) = 0.
3935	d_tr_uscav02(i, k) = 0.
3936	d_tr_uscav03(i, k) = 0.
3937	d_tr_uscav04(i, k) = 0.
3938	d_tr_uscav05(i, k) = 0.
3939	d_tr_insc01(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3940	d_tr_insc02(i, k) = 0.
3941	d_tr_insc03(i, k) = 0.
3942	d_tr_insc04(i, k) = 0.
3943	d_tr_insc05(i, k) = 0.
3944	d_tr_bcscav01(i, k) = 0.
3945	d_tr_bcscav02(i, k) = 0.
3946	d_tr_bcscav03(i, k) = 0.
3947	d_tr_bcscav04(i, k) = 0.
3948	d_tr_bcscav05(i, k) = 0.
3949	d_tr_evapls01(i, k) = 0.
3950	d_tr_evapls02(i, k) = 0.
3951	d_tr_evapls03(i, k) = 0.
3952	d_tr_evapls04(i, k) = 0.
3953	d_tr_evapls05(i, k) = 0.
3954	d_tr_ls01(i, k) = 0.
3955	d_tr_ls02(i, k) = 0.
3956	d_tr_ls03(i, k) = 0.
3957	d_tr_ls04(i, k) = 0.
3958	d_tr_ls05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3959	d_tr_dyn01(i, k) = 0.
3960	d_tr_dyn02(i, k) = 0.
3961	d_tr_dyn03(i, k) = 0.
3962	d_tr_dyn04(i, k) = 0.
3963	d_tr_dyn05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3964	d_tr_cl01(i, k) = 0.
3965	d_tr_cl02(i, k) = 0.
3966	d_tr_cl03(i, k) = 0.
3967	d_tr_cl04(i, k) = 0.
3968	d_tr_cl05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3969	d_tr_th01(i, k) = 0.
3970	d_tr_th02(i, k) = 0.
3971	d_tr_th03(i, k) = 0.
3972	d_tr_th04(i, k) = 0.
3973	d_tr_th05(i, k) = 0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3974	ENDDO
3975	ENDDO
3976
3977	IF(1==0) THEN
3978	! calcul in original trunk version; problem: budget not closed. Corrected in "ELSE"
3979	DO i = 1, klon
3980	DO k = 1, klev
3981
3982	IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv_o(i, k, id_prec)
3983	IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv_o(i, k, id_fine)
3984	IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv_o(i, k, id_coss)
3985	IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv_o(i, k, id_codu)
3986	IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv_o(i, k, id_scdu)
3987	IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp_o(i, k, id_prec)
3988	IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp_o(i, k, id_fine)
3989	IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp_o(i, k, id_coss)
3990	IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp_o(i, k, id_codu)
3991	IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp_o(i, k, id_scdu)
3992	IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav_o(i, k, id_prec)
3993	IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav_o(i, k, id_fine)
3994	IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav_o(i, k, id_coss)
3995	IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav_o(i, k, id_codu)
3996	IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav_o(i, k, id_scdu)
3997	IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat_o(i, k, id_prec)
3998	IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat_o(i, k, id_fine)
3999	IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat_o(i, k, id_coss)
4000	IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat_o(i, k, id_codu)
4001	IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat_o(i, k, id_scdu)
4002	IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav_o(i, k, id_prec)
4003	IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav_o(i, k, id_fine)
4004	IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav_o(i, k, id_coss)
4005	IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav_o(i, k, id_codu)
4006	IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav_o(i, k, id_scdu)
4007	IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc_o(i, k, id_prec)
4008	IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc_o(i, k, id_fine)
4009	IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc_o(i, k, id_coss)
4010	IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc_o(i, k, id_codu)
4011	IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc_o(i, k, id_scdu)
4012	IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav_o(i, k, id_prec)
4013	IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav_o(i, k, id_fine)
4014	IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav_o(i, k, id_coss)
4015	IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav_o(i, k, id_codu)
4016	IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav_o(i, k, id_scdu)
4017	IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls_o(i, k, id_prec)
4018	IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls_o(i, k, id_fine)
4019	IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls_o(i, k, id_coss)
4020	IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls_o(i, k, id_codu)
4021	IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls_o(i, k, id_scdu)
4022	ENDDO
4023	ENDDO
4024	ELSE ! correction pour fermeture de bilan, par FH dans les simus de Binta pour Habib
4025	DO i = 1, klon
4026	DO k = 1, klev
4027	IF(id_prec>0) d_tr_cv01(i, k) = d_tr_cv(i, k, id_prec) / pdtphys
4028	IF(id_fine>0) d_tr_cv02(i, k) = d_tr_cv(i, k, id_fine) / pdtphys
4029	IF(id_coss>0) d_tr_cv03(i, k) = d_tr_cv(i, k, id_coss) / pdtphys
4030	IF(id_codu>0) d_tr_cv04(i, k) = d_tr_cv(i, k, id_codu) / pdtphys
4031	IF(id_scdu>0) d_tr_cv05(i, k) = d_tr_cv(i, k, id_scdu) / pdtphys
4032	IF(id_prec>0) d_tr_trsp01(i, k) = d_tr_trsp(i, k, id_prec) / pdtphys
4033	IF(id_fine>0) d_tr_trsp02(i, k) = d_tr_trsp(i, k, id_fine) / pdtphys
4034	IF(id_coss>0) d_tr_trsp03(i, k) = d_tr_trsp(i, k, id_coss) / pdtphys
4035	IF(id_codu>0) d_tr_trsp04(i, k) = d_tr_trsp(i, k, id_codu) / pdtphys
4036	IF(id_scdu>0) d_tr_trsp05(i, k) = d_tr_trsp(i, k, id_scdu) / pdtphys
4037	IF(id_prec>0) d_tr_sscav01(i, k) = d_tr_sscav(i, k, id_prec) / pdtphys
4038	IF(id_fine>0) d_tr_sscav02(i, k) = d_tr_sscav(i, k, id_fine) / pdtphys
4039	IF(id_coss>0) d_tr_sscav03(i, k) = d_tr_sscav(i, k, id_coss) / pdtphys
4040	IF(id_codu>0) d_tr_sscav04(i, k) = d_tr_sscav(i, k, id_codu) / pdtphys
4041	IF(id_scdu>0) d_tr_sscav05(i, k) = d_tr_sscav(i, k, id_scdu) / pdtphys
4042	IF(id_prec>0) d_tr_sat01(i, k) = d_tr_sat(i, k, id_prec) / pdtphys
4043	IF(id_fine>0) d_tr_sat02(i, k) = d_tr_sat(i, k, id_fine) / pdtphys
4044	IF(id_coss>0) d_tr_sat03(i, k) = d_tr_sat(i, k, id_coss) / pdtphys
4045	IF(id_codu>0) d_tr_sat04(i, k) = d_tr_sat(i, k, id_codu) / pdtphys
4046	IF(id_scdu>0) d_tr_sat05(i, k) = d_tr_sat(i, k, id_scdu) / pdtphys
4047	IF(id_prec>0) d_tr_uscav01(i, k) = d_tr_uscav(i, k, id_prec) / pdtphys
4048	IF(id_fine>0) d_tr_uscav02(i, k) = d_tr_uscav(i, k, id_fine) / pdtphys
4049	IF(id_coss>0) d_tr_uscav03(i, k) = d_tr_uscav(i, k, id_coss) / pdtphys
4050	IF(id_codu>0) d_tr_uscav04(i, k) = d_tr_uscav(i, k, id_codu) / pdtphys
4051	IF(id_scdu>0) d_tr_uscav05(i, k) = d_tr_uscav(i, k, id_scdu) / pdtphys
4052	IF(id_prec>0) d_tr_insc01(i, k) = d_tr_insc(i, k, id_prec) / pdtphys
4053	IF(id_fine>0) d_tr_insc02(i, k) = d_tr_insc(i, k, id_fine) / pdtphys
4054	IF(id_coss>0) d_tr_insc03(i, k) = d_tr_insc(i, k, id_coss) / pdtphys
4055	IF(id_codu>0) d_tr_insc04(i, k) = d_tr_insc(i, k, id_codu) / pdtphys
4056	IF(id_scdu>0) d_tr_insc05(i, k) = d_tr_insc(i, k, id_scdu) / pdtphys
4057	IF(id_prec>0) d_tr_bcscav01(i, k) = d_tr_bcscav(i, k, id_prec) / pdtphys
4058	IF(id_fine>0) d_tr_bcscav02(i, k) = d_tr_bcscav(i, k, id_fine) / pdtphys
4059	IF(id_coss>0) d_tr_bcscav03(i, k) = d_tr_bcscav(i, k, id_coss) / pdtphys
4060	IF(id_codu>0) d_tr_bcscav04(i, k) = d_tr_bcscav(i, k, id_codu) / pdtphys
4061	IF(id_scdu>0) d_tr_bcscav05(i, k) = d_tr_bcscav(i, k, id_scdu) / pdtphys
4062	IF(id_prec>0) d_tr_evapls01(i, k) = d_tr_evapls(i, k, id_prec) / pdtphys
4063	IF(id_fine>0) d_tr_evapls02(i, k) = d_tr_evapls(i, k, id_fine) / pdtphys
4064	IF(id_coss>0) d_tr_evapls03(i, k) = d_tr_evapls(i, k, id_coss) / pdtphys
4065	IF(id_codu>0) d_tr_evapls04(i, k) = d_tr_evapls(i, k, id_codu) / pdtphys
4066	IF(id_scdu>0) d_tr_evapls05(i, k) = d_tr_evapls(i, k, id_scdu) / pdtphys
4067	ENDDO
4068	ENDDO
4069	ENDIF
4070
4071	IF(1==0) THEN ! This "if" is as in original trunk
4072	DO i = 1, klon
4073	DO k = 1, klev
4074	IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls_o(i, k, id_prec)
4075	IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls_o(i, k, id_fine)
4076	IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls_o(i, k, id_coss)
4077	IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls_o(i, k, id_codu)
4078	IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls_o(i, k, id_scdu)
4079	IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn_o(i, k, id_prec)
4080	IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn_o(i, k, id_fine)
4081	IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn_o(i, k, id_coss)
4082	IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn_o(i, k, id_codu)
4083	IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn_o(i, k, id_scdu)
4084	IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl_o(i, k, id_prec)
4085	IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl_o(i, k, id_fine)
4086	IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl_o(i, k, id_coss)
4087	IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl_o(i, k, id_codu)
4088	IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl_o(i, k, id_scdu)
4089	IF(id_prec>0) d_tr_th01(i, k) = d_tr_th_o(i, k, id_prec)
4090	IF(id_fine>0) d_tr_th02(i, k) = d_tr_th_o(i, k, id_fine)
4091	IF(id_coss>0) d_tr_th03(i, k) = d_tr_th_o(i, k, id_coss)
4092	IF(id_codu>0) d_tr_th04(i, k) = d_tr_th_o(i, k, id_codu)
4093	IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th_o(i, k, id_scdu)
4094	ENDDO
4095	ENDDO
4096	ELSE
4097	DO i = 1, klon
4098	DO k = 1, klev
4099	IF(id_prec>0) d_tr_ls01(i, k) = d_tr_ls(i, k, id_prec) / pdtphys
4100	IF(id_fine>0) d_tr_ls02(i, k) = d_tr_ls(i, k, id_fine) / pdtphys
4101	IF(id_coss>0) d_tr_ls03(i, k) = d_tr_ls(i, k, id_coss) / pdtphys
4102	IF(id_codu>0) d_tr_ls04(i, k) = d_tr_ls(i, k, id_codu) / pdtphys
4103	IF(id_scdu>0) d_tr_ls05(i, k) = d_tr_ls(i, k, id_scdu) / pdtphys
4104	IF(id_prec>0) d_tr_dyn01(i, k) = d_tr_dyn(i, k, id_prec) / pdtphys
4105	IF(id_fine>0) d_tr_dyn02(i, k) = d_tr_dyn(i, k, id_fine) / pdtphys
4106	IF(id_coss>0) d_tr_dyn03(i, k) = d_tr_dyn(i, k, id_coss) / pdtphys
4107	IF(id_codu>0) d_tr_dyn04(i, k) = d_tr_dyn(i, k, id_codu) / pdtphys
4108	IF(id_scdu>0) d_tr_dyn05(i, k) = d_tr_dyn(i, k, id_scdu) / pdtphys
4109	IF(id_prec>0) d_tr_cl01(i, k) = d_tr_cl(i, k, id_prec) / pdtphys
4110	IF(id_fine>0) d_tr_cl02(i, k) = d_tr_cl(i, k, id_fine) / pdtphys
4111	IF(id_coss>0) d_tr_cl03(i, k) = d_tr_cl(i, k, id_coss) / pdtphys
4112	IF(id_codu>0) d_tr_cl04(i, k) = d_tr_cl(i, k, id_codu) / pdtphys
4113	IF(id_scdu>0) d_tr_cl05(i, k) = d_tr_cl(i, k, id_scdu) / pdtphys
4114	IF(id_prec>0) d_tr_th01(i, k) = d_tr_th(i, k, id_prec) / pdtphys
4115	IF(id_fine>0) d_tr_th02(i, k) = d_tr_th(i, k, id_fine) / pdtphys
4116	IF(id_coss>0) d_tr_th03(i, k) = d_tr_th(i, k, id_coss) / pdtphys
4117	IF(id_codu>0) d_tr_th04(i, k) = d_tr_th(i, k, id_codu) / pdtphys
4118	IF(id_scdu>0) d_tr_th05(i, k) = d_tr_th(i, k, id_scdu) / pdtphys
4119	ENDDO
4120	ENDDO
4121	ENDIF
4122
4123	IF (logitime) THEN
4124	CALL SYSTEM_CLOCK(COUNT = clock_end)
4125
4126	dife = clock_end - clock_start
4127	ti_outs = dife * MAX(0, SIGN(1, dife)) &
4128	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4129	tia_outs = tia_outs + REAL(ti_outs) / REAL(clock_rate)
4130	ENDIF
4131
4132	IF (logitime) THEN
4133	CALL SYSTEM_CLOCK(COUNT = clock_end)
4134
4135	dife = clock_end - clock_start_spla
4136	ti_spla = dife * MAX(0, SIGN(1, dife)) &
4137	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4138
4139	tia_spla = tia_spla + REAL(ti_spla) / REAL(clock_rate)
4140	PRINT *, 'times for this timestep:timeproc,timeproc/time_pytracr_spl-'
4141	PRINT *, 'time spla', REAL(ti_spla) / REAL(clock_rate) &
4142	, REAL(ti_spla) / REAL(ti_spla)
4143	PRINT *, 'time init', REAL(ti_init) / REAL(clock_rate) &
4144	, REAL(ti_init) / REAL(ti_spla)
4145	PRINT *, 'time inittype', REAL(ti_inittype) / REAL(clock_rate) &
4146	, REAL(ti_inittype) / REAL(ti_spla)
4147	PRINT *, 'time inittwrite', REAL(ti_inittwrite) / REAL(clock_rate) &
4148	, REAL(ti_inittwrite) / REAL(ti_spla)
4149	PRINT *, 'time emis', REAL(ti_emis) / REAL(clock_rate) &
4150	, REAL(ti_emis) / REAL(ti_spla)
4151	PRINT *, 'time depo ', REAL(ti_depo) / REAL(clock_rate) &
4152	, REAL(ti_depo) / REAL(ti_spla)
4153	PRINT *, 'time cltr', REAL(ti_cltr) / REAL(clock_rate) &
4154	, REAL(ti_cltr) / REAL(ti_spla)
4155	PRINT *, 'time ther', REAL(ti_ther) / REAL(clock_rate) &
4156	, REAL(ti_ther) / REAL(ti_spla)
4157	PRINT *, 'time sedi', REAL(ti_sedi) / REAL(clock_rate) &
4158	, REAL(ti_sedi) / REAL(ti_spla)
4159	PRINT *, 'time gas to part', REAL(ti_gasp) / REAL(clock_rate) &
4160	, REAL(ti_gasp) / REAL(ti_spla)
4161	PRINT *, 'time AP wet', REAL(ti_wetap) / REAL(clock_rate) &
4162	, REAL(ti_wetap) / REAL(ti_spla)
4163	PRINT *, 'time convective', REAL(ti_cvltr) / REAL(clock_rate) &
4164	, REAL(ti_cvltr) / REAL(ti_spla)
4165	PRINT *, 'time NP lsc scav', REAL(ti_lscs) / REAL(clock_rate) &
4166	, REAL(ti_lscs) / REAL(ti_spla)
4167	PRINT *, 'time opt,brdn,etc', REAL(ti_brop) / REAL(clock_rate) &
4168	, REAL(ti_brop) / REAL(ti_spla)
4169	PRINT *, 'time outputs', REAL(ti_outs) / REAL(clock_rate) &
4170	, REAL(ti_outs) / REAL(ti_spla)
4171
4172	PRINT *, '--time accumulated: time proc, time proc/time phytracr_spl--'
4173	PRINT *, 'time spla', tia_spla
4174	PRINT *, 'time init', tia_init, tia_init / tia_spla
4175	PRINT *, 'time inittype', tia_inittype, tia_inittype / tia_spla
4176	PRINT *, 'time inittwrite', tia_inittwrite, tia_inittwrite / tia_spla
4177	PRINT *, 'time emis', tia_emis, tia_emis / tia_spla
4178	PRINT *, 'time depo', tia_depo, tia_depo / tia_spla
4179	PRINT *, 'time cltr', tia_cltr, tia_cltr / tia_spla
4180	PRINT *, 'time ther', tia_ther, tia_ther / tia_spla
4181	PRINT *, 'time sedi', tia_sedi, tia_sedi / tia_spla
4182	PRINT *, 'time gas to part', tia_gasp, tia_gasp / tia_spla
4183	PRINT *, 'time AP wet', tia_wetap, tia_wetap / tia_spla
4184	PRINT *, 'time convective', tia_cvltr, tia_cvltr / tia_spla
4185	PRINT *, 'time NP lsc scav', tia_lscs, tia_lscs / tia_spla
4186	PRINT *, 'time opt,brdn,etc', tia_brop, tia_brop / tia_spla
4187	PRINT *, 'time outputs', tia_outs, tia_outs / tia_spla
4188
4189	dife = clock_end_outphytracr - clock_start_outphytracr
4190	ti_nophytracr = dife * MAX(0, SIGN(1, dife)) &
4191	+ (dife + clock_per_max) * MAX(0, SIGN(1, -dife))
4192	tia_nophytracr = tia_nophytracr + REAL(ti_nophytracr) / REAL(clock_rate)
4193	PRINT *, 'Time outside phytracr; Time accum outside phytracr'
4194	PRINT*, REAL(ti_nophytracr) / REAL(clock_rate), tia_nophytracr
4195
4196	clock_start_outphytracr = clock_end
4197
4198	ENDIF
4199	PRINT *, 'END PHYTRACR_SPL '
4200	PRINT *, 'lmt_so2ff_l FIN', MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l)
4201
4202	! CALL abort_gcm('TEST1', 'OK1', 1)
4203
4204	END SUBROUTINE phytracr_spl
4205
4206	SUBROUTINE readregionsdims2_spl(nbreg, fileregions)
4207
4208	USE lmdz_grid_phy
4209	USE lmdz_phys_para
4210
4211	IMPLICIT NONE
4212	CHARACTER*800 fileregions
4213	CHARACTER*800 auxstr
4214	INTEGER nbreg
4215
4216	IF (is_mpi_root .AND. is_omp_root) THEN
4217
4218	OPEN (UNIT = 1, FILE = trim(adjustl(fileregions)))
4219	READ(1, '(a)') auxstr
4220	READ(1, '(i10)') nbreg
4221	CLOSE(UNIT = 1)
4222	ENDIF
4223	CALL bcast(nbreg)
4224
4225	END SUBROUTINE readregionsdims2_spl
4226
4227	SUBROUTINE readregionsdims_spl(nbreg_ind, fileregionsdimsind, &
4228	nbreg_dust, fileregionsdimsdust, &
4229	nbreg_bb, fileregionsdimsbb)
4230	USE lmdz_grid_phy
4231	USE lmdz_phys_para
4232
4233	IMPLICIT NONE
4234	CHARACTER*800 fileregionsdimsind
4235	CHARACTER*800 fileregionsdimsdust
4236	CHARACTER*800 fileregionsdimsbb
4237	CHARACTER*800 auxstr
4238	INTEGER nbreg_ind, nbreg_dust, nbreg_bb
4239
4240	IF (is_mpi_root .AND. is_omp_root) THEN
4241
4242	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsind)))
4243	READ(1, '(a)') auxstr
4244	READ(1, '(i10)') nbreg_ind
4245	CLOSE(UNIT = 1)
4246
4247	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsdust)))
4248	READ(1, '(a)') auxstr
4249	READ(1, '(i10)') nbreg_dust
4250	CLOSE(UNIT = 1)
4251
4252	OPEN (UNIT = 1, FILE = trim(adjustl(fileregionsdimsbb)))
4253	READ(1, '(a)') auxstr
4254	READ(1, '(i10)') nbreg_bb
4255	CLOSE(UNIT = 1)
4256
4257	ENDIF
4258	CALL bcast(nbreg_ind)
4259	CALL bcast(nbreg_dust)
4260	CALL bcast(nbreg_bb)
4261
4262	END SUBROUTINE readregionsdims_spl
4263
4264	SUBROUTINE readregions_spl(iregion, filenameregion)
4265	USE dimphy
4266	USE lmdz_grid_phy
4267	USE lmdz_phys_para
4268
4269	IMPLICIT NONE
4270	CHARACTER() filenameregion
4271	INTEGER iregion(klon)
4272	INTEGER iregion_glo(klon_glo)
4273	INTEGER k
4274
4275	IF (is_mpi_root .AND. is_omp_root) THEN
4276
4277	PRINT *, trim(adjustl(filenameregion))
4278	OPEN(1, file = trim(adjustl(filenameregion)))
4279	DO k = 1, klon_glo
4280	READ(1, '(i10)') iregion_glo(k)
4281	ENDDO
4282	CLOSE(UNIT = 1)
4283	ENDIF
4284	CALL scatter(iregion_glo, iregion)
4285
4286	END SUBROUTINE readregions_spl
4287
4288	!! AS: SUBROUTINE readscaleparams_spl pas appellee
4289	SUBROUTINE readscaleparams_spl(scale_param, nbreg, &
4290	filescaleparams)
4291	USE lmdz_grid_phy
4292	USE lmdz_phys_para
4293	IMPLICIT NONE
4294
4295	CHARACTER*800 filescaleparams
4296	INTEGER nbreg
4297	REAL scale_param(nbreg)
4298	INTEGER k
4299
4300	IF (is_mpi_root .AND. is_omp_root) THEN
4301	OPEN(1, file = trim(adjustl(filescaleparams)), form = 'unformatted')
4302	DO k = 1, nbreg
4303	read(1) scale_param(k)
4304	enddo
4305	CLOSE(1)
4306	ENDIF
4307	CALL bcast(scale_param)
4308	! PRINT *,'holaaaaaaaaaaaa'
4309	! PRINT *,scale_param
4310
4311	END SUBROUTINE readscaleparams_spl
4312
4313	SUBROUTINE readscaleparamsnc_spl(scale_param_ind, &
4314	nbreg_ind, paramname_ind, &
4315	scale_param_ff, nbreg_ff, paramname_ff, &
4316	scale_param_bb, nbreg_bb, paramname_bb, &
4317	scale_param_dustacc, nbreg_dustacc, paramname_dustacc, &
4318	scale_param_dustcoa, nbreg_dustcoa, paramname_dustcoa, &
4319	scale_param_dustsco, nbreg_dustsco, paramname_dustsco, &
4320	param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL, &
4321	param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, &
4322	scale_param_ssacc, paramname_ssacc, &
4323	scale_param_sscoa, paramname_sscoa, &
4324	filescaleparams, julien, jH_phys, pdtphys, debutphy)
4325	! SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, &
4326	! filescaleparams,paramname,&
4327	! julien,jH_phys, pdtphys,debutphy)
4328	USE lmdz_grid_phy
4329	USE lmdz_phys_para
4330	IMPLICIT NONE
4331
4332	CHARACTER*800 filescaleparams
4333	CHARACTER*100 paramname_ind, paramname_ff, paramname_bb
4334	CHARACTER*100 paramname_dustacc, paramname_dustcoa
4335	CHARACTER*100 paramname_dustsco
4336	CHARACTER*100 paramname_ssacc
4337	CHARACTER*100 paramname_sscoa
4338	CHARACTER*100 paramname_wstarBL
4339	CHARACTER*100 paramname_wstarWAKE
4340
4341	INTEGER nbreg, iday
4342	INTEGER nbreg_ind, nbreg_ff, nbreg_bb, nbreg_dustacc
4343	INTEGER nbreg_dustcoa, nbreg_dustsco, nbreg_wstardustBL
4344	INTEGER nbreg_wstardustWAKE
4345	INTEGER, PARAMETER :: nbreg_ssacc = 1
4346	INTEGER, PARAMETER :: nbreg_sscoa = 1
4347	REAL, PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours
4348	REAL scale_param_ind(nbreg_ind)
4349	REAL scale_param_bb(nbreg_bb)
4350	REAL scale_param_ff(nbreg_ff)
4351	REAL scale_param_dustacc(nbreg_dustacc)
4352	REAL scale_param_dustcoa(nbreg_dustcoa)
4353	REAL scale_param_dustsco(nbreg_dustsco)
4354	REAL param_wstarBLperregion(nbreg_wstardustBL)
4355	REAL param_wstarWAKEperregion(nbreg_wstardustWAKE)
4356	REAL scale_param_ssacc
4357	REAL scale_param_ssacc_tmp(nbreg_ssacc)
4358	REAL scale_param_sscoa
4359	REAL scale_param_sscoa_tmp(nbreg_sscoa)
4360
4361	INTEGER k, step_sca, test_sca
4362	REAL :: jH_phys, pdtphys
4363	REAL, SAVE :: jH_sca, jH_ini
4364	INTEGER julien
4365	LOGICAL debutphy
4366	SAVE step_sca, test_sca, iday
4367	!$OMP THREADPRIVATE(step_sca,test_sca,iday)
4368	!$OMP THREADPRIVATE(jH_sca,jH_ini)
4369
4370	IF (debutphy) THEN
4371	iday = julien
4372	step_sca = 1
4373	test_sca = 0
4374	jH_ini = jH_phys
4375	jH_sca = jH_phys
4376	ENDIF
4377
4378	IF (test_sca == 0) THEN
4379	! READ file!!
4380	CALL read_scalenc(filescaleparams, paramname_ind, &
4381	nbreg_ind, step_sca, &
4382	scale_param_ind)
4383	CALL read_scalenc(filescaleparams, paramname_bb, &
4384	nbreg_bb, step_sca, &
4385	scale_param_bb)
4386	CALL read_scalenc(filescaleparams, paramname_ff, &
4387	nbreg_ff, step_sca, &
4388	scale_param_ff)
4389	CALL read_scalenc(filescaleparams, paramname_dustacc, &
4390	nbreg_dustacc, step_sca, &
4391	scale_param_dustacc)
4392	CALL read_scalenc(filescaleparams, paramname_dustcoa, &
4393	nbreg_dustcoa, step_sca, &
4394	scale_param_dustcoa)
4395	CALL read_scalenc(filescaleparams, paramname_dustsco, &
4396	nbreg_dustsco, step_sca, &
4397	scale_param_dustsco)
4398	CALL read_scalenc(filescaleparams, paramname_wstarBL, &
4399	nbreg_wstardustBL, step_sca, &
4400	param_wstarBLperregion)
4401	CALL read_scalenc(filescaleparams, paramname_wstarWAKE, &
4402	nbreg_wstardustWAKE, step_sca, &
4403	param_wstarWAKEperregion)
4404	CALL read_scalenc(filescaleparams, paramname_ssacc, &
4405	nbreg_ssacc, step_sca, &
4406	scale_param_ssacc_tmp)
4407	CALL read_scalenc(filescaleparams, paramname_sscoa, &
4408	nbreg_sscoa, step_sca, &
4409	scale_param_sscoa_tmp)
4410	scale_param_ssacc = scale_param_ssacc_tmp(1)
4411	scale_param_sscoa = scale_param_sscoa_tmp(1)
4412
4413	!PRINT *,'JEREADFILE',julien,jH_phys
4414	step_sca = step_sca + 1
4415	test_sca = 1
4416	ENDIF
4417
4418	jH_sca = jH_sca + pdtphys / (24. * 3600.)
4419	IF (jH_sca>(sca_resol) / 24.) THEN
4420	test_sca = 0
4421	jH_sca = jH_ini
4422	ENDIF
4423
4424	END SUBROUTINE readscaleparamsnc_spl
4425
4426	SUBROUTINE read_scalenc(filescaleparams, paramname, nbreg, step_sca, &
4427	scale_param)
4428
4429	USE lmdz_grid_phy
4430	USE lmdz_phys_para
4431	USE netcdf, ONLY: nf90_open, nf90_close, nf90_inq_varid, nf90_nowrite, nf90_noerr, nf90_get_var
4432	IMPLICIT NONE
4433
4434	CHARACTER*800 filescaleparams
4435	CHARACTER*100 paramname
4436	INTEGER nbreg, step_sca
4437	REAL scale_param(nbreg)
4438	!local vars
4439	INTEGER nid, ierr, nvarid
4440	REAL rcode, auxreal
4441	INTEGER start(4), count(4), status
4442	! local
4443	CHARACTER*104 varname
4444	CHARACTER*2 aux_2s
4445	INTEGER i, j, ig
4446	!$OMP MASTER
4447	IF (is_mpi_root .AND. is_omp_root) THEN
4448	ierr = nf90_open(trim(adjustl(filescaleparams)), nf90_nowrite, nid)
4449	IF (ierr == nf90_noerr) THEN
4450	DO i = 1, nbreg
4451	WRITE(aux_2s, '(i2.2)') i
4452	varname = trim(adjustl(paramname)) // aux_2s
4453	PRINT *, varname
4454	ierr = nf90_inq_varid(nid, trim(adjustl(varname)), nvarid)
4455	ierr = nf90_get_var(nid, nvarid, auxreal, [step_sca])
4456	IF (ierr /= nf90_noerr) THEN
4457	PRINT*, 'Pb de lecture pour modvalues'
4458	PRINT *, 'JE scale_var, step_sca', trim(adjustl(varname)), step_sca
4459	CALL HANDLE_ERR(ierr)
4460	PRINT *, 'error ierr= ', ierr
4461	CALL exit(1)
4462	CALL abort_gcm('read_scalenc', 'error reading variable', 1)
4463	ENDIF
4464
4465	PRINT *, auxreal
4466	scale_param(i) = auxreal
4467	enddo
4468
4469	ierr = nf90_close(nid)
4470	else
4471	PRINT *, 'File ' // trim(adjustl(filescaleparams)) // ' not found'
4472	PRINT *, 'doing nothing...'
4473	endif
4474
4475	ENDIF ! mpi_root
4476	!$OMP END MASTER
4477	!$OMP BARRIER
4478	! CALL scatter(var local _glo,var local) o algo asi
4479	CALL bcast(scale_param)
4480	END SUBROUTINE read_scalenc
4481
4482
4483	END MODULE lmdz_phytracr_spl

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

Download in other formats:

Original Format