source: LMDZ5/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90 @ 5437

Last change on this file since 5437 was 2648, checked in by fhourdin, 8 years ago

Correction d'un petit bug pour les dusts

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