Context Navigation

phytracr_spl.F_20140507_seq @ 2175

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

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

Download in other formats:

Original Format