Context Navigation

phytracr_spl_mod.F90 @ 2175

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

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

Download in other formats:

Original Format