Context Navigation

phytracr_spl_mod.F90 @ 4071

Last change on this file since 4071 was 4071, checked in by dcugnet, 2 years ago

Fix for unadvected tracers (iadv==0)
The key %isH2Ofamily, from the derived type "trac_type", is replaced with the more general

key %isInPhysics, which is TRUE for tracers both in "qx" and "tr_seri".

Currently, FALSE for tracers descending on H2O (isotopes and tagging tracers included). Could be set to FALSE
for interactive CO2 (type_trac=='inco') or ice supersaturated cloud content (tranfered to "rneb_seri")

Parser routines taken from version 10 of https://svn.lmd.jussieu.fr/tracers-parser

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

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

Download in other formats:

Original Format