source: LMDZ6/branches/Test_modipsl/libf/phylmd/Dust/phytracr_spl_mod.F90 @ 5428

Last change on this file since 5428 was 4160, checked in by asima, 3 years ago

In r4090 (FH) thermcell.h dissapears ; the flags required by subroutine thermcell_dq (iflag_wake, iflag_coupl, iflag_trig_bl, iflag_clos_bl) are now in the new file alpale.h

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