Context Navigation

phytracr_spl_mod.F90 @ 2217

Last change on this file since 2217 was 2217, checked in by jescribano, 9 years ago
Bugs corrections. Included a correction/tunning factor for the Chimere-dust emissions, Constant of MB95 equal to 2.61 as in MB95. No spurious increase of u* before horizontal flux calculations in the dust emission scheme. Values of AG00 binding energies fixed as the original AG00 divided by 3 as is Sow et al 2011 ACPD.
File size: 205.4 KB

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

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

Download in other formats:

Original Format