Context Navigation

phytracr_spl_mod.F90 @ 5418

Last change on this file since 5418 was 5337, checked in by Laurent Fairhead, 4 weeks ago
Getting rid of dependance to dynamics
File size: 174.9 KB

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

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

Download in other formats:

Original Format