Context Navigation

phytracr_spl.F_20140506_seq @ 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: 106.8 KB

Line
1	SUBROUTINE phytracr_spl ( debutphy, iflag_conv,
2	I pdtphys,ftsol,tsol,
3	I t_seri,q_seri,paprs,pplay,RHcl,
4	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
5	I coefh, cdragh, cdragm, yu1, yv1,
6	I u_seri, v_seri, xlat,xlon,
7	I pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,
8	I da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,
9	I epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,
10	I evap,wdtrainA, wdtrainM,wght_cvfd,
11	I fm_therm, entr_therm, rneb,
12	I beta_fisrt,beta_v1,
13	P scale_param_ssacc,
14	P scale_param_sscoa,scale_param_ind,
15	P scale_param_bb,scale_param_ff,
16	P scale_param_dustacc,scale_param_dustcoa,
17	E dust_ec,u10m_ec,v10m_ec,
18	E lmt_sea_salt,
19	E lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba,
20	E lmt_so2bb_l, lmt_so2bb_h,
21	E lmt_so2volc_cont,lmt_altvolc_cont,
22	E lmt_so2volc_expl,lmt_altvolc_expl,
23	E lmt_dmsbio,lmt_h2sbio,lmt_dmsconc,
24	E lmt_bcff,lmt_bcnff,lmt_bcbb_l,lmt_bcbb_h,
25	E lmt_bcba,lmt_omff,lmt_omnff,lmt_ombb_l,
26	E lmt_ombb_h,lmt_omnat,lmt_omba,
27	O tr_seri,
28	O diff_aod550_tot,diag_aod865_tot,
29	O diff_aod550_tr2,diag_aod865_tr2,
30	O diag_aod550_dust,diag_aod865_dust,
31	O diag_aod550_ss,diag_aod865_ss)
32	! E wth,cly,zprecipinsoil,lmt_sea_salt, ! Titane
33	c
34	USE IOIPSL
35	USE dimphy
36	USE infotrac
37	USE indice_sol_mod
38	c
39	IMPLICIT none
40	c
41	c======================================================================
42	c Auteur(s) FH
43	c Objet: Moniteur general des tendances traceurs
44	c
45	c Remarques en vrac:
46	c ------------------
47	c 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien
48	c les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
49	c======================================================================
50	#include "dimensions.h"
51	#include "chem.h"
52	#include "../phylmd/YOMCST.h"
53	#include "../phylmd/YOETHF.h"
54	c #include "../phylmd/dimphy.h"
55	c #include "../phylmd/indicesol.h"
56	#include "paramet.h"
57	#include "thermcell.h"
58
59	c======================================================================
60
61	c Arguments:
62	c
63	c EN ENTREE:
64	c ==========
65	c
66	c divers:
67	c -------
68	c
69	real pdtphys ! pas d'integration pour la physique (seconde)
70	real ftsol(klon,nbsrf) ! temperature du sol par type
71	real tsol(klon) ! temperature du sol moyenne
72	real t_seri(klon,klev) ! temperature
73	real u_seri(klon,klev) ! vent
74	real v_seri(klon,klev) ! vent
75	real q_seri(klon,klev) ! vapeur d eau kg/kg
76	real tr_seri(klon,klev,nbtr) ! traceur
77	real tmp_var(klon,klev) ! auxiliary variable to replace traceur
78	real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
79	real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D
80	real dummy1d ! JE auxiliary variable
81	real aux_var2(klon) ! auxiliary variable to replace traceur
82	real aux_var3(klon,klev) ! auxiliary variable to replace traceur
83	real d_tr(klon,klev,nbtr) ! traceur tendance
84	real sconc_seri(klon,nbtr) ! surface concentration of traceur
85	c
86	integer nbjour
87	save nbjour
88	c
89	REAL diff_aod550_tot(klon) ! epaisseur optique total aerosol 550 nm
90	REAL diag_aod670_tot(klon) ! epaisseur optique total aerosol 670 nm
91	REAL diag_aod865_tot(klon) ! epaisseur optique total aerosol 865 nm
92	REAL diff_aod550_tr2(klon) ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic
93	REAL diag_aod670_tr2(klon) ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic
94	REAL diag_aod865_tr2(klon) ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic
95	REAL diag_aod550_ss(klon) ! epaisseur optique Sels marins aerosol 550 nm, diagnostic
96	REAL diag_aod670_ss(klon) ! epaisseur optique Sels marins aerosol 670 nm, diagnostic
97	REAL diag_aod865_ss(klon) ! epaisseur optique Sels marins aerosol 865 nm, diagnostic
98	REAL diag_aod550_dust(klon) ! epaisseur optique Dust aerosol 550 nm, diagnostic
99	REAL diag_aod670_dust(klon) ! epaisseur optique Dust aerosol 670 nm, diagnostic
100	REAL diag_aod865_dust(klon) ! epaisseur optique Dust aerosol 865 nm, diagnostic
101	c
102	real paprs(klon,klev+1) ! pression pour chaque inter-couche (en Pa)
103	real pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa)
104	real RHcl(klon,klev) ! humidite relativen ciel clair
105	real znivsig(klev) ! indice des couches
106	real paire(klon)
107	real pphis(klon)
108	real pctsrf(klon,nbsrf)
109	logical debutphy ! le flag de l'initialisation de la physique
110	c
111	c Scaling Parameters:
112	c ----------------------
113	c
114	CHARACTER*33 c_Directory
115	CHARACTER*33 c_FileName1
116	CHARACTER*42 c_FileName2
117	CHARACTER*71 c_FullName1
118	CHARACTER*77 c_FullName2
119	INTEGER :: xidx, yidx
120	INTEGER,DIMENSION(klon) :: mask_bbreg
121	INTEGER,DIMENSION(klon) :: mask_ffso2reg
122	INTEGER :: aux_mask1
123	INTEGER :: aux_mask2
124
125	INTEGER iregion_so4(klon) !Defines regions for SO4
126	INTEGER iregion_ind(klon) !Defines regions for SO2, BC & OM
127	INTEGER iregion_bb(klon) !Defines regions for SO2, BC & OM
128	INTEGER iregion_dust(klon) !Defines dust regions
129	c REAL scale_param_sulf(jjm+1) !Scaling parameter for sulfate (input)
130	c REAL scale_param_so4(klon) !Scaling parameter for sulfate used whithin phytrac
131	REAL scale_param_ssacc !Scaling parameter for Fine Sea Salt
132	REAL scale_param_sscoa !Scaling parameter for Coarse Sea Salt
133	REAL scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissionsi of SO2
134	REAL scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning (SO2, BC & OM)
135	REAL scale_param_ff(nbreg_ind) !Scaling parameter for industrial emissions (fossil fuel)
136	REAL scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust
137	REAL scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust
138	c
139	c Emissions:
140	c ---------
141	c
142	c---------------------------- SEA SALT & DUST emissions ------------------------
143	REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
144	REAL u10m_ec1(klon),v10m_ec1(klon)
145	REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon)
146	REAL dust_ec(klon)
147	! REAL cly(klon),wth(klon),zprecipinsoil(klon) ! Titane
148	c------------------------- SULFUR emissions ----------------------------
149	REAL lmt_so2volc_cont(klon) ! emissions so2 volcan (continuous)
150	REAL lmt_altvolc_cont(klon) ! altitude so2 volcan (continuous)
151	REAL lmt_so2volc_expl(klon) ! emissions so2 volcan (explosive)
152	REAL lmt_altvolc_expl(klon) ! altitude so2 volcan (explosive)
153	REAL lmt_so2ff_l(klon) ! emissions so2 fossil fuel (low)
154	REAL lmt_so2ff_h(klon) ! emissions so2 fossil fuel (high)
155	REAL lmt_so2nff(klon) ! emissions so2 non-fossil fuel
156	REAL lmt_so2bb_l(klon) ! emissions de so2 biomass burning (low)
157	REAL lmt_so2bb_h(klon) ! emissions de so2 biomass burning (high)
158	REAL lmt_so2ba(klon) ! emissions de so2 bateau
159	REAL lmt_dms(klon) ! emissions de dms
160	REAL lmt_dmsconc(klon) ! concentration de dms oceanique
161	REAL lmt_dmsbio(klon) ! emissions de dms bio
162	REAL lmt_h2sbio(klon) ! emissions de h2s bio
163	c------------------------- BLACK CARBON emissions ----------------------
164	REAL lmt_bcff(klon) ! emissions de BC fossil fuels
165	REAL lmt_bcnff(klon) ! emissions de BC non-fossil fuels
166	REAL lmt_bcbb_l(klon) ! emissions de BC biomass basses
167	REAL lmt_bcbb_h(klon) ! emissions de BC biomass hautes
168	REAL lmt_bcba(klon) ! emissions de BC bateau
169	c------------------------ ORGANIC MATTER emissions ---------------------
170	REAL lmt_omff(klon) ! emissions de OM fossil fuels
171	REAL lmt_omnff(klon) ! emissions de OM non-fossil fuels
172	REAL lmt_ombb_l(klon) ! emissions de OM biomass basses
173	REAL lmt_ombb_h(klon) ! emissions de OM biomass hautes
174	REAL lmt_omnat(klon) ! emissions de OM Natural
175	REAL lmt_omba(klon) ! emissions de OM bateau
176
177	c
178	c Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
179	c
180	c convection:
181	c -----------
182	c
183	REAL pmfu(klon,klev) ! flux de masse dans le panache montant
184	REAL pmfd(klon,klev) ! flux de masse dans le panache descendant
185	REAL pen_u(klon,klev) ! flux entraine dans le panache montant
186	REAL pde_u(klon,klev) ! flux detraine dans le panache montant
187	REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
188	REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
189	c
190	c Convection KE scheme:
191	c ---------------------
192	c
193	c! Variables pour le lessivage convectif
194	REAL,DIMENSION(klon,klev),INTENT(IN) :: da
195	REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi
196	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2
197	REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam
198	REAL,DIMENSION(klon,klev),INTENT(IN) :: mp
199	REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated
200	c updraft mass flux
201	REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated
202	c downdraft mass flux
203	INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con
204	INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con
205	REAL,DIMENSION(klon,klev),INTENT(IN) :: evap
206	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA
207	REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM
208
209
210	REAL,DIMENSION(klon,klev),INTENT(IN) :: ep
211	REAL,DIMENSION(klon),INTENT(IN) :: sigd
212	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij
213	REAL,DIMENSION(klon,klev),INTENT(IN) :: clw
214	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij
215	REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm
216	REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm
217	REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL
218
219
220	c KE: Tendances de traceurs (Td) et flux de traceurs:
221	! ------------------------
222	REAL,DIMENSION(klon,klev) :: Mint
223	REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a
224	REAL,DIMENSION(klon,klev,nbtr) :: zmfdam
225	REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2
226	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav
227	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat
228	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav
229	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra
230	c dans pluie,air descente insaturee
231	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel
232	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur
233	c descente air insaturee et td convective MA
234	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv ! Td convection/traceur
235	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp
236	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th ! Td thermique
237	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc
238	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav
239	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls
240	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls
241	REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: qPrls !jyg: concentration
242	! !tra dans pluie LS a la surf.
243	! outputs for cvltr_spl
244	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o
245	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o
246	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o
247	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o
248	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o
249
250
251
252	INTEGER :: nsplit
253	!
254
255
256
257	!CHECK!!
258	!!!$OMP
259	!!!!THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl)
260	!!!!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qPr,qDi)
261	!$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls)
262	!!!!!$OMP THREADPRIVATE(d_tr,d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv)
263
264
265	c
266	c Lessivage
267	c ---------
268	c
269	REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection
270	REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale
271	! JE REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection ! Titane
272	! JE REAL prfl(klon,klev), psfl(klon,klev) !--large-scale ! Titane
273	REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb
274	REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content
275
276	REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle)
277	!
278
279	REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion
280	! ! de l'eau cond (de fisrtilp)
281	REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version)
282	INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav
283
284
285
286
287	!Thermiques:
288	!----------
289	REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm
290	REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm
291
292
293	c
294	c Couche limite:
295	c --------------
296	c
297	REAL coefh(klon,klev) ! coeff melange CL
298	REAL cdragh(klon), cdragm(klon)
299	REAL yu1(klon) ! vent dans la 1iere couche
300	REAL yv1(klon) ! vent dans la 1iere couche
301	c
302	c
303	c----------------------------------------------------------------------
304	REAL his_ds(klon,nbtr)
305	REAL his_dhlsc(klon,nbtr) ! in-cloud scavenging lsc
306	REAL his_dhcon(klon,nbtr) ! in-cloud scavenging con
307	REAL his_dhbclsc(klon,nbtr) ! below-cloud scavenging lsc
308	REAL his_dhbccon(klon,nbtr) ! below-cloud scavenging con
309	REAL trm(klon,nbtr)
310	c
311	REAL u10m_ec(klon), v10m_ec(klon)
312	c
313	REAL his_th(klon,nbtr)
314	REAL his_dhkecv(klon,nbtr)
315	REAL his_dhkelsc(klon,nbtr)
316
317
318	c
319	c Coordonnees
320	c -----------
321	c
322	REAL xlat(klon) ! latitudes pour chaque point
323	REAL xlon(klon) ! longitudes pour chaque point
324	C
325	INTEGER i, k, it, j, ig
326	c
327	c DEFINITION OF DIAGNOSTIC VARIABLES
328	c
329	REAL diag_trm(nbtr), diag_drydep(nbtr)
330	REAL diag_wetdep(nbtr), diag_cvtdep(nbtr)
331	REAL diag_emissn(nbtr), diag_g2part
332	REAL diag_sedimt
333	REAL trm_aux(nbtr), src_aux(nbtr)
334	c
335	c Variables locales pour effectuer les appels en serie
336	c----------------------------------------------------
337	REAL source_tr(klon,nbtr)
338	REAL flux_tr(klon,nbtr)
339	REAL m_conc(klon,klev)
340	REAL sed_ss(klon) ! corresponds to tracer 3
341	REAL sed_dust(klon) ! corresponds to tracer 4
342	REAL henry(nbtr) !--cste de Henry mol/l/atm
343	REAL kk(nbtr) !--coefficient de var avec T (K)
344	REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie
345	REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige
346	REAL vdep_oce(nbtr), vdep_sic(nbtr)
347	REAL vdep_ter(nbtr), vdep_lic(nbtr)
348	REAL dtrconv(klon,nbtr)
349	REAL zrho(klon,klev), zdz(klon,klev)
350	REAL zalt(klon,klev)
351	REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique
352	c . Kg/m2
353	REAL,DIMENSION(klon,klev) :: ztra_th
354	REAL qmin, qmax, aux
355	! PARAMETER (qmin=0.0, qmax=1.e33)
356	PARAMETER (qmin=1.e33, qmax=-1.e33)
357
358	c Variables to save data into file
359	c----------------------------------
360
361	CHARACTER*2 str2
362	LOGICAL ok_histrac
363	PARAMETER (ok_histrac=.true.)
364	INTEGER ndex2d(iim(jjm+1)), ndex3d(iim(jjm+1)*klev)
365	INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert
366	INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
367	SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5
368	INTEGER itra
369	SAVE itra ! compteur pour la physique
370	INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m
371	SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m
372	REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA)
373	REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
374	REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev)
375	REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
376	REAL zsto, zout, zout_h, zout_m, zjulian
377	REAL fluxbb(klon), fluxff(klon)
378	REAL fluxbcbb(klon), fluxbcff(klon), fluxbcnff(klon)
379	REAL fluxombb(klon), fluxomff(klon), fluxomnat(klon)
380	REAL fluxomnff(klon), fluxomba(klon), fluxbcba(klon)
381	REAL fluxso2ff(klon), fluxso2bb(klon), fluxso2(klon)
382	REAL fluxso2nff(klon), fluxso2vol(klon), fluxso2ba(klon)
383	REAL fluxh2sff(klon), fluxh2snff(klon)
384	REAL fluxso4ff(klon), fluxso4bb(klon), fluxso4ba(klon)
385	REAL fluxh2sbio(klon), fluxso4nff(klon)
386	REAL fluxdms(klon)
387	REAL fluxbc(klon), fluxom(klon), fluxso4(klon)
388	REAL fluxdd(klon), fluxss(klon)
389	REAL fluxdustec(klon), fluxssfine(klon), fluxsscoa(klon)
390	REAL fluxddfine(klon), fluxddcoa(klon)
391	REAL flux_sparam_bb(klon), flux_sparam_ff(klon)
392	REAL flux_sparam_ind(klon) !, flux_sparam_sulf(klon,klev)
393	REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon)
394	REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon)
395
396	c------------------DMS SO2 SO4 H2S DMSO MSA H2O2
397	c------------------BC1, BC2, OM1, OM2,flyash dust1 dust2
398	c------------------Sea Salt 1-8 bins
399	c------------------Precursors (gases), Fine, Coarse Aerosols
400	C c
401	C DATA henry /1.4, 0.0, 0.0, 0.0/
402	C c
403	C DATA kk /2900., 0., 0., 0./
404	C c
405	C DATA alpha_r /0., 0.001, 0.001, 0.001/
406	C c
407	C DATA alpha_s /0., 0.01, 0.01, 0.01/
408	C c
409	C cnhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
410	C cnhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
411	C DATA vdep_oce /0.28, 0.28, 1.2, 1.2/
412	C c
413	C DATA vdep_sic /0.2, 0.17, 1.2, 1.2/
414	C c
415	C DATA vdep_ter /0.3, 0.14, 1.2, 1.2/
416
417	C DATA vdep_lic /0.2, 0.17, 1.2, 1.2/
418
419	c------Molar Masses
420	REAL masse(nbtr)
421	c
422	REAL fracso2emis !--fraction so2 emis en so2
423	PARAMETER (fracso2emis=0.95)
424	REAL frach2sofso2 !--fraction h2s from so2
425	PARAMETER (frach2sofso2=0.0426)
426	c
427	c Controles
428	c-------------
429	LOGICAL convection,lessivage,lminmax
430	DATA convection,lessivage,lminmax
431	s /.true.,.true.,.true./
432	c
433	REAL xconv(nbtr)
434	c
435	LOGICAL anthropo, bateau, edgar
436	DATA anthropo,bateau,edgar/.true.,.true.,.true./
437	c
438	cc bc_source
439	INTEGER kminbc, kmaxbc
440	PARAMETER (kminbc=3, kmaxbc=5)
441	c
442	REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont
443	c
444	c JE for updating in cltrac
445	REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)
446	REAL,DIMENSION(klon,nbtr) :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE jyg
447	REAL,DIMENSION(klon,nbtr) :: flux_tr_dry
448	c SAVE d_tr_dry
449	c JE for include gas to particle conversion in output
450	REAL his_g2pgas(klon) ! gastoparticle in gas units (check!)
451	REAL his_g2paer(klon) ! gastoparticle in aerosol units (check!)
452	c
453	INTEGER iflag_conv
454	LOGICAL iscm3 ! debug variable. for checkmass ! JE
455
456	c------------------------------------------------------------------------
457	c only to compute time consumption of each process
458	c----
459	INTEGER clock_start,clock_end,clock_rate,clock_start_spla
460	INTEGER clock_end_outphytracr,clock_start_outphytracr
461	INTEGER ti_init,dife,ti_inittype,ti_inittwrite
462	INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther
463	INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs
464	INTEGER ti_nophytracr,clock_per_max
465	REAL tia_init,tia_inittype,tia_inittwrite
466	REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
467	REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
468	REAL tia_brop,tia_outs
469	REAL tia_nophytracr
470
471	SAVE tia_init,tia_inittype,tia_inittwrite
472	SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther
473	SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs
474	SAVE tia_brop,tia_outs
475	SAVE ti_nophytracr
476	SAVE tia_nophytracr
477	SAVE clock_end_outphytracr,clock_start_outphytracr
478	SAVE clock_per_max
479	LOGICAL logitime
480
481	c======================================================================
482	c INITIALISATIONS
483	c======================================================================
484	c
485	c computing time
486	logitime=.true.
487	IF (logitime) THEN
488	clock_start=0
489	clock_end=0
490	clock_rate=0
491	CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max)
492	CALL SYSTEM_CLOCK(COUNT=clock_start_spla)
493	clock_start=clock_start_spla
494	! IF (.NOT.debutphy) THEN
495	clock_end_outphytracr=clock_start_spla
496	! print*,'JE clock',clock_rate,clock_per_max
497	! ENDIF
498	ENDIF
499
500
501
502	c---fraction of tracer that is convected (??
503	xconv(1)=0.8
504	xconv(2)=0.5
505	xconv(3)=0.5
506	xconv(4)=0.6
507
508	masse(1)=32.
509	masse(2)=6.02e23
510	masse(3)=6.02e23
511	masse(4)=6.02e23
512
513	henry= (/1.4, 0.0, 0.0, 0.0/)
514	kk = (/2900., 0., 0., 0./)
515	alpha_r = (/0., 0.001, 0.001, 0.001/)
516	alpha_s = (/0., 0.01, 0.01, 0.01/)
517
518	c nhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/
519	c nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities
520	vdep_oce = (/0.28, 0.28, 1.2, 1.2/)
521	vdep_sic = (/0.2, 0.17, 1.2, 1.2/)
522	vdep_ter = (/0.3, 0.14, 1.2, 1.2/)
523	vdep_lic = (/0.2, 0.17, 1.2, 1.2/)
524
525
526
527	lmt_dms(:)=0.0
528	aux_var2(:)=0.0
529	aux_var3(:,:)=0.0
530	source_tr(:,:)=0.0
531	flux_tr(:,:)=0.0
532	flux_sparam_bb(:)=0.0
533	flux_sparam_ff(:)=0.0
534	flux_sparam_ind(:)=0.0
535	flux_sparam_ddfine(:)=0.0
536	flux_sparam_ddcoa(:)=0.0
537	flux_sparam_ssfine(:)=0.0
538	flux_sparam_sscoa(:)=0.0
539
540	d_tr_dry(:,:)=0.0
541	flux_tr_dry(:,:)=0.0
542	!
543	RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644
544	RG = 9.80665
545	RNAVO =6.02e23
546	RLVTT=2.5008E+6
547	RLSTT=2.8345E+6
548	R4IES=7.66
549	R3IES=21.875
550	R4LES=35.86
551	R3LES=17.269
552	RTT=273.16
553	RMV=18.0153
554	RKBOL=1.380658E-23
555	R=RNAVO*RKBOL
556	R5LES=R3LES*(RTT-R4LES)
557	R5IES=R3IES*(RTT-R4IES)
558	RV=1000.*R/RMV
559	RCPV=4.*RV
560	RCPD=3.5*RD
561	RVTMP2=RCPV/RCPD-1
562	RETV=RV/RD-1.
563
564	c
565	iscm3=.false.
566	if (debutphy) then
567	print *, 'let s check nbtr=', nbtr
568	print *, 'xlat and xlon'
569	c JE initializon to cero the tracers
570	DO it=1, nbtr
571	tr_seri(:,:,it)=0.0
572	ENDDO
573	c JE end
574	! Initializing to zero tr_seri for comparison purposes
575	! tr_seri(:,:,:)=0.0
576	c
577	! DO it=1,nbtr
578	! trm_aux(it)=0.0
579	! src_aux(it)=0.0
580	! diag_trm(it)=0.0
581	! diag_drydep(it)=0.0
582	! diag_wetdep(it)=0.0
583	! diag_cvtdep(it)=0.0
584	! diag_emissn(it)=0.0
585	! ENDDO
586	! diag_g2part=0.0
587	print *,'PREPARE FILES TO SAVE VARIABLES'
588	c
589	nbjour=30
590	ecrit_tra = NINT(86400./pdtphys) !--1-day average
591	ecrit_tra_h = NINT(86400./pdtphys*0.25) !--6-hour average
592	ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour)) !--1-mth average
593	print *,'ecrit_tra=', pdtphys, ecrit_tra
594
595	IF (ok_histrac) THEN
596
597	itra=0
598	c
599	CALL ymds2ju(1900, 1, 1, 0.0, zjulian)
600	c
601	print *, 'klon,iim,jjm+1 = ',klon,iim,jjm+1
602	CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon)
603	c
604	DO i = 1, iim
605	zx_lon(i,1) = xlon(i+1)
606	zx_lon(i,jjm+1) = xlon(i+1)
607	ENDDO
608	c
609	CALL histbeg("histrac_spl", iim,zx_lon, jjm+1,zx_lat,
610	. 1,iim,1,jjm+1, 0, zjulian, pdtphys,
611	. nhori1, nid_tra1)
612	c
613	CALL histbeg("lessivage_spl", iim,zx_lon, jjm+1,zx_lat,
614	. 1,iim,1,jjm+1, 0, zjulian, pdtphys,
615	. nhori2, nid_tra2)
616	c
617	CALL histbeg("traceur_spl", iim,zx_lon, jjm+1,zx_lat,
618	. 1,iim,1,jjm+1, 0, zjulian, pdtphys,
619	. nhori3, nid_tra3)
620	c
621	CALL histvert(nid_tra1, "presnivs", "Vertical levels", "mb",
622	. klev, presnivs, nvert)
623	c
624	CALL histvert(nid_tra2, "presnivs", "Vertical levels", "mb",
625	. klev, presnivs, nvert)
626	c
627	CALL histvert(nid_tra3, "presnivs", "Vertical levels", "mb",
628	. klev, presnivs, nvert)
629	c
630	zsto = pdtphys
631	zout = pdtphys * FLOAT(ecrit_tra)
632	zout_h = pdtphys * FLOAT(ecrit_tra_h)
633	zout_m = pdtphys * FLOAT(ecrit_tra_m)
634	print *,'zsto zout=', zsto, zout
635
636	c
637	c----------------- HISTORY FILES OF TRACER EMISSIONS -------------------
638	c
639	c HISTRAC
640	c
641	CALL histdef(nid_tra1, "fluxbb", "Flux BB", "mg/m2/s",
642	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
643	. "ave(X)", zsto,zout)
644	c
645	CALL histdef(nid_tra1, "fluxff", "Flux FF", "mg/m2/s",
646	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
647	. "ave(X)", zsto,zout)
648	c
649	CALL histdef(nid_tra1, "fluxbcbb", "Flux BC-BB", "mg/m2/s",
650	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
651	. "ave(X)", zsto,zout)
652	c
653	CALL histdef(nid_tra1, "fluxbcff", "Flux BC-FF", "mg/m2/s",
654	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
655	. "ave(X)", zsto,zout)
656	c
657	CALL histdef(nid_tra1, "fluxbcnff", "Flux BC-NFF", "mg/m2/s",
658	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
659	. "ave(X)", zsto,zout)
660	c
661	CALL histdef(nid_tra1, "fluxbcba", "Flux BC-BA", "mg/m2/s",
662	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
663	. "ave(X)", zsto,zout)
664	c
665	CALL histdef(nid_tra1, "fluxbc", "Flux BC", "mg/m2/s",
666	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
667	. "ave(X)", zsto,zout)
668	c
669	CALL histdef(nid_tra1, "fluxombb", "Flux OM-BB", "mg/m2/s",
670	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
671	. "ave(X)", zsto,zout)
672	c
673	CALL histdef(nid_tra1, "fluxomff", "Flux OM-FF", "mg/m2/s",
674	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
675	. "ave(X)", zsto,zout)
676	c
677	CALL histdef(nid_tra1, "fluxomnff", "Flux OM-NFF", "mg/m2/s",
678	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
679	. "ave(X)", zsto,zout)
680	c
681	CALL histdef(nid_tra1, "fluxomba", "Flux OM-BA", "mg/m2/s",
682	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
683	. "ave(X)", zsto,zout)
684	c
685	CALL histdef(nid_tra1, "fluxomnat", "Flux OM-NT", "mg/m2/s",
686	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
687	. "ave(X)", zsto,zout)
688	c
689	CALL histdef(nid_tra1, "fluxom", "Flux OM", "mg/m2/s",
690	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
691	. "ave(X)", zsto,zout)
692	c
693	CALL histdef(nid_tra1,"fluxh2sff","Flux H2S FF","mgS/m2/s",
694	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
695	. "ave(X)", zsto,zout)
696	c
697	CALL histdef(nid_tra1,"fluxh2snff","Flux H2S non-FF",
698	. "mgS/m2/s",iim,jjm+1,nhori1, 1,1,1, -99, 32,
699	. "ave(X)", zsto,zout)
700	c
701	CALL histdef(nid_tra1,"fluxso2ff","Flux SO2 FF","mgS/m2/s",
702	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
703	. "ave(X)", zsto,zout)
704	c
705	CALL histdef(nid_tra1,"fluxso2nff","Flux SO2 non-FF",
706	. "mgS/m2/s",iim,jjm+1,nhori1, 1,1,1, -99, 32,
707	. "ave(X)", zsto,zout)
708	c
709	CALL histdef(nid_tra1, "fluxso2bb", "Flux SO2 BB","mgS/m2/s",
710	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
711	. "ave(X)", zsto,zout)
712	c
713	CALL histdef(nid_tra1,"fluxso2vol","Flux SO2 Vol","mgS/m2/s",
714	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
715	. "ave(X)", zsto,zout)
716	c
717	CALL histdef(nid_tra1, "fluxso2ba", "Flux SO2 Ba","mgS/m2/s",
718	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
719	. "ave(X)", zsto,zout)
720	c
721	CALL histdef(nid_tra1, "fluxso2", "Flux SO2","mgS/m2/s",
722	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
723	. "ave(X)", zsto,zout)
724	c
725	CALL histdef(nid_tra1,"fluxso4ff","Flux SO4 FF","mgS/m2/s",
726	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
727	. "ave(X)", zsto,zout)
728	c
729	CALL histdef(nid_tra1,"fluxso4nff","Flux SO4 non-FF",
730	. "mgS/m2/s", iim,jjm+1,nhori1, 1,1,1, -99, 32,
731	. "ave(X)", zsto,zout)
732	c
733	CALL histdef(nid_tra1, "fluxso4bb", "Flux SO4 BB","mgS/m2/s",
734	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
735	. "ave(X)", zsto,zout)
736	c
737	CALL histdef(nid_tra1, "fluxso4ba", "Flux SO4 Ba","mgS/m2/s",
738	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
739	. "ave(X)", zsto,zout)
740	c
741	CALL histdef(nid_tra1, "fluxso4", "Flux SO4","mgS/m2/s",
742	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
743	. "ave(X)", zsto,zout)
744	c
745	CALL histdef(nid_tra1, "fluxdms", "Flux DMS", "mgS/m2/s",
746	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
747	. "ave(X)", zsto,zout)
748	c
749	CALL histdef(nid_tra1,"fluxh2sbio","Flux H2S Bio","mgS/m2/s",
750	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
751	. "ave(X)", zsto,zout)
752	c
753	CALL histdef(nid_tra1, "fluxdustec",
754	. "Flux Dust EC", "mg/m2/s",
755	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
756	. "ave(X)", zsto,zout)
757	c
758	CALL histdef(nid_tra1,"fluxddfine","DD Fine Mode","mg/m2/s",
759	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
760	. "ave(X)", zsto,zout)
761	c
762	CALL histdef(nid_tra1,"fluxddcoa","DD Coarse Mode","mg/m2/s",
763	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
764	. "ave(X)", zsto,zout)
765	c
766	CALL histdef(nid_tra1,"fluxdd","Flux DD","mg/m2/s",
767	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
768	. "ave(X)", zsto,zout)
769	c
770	CALL histdef(nid_tra1,"fluxssfine","SS Fine Mode","mg/m2/s",
771	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
772	. "ave(X)", zsto,zout)
773	c
774	CALL histdef(nid_tra1,"fluxsscoa","SS Coarse Mode","mg/m2/s",
775	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
776	. "ave(X)", zsto,zout)
777	c
778	CALL histdef(nid_tra1,"fluxss","Flux SS","mg/m2/s",
779	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
780	. "ave(X)", zsto,zout)
781	c
782	cnhl CALL histdef(nid_tra1,"fluxso4chem","SO4 chem prod",
783	cnhl . "gAer/kgAir",
784	cnhl . iim,jjm+1,nhori1, klev,1,klev,nvert, 32,
785	cnhl . "ave(X)", zsto,zout)
786	c
787	CALL histdef(nid_tra1,"flux_sparam_ind","Ind emiss",
788	. "mg/m2/s",
789	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
790	. "ave(X)", zsto,zout)
791	c
792	CALL histdef(nid_tra1,"flux_sparam_bb","BB emiss",
793	. "mg/m2/s",
794	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
795	. "ave(X)", zsto,zout)
796	c
797	CALL histdef(nid_tra1,"flux_sparam_ff","FF emiss",
798	. "mg/m2/s",
799	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
800	. "ave(X)", zsto,zout)
801	c
802	CALL histdef(nid_tra1,"flux_sparam_ddfine","DD fine emiss",
803	. "mg/m2/s",
804	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
805	. "ave(X)", zsto,zout)
806	c
807	CALL histdef(nid_tra1,"flux_sparam_ddcoa","DD coarse emiss",
808	. "mg/m2/s",
809	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
810	. "ave(X)", zsto,zout)
811	c
812	CALL histdef(nid_tra1,"flux_sparam_ssfine","SS fine emiss",
813	. "mg/m2/s",
814	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
815	. "ave(X)", zsto,zout)
816	c
817	CALL histdef(nid_tra1,"flux_sparam_sscoa","SS coarse emiss",
818	. "mg/m2/s",
819	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
820	. "ave(X)", zsto,zout)
821	c
822	CALL histdef(nid_tra1,"u10m","Zonal wind at 10 m",
823	. "m/s",
824	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
825	. "ave(X)", zsto,zout)
826	c
827	CALL histdef(nid_tra1,"v10m","Meridional wind at 10 m",
828	. "m/s",
829	. iim,jjm+1,nhori1, 1,1,1, -99, 32,
830	. "ave(X)", zsto,zout)
831	c
832	cnhl CALL histdef(nid_tra1,"flux_sparam_sulf","SO4 chem prod",
833	cnhl . "gAer/kgAir",
834	cnhl . iim,jjm+1,nhori1, klev,1,klev,nvert, 32,
835	cnhl . "ave(X)", zsto,zout)
836	c
837	c TRACEUR
838	c
839	CALL histdef(nid_tra3, "taue550", "Tau ext 550", " ",
840	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
841	. "ave(X)", zsto,zout)
842	c
843	CALL histdef(nid_tra3, "taue670", "Tau ext 670", " ",
844	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
845	. "ave(X)", zsto,zout)
846	c
847	CALL histdef(nid_tra3, "taue865", "Tau ext 865", " ",
848	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
849	. "ave(X)", zsto,zout)
850	c
851	CALL histdef(nid_tra3, "taue550_tr2", "Tau ext 550tr2", " ",
852	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
853	. "ave(X)", zsto,zout)
854	c
855	CALL histdef(nid_tra3, "taue670_tr2", "Tau ext 670tr2", " ",
856	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
857	. "ave(X)", zsto,zout)
858	c
859	CALL histdef(nid_tra3, "taue865_tr2", "Tau ext 865tr2", " ",
860	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
861	. "ave(X)", zsto,zout)
862	c
863	CALL histdef(nid_tra3, "taue550_ss", "Tau ext 550ss", " ",
864	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
865	. "ave(X)", zsto,zout)
866	c
867	CALL histdef(nid_tra3, "taue670_ss", "Tau ext 670ss", " ",
868	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
869	. "ave(X)", zsto,zout)
870	c
871	CALL histdef(nid_tra3, "taue865_ss", "Tau ext 865ss", " ",
872	. iim,jjm+1,nhori3, 1,1,1, -99, 32,
873	. "ave(X)", zsto,zout)
874	c
875	CALL histdef(nid_tra3, "taue550_dust", "Tau ext 550dust", " "
876	. ,iim,jjm+1,nhori3, 1,1,1, -99, 32,
877	. "ave(X)", zsto,zout)
878	c
879	CALL histdef(nid_tra3, "taue670_dust", "Tau ext 670dust", " "
880	. ,iim,jjm+1,nhori3, 1,1,1, -99, 32,
881	. "ave(X)", zsto,zout)
882	c
883	CALL histdef(nid_tra3, "taue865_dust", "Tau ext 865dust", " "
884	. ,iim,jjm+1,nhori3, 1,1,1, -99, 32,
885	. "ave(X)", zsto,zout)
886	DO it=1, nbtr
887	c
888	WRITE(str2,'(i2.2)') it
889	c
890	CALL histdef(nid_tra3, "trm"//str2, "Burden No."//str2,
891	. "mgS/m2", iim,jjm+1,nhori3, 1,1,1, -99, 32,
892	. "ave(X)", zsto,zout)
893	c
894	CALL histdef(nid_tra3, "sconc"//str2, "Surf Conc. No."//str2,
895	. "mg/m3", iim,jjm+1,nhori3, 1,1,1, -99, 32,
896	. "ave(X)", zsto,zout)
897	c
898	c LESSIVAGE
899	c
900	CALL histdef(nid_tra2, "flux"//str2, "emission"//str2,
901	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
902	. "ave(X)", zsto,zout)
903	c
904	CALL histdef(nid_tra2, "ds"//str2, "Depot sec No."//str2,
905	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
906	. "ave(X)", zsto,zout)
907	c
908	CALL histdef(nid_tra2,"dh"//str2,
909	. "Depot hum No."//str2,
910	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
911	. "ave(X)", zsto,zout)
912	c
913	CALL histdef(nid_tra2,"dtrconv"//str2,
914	. "Tiedke convective"//str2,
915	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
916	. "ave(X)", zsto,zout)
917
918	CALL histdef(nid_tra2,"dtherm"//str2,
919	. "Thermals dtracer"//str2,
920	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
921	. "ave(X)", zsto,zout)
922
923	CALL histdef(nid_tra2,"dhkecv"//str2,
924	. "KE dep hum convective"//str2,
925	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
926	. "ave(X)", zsto,zout)
927	CALL histdef(nid_tra2,"dhkelsc"//str2,
928	. "KE dep hum large scale"//str2,
929	. "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
930	. "ave(X)", zsto,zout)
931
932
933	CALL histdef(nid_tra2,"d_tr_cv"//str2,
934	. "cvltr d_tr_cv"//str2,
935	. "mgS/m2/s",
936	. iim,jjm+1,nhori2, klev,1,klev,nvert, 32,
937	. "ave(X)", zsto,zout)
938	CALL histdef(nid_tra2,"d_tr_trsp"//str2
939	. ,"cvltr d_tr_trsp"//str2,
940	. "mgS/m2/s",
941	. iim,jjm+1,nhori2, klev,1,klev,nvert, 32,
942	. "ave(X)", zsto,zout)
943	CALL histdef(nid_tra2,"d_tr_sscav"//str2
944	. ,"cvltr d_tr_sscav"//str2,"mgS/m2/s",
945	. iim,jjm+1,nhori2, klev,1,klev,nvert, 32,
946	. "ave(X)", zsto,zout)
947	CALL histdef(nid_tra2,"d_tr_sat"//str2
948	. ,"cvltr d_tr_sat"//str2,
949	. "mgS/m2/s",
950	. iim,jjm+1,nhori2, klev,1,klev,nvert, 32,
951	. "ave(X)", zsto,zout)
952	CALL histdef(nid_tra2,"d_tr_uscav"//str2
953	. ,"cvltr d_tr_uscav"//str2,
954	. "mgS/m2/s",
955	. iim,jjm+1,nhori2, klev,1,klev,nvert, 32,
956	. "ave(X)", zsto,zout)
957
958
959
960	c
961	ENDDO
962	c
963	CALL histdef(nid_tra2, "sed_ss", "Sedmet. Tr3",
964	. "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
965	. "ave(X)", zsto,zout)
966	c
967	CALL histdef(nid_tra2, "sed_dust", "Sedmet. Tr4",
968	. "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
969	. "ave(X)", zsto,zout)
970	c
971	CALL histdef(nid_tra2, "g2p_gas", "Gas2particle gas sink",
972	. "mg-S/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
973	. "ave(X)", zsto,zout)
974	c
975	CALL histdef(nid_tra2, "g2p_aer", "Gas2particle tr2 src",
976	. "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32,
977	. "ave(X)", zsto,zout)
978	c
979	c--------------------------------------------------------------------
980	c
981	CALL histend(nid_tra1)
982	c
983	CALL histend(nid_tra2)
984	c
985	CALL histend(nid_tra3)
986	c
987	c--------------------------------------------------------------------
988
989	! nbjour=1
990	ENDIF !--ok_histrac
991
992	c
993	! IF (.NOT.edgar.AND.bateau) THEN
994	! PRINT *,'ATTENTION risque de compter double les bateaux'
995	! STOP
996	! ENDIF
997	c
998	c
999	c
1000	endif ! debutphy
1001	c
1002	c======================================================================
1003	c Initialisations
1004	c======================================================================
1005	c
1006	c
1007	c je KE init
1008	IF (debutphy) THEN
1009	ALLOCATE(d_tr_cv(klon,klev,nbtr))
1010	ALLOCATE(d_tr_trsp(klon,klev,nbtr))
1011	ALLOCATE(d_tr_sscav(klon,klev,nbtr),
1012	. d_tr_sat(klon,klev,nbtr))
1013	ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),
1014	. qDi(klon,klev,nbtr))
1015	ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr))
1016	ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr))
1017	ALLOCATE(d_tr_th(klon,klev,nbtr))
1018	ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr))
1019	ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr))
1020	ALLOCATE(qPrls(klon,nbtr))
1021
1022	ALLOCATE(d_tr_cv_o(klon,klev,nbtr))
1023	ALLOCATE(d_tr_trsp_o(klon,klev,nbtr))
1024	ALLOCATE(d_tr_sscav_o(klon,klev,nbtr),
1025	. d_tr_sat_o(klon,klev,nbtr))
1026	ALLOCATE(d_tr_uscav_o(klon,klev,nbtr))
1027	!
1028	!Config Key = iflag_lscav
1029	!Config Desc = Large scale scavenging parametrization: 0=none,
1030	!1=old(Genthon92),
1031	! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.
1032	!Config Def = 4
1033	!Config
1034	!$OMP MASTER
1035	iflag_lscav_omp=4
1036	call getin('iflag_lscav', iflag_lscav_omp)
1037	!$OMP END MASTER
1038	!$OMP BARRIER
1039	iflag_lscav=iflag_lscav_omp
1040	! initialiation for time computation
1041
1042	tia_spla=0.
1043	tia_emis=0.
1044	tia_depo=0.
1045	tia_cltr=0.
1046	tia_ther=0.
1047	tia_sedi=0.
1048	tia_gasp=0.
1049	tia_wetap=0.
1050	tia_cvltr=0.
1051	tia_lscs=0.
1052	tia_brop=0.
1053	tia_outs=0.
1054	tia_nophytracr=0.
1055	clock_start_outphytracr=clock_end_outphytracr+1
1056
1057	ENDIF ! debutphy
1058
1059
1060	! initialiation for time computation
1061
1062	ti_spla=0
1063	ti_emis=0
1064	ti_depo=0
1065	ti_cltr=0
1066	ti_ther=0
1067	ti_sedi=0
1068	ti_gasp=0
1069	ti_wetap=0
1070	ti_cvltr=0
1071	ti_lscs=0
1072	ti_brop=0
1073	ti_outs=0
1074
1075
1076	DO k=1,klev
1077	DO i=1,klon
1078	Mint(i,k)=0.
1079	END DO
1080	END DO
1081
1082
1083	c
1084	DO it=1, nbtr
1085	DO k=1,klev
1086	DO i=1,klon
1087	d_tr_cv(i,k,it)=0.
1088	d_tr_trsp(i,k,it)=0.
1089	d_tr_sscav(i,k,it)=0.
1090	d_tr_sat(i,k,it)=0.
1091	d_tr_uscav(i,k,it)=0.
1092	d_tr(i,k,it)=0.
1093	d_tr_insc(i,k,it)=0.
1094	d_tr_bcscav(i,k,it)=0.
1095	d_tr_evapls(i,k,it)=0.
1096	d_tr_ls(i,k,it)=0.
1097
1098	d_tr_cv_o(i,k,it)=0.
1099	d_tr_trsp_o(i,k,it)=0.
1100	d_tr_sscav_o(i,k,it)=0.
1101	d_tr_sat_o(i,k,it)=0.
1102	d_tr_uscav_o(i,k,it)=0.
1103
1104
1105	qDi(i,k,it)=0.
1106	qPr(i,k,it)=0.
1107	qPa(i,k,it)=0.
1108	qMel(i,k,it)=0.
1109	qTrdi(i,k,it)=0.
1110	dtrcvMA(i,k,it)=0.
1111	zmfd1a(i,k,it)=0.
1112	zmfdam(i,k,it)=0.
1113	zmfphi2(i,k,it)=0.
1114	END DO
1115	END DO
1116	END DO
1117
1118
1119	DO it=1, nbtr
1120	DO i=1,klon
1121	qPrls(i,it)=0.0
1122	dtrconv(i,it)=0.0
1123	ENDDO
1124	ENDDO
1125
1126	DO it=1, nbtr
1127	DO i=1, klon
1128	his_dhlsc(i,it)=0.0
1129	his_dhcon(i,it)=0.0
1130	his_dhbclsc(i,it)=0.0
1131	his_dhbccon(i,it)=0.0
1132	trm(i,it)=0.0
1133	his_th(i,it)=0.0
1134	his_dhkecv(i,it)=0.0
1135	his_dhkelsc(i,it)=0.0
1136
1137	ENDDO
1138	ENDDO
1139	cJE:
1140	DO i=1, klon
1141	his_g2pgas(i) = 0.0
1142	his_g2paer(i) = 0.0
1143	ENDDO
1144	c endJE
1145	c
1146
1147	DO k=1, klev
1148	DO i = 1, klon
1149	zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD
1150	zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
1151	zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/RG
1152	ENDDO
1153	ENDDO
1154	c
1155	DO i = 1, klon
1156	zalt(i,1)=pphis(i)/RG
1157	ENDDO
1158	DO k=1, klev-1
1159	DO i = 1, klon
1160	zalt(i,k+1)=zalt(i,k)+zdz(i,k)
1161	ENDDO
1162	ENDDO
1163
1164	IF (logitime) THEN
1165	CALL SYSTEM_CLOCK(COUNT=clock_end)
1166	dife=clock_end-clock_start
1167	ti_init=dife*MAX(0,SIGN(1,dife))
1168	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1169	tia_init=tia_init+REAL(ti_init)/REAL(clock_rate)
1170	ENDIF
1171	IF (logitime) THEN
1172	CALL SYSTEM_CLOCK(COUNT=clock_start)
1173	ENDIF
1174
1175	c
1176	c======================================================================
1177	c Initialisations of Scaling Parameters
1178	c======================================================================
1179	C
1180	C ----------------------------- SO4 -----------------------------------
1181	C
1182	c scale_param_so4(1)=scale_param_sulf(1)
1183	c scale_param_so4(klon)=scale_param_sulf(jjm+1)
1184
1185	c DO j = 2, jjm
1186	c DO i = 1, iim
1187	c ig=iim*(j-2)+i+1
1188	c scale_param_so4(ig)=scale_param_sulf(j)
1189	c ENDDO
1190	c ENDDO
1191	C
1192	C ----------------------- SO2, BC & OM --------------------------------
1193	C ----------------FOSSIL FUEL AND INUDSTRIAL EMISSIONS-----------------
1194	iregion_dust(:)=-999
1195	iregion_ind(:)=-999
1196	iregion_bb(:)=-999
1197	! READING BB MASK
1198	! c_Directory='/ccc/work/cont003/dsm/nhuneeus/REGION_MASK/'
1199	c_Directory='/d6/jelmd/LMDZ_INPUT/REGION_MASK/'
1200	! c_FileName1='GFED_phyBBmask_lowres_v2.txt'
1201	c JE por v2 c_FileName1='GFED_phyBBmask_lowres.txt'
1202	c JE por v2 c_FileName2='Country_phyFFandSO2mask_lowres.txt'
1203	c c_FileName1='GFED_phyBBmask_lowres_v2.txt'
1204	c c_FileName2='Country_phyFFandSO2mask_lowres_v2.txt'
1205	c_FileName1='GFED_phyBBmask_lowres_je48x36.txt'
1206	c_FileName2='Country_phyFFandSO2mask_lowres_je48x36.txt'
1207	c_FullName1=c_Directory//c_FileName1
1208	c_FullName2=c_Directory//c_FileName2
1209	print *,'BB mask NL = ',c_FullName1
1210	!
1211	OPEN (UNIT=1,FILE=c_FullName1)
1212	OPEN (UNIT=111,FILE=c_FullName2)
1213	DO j=1,klon
1214	! print *, j, klon
1215	aux_mask1=0
1216	aux_mask2=0
1217	READ(1,102) aux_mask1
1218	! mask_BBreg(j)=aux_mask1
1219	iregion_bb(j)=aux_mask1
1220	READ(111,102) aux_mask2
1221	! print *,'aux_mask1, aux_mask2
1222	! . =',aux_mask1,aux_mask2,INT(aux_mask1),INT(aux_mask2)
1223	! mask_ffso2reg(j)=aux_mask2
1224	iregion_ind(j)=aux_mask2
1225	ENDDO
1226	CLOSE (UNIT=1)
1227	CLOSE (UNIT=111)
1228	!
1229	IF (debutphy) THEN
1230	OPEN(25,FILE='dustregions_pyvar.data')
1231	OPEN(55,FILE='indregions_pyvar.data')
1232	OPEN(75,FILE='bbregions_pyvar.data')
1233	ENDIF
1234
1235	DO i = 1, klon
1236	C ----------------------- SO2, BC & OM ---------------------------------
1237	C -----------------------BIOMASS BURNING--------------------------------
1238	C ------------------------------- DUST ---------------------------------
1239	C
1240	IF ((xlat(i).GT.11).AND.(xlon(i).LT.-85)) THEN
1241	c NORTH WEST AMERICA = 1
1242	iregion_dust(i)=1
1243	ELSEIF ((xlat(i).LE.11).AND.(xlon(i).LT.-25)) THEN
1244	c SOUTH AMERICA = 2
1245	iregion_dust(i)=2
1246	ELSEIF ((xlat(i).GE.11).AND.(xlon(i).GE.-25).AND.
1247	. (xlon(i).LE.14)) THEN
1248	c WEST SAHARA = 3
1249	iregion_dust(i)=3
1250	ELSEIF ((xlat(i).GT.-1.75*xlon(i)+89).AND.
1251	. (xlat(i).GT.0.524*xlon(i)-11.048).AND.
1252	. (xlat(i).LT.-0.464*xlon(i)+53.179).AND.
1253	. (xlat(i).LT.36)) THEN
1254	c SAUDI ARABIA = 9
1255	iregion_dust(i)=9
1256	ELSEIF ((xlat(i).LT.11).AND.(xlon(i).GE.-25).AND.
1257	. (xlon(i).LE.77)) THEN
1258	c AFRICA SUB-SAHARA = 5
1259	iregion_dust(i)=5
1260	ELSEIF ((xlon(i).GT.77).AND.(xlat(i).LT.-5)) THEN
1261	c AUSTRALIA = 8
1262	iregion_dust(i)=8
1263	ELSEIF ((xlon(i).GE.77).AND.(xlat(i).GE.-5)) THEN
1264	c ASIA EAST = 6 REGION ADDED
1265	iregion_dust(i)=6
1266	ELSEIF (xlat(i).GT.11.AND.xlon(i).GE.-85.AND.
1267	. xlon(i).LT.-25) THEN
1268	c NORTH EAST AMERICA = 11
1269	iregion_dust(i)=11
1270	ELSEIF ((xlon(i).LT.77).AND.(xlat(i).LT.36).AND.
1271	. (xlat(i).GE.11).AND.
1272	. (xlat(i).GT.-0.464*xlon(i)+53.179).OR.
1273	. (xlat(i).LT.0.524*xlon(i)-11.048)) THEN
1274	c INDIAN SUBCONTINENT
1275	iregion_dust(i)=10
1276	ELSEIF ((xlon(i).GT.33).AND.(xlon(i).LT.77).AND.
1277	. (xlat(i).GE.36)) THEN
1278	c ASIA WEST = 7
1279	iregion_dust(i)=7
1280	ELSEIF ((xlat(i).GE.11).AND.
1281	. (xlon(i).GT.14).AND.
1282	. (xlat(i).LT.-1.75*xlon(i)+89).OR.xlon(i).LE.33) THEN
1283	c EAST SAHARA = 4
1284	iregion_dust(i)=4
1285	ENDIF
1286
1287	IF (debutphy) THEN
1288	c WRITTING REGIONS INTO FILE
1289	IF (iregion_dust(i).LT.10) THEN
1290	WRITE (25,101) iregion_dust(i)
1291	ELSE
1292	WRITE (25,102) iregion_dust(i)
1293	ENDIF
1294	WRITE (55,*) iregion_ind(i)
1295	WRITE (75,*) iregion_bb(i)
1296	! WRITE (55,102) iregion_ind(i)
1297	! WRITE (75,102) iregion_bb(i)
1298
1299	ENDIF ! debutphy/write regions
1300	ENDDO
1301	! print *,'NEW DUST REGION, NOW 11 REGIONS!'
1302	IF (debutphy) THEN
1303
1304	CLOSE(25)
1305	CLOSE(55)
1306	CLOSE(75)
1307	101 FORMAT (i1)
1308	102 FORMAT (i2)
1309	! stop
1310
1311	ENDIF
1312	IF (logitime) THEN
1313	CALL SYSTEM_CLOCK(COUNT=clock_end)
1314	dife=clock_end-clock_start
1315	ti_inittype=dife*MAX(0,SIGN(1,dife))
1316	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1317	tia_inittype=tia_inittype+REAL(ti_inittype)/REAL(clock_rate)
1318	ENDIF
1319
1320	IF (logitime) THEN
1321	CALL SYSTEM_CLOCK(COUNT=clock_start)
1322	ENDIF
1323
1324
1325	c
1326	c=======================================================================
1327	c SAVING SURFACE TYPE
1328	c=======================================================================
1329	IF (debutphy) THEN
1330
1331	OPEN(35,FILE='surface_ocean.data')
1332	OPEN(45,FILE='surface_seaice.data')
1333	OPEN(65,FILE='surface_land.data')
1334	OPEN(85,FILE='surface_landice.data')
1335	DO i = 1, klon
1336	WRITE (35,103) pctsrf(i,is_oce)
1337	WRITE (45,103) pctsrf(i,is_sic)
1338	WRITE (65,103) pctsrf(i,is_ter)
1339	WRITE (85,103) pctsrf(i,is_lic)
1340	ENDDO
1341	CLOSE(35)
1342	CLOSE(45)
1343	CLOSE(65)
1344	CLOSE(85)
1345	103 FORMAT (f6.2)
1346	ENDIF
1347	! stop
1348	c
1349	c=======================================================================
1350
1351	! CALL checknanqfi(tr_seri(:,:,1),qmin,qmax,'nan_TEST0it1')
1352	! CALL checknanqfi(tr_seri(:,:,2),qmin,qmax,'nan_TEST0it2')
1353	! CALL checknanqfi(tr_seri(:,:,3),qmin,qmax,'nan_TEST0it3')
1354	! CALL checknanqfi(tr_seri(:,:,4),qmin,qmax,'nan_TEST0it4')
1355	c
1356	DO it=1, nbtr
1357	DO j=1,klev
1358	DO i=1,klon
1359	tmp_var(i,j)=tr_seri(i,j,it)
1360	ENDDO
1361	ENDDO
1362	CALL kg_to_cm3(pplay,t_seri,tmp_var)
1363	DO j=1,klev
1364	DO i=1,klon
1365	tr_seri(i,j,it)=tmp_var(i,j)
1366	ENDDO
1367	ENDDO
1368	ENDDO
1369	iscm3=.true.
1370
1371	! CALL checknanqfi(t_seri(:,:),qmin,qmax,'nan_t_seri')
1372	! CALL abort_gcm('TEST1', 'Pass nan t_seri', 1)
1373	! CALL checknanqfi(tr_seri(:,:,1),qmin,qmax,'nan_TEST1it1')
1374	! CALL checknanqfi(tr_seri(:,:,2),qmin,qmax,'nan_TEST1it2')
1375	! CALL checknanqfi(tr_seri(:,:,3),qmin,qmax,'nan_TEST1it3')
1376	! CALL checknanqfi(tr_seri(:,:,4),qmin,qmax,'nan_TEST1it4')
1377	! DO it=1, nbtr
1378	! CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,
1379	! . 'after kg_to_cm3')
1380	! ENDDO
1381	c=======================================================================
1382	c
1383	DO k=1, klev
1384	DO i=1, klon
1385	m_conc(i,k)=pplay(i,k)/t_seri(i,k)/RKBOL*1.e-6
1386	ENDDO
1387	ENDDO
1388
1389	!
1390	c
1391	IF (lminmax) THEN
1392	DO it=1,nbtr
1393	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_avt_coarem')
1394	ENDDO
1395	DO it=1,nbtr
1396	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'avt coarem')
1397	ENDDO
1398	CALL minmaxsource(source_tr,qmin,qmax,'src: avt coarem')
1399	ENDIF
1400
1401	IF (logitime) THEN
1402	CALL SYSTEM_CLOCK(COUNT=clock_end)
1403	dife=clock_end-clock_start
1404	ti_inittwrite=dife*MAX(0,SIGN(1,dife))
1405	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1406	tia_inittwrite=tia_inittwrite+REAL(ti_inittwrite)/REAL(clock_rate)
1407	ENDIF
1408
1409	c
1410	c
1411	c=======================================================================
1412	c EMISSIONS OF COARSE AEROSOLS
1413	c=======================================================================
1414
1415
1416	IF (logitime) THEN
1417	CALL SYSTEM_CLOCK(COUNT=clock_start)
1418	ENDIF
1419
1420
1421
1422	c
1423	c PRINT *, 'DUST EMISSION VALUES FOR REAGION EAST ASIA'
1424	c DO i=1, klon
1425	c IF ((xlon(i).GT.105).AND.(xlat(i).GE.-5)) THEN
1426	c print *, 'DUST_EC,LON,LAT = ',dust_ec(i),xlon(i),xlat(i)
1427	c ENDIF
1428	c ENDDO
1429	print *,'Number of tracers = ',nbtr
1430
1431	print *,'AT BEGINNING OF PHYTRACR_SPL'
1432	! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)),
1433	! . MAXVAL(tr_seri(:,:,3))
1434
1435	CALL coarsemission(pctsrf,pdtphys,t_seri,
1436	. pmflxr,pmflxs,prfl,psfl,
1437	. scale_param_ssacc,scale_param_sscoa,
1438	. scale_param_dustacc,scale_param_dustcoa,
1439	. iregion_dust,dust_ec,
1440	. lmt_sea_salt,qmin,qmax,
1441	. flux_sparam_ddfine,flux_sparam_ddcoa,
1442	. flux_sparam_ssfine,flux_sparam_sscoa,
1443	. source_tr,flux_tr)
1444
1445
1446	IF (lminmax) THEN
1447	DO it=1,nbtr
1448	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_coarem')
1449	ENDDO
1450	DO it=1,nbtr
1451	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after coarem')
1452	ENDDO
1453	CALL minmaxsource(source_tr,qmin,qmax,'src: after coarem')
1454	ENDIF
1455
1456	c
1457	c
1458	c
1459	c======================================================================
1460	c EMISSIONS OF AEROSOL PRECURSORS
1461	c======================================================================
1462	c
1463	print *,'INPUT TO PRECUREMISSION'
1464
1465	CALL precuremission(ftsol,u10m_ec,v10m_ec,pctsrf,
1466	. u_seri,v_seri,paprs,pplay,cdragh,cdragm,
1467	. t_seri,q_seri,tsol,fracso2emis,frach2sofso2,
1468	. bateau,zdz,zalt,kminbc,kmaxbc,pdtphys,
1469	. scale_param_bb,scale_param_ind,
1470	. iregion_ind, iregion_bb,
1471	. lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba,
1472	. lmt_so2bb_l,lmt_so2bb_h,
1473	. lmt_so2volc_cont,lmt_altvolc_cont,
1474	. lmt_so2volc_expl,lmt_altvolc_expl,
1475	. lmt_dmsbio,lmt_h2sbio, lmt_dmsconc, lmt_dms,
1476	. flux_sparam_ind, flux_sparam_bb,
1477	. source_tr,flux_tr,tr_seri)
1478	!
1479	IF (lminmax) THEN
1480	DO it=1,nbtr
1481	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after precur')
1482	ENDDO
1483	DO it=1,nbtr
1484	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after precur')
1485	ENDDO
1486	CALL minmaxsource(source_tr,qmin,qmax,'src: after precur')
1487	ENDIF
1488
1489	c
1490	c
1491	c=======================================================================
1492	c EMISSIONS OF FINE AEROSOLS
1493	c=======================================================================
1494	c
1495	CALL finemission(zdz,pdtphys,zalt,kminbc,kmaxbc,
1496	. scale_param_bb,scale_param_ff,
1497	. iregion_ind,iregion_bb,
1498	. lmt_bcff, lmt_bcnff, lmt_bcbb_l,lmt_bcbb_h,
1499	. lmt_bcba, lmt_omff, lmt_omnff,
1500	. lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba,
1501	. flux_sparam_bb, flux_sparam_ff,
1502	. source_tr,flux_tr,tr_seri)
1503	c
1504	!
1505	IF (lminmax) THEN
1506	DO it=1,nbtr
1507	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_fineem')
1508	ENDDO
1509	DO it=1,nbtr
1510	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after fineem')
1511	ENDDO
1512	DO it=1,nbtr
1513	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1514	. pplay,t_seri,iscm3,'after fineem')
1515	ENDDO
1516	CALL minmaxsource(source_tr,qmin,qmax,'src: after fineem')
1517	ENDIF
1518
1519	IF (logitime) THEN
1520	CALL SYSTEM_CLOCK(COUNT=clock_end)
1521	dife=clock_end-clock_start
1522	ti_emis=dife*MAX(0,SIGN(1,dife))
1523	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1524	tia_emis=tia_emis+REAL(ti_emis)/REAL(clock_rate)
1525	ENDIF
1526
1527
1528
1529
1530
1531	c
1532	c=======================================================================
1533	c DRY DEPOSITION AND BOUNDARY LAYER MIXING
1534	c=======================================================================
1535	c
1536	! DO it=1,nbtr
1537	! CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1538	! . pplay,t_seri,iscm3,'')
1539	! ENDDO
1540
1541	!======================================================================
1542	! -- Dry deposition --
1543	!======================================================================
1544	IF (logitime) THEN
1545	CALL SYSTEM_CLOCK(COUNT=clock_start)
1546	ENDIF
1547
1548	DO it=1, nbtr
1549	DO j=1,klev
1550	DO i=1,klon
1551	tmp_var(i,j)=tr_seri(i,j,it)
1552	ENDDO
1553	ENDDO
1554	CALL cm3_to_kg(pplay,t_seri,tmp_var)
1555	DO j=1,klev
1556	DO i=1,klon
1557	tr_seri(i,j,it)=tmp_var(i,j)
1558	ENDDO
1559	ENDDO
1560	ENDDO
1561	iscm3=.false.
1562	c----------------------------
1563	IF (lminmax) THEN
1564	DO it=1,nbtr
1565	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_depo')
1566	ENDDO
1567	DO it=1,nbtr
1568	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before depo')
1569	ENDDO
1570	DO it=1,nbtr
1571	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1572	. pplay,t_seri,iscm3,'before depo')
1573	ENDDO
1574	CALL minmaxsource(source_tr,qmin,qmax,'src: before depo')
1575	ENDIF
1576
1577	CALL deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf,
1578	. zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay,paprs,
1579	. lminmax,qmin,qmax,
1580	. his_ds,source_tr,tr_seri)
1581	c
1582	IF (lminmax) THEN
1583	DO it=1,nbtr
1584	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_depo')
1585	ENDDO
1586	DO it=1,nbtr
1587	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after depo')
1588	ENDDO
1589	DO it=1,nbtr
1590	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1591	. pplay,t_seri,iscm3,'after depo')
1592	ENDDO
1593
1594	CALL minmaxsource(source_tr,qmin,qmax,'src: after depo')
1595	ENDIF
1596
1597	IF (logitime) THEN
1598	CALL SYSTEM_CLOCK(COUNT=clock_end)
1599	dife=clock_end-clock_start
1600	ti_depo=dife*MAX(0,SIGN(1,dife))
1601	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1602	tia_depo=tia_depo+REAL(ti_depo)/REAL(clock_rate)
1603	ENDIF
1604
1605
1606	c
1607	!======================================================================
1608	! -- Boundary layer mixing --
1609	!======================================================================
1610
1611
1612	IF (logitime) THEN
1613	CALL SYSTEM_CLOCK(COUNT=clock_start)
1614	ENDIF
1615
1616	c
1617
1618	DO k = 1, klev
1619	DO i = 1, klon
1620	delp(i,k) = paprs(i,k)-paprs(i,k+1)
1621	END DO
1622	END DO
1623	c
1624	DO it=1, nbtr
1625	DO j=1, klev
1626	DO i=1, klon
1627	tmp_var(i,j)=tr_seri(i,j,it)
1628	aux_var2(i)=source_tr(i,it)
1629	ENDDO
1630	ENDDO
1631	IF (iflag_conv.EQ.2) THEN
1632	! Tiedke
1633	CALL cltrac_spl(pdtphys,coefh,yu1,yv1,t_seri,tmp_var,
1634	. aux_var2,paprs,pplay,aux_var3)
1635
1636	ELSE IF (iflag_conv.GE.3) THEN
1637	!KE
1638	CALL cltrac(pdtphys, coefh,t_seri,tmp_var,aux_var2,paprs,pplay,
1639	. delp,aux_var3,d_tr_dry,flux_tr_dry(:,it))
1640	ENDIF
1641
1642	DO i=1, klon
1643	DO j=1, klev
1644	tr_seri(i,j,it)=tmp_var(i,j)
1645	d_tr(i,j,it)=aux_var3(i,j)
1646	ENDDO
1647	ENDDO
1648	DO k = 1, klev
1649	DO i = 1, klon
1650	tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it)
1651	ENDDO
1652	ENDDO
1653	print *,' AFTER Cltrac'
1654	IF (lminmax) THEN
1655	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after cltrac')
1656	ENDIF
1657	ENDDO !--end itr loop
1658
1659	IF (logitime) THEN
1660	CALL SYSTEM_CLOCK(COUNT=clock_end)
1661	dife=clock_end-clock_start
1662	ti_cltr=dife*MAX(0,SIGN(1,dife))
1663	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1664	tia_cltr=tia_cltr+REAL(ti_cltr)/REAL(clock_rate)
1665	ENDIF
1666
1667
1668
1669	!======================================================================
1670	! -- Calcul de l'effet des thermiques for KE--
1671	!======================================================================
1672
1673	IF (iflag_conv.GE.3) THEN
1674
1675	IF (logitime) THEN
1676	CALL SYSTEM_CLOCK(COUNT=clock_start)
1677	ENDIF
1678
1679
1680
1681
1682
1683	IF (lminmax) THEN
1684	DO it=1,nbtr
1685	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before therm')
1686	ENDDO
1687	DO it=1,nbtr
1688	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before therm')
1689	ENDDO
1690	DO it=1,nbtr
1691	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1692	. pplay,t_seri,iscm3,'before therm')
1693	ENDDO
1694	CALL minmaxsource(source_tr,qmin,qmax,'before therm')
1695	ENDIF
1696
1697	DO it=1,nbtr
1698	DO k=1,klev
1699	DO i=1,klon
1700	tmp_var3(i,k,it)=tr_seri(i,k,it)
1701	d_tr_th(i,k,it)=0.
1702	tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.)
1703	!JE: precursor >>1e10 tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10)
1704	END DO
1705	END DO
1706	END DO
1707
1708	!JE new implicit scheme 20140323
1709	DO it=1,nbtr
1710	CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm,
1711	. zmasse,tr_seri(1:klon,1:klev,it),
1712	. d_tr(1:klon,1:klev,it),ztra_th,0 )
1713
1714	DO k=1,klev
1715	DO i=1,klon
1716	d_tr(i,k,it)=pdtphys*d_tr(i,k,it)
1717	d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it)
1718	tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.)
1719	END DO
1720	END DO
1721
1722	ENDDO
1723
1724	! old scheme explicit
1725	! nsplit=10
1726	! DO it=1,nbtr
1727	! DO isplit=1,nsplit
1728	! CALL dqthermcell(klon,klev,pdtphys/nsplit,
1729	! . fm_therm,entr_therm,zmasse,
1730	! . tr_seri(1:klon,1:klev,it),
1731	! . d_tr(1:klon,1:klev,it),ztra_th)
1732	! DO k=1,klev
1733	! DO i=1,klon
1734	! d_tr(i,k,it)=pdtphys*d_tr(i,k,it)/nsplit
1735	! d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it)
1736	! tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.)
1737	! END DO
1738	! END DO
1739	! END DO ! nsplit1
1740	! END DO ! it
1741	!JE end modif 20140323
1742
1743	DO it=1,nbtr
1744	DO k=1,klev
1745	DO i=1,klon
1746	tmp_var(i,k)=tr_seri(i,k,it)-tmp_var3(i,k,it)
1747	ENDDO
1748	ENDDO
1749	IF (lminmax) THEN
1750	CALL checkmass(tmp_var(:,:),RNAVO,masse(it),zdz,
1751	. pplay,t_seri,iscm3,'dtr therm ')
1752	ENDIF
1753	CALL kg_to_cm3(pplay,t_seri,tmp_var)
1754
1755	DO k=1,klev
1756	DO i=1,klon
1757	his_th(i,it)=his_th(i,it)+
1758	. (tmp_var(i,k))/RNAVO*
1759	. masse(it)1.e31.e6*zdz(i,k)/pdtphys
1760	END DO !klon
1761	END DO !klev
1762
1763	END DO !it
1764	IF (lminmax) THEN
1765	DO it=1,nbtr
1766	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after therm')
1767	ENDDO
1768	DO it=1,nbtr
1769	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after therm')
1770	ENDDO
1771	DO it=1,nbtr
1772	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1773	. pplay,t_seri,iscm3,'after therm')
1774	ENDDO
1775	CALL minmaxsource(source_tr,qmin,qmax,'after therm')
1776	ENDIF
1777
1778	IF (logitime) THEN
1779	CALL SYSTEM_CLOCK(COUNT=clock_end)
1780	dife=clock_end-clock_start
1781	ti_ther=dife*MAX(0,SIGN(1,dife))
1782	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1783	tia_ther=tia_ther+REAL(ti_ther)/REAL(clock_rate)
1784	ENDIF
1785
1786
1787	ENDIF ! iflag_conv KE
1788	c------------------------------------
1789	c Sedimentation
1790	c-----------------------------------
1791	IF (logitime) THEN
1792	CALL SYSTEM_CLOCK(COUNT=clock_start)
1793	ENDIF
1794
1795
1796	DO it=1,nbtr
1797	DO j=1,klev
1798	DO i=1,klon
1799	tmp_var(i,j)=tr_seri(i,j,it)
1800	ENDDO
1801	ENDDO
1802	CALL kg_to_cm3(pplay,t_seri,tmp_var)
1803	DO j=1,klev
1804	DO i=1,klon
1805	tr_seri(i,j,it)=tmp_var(i,j)
1806	ENDDO
1807	ENDDO
1808	ENDDO !--end itr loop
1809	iscm3=.true.
1810	c--------------------------------------
1811	print *,' BEFORE Sediment'
1812
1813	IF (lminmax) THEN
1814	DO it=1,nbtr
1815	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_sedi')
1816	ENDDO
1817	DO it=1,nbtr
1818	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before sedi')
1819	ENDDO
1820	DO it=1,nbtr
1821	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1822	. pplay,t_seri,iscm3,'before sedi')
1823	ENDDO
1824	CALL minmaxsource(source_tr,qmin,qmax,'src: before sedi')
1825	ENDIF
1826
1827	print *,'SPLA VERSION OF SEDIMENTATION IS USED'
1828	CALL sediment_mod(t_seri,pplay,zrho,paprs,pdtphys,RHcl,!xlon,xlat,
1829	. sed_ss,sed_dust,tr_seri)
1830	c
1831	print *,'AFTER Sediment'
1832
1833	IF (lminmax) THEN
1834	DO it=1,nbtr
1835	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_sedi')
1836	ENDDO
1837	DO it=1,nbtr
1838	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after sedi')
1839	ENDDO
1840	DO it=1,nbtr
1841	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1842	. pplay,t_seri,iscm3,'after sedi')
1843	ENDDO
1844	CALL minmaxsource(source_tr,qmin,qmax,'src: after sedi')
1845	ENDIF
1846	c
1847	c=======================================================================
1848	c
1849	IF (logitime) THEN
1850	CALL SYSTEM_CLOCK(COUNT=clock_end)
1851	dife=clock_end-clock_start
1852	ti_sedi=dife*MAX(0,SIGN(1,dife))
1853	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1854	tia_sedi=tia_sedi+REAL(ti_sedi)/REAL(clock_rate)
1855	ENDIF
1856
1857	DO it=1, nbtr
1858	DO j=1,klev
1859	DO i=1,klon
1860	tmp_var(i,j)=tr_seri(i,j,it)
1861	ENDDO
1862	ENDDO
1863	CALL cm3_to_kg(pplay,t_seri,tmp_var)
1864	DO j=1,klev
1865	DO i=1,klon
1866	tr_seri(i,j,it)=tmp_var(i,j)
1867	ENDDO
1868	ENDDO
1869	ENDDO
1870	iscm3=.false.
1871	c
1872	c
1873	c======================================================================
1874	c GAS TO PARTICLE CONVERSION
1875	c======================================================================
1876	c
1877
1878	IF (logitime) THEN
1879	CALL SYSTEM_CLOCK(COUNT=clock_start)
1880	ENDIF
1881
1882	IF (lminmax) THEN
1883	DO it=1,nbtr
1884	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_beforegastopar')
1885	ENDDO
1886	DO it=1,nbtr
1887	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before gastopar')
1888	ENDDO
1889	DO it=1,nbtr
1890	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1891	. pplay,t_seri,iscm3,'before gastopar')
1892	ENDDO
1893	CALL minmaxsource(source_tr,qmin,qmax,'src: before gastopar')
1894	ENDIF
1895
1896	CALL gastoparticle(pdtphys,zdz,zrho,xlat,
1897	. pplay,t_seri,
1898	. tr_seri,his_g2pgas ,his_g2paer)
1899	c
1900	IF (lminmax) THEN
1901	DO it=1,nbtr
1902	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_gastopar')
1903	ENDDO
1904	DO it=1,nbtr
1905	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after gastopar')
1906	ENDDO
1907	DO it=1,nbtr
1908	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1909	. pplay,t_seri,iscm3,'after gastopar')
1910	ENDDO
1911	CALL minmaxsource(source_tr,qmin,qmax,'src: after gastopar')
1912	ENDIF
1913
1914	IF (logitime) THEN
1915	CALL SYSTEM_CLOCK(COUNT=clock_end)
1916	dife=clock_end-clock_start
1917	ti_gasp=dife*MAX(0,SIGN(1,dife))
1918	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
1919	tia_gasp=tia_gasp+REAL(ti_gasp)/REAL(clock_rate)
1920	ENDIF
1921
1922
1923	c
1924	c======================================================================
1925	c EFFECT OF PRECIPITATION: iflag_conv=2
1926	c======================================================================
1927	c
1928	IF (iflag_conv.EQ.2) THEN
1929
1930	IF (logitime) THEN
1931	CALL SYSTEM_CLOCK(COUNT=clock_start)
1932	ENDIF
1933
1934
1935
1936
1937	DO it=1, nbtr
1938	DO j=1,klev
1939	DO i=1,klon
1940	tmp_var(i,j)=tr_seri(i,j,it)
1941	ENDDO
1942	ENDDO
1943	CALL kg_to_cm3(pplay,t_seri,tmp_var)
1944	DO j=1,klev
1945	DO i=1,klon
1946	tr_seri(i,j,it)=tmp_var(i,j)
1947	ENDDO
1948	ENDDO
1949	ENDDO
1950	iscm3=.true.
1951	c------------------------------
1952
1953	print *,'iflag_conv bef lessiv',iflag_conv
1954	IF (lessivage) THEN
1955	c
1956	print *,' BEFORE Incloud'
1957
1958	IF (lminmax) THEN
1959	DO it=1,nbtr
1960	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_incloud')
1961	ENDDO
1962	DO it=1,nbtr
1963	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before incloud')
1964	ENDDO
1965	DO it=1,nbtr
1966	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
1967	. pplay,t_seri,iscm3,'before incloud')
1968	ENDDO
1969	CALL minmaxsource(source_tr,qmin,qmax,'src: before incloud')
1970	ENDIF
1971
1972
1973	! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl,
1974	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
1975
1976	! . his_dhlsc,his_dhcon,tr_seri)
1977	print *,'iflag_conv bef incloud',iflag_conv
1978
1979	IF (iflag_conv.EQ.2) THEN
1980	! Tiedke
1981	CALL incloud_scav(.false.,qmin,qmax,masse,henry,kk,prfl,
1982	. psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
1983	. his_dhlsc,his_dhcon,tr_seri)
1984
1985	!---------- to use this option please comment lsc_scav at the end
1986	! ELSE IF (iflag_conv.GE.3) THEN
1987	!
1988	! CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl,
1989	! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
1990	! . his_dhlsc,his_dhcon,tr_seri)
1991	!--------------------------------------------------------------
1992
1993	ENDIF
1994	c
1995	c
1996	print *,' BEFORE blcloud (after incloud)'
1997	IF (lminmax) THEN
1998	DO it=1,nbtr
1999	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_blcloud')
2000	ENDDO
2001	DO it=1,nbtr
2002	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before blcloud')
2003	ENDDO
2004	DO it=1,nbtr
2005	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2006	. pplay,t_seri,iscm3,'before blcloud')
2007	ENDDO
2008	CALL minmaxsource(source_tr,qmin,qmax,'src: before blcloud')
2009	ENDIF
2010
2011	! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl,
2012	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2013	! . his_dhbclsc,his_dhbccon,tr_seri)
2014
2015	IF (iflag_conv.EQ.2) THEN
2016	! Tiedke
2017
2018	CALL blcloud_scav(.false.,qmin,qmax,pdtphys,prfl,psfl,
2019	. pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2020	. his_dhbclsc,his_dhbccon,tr_seri)
2021
2022	!---------- to use this option please comment lsc_scav at the end
2023	! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:"
2024	!
2025	!
2026	! ELSE IF (iflag_conv.GE.3) THEN
2027	!
2028	! CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl,
2029	! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse,
2030	! . his_dhbclsc,his_dhbccon,tr_seri)
2031	!
2032	!----------------------------------------------------------------------
2033	ENDIF
2034
2035
2036	print *,' AFTER blcloud '
2037
2038	IF (lminmax) THEN
2039	DO it=1,nbtr
2040	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_blcloud')
2041	ENDDO
2042	DO it=1,nbtr
2043	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after blcloud')
2044	ENDDO
2045	DO it=1,nbtr
2046	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2047	. pplay,t_seri,iscm3,'after blcloud')
2048	ENDDO
2049	CALL minmaxsource(source_tr,qmin,qmax,'src: after blcloud')
2050	ENDIF
2051
2052
2053	ENDIF !--lessivage
2054
2055	DO it=1, nbtr
2056	DO j=1,klev
2057	DO i=1,klon
2058	tmp_var(i,j)=tr_seri(i,j,it)
2059	ENDDO
2060	ENDDO
2061	CALL cm3_to_kg(pplay,t_seri,tmp_var)
2062	DO j=1,klev
2063	DO i=1,klon
2064	tr_seri(i,j,it)=tmp_var(i,j)
2065	ENDDO
2066	ENDDO
2067	ENDDO
2068	iscm3=.false.
2069	c
2070	IF (logitime) THEN
2071	CALL SYSTEM_CLOCK(COUNT=clock_end)
2072	dife=clock_end-clock_start
2073	ti_wetap=dife*MAX(0,SIGN(1,dife))
2074	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2075	tia_wetap=tia_wetap+REAL(ti_wetap)/REAL(clock_rate)
2076	ENDIF
2077
2078
2079
2080
2081	ENDIF ! iflag_conv=2
2082
2083	c
2084	c
2085	c======================================================================
2086	c EFFECT OF CONVECTION
2087	c======================================================================
2088	c
2089	IF (logitime) THEN
2090	CALL SYSTEM_CLOCK(COUNT=clock_start)
2091	ENDIF
2092
2093
2094	IF (convection) THEN
2095	c
2096	print *,' BEFORE trconvect'
2097
2098	IF (lminmax) THEN
2099	DO it=1,nbtr
2100	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_trconve')
2101	ENDDO
2102	DO it=1,nbtr
2103	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before trconve')
2104	ENDDO
2105	DO it=1,nbtr
2106	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2107	. pplay,t_seri,iscm3,'before trconve')
2108	ENDDO
2109	CALL minmaxsource(source_tr,qmin,qmax,'src: before trconve')
2110	ENDIF
2111
2112
2113	! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
2114	! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse,
2115	! . dtrconv,tr_seri)
2116	! -------------------------------------------------------------
2117	IF (iflag_conv.EQ.2) THEN
2118	! Tiedke
2119	CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,
2120	. pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,.false.,masse,
2121	. dtrconv,tr_seri)
2122	DO it=1, nbtr
2123	d_tr_cv(:,:,it)=0.
2124	ENDDO
2125
2126	ELSE IF (iflag_conv.GE.3) THEN
2127	! KE
2128	print *,'JE: KE in phytracr_spl'
2129	DO it=1, nbtr
2130	DO k = 1, klev
2131	DO i = 1, klon
2132	tmp_var3(i,k,it)=tr_seri(i,k,it)
2133	END DO
2134	END DO
2135	ENDDO
2136
2137	DO it=1, nbtr
2138	! routine for aerosols . otherwise, check cvltrorig
2139	print *,'Check sum before cvltr it',it,SUM(tr_seri(:,:,it))
2140	IF (.FALSE.) THEN
2141	CALL cvltr_spl(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
2142	. sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
2143	. pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,
2144	! . paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con,
2145	. paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con,
2146	. henry,kk,zrho,
2147	. d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
2148	. qPa,qMel,qTrdi,dtrcvMA,Mint,
2149	. zmfd1a,zmfphi2,zmfdam)
2150	print *,'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
2151	! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
2152	ENDIF
2153
2154
2155	IF (.FALSE.) THEN
2156	CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep,
2157	. sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm,
2158	. pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM,
2159	. paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con,
2160	. d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,
2161	. qPa,qMel,qTrdi,dtrcvMA,Mint,
2162	. zmfd1a,zmfphi2,zmfdam)
2163	! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr)
2164	ENDIF
2165
2166
2167
2168	!!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,
2169	!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3,
2170	!!! . upwd,dnwd,d_tr_cv)
2171	! CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,
2172	! . pplay,tmp_var3,upwd,dnwd,d_tr_cv)
2173
2174	DO k = 1, klev
2175	DO i = 1, klon
2176	! tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
2177	tr_seri(i,k,it)=(tmp_var3(i,k,it)+d_tr_cv(i,k,it))
2178	tmp_var(i,k)=d_tr_cv(i,k,it)
2179
2180	END DO
2181	END DO
2182
2183	CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation
2184
2185	DO k = 1, klev
2186	DO i = 1, klon
2187	dtrconv(i,it)=0.0
2188	his_dhkecv(i,it)=his_dhkecv(i,it)-tmp_var(i,k)
2189	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2190	END DO
2191	END DO
2192	print *,'Check sum after cvltr it',it,SUM(tr_seri(:,:,it))
2193	CALL minmaxqfi2(d_tr_cv(:,:,it),qmin,qmax,'d_tr_cv:')
2194	CALL minmaxqfi2(d_tr_trsp(:,:,it),qmin,qmax,'d_tr_trsp:')
2195	CALL minmaxqfi2(d_tr_sscav(:,:,it),qmin,qmax,'d_tr_sscav:')
2196	CALL minmaxqfi2(d_tr_sat(:,:,it),qmin,qmax,'d_tr_sat:')
2197	CALL minmaxqfi2(d_tr_uscav(:,:,it),qmin,qmax,'d_tr_uscav:')
2198	CALL checkmass(d_tr_cv(:,:,it),RNAVO,masse(it),zdz,
2199	. pplay,t_seri,.false.,'d_tr_cv:')
2200
2201	ENDDO ! it=1,nbtr
2202
2203	ENDIF ! iflag_conv
2204	IF (lminmax) THEN
2205	DO it=1,nbtr
2206	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_trcon')
2207	ENDDO
2208	DO it=1,nbtr
2209	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after trconv')
2210	ENDDO
2211	DO it=1,nbtr
2212	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2213	. pplay,t_seri,iscm3,'after trconv')
2214	ENDDO
2215	CALL minmaxsource(source_tr,qmin,qmax,'src: after trconv')
2216	ENDIF
2217	ENDIF ! convection
2218
2219	IF (logitime) THEN
2220	CALL SYSTEM_CLOCK(COUNT=clock_end)
2221	dife=clock_end-clock_start
2222	ti_cvltr=dife*MAX(0,SIGN(1,dife))
2223	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2224	tia_cvltr=tia_cvltr+REAL(ti_cvltr)/REAL(clock_rate)
2225	ENDIF
2226
2227
2228
2229	c
2230	c
2231	c=======================================================================
2232	c LARGE SCALE SCAVENGING KE
2233	c=======================================================================
2234	c
2235
2236	IF (iflag_conv.GE.3) THEN
2237	IF (logitime) THEN
2238	CALL SYSTEM_CLOCK(COUNT=clock_start)
2239	ENDIF
2240
2241
2242	IF (lessivage) THEN
2243	print *,' BEFORE lsc_scav '
2244	IF (lminmax) THEN
2245	DO it=1,nbtr
2246	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_lsc_scav')
2247	ENDDO
2248	DO it=1,nbtr
2249	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before lsc_scav')
2250	ENDDO
2251	DO it=1,nbtr
2252	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2253	. pplay,t_seri,iscm3,'before lsc_scav')
2254	ENDDO
2255	CALL minmaxsource(source_tr,qmin,qmax,'src: before lsc_scav')
2256	ENDIF
2257
2258
2259
2260	ql_incloud_ref = 10.e-4
2261	ql_incloud_ref = 5.e-4
2262	! calcul du contenu en eau liquide au sein du nuage
2263	ql_incl = ql_incloud_ref
2264	! choix du lessivage
2265	IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
2266	print *,'JE iflag_lscav',iflag_lscav
2267	DO it = 1, nbtr
2268
2269	! incloud scavenging and removal by large scale rain ! orig : ql_incl
2270	! was replaced by 0.5e-3 kg/kg
2271	! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR
2272	! Liu (2001) proposed to use 1.5e-3 kg/kg
2273
2274	CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,
2275	. rneb,beta_fisrt, beta_v1,pplay,paprs,
2276	. t_seri,tr_seri,d_tr_insc,
2277	. d_tr_bcscav,d_tr_evapls,qPrls)
2278
2279	!large scale scavenging tendency
2280	DO k = 1, klev
2281	DO i = 1, klon
2282	d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)
2283	. +d_tr_evapls(i,k,it)
2284	tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)
2285	tmp_var(i,k)=d_tr_ls(i,k,it)
2286	ENDDO
2287	ENDDO
2288
2289	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2290	DO k=1,klev
2291	DO i=1,klon
2292	his_dhkelsc(i,it)=his_dhkelsc(i,it)-tmp_var(i,k)
2293	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2294
2295	END DO
2296	END DO
2297
2298	END DO !tr
2299	ELSE
2300	his_dhkelsc(i,it)=0.0
2301	print *,'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4'
2302	ENDIF !iflag_lscav
2303
2304	print *,' AFTER lsc_scav '
2305	IF (lminmax) THEN
2306	DO it=1,nbtr
2307	CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_lsc_scav')
2308	ENDDO
2309	DO it=1,nbtr
2310	CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after lsc_scav')
2311	ENDDO
2312	DO it=1,nbtr
2313	CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz,
2314	. pplay,t_seri,iscm3,'after lsc_scav')
2315	ENDDO
2316	CALL minmaxsource(source_tr,qmin,qmax,'src: after lsc_scav')
2317	ENDIF
2318
2319	ENDIF ! lessivage
2320
2321	IF (logitime) THEN
2322	CALL SYSTEM_CLOCK(COUNT=clock_end)
2323	dife=clock_end-clock_start
2324	ti_lscs=dife*MAX(0,SIGN(1,dife))
2325	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2326	tia_lscs=tia_lscs+REAL(ti_lscs)/REAL(clock_rate)
2327	ENDIF
2328
2329
2330
2331	ENDIF !iflag_conv
2332
2333
2334	c=======================================================================
2335	c COMPUTING THE BURDEN
2336	c=======================================================================
2337	c
2338	IF (logitime) THEN
2339	CALL SYSTEM_CLOCK(COUNT=clock_start)
2340	ENDIF
2341
2342
2343	DO it=1, nbtr
2344	DO j=1,klev
2345	DO i=1,klon
2346	tmp_var(i,j)=tr_seri(i,j,it)
2347	ENDDO
2348	ENDDO
2349	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2350	DO j=1,klev
2351	DO i=1,klon
2352	tr_seri(i,j,it)=tmp_var(i,j)
2353	ENDDO
2354	ENDDO
2355	ENDDO
2356	iscm3=.true.
2357
2358	c
2359	c Computing burden in mg/m2
2360	DO it=1, nbtr
2361	DO k=1, klev
2362	DO i=1, klon
2363	trm(i,it)=trm(i,it)+tr_seri(i,k,it)1.e6zdz(i,k)*
2364	. masse(it)*1.e3/RNAVO !--mg S/m2
2365	ENDDO
2366	ENDDO
2367	ENDDO
2368	c
2369	c Computing Surface concentration in ug/m3
2370	c
2371	DO it=1, nbtr
2372	DO i=1, klon
2373	sconc_seri(i,it)=tr_seri(i,1,it)1.e6
2374	. masse(it)*1.e3/RNAVO !--mg/m3 (tr_seri ist in g/cm3)
2375	ENDDO
2376	ENDDO
2377	c
2378	c=======================================================================
2379	c CALCULATION OF OPTICAL PROPERTIES
2380	c=======================================================================
2381	c
2382	CALL aeropt_spl(zdz, tr_seri, RHcl,
2383	. diff_aod550_tot,diag_aod670_tot,diag_aod865_tot,
2384	. diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2,
2385	. diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,
2386	. diag_aod550_dust,diag_aod670_dust,diag_aod865_dust)
2387
2388
2389
2390	IF (logitime) THEN
2391	CALL SYSTEM_CLOCK(COUNT=clock_end)
2392	dife=clock_end-clock_start
2393	ti_brop=dife*MAX(0,SIGN(1,dife))
2394	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2395	tia_brop=tia_brop+REAL(ti_brop)/REAL(clock_rate)
2396	ENDIF
2397
2398
2399
2400	c
2401	c======================================================================
2402	c Stockage sur bande histoire
2403	c======================================================================
2404	c
2405	IF (logitime) THEN
2406	CALL SYSTEM_CLOCK(COUNT=clock_start)
2407	ENDIF
2408
2409	DO it=1, nbtr
2410	DO j=1,klev
2411	DO i=1,klon
2412	tmp_var(i,j)=tr_seri(i,j,it)
2413	ENDDO
2414	ENDDO
2415	CALL cm3_to_kg(pplay,t_seri,tmp_var)
2416	DO j=1,klev
2417	DO i=1,klon
2418	tr_seri(i,j,it)=tmp_var(i,j)
2419	ENDDO
2420	ENDDO
2421	ENDDO
2422	iscm3=.false.
2423
2424	c
2425	c
2426	c======================================================================
2427	c SAVING AEROSOL RELATED VARIABLES INTO FILE
2428	c======================================================================
2429	c
2430	IF (ok_histrac) THEN
2431	c
2432	ndex2d = 0
2433	ndex3d = 0
2434	c
2435	itra=itra+1
2436
2437	print *,'SAVING VARIABLES FOR DAY ',itra
2438	c
2439	fluxbb(:)=0.0
2440	fluxff(:)=0.0
2441	fluxbcbb(:)=0.0
2442	fluxbcff(:)=0.0
2443	fluxbcnff(:)=0.0
2444	fluxbcba(:)=0.0
2445	fluxbc(:)=0.0
2446	fluxombb(:)=0.0
2447	fluxomff(:)=0.0
2448	fluxomnat(:)=0.0
2449	fluxomba(:)=0.0
2450	fluxomnff(:)=0.0
2451	fluxom(:)=0.0
2452	fluxh2sff(:)=0.0
2453	fluxh2snff(:)=0.0
2454	fluxh2sbio(:)=0.0
2455	fluxso2ff(:)=0.0
2456	fluxso2nff(:)=0.0
2457	fluxso2bb(:)=0.0
2458	fluxso2vol(:)=0.0
2459	fluxso2ba(:)=0.0
2460	fluxso2(:)=0.0
2461	fluxso4ff(:)=0.0
2462	fluxso4nff(:)=0.0
2463	fluxso4bb(:)=0.0
2464	fluxso4ba(:)=0.0
2465	fluxso4(:)=0.0
2466	fluxdms(:)=0.0
2467	fluxdustec(:)=0.0
2468	fluxddfine(:)=0.0
2469	fluxddcoa(:)=0.0
2470	fluxdd(:)=0.0
2471	fluxssfine(:)=0.0
2472	fluxsscoa(:)=0.0
2473	fluxss(:)=0.0
2474	DO i=1, klon
2475	IF (iregion_ind(i).GT.0) THEN ! LAND
2476	! SULFUR EMISSIONS
2477	fluxh2sff(i)= (lmt_so2ff_l(i)+lmt_so2ff_h(i))frach2sofso2
2478	. scale_param_ind(iregion_ind(i))*
2479	. 1.e4/RNAVOmasse_s1.e3 ! mgS/m2/s
2480	fluxso2ff(i)=scale_param_ind(iregion_ind(i)) * fracso2emis *
2481	. (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO *
2482	. masse_s * 1.e3 ! mgS/m2/s
2483	! SULPHATE EMISSIONS
2484	fluxso4ff(i)=scale_param_ind(iregion_ind(i))(1-fracso2emis)
2485	. (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO *
2486	. masse_s * 1.e3 ! mgS/m2/s
2487	! BLACK CARBON EMISSIONS
2488	fluxbcff(i)=scale_param_ff(iregion_ind(i))*
2489	. lmt_bcff(i)1.e41.e3 !/g/m2/s
2490	! ORGANIC MATTER EMISSIONS
2491	fluxomff(i)=scale_param_ff(iregion_ind(i))*
2492	. (lmt_omff(i))1.e41.e3 !/g/m2/s
2493	! FOSSIL FUEL EMISSIONS
2494	fluxff(i)=fluxbcff(i)+fluxomff(i)
2495	ENDIF
2496	IF (iregion_bb(i).GT.0) THEN ! LAND
2497	! SULFUR EMISSIONS
2498	fluxso2bb(i) =scale_param_bb(iregion_bb(i)) * fracso2emis *
2499	. (lmt_so2bb_l(i)+lmt_so2bb_h(i))*
2500	. (1.-pctsrf(i,is_oce))1.e4/RNAVOmasse_s*1.e3 ! mgS/m2/s
2501	! SULPHATE EMISSIONS
2502	fluxso4bb(i) =scale_param_bb(iregion_bb(i))(1-fracso2emis)
2503	. (lmt_so2bb_l(i)+lmt_so2bb_h(i))*
2504	. (1.-pctsrf(i,is_oce))1.e4/RNAVOmasse_s*1.e3 ! mgS/m2/s
2505	! BLACK CARBON EMISSIONS
2506	fluxbcbb(i)=scale_param_bb(iregion_bb(i))*
2507	. (lmt_bcbb_l(i)+lmt_bcbb_h(i))1.e41.e3 !mg/m2/s
2508	! ORGANIC MATTER EMISSIONS
2509	fluxombb(i)=scale_param_bb(iregion_bb(i))*
2510	. (lmt_ombb_l(i)+lmt_ombb_h(i))1.e41.e3 !mg/m2/s
2511	! BIOMASS BURNING EMISSIONS
2512	fluxbb(i)=fluxbcbb(i)+fluxombb(i)
2513	ENDIF
2514	! H2S EMISSIONS
2515	fluxh2sbio(i)=lmt_h2sbio(i)1.e4/RNAVOmasse_s*1.e3 ! mgS/m2/s
2516	fluxh2snff(i)= lmt_so2nff(i)frach2sofso2
2517	. 1.e4/RNAVOmasse_s1.e3 ! mgS/m2/s
2518	! SULFUR DIOXIDE EMISSIONS
2519	fluxso2nff(i)=fracso2emis * lmt_so2nff(i) * 1.e4/RNAVO *
2520	. masse_s * 1.e3 ! mgS/m2/s
2521	fluxso2vol(i)=(lmt_so2volc_cont(i)+lmt_so2volc_expl(i))
2522	. 1.e4/RNAVOmasse_s*1.e3 ! mgS/m2/s
2523	fluxso2ba(i) =lmt_so2ba(i)1.e4/RNAVOmasse_s1.e3
2524	. fracso2emis ! mgS/m2/s
2525	fluxso2(i)=fluxso2ff(i)+fluxso2bb(i)+fluxso2nff(i)+
2526	. fluxso2vol(i)+fluxso2ba(i)
2527	! DMS EMISSIONS
2528	fluxdms(i)=( lmt_dms(i)+lmt_dmsbio(i) )
2529	. 1.e4/RNAVOmasse_s*1.e3 ! mgS/m2/s
2530	! SULPHATE EMISSIONS
2531	fluxso4ba(i) =lmt_so2ba(i)1.e4/RNAVOmasse_s*1.e3
2532	. *(1-fracso2emis) ! mgS/m2/s
2533	fluxso4nff(i)=(1-fracso2emis)lmt_so2nff(i) 1.e4/RNAVO *
2534	. masse_s * 1.e3 ! mgS/m2/s
2535	fluxso4(i)=fluxso4ff(i)+fluxso4bb(i)+fluxso4ba(i)+fluxso4nff(i)
2536	! BLACK CARBON EMISSIONS
2537
2538	fluxbcnff(i)=lmt_bcnff(i)1.e41.e3 !mg/m2/s
2539	fluxbcba(i)=lmt_bcba(i)1.e41.e3 !mg/m2/s
2540	fluxbc(i)=fluxbcbb(i)+fluxbcff(i)+fluxbcnff(i)+fluxbcba(i)
2541	! ORGANIC MATTER EMISSIONS
2542	fluxomnat(i)=lmt_omnat(i)1.e41.e3 !mg/m2/s
2543	fluxomba(i)=lmt_omba(i)1.e41.e3 !mg/m2/s
2544	fluxomnff(i)=lmt_omnff(i)1.e41.e3 !mg/m2/s
2545	fluxom(i)=fluxombb(i)+fluxomff(i)+fluxomnat(i)+fluxomba(i)+
2546	. fluxomnff(i)
2547	! DUST EMISSIONS
2548	fluxdustec(i)=dust_ec(i)*1.e6
2549	fluxddfine(i)=scale_param_dustacc(iregion_dust(i))
2550	. * dust_ec(i)0.0931.e6
2551	fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i))
2552	. * dust_ec(i)0.9051.e6
2553	fluxdd(i)=fluxddfine(i)+fluxddcoa(i)
2554	! SEA SALT EMISSIONS
2555	fluxssfine(i)=scale_param_ssacclmt_sea_salt(i,1)1.e4*1.e3
2556	fluxsscoa(i)=scale_param_sscoalmt_sea_salt(i,2)1.e4*1.e3
2557	fluxss(i)=fluxssfine(i)+fluxsscoa(i)
2558	ENDDO
2559	! prepare outputs cvltr
2560
2561	DO it=1, nbtr
2562	DO k=1,klev
2563	DO i=1,klon
2564	tmp_var(i,k)=d_tr_cv(i,k,it)
2565	ENDDO
2566	ENDDO
2567	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2568	DO k=1,klev
2569	DO i=1,klon
2570	d_tr_cv_o(i,k,it)=tmp_var(i,k)
2571	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2572	ENDDO
2573	ENDDO
2574	ENDDO
2575	DO it=1, nbtr
2576	DO k=1,klev
2577	DO i=1,klon
2578	tmp_var(i,k)=d_tr_trsp(i,k,it)
2579	ENDDO
2580	ENDDO
2581	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2582	DO k=1,klev
2583	DO i=1,klon
2584	d_tr_trsp_o(i,k,it)=tmp_var(i,k)
2585	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2586	ENDDO
2587	ENDDO
2588	ENDDO
2589	DO it=1, nbtr
2590	DO k=1,klev
2591	DO i=1,klon
2592	tmp_var(i,k)=d_tr_sscav(i,k,it)
2593	ENDDO
2594	ENDDO
2595	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2596	DO k=1,klev
2597	DO i=1,klon
2598	d_tr_sscav_o(i,k,it)=tmp_var(i,k)
2599	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2600	ENDDO
2601	ENDDO
2602	ENDDO
2603	DO it=1, nbtr
2604	DO k=1,klev
2605	DO i=1,klon
2606	tmp_var(i,k)=d_tr_sat(i,k,it)
2607	ENDDO
2608	ENDDO
2609	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2610	DO k=1,klev
2611	DO i=1,klon
2612	d_tr_sat_o(i,k,it)=tmp_var(i,k)
2613	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2614	ENDDO
2615	ENDDO
2616	ENDDO
2617	DO it=1, nbtr
2618	DO k=1,klev
2619	DO i=1,klon
2620	tmp_var(i,k)=d_tr_uscav(i,k,it)
2621	ENDDO
2622	ENDDO
2623	CALL kg_to_cm3(pplay,t_seri,tmp_var)
2624	DO k=1,klev
2625	DO i=1,klon
2626	d_tr_uscav_o(i,k,it)=tmp_var(i,k)
2627	. /RNAVOmasse(it)1.e31.e6zdz(i,k)/pdtphys
2628	ENDDO
2629	ENDDO
2630	ENDDO
2631
2632
2633
2634	c
2635	c SAVING VARIABLES IN TRACEUR
2636	c
2637	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diff_aod550_tot,zx_tmp_2d)
2638	CALL histwrite(nid_tra3,"taue550",itra,zx_tmp_2d,
2639	. iim*(jjm+1),ndex2d)
2640	c
2641	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_tot,zx_tmp_2d)
2642	CALL histwrite(nid_tra3,"taue670",itra,zx_tmp_2d,
2643	. iim*(jjm+1),ndex2d)
2644	c
2645	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_tot,zx_tmp_2d)
2646	CALL histwrite(nid_tra3,"taue865",itra,zx_tmp_2d,
2647	. iim*(jjm+1),ndex2d)
2648	c
2649	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diff_aod550_tr2,zx_tmp_2d)
2650	CALL histwrite(nid_tra3,"taue550_tr2",itra,zx_tmp_2d,
2651	. iim*(jjm+1),ndex2d)
2652	c
2653	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_tr2,zx_tmp_2d)
2654	CALL histwrite(nid_tra3,"taue670_tr2",itra,zx_tmp_2d,
2655	. iim*(jjm+1),ndex2d)
2656	c
2657	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_tr2,zx_tmp_2d)
2658	CALL histwrite(nid_tra3,"taue865_tr2",itra,zx_tmp_2d,
2659	. iim*(jjm+1),ndex2d)
2660	c
2661	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod550_ss,zx_tmp_2d)
2662	CALL histwrite(nid_tra3,"taue550_ss",itra,zx_tmp_2d,
2663	. iim*(jjm+1),ndex2d)
2664	c
2665	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_ss,zx_tmp_2d)
2666	CALL histwrite(nid_tra3,"taue670_ss",itra,zx_tmp_2d,
2667	. iim*(jjm+1),ndex2d)
2668	c
2669	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_ss,zx_tmp_2d)
2670	CALL histwrite(nid_tra3,"taue865_ss",itra,zx_tmp_2d,
2671	. iim*(jjm+1),ndex2d)
2672	c
2673	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod550_dust,zx_tmp_2d)
2674	CALL histwrite(nid_tra3,"taue550_dust",itra,zx_tmp_2d,
2675	. iim*(jjm+1),ndex2d)
2676	c
2677	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_dust,zx_tmp_2d)
2678	CALL histwrite(nid_tra3,"taue670_dust",itra,zx_tmp_2d,
2679	. iim*(jjm+1),ndex2d)
2680	c
2681	CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_dust,zx_tmp_2d)
2682	CALL histwrite(nid_tra3,"taue865_dust",itra,zx_tmp_2d,
2683	. iim*(jjm+1),ndex2d)
2684	c
2685	DO it=1,nbtr
2686	c
2687	WRITE(str2,'(i2.2)') it
2688	c
2689	CALL gr_fi_ecrit(1,klon,iim,jjm+1,trm(1,it),zx_tmp_2d)
2690	CALL histwrite(nid_tra3,"trm"//str2,itra,zx_tmp_2d,
2691	. iim*(jjm+1),ndex2d)
2692	c
2693	CALL gr_fi_ecrit(1,klon,iim,jjm+1,sconc_seri(1,it),zx_tmp_2d)
2694	CALL histwrite(nid_tra3,"sconc"//str2,itra,zx_tmp_2d,
2695	. iim*(jjm+1),ndex2d)
2696	c
2697	c SAVING VARIABLES IN LESSIVAGE
2698	c
2699	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_tr(1,it),zx_tmp_2d)
2700	CALL histwrite(nid_tra2,"flux"//str2,itra,zx_tmp_2d,
2701	. iim*(jjm+1),ndex2d)
2702	c
2703	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_ds(1,it),zx_tmp_2d)
2704	CALL histwrite(nid_tra2,"ds"//str2,itra,zx_tmp_2d,
2705	. iim*(jjm+1),ndex2d)
2706	c
2707	DO i=1, klon
2708	zx_tmp_fi2d(i) = his_dhlsc(i,it)+his_dhcon(i,it)+
2709	. his_dhbclsc(i,it)+his_dhbccon(i,it)
2710	ENDDO
2711	c
2712	CALL gr_fi_ecrit(1,klon,iim,jjm+1,zx_tmp_fi2d,zx_tmp_2d)
2713	CALL histwrite(nid_tra2,"dh"//str2,itra,zx_tmp_2d,
2714	. iim*(jjm+1),ndex2d)
2715	C
2716	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_dhkecv(1,it),zx_tmp_2d)
2717	CALL histwrite(nid_tra2,"dhkecv"//str2,itra,zx_tmp_2d,
2718	. iim*(jjm+1),ndex2d)
2719	c
2720	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_dhkelsc(1,it),zx_tmp_2d)
2721	CALL histwrite(nid_tra2,"dhkelsc"//str2,itra,zx_tmp_2d,
2722	. iim*(jjm+1),ndex2d)
2723	c
2724
2725	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cv_o(1,1,it),
2726	. zx_tmp_3d)
2727	CALL histwrite(nid_tra2,"d_tr_cv"//str2,itra,zx_tmp_3d,
2728	. iim(jjm+1)klev,ndex3d)
2729	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_trsp_o(1,1,it),
2730	. zx_tmp_3d)
2731	CALL histwrite(nid_tra2,"d_tr_trsp"//str2,itra,zx_tmp_3d,
2732	. iim(jjm+1)klev,ndex3d)
2733	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_sscav_o(1,1,it),
2734	. zx_tmp_3d)
2735	CALL histwrite(nid_tra2,"d_tr_sscav"//str2,itra,zx_tmp_3d,
2736	. iim(jjm+1)klev,ndex3d)
2737	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_sat_o(1,1,it),
2738	. zx_tmp_3d)
2739	CALL histwrite(nid_tra2,"d_tr_sat"//str2,itra,zx_tmp_3d,
2740	. iim(jjm+1)klev,ndex3d)
2741	CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_uscav_o(1,1,it),
2742	. zx_tmp_3d)
2743	CALL histwrite(nid_tra2,"d_tr_uscav"//str2,itra,zx_tmp_3d,
2744	. iim(jjm+1)klev,ndex3d)
2745
2746
2747	CALL gr_fi_ecrit(1,klon,iim,jjm+1,dtrconv(1,it),zx_tmp_2d)
2748	CALL histwrite(nid_tra2,"dtrconv"//str2,itra,zx_tmp_2d,
2749	. iim*(jjm+1),ndex2d)
2750	c
2751	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_th(1,it),zx_tmp_2d)
2752	CALL histwrite(nid_tra2,"dtherm"//str2,itra,zx_tmp_2d,
2753	. iim*(jjm+1),ndex2d)
2754	c
2755
2756	ENDDO
2757	c
2758	CALL gr_fi_ecrit(1,klon,iim,jjm+1,sed_ss,zx_tmp_2d)
2759	CALL histwrite(nid_tra2,"sed_ss",itra,zx_tmp_2d,
2760	. iim*(jjm+1),ndex2d)
2761	c
2762	CALL gr_fi_ecrit(1,klon,iim,jjm+1,sed_dust,zx_tmp_2d)
2763	CALL histwrite(nid_tra2,"sed_dust",itra,zx_tmp_2d,
2764	. iim*(jjm+1),ndex2d)
2765	c
2766	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_g2pgas,zx_tmp_2d)
2767	CALL histwrite(nid_tra2,"g2p_gas",itra,zx_tmp_2d,
2768	. iim*(jjm+1),ndex2d)
2769	c
2770	CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_g2paer,zx_tmp_2d)
2771	CALL histwrite(nid_tra2,"g2p_aer",itra,zx_tmp_2d,
2772	. iim*(jjm+1),ndex2d)
2773	c SAVING VARIABLES IN HISTRAC
2774	c
2775	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbb,zx_tmp_2d)
2776	CALL histwrite(nid_tra1,"fluxbb",itra,zx_tmp_2d,
2777	. iim*(jjm+1),ndex2d)
2778	c
2779	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxff,zx_tmp_2d)
2780	CALL histwrite(nid_tra1,"fluxff",itra,zx_tmp_2d,
2781	. iim*(jjm+1),ndex2d)
2782	c
2783	c ========================= BC =============================
2784	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcbb,zx_tmp_2d)
2785	CALL histwrite(nid_tra1,"fluxbcbb",itra,zx_tmp_2d,
2786	. iim*(jjm+1),ndex2d)
2787	c
2788	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcff,zx_tmp_2d)
2789	CALL histwrite(nid_tra1,"fluxbcff",itra,zx_tmp_2d,
2790	. iim*(jjm+1),ndex2d)
2791	c
2792	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcnff,zx_tmp_2d)
2793	CALL histwrite(nid_tra1,"fluxbcnff",itra,zx_tmp_2d,
2794	. iim*(jjm+1),ndex2d)
2795	c
2796	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcba,zx_tmp_2d)
2797	CALL histwrite(nid_tra1,"fluxbcba",itra,zx_tmp_2d,
2798	. iim*(jjm+1),ndex2d)
2799	c
2800	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbc,zx_tmp_2d)
2801	CALL histwrite(nid_tra1,"fluxbc",itra,zx_tmp_2d,
2802	. iim*(jjm+1),ndex2d)
2803	c ========================= OM =============================
2804	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxombb,zx_tmp_2d)
2805	CALL histwrite(nid_tra1,"fluxombb",itra,zx_tmp_2d,
2806	. iim*(jjm+1),ndex2d)
2807	c
2808	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomff,zx_tmp_2d)
2809	CALL histwrite(nid_tra1,"fluxomff",itra,zx_tmp_2d,
2810	. iim*(jjm+1),ndex2d)
2811	c
2812	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomnff,zx_tmp_2d)
2813	CALL histwrite(nid_tra1,"fluxomnff",itra,zx_tmp_2d,
2814	. iim*(jjm+1),ndex2d)
2815	c
2816	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomba,zx_tmp_2d)
2817	CALL histwrite(nid_tra1,"fluxomba",itra,zx_tmp_2d,
2818	. iim*(jjm+1),ndex2d)
2819	c
2820	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomnat,zx_tmp_2d)
2821	CALL histwrite(nid_tra1,"fluxomnat",itra,zx_tmp_2d,
2822	. iim*(jjm+1),ndex2d)
2823	c
2824	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxom,zx_tmp_2d)
2825	CALL histwrite(nid_tra1,"fluxom",itra,zx_tmp_2d,
2826	. iim*(jjm+1),ndex2d)
2827	c ========================= SO4 =============================
2828	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4ff,zx_tmp_2d)
2829	CALL histwrite(nid_tra1,"fluxso4ff",itra,zx_tmp_2d,
2830	. iim*(jjm+1),ndex2d)
2831	c
2832	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4nff,zx_tmp_2d)
2833	CALL histwrite(nid_tra1,"fluxso4nff",itra,zx_tmp_2d,
2834	. iim*(jjm+1),ndex2d)
2835	c
2836	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4bb,zx_tmp_2d)
2837	CALL histwrite(nid_tra1,"fluxso4bb",itra,zx_tmp_2d,
2838	. iim*(jjm+1),ndex2d)
2839	c
2840	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4ba,zx_tmp_2d)
2841	CALL histwrite(nid_tra1,"fluxso4ba",itra,zx_tmp_2d,
2842	. iim*(jjm+1),ndex2d)
2843	c
2844	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4,zx_tmp_2d)
2845	CALL histwrite(nid_tra1,"fluxso4",itra,zx_tmp_2d,
2846	. iim*(jjm+1),ndex2d)
2847	c ========================= H2S =============================
2848	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2sff,zx_tmp_2d)
2849	CALL histwrite(nid_tra1,"fluxh2sff",itra,zx_tmp_2d,
2850	. iim*(jjm+1),ndex2d)
2851	c
2852	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2snff,zx_tmp_2d)
2853	CALL histwrite(nid_tra1,"fluxh2snff",itra,zx_tmp_2d,
2854	. iim*(jjm+1),ndex2d)
2855	c
2856	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2sbio,zx_tmp_2d)
2857	CALL histwrite(nid_tra1,"fluxh2sbio",itra,zx_tmp_2d,
2858	. iim*(jjm+1),ndex2d)
2859	c ========================= SO2 =============================
2860	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2ff,zx_tmp_2d)
2861	CALL histwrite(nid_tra1,"fluxso2ff",itra,zx_tmp_2d,
2862	. iim*(jjm+1),ndex2d)
2863	c
2864	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2nff,zx_tmp_2d)
2865	CALL histwrite(nid_tra1,"fluxso2nff",itra,zx_tmp_2d,
2866	. iim*(jjm+1),ndex2d)
2867	c
2868	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2bb,zx_tmp_2d)
2869	CALL histwrite(nid_tra1,"fluxso2bb",itra,zx_tmp_2d,
2870	. iim*(jjm+1),ndex2d)
2871	c
2872	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2vol,zx_tmp_2d)
2873	CALL histwrite(nid_tra1,"fluxso2vol",itra,zx_tmp_2d,
2874	. iim*(jjm+1),ndex2d)
2875	c
2876	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2ba,zx_tmp_2d)
2877	CALL histwrite(nid_tra1,"fluxso2ba",itra,zx_tmp_2d,
2878	. iim*(jjm+1),ndex2d)
2879	c
2880	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2,zx_tmp_2d)
2881	CALL histwrite(nid_tra1,"fluxso2",itra,zx_tmp_2d,
2882	. iim*(jjm+1),ndex2d)
2883	c
2884	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdms,zx_tmp_2d)
2885	CALL histwrite(nid_tra1,"fluxdms",itra,zx_tmp_2d,
2886	. iim*(jjm+1),ndex2d)
2887	c ========================= DD =============================
2888	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdustec,zx_tmp_2d)
2889	CALL histwrite(nid_tra1,"fluxdustec",itra,zx_tmp_2d,
2890	. iim*(jjm+1),ndex2d)
2891	c
2892	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxddfine,zx_tmp_2d)
2893	CALL histwrite(nid_tra1,"fluxddfine",itra,zx_tmp_2d,
2894	. iim*(jjm+1),ndex2d)
2895	c
2896	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxddcoa,zx_tmp_2d)
2897	CALL histwrite(nid_tra1,"fluxddcoa",itra,zx_tmp_2d,
2898	. iim*(jjm+1),ndex2d)
2899	c
2900	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdd,zx_tmp_2d)
2901	CALL histwrite(nid_tra1,"fluxdd",itra,zx_tmp_2d,
2902	. iim*(jjm+1),ndex2d)
2903	c ========================= SS =============================
2904	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxssfine,zx_tmp_2d)
2905	CALL histwrite(nid_tra1,"fluxssfine",itra,zx_tmp_2d,
2906	. iim*(jjm+1),ndex2d)
2907	c
2908	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxsscoa,zx_tmp_2d)
2909	CALL histwrite(nid_tra1,"fluxsscoa",itra,zx_tmp_2d,
2910	. iim*(jjm+1),ndex2d)
2911	c
2912	CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxss,zx_tmp_2d)
2913	CALL histwrite(nid_tra1,"fluxss",itra,zx_tmp_2d,
2914	. iim*(jjm+1),ndex2d)
2915	c
2916	cnhl CALL gr_fi_ecrit(klev,klon,iim,jjm+1,fluxso4chem,zx_tmp_3d)
2917	cnhl CALL histwrite(nid_tra1,"fluxso4chem",itra,zx_tmp_3d,
2918	cnhl . iim(jjm+1)klev,ndex3d)
2919	c
2920	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ind,zx_tmp_2d)
2921	CALL histwrite(nid_tra1,"flux_sparam_ind",itra,zx_tmp_2d,
2922	. iim*(jjm+1),ndex2d)
2923	c
2924	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_bb,zx_tmp_2d)
2925	CALL histwrite(nid_tra1,"flux_sparam_bb",itra,zx_tmp_2d,
2926	. iim*(jjm+1),ndex2d)
2927	c
2928	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ff,zx_tmp_2d)
2929	CALL histwrite(nid_tra1,"flux_sparam_ff",itra,zx_tmp_2d,
2930	. iim*(jjm+1),ndex2d)
2931	c
2932	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ddfine,zx_tmp_2d)
2933	CALL histwrite(nid_tra1,"flux_sparam_ddfine",itra,zx_tmp_2d,
2934	. iim*(jjm+1),ndex2d)
2935	c
2936	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ddcoa,zx_tmp_2d)
2937	CALL histwrite(nid_tra1,"flux_sparam_ddcoa",itra,zx_tmp_2d,
2938	. iim*(jjm+1),ndex2d)
2939	c
2940	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ssfine,zx_tmp_2d)
2941	CALL histwrite(nid_tra1,"flux_sparam_ssfine",itra,zx_tmp_2d,
2942	. iim*(jjm+1),ndex2d)
2943	c
2944	CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_sscoa,zx_tmp_2d)
2945	CALL histwrite(nid_tra1,"flux_sparam_sscoa",itra,zx_tmp_2d,
2946	. iim*(jjm+1),ndex2d)
2947	c
2948	CALL gr_fi_ecrit(1,klon,iim,jjm+1,u10m_ec,zx_tmp_2d)
2949	CALL histwrite(nid_tra1,"u10m",itra,zx_tmp_2d,
2950	. iim*(jjm+1),ndex2d)
2951	c
2952	CALL gr_fi_ecrit(1,klon,iim,jjm+1,v10m_ec,zx_tmp_2d)
2953	CALL histwrite(nid_tra1,"v10m",itra,zx_tmp_2d,
2954	. iim*(jjm+1),ndex2d)
2955	c
2956	cnhl CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flux_sparam_sulf,zx_tmp_3d)
2957	cnhl CALL histwrite(nid_tra1,"flux_sparam_sulf",itra,zx_tmp_3d,
2958	cnhl . iim(jjm+1)klev,ndex3d)
2959	c
2960	ENDIF ! ok_histrac
2961
2962
2963	IF (logitime) THEN
2964	CALL SYSTEM_CLOCK(COUNT=clock_end)
2965
2966	dife=clock_end-clock_start
2967	ti_outs=dife*MAX(0,SIGN(1,dife))
2968	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2969	tia_outs=tia_outs+REAL(ti_outs)/REAL(clock_rate)
2970	ENDIF
2971
2972	IF (logitime) THEN
2973	CALL SYSTEM_CLOCK(COUNT=clock_end)
2974
2975	dife=clock_end-clock_start_spla
2976	ti_spla=dife*MAX(0,SIGN(1,dife))
2977	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
2978
2979
2980	tia_spla=tia_spla+REAL(ti_spla)/REAL(clock_rate)
2981	print *,'---times for this timestep: time proc, time proc/time
2982	. phytracr_spl---'
2983	print *,'time spla',REAL(ti_spla)/REAL(clock_rate)
2984	. ,REAL(ti_spla)/REAL(ti_spla)
2985	print *,'time init',REAL(ti_init)/REAL(clock_rate)
2986	. ,REAL(ti_init)/REAL(ti_spla)
2987	print *,'time inittype',REAL(ti_inittype)/REAL(clock_rate)
2988	. ,REAL(ti_inittype)/REAL(ti_spla)
2989	print *,'time inittwrite',REAL(ti_inittwrite)/REAL(clock_rate)
2990	. ,REAL(ti_inittwrite)/REAL(ti_spla)
2991	print *,'time emis',REAL(ti_emis)/REAL(clock_rate)
2992	. ,REAL(ti_emis)/REAL(ti_spla)
2993	print *,'time depo ',REAL(ti_depo)/REAL(clock_rate)
2994	. ,REAL(ti_depo)/REAL(ti_spla)
2995	print *,'time cltr',REAL(ti_cltr)/REAL(clock_rate)
2996	. ,REAL(ti_cltr)/REAL(ti_spla)
2997	print *,'time ther',REAL(ti_ther)/REAL(clock_rate)
2998	. ,REAL(ti_ther)/REAL(ti_spla)
2999	print *,'time sedi',REAL(ti_sedi)/REAL(clock_rate)
3000	. ,REAL(ti_sedi)/REAL(ti_spla)
3001	print *,'time gas to part',REAL(ti_gasp)/REAL(clock_rate)
3002	. ,REAL(ti_gasp)/REAL(ti_spla)
3003	print *,'time AP wet',REAL(ti_wetap)/REAL(clock_rate)
3004	. ,REAL(ti_wetap)/REAL(ti_spla)
3005	print *,'time convective',REAL(ti_cvltr)/REAL(clock_rate)
3006	. ,REAL(ti_cvltr)/REAL(ti_spla)
3007	print *,'time NP lsc scav',REAL(ti_lscs)/REAL(clock_rate)
3008	. ,REAL(ti_lscs)/REAL(ti_spla)
3009	print *,'time opt,brdn,etc',REAL(ti_brop)/REAL(clock_rate)
3010	. ,REAL(ti_brop)/REAL(ti_spla)
3011	print *,'time outputs',REAL(ti_outs)/REAL(clock_rate)
3012	. ,REAL(ti_outs)/REAL(ti_spla)
3013
3014
3015	print *,'---time accumulated: time proc, time proc/time
3016	. phytracr_spl---'
3017	print *,'time spla',tia_spla
3018	print *,'time init',tia_init,tia_init/tia_spla
3019	print *,'time inittype',tia_inittype,tia_inittype/tia_spla
3020	print *,'time inittwrite',tia_inittwrite,tia_inittwrite/tia_spla
3021	print *,'time emis',tia_emis,tia_emis/tia_spla
3022	print *,'time depo',tia_depo,tia_depo/tia_spla
3023	print *,'time cltr',tia_cltr,tia_cltr/tia_spla
3024	print *,'time ther',tia_ther,tia_ther/tia_spla
3025	print *,'time sedi',tia_sedi,tia_sedi/tia_spla
3026	print *,'time gas to part',tia_gasp,tia_gasp/tia_spla
3027	print *,'time AP wet',tia_wetap,tia_wetap/tia_spla
3028	print *,'time convective',tia_cvltr,tia_cvltr/tia_spla
3029	print *,'time NP lsc scav',tia_lscs,tia_lscs/tia_spla
3030	print *,'time opt,brdn,etc',tia_brop,tia_brop/tia_spla
3031	print *,'time outputs',tia_outs,tia_outs/tia_spla
3032
3033
3034
3035	dife=clock_end_outphytracr-clock_start_outphytracr
3036	ti_nophytracr=dife*MAX(0,SIGN(1,dife))
3037	. +(dife+clock_per_max)*MAX(0,SIGN(1,-dife))
3038	tia_nophytracr=tia_nophytracr+REAL(ti_nophytracr)/REAL(clock_rate)
3039	print *,'Time outside phytracr; Time accum outside phytracr'
3040	print*,REAL(ti_nophytracr)/REAL(clock_rate),tia_nophytracr
3041
3042	clock_start_outphytracr=clock_end
3043
3044	ENDIF
3045	print *,'END PHYTRACR_SPL '
3046
3047	END

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

Download in other formats:

Original Format