Context Navigation

phytracr_spl_mod.F90 @ 4058

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

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

Download in other formats:

Original Format