source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/phytracr_spl_mod.F90

Last change on this file was 2303, checked in by jescribano, 10 years ago

Bugs corrections, control vector is now fine mode+coarse mode and seasalt coarse+fine, change in emission scheme parameters, more outputs at 10h30 and 13h30 LT. (Pending correct optical and sedimentation parameters)

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