Context Navigation

stomate_permafrost_soilcarbon.f90 @ 7346

Last change on this file since 7346 was 7020, checked in by elodie.salmon, 3 years ago
New: ebullition threshold vary with depth
File size: 311.7 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_permafrost_soilcarbon
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see
8	! ORCHIDEE/ORCHIDEE_CeCILL.LIC
9	!
10	!>\BRIEF Calculate permafrost soil carbon dynamics following POPCRAN by Dmitry Khvorstyanov
11	!!
12	!!\n DESCRIPTION: None
13	!!
14	!! RECENT CHANGE(S): None
15	!!
16	!! SVN :
17	!! $HeadURL:
18	!svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate_soilcarbon.f90
19	!$
20	!! $Date: 2013-10-14 15:38:24 +0200 (Mon, 14 Oct 2013) $
21	!! $Revision: 1536 $
22	!! \n
23	!_
24	!================================================================================================================================
25
26	MODULE stomate_permafrost_soilcarbon
27
28	! modules used:
29	USE ioipsl_para
30	USE constantes_soil_var
31	USE constantes_soil
32	USE constantes_var
33	USE pft_parameters
34	USE stomate_data
35	USE grid
36	USE mod_orchidee_para
37	USE xios_orchidee
38
39	IMPLICIT NONE
40	PRIVATE
41	PUBLIC deep_carbcycle,permafrost_carbon_clear, microactem
42
43	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zf_soil !! depths of full levels (m)
44	!$OMP THREADPRIVATE(zf_soil)
45	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zi_soil !! depths of intermediate levels (m)
46	!$OMP THREADPRIVATE(zi_soil)
47	!! ES comments old paramters for diffusion
48	REAL(r_std), SAVE :: mu_soil
49	!$OMP THREADPRIVATE(mu_soil)
50	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alphaO2_soil
51	! !$OMP THREADPRIVATE(alphaO2_soil)
52	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: betaO2_soil
53	! !$OMP THREADPRIVATE(betaO2_soil)
54	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alphaCH4_soil
55	! !$OMP THREADPRIVATE(alphaCH4_soil)
56	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: betaCH4_soil
57	! !$OMP THREADPRIVATE(betaCH4_soil)
58
59	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: O2atm !!oxygen contentration at the continental surface
60	!$OMP THREADPRIVATE(O2atm)
61	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: CH4atm !!methane contentration at the continental surface
62	!$OMP THREADPRIVATE(CH4atm)
63	REAL(i_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: ildiff !!the highest snow layer that is fill with snow@
64	! !$OMP THREADPRIVATE(ildiff)
65	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: a_O2soil !!terms of tridiagonal matrix A, coefficient for concentration at level z+1
66	!$OMP THREADPRIVATE(a_O2soil)
67	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: b_O2soil !!terms of tridiagonal matrix A, coefficient for concentration at level z
68	!$OMP THREADPRIVATE(b_O2soil)
69	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: c_O2soil !!terms of tridiagonal matrix A, coefficient for concentration at level z-1
70	!$OMP THREADPRIVATE(c_O2soil)
71	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Bv_O2soil !!Oxygen concentration at previous time step (tsp-1)
72	!$OMP THREADPRIVATE(Bv_O2soil)
73	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: a_CH4soil !!terms of tridiagonal matrix A, coefficient for concentration at level z+1
74	!$OMP THREADPRIVATE(a_CH4soil)
75	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: b_CH4soil !!terms of tridiagonal matrix A, coefficient for concentration at level z
76	!$OMP THREADPRIVATE(b_CH4soil)
77	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: c_CH4soil !!terms of tridiagonal matrix A, coefficient for concentration at level z-1
78	!$OMP THREADPRIVATE(c_CH4soil)
79	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Bv_CH4soil !!Oxygen concentration at previous time step (tsp-1)
80	!$OMP THREADPRIVATE(Bv_CH4soil)
81
82	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: heights_snow !! total thickness of snow levels (m)
83	!$OMP THREADPRIVATE(heights_snow)
84	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: zf_snow !! depths of full levels (m)
85	!$OMP THREADPRIVATE(zf_snow)
86	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: zi_snow !! depths of intermediate levels (m)
87	!$OMP THREADPRIVATE(zi_snow)
88	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zf_snow_nopftdim !! depths of full levels (m)
89	!$OMP THREADPRIVATE(zf_snow_nopftdim)
90	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: zi_snow_nopftdim !! depths of intermediate levels (m)
91	!$OMP THREADPRIVATE(zi_snow_nopftdim)
92
93	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zf_coeff_snow
94	!$OMP THREADPRIVATE(zf_coeff_snow)
95	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zi_coeff_snow
96	!$OMP THREADPRIVATE(zi_coeff_snow)
97	!! ES old parameters for gas diffusion
98	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mu_snow
99	! !$OMP THREADPRIVATE(mu_snow)
100	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alphaO2_snow
101	! !$OMP THREADPRIVATE(alphaO2_snow)
102	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: betaO2_snow
103	! !$OMP THREADPRIVATE(betaO2_snow)
104	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alphaCH4_snow
105	! !$OMP THREADPRIVATE(alphaCH4_snow)
106	! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: betaCH4_snow
107	! !$OMP THREADPRIVATE(betaCH4_snow)
108
109	real(r_std), allocatable, save, dimension(:,:,:) :: deepC_pftmean !! Deep soil carbon profiles, mean over all PFTs
110	!$OMP THREADPRIVATE(deepC_pftmean)
111
112	INTEGER(i_std), SAVE :: yr_len = 360
113	!$OMP THREADPRIVATE(yr_len)
114	!! Arrays related to cryoturbation processes
115	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: diff_k !! Diffusion constant (m^2/s)
116	!$OMP THREADPRIVATE(diff_k)
117	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: xe_a
118	!$OMP THREADPRIVATE(xe_a)
119	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: xe_s
120	!$OMP THREADPRIVATE(xe_s)
121	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: xe_p
122	!$OMP THREADPRIVATE(xe_p)
123	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xc_cryoturb
124	!$OMP THREADPRIVATE(xc_cryoturb)
125	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xd_cryoturb
126	!$OMP THREADPRIVATE(xd_cryoturb)
127	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: alpha_a
128	!$OMP THREADPRIVATE(alpha_a)
129	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: alpha_s
130	!$OMP THREADPRIVATE(alpha_s)
131	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: alpha_p
132	!$OMP THREADPRIVATE(alpha_p)
133	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: beta_a
134	!$OMP THREADPRIVATE(beta_a)
135	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: beta_s
136	!$OMP THREADPRIVATE(beta_s)
137	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: beta_p
138	!$OMP THREADPRIVATE(beta_p)
139	LOGICAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: cryoturb_location
140	!$OMP THREADPRIVATE(cryoturb_location)
141	LOGICAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: bioturb_location
142	!$OMP THREADPRIVATE(bioturb_location)
143	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: airvol_soil
144	!$OMP THREADPRIVATE(airvol_soil)
145	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: totporO2_soil !! total oxygen porosity in the soil
146	!$OMP THREADPRIVATE(totporO2_soil)
147	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: totporCH4_soil !! total methane porosity in the soil
148	!$OMP THREADPRIVATE(totporCH4_soil)
149	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: conduct_soil
150	!$OMP THREADPRIVATE(conduct_soil)
151	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: diffO2_soil !! oxygen diffusivity in the soil (m**2/s)
152	!$OMP THREADPRIVATE(diffO2_soil)
153	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: diffCH4_soil !! methane diffusivity in the soil (m**2/s)
154	!$OMP THREADPRIVATE(diffCH4_soil)
155	REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE :: airvol_snow
156	!$OMP THREADPRIVATE(airvol_snow)
157	REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE :: totporO2_snow !! total oxygen porosity in the snow
158	!$OMP THREADPRIVATE(totporO2_snow)
159	REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE :: totporCH4_snow !! total methane porosity in the snow
160	!$OMP THREADPRIVATE(totporCH4_snow)
161	REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE :: conduct_snow
162	!$OMP THREADPRIVATE(conduct_snow)
163	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: diffCH4_snow !! methane diffusivity in the snow (m**2/s)
164	!$OMP THREADPRIVATE(diffCH4_snow)
165	REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: diffO2_snow !! oxygen diffusivity in the snow (m**2/s)
166	!$OMP THREADPRIVATE(diffO2_snow)
167	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: altmax_lastyear !! active layer thickness
168	!$OMP THREADPRIVATE(altmax_lastyear)
169	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: alt
170	!$OMP THREADPRIVATE(alt)
171	INTEGER(i_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: alt_ind !! active layer thickness
172	!$OMP THREADPRIVATE(alt_ind)
173	INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE :: altmax_ind !! Maximum over the year active layer thickness
174	!$OMP THREADPRIVATE(altmax_ind)
175	INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE :: altmax_ind_lastyear
176	!$OMP THREADPRIVATE(altmax_ind_lastyear)
177	REAL(r_std), DIMENSION(:,:),ALLOCATABLE, SAVE :: z_root !! Rooting depth
178	!$OMP THREADPRIVATE(z_root)
179	INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE :: rootlev !! The deepest model level within the rooting depth
180	!$OMP THREADPRIVATE(rootlev)
181	REAL(r_std),DIMENSION(:,:),ALLOCATABLE, SAVE :: lalo_global !! Geogr. coordinates (latitude,longitude) (degrees)
182	!$OMP THREADPRIVATE(lalo_global)
183	LOGICAL,DIMENSION(:,:),ALLOCATABLE, SAVE :: veget_mask_2d !! whether there is vegetation
184	!$OMP THREADPRIVATE(veget_mask_2d)
185	REAL(r_std), PARAMETER :: fslow = 37 !16.66667! 36.7785 ! 37. Dmitry original ! facteurs de vitesse pour reservoirs slow et passif
186	REAL(r_std), PARAMETER :: fpassive = 1617.45 !2372 represents 2000 years for passive at reference of 5 degrees!1617.45 !666.667 !1617.45 !1600. Dmitry original
187
188	LOGICAL, SAVE :: reset_gas_concentration =.FALSE.
189	LOGICAL, SAVE :: adjust_k_by_o2 =.TRUE.
190
191
192	CONTAINS
193
194	!!
195	!================================================================================================================================
196	!! SUBROUTINE : deep_carbcycle
197	!!
198	!>\BRIEF Recalculate vegetation cover and LAI
199	!!
200	!!\n DESCRIPTION :
201	!!
202	!! RECENT CHANGE(S) : None
203	!!
204	!! MAIN OUTPUT VARIABLE(S): None
205	!!
206	!! REFERENCE(S) : None
207	!!
208	!! FLOWCHART :
209	!_
210	!================================================================================================================================
211
212	SUBROUTINE deep_carbcycle(kjpindex, index, itau, time_step, lalo, clay, &
213	tsurf, tprof, hslong_in, lai, &
214	poros_layt_pft, &
215	snow, heat_Zimov, pb, &
216	sfluxCH4_deep, sfluxCO2_deep, &
217	deepC_a, deepC_s, deepC_p, O2_soil, CH4_soil, O2_snow, CH4_snow, &
218	zz_deep, zz_coef_deep, z_organic, soilc_in, veget_max, &
219	rprof, altmax, carbon, carbon_surf, resp_hetero_soil, fbact, fixed_cryoturbation_depth, &
220	snowdz,snowrho,&
221	shumCH4_rel, &
222	!!!qcj++ peatland
223	deepC_peat)
224
225	!! 0. Variable and parameter declaration
226
227	!! 0.1 Input variables
228	INTEGER(i_std), INTENT(in) :: kjpindex
229	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
230	INTEGER(i_std), intent(in) :: itau !! time step number
231	REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo !! Geogr. coordinates (latitude,longitude) (degrees)
232	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: pb !! surface pressure [pa]
233	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: clay !! clay content
234	INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: index !! Indeces of the points on the map
235	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
236	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in) :: snowdz !! Snow depth [m]
237	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in) :: snowrho !! snow density
238	REAL(r_std), DIMENSION(ndeep), INTENT (in) :: zz_deep !! deep vertical profile
239	REAL(r_std), DIMENSION(ndeep), INTENT (in) :: zz_coef_deep !! deep vertical profile
240	REAL(r_std), DIMENSION(kjpindex), INTENT (inout) :: z_organic !! depth to organic soil
241	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: tprof !! deep temperature profile
242	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: hslong_in !! deep long term soil humidity profile
243	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: hslong_rel_in !!relative deep long term soil humidity profile, relative to water saturation content (mcs define in hydrol.f90)
244	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (inout):: shumCH4_rel !!relative soil humidity profile, relative to water saturation content (mcs define in hydrol.f90)
245	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT (in) :: lai !!leaf area index
246	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: poros_layt_pft !!total porosity[m3void/m3soil]
247	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm),INTENT(in) :: soilc_in !! carbon going into carbon pools [gC/(m**2 of ground)/day]
248	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! Maximum vegetation fraction
249	REAL(r_std), DIMENSION (kjpindex,nvm) :: veget_max_bg
250	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: rprof !! rooting depth (m)
251	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !! skin temperature [K]
252	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in):: fbact
253
254	!! 0.2 Output variables
255	REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: sfluxCH4_deep !! total CH4 flux [g CH4 / m*2 / s]; = SUM(veget_max_bg(ip,:)( CH4ii(ip,:)-CH4i(ip,:)+MG(ip,:)-MT(ip,:) ))/time_step
256	REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: sfluxCO2_deep !! total CO2 flux [g C / m*2 / s]; = SUM(veget_max_bg(ip,:)( dC1i(ip,:) + MT(ip,:)*(12./16.) ) )/time_step
257	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: resp_hetero_soil !! soil heterotrophic respiration (first in gC/day/m**2 of ground )
258	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT (out) :: heat_Zimov !! Heating associated with decomposition [W/m**3 soil]
259	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out) :: carbon !! vertically-integrated (diagnostic) soil carbon pool: active, slow, or passive, (gC/(m**2 of ground))
260	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out) :: carbon_surf !! vertically-integrated (diagnostic) soil carbon pool: active, slow, or passive, (gC/(m**2 of ground))
261
262	!! 0.3 Modified variables
263	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_a !! Active soil carbon (g/m**3)
264	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_s !! Slow soil carbon (g/m**3)
265	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_p !! Passive soil carbon (g/m**3)
266	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow !! oxygen in the snow (g O2/m**3 air)
267	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !! oxygen in the soil (g O2/m**3 air)
268	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow !! methane in the snow (g CH4/m**3 air)
269	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane in the soil (g CH4/m**3 air)
270	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: O2ps_snow !! oxygen in the snow (g O2/m**3 soil)
271	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: O2ps_soil !! oxygen in the soil (g O2/m**3 soil)
272	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: CH4ps_snow !! methane in the snow (g CH4/m**3 soil)
273	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4ps_soil !! methane in the soil (g CH4/m**3 soil)
274
275	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout) :: altmax !! active layer thickness (m)
276	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout) :: fixed_cryoturbation_depth !! depth to hold cryoturbation to for fixed runs
277
278	!!!qcj++ peatland
279	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deepC_pt
280	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_peat
281	REAL(r_std), DIMENSION(kjpindex,nvm) :: peat_OLT
282	!! 0.4 Local variables
283
284	REAL(r_std), DIMENSION(kjpindex) :: overburden
285	REAL(r_std), DIMENSION(kjpindex,nvm) :: fluxCH4
286	REAL(r_std), DIMENSION(kjpindex,nvm) :: febul !! methane amount that is transported by ebullition to the surface
287	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxCH4 !!integrated surface flux per pft; = ( CH4ii(:,:)-CH4i(:,:)+MG(:,:)-MT(:,:) ) *one_day/time_step
288	REAL(r_std), DIMENSION(kjpindex,nvm) :: tfluxCH4D
289	REAL(r_std), DIMENSION(kjpindex,nvm) :: tfluxCH4
290	REAL(r_std), DIMENSION(kjpindex,nvm) :: tfluxCH4_soil
291	REAL(r_std), DIMENSION(kjpindex,nvm) :: tfluxCH4_snow
292	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxCH4diff_soil !! methane surface flux by diffusion in soil
293	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxCH4diff_snow !! methane surface flux by diffusion in snow
294	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxCH4diff !! methane surface flux by diffusion through soil and snow
295	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxO2diff_soil !! oxygen surface flux by diffusion in soil
296	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxO2diff_snow !! oxygen surface flux by diffusion in snow
297	REAL(r_std), DIMENSION(kjpindex,nvm) :: sfluxO2diff !! oxygen surface flux by diffusion through soil and snow
298	REAL(r_std), DIMENSION(kjpindex,nvm) :: dirfluxCH4 !! direct methane surface flux=Teb+Tplt+Tdiff
299	REAL(r_std), DIMENSION(kjpindex,nvm) :: flupmt !! methane amount that is transported by plant transport to the surface
300	REAL(r_std), DIMENSION(kjpindex,nvm) :: MT !! depth-integrated methane consumed in methanotrophy
301	REAL(r_std), DIMENSION(kjpindex,nvm) :: MG !! depth-integrated methane released in methanogenesis
302	REAL(r_std), DIMENSION(kjpindex,nvm) :: CH4i !! depth-integrated methane
303	REAL(r_std), DIMENSION(kjpindex,nvm) :: CH4ii !! depth-integrated initial methane
304	REAL(r_std), DIMENSION(kjpindex,nvm) :: dC1i !! depth-integrated oxic decomposition carbon
305	REAL(r_std), DIMENSION(kjpindex,nvm) :: dCi !! depth-integrated soil carbon
306	REAL(r_std), DIMENSION(kjpindex,nvm) :: Tplt !! depth-integrated methane transport via plants
307	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm) :: TpltL !![gCH4/m3air/it/pft] methane transport via plants
308	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm) :: TebL !![gCH4/m3air/it/pft] methane transport via ebullition
309	REAL(r_std), DIMENSION(kjpindex,nvm) :: Teb !! depth-integrated methane transport by ebullition
310	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm) :: TpltLps !![gCH4/m3soil/it/pft] methane transport via plants
311	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm) :: TebLps !![gCH4/m3soil/it/pft] methane transport via ebullition
312	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4diffBf_soil !! variable to calculate flux from diffusion: depth-integrated methane concentration in soil before diffusion
313	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4diffAf_soil !! variable to calculate flux from diffusion: depth-integrated methane concentration in soil after diffusion
314	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4diffBf_snow !! variable to calculate flux from diffusion: depth-integrated methane concentration in snow before diffusion
315	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4diffAf_snow !! variable to calculate flux from diffusion: depth-integrated methane concentration in soil after diffusion
316	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4difftopBf_soil !! variable to calculate flux from diffusion: methane concentration in top layer of soil before diffusion
317	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4difftopAf_soil !! variable to calculate flux from diffusion: methane concentration in top layer of soil after diffusion
318	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4difftopBf_snow !! variable to calculate flux from diffusion: methane concentration in top layer of snow before diffusion
319	REAL(r_std), DIMENSION(kjpindex,nvm) :: TCH4difftopAf_snow !! variable to calculate flux from diffusion:methane concentration in top layer of snow after diffusion
320	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2diffBf_soil !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil before diffusion
321	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2diffAf_soil !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil after diffusion
322	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2diffBf_snow !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in snow before diffusion
323	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2diffAf_snow !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil after diffusion
324	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2difftopBf_soil !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil before diffusion
325	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2difftopAf_soil !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil after diffusion
326	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2difftopBf_snow !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in snow before diffusion
327	REAL(r_std), DIMENSION(kjpindex,nvm) :: TO2difftopAf_snow !! variable to calculate flux from diffusion: depth-integrated oxygen concentration in soil after diffusion
328	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: totporCH4ini_soil
329
330	REAL(r_std), DIMENSION(kjpindex,nvm) :: Tref !! Ref. temperature for growing season caluculation (C)
331	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaCH4g !! methane produced at each time step (g CH4/m**3 air)
332	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaCH4 !! methane consumed at each time step (g CH4/m**3 air)
333	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaCH4gps !! methane produced at each time step (g CH4/m**3 soil)
334	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaCH4ps !! methane consumed at each time step (g CH4/m**3 soil)
335	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaC1_a
336	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaC1_s
337	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaC1_p
338	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaC2
339	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deltaC3
340	REAL(r_std), DIMENSION(kjpindex,ncarb,ndeep,nvm) :: dc_litter_z
341	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4ini_soil
342	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: hslong !! deep long term soil humidity profile
343	INTEGER(i_std) :: ip, il, itz, iz
344	REAL(r_std), SAVE, DIMENSION(3) :: lhc !! specific heat of soil organic matter oxidation (J/kg carbon)
345	REAL(r_std), SAVE :: O2m !! oxygen concentration [g/m3] below which there is anoxy
346	LOGICAL, SAVE :: ok_methane = .TRUE. !! Is Methanogenesis and -trophy taken into account?
347	LOGICAL, SAVE :: ok_cryoturb !! cryoturbate the carbon?
348	REAL(r_std), SAVE :: cryoturbation_diff_k_in !! input time constant of cryoturbation (m^2/y)
349	REAL(r_std), SAVE :: bioturbation_diff_k_in !! input time constant of bioturbation (m^2/y)
350	REAL(r_std), SAVE :: tau_CH4troph !! time constant of methanetrophy (s)
351	REAL(r_std), SAVE :: fbactratio !! time constant of methanogenesis (ratio to that of oxic)
352	LOGICAL, SAVE :: firstcall = .TRUE. !! first call?
353	REAL(r_std), SAVE, DIMENSION(2) :: lhCH4 !! specific heat of methane transformation (J/kg) (/ 3.1E6, 9.4E6 /)
354	INTEGER(i_std), SAVE :: frozen_respiration_func
355	LOGICAL, SAVE :: oxlim = .TRUE. !! O2 limitation taken into account
356	LOGICAL, SAVE :: no_pfrost_decomp = .FALSE.!! Whether this is a spinup run
357	LOGICAL, SAVE :: methane_gene_diff = .TRUE. !! when FALSE:During force soil run no methane is generated
358	!!and diffusion is turned off
359	!!when TRUE:methane generation
360	!and diffusion turn on
361
362	REAL(r_std), SAVE :: refdep !!= 0.20_r_std !! Depth to compute reference temperature for the growing season (m). WH2000 use 0.50
363	REAL(r_std), SAVE :: Tgr !!= 5.0 !! Temperature when plant growing starts and this becomes constant
364	INTEGER(i_std) :: month,year,dayno !! current time parameters
365	REAL(r_std) :: scnd
366	REAL(r_std) :: organic_layer_thickness
367	REAL(r_std) :: fbact_a
368	INTEGER(i_std) :: ier, iv, m, jv
369	CHARACTER(80) :: yedoma_map_filename
370	REAL(r_std) :: yedoma_depth, yedoma_cinit_act, yedoma_cinit_slo, yedoma_cinit_pas
371	LOGICAL :: reset_yedoma_carbon
372	LOGICAL, SAVE :: MG_useallCpools = .true. !! Do we allow all three C pools to feed methanogenesis?
373	CHARACTER(LEN=10) :: part_str !! string suffix indicating an index
374	REAL(r_std), SAVE :: max_shum_value = 1.0 !! maximum saturation degree on the thermal axes
375	REAL(r_std), DIMENSION(kjpindex) :: alt_pftmean, altmax_pftmean, tsurf_pftmean
376
377	REAL(r_std) ::time_step_O2_diff !!subtime step that will be apply within the subloop for diffusion
378	REAL(r_std) ::time_step_O2_diff_accu !!accumulated subtime step within the subloop for diffusion
379	!! this should not be greater than the time step value
380	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) ::delta_O2_soil
381
382	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: O2_soil_cum !!oxygen concentration accumulated in soil layer at the subtime step of the subloop for diffusion
383	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: O2_snow_loc !!oxygen concentration in soil layer within the subloop for diffusion
384	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: O2_soil_loc !!oxygen concentration in soil layer within the subloop for diffusion
385	REAL(i_std) :: niter
386	REAL(i_std) :: iter
387	REAL(r_std),PARAMETER :: min_time_step_O2_diff=3600.
388	REAL(r_std) :: time_step_CH4_diff !!subtime step that will be apply within the subloop for diffusion
389	REAL(r_std) :: time_step_CH4_diff_accu!!accumulated subtime step within the subloop for diffusion
390	!!this should not be greater than the time step value
391
392	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: delta_CH4_soil !!total methane emissions during one time step
393	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4_soil_cum !!methane concentration accumulated in soil layer at the subtime step of the subloop for diffusion
394	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: CH4_snow_loc !!methane concentration in soil layer within the subloop for diffusion
395	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4_soil_loc !!methane concentration in soil layer within the subloop for diffusion
396	REAL(r_std),PARAMETER :: min_time_step_CH4_diff=3600.
397
398	IF (printlev>=3) WRITE(,) 'Entering deep_carbcycle'
399
400	flupmt(:,:) = 0
401	febul(:,:) = 0
402
403	!! 0. first call
404	IF ( firstcall ) THEN
405
406	CALL getin_p('reset_gas_concentration', reset_gas_concentration)
407	CALL getin_p('adjust_k_by_o2', adjust_k_by_o2)
408
409	overburden(:)=1.
410	!
411	!Config Key = organic_layer_thickness
412	!Config Desc = The thickness of organic layer
413	!Config Def = n
414	!Config If = OK_PC
415	!Config Help = This parameters allows the user to prescibe the organic
416	!Config layer thickness
417	!Config Units = [-]
418	!
419	organic_layer_thickness = 0.
420	CALL getin_p('organic_layer_thickness', organic_layer_thickness)
421	z_organic(:) = overburden(:)*organic_layer_thickness
422
423	!
424	!Config Key = OK_METHANE
425	!Config Desc = Is Methanogenesis and -trophy taken into account?
426	!Config Def = n
427	!Config If = OK_PC
428	!Config Help =
429	!Config
430	!Config Units = [flag]
431	!
432	ok_methane = .TRUE.
433	CALL getin_p('OK_METHANE',ok_methane)
434	!
435	!Config Key = HEAT_CO2_ACT
436	!Config Desc = specific heat of soil organic matter oxidation for active carbon (J/kg carbon)
437	!Config Def = 40.0E6
438	!Config If = OK_PC
439	!Config Help =
440	!Config
441	!Config Units = [J/Kg]
442	!
443	lhc(iactive) = 40.0e6
444	CALL getin_p('HEAT_CO2_ACT',lhc(iactive))
445	!
446	!Config Key = HEAT_CO2_SLO
447	!Config Desc = specific heat of soil organic matter oxidation for slow
448	!Config carbon pool (J/kg carbon)
449	!Config Def = 30.0E6
450	!Config If = OK_PC
451	!Config Help =
452	!Config
453	!Config Units = [J/Kg]
454	!
455	lhc(islow) = 30.0E6
456	CALL getin_p('HEAT_CO2_SLO',lhc(islow))
457	!
458	!Config Key = HEAT_CO2_PAS
459	!Config Desc = specific heat of soil organic matter oxidation for
460	!Config passive carbon pool (J/kg carbon)
461	!Config Def = 10.0E6
462	!Config If = OK_PC
463	!Config Help =
464	!Config
465	!Config Units = [J/Kg]
466	!
467	lhc(ipassive) = 10.0e6
468	CALL getin_p('HEAT_CO2_PAS',lhc(ipassive))
469	!
470	!Config Key = TAU_CH4_TROPH
471	!Config Desc = time constant of methanetrophy
472	!Config Def = 432000
473	!Config If = OK_PC
474	!Config Help =
475	!Config
476	!Config Units = [s]
477	!
478	tau_CH4troph =86400 ! 432000 !Khvorostyanov et al. 2008-> 5 days= 432000 sec
479	!This can not be smaller than time step
480	CALL getin_p('TAU_CH4_TROPH',tau_CH4troph)
481	!
482	!Config Key = TAU_CH4_GEN_RATIO
483	!Config Desc = time constant of methanogenesis (ratio to that of oxic)
484	!Config Def = 9.0
485	!Config If = OK_PC
486	!Config Help =
487	!Config
488	!Config Units = [-]
489	!
490	fbactratio = 9.0 !6.0 !ES initial value was 9.0 no source reference.
491	CALL getin_p('TAU_CH4_GEN_RATIO',fbactratio)
492	!
493	!Config Key = O2_SEUIL_MGEN
494	!Config Desc = oxygen concentration below which there is anoxy
495	!Config Def = 3.0
496	!Config If = OK_PC
497	!Config Help =
498	!Config
499	!Config Units = [g/m3]
500	!
501	O2m = 3.0
502	CALL getin_p('O2_SEUIL_MGEN',O2m)
503
504	!
505	!Config Key = T_GROW
506	!Config Desc = Temperature at which plants begin to grow (C)
507	!Config Def = 5.0
508	!Config If = OK_PC
509	!Config Help =
510	!Config
511	!Config Units = [degresC]
512	!
513	Tgr = 5.0
514	CALL getin_p('T_GROW',Tgr)
515	!
516	!Config Key = REF_DEPTH
517	!Config Desc = Depth to compute reference temperature for the growing
518	!season (m). WH2000 use 0.50
519	!Config Def = 0.20
520	!Config If = OK_PC
521	!Config Help =
522	!Config
523	!Config Units = [m]
524	!
525	refdep = 0.20
526	CALL getin_p('REF_DEPTH',refdep)
527
528	!
529	!Config Key = HEAT_CH4_GEN
530	!Config Desc = specific heat of methanogenesis
531	!Config Def = 0
532	!Config If = OK_PC
533	!Config Help =
534	!Config
535	!Config Units = [J/kgC]
536	!
537	lhCH4(1) = 5.5e6 !0
538	CALL getin_p('HEAT_CH4_GEN',lhCH4(1))
539	!
540	!Config Key = HEAT_CH4_TROPH
541	!Config Desc = specific heat of methanotrophy
542	!Config Def = 0
543	!Config If = OK_PC
544	!Config Help =
545	!Config
546	!Config Units = [J/kgC]
547	!
548	lhCH4(2) = 50e6 !0
549	CALL getin_p('HEAT_CH4_TROPH',lhCH4(2))
550	!
551	!Config Key = frozen_respiration_func
552	!Config Desc = which temperature function of carbon consumption
553	!Config Def = 1
554	!Config If = OK_PC
555	!Config Help =
556	!Config
557	!Config Units = [-]
558	!
559	frozen_respiration_func=1
560	CALL getin_p('frozen_respiration_func',frozen_respiration_func)
561	!
562	!Config Key = O2_LIMIT
563	!Config Desc = O2 limitation taken into account
564	!Config Def = y
565	!Config If = OK_PC
566	!Config Help =
567	!Config
568	!Config Units = [flag]
569	!
570	oxlim=.TRUE.
571	CALL getin_p('O2_LIMIT',oxlim)
572	!
573	!Config Key = NO_PFROST_DECOMP
574	!Config Desc = whether this is spin-up
575	!Config Def = n
576	!Config If = OK_PC
577	!Config Help =
578	!Config
579	!Config Units = [flag]
580	!
581	no_pfrost_decomp=.FALSE.
582	CALL getin_p('NO_PFROST_DECOMP',no_pfrost_decomp)
583
584	!
585	!Config Key = METHANE_GENE_DIFF
586	!Config Desc = when true methane generation and diffusion turn on
587	!Config Def = y
588	!Config If = OK_PC
589	!Config Help =
590	!Config
591	!Config Units = [flag]
592	!
593	methane_gene_diff=.TRUE.
594	CALL getin_p('METHANE_GENE_DIFF',methane_gene_diff)
595
596
597	!
598	!Config Key = cryoturbate
599	!Config Desc = Do we allow for cyoturbation?
600	!Config Def = y
601	!Config If = OK_PC
602	!Config Help =
603	!Config
604	!Config Units = [flag]
605	!
606	ok_cryoturb=.TRUE.
607	CALL getin_p('cryoturbate',ok_cryoturb)
608	!
609	!Config Key = cryoturbation_diff_k_in
610	!Config Desc = diffusion constant for cryoturbation
611	!Config Def = 0.001
612	!Config If = OK_PC
613	!Config Help =
614	!Config
615	!Config Units = [m2/year]
616	!
617	cryoturbation_diff_k_in = .001
618	CALL getin_p('cryoturbation_diff_k',cryoturbation_diff_k_in)
619	!
620	!Config Key = bioturbation_diff_k_in
621	!Config Desc = diffusion constant for bioturbation
622	!Config Def = 0.0
623	!Config If = OK_PC
624	!Config Help =
625	!Config
626	!Config Units = [m2/year]
627	!
628	bioturbation_diff_k_in = 0.0001
629	CALL getin_p('bioturbation_diff_k',bioturbation_diff_k_in)
630	!
631	!Config Key = MG_useallCpools
632	!Config Desc = Do we allow all three C pools to feed methanogenesis?
633	!Config Def = y
634	!Config If = OK_PC
635	!Config Help =
636	!Config
637	!Config Units = [flag]
638	!
639	MG_useallCpools = .TRUE.
640	CALL getin_p('MG_useallCpools', MG_useallCpools)
641	!
642	!Config Key = max_shum_value
643	!Config Desc = maximum saturation degree on the thermal axes
644	!Config Def = 1
645	!Config If = OK_PC
646	!Config Help =
647	!Config
648	!Config Units = [-]
649	!
650	max_shum_value=1.0
651	CALL getin_p('max_shum_value',max_shum_value)
652	hslong(:,:,:) = MAX(MIN(hslong_in(:,:,:),max_shum_value),zero)
653	!
654
655	!! Arrays allocations
656
657	ALLOCATE (veget_mask_2d(kjpindex,nvm),stat=ier)
658	IF (ier.NE.0) THEN
659	WRITE (numout,*) ' error in veget_mask_2d allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
660	& , kjpindex*nvm
661	STOP 'deep_carbcycle'
662	END IF
663
664	ALLOCATE(lalo_global(kjpindex,2),stat=ier)
665	IF (ier.NE.0) THEN
666	WRITE (numout,*) ' error in lalo_global allocation. We stop. We need ',kjpindex,' fois ',2,' words = '&
667	& , kjpindex*2
668	STOP 'deep_carbcycle'
669	END IF
670
671	ALLOCATE (alt(kjpindex,nvm),stat=ier)
672	IF (ier.NE.0) THEN
673	WRITE (numout,*) ' error in alt allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
674	& , kjpindex*nvm
675	STOP 'deep_carbcycle'
676	END IF
677
678	ALLOCATE (altmax_lastyear(kjpindex,nvm),stat=ier)
679	IF (ier.NE.0) THEN
680	WRITE (numout,*) ' error in altmax_lastyear allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
681	& , kjpindex*nvm
682	STOP 'deep_carbcycle'
683	END IF
684
685	ALLOCATE (alt_ind(kjpindex,nvm),stat=ier)
686	IF (ier.NE.0) THEN
687	WRITE (numout,*) ' error in alt_ind allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
688	& , kjpindex*nvm
689	STOP 'deep_carbcycle'
690	END IF
691
692	ALLOCATE (altmax_ind(kjpindex,nvm),stat=ier)
693	IF (ier.NE.0) THEN
694	WRITE (numout,*) ' error in altmax_ind allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
695	& , kjpindex*nvm
696	STOP 'deep_carbcycle'
697	END IF
698
699	ALLOCATE (altmax_ind_lastyear(kjpindex,nvm),stat=ier)
700	IF (ier.NE.0) THEN
701	WRITE (numout,*) ' error in altmax_ind allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
702	& , kjpindex*nvm
703	STOP 'deep_carbcycle'
704	END IF
705
706	ALLOCATE (z_root(kjpindex,nvm),stat=ier)
707	IF (ier.NE.0) THEN
708	WRITE (numout,*) ' error in z_root allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
709	& , kjpindex*nvm
710	STOP 'deep_carbcycle'
711	END IF
712
713	ALLOCATE (rootlev(kjpindex,nvm),stat=ier)
714	IF (ier.NE.0) THEN
715	WRITE (numout,*) ' error in rootlev allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
716	& , kjpindex*nvm
717	STOP 'deep_carbcycle'
718	END IF
719
720	ALLOCATE (heights_snow(kjpindex,nvm),stat=ier)
721	IF (ier.NE.0) THEN
722	WRITE (numout,*) ' error in heights_snow allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
723	& , kjpindex*nvm
724	STOP 'deep_carbcycle'
725	END IF
726
727	ALLOCATE (zf_soil(0:ndeep),stat=ier)
728	IF (ier.NE.0) THEN
729	WRITE (numout,*) ' error in zf_soil allocation. We stop. We need',ndeep+1,' words = '&
730	& , ndeep+1
731	STOP 'deep_carbcycle'
732	END IF
733
734	ALLOCATE (zi_soil(ndeep),stat=ier)
735	IF (ier.NE.0) THEN
736	WRITE (numout,*) ' error in zi_soil allocation. We stop. We need',ndeep,' words = '&
737	& , ndeep
738	STOP 'deep_carbcycle'
739	END IF
740
741	ALLOCATE (zf_snow(kjpindex,0:nsnow,nvm),stat=ier)
742	IF (ier.NE.0) THEN
743	WRITE (numout,*) ' error in zf_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow+1, ' fois ',nvm,' words = '&
744	& , kjpindex(nsnow+1)nvm
745	STOP 'deep_carbcycle'
746	END IF
747
748	ALLOCATE (zi_snow(kjpindex,nsnow,nvm),stat=ier)
749	IF (ier.NE.0) THEN
750	WRITE (numout,*) ' error in zi_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
751	& , kjpindexnsnownvm
752	STOP 'deep_carbcycle'
753	END IF
754
755	ALLOCATE (zf_snow_nopftdim(kjpindex,0:nsnow),stat=ier)
756	IF (ier.NE.0) THEN
757	WRITE (numout,*) ' error in zf_snow_nopftdim allocation. We stop. We need', kjpindex, ' fois ',nsnow+1,' words = '&
758	& , kjpindex*(nsnow+1)
759	STOP 'deep_carbcycle'
760	END IF
761
762	ALLOCATE (zi_snow_nopftdim(kjpindex,nsnow),stat=ier)
763	IF (ier.NE.0) THEN
764	WRITE (numout,*) ' error in zi_snow_nopftdim allocation. We stop. We need', kjpindex, ' fois ',nsnow,' words = '&
765	& , kjpindex*nsnow
766	STOP 'deep_carbcycle'
767	END IF
768
769	ALLOCATE (airvol_soil(kjpindex,ndeep,nvm),stat=ier)
770	IF (ier.NE.0) THEN
771	WRITE (numout,*) ' error in airvol_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
772	& , kjpindexndeepnvm
773	STOP 'deep_carbcycle'
774	END IF
775
776	ALLOCATE (totporO2_soil(kjpindex,ndeep,nvm),stat=ier)
777	IF (ier.NE.0) THEN
778	WRITE (numout,*) ' error in totporO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
779	& , kjpindexndeepnvm
780	STOP 'deep_carbcycle'
781	END IF
782
783	ALLOCATE (totporCH4_soil(kjpindex,ndeep,nvm),stat=ier)
784	IF (ier.NE.0) THEN
785	WRITE (numout,*) ' error in totporCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
786	& , kjpindexndeepnvm
787	STOP 'deep_carbcycle'
788	END IF
789
790	ALLOCATE (conduct_soil(kjpindex,ndeep,nvm),stat=ier)
791	IF (ier.NE.0) THEN
792	WRITE (numout,*) ' error in conduct_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
793	& , kjpindexndeepnvm
794	STOP 'deep_carbcycle'
795	END IF
796
797	ALLOCATE (diffO2_soil(kjpindex,ndeep,nvm),stat=ier)
798	IF (ier.NE.0) THEN
799	WRITE (numout,*) ' error in diffO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
800	& , kjpindexndeepnvm
801	STOP 'deep_carbcycle'
802	END IF
803
804	ALLOCATE (diffCH4_soil(kjpindex,ndeep,nvm),stat=ier)
805	IF (ier.NE.0) THEN
806	WRITE (numout,*) ' error in diffCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
807	& , kjpindexndeepnvm
808	STOP 'deep_carbcycle'
809	END IF
810
811	ALLOCATE (airvol_snow(kjpindex,nsnow,nvm),stat=ier)
812	IF (ier.NE.0) THEN
813	WRITE (numout,*) ' error in airvol_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
814	& , kjpindexnsnownvm
815	STOP 'deep_carbcycle'
816	END IF
817
818	ALLOCATE (totporO2_snow(kjpindex,nsnow,nvm),stat=ier)
819	IF (ier.NE.0) THEN
820	WRITE (numout,*) ' error in totporO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
821	& , kjpindexnsnownvm
822	STOP 'deep_carbcycle'
823	END IF
824
825	ALLOCATE (totporCH4_snow(kjpindex,nsnow,nvm),stat=ier)
826	IF (ier.NE.0) THEN
827	WRITE (numout,*) ' error in totporCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
828	& , kjpindexnsnownvm
829	STOP 'deep_carbcycle'
830	END IF
831
832	ALLOCATE (conduct_snow(kjpindex,nsnow,nvm),stat=ier)
833	IF (ier.NE.0) THEN
834	WRITE (numout,*) ' error in conduct_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
835	& , kjpindexnsnownvm
836	STOP 'deep_carbcycle'
837	END IF
838
839	ALLOCATE (diffO2_snow(kjpindex,nsnow,nvm),stat=ier)
840	IF (ier.NE.0) THEN
841	WRITE (numout,*) ' error in diffO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
842	& , kjpindexnsnownvm
843	STOP 'deep_carbcycle'
844	END IF
845
846	ALLOCATE (diffCH4_snow(kjpindex,nsnow,nvm),stat=ier)
847	IF (ier.NE.0) THEN
848	WRITE (numout,*) ' error in diffCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
849	& , kjpindexnsnownvm
850	STOP 'deep_carbcycle'
851	END IF
852
853	ALLOCATE (deepc_pftmean(kjpindex,ndeep,ncarb),stat=ier)
854	IF (ier.NE.0) THEN
855	WRITE (numout,*) ' error in deepc_pftmean allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',ncarb,' words = '&
856	& , kjpindexndeepncarb
857	STOP 'deep_carbcycle'
858	END IF
859
860	ALLOCATE (O2atm(kjpindex,nvm),stat=ier)
861	IF (ier.NE.0) THEN
862	WRITE (numout,*) ' error in O2atm allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
863	& , kjpindex(ndeep+nsnow)nvm
864	STOP 'deep_carbcycle'
865	END IF
866
867	ALLOCATE (CH4atm(kjpindex,nvm),stat=ier)
868	IF (ier.NE.0) THEN
869	WRITE (numout,*) ' error in CH4atm allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
870	& , kjpindex(ndeep+nsnow)nvm
871	STOP 'deep_carbcycle'
872	END IF
873
874	ALLOCATE (ildiff(kjpindex,nvm),stat=ier)
875	IF (ier.NE.0) THEN
876	WRITE (numout,) ' error in ildiff allocation. We stop. We need',kjpindex,' fois ',nvm,'words = ', kjpindexnvm
877	STOP 'deep_carbcycle'
878	END IF
879
880
881	!! assign values for arrays
882	yr_len = NINT(one_year)
883
884	veget_max_bg(:,2:nvm) = veget_max(:,2:nvm)
885	veget_max_bg(:,1) = MAX((un - SUM(veget_max(:,2:nvm), 2)), zero)
886	!! veget_mask_2d(:,:) = veget_max_bg .GT. EPSILON(zero)
887	!! WHERE( ALL((.NOT. veget_mask_2d(:,:)), dim=2) )
888	!! veget_mask_2d(:,1) = .TRUE.
889	!! END WHERE
890	veget_mask_2d(:,:) = .TRUE.
891
892	lalo_global(:,:) = lalo(:,:)
893	alt(:,:) = 0
894	altmax_lastyear(:,:) = 0
895	alt_ind(:,:) = 0
896	altmax_ind(:,:) = 0
897	altmax_ind_lastyear(:,:) = 0
898	z_root(:,:) = 0
899	rootlev(:,:) = 0
900
901	! DO il = 1, ndeep
902	! O2_soil(:,il,:)= min_stomate !O2m !zero !O2atm(:,:) !O2_init_conc
903	! ENDDO
904	! DO il =1, nsnow
905	! O2_snow(:,il,:)= O2m !O2atm(:,:) !O2_init_conc
906	! ENDDO
907	!
908	! DO il = 1, ndeep
909	! CH4_soil(:,il,:)= min_stomate !zero !O2atm(:,:) !O2_init_conc
910	! ENDDO
911	! DO il =1, nsnow
912	! CH4_snow(:,il,:)= min_stomate !O2atm(:,:) !O2_init_conc
913	! ENDDO
914
915	! make sure gas concentrations where not defined by veget_mask are equal
916	!to initial conditions
917	DO il = 1, ndeep
918	WHERE ( .NOT. veget_mask_2d(:,:) )
919	O2_soil(:,il,:) = min_stomate !O2m !O2atm(:,:)!O2_init_conc
920	CH4_soil(:,il,:) = min_stomate !CH4atm(:,:) !CH4_init_conc
921	END WHERE
922	END DO
923	DO il = 1, nsnow
924	WHERE ( .NOT. veget_mask_2d(:,:) )
925	O2_snow(:,il,:) = O2m !O2atm(:,:) !O2_init_conc !O2_surf, why use O2_surf?
926	CH4_snow(:,il,:) = min_stomate !CH4atm(:,:) !CH4_init_conc!CH4_surf
927
928	END WHERE
929	END DO
930
931	IF (reset_gas_concentration) THEN
932	DO il = 1, ndeep
933	O2_soil(:,il,:)= min_stomate !O2m !zero !O2atm(:,:) !O2_init_conc
934	CH4_soil(:,il,:)=min_stomate !zero !CH4atm(:,:) !CH4_init_conc
935	ENDDO
936	DO il =1, nsnow
937	O2_snow(:,il,:)= O2m !O2atm(:,:) !O2_init_conc
938	CH4_snow(:,il,:)=min_stomate !CH4atm(:,:) !CH4_init_conc
939	ENDDO
940	ENDIF
941
942
943	heights_snow(:,:) = zero
944	zf_soil(:) = zero
945	zi_soil(:) = zero
946	zf_snow(:,:,:) = zero
947	zi_snow(:,:,:) = zero
948	zf_snow_nopftdim(:,:) = zero
949	zi_snow_nopftdim(:,:) = zero
950	airvol_soil(:,:,:) = zero
951	totporO2_soil(:,:,:) = zero
952	totporCH4_soil(:,:,:) = zero
953	conduct_soil(:,:,:) = zero
954	diffO2_soil(:,:,:) = zero
955	diffCH4_soil(:,:,:) = zero
956	airvol_snow(:,:,:) = zero
957	totporO2_snow(:,:,:) = zero
958	totporCH4_snow(:,:,:) = zero
959	conduct_snow(:,:,:) = zero
960	diffO2_snow(:,:,:) = zero
961	diffCH4_snow(:,:,:) = zero
962	delta_CH4_soil(:,:,:)=zero
963	delta_O2_soil(:,:,:)=zero
964
965	O2atm(:,:) = zero
966	CH4atm(:,:) = zero
967	DO iv = 1, nvm
968	O2atm(:,iv) = pb(:)/(RRtsurf(:)) O2_surf * wO2
969	CH4atm(:,iv) = pb(:)/(RRtsurf(:)) CH4_surf * wCH4
970	ENDDO
971
972
973	! get snow and soil levels
974	DO iv = 1, nvm
975	heights_snow(:,iv) = SUM(snowdz(:,1:nsnow), 2)
976	ENDDO
977	! Calculating intermediate and full depths for snow
978	call snowlevels (kjpindex, snowdz, zi_snow, zf_snow, veget_max_bg)
979
980	! here we need to put the shallow and deep soil levels together to make the complete soil levels.
981	! This requires pulling in the indices from thermosoil and deepsoil_freeze.
982	zi_soil(:) = zz_deep(:)
983	zf_soil(1:ndeep) = zz_coef_deep(:)
984	zf_soil(0) = 0.
985
986
987	! allocate arrays for gas diffusion !
988	! get diffusion coefficients: heat capacity,
989	! conductivity, and oxygen diffusivity
990
991	CALL get_gasdiff (kjpindex,poros_layt_pft,hslong,shumCH4_rel, &
992	tprof,snow,airvol_snow, &
993	totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
994	airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
995
996	!
997	! initialize soil temperature calculation
998	!
999	CALL soil_gasdiff_main (kjpindex,time_step,index,'initialize', &
1000	pb,tsurf,tprof, O2m,diffO2_snow,diffCH4_snow, &
1001	totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
1002	totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
1003
1004	!
1005	! calculate the coefficients
1006	!
1007	! CALL soil_gasdiff_main (kjpindex,time_step,index,'coefficients', &
1008	! pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
1009	! totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
1010	! totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
1011
1012
1013
1014	CALL itau2ymds(itau, time_step, year, month, dayno, scnd)
1015	dayno = (month-1)*30 + dayno
1016	CALL altcalc (kjpindex, time_step, dayno, scnd, tprof, zi_soil, alt, alt_ind, altmax, altmax_ind, &
1017	altmax_lastyear, altmax_ind_lastyear)
1018
1019	IF (printlev>=3 ) THEN
1020	WRITE(,) 'deep_carbcycle: finished firstcall calcs'
1021	ENDIF
1022
1023	! reset
1024	!
1025	!Config Key = reset_yedoma_carbon
1026	!Config Desc = Do we reset carbon concentrations for yedoma region?
1027	!Config Def = n
1028	!Config If = OK_PC
1029	!Config Help =
1030	!Config
1031	!Config Units = [flag]
1032	!
1033	reset_yedoma_carbon = .false.
1034	CALL getin_p('reset_yedoma_carbon',reset_yedoma_carbon)
1035
1036	IF (reset_yedoma_carbon) THEN
1037	yedoma_map_filename = 'NONE'
1038	yedoma_depth = zero
1039	yedoma_cinit_act = zero
1040	yedoma_cinit_slo = zero
1041	yedoma_cinit_pas = zero
1042	!
1043	!Config Key = yedoma_map_filename
1044	!Config Desc = The filename for yedoma map
1045	!Config Def = yedoma_map.nc
1046	!Config If = OK_PC
1047	!Config Help =
1048	!Config
1049	!Config Units = []
1050	!
1051	CALL getin_p('yedoma_map_filename', yedoma_map_filename)
1052	!
1053	!Config Key = yedoma_depth
1054	!Config Desc = The depth for soil carbon in yedoma
1055	!Config Def = 20
1056	!Config If = OK_PC
1057	!Config Help =
1058	!Config
1059	!Config Units = [m]
1060	!
1061	CALL getin_p('yedoma_depth', yedoma_depth)
1062	!
1063	!Config Key = deepC_a_init
1064	!Config Desc = Carbon concentration for active soil C pool in yedoma
1065	!Config Def = 1790.1
1066	!Config If = OK_PC
1067	!Config Help =
1068	!Config
1069	!Config Units = []
1070	!
1071	CALL getin_p('deepC_a_init', yedoma_cinit_act)
1072	!
1073	!Config Key = deepC_s_init
1074	!Config Desc = Carbon concentration for slow soil C pool in yedoma
1075	!Config Def = 14360.8
1076	!Config If = OK_PC
1077	!Config Help =
1078	!Config
1079	!Config Units = []
1080	!
1081	CALL getin_p('deepC_s_init', yedoma_cinit_slo)
1082	!
1083	!Config Key = deepC_p_init
1084	!Config Desc = Carbon concentration for passive soil C pool in yedoma
1085	!Config Def = 1436
1086	!Config If = OK_PC
1087	!Config Help =
1088	!Config
1089	!Config Units = []
1090	!
1091	CALL getin_p('deepC_p_init', yedoma_cinit_pas)
1092	! intialize the yedoma carbon stocks
1093	CALL initialize_yedoma_carbonstocks(kjpindex, lalo, deepC_a, deepC_s, deepC_p, zz_deep, &
1094	yedoma_map_filename, yedoma_depth, yedoma_cinit_act,yedoma_cinit_slo, yedoma_cinit_pas, altmax_ind)
1095	ENDIF
1096
1097
1098	ENDIF ! firstcall
1099
1100	! Prepare values for arrays
1101	veget_max_bg(:,2:nvm) = veget_max(:,2:nvm)
1102	veget_max_bg(:,1) = MAX((un - SUM(veget_max(:,2:nvm), 2)), zero)
1103
1104	! whether this is a C spin-up; if not, then
1105	IF ( .NOT. no_pfrost_decomp ) THEN
1106
1107	IF ( ANY(rootlev(:,:) .GT. ndeep) ) THEN
1108	WRITE(,) 'problems with rootlev:', rootlev
1109	STOP
1110	ENDIF
1111
1112	DO iv = 1, nvm
1113	heights_snow(:,iv) = SUM(snowdz(:,1:nsnow), 2)
1114	ENDDO
1115	!
1116	! define initial CH4 value (before the time step)
1117	DO ip = 1, kjpindex
1118	DO il=1, ndeep
1119	DO iv=1, nvm
1120	CH4ini_soil(ip,il,iv) = CH4_soil(ip,il,iv)
1121	totporCH4ini_soil(ip,il,iv) =totporCH4_soil (ip,il,iv)
1122	ENDDO
1123	ENDDO
1124	ENDDO
1125
1126
1127	! apply maximum soil wetness criteria to prevent soils from turning to wetlands where they aren't supposed to
1128	hslong(:,:,:) = MAX(MIN(hslong_in(:,:,:),max_shum_value),zero)
1129
1130
1131	! ! update the gas profiles
1132	! !
1133	! CALL soil_gasdiff_main (kjpindex, time_step, index, 'diffuse', &
1134	! pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
1135	! totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
1136	! totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
1137	!
1138	! ! get new snow levels and interpolate gases on these levels
1139	! !
1140	! CALL snow_interpol (kjpindex,O2_snow, CH4_snow, zi_snow, zf_snow, veget_max_bg, snowdz)
1141
1142	! Compute active layer thickness
1143	CALL itau2ymds(itau, time_step, year, month, dayno, scnd)
1144	dayno = (month-1)*30 + dayno
1145
1146	CALL altcalc (kjpindex, time_step, dayno, scnd, tprof, zi_soil, alt, alt_ind, altmax, altmax_ind, &
1147	altmax_lastyear, altmax_ind_lastyear)
1148
1149	! list pft-mean alt and altmax for debugging purposes
1150	IF (printlev>=3) THEN
1151	alt_pftmean(:) = 0.
1152	altmax_pftmean(:) = 0.
1153	tsurf_pftmean(:) = 0.
1154	DO iv = 1, nvm
1155	WHERE ( veget_mask_2d(:,iv) )
1156	alt_pftmean(:) = alt_pftmean(:) + alt(:,iv)*veget_max_bg(:,iv)
1157	altmax_pftmean(:) = altmax_pftmean(:) + altmax(:,iv)*veget_max_bg(:,iv)
1158	tsurf_pftmean(:) = tsurf_pftmean(:) + tprof(:,1,iv)*veget_max_bg(:,iv)
1159	END WHERE
1160	END DO
1161	END IF
1162
1163	! Make sure the rooting depth is within the active layer
1164
1165	!need to sort out the rooting depth, by each STOMATE PFT
1166	WHERE ( altmax_lastyear(:,:) .LT. z_root_max .and. veget_mask_2d(:,:) )
1167	z_root(:,:) = altmax_lastyear(:,:)
1168	rootlev(:,:) = altmax_ind_lastyear(:,:)
1169	ELSEWHERE ( veget_mask_2d(:,:) )
1170	z_root(:,:) = z_root_max
1171	rootlev(:,:) = altmax_ind_lastyear(:,:)
1172	ENDWHERE
1173
1174	IF (ok_cryoturb) CALL cryoturbate(kjpindex, time_step, dayno, altmax_ind_lastyear, deepC_a, deepC_s, deepC_p, &
1175	'diffuse', cryoturbation_diff_k_in/(one_dayone_year), bioturbation_diff_k_in/(one_dayone_year), &
1176	altmax_lastyear, fixed_cryoturbation_depth)
1177	!
1178	! Carbon input into the soil
1179	!
1180	CALL carbinput(kjpindex,time_step,itau*time_step,no_pfrost_decomp,tprof,tsurf,hslong,dayno,z_root,altmax_lastyear, &
1181	deepC_a, deepC_s, deepC_p, soilc_in, dc_litter_z, z_organic, veget_max_bg, rprof)
1182	!
1183	!Initiate variable that record total removal of O2 and CH4 in one
1184	!time step
1185	delta_O2_soil=0.
1186	delta_CH4_soil=0.
1187
1188	! calculate the coefficients for the next timestep:
1189	!
1190	! get diffusion coefficients: heat capacity,
1191	! conductivity, and oxygen diffusivity
1192	!
1193
1194
1195	CALL get_gasdiff (kjpindex,poros_layt_pft,hslong,shumCH4_rel, &
1196	tprof,snow,airvol_snow, &
1197	totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
1198	airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil,z_organic,snowrho)
1199
1200
1201	CALL permafrost_decomp (kjpindex, time_step, tprof, frozen_respiration_func, airvol_soil, &
1202	oxlim, tau_CH4troph, ok_methane, fbactratio, O2m, &
1203	totporO2_soil, totporCH4_soil,poros_layt_pft, hslong, clay, &
1204	no_pfrost_decomp,methane_gene_diff, deepC_a, deepC_s, deepC_p,&
1205	deltaCH4g, deltaCH4, deltaC1_a, &
1206	deltaC1_s, deltaC1_p, deltaC2, &
1207	deltaC3, O2_soil,delta_O2_soil,delta_CH4_soil, &
1208	CH4_soil, fbact, MG_useallCpools,O2atm, &
1209	!!!qcj++ peatland
1210	deepC_pt,deepC_peat, peat_OLT)
1211
1212
1213
1214	IF (ok_methane .AND. methane_gene_diff) THEN
1215
1216	!
1217	! CH4 ebullition
1218	!
1219	CALL ebullition (kjpindex,time_step,tprof,totporCH4_soil, hslong,&
1220	shumCH4_rel, delta_CH4_soil, &
1221	poros_layt_pft, CH4_soil,febul,TebL,pb)
1222
1223	!
1224	! Plant-mediated CH4 transport
1225	!
1226	CALL traMplan(CH4_soil,O2_soil,delta_O2_soil,delta_CH4_soil, &
1227	kjpindex,time_step,totporCH4_soil,totporO2_soil,z_root, &
1228	rootlev,Tgr,Tref,hslong, veget_max, lai, flupmt,TpltL,snowdz, &
1229	refdep, zi_soil, tprof, pb, deltaC3,tsurf)
1230
1231	ELSE !ok_methane
1232	flupmt(:,:)=zero
1233	TpltL(:,:,:)=zero
1234	febul(:,:)=zero
1235	TebL(:,:,:)=zero
1236	ENDIF !ok_methane
1237
1238	ENDIF
1239
1240	DO ip = 1, kjpindex
1241	DO iv = 1, nvm
1242	IF ( veget_mask_2d(ip,iv) ) THEN
1243	! oxic decomposition
1244	heat_Zimov(ip,:,iv) = lhc(iactive)1.E-3deltaC1_a(ip,:,iv) + &
1245	lhc(islow)1.E-3deltaC1_s(ip,:,iv) + &
1246	lhc(ipassive)1.E-3deltaC1_p(ip,:,iv)
1247	!
1248	! methanogenesis
1249	heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv) + lhCH4(1)1.E-3deltaC2(ip,:,iv)
1250	!
1251	! methanotrophy
1252	! heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv) + lhCH4(2)1.E-3deltaCH4(ip,:,iv) * &
1253	! totporCH4_soil(ip,:,iv)
1254	heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv) + lhCH4(2)1.E-3deltaC3(ip,:,iv)
1255	!
1256	heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv)/time_step
1257
1258	!
1259	fluxCH4(ip,iv) = zero
1260	ELSE
1261	heat_Zimov(ip,:,iv) = zero
1262	fluxCH4(ip,iv) = zero
1263	ENDIF
1264	ENDDO
1265	ENDDO
1266
1267	! IF ( .NOT. firstcall) THEN
1268	! !
1269	! ! Plant-mediated CH4 transport
1270	! !
1271	! CALL traMplan(CH4_soil,O2_soil,kjpindex,time_step,totporCH4_soil,totporO2_soil,z_root, &
1272	! rootlev,Tgr,Tref,hslong,flupmt, &
1273	! refdep, zi_soil, tprof)
1274	! ! flupmt=zero
1275	! !
1276	! ! CH4 ebullition
1277	! !
1278	!
1279	! CALL ebullition (kjpindex,time_step,tprof,totporCH4_soil,hslong,CH4_soil,febul)
1280	!
1281	! !
1282	! ENDIF
1283
1284	! ! calculate the coefficients for the next timestep:
1285	! !
1286	! ! get diffusion coefficients: heat capacity,
1287	! ! conductivity, and oxygen diffusivity
1288	! !
1289	! CALL get_gasdiff (kjpindex,poros_layt_pft,hslong,shumCH4_rel, &
1290	! tprof,snow,airvol_snow, &
1291	! totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
1292	! airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil,z_organic, snowrho)
1293
1294	!
1295	! Create variables to calculate transport by diffusion
1296	!
1297	IF ((ok_methane) .AND.( methane_gene_diff)) THEN
1298
1299	TCH4diffBf_soil(:,:)=zero
1300	TCH4difftopBf_soil(:,:)=zero
1301	TCH4diffBf_snow(:,:)=zero
1302	TCH4difftopBf_snow(:,:)=zero
1303	!
1304	DO ip = 1, kjpindex
1305	DO iv = 1, nvm
1306	IF ( veget_mask_2d(ip,iv) ) THEN
1307	DO il=1,ndeep
1308
1309	TCH4diffBf_soil(ip,iv) = TCH4diffBf_soil(ip,iv) &
1310	+ CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) &
1311	*(zf_soil(il) - zf_soil(il-1) )
1312	IF (il .EQ. 1) THEN !!top layer of soil
1313	TCH4difftopBf_soil(ip,iv) = CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) &
1314	*(zf_soil(il) )
1315	ENDIF
1316	END DO
1317	DO il=1,nsnow
1318	TCH4diffBf_snow(ip,iv) = TCH4diffBf_snow(ip,iv) &
1319	+ CH4_snow(ip,il,iv)*totporCH4_snow(ip,il,iv) &
1320	*(zf_snow(ip,il,iv) - zf_snow(ip,il-1,iv) )
1321	IF (il .EQ. nsnow) THEN !! top layer of snow
1322	TCH4difftopBf_snow(ip,iv) =CH4_snow(ip,il,iv)*totporCH4_snow(ip,il,iv) &
1323	*(zf_snow(ip,il,iv) )
1324	ENDIF
1325
1326	END DO !ndeep
1327	ENDIF !veget_mask
1328	ENDDO !iv
1329	ENDDO !ip
1330
1331	!
1332	!Updating CH4 profile: subloop for diffusion of methane
1333	!
1334
1335	DO ip = 1, kjpindex
1336	DO iv = 1, nvm
1337	if ( veget_mask_2d(ip,iv) ) then
1338	DO il = 1,nsnow
1339	CH4_snow_loc(ip,il,iv)=CH4_snow(ip,il,iv)
1340	ENDDO !nsnow
1341	DO il = 1,ndeep
1342	CH4_soil_loc(ip,il,iv)=CH4_soil(ip,il,iv)
1343	CH4_soil_cum(ip,il,iv)=CH4_soil_loc(ip,il,iv)
1344	ENDDO !ndeep
1345	endif !veget_mask
1346	ENDDO !iv
1347	ENDDO !ip
1348
1349	!Initialize time in the time step of the loop
1350	time_step_CH4_diff_accu=0.
1351	time_step_CH4_diff=time_step
1352	DO WHILE (time_step_CH4_diff_accu .lt. time_step)
1353	!time_step_CH4_diff_accu is total time spend in the loop
1354	!that should not exceed the value of the time_step
1355	DO ip = 1, kjpindex
1356	DO iv = 1, nvm
1357	if ( veget_mask_2d(ip,iv) ) then
1358	DO il=1,ndeep
1359	!calculate the time step needed to avoid negative CH4
1360	!concentration by considering all the layers
1361	if ( delta_CH4_soil(ip,il,iv) .gt. zero ) then
1362	!delta_CH4_soil is the amount of total oxygene
1363	!employed
1364	!for oxydation processes (soil C + CH4 oxydation)
1365	time_step_CH4_diff=min(time_step_CH4_diff,min(CH4_soil_loc(ip,il,iv)/(delta_CH4_soil(ip,il,iv)/time_step),(time_step-time_step_CH4_diff_accu)))
1366	else
1367	time_step_CH4_diff=time_step_CH4_diff
1368	endif !( delta_CH4_soil(ip,il,iv) .gt. zero )
1369	ENDDO !il
1370	endif !veget_mask
1371	ENDDO !iv
1372	ENDDO !ip
1373
1374	!Avoid time_step_CH4_diff of being too small leading to
1375	!a unlimited cycle
1376	if (min_time_step_CH4_diff.gt.(time_step-time_step_CH4_diff_accu) ) then
1377	time_step_CH4_diff=(time_step-time_step_CH4_diff_accu)
1378	elseif ((time_step_CH4_diff .lt.min_time_step_CH4_diff)) then
1379	time_step_CH4_diff=min_time_step_CH4_diff
1380	endif !min_time_step
1381
1382	DO ip = 1, kjpindex
1383	DO iv = 1, nvm
1384	if ( veget_mask_2d(ip,iv) ) then
1385	DO il = 1,ndeep
1386	CH4_soil_loc(ip,il,iv)=CH4_soil_loc(ip,il,iv)-delta_CH4_soil(ip,il,iv)/time_step*time_step_CH4_diff
1387	if (CH4_soil_loc(ip,il,iv) .lt. zero) then
1388	CH4_soil_loc(ip,il,iv)=min_stomate
1389	endif !CH4_soil_loc
1390	ENDDO !ndeep
1391	DO il = 1,nsnow
1392	CH4_snow_loc(ip,il,iv)=CH4_snow_loc(ip,il,iv)/time_step*time_step_CH4_diff
1393	if (CH4_snow_loc(ip,il,iv) .lt. zero) then
1394	CH4_snow_loc(ip,il,iv)=min_stomate
1395	endif !CH4_snow_loc
1396	ENDDO !nsnow
1397	endif !veget_mask
1398	ENDDO !DO iv
1399	ENDDO! DO ip
1400
1401	!! Converte CH4_Soil and CH4_snow from gCH4/m3Air into
1402	!gCH4/m3soil or snow
1403	CH4_soil_loc(:,:,:) = CH4_soil_loc(:,:,:) * totporCH4_soil
1404	CH4_snow_loc(:,:,:) = CH4_snow_loc(:,:,:) * totporCH4_snow
1405
1406	! Compute diffusion coefficients
1407	call soil_gasdiff_coeff_CH4(kjpindex,time_step_CH4_diff,CH4atm,&
1408	tsurf,CH4_snow_loc, &
1409	diffCH4_snow,totporCH4_snow,CH4_soil_loc, &
1410	diffCH4_soil,totporCH4_soil,zi_snow, zf_snow)
1411
1412	!Compute diffusion: solve tridiagonal matrix
1413	call soil_gasdiff_diff_CH4(kjpindex,time_step_CH4_diff,CH4atm,&
1414	CH4_snow_loc,CH4_soil_loc)
1415
1416	!Define cumulated variables: time and CH4 cencentration
1417	time_step_CH4_diff_accu=time_step_CH4_diff_accu+time_step_CH4_diff
1418
1419	!! Converte CH4_Soil and CH4_snow from gCH4/m3soil or snow into
1420	!gCH4/m3air
1421	CH4_soil_loc(:,:,:) = CH4_soil_loc(:,:,:) / totporCH4_soil
1422	CH4_snow_loc(:,:,:) = CH4_snow_loc(:,:,:) / totporCH4_snow
1423
1424	DO ip = 1, kjpindex
1425	DO iv = 1, nvm
1426	DO il = 1,ndeep
1427	CH4_soil_cum(ip,il,iv)=CH4_soil_cum(ip,il,iv)+CH4_soil_loc(ip,il,iv)
1428	ENDDO !il
1429	ENDDO !iv
1430	ENDDO !ip
1431
1432	ENDDO !end do for DO while
1433
1434	!one more step: when the CH4 diffused is still smaller
1435	!than
1436	!what has consumed, then set the CH4 concenration of the
1437	!given
1438	!layer to zero. Noted that this may cause some
1439	!uncertainties
1440	!(more C is oxic decomposed)
1441	!To improve, one may add one step to adjust the C is oxic
1442	!decomposed when the delta_O2_soil>O2_soil_cum, but
1443	!currently not considered
1444
1445	DO ip = 1, kjpindex
1446	DO iv = 1, nvm
1447	DO il = 1,ndeep
1448	if (CH4_soil_cum(ip,il,iv).lt.delta_CH4_soil(ip,il,iv))then
1449	CH4_soil_loc(ip,il,iv)=zero
1450	endif !CH4_soil_cum
1451	CH4_soil(ip,il,iv)=CH4_soil_loc(ip,il,iv)
1452	ENDDO !ndeep
1453	DO il = 1,nsnow
1454	CH4_snow(ip,il,iv)=max(zero, CH4_snow_loc(ip,il,iv))
1455	ENDDO !nsnow
1456	ENDDO !DO iv
1457	ENDDO! DO ip
1458
1459	!
1460	! Create variables to calculate transport by diffusion
1461	!
1462	TCH4diffAf_soil(:,:)=zero
1463	TCH4diffAf_snow(:,:)=zero
1464	TCH4difftopAf_soil(:,:)=zero
1465	TCH4difftopAf_snow(:,:)=zero
1466	!
1467	DO ip = 1, kjpindex
1468	DO iv = 1, nvm
1469	IF ( veget_mask_2d(ip,iv) ) THEN
1470	DO il=1,ndeep
1471	TCH4diffAf_soil(ip,iv) = TCH4diffAf_soil(ip,iv) &
1472	+ CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) &
1473	*(zf_soil(il) - zf_soil(il-1) )
1474	IF (il .EQ. 1) THEN !!top layer of soil
1475	TCH4difftopAf_soil(ip,iv) = CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) &
1476	*(zf_soil(il) )
1477	ENDIF
1478
1479	END DO
1480	DO il=1,nsnow
1481	TCH4diffAf_snow(ip,iv) = TCH4diffAf_snow(ip,iv) &
1482	+ CH4_snow(ip,il,iv)*totporCH4_snow(ip,il,iv) &
1483	*(zf_snow(ip,il,iv) - zf_snow(ip,il-1,iv) )
1484
1485	IF (il .EQ. nsnow) THEN !! top layer of snow
1486	TCH4difftopAf_snow(ip,iv)=CH4_snow(ip,il,iv)*totporCH4_snow(ip,il,iv) &
1487	*(zf_snow(ip,il,iv) )
1488	ENDIF
1489	END DO !ndeep
1490
1491	ENDIF !veget_mask
1492	ENDDO !iv
1493	ENDDO !ip
1494
1495	END IF !(( ok_methane) .AND.( methane_gene_diff))
1496
1497	IF ((oxlim).OR.(( ok_methane) .AND.( methane_gene_diff))) THEN
1498
1499	!
1500	! Create variables to calculate transport by diffusion
1501	!
1502	TO2diffBf_soil(:,:)=zero
1503	TO2diffBf_snow(:,:)=zero
1504	TO2difftopBf_soil(:,:)=zero
1505	TO2difftopBf_snow(:,:)=zero
1506	!
1507	DO ip = 1, kjpindex
1508	DO iv = 1, nvm
1509	IF ( veget_mask_2d(ip,iv) ) THEN
1510	DO il=1,ndeep
1511	IF (il .EQ. 1) THEN !!top layer of soil
1512	TO2difftopBf_soil(ip,iv)=O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv) &
1513	*(zf_soil(il) )
1514	ENDIF
1515
1516	TO2diffBf_soil(ip,iv) = TO2diffBf_soil(ip,iv) &
1517	+O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv) &
1518	*(zf_soil(il) - zf_soil(il-1) )
1519	END DO
1520	DO il=1,nsnow
1521	IF (il .EQ. nsnow) THEN !! top layer of snow
1522	TO2difftopBf_snow(ip,iv)=O2_snow(ip,il,iv)*totporO2_snow(ip,il,iv) &
1523	*(zf_snow(ip,il,iv) )
1524	ENDIF
1525
1526	TO2diffBf_snow(ip,iv) = TO2diffBf_snow(ip,iv) &
1527	+O2_snow(ip,il,iv)*totporO2_snow(ip,il,iv) &
1528	*(zf_snow(ip,il,iv) -zf_snow(ip,il-1,iv) )
1529	END DO !ndeep
1530
1531	ENDIF !veget_mask
1532	ENDDO !iv
1533	ENDDO !ip
1534
1535
1536	!
1537	!Updating O2 profile: subloop for diffusion of methane
1538	!
1539
1540	DO ip = 1, kjpindex
1541	DO iv = 1, nvm
1542	if ( veget_mask_2d(ip,iv) ) then
1543	DO il = 1,nsnow
1544	O2_snow_loc(ip,il,iv)=O2_snow(ip,il,iv)
1545	ENDDO !il nsnow
1546	DO il = 1,ndeep
1547	O2_soil_loc(ip,il,iv)=O2_soil(ip,il,iv)
1548	O2_soil_cum(ip,il,iv)=O2_soil_loc(ip,il,iv)
1549	ENDDO !il ndeep
1550	endif !veget_mask
1551	ENDDO !iv
1552	ENDDO !ip
1553
1554	!Initialize time in the time step of the loop
1555	time_step_O2_diff_accu=0.
1556	time_step_O2_diff=time_step
1557
1558	DO WHILE (time_step_O2_diff_accu .lt. time_step)
1559	!time_step_O2_diff_accu is total time spend in the loop
1560	!that should not exceed the value of the time_step
1561
1562	DO ip = 1, kjpindex
1563	DO iv = 1, nvm
1564	if ( veget_mask_2d(ip,iv) ) then
1565	DO il=1,ndeep
1566	!calculate the time step needed to avoid negative O2
1567	!concentration by considering all the layers
1568	if ( delta_O2_soil(ip,il,iv) .gt. zero ) then
1569	!delta_O2_soil is the amount of total oxygene employed
1570	!for oxydation processes (soil C + CH4 oxydation)
1571	time_step_O2_diff=min(time_step_O2_diff,min(O2_soil_loc(ip,il,iv)/(delta_O2_soil(ip,il,iv)/time_step),(time_step-time_step_O2_diff_accu)))
1572	endif !!delta_O2_soil
1573	ENDDO !il ndeep
1574	endif !veget_mask
1575	ENDDO !iv
1576	ENDDO !ip
1577
1578	!Avoid time_step_O2_diff of being too small leading to
1579	!a unlimited cycle
1580	if (min_time_step_O2_diff.gt.(time_step-time_step_O2_diff_accu) ) then
1581	time_step_O2_diff=(time_step-time_step_O2_diff_accu)
1582	elseif ((time_step_O2_diff .lt. min_time_step_O2_diff))then
1583	time_step_O2_diff=min_time_step_O2_diff
1584	endif
1585	DO ip = 1, kjpindex
1586	DO iv = 1, nvm
1587	if ( veget_mask_2d(ip,iv) ) then
1588	DO il = 1,ndeep
1589	O2_soil_loc(ip,il,iv)=(O2_soil_loc(ip,il,iv)-delta_O2_soil(ip,il,iv))/time_step*time_step_O2_diff
1590	if (O2_soil_loc(ip,il,iv) .lt. zero) then
1591	O2_soil_loc(ip,il,iv)=min_stomate !O2m-1
1592	endif !O2_soil_loc
1593	ENDDO !il ndeep
1594	DO il = 1,nsnow
1595	O2_snow_loc(ip,il,iv)=O2_snow_loc(ip,il,iv)/time_step*time_step_O2_diff
1596	if (O2_snow_loc(ip,il,iv) .lt. zero) then
1597	O2_snow_loc(ip,il,iv)=min_stomate !O2m-1
1598	endif !O2_snow_loc
1599	ENDDO !il nsnow
1600	endif !veget_mask
1601	ENDDO !DO iv
1602	ENDDO! DO ip
1603
1604	!! Converte O2_Soil and O2_snow from gO2/m3Air into gO2/m3soil
1605	!or snow
1606	O2_soil_loc(:,:,:) = O2_soil_loc(:,:,:) * totporO2_soil
1607	O2_snow_loc(:,:,:) = O2_snow_loc(:,:,:) * totporO2_snow
1608
1609	!! Define diffusion coefficients
1610	call soil_gasdiff_coeff_O2(kjpindex,time_step_O2_diff,O2atm, tsurf,O2_snow_loc, &
1611	diffO2_snow,totporO2_snow,O2_soil_loc, &
1612	diffO2_soil,totporO2_soil,zi_snow, zf_snow)
1613
1614	!!Compute diffusion: by solving a tridiagonal matrix
1615	call soil_gasdiff_diff_O2(kjpindex,time_step_O2_diff,O2atm,O2m, O2_snow_loc,O2_soil_loc)
1616
1617	!! Converte O2_Soil and O2_snow from gO2/m3soil or snow into
1618	!gO2/m3air
1619	O2_soil_loc(:,:,:) = O2_soil_loc(:,:,:) / totporO2_soil
1620	O2_snow_loc(:,:,:) = O2_snow_loc(:,:,:) / totporO2_snow
1621
1622	!! Define cumulated variable :time and O2 concentration
1623	time_step_O2_diff_accu=time_step_O2_diff_accu+time_step_O2_diff
1624	DO ip = 1, kjpindex
1625	DO iv = 1, nvm
1626	DO il = 1,ndeep
1627	O2_soil_cum(ip,il,iv)=O2_soil_cum(ip,il,iv)+O2_soil_loc(ip,il,iv)
1628	ENDDO !il ndeep
1629	ENDDO !iv
1630	ENDDO !ip
1631
1632	ENDDO !end do for DO while
1633
1634	!one more step: when the O2 diffused is still smaller than
1635	!what
1636	!has consumed, then set the O2 concenration of the given
1637	!layer
1638	!to zero. Noted that this may cause some uncertainties
1639	!(more C
1640	!is oxic decomposed)
1641	!To improve, one may add one step to adjust the C is oxic
1642	!decomposed when the delta_O2_soil>O2_soil_cum, but
1643	!currently
1644	!not considered
1645	DO ip = 1, kjpindex
1646	DO iv = 1, nvm
1647	DO il = 1,ndeep
1648	if (O2_soil_cum(ip,il,iv) .lt. delta_O2_soil(ip,il,iv)) then
1649	O2_soil_loc(ip,il,iv)=zero
1650	endif !O2_soil_cum
1651	O2_soil(ip,il,iv)=O2_soil_loc(ip,il,iv)
1652	ENDDO !il ndeep
1653	DO il = 1,nsnow
1654	O2_snow(ip,il,iv)=max(zero, O2_snow_loc(ip,il,iv))
1655	ENDDO !il nsnow
1656	ENDDO !DO iv
1657	ENDDO! DO ip
1658
1659	!
1660	! Create variables to calculate transport by diffusion
1661	!
1662	TO2diffAf_soil(:,:)=zero
1663	TO2diffAf_snow(:,:)=zero
1664	TO2difftopAf_soil(:,:)=zero
1665	TO2difftopAf_snow(:,:)=zero
1666	!
1667	DO ip = 1, kjpindex
1668	DO iv = 1, nvm
1669	IF ( veget_mask_2d(ip,iv) ) THEN
1670	DO il=1,ndeep
1671	TO2diffAf_soil(ip,iv) = TO2diffAf_soil(ip,iv) &
1672	+ O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv) &
1673	*(zf_soil(il) - zf_soil(il-1) )
1674	IF (il .EQ. 1) THEN !!top layer of soil
1675	TO2difftopAf_soil(ip,iv)=O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv) &
1676	*(zf_soil(il) )
1677	ENDIF
1678	END DO
1679	DO il=1,nsnow
1680	TO2diffAf_snow(ip,iv) = TO2diffAf_snow(ip,iv) &
1681	+ O2_snow(ip,il,iv)*totporO2_snow(ip,il,iv) &
1682	*(zf_snow(ip,il,iv) - zf_snow(ip,il-1,iv) )
1683	IF (il .EQ. nsnow) THEN !! top layer of snow
1684	TO2difftopAf_snow(ip,iv)=O2_snow(ip,il,iv)*totporO2_snow(ip,il,iv) &
1685	*(zf_snow(ip,il,iv) )
1686	ENDIF
1687
1688	END DO !ndeep
1689	ENDIF !veget_mask
1690	ENDDO !iv
1691	ENDDO !ip
1692
1693	ENDIF !IF oxlim line 1509
1694
1695	call calc_vert_int_soil_carbon(kjpindex, deepC_a, deepC_s,deepC_p,carbon, carbon_surf, zf_soil)
1696	IF (printlev>=3) WRITE(,) 'after calc_vert_int_soil_carbon'
1697
1698
1699
1700	!
1701	MT(:,:)=zero
1702	MG(:,:)=zero
1703	CH4i(:,:)=zero
1704	CH4ii(:,:)=zero
1705	dC1i(:,:)=zero
1706	dCi(:,:)=zero
1707	Tplt(:,:)=zero
1708	Teb(:,:)=zero
1709	!
1710	DO ip = 1, kjpindex
1711	DO iv = 1, nvm
1712	IF ( veget_mask_2d(ip,iv) ) THEN
1713	DO il=1,ndeep
1714	MT(ip,iv) = MT(ip,iv) + deltaC3(ip,il,iv)wCH4/wC &
1715	( zf_soil(il) - zf_soil(il-1) )
1716	MG(ip,iv) = MG(ip,iv) + deltaC2(ip,il,iv)* wCH4/WC * &
1717	( zf_soil(il) - zf_soil(il-1) )
1718	CH4i(ip,iv) = CH4i(ip,iv) + CH4_soil(ip,il,iv)totporCH4_soil(ip,il,iv) &
1719	(zf_soil(il)-zf_soil(il-1))
1720	CH4ii(ip,iv) = CH4ii(ip,iv) + &
1721	CH4ini_soil(ip,il,iv)totporCH4_soil(ip,il,iv) &
1722	(zf_soil(il)-zf_soil(il-1))
1723	dC1i(ip,iv) = dC1i(ip,iv) + (deltaC1_a(ip,il,iv)+deltaC1_s(ip,il,iv)+deltaC1_p(ip,il,iv)) * &
1724	( zf_soil(il) - zf_soil(il-1) )
1725	dCi(ip,iv) = dCi(ip,iv) + (deepC_a(ip,il,iv) + deepC_s(ip,il,iv) + deepC_p(ip,il,iv)) * &
1726	( zf_soil(il) - zf_soil(il-1) )
1727	Tplt (ip,iv) = Tplt(ip,iv) + TpltL(ip,il,iv)totporCH4_soil(ip,il,iv) &
1728	( zf_soil(il) - zf_soil(il-1) )
1729	Teb (ip,iv) = Teb(ip,iv) + TebL(ip,il,iv)totporCH4_soil(ip,il,iv) &
1730	( zf_soil(il) - zf_soil(il-1) )
1731	END DO
1732	ENDIF
1733	ENDDO
1734	ENDDO
1735
1736	!
1737	!
1738
1739	DO ip = 1, kjpindex
1740	! Total CH4 flux
1741	sfluxCH4_deep(ip) = SUM(veget_max_bg(ip,:)*( CH4ii(ip,:)-CH4i(ip,:)+MG(ip,:)-MT(ip,:) ))/time_step
1742	! TotalCO2 flux
1743	sfluxCO2_deep(ip) = SUM(veget_max_bg(ip,:)( dC1i(ip,:) + MT(ip,:)(12./16.) ) )/time_step
1744	END DO
1745
1746	resp_hetero_soil(:,:) = ( dC1i(:,:) + MT(:,:)(12./16.) ) one_day/time_step
1747	sfluxCH4(:,:) = ( CH4ii(:,:)-CH4i(:,:)+MG(:,:)-MT(:,:) ) *one_day/time_step
1748
1749	tfluxCH4D(:,:) = (CH4ii(:,:)+MG(:,:)-MT(:,:)-Tplt(:,:)-Teb(:,:))*one_day/time_step
1750	tfluxCH4(:,:) = ( CH4ii(:,:)-CH4i(:,:))*one_day/time_step
1751	sfluxCH4diff_soil(:,:) = (TCH4difftopBf_soil(:,:) &
1752	- TCH4difftopAf_soil(:,:)) *one_day/time_step
1753	sfluxCH4diff_snow(:,:) = (TCH4difftopBf_snow(:,:) &
1754	- TCH4difftopAf_snow(:,:)) *one_day/time_step
1755	tfluxCH4_soil(:,:) = (Tplt(:,:)+Teb(:,:)+(TCH4difftopBf_soil(:,:)&
1756	-TCH4difftopAf_soil(:,:)) )*one_day/time_step
1757	tfluxCH4_snow(:,:) = (Tplt(:,:)+Teb(:,:)+(TCH4difftopBf_snow(:,:)&
1758	-TCH4difftopAf_snow(:,:)) )*one_day/time_step
1759	sfluxO2diff_soil(:,:) = (TO2difftopBf_soil(:,:) &
1760	- TO2difftopAf_soil(:,:))*one_day/time_step
1761	sfluxO2diff_snow(:,:) = (TO2difftopBf_snow(:,:) &
1762	- TO2difftopAf_snow(:,:))*one_day/time_step
1763
1764	DO ip = 1, kjpindex
1765	IF (snow(ip) .GT. 0) THEN
1766	sfluxCH4diff(ip,:) = (TCH4difftopBf_snow(ip,:) &
1767	- TCH4difftopAf_snow(ip,:)) *one_day/time_step
1768	dirfluxCH4(ip,:) = (Tplt(ip,:)+Teb(ip,:)+(TCH4difftopBf_snow(ip,:) &
1769	- TCH4difftopAf_snow(ip,:)) )*one_day/time_step
1770	sfluxO2diff(ip,:) = (TO2difftopBf_snow(ip,:) &
1771	- TO2difftopAf_snow(ip,:)) *one_day/time_step
1772	ELSE
1773	sfluxCH4diff(ip,:) = (TCH4difftopBf_soil(ip,:) &
1774	-TCH4difftopAf_soil(ip,:)) *one_day/time_step
1775	dirfluxCH4(ip,:) = (Tplt(ip,:)+Teb(ip,:)+(TCH4difftopBf_soil(ip,:) &
1776	- TCH4difftopAf_soil(ip,:)) )*one_day/time_step
1777	sfluxO2diff(ip,:) = (TO2difftopBf_soil(ip,:) &
1778	-TO2difftopAf_soil(ip,:)) *one_day/time_step
1779	ENDIF
1780	ENDDO
1781
1782	!
1783	!Conversion of variables from m3 of air to m3 of soil for output
1784	!
1785
1786	O2ps_snow(:,:,:)=zero
1787	O2ps_soil(:,:,:)=zero
1788	CH4ps_snow(:,:,:)=zero
1789	CH4ps_soil(:,:,:)=zero
1790	deltaCH4gps(:,:,:)=zero
1791	deltaCH4ps(:,:,:)=zero
1792	TpltLps(:,:,:)=zero
1793	TebLps(:,:,:)=zero
1794	DO ip = 1, kjpindex
1795	DO iv = 1, nvm
1796	IF ( veget_mask_2d(ip,iv) ) THEN
1797	DO il=1,ndeep
1798	O2ps_snow(ip,il,iv)=O2_snow(ip,il,iv)*totporO2_soil(ip,il,iv)
1799	O2ps_soil(ip,il,iv)=O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv)
1800	CH4ps_snow(ip,il,iv)=CH4_snow(ip,il,iv)*totporCH4_soil(ip,il,iv)
1801	CH4ps_soil(ip,il,iv)=CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv)
1802	deltaCH4gps(ip,il,iv)=deltaCH4g(ip,il,iv)*totporCH4_soil(ip,il,iv)
1803	deltaCH4ps(ip,il,iv)=deltaCH4(ip,il,iv)*totporCH4_soil(ip,il,iv)
1804	TpltLps(ip,il,iv)=TpltL(ip,il,iv)*totporCH4_soil(ip,il,iv)
1805	TebLps(ip,il,iv)=TebL(ip,il,iv)*totporCH4_soil(ip,il,iv)
1806	END DO
1807	ENDIF
1808	ENDDO
1809	ENDDO
1810
1811
1812	! calculate coefficients for cryoturbation calculation
1813	IF (ok_cryoturb) THEN
1814	CALL cryoturbate(kjpindex, time_step, dayno, altmax_ind_lastyear, deepC_a, deepC_s, deepC_p, &
1815	'coefficients', cryoturbation_diff_k_in/(one_dayone_year),bioturbation_diff_k_in/(one_dayone_year), &
1816	altmax_lastyear, fixed_cryoturbation_depth)
1817	ENDIF
1818	! ! calculate the coefficients for the next timestep:
1819	! !
1820	! ! get diffusion coefficients: heat capacity,
1821	! ! conductivity, and oxygen diffusivity
1822	! !
1823	! CALL get_gasdiff (kjpindex,hslong,tprof,snow,airvol_snow, &
1824	! totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
1825	! airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
1826	!
1827	! !
1828	! ! calculate the coefficients for the next time step
1829	! !
1830	! CALL soil_gasdiff_main (kjpindex,time_step,index,'coefficients', &
1831	! pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
1832	! totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
1833	! totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
1834	! call calc_vert_int_soil_carbon(kjpindex, deepC_a, deepC_s, deepC_p, carbon, carbon_surf, zf_soil)
1835	! IF (printlev>=3) WRITE(,) 'after calc_vert_int_soil_carbon'
1836	! ENDIF
1837
1838	! define pft-mean soil C profile
1839	deepC_pftmean(:,:,:) = 0._r_std
1840	do iv = 1, nvm
1841	do il=1,ndeep
1842	deepC_pftmean(:,il,iactive) = deepC_pftmean(:,il,iactive) + deepC_a(:,il,iv) * veget_max(:,iv)
1843	deepC_pftmean(:,il,islow) = deepC_pftmean(:,il,islow) + deepC_s(:,il,iv) * veget_max(:,iv)
1844	deepC_pftmean(:,il,ipassive) = deepC_pftmean(:,il,ipassive) + deepC_p(:,il,iv) * veget_max(:,iv)
1845	end do
1846	end do
1847
1848
1849	!history output
1850	IF ( .NOT. soilc_isspinup ) THEN
1851
1852	CALL histwrite_p (hist_id_stomate, 'tsurf', itime, tsurf, kjpindex, index)
1853	CALL histwrite_p (hist_id_stomate, 'fluxCH4', itime, sfluxCH4, kjpindex*nvm, horipft_index)
1854	CALL histwrite_p (hist_id_stomate, 'febul', itime, febul, kjpindex*nvm, horipft_index)
1855	CALL histwrite_p (hist_id_stomate, 'flupmt', itime, flupmt, kjpindex*nvm, horipft_index)
1856	CALL histwrite_p (hist_id_stomate, 'alt', itime, alt, kjpindex*nvm, horipft_index)
1857	CALL histwrite_p (hist_id_stomate, 'altmax', itime, altmax, kjpindex*nvm, horipft_index)
1858	CALL histwrite_p (hist_id_stomate, 'sfluxCH4_deep', itime, sfluxCH4_deep, kjpindex, index)
1859	CALL histwrite_p (hist_id_stomate, 'sfluxCO2_deep', itime, sfluxCO2_deep, kjpindex, index)
1860	CALL histwrite_p (hist_id_stomate, 'pb', itime, pb, kjpindex, index)
1861	call histwrite_p (hist_id_stomate, 'deepC_a_pftmean', itime, deepC_pftmean(:,:,iactive), kjpindex*ndeep, horideep_index)
1862	call histwrite_p (hist_id_stomate, 'deepC_s_pftmean', itime, deepC_pftmean(:,:,islow), kjpindex*ndeep, horideep_index)
1863	call histwrite_p (hist_id_stomate, 'deepC_p_pftmean', itime, deepC_pftmean(:,:,ipassive), kjpindex*ndeep, horideep_index)
1864
1865	DO jv = 1, nvm
1866	IF (permafrost_veg_exists(jv)) THEN !don't bother to write if there are pfts that don't exist in our domain
1867	WRITE(part_str,'(I2)') jv
1868	IF (jv < 10) part_str(1:1) = '0'
1869	IF (writehist_deepC) THEN
1870	CALL histwrite_p (hist_id_stomate, 'deepC_a_'//part_str(1:LEN_TRIM(part_str)), &
1871	itime, deepC_a(:,:,jv), kjpindex*ndeep, horideep_index)
1872	CALL histwrite_p (hist_id_stomate, 'deepC_s_'//part_str(1:LEN_TRIM(part_str)), &
1873	itime, deepC_s(:,:,jv), kjpindex*ndeep, horideep_index)
1874	CALL histwrite_p (hist_id_stomate, 'deepC_p_'//part_str(1:LEN_TRIM(part_str)), &
1875	itime, deepC_p(:,:,jv), kjpindex*ndeep, horideep_index)
1876	ENDIF
1877	IF (writehist_soilgases) THEN
1878	CALL histwrite_p (hist_id_stomate, 'O2_soil_'//part_str(1:LEN_TRIM(part_str)), &
1879	itime, O2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1880	CALL histwrite_p (hist_id_stomate, 'CH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
1881	itime, CH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1882	CALL histwrite_p (hist_id_stomate, 'O2_snow_'//part_str(1:LEN_TRIM(part_str)), &
1883	itime, O2_snow(:,:,jv), kjpindex*nsnow, horisnow_index)
1884	CALL histwrite_p (hist_id_stomate, 'CH4_snow_'//part_str(1:LEN_TRIM(part_str)), &
1885	itime, CH4_snow(:,:,jv), kjpindex*nsnow, horisnow_index)
1886	ENDIF
1887	IF (writehist_deltaC) THEN
1888	CALL histwrite_p (hist_id_stomate, 'deltaCH4g_'//part_str(1:LEN_TRIM(part_str)), &
1889	itime, deltaCH4g(:,:,jv), kjpindex*ndeep, horideep_index)
1890	CALL histwrite_p (hist_id_stomate, 'deltaCH4_'//part_str(1:LEN_TRIM(part_str)), &
1891	itime, deltaCH4(:,:,jv), kjpindex*ndeep, horideep_index)
1892	CALL histwrite_p (hist_id_stomate, 'deltaC1_'//part_str(1:LEN_TRIM(part_str)), &
1893	itime, deltaC1_a(:,:,jv)+deltaC1_s(:,:,jv)+deltaC1_p(:,:,jv), kjpindex*ndeep, horideep_index)
1894	CALL histwrite_p (hist_id_stomate, 'deltaC2_'//part_str(1:LEN_TRIM(part_str)), &
1895	itime, deltaC2(:,:,jv), kjpindex*ndeep, horideep_index)
1896	CALL histwrite_p (hist_id_stomate, 'deltaC3_'//part_str(1:LEN_TRIM(part_str)), &
1897	itime, deltaC3(:,:,jv), kjpindex*ndeep, horideep_index)
1898	ENDIF
1899
1900	IF (writehist_zimovheat) THEN
1901	CALL histwrite_p (hist_id_stomate, 'heat_Zimov_'//part_str(1:LEN_TRIM(part_str)), &
1902	itime, heat_Zimov(:,:,jv), kjpindex*ndeep, horideep_index)
1903	ENDIF
1904
1905	IF (writehist_deltaC_litter) THEN
1906	CALL histwrite_p (hist_id_stomate, 'deltaC_litter_act_'//part_str(1:LEN_TRIM(part_str)), &
1907	itime, dc_litter_z(:,iactive,:,jv)/ time_step, kjpindex*ndeep, horideep_index)
1908	CALL histwrite_p (hist_id_stomate, 'deltaC_litter_slo_'//part_str(1:LEN_TRIM(part_str)), &
1909	itime, dc_litter_z(:,islow,:,jv)/ time_step, kjpindex*ndeep, horideep_index)
1910	ENDIF
1911	!------------------------------ further output for debugging/diagnosing
1912
1913	IF (writehist_gascoeff) THEN
1914	CALL histwrite_p (hist_id_stomate, 'totporO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
1915	itime, totporO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1916	CALL histwrite_p (hist_id_stomate, 'diffO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
1917	itime, diffO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1918	! CALL histwrite_p (hist_id_stomate, 'alphaO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
1919	! itime, alphaO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1920	! CALL histwrite_p (hist_id_stomate, 'betaO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
1921	! itime, betaO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1922
1923	CALL histwrite_p (hist_id_stomate, 'totporCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
1924	itime, totporCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1925	CALL histwrite_p (hist_id_stomate, 'diffCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
1926	itime, diffCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1927	! CALL histwrite_p (hist_id_stomate, 'alphaCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
1928	! itime, alphaCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1929	! CALL histwrite_p (hist_id_stomate, 'betaCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
1930	! itime, betaCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
1931	ENDIF
1932	END IF
1933	END DO
1934
1935	ENDIF
1936
1937	! XIOS history output
1938	IF ( .NOT. soilc_isspinup ) THEN
1939
1940	CALL xios_orchidee_send_field ('tsurf', tsurf)
1941	CALL xios_orchidee_send_field ('fluxCH4', sfluxCH4)
1942	CALL xios_orchidee_send_field ('febul', (febul * one_day))
1943	CALL xios_orchidee_send_field ('flupmt', (flupmt * one_day))
1944	CALL xios_orchidee_send_field ( 'alt', alt )
1945	CALL xios_orchidee_send_field ( 'altmax', altmax)
1946	CALL xios_orchidee_send_field ( 'tfluxCH4', (tfluxCH4))!per day
1947	CALL xios_orchidee_send_field ( 'tfluxCH4D', (tfluxCH4D))!per day
1948	CALL xios_orchidee_send_field ('sfluxCH4diff_soil', sfluxCH4diff_soil) !per day/pft
1949	CALL xios_orchidee_send_field ('sfluxCH4diff_snow', sfluxCH4diff_snow) !per day/pft
1950	CALL xios_orchidee_send_field ('sfluxO2diff_soil', sfluxO2diff_soil) !per day/pft
1951	CALL xios_orchidee_send_field ('sfluxO2diff_snow', sfluxO2diff_snow) !per day/pft
1952	CALL xios_orchidee_send_field ('dirfluxCH4', dirfluxCH4) !per day/pft
1953	CALL xios_orchidee_send_field ('sfluxCH4diff', sfluxCH4diff) !per day/pft
1954	CALL xios_orchidee_send_field ('sfluxO2diff', sfluxO2diff) !per day/pft
1955	CALL xios_orchidee_send_field ( 'tfluxCH4_soil', (tfluxCH4_soil))!per day
1956	CALL xios_orchidee_send_field ( 'tfluxCH4_snow', (tfluxCH4_snow))!per day
1957	CALL xios_orchidee_send_field ( 'sfluxCH4_deep', (sfluxCH4_deep * one_day))
1958	CALL xios_orchidee_send_field ( 'sfluxCO2_deep', (sfluxCO2_deep * one_day))
1959	! CALL xios_orchidee_send_field ( 'respH_MT', resp_hetero_soil) !per day/pft respiration heterotrophic and methanotrophy
1960	CALL xios_orchidee_send_field ( 'pb', pb)
1961	call xios_orchidee_send_field ( 'deepC_a_pftmean', deepC_pftmean(:,:,iactive))
1962	call xios_orchidee_send_field ( 'deepC_s_pftmean', deepC_pftmean(:,:,islow))
1963	call xios_orchidee_send_field ( 'deepC_p_pftmean', deepC_pftmean(:,:,ipassive))
1964	! IF (writehist_peatCH4) THEN
1965	CALL xios_orchidee_send_field ( 'MT', (MT*one_day/time_step)) !!per day/pft
1966	CALL xios_orchidee_send_field ( 'MG', (MG*one_day/time_step)) !per day/pft
1967	CALL xios_orchidee_send_field ( 'CH4i', (CH4i*one_day/time_step)) !per day/pft
1968	CALL xios_orchidee_send_field ( 'CH4ii', (CH4ii*one_day/time_step)) !per day/pft
1969	CALL xios_orchidee_send_field ( 'dC1i', (dC1i*one_day/time_step)) !per day/pft
1970	CALL xios_orchidee_send_field ( 'dCi', (dCi*one_day/time_step)) !per day/pft
1971	CALL xios_orchidee_send_field ( 'Tplt', (Tplt*one_day/time_step)) !per day/pft
1972	CALL xios_orchidee_send_field ( 'Teb', (Teb*one_day/time_step)) !per day/pft
1973	CALL xios_orchidee_send_field ( 'TpltL', (TpltL*one_day/time_step)) !per day/pft
1974	CALL xios_orchidee_send_field ( 'TebL', (TebL*one_day/time_step)) !per day/pft
1975	CALL xios_orchidee_send_field ( 'TpltLps',(TpltLps*one_day/time_step))!per day/pft
1976	CALL xios_orchidee_send_field ( 'TebLps', (TebLps*one_day/time_step))!per day/pft
1977	CALL xios_orchidee_send_field ( 'TCH4diffBf_soil', (TCH4diffBf_soil*one_day/time_step)) !per day/pft
1978	CALL xios_orchidee_send_field ( 'TCH4diffBf_snow', (TCH4diffBf_snow*one_day/time_step)) !per day/pft
1979	CALL xios_orchidee_send_field ( 'TCH4diffAf_soil', (TCH4diffAf_soil*one_day/time_step)) !per day/pft
1980	CALL xios_orchidee_send_field ( 'TCH4diffAf_snow', (TCH4diffAf_snow*one_day/time_step)) !per day/pft
1981	CALL xios_orchidee_send_field ( 'TO2diffBf_soil', (TO2diffBf_soil*one_day/time_step)) !per day/pft
1982	CALL xios_orchidee_send_field ( 'TO2diffBf_snow', (TO2diffBf_snow*one_day/time_step)) !per day/pft!
1983	CALL xios_orchidee_send_field ( 'TO2diffAf_soil', (TO2diffAf_soil*one_day/time_step)) !per day/pft
1984	CALL xios_orchidee_send_field ( 'TO2diffAf_snow', (TO2diffAf_snow*one_day/time_step)) !per day/pft
1985	CALL xios_orchidee_send_field ( 'shumCH4_rel',shumCH4_rel) !per day/pft
1986	! ENDIF
1987
1988	IF (writehist_deepC) THEN
1989	CALL xios_orchidee_send_field ( 'deepC_a', deepC_a)
1990	CALL xios_orchidee_send_field ( 'deepC_s', deepC_s)
1991	CALL xios_orchidee_send_field ( 'deepC_p', deepC_p)
1992	!!!qcj++ peatland
1993	IF (perma_peat) THEN
1994	CALL xios_orchidee_send_field ( 'deepC_peat', deepC_peat)
1995	CALL xios_orchidee_send_field ( 'peat_OLT', peat_OLT)
1996	CALL xios_orchidee_send_field ( 'deepC_pt', deepC_pt)
1997	ENDIF
1998	ENDIF
1999
2000	! IF (writehist_soilgases) THEN
2001	CALL xios_orchidee_send_field ( 'O2_soil', O2_soil)
2002	CALL xios_orchidee_send_field ( 'CH4_soil', CH4_soil)
2003	CALL xios_orchidee_send_field ('O2_snow', O2_snow)
2004	CALL xios_orchidee_send_field ( 'CH4_snow', CH4_snow)
2005	CALL xios_orchidee_send_field ( 'O2ps_soil', O2ps_soil)
2006	CALL xios_orchidee_send_field ( 'CH4ps_soil', CH4ps_soil)
2007	CALL xios_orchidee_send_field ('O2ps_snow', O2ps_snow)
2008	CALL xios_orchidee_send_field ( 'CH4ps_snow', CH4ps_snow)
2009	CALL xios_orchidee_send_field ( 'CH4ini_soil', CH4ini_soil)
2010	! ENDIF
2011
2012	! IF (writehist_deltaC) THEN
2013	CALL xios_orchidee_send_field ( 'deltaCH4g', deltaCH4g)
2014	CALL xios_orchidee_send_field ( 'deltaCH4', deltaCH4)
2015	CALL xios_orchidee_send_field ( 'deltaCH4gps', deltaCH4gps)
2016	CALL xios_orchidee_send_field ( 'deltaCH4ps', deltaCH4ps)
2017	CALL xios_orchidee_send_field ( 'deltaC1', deltaC1_a+deltaC1_s+deltaC1_p)
2018	CALL xios_orchidee_send_field ( 'deltaC2', deltaC2)
2019	CALL xios_orchidee_send_field ( 'deltaC3', deltaC3)
2020	! ENDIF
2021
2022	! IF (writehist_zimovheat) THEN
2023	CALL xios_orchidee_send_field ( 'heat_Zimov', heat_Zimov)
2024	! ENDIF
2025
2026	! IF (writehist_deltaC_litter) THEN
2027	CALL xios_orchidee_send_field ( 'deltaC_litter_act', dc_litter_z(:,iactive,:,:)/ time_step)
2028	CALL xios_orchidee_send_field ( 'deltaC_litter_slo', dc_litter_z(:,islow,:,:)/ time_step)
2029	! ENDIF
2030
2031	! IF (writehist_gascoeff) THEN
2032	CALL xios_orchidee_send_field ( 'totporO2_soil', totporO2_soil)
2033	CALL xios_orchidee_send_field ( 'diffO2_soil', diffO2_soil)
2034	! CALL xios_orchidee_send_field ( 'alphaO2_soil', alphaO2_soil)
2035	! CALL xios_orchidee_send_field ( 'betaO2_soil', betaO2_soil)
2036
2037	CALL xios_orchidee_send_field ( 'totporCH4_soil', totporCH4_soil)
2038	CALL xios_orchidee_send_field ( 'diffCH4_soil', diffCH4_soil)
2039	! CALL xios_orchidee_send_field ('alphaCH4_soil', alphaCH4_soil)
2040	! CALL xios_orchidee_send_field ( 'betaCH4_soil', betaCH4_soil)
2041	! ENDIF
2042
2043	ENDIF
2044
2045	IF (printlev>=3) WRITE(,) 'cdk: leaving deep_carbcycle'
2046
2047	IF ( firstcall ) firstcall = .FALSE.
2048
2049
2050	END SUBROUTINE deep_carbcycle
2051
2052	!!
2053	!================================================================================================================================
2054	!! SUBROUTINE : altcalc
2055	!!
2056	!>\BRIEF This routine calculate active layer thickness
2057	!!
2058	!! DESCRIPTION :
2059	!!
2060	!! RECENT CHANGE(S) : None
2061	!!
2062	!! MAIN OUTPUT VARIABLE(S) : alt
2063	!!
2064	!! REFERENCE(S) : None
2065	!!
2066	!! FLOWCHART11 : None
2067	!! \n
2068	!_
2069	!================================================================================================================================
2070	SUBROUTINE altcalc (kjpindex,time_step,dayno,scnd, temp, zprof, alt, alt_ind, altmax, altmax_ind, &
2071	altmax_lastyear, altmax_ind_lastyear)
2072
2073	!! 0. Variable and parameter declaration
2074
2075	!! 0.1 Input variables
2076
2077	INTEGER(i_std), INTENT(in) :: kjpindex
2078	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
2079	INTEGER(i_std), INTENT(in) :: dayno !! number of the day in the current year
2080	REAL(r_std), INTENT(in) :: scnd !! model time & time step
2081	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm), INTENT(in) :: temp !! soil temperature
2082	REAL(r_std), DIMENSION(ndeep), INTENT(in) :: zprof !! soil depths (m)
2083
2084	!! 0.2 Output variables
2085
2086	REAL(r_std), DIMENSION(kjpindex, nvm), INTENT(out) :: alt !! active layer thickness
2087	INTEGER, DIMENSION(kjpindex, nvm), INTENT(out) :: alt_ind !! active layer index
2088
2089	!! 0.3 Modified variables
2090
2091	REAL(r_std), DIMENSION(kjpindex, nvm),INTENT(inout) :: altmax_lastyear !! Maximum active-layer thickness
2092	REAL(r_std), DIMENSION(kjpindex, nvm),INTENT(inout) :: altmax !! Maximum active-layer thickness
2093	INTEGER(i_std), DIMENSION(kjpindex, nvm),INTENT(inout) :: altmax_ind !! Maximum over the year active-layer index
2094	INTEGER(i_std), DIMENSION(kjpindex, nvm),INTENT(inout) :: altmax_ind_lastyear !! Maximum over the year active-layer index
2095
2096	!! 0.4 Local variables
2097
2098	INTEGER :: ix,iz,il,iv !! grid indices
2099	LOGICAL, SAVE :: firstcall = .TRUE.
2100	INTEGER, save :: tcounter
2101	INTEGER(i_std), SAVE :: id, id2
2102	LOGICAL, SAVE :: check = .FALSE.
2103	LOGICAL, SAVE :: newaltcalc = .FALSE.
2104	LOGICAL, DIMENSION(kjpindex,nvm) :: inalt, bottomlevelthawed
2105	CHARACTER(LEN=16) :: buf
2106	INTEGER :: lev
2107
2108
2109	IF ( firstcall ) THEN
2110
2111	! calculate altmax_ind from altmax
2112	altmax_ind(:,:) = 0
2113	DO ix = 1, kjpindex
2114	DO iv = 1, nvm
2115	IF ( veget_mask_2d(ix,iv) ) THEN
2116	DO il=1,ndeep
2117	IF ( altmax(ix,iv) .GE. zprof(il) ) THEN
2118	altmax_ind(ix,iv) = altmax_ind(ix,iv) + 1
2119	END IF
2120	END DO
2121	END IF
2122	END DO
2123	END DO
2124	altmax_lastyear(:,:) = altmax(:,:)
2125	altmax_ind_lastyear(:,:) = altmax_ind(:,:)
2126	firstcall = .FALSE.
2127
2128	!Config Key = newaltcalc
2129	!Config Desc = calculate alt ?
2130	!Config Def = n
2131	!Config If = OK_PC
2132	!Config Help =
2133	!Config Unit = [flag]
2134	CALL getin_p('newaltcalc', newaltcalc)
2135
2136	ELSE
2137	! all other timesteps
2138	IF ( .NOT. newaltcalc ) THEN
2139	DO ix = 1, kjpindex
2140	DO iv = 1, nvm
2141	IF ( veget_mask_2d(ix,iv) ) THEN
2142	iz = 1
2143	DO WHILE( temp(ix,iz,iv) > ZeroCelsius .AND. iz < ndeep )
2144	iz = iz + 1
2145	END DO
2146	IF( iz == 1 ) THEN
2147	! it means that all is frozen
2148	alt(ix,iv) = zero
2149	ELSE
2150	alt(ix,iv) = zprof(iz-1)
2151	END IF
2152	alt_ind(ix,iv) = iz-1
2153	END IF
2154	END DO
2155	END DO
2156	ELSE
2157	! initialize for pfts that don't exist
2158	alt(:,:) = zprof(ndeep)
2159	bottomlevelthawed(:,:) = .FALSE.
2160	! start from bottom and work up instead
2161	WHERE (temp(:,ndeep,:) > ZeroCelsius )
2162	bottomlevelthawed(:,:) = .TRUE.
2163	alt(:,:) = zprof(ndeep)
2164	alt_ind(:,:) = ndeep
2165	END WHERE
2166	inalt(:,:) = .FALSE.
2167	DO iz = 1, ndeep - 1
2168	lev = ndeep - iz
2169	WHERE ( temp(:,lev,:) > ZeroCelsius .AND. .NOT. inalt(:,:) .AND. .NOT. bottomlevelthawed(:,:) )
2170	inalt(:,:) = .TRUE.
2171	alt(:,:) = zprof(lev)
2172	alt_ind(:,:) = lev
2173	ELSEWHERE ( temp(:,lev,:) <= ZeroCelsius .AND. inalt(:,:) .AND. .NOT. bottomlevelthawed(:,:) )
2174	inalt(:,:) = .FALSE.
2175	END WHERE
2176	END DO
2177	WHERE ( .NOT. inalt .AND. .NOT. bottomlevelthawed(:,:) )
2178	alt(:,:) = zero
2179	alt_ind(:,:) = 0
2180	END WHERE
2181	ENDIF
2182
2183	! debug
2184	IF ( check ) THEN
2185	IF (ANY(alt(:,:) .GT. zprof(ndeep))) THEN
2186	WRITE(,) 'error: alt greater than soil depth.'
2187	ENDIF
2188	ENDIF
2189
2190	! Maximum over the year active layer thickness
2191	WHERE ( ( alt(:,:) .GT. altmax(:,:) ) .AND. veget_mask_2d(:,:) )
2192	altmax(:,:) = alt(:,:)
2193	altmax_ind(:,:) = alt_ind(:,:)
2194	ENDWHERE
2195
2196	IF ( .NOT. soilc_isspinup ) THEN
2197	! do it on the second timestep, that way when we are writing restart files it is not done before that!
2198	! now we are doing daily permafrost calcs, so just run it on the second day.
2199	IF ( ( dayno .EQ. 2) ) THEN
2200	! Reinitialize ALT_max
2201	altmax_lastyear(:,:) = altmax(:,:)
2202	altmax_ind_lastyear(:,:) = altmax_ind(:,:)
2203	altmax(:,:) = alt(:,:)
2204	altmax_ind(:,:) = alt_ind(:,:)
2205	END IF
2206	ELSE
2207
2208	! for spinup, best to set altmax_lastyear to altmax, and not boter to reset since every year is the same,
2209	! and if you try to do so, it doesn't work properly -- 06 may 2010
2210	altmax_lastyear(:,:) = altmax(:,:)
2211	altmax_ind_lastyear(:,:) = altmax_ind(:,:)
2212	END IF
2213	END IF
2214
2215	IF (printlev>=3) WRITE(,) 'leaving altcalc'
2216	END SUBROUTINE altcalc
2217
2218	!!
2219	!================================================================================================================================
2220	!! SUBROUTINE : soil_gasdiff_main
2221	!!
2222	!>\BRIEF This routine calculate oxygen and methane in the snow/soil medium
2223	!!
2224	!! DESCRIPTION :
2225	!!
2226	!! RECENT CHANGE(S) : None
2227	!!
2228	!! MAIN OUTPUT VARIABLE(S) :
2229	!!
2230	!! REFERENCE(S) : None
2231	!!
2232	!! FLOWCHART11 : None
2233	!! \n
2234	!_
2235	!================================================================================================================================
2236	SUBROUTINE soil_gasdiff_main( kjpindex,time_step,index,action, &
2237	psol,tsurf,tprof,O2m,diffO2_snow,diffCH4_snow, &
2238	totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
2239	totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
2240
2241	!! 0. Variable and parameter declaration
2242
2243	!! 0.1 Input variables
2244
2245	INTEGER(i_std), INTENT(in) :: kjpindex !! number of grid points
2246	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
2247	CHARACTER(LEN=*), INTENT(in) :: action !! what to do
2248	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: psol !! surface pressure (Pa)
2249	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !! Surface temperature (K)
2250	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: tprof !! Soil temperature (K)
2251	REAL(r_std),INTENT(in) :: O2m !! oxygen concentration [g/m3]below which there is anoxy
2252	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffO2_snow !! oxygen diffusivity (m**2/s)
2253	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffCH4_snow !! methane diffusivity (m**2/s)
2254	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: totporO2_snow !! total O2 porosity (Tans, 1998)
2255	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: totporCH4_snow !! total CH4 porosity (Tans, 1998)
2256	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffO2_soil !! oxygen diffusivity (m**2/s)
2257	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffCH4_soil !! methane diffusivity (m**2/s)
2258	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporO2_soil !! total O2 porosity (Tans, 1998)
2259	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporCH4_soil !! total CH4 porosity (Tans, 1998)
2260	INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: index !! Indeces of permafrost points on the map
2261
2262	!! 0.2 Output variables
2263
2264	!! 0.3 Modified variables
2265
2266	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow !! oxygen (g O2/m**3 air)
2267	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow !! methane (g CH4/m**3 air)
2268	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !! oxygen (g O2/m**3 air)
2269	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane (g CH4/m**3 air)
2270	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), intent(inout):: zf_snow !! depths of full levels (m)
2271	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), intent(inout) :: zi_snow !! depths of intermediate levels (m)
2272
2273	!! 0.4 local variables
2274
2275	CHARACTER(LEN=20), SAVE :: last_action = 'not called'
2276
2277
2278	! 1. ensure that we do not repeat actions
2279	!
2280	IF ( action .EQ. last_action ) THEN
2281	!
2282	WRITE(,) 'CANNOT TAKE THE SAME ACTION TWICE: ',TRIM(action)
2283	STOP
2284	!
2285	ENDIF
2286	!
2287	! 2. decide what to do
2288	!
2289	IF ( action .EQ. 'initialize' ) THEN
2290	!
2291	! 2.1 initialize
2292	!
2293	IF ( TRIM(last_action) .NE. 'not called' ) THEN
2294	!
2295	WRITE(,) 'SOIL MODEL CANNOT BE INITIALIZED TWICE.'
2296	STOP
2297	!
2298	ENDIF
2299	!
2300	CALL soil_gasdiff_alloc( kjpindex )
2301	!
2302	ELSEIF ( action .EQ. 'diffuse' ) THEN
2303	!
2304	! 2.2 calculate soil temperatures
2305	!
2306	CALL soil_gasdiff_diff_CH4( kjpindex,time_step,CH4atm, CH4_snow, CH4_soil)
2307	CALL soil_gasdiff_diff_O2( kjpindex,time_step,O2atm, O2m, O2_snow, O2_soil)
2308	!
2309	ELSEIF ( action .EQ. 'coefficients' ) THEN
2310	!
2311	! 2.3 calculate coefficients (heat flux and apparent surface heat capacity)
2312	!
2313	CALL soil_gasdiff_coeff_CH4( kjpindex,time_step,CH4atm, tsurf,CH4_snow, &
2314	diffCH4_snow,totporCH4_snow,CH4_soil, &
2315	diffCH4_soil,totporCH4_soil, zi_snow, zf_snow)
2316
2317	CALL soil_gasdiff_coeff_O2( kjpindex,time_step,O2atm,tsurf,O2_snow, &
2318	diffO2_snow,totporO2_snow,O2_soil,&
2319	diffO2_soil,totporO2_soil, zi_snow,zf_snow)
2320
2321	!
2322	ELSE
2323	!
2324	! 2.4 do not know this action
2325	!
2326	WRITE(,) 'DO NOT KNOW WHAT TO DO: ',TRIM(action)
2327	STOP
2328	!
2329	ENDIF
2330	!
2331	! 2.5 keep last action in mind
2332	!
2333	last_action = action
2334
2335	IF (printlev>=3) WRITE(,) 'leaving soil_gasdiff_main'
2336	END SUBROUTINE soil_gasdiff_main
2337
2338	!!
2339	!================================================================================================================================
2340	!! SUBROUTINE : soil_gasdiff_alloc
2341	!!
2342	!>\BRIEF This routine allocate arrays related to oxygen and methane in the snow/soil medium
2343	!!
2344	!! DESCRIPTION :
2345	!!
2346	!! RECENT CHANGE(S) : None
2347	!!
2348	!! MAIN OUTPUT VARIABLE(S) :
2349	!!
2350	!! REFERENCE(S) : None
2351	!!
2352	!! FLOWCHART11 : None
2353	!! \n
2354	!_
2355	!================================================================================================================================
2356	SUBROUTINE soil_gasdiff_alloc( kjpindex )
2357
2358	!! 0. Variable and parameter declaration
2359
2360	!! 0.1 Input variables
2361
2362	INTEGER(i_std), INTENT(in) :: kjpindex
2363
2364	!! 0.2 Output variables
2365
2366	!! 0.3 Modified variables
2367
2368	!! 0.4 local variables
2369
2370	INTEGER(i_std) :: ier
2371
2372	! Allocate the variables that need to be saved after soil_gasdiff_coeff
2373
2374	! ALLOCATE (alphaO2_soil(kjpindex,ndeep,nvm),stat=ier)
2375	! IF (ier.NE.0) THEN
2376	! WRITE (numout,*) ' error in alphaO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
2377	! & , kjpindexndeepnvm
2378	! STOP 'deep_carbcycle'
2379	! END IF
2380
2381	! ALLOCATE (betaO2_soil(kjpindex,ndeep,nvm),stat=ier)
2382	! IF (ier.NE.0) THEN
2383	! WRITE (numout,*) ' error in betaO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
2384	! & , kjpindexndeepnvm
2385	! STOP 'deep_carbcycle'
2386	! END IF
2387
2388	! ALLOCATE (alphaCH4_soil(kjpindex,ndeep,nvm),stat=ier)
2389	! IF (ier.NE.0) THEN
2390	! WRITE (numout,*) ' error in alphaCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
2391	! & , kjpindexndeepnvm
2392	! STOP 'deep_carbcycle'
2393	! END IF
2394
2395	! ALLOCATE (betaCH4_soil(kjpindex,ndeep,nvm),stat=ier)
2396	! IF (ier.NE.0) THEN
2397	! WRITE (numout,*) ' error in betaCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
2398	! & , kjpindexndeepnvm
2399	! STOP 'deep_carbcycle'
2400	! END IF
2401
2402	! ALLOCATE (alphaO2_snow(kjpindex,nsnow,nvm),stat=ier)
2403	! IF (ier.NE.0) THEN
2404	! WRITE (numout,*) ' error in alphaO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2405	! & , kjpindexnsnownvm
2406	! STOP 'deep_carbcycle'
2407	! END IF
2408
2409	! ALLOCATE (betaO2_snow(kjpindex,nsnow,nvm),stat=ier)
2410	! IF (ier.NE.0) THEN
2411	! WRITE (numout,*) ' error in betaO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2412	! & , kjpindexnsnownvm
2413	! STOP 'deep_carbcycle'
2414	! END IF
2415
2416	! ALLOCATE (alphaCH4_snow(kjpindex,nsnow,nvm),stat=ier)
2417	! IF (ier.NE.0) THEN
2418	! WRITE (numout,*) ' error in alphaCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2419	! & , kjpindexnsnownvm
2420	! STOP 'deep_carbcycle'
2421	! END IF
2422
2423	! ALLOCATE (betaCH4_snow(kjpindex,nsnow,nvm),stat=ier)
2424	! IF (ier.NE.0) THEN
2425	! WRITE (numout,*) ' error in betaCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2426	! & , kjpindexnsnownvm
2427	! STOP 'deep_carbcycle'
2428	! END IF
2429
2430	ALLOCATE (zf_coeff_snow(kjpindex,0:nsnow,nvm),stat=ier)
2431	IF (ier.NE.0) THEN
2432	WRITE (numout,*) ' error in zf_coeff_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow+1, ' fois ',nvm,' words = '&
2433	& , kjpindex(nsnow+1)nvm
2434	STOP 'deep_carbcycle'
2435	END IF
2436
2437	ALLOCATE (zi_coeff_snow(kjpindex,nsnow,nvm),stat=ier)
2438	IF (ier.NE.0) THEN
2439	WRITE (numout,*) ' error in zi_coeff_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2440	& , kjpindexnsnownvm
2441	STOP 'deep_carbcycle'
2442	END IF
2443
2444	! ALLOCATE (mu_snow(kjpindex,nvm),stat=ier)
2445	! IF (ier.NE.0) THEN
2446	! WRITE (numout,*) ' error in mu_snow allocation. We stop. We need', kjpindex, ' fois ',nvm,' words = '&
2447	! & , kjpindex*nvm
2448	! STOP 'deep_carbcycle'
2449	! END IF
2450
2451	ALLOCATE (a_O2soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2452	IF (ier.NE.0) THEN
2453	WRITE (numout,*) ' error in a_O2soil allocation. We stop. We need',kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2454	& , kjpindexnsnownvm, 'ier', ier
2455	STOP 'deep_carbcycle'
2456	END IF
2457
2458	ALLOCATE (b_O2soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2459	IF (ier.NE.0) THEN
2460	WRITE (numout,*) ' error in b_O2soil allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
2461	& , kjpindex(ndeep+nsnow)nvm
2462	STOP 'deep_carbcycle'
2463	END IF
2464
2465	ALLOCATE (c_O2soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2466	IF (ier.NE.0) THEN
2467	WRITE (numout,*) ' error in c_O2soil allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
2468	& , kjpindex(ndeep+nsnow)nvm
2469	STOP 'deep_carbcycle'
2470	END IF
2471
2472	ALLOCATE (Bv_O2soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2473	IF (ier.NE.0) THEN
2474	WRITE (numout,*) ' error in Bv_O2soil allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), 'fois ',nvm,' words = '&
2475	& , kjpindex(ndeep+nsnow)nvm
2476	STOP 'deep_carbcycle'
2477	END IF
2478
2479	ALLOCATE (a_CH4soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2480	IF (ier.NE.0) THEN
2481	WRITE (numout,*) ' error in a_CH4soil allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
2482	& , kjpindexnsnownvm, 'ier', ier
2483	STOP 'deep_carbcycle'
2484	END IF
2485
2486	ALLOCATE (b_CH4soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2487	IF (ier.NE.0) THEN
2488	WRITE (numout,*) ' error in b_CH4soil allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), 'fois ',nvm,' words = '&
2489	& , kjpindex(ndeep+nsnow)nvm
2490	STOP 'deep_carbcycle'
2491	END IF
2492
2493	ALLOCATE (c_CH4soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2494	IF (ier.NE.0) THEN
2495	WRITE (numout,*) ' error in c_CH4soil allocation. We stop. We need', kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
2496	& , kjpindex(ndeep+nsnow)nvm
2497	STOP 'deep_carbcycle'
2498	END IF
2499
2500	ALLOCATE (Bv_CH4soil(kjpindex,ndeep+nsnow,nvm),stat=ier)
2501	IF (ier.NE.0) THEN
2502	WRITE (numout,*) ' error in Bv_CH4soil allocation. We stop. We need',kjpindex, ' fois ',(ndeep+nsnow), ' fois ',nvm,' words = '&
2503	& , kjpindex(ndeep+nsnow)nvm
2504	STOP 'deep_carbcycle'
2505	END IF
2506
2507
2508
2509	! alphaO2_soil(:,:,:) = zero
2510	! betaO2_soil(:,:,:) = zero
2511	! alphaCH4_soil(:,:,:) = zero
2512	! betaCH4_soil(:,:,:) = zero
2513	! alphaO2_snow(:,:,:) = zero
2514	! betaO2_snow(:,:,:) = zero
2515	! alphaCH4_snow(:,:,:) = zero
2516	! betaCH4_snow(:,:,:) = zero
2517
2518	a_O2soil (:,:,:) = zero
2519	b_O2soil (:,:,:) = zero
2520	c_O2soil (:,:,:) = zero
2521	Bv_O2soil (:,:,:) = zero
2522	a_CH4soil (:,:,:) = zero
2523	b_CH4soil (:,:,:) = zero
2524	c_CH4soil (:,:,:) = zero
2525	Bv_CH4soil (:,:,:) = zero
2526	zf_coeff_snow(:,:,:) = zero
2527	zi_coeff_snow(:,:,:) = zero
2528	! mu_snow(:,:) = zero
2529
2530	END SUBROUTINE soil_gasdiff_alloc
2531
2532	!!
2533	!================================================================================================================================
2534	!! SUBROUTINE : soil_gasdiff_coeff
2535	!!
2536	!>\BRIEF This routine calculate coeff related to gas diffuvisity
2537	!!
2538	!! DESCRIPTION :
2539	!!
2540	!! RECENT CHANGE(S) : None
2541	!!
2542	!! MAIN OUTPUT VARIABLE(S) :
2543	!!
2544	!! REFERENCE(S) : None
2545	!!
2546	!! FLOWCHART11 : None
2547	!! \n
2548	!_
2549	!================================================================================================================================
2550
2551	! SUBROUTINE soil_gasdiff_coeff( kjpindex,time_step,tprof,O2_snow,CH4_snow, &
2552	! diffO2_snow,diffCH4_snow,totporO2_snow,totporCH4_snow,O2_soil,CH4_soil, &
2553	! diffO2_soil,diffCH4_soil,totporO2_soil,totporCH4_soil, zi_snow, zf_snow)
2554	!
2555	!
2556	! !! 0. Variable and parameter declaration
2557	!
2558	! !! 0.1 Input variables
2559	!
2560	! INTEGER(i_std), INTENT(in) :: kjpindex !! number of grid points
2561	! REAL(r_std), INTENT(in) :: time_step !! time step in seconds
2562	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: tprof !! Soil temperature (K)
2563	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffO2_snow !! oxygen diffusivity (m**2/s)
2564	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffCH4_snow !! methane diffusivity (m**2/s)
2565	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: totporO2_snow !! total O2 porosity (Tans, 1998)
2566	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: totporCH4_snow !! total CH4 porosity (Tans, 1998)
2567	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffO2_soil !! oxygen diffusivity (m**2/s)
2568	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffCH4_soil !! methane diffusivity (m**2/s)
2569	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporO2_soil !! total O2 porosity (Tans, 1998)
2570	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporCH4_soil !! total CH4 porosity (Tans, 1998)
2571	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: O2_snow !! oxygen (g O2/m**3 air)
2572	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: CH4_snow !! methane (g CH4/m**3 air)
2573	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: O2_soil !! oxygen (g O2/m**3 air)
2574	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: CH4_soil !! methane (g CH4/m**3 air)
2575	! REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(in) :: zf_snow !! depths of full levels (m)
2576	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: zi_snow !! depths of intermediate levels (m)
2577	!
2578	! !! 0.2 Output variables
2579	!
2580	! !! 0.3 Modified variables
2581	!
2582	! !! 0.4 local variables
2583	!
2584	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: xcO2_snow,xdO2_snow
2585	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: xcCH4_snow,xdCH4_snow
2586	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: xcO2_soil,xdO2_soil
2587	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: xcCH4_soil,xdCH4_soil
2588	! INTEGER(i_std) :: il
2589	! REAL(r_std), DIMENSION(kjpindex,nvm) :: xeO2,xeCH4
2590	! LOGICAL, DIMENSION(kjpindex,nvm) :: snow_height_mask_2d
2591	! LOGICAL, SAVE :: firstcall = .true.
2592	!
2593	! ! loop over materials (soil, snow), beginning at the bottom
2594	! !
2595	! ! 1. define useful variables linked to geometry and physical properties
2596	! !
2597	! ! 1.1 normal levels
2598	! !
2599	! ! default value if inexistent
2600	! xcO2_snow(:,1,:) = xcO2_soil(:,1,:)
2601	! xdO2_snow(:,1,:) = xdO2_soil(:,1,:)
2602	! xcCH4_snow(:,1,:) = xcCH4_soil(:,1,:)
2603	! xdCH4_snow(:,1,:) = xdCH4_soil(:,1,:)
2604	! !
2605	! snow_height_mask_2d(:,:) = ( heights_snow(:,:) .GT. hmin_tcalc )
2606	! !
2607	! DO il = 1,nsnow-1
2608	! !
2609	! WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
2610	! !
2611	! xcO2_snow(:,il,:) = ( zf_snow(:,il,:) - zf_snow(:,il-1,:) ) * &
2612	! totporO2_snow(:,il,:) / time_step
2613	! xcCH4_snow(:,il,:) = ( zf_snow(:,il,:) - zf_snow(:,il-1,:) ) * &
2614	! totporCH4_snow(:,il,:) / time_step
2615	! !
2616	! xdO2_snow(:,il,:) = diffO2_snow(:,il,:) / &
2617	! (zi_snow(:,il+1,:)-zi_snow(:,il,:))
2618	! xdCH4_snow(:,il,:) = diffCH4_snow(:,il,:) / &
2619	! (zi_snow(:,il+1,:)-zi_snow(:,il,:))
2620	! !
2621	! ENDWHERE
2622	! END DO
2623	! !
2624	! DO il = 1,ndeep-1
2625	! !
2626	! WHERE ( veget_mask_2d(:,:) )
2627	! !
2628	! xcO2_soil(:,il,:) = ( zf_soil(il) - zf_soil(il-1) ) * &
2629	! totporO2_soil(:,il,:) / time_step
2630	! xcCH4_soil(:,il,:) = ( zf_soil(il) - zf_soil(il-1) ) * &
2631	! totporCH4_soil(:,il,:) / time_step
2632	! !
2633	! xdO2_soil(:,il,:) = diffO2_soil(:,il,:) / &
2634	! (zi_soil(il+1)-zi_soil(il))
2635	! xdCH4_soil(:,il,:) = diffCH4_soil(:,il,:) / &
2636	! (zi_soil(il+1)-zi_soil(il))
2637	! !
2638	! ENDWHERE
2639	! !
2640	! ENDDO
2641	! !
2642	! ! 1.2 for the lower boundary, define a similar geometric variable.
2643	! !
2644	! !snow
2645	! !
2646	! WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
2647	! xcO2_snow(:,nsnow,:) = ( zf_snow(:,nsnow,:) - &
2648	! zf_snow(:,nsnow-1,:) ) * &
2649	! totporO2_snow(:,nsnow,:) / time_step
2650	! xdO2_snow(:,nsnow,:) = diffO2_snow(:,nsnow,:) / &
2651	! ( zi_soil(1) + &
2652	! zf_snow(:,nsnow,:) - zi_snow(:,nsnow,:) )
2653	! xcCH4_snow(:,nsnow,:) = ( zf_snow(:,nsnow,:) - &
2654	! zf_snow(:,nsnow-1,:) ) * &
2655	! totporCH4_snow(:,nsnow,:) / time_step
2656	! xdCH4_snow(:,nsnow,:) = diffCH4_snow(:,nsnow,:) / &
2657	! ( zi_soil(1) + &
2658	! zf_snow(:,nsnow,:) - zi_snow(:,nsnow,:) )
2659	! ENDWHERE
2660	! !
2661	! ! soil
2662	! !
2663	! WHERE ( veget_mask_2d(:,:) ) ! removed heights_soil logic
2664	! xcO2_soil(:,ndeep,:) = &
2665	! ( zf_soil(ndeep) - zf_soil(ndeep-1) ) * &
2666	! totporO2_soil(:,ndeep,:) / time_step
2667	! xdO2_soil(:,ndeep,:) = diffO2_soil(:,ndeep,:) / &
2668	! ( zf_soil(ndeep) - zi_soil(ndeep) )
2669	! xcCH4_soil(:,ndeep,:) = &
2670	! ( zf_soil(ndeep) - zf_soil(ndeep-1) ) * &
2671	! totporCH4_soil(:,ndeep,:) / time_step
2672	! xdCH4_soil(:,ndeep,:) = diffCH4_soil(:,ndeep,:) / &
2673	! ( zf_soil(ndeep) - zi_soil(ndeep) )
2674	! ENDWHERE
2675	! !
2676	! ! 1.3 extrapolation factor from first levels to surface
2677	! !
2678	! WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
2679	! mu_snow(:,:) = zi_snow(:,1,:) / ( zi_snow(:,2,:) - zi_snow(:,1,:) )
2680	! ELSEWHERE ( veget_mask_2d(:,:) )
2681	! mu_snow(:,:) = .5 ! any value
2682	! ENDWHERE
2683	! !
2684	! mu_soil = zi_soil(1) / ( zi_soil(2) - zi_soil(1) )
2685	! !
2686	! ! 2. bottom level: treatment depends on lower boundary condition
2687	! !
2688	! ! soil
2689	! !
2690	! WHERE ( veget_mask_2d(:,:) ) ! removed heights_soil logic
2691	! !
2692	! xeO2(:,:) = xcO2_soil(:,ndeep,:) + xdO2_soil(:,ndeep-1,:)
2693	! xeCH4(:,:) = xcCH4_soil(:,ndeep,:) + xdCH4_soil(:,ndeep-1,:)
2694	! !
2695	! alphaO2_soil(:,ndeep-1,:) = xdO2_soil(:,ndeep-1,:) / xeO2(:,:)
2696	! alphaCH4_soil(:,ndeep-1,:) = xdCH4_soil(:,ndeep-1,:) &
2697	! / xeCH4(:,:)
2698	! !
2699	! betaO2_soil(:,ndeep-1,:) = &
2700	! (xcO2_soil(:,ndeep,:)*O2_soil(:,ndeep,:))/xeO2(:,:)
2701	! betaCH4_soil(:,ndeep-1,:) = &
2702	! (xcCH4_soil(:,ndeep,:)*CH4_soil(:,ndeep,:))/xeCH4(:,:)
2703	! !
2704	! ENDWHERE
2705	! !
2706	! !snow
2707	! !
2708	! WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
2709	! !
2710	! ! dernier niveau
2711	! !
2712	! xeO2(:,:) = xcO2_soil(:,1,:) + &
2713	! (1.-alphaO2_soil(:,1,:))*xdO2_soil(:,1,:) + &
2714	! xdO2_snow(:,nsnow,:)
2715	! xeCH4(:,:) = xcCH4_soil(:,1,:) + &
2716	! (1.-alphaCH4_soil(:,1,:))*xdCH4_soil(:,1,:) + &
2717	! xdCH4_snow(:,nsnow,:)
2718	! !
2719	! alphaO2_snow(:,nsnow,:) = xdO2_snow(:,nsnow,:)/xeO2(:,:)
2720	! alphaCH4_snow(:,nsnow,:) = xdCH4_snow(:,nsnow,:) &
2721	! /xeCH4(:,:)
2722	! !
2723	! betaO2_snow(:,nsnow,:) = &
2724	! ( xcO2_soil(:,1,:)*O2_soil(:,1,:) + &
2725	! xdO2_soil(:,1,:)*betaO2_soil(:,1,:) ) &
2726	! / xeO2(:,:)
2727	! betaCH4_snow(:,nsnow,:) = &
2728	! ( xcCH4_soil(:,1,:)*CH4_soil(:,1,:) + &
2729	! xdCH4_soil(:,1,:)*betaCH4_soil(:,1,:) ) &
2730	! / xeCH4(:,:)
2731	! !
2732	! ! avant-dernier niveau
2733	! !
2734	! xeO2(:,:) = xcO2_snow(:,nsnow,:) + &
2735	! (1.-alphaO2_snow(:,nsnow,:))*xdO2_snow(:,nsnow,:) + &
2736	! xdO2_snow(:,nsnow-1,:)
2737	! xeCH4(:,:) = xcCH4_snow(:,nsnow,:) + &
2738	! (1.-alphaCH4_snow(:,nsnow,:))*xdCH4_snow(:,nsnow,:) &
2739	! + xdCH4_snow(:,nsnow-1,:)
2740	! !
2741	! alphaO2_snow(:,nsnow-1,:) = &
2742	! xdO2_snow(:,nsnow-1,:) / xeO2(:,:)
2743	! alphaCH4_snow(:,nsnow-1,:) = &
2744	! xdCH4_snow(:,nsnow-1,:) / xeCH4(:,:)
2745	! !
2746	! betaO2_snow(:,nsnow-1,:) = &
2747	! ( xcO2_snow(:,nsnow,:)*O2_snow(:,nsnow,:) + &
2748	! xdO2_snow(:,nsnow,:)*betaO2_snow(:,nsnow,:) ) &
2749	! / xeO2(:,:)
2750	! betaCH4_snow(:,nsnow-1,:) = &
2751	! ( xcCH4_snow(:,nsnow,:)*CH4_snow(:,nsnow,:) + &
2752	! xdCH4_snow(:,nsnow,:)*betaCH4_snow(:,nsnow,:) ) &
2753	! / xeCH4(:,:)
2754	! !
2755	! ELSEWHERE ( veget_mask_2d(:,:) )
2756	! !
2757	! alphaO2_snow(:,nsnow,:) = 1.
2758	! alphaCH4_snow(:,nsnow,:) = 1.
2759	! betaO2_snow(:,nsnow,:) = zero
2760	! betaCH4_snow(:,nsnow,:) = zero
2761	! !
2762	! alphaO2_snow(:,nsnow-1,:) = 1.
2763	! alphaCH4_snow(:,nsnow-1,:) = 1.
2764	! betaO2_snow(:,nsnow-1,:) = zero
2765	! betaCH4_snow(:,nsnow-1,:) = zero
2766	! !
2767	! ENDWHERE
2768	! !
2769	!
2770	! !
2771	! ! 3. the other levels
2772	! !
2773	! DO il = nsnow-2,1,-1 !snow
2774	! !
2775	! WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
2776	! !
2777	! xeO2(:,:) = xcO2_snow(:,il+1,:) + &
2778	! (1.-alphaO2_snow(:,il+1,:))*xdO2_snow(:,il+1,:) + xdO2_snow(:,il,:)
2779	! xeCH4(:,:) = xcCH4_snow(:,il+1,:) + &
2780	! (1.-alphaCH4_snow(:,il+1,:))*xdCH4_snow(:,il+1,:) + &
2781	! xdCH4_snow(:,il,:)
2782	! !
2783	! alphaO2_snow(:,il,:) = xdO2_snow(:,il,:) / xeO2(:,:)
2784	! alphaCH4_snow(:,il,:) = xdCH4_snow(:,il,:) / xeCH4(:,:)
2785	! !
2786	! betaO2_snow(:,il,:) = &
2787	! ( xcO2_snow(:,il+1,:)*O2_snow(:,il+1,:) + &
2788	! xdO2_snow(:,il+1,:)*betaO2_snow(:,il+1,:) ) / xeO2(:,:)
2789	! betaCH4_snow(:,il,:) = &
2790	! ( xcCH4_snow(:,il+1,:)*CH4_snow(:,il+1,:) + &
2791	! xdCH4_snow(:,il+1,:)*betaCH4_snow(:,il+1,:) ) / xeCH4(:,:)
2792	! !
2793	! ELSEWHERE ( veget_mask_2d(:,:) )
2794	! !
2795	! alphaO2_snow(:,il,:) = 1.
2796	! alphaCH4_snow(:,il,:) = 1.
2797	! !
2798	! betaO2_snow(:,il,:) = zero
2799	! betaCH4_snow(:,il,:) = zero
2800	! !
2801	! ENDWHERE
2802	! !
2803	! ENDDO
2804	! !
2805	! DO il = ndeep-2,1,-1 !soil
2806	! !
2807	! WHERE ( veget_mask_2d(:,:) ) !removed heights_soil logic
2808	! !
2809	! xeO2(:,:) = xcO2_soil(:,il+1,:) + &
2810	! (1.-alphaO2_soil(:,il+1,:))*xdO2_soil(:,il+1,:) + xdO2_soil(:,il,:)
2811	! xeCH4(:,:) = xcCH4_soil(:,il+1,:) + &
2812	! (1.-alphaCH4_soil(:,il+1,:))*xdCH4_soil(:,il+1,:) + &
2813	! xdCH4_soil(:,il,:)
2814	! !
2815	! alphaO2_soil(:,il,:) = xdO2_soil(:,il,:) / xeO2(:,:)
2816	! alphaCH4_soil(:,il,:) = xdCH4_soil(:,il,:) / xeCH4(:,:)
2817	! !
2818	! betaO2_soil(:,il,:) = &
2819	! ( xcO2_soil(:,il+1,:)*O2_soil(:,il+1,:) + &
2820	! xdO2_soil(:,il+1,:)*betaO2_soil(:,il+1,:) ) / xeO2(:,:)
2821	! betaCH4_soil(:,il,:) = &
2822	! ( xcCH4_soil(:,il+1,:)*CH4_soil(:,il+1,:) + &
2823	! xdCH4_soil(:,il+1,:)*betaCH4_soil(:,il+1,:) ) / xeCH4(:,:)
2824	! !
2825	! ENDWHERE
2826	! !
2827	! ENDDO
2828	! !
2829	! ! 4. store thickness of the different levels for all soil types (for security)
2830	! !
2831	! zf_coeff_snow(:,:,:) = zf_snow(:,:,:)
2832	! zi_coeff_snow(:,:,:) = zi_snow(:,:,:)
2833	!
2834	! !--hist out for keeping track of these
2835	! IF (firstcall) THEN
2836	! firstcall = .false.
2837	! ELSE
2838	! ENDIF
2839	!
2840	! END SUBROUTINE soil_gasdiff_coeff
2841
2842	!!!
2843	!!!================================================================================================================================
2844	!!! SUBROUTINE : soil_gasdiff_diff
2845	!!!
2846	!!>\BRIEF This routine update oxygen and methane in the snow and soil
2847	!!!
2848	!!! DESCRIPTION :
2849	!!!
2850	!!! RECENT CHANGE(S) : None
2851	!!!
2852	!!! MAIN OUTPUT VARIABLE(S) :
2853	!!!
2854	!!! REFERENCE(S) : None
2855	!!!
2856	!!! FLOWCHART11 : None
2857	!!! \n
2858	!!_
2859	!!================================================================================================================================
2860	!
2861	! SUBROUTINE soil_gasdiff_diff( kjpindex,time_step,index,pb,tsurf, O2_snow, CH4_snow, O2_soil, CH4_soil)
2862	!
2863	! !! 0. Variable and parameter declaration
2864	!
2865	! !! 0.1 Input variables
2866	!
2867	! INTEGER(i_std), INTENT(in) :: kjpindex !! number of grid points
2868	! REAL(r_std), INTENT(in) :: time_step !! time step in seconds
2869	! REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: pb !! Surface pressure
2870	! REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !! Surface temperature
2871	! INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: index !! Indeces of the points on the map
2872	! !! 0.2 Output variables
2873	!
2874	! !! 0.3 Modified variables
2875	!
2876	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow !! oxygen (g O2/m**3 air)
2877	! REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow !! methane (g CH4/m**3 air)
2878	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !! oxygen (g O2/m**3 air)
2879	! REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane (g CH4/m**3 air)
2880	!
2881	! !! 0.4 local variables
2882	!
2883	! INTEGER(i_std) :: it, ip, il, iv
2884	! LOGICAL, DIMENSION(kjpindex,nvm) :: snowtop
2885	! REAL(r_std), DIMENSION(kjpindex,nvm) :: O2sa, CH4sa
2886	!
2887	! !
2888	! ! 1.1 Determine which is the first existing soil type.
2889	! !
2890	! snowtop(:,:) = .FALSE.
2891	! !
2892	! !ignore snow for now...
2893	! WHERE ( heights_snow(:,:) .GT. hmin_tcalc )
2894	! snowtop(:,:) = .TRUE.
2895	! ENDWHERE
2896	! !
2897	! ! 2.gas diffusion
2898	! !
2899	! ! 2.1 top level
2900	! !
2901	! ! 2.1.1 non-existing
2902	! !
2903	! DO iv = 1, nvm
2904	! O2sa(:,iv) = pb(:)/(RRtsurf(:)) O2_surf * wO2
2905	! CH4sa(:,iv) = pb(:)/(RRtsurf(:)) CH4_surf * wCH4
2906	! ENDDO
2907	! !
2908	! WHERE ( (.NOT. snowtop(:,:)) .AND. veget_mask_2d(:,:) ) ! it equals 1 (snow) but there is no snow...
2909	! !
2910	! O2_snow(:,1,:) = O2sa(:,:)
2911	! CH4_snow(:,1,:) = CH4sa(:,:)
2912	! !
2913	! O2_soil(:,1,:) = ( O2sa(:,:) + mu_soil*betaO2_soil(:,1,:) ) / &
2914	! ( 1. + mu_soil*(1.-alphaO2_soil(:,1,:)) )
2915	! CH4_soil(:,1,:) = ( CH4sa(:,:) + mu_soil*betaCH4_soil(:,1,:) ) / &
2916	! ( 1. + mu_soil*(1.-alphaCH4_soil(:,1,:)) )
2917	! !
2918	! ENDWHERE
2919	! !
2920	! ! 2.1.2 first existing soil type
2921	! !
2922	! WHERE ( snowtop(:,:) .AND. veget_mask_2d(:,:) )
2923	! !
2924	! O2_snow(:,1,:) = ( O2sa(:,:) + mu_snow(:,:)*betaO2_snow(:,1,:) ) / &
2925	! ( 1. + mu_snow(:,:)*(1.-alphaO2_snow(:,1,:)) )
2926	! CH4_snow(:,1,:) = ( CH4sa(:,:) + mu_snow(:,:)*betaCH4_snow(:,1,:) ) / &
2927	! ( 1. + mu_snow(:,:)*(1.-alphaCH4_snow(:,1,:)) )
2928	! !
2929	! O2_soil(:,1,:) = &
2930	! alphaO2_snow(:,nsnow,:) * O2_snow(:,nsnow,:) + &
2931	! betaO2_snow(:,nsnow,:)
2932	! CH4_soil(:,1,:) = &
2933	! alphaCH4_snow(:,nsnow,:) * CH4_snow(:,nsnow,:) + &
2934	! betaCH4_snow(:,nsnow,:)
2935	! ! debug: need to check for weird numbers here!
2936	! ENDWHERE
2937	! !
2938	! ! 2.2 other levels
2939	! !
2940	! DO il = 2, nsnow
2941
2942	! WHERE ( veget_mask_2d(:,:) )
2943	! !
2944	! O2_snow(:,il,:) = &
2945	! alphaO2_snow(:,il-1,:) * O2_snow(:,il-1,:) + &
2946	! betaO2_snow(:,il-1,:)
2947	! CH4_snow(:,il,:) = &
2948	! alphaCH4_snow(:,il-1,:) * CH4_snow(:,il-1,:) + &
2949	! betaCH4_snow(:,il-1,:)
2950	! END WHERE
2951	! ENDDO
2952	! DO il = 2, ndeep
2953	!
2954	! WHERE ( veget_mask_2d(:,:) )
2955	! !
2956	! O2_soil(:,il,:) = &
2957	! alphaO2_soil(:,il-1,:) * O2_soil(:,il-1,:) + &
2958	! betaO2_soil(:,il-1,:)
2959	! CH4_soil(:,il,:) = &
2960	! alphaCH4_soil(:,il-1,:) * CH4_soil(:,il-1,:) + &
2961	! betaCH4_soil(:,il-1,:)
2962	! END WHERE
2963	! ENDDO
2964	!
2965	! END SUBROUTINE soil_gasdiff_diff
2966	!
2967
2968	!!
2969	!================================================================================================================================
2970	!! SUBROUTINE : soil_gasdiff_coeff_CH4
2971	!!
2972	!>\BRIEF This routine calculate coeff related to gas diffuvisity
2973	!!
2974	!! DESCRIPTION : Considering diffusion equation du/dt=d/dz(D(z)x(du/dz)) with
2975	!! u:oxygen concentration; z:depth position and D: diffusion coefficient.
2976	!! Using the forward time centered space(FTCS) method (defined in Numerical
2977	!! recipes in fortran 77: the art of scientific computing by W. Press, W.A.
2978	!! Teukolsky et al.) the diffusion equation becomes:
2979	!!
2980	!(u(n+1,j)-u(n,j))/(t(n+1)-t(n))=((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
2981	!! with n: time index and j: position index
2982	!! Using Crank-Nicolson method (the average of the implicite and explicite
2983	!! method) at time step centered at n+1/2 for both side of the equation:
2984	!! (u(n+1,j)-u(n,j))/(t(n+1)-t(n))= 1/2.
2985	!!
2986	!((D(z(j+1/2)).(u(n+1,j+1)-u(n+1,j)))-(D(z(j-1/2)).(u(n+1,j)-u(n+1,j-1))))/(z(j+1)-z(j))**2
2987	!!
2988	!+((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
2989	!! After moving all u(n+1) term on one side and u(n) on the other side we can
2990	!! consider:
2991	!! a=(t(n+1)-t(n))xD(z(j+1/2)/(2x(z(j+1)-z(j))**2)
2992	!! c=(t(n+1)-t(n))xD(z(j-1/2)/(2x(z(j+1)-z(j))**2)
2993	!! b=1+a+c
2994	!! a,b and c are the term of a tridiagonal matrix A such as:
2995	!! A.u(n+1,j)=B(u(n,j))
2996	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
2997	!timestep n+1)
2998	!! Then the tridiagonal algorithm define in Numerical recipes is employed to
2999	!! solve this linear system using forward then backward substitution method.
3000	!!
3001	!! RECENT CHANGE(S) : changed by Elodie Salmon on August 2018
3002	!!
3003	!! MAIN OUTPUT VARIABLE(S) :
3004	!!
3005	!! REFERENCE(S) : Numerical recipes in fortran 77: the art of scientific
3006	!computing by W. Press, W.A.
3007	!! Teukolsky et al. 1986-1992
3008	!!
3009	!! FLOWCHART11 : None
3010	!! \n
3011	!_
3012	!================================================================================================================================
3013
3014	SUBROUTINE soil_gasdiff_coeff_CH4(kjpindex, time_step, CH4atm, tsurf, CH4_snow, &
3015	diffCH4_snow,totporCH4_snow,CH4_soil, &
3016	diffCH4_soil,totporCH4_soil, zi_snow, zf_snow)!, &
3017	! a_soil, b_soil, c_soil, Bv_soil)
3018
3019	!! 0. Variable and parameter declaration
3020
3021	!! 0.1 Input variables
3022
3023	!Domain size
3024	INTEGER(i_std), INTENT(in) :: kjpindex !! number of grid points
3025	INTEGER(i_std) :: il
3026	! INTEGER(i_std), INTENT(inout) :: ildiff !!!begining
3027	! value index for il when computing diffusion with a thin snow top cover
3028	INTEGER(i_std) :: ip
3029	INTEGER(i_std) :: iv
3030
3031	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
3032	! REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: pb !! Surface pressure
3033	! (Pa)
3034	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !! Surface temperature
3035	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffCH4_snow !!CH4 diffusivity (m**2/s)
3036	REAL(r_std), DIMENSION(nsnow), INTENT(in) :: totporCH4_snow !!total CH4 porosity (Tans, 1998)
3037	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffCH4_soil !!CH4 diffusion coefficient in the soil (m**2/s) (compute in get_gasdiff)
3038	REAL(r_std), DIMENSION(ndeep), INTENT(in) :: totporCH4_soil !!total CH4 porosity (Tans, 1998)
3039	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow !!CH4 (g CH4/m**3 air)
3040	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !!methane (g CH4/m**3 air)
3041	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(in) :: zf_snow !!depths of full levels (m)
3042	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: zi_snow !!depths of intermediate levels (m)
3043
3044	!! 0.4 local variables
3045	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: diffCH4_halfUP !!average diffusion coefficient at half level up
3046	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: diffCH4_halfDOWN !!average diffusion coefficient at half level down
3047
3048	REAL(r_std),DIMENSION(kjpindex,nvm), INTENT(in) :: CH4atm
3049	LOGICAL,DIMENSION(kjpindex,nvm) :: snowtop
3050	!LOGICAL :: snow_height_mask_2d
3051	!LOGICAL, SAVE :: firstcall = .true.
3052
3053	! loop over materials (soil, snow), beginning at the top
3054	! diffusion is considered to be continued through soil and snow
3055	! so il is defined between 1 and nsnow+ndeep levels
3056	! but diffO2_soil, zf_soil, O2_soil are defined over ndeep levels
3057	! and diffO2_snow, zf_snow, O2_snow are defined over nsnow levels
3058	!
3059	! 1.0 Boundary conditions
3060	!
3061	!!!Define terms a,b and c of matrix A:
3062	!! a=(t(n+1)-t(n)).D(z(j+1/2)/(2.(z(j+1)-z(j))**2)
3063	!! c=(t(n+1)-t(n)).D(z(j-1/2)/(2.(z(j+1)-z(j))**2)
3064	!! b=1+a+c
3065	!! a,b and c are the term of a tridiagonal matrix A such as:
3066	!! A.u(n+1,j)=B(u(n,j))
3067	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
3068	!! timestep n+1)
3069	!
3070	! 1.1 Above snow: atmosphere/snow
3071	! 1.1.1 Determine whether there is snow top cover.
3072	!
3073
3074	DO ip = 1, kjpindex
3075	DO iv = 1,nvm
3076	DO il = 1, nsnow+ndeep
3077
3078	!!!Default values
3079	if ( heights_snow(ip,iv) .GT. hmin_tcalc ) then
3080	!
3081	! 1.1.2 There is snow cover: atmosphere/snow
3082	!
3083	!
3084	!1.1.2.1 top snow level
3085	!
3086	ildiff(ip,iv) = 1 !!define top snow layer for diffusion. This value changes
3087	!! with the amont of snow whether there is 1, 2 or 3 layer
3088	!! of snow that are filled in
3089	IF ( il .EQ. 1 ) THEN
3090	IF ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv) .GT.0)) THEN !here 1 is the top snow level
3091	!Diffusion coefficient at half level above and below:
3092	diffCH4_halfUP(ip,il,iv) = (diffCH4_air + diffCH4_snow(ip,il,iv))/2.
3093	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_snow(ip,il+1,iv) + diffCH4_snow(ip,il,iv))/2.
3094	!Define terms a,b and c of matrix A:
3095	!a_CH4soil=a_CH4snow,b_CH4soil=b_CH4snow,c_CH4soil=c_CH4snow,and
3096	!Bv_CH4soil=Bv_CH4snow,
3097	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3098	/(2. ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv))*2.))
3099	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3100	/(2. ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv))*2.))
3101	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3102	!Define vector B using O2 concentration in previous time step:
3103	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4atm(ip,iv) + &
3104	(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_snow(ip,nsnow,iv) &
3105	+ c_CH4soil(ip,il,iv)*CH4_snow(ip,nsnow-1,iv)
3106	ELSE
3107	ildiff(ip,iv) = il+1
3108	ENDIF
3109	ENDIF
3110
3111	!
3112	!1.1.2.2 Middle snow level
3113	!
3114
3115	! Whether top level is a snow level then the middle snow level is :
3116
3117	IF ((il .GT. 1).AND.(il .LT.nsnow)) THEN
3118	IF ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv).GT.0)) THEN
3119
3120	!Diffusion coefficient at half level above and below:
3121	!nsnow+1-il is to convert il dimension into nsnow dimension
3122	diffCH4_halfUP(ip,il,iv) = (diffCH4_snow(ip,il+1,iv) + diffCH4_snow(ip,il,iv))/2.
3123	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_snow(ip,il-1,iv)+diffCH4_snow(ip,il,iv))/2.
3124	!Define terms a,b and c of matrix A:
3125	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3126	/(2. * ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv))**2.))
3127	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3128	/(2. * ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv))**2.))
3129	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3130	!Define vector B using O2 concentration in previous time step:
3131	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_snow(ip,il-1,iv) &
3132	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_snow(ip,il,iv) &
3133	+ c_CH4soil(ip,il,iv)*CH4_snow(ip,il+1,iv)
3134	ELSE
3135	ildiff(ip,iv) =il+1
3136	ENDIF
3137	ENDIF
3138
3139	!
3140	!1.1.2.3 Bottom snow level
3141	!
3142
3143
3144	! Whether top level is a snow level then the bottom snow level is :
3145	IF ( il .EQ. nsnow) THEN
3146	IF ((zf_snow(ip,nsnow+1-il,iv).GT.0)) THEN !here nsnow is the bottom snow level
3147	!Diffusion coefficient at half level above and below:
3148	diffCH4_halfUP(ip,il,iv) = (diffCH4_snow(ip,il-1,iv) + diffCH4_snow(ip,il,iv))/2.
3149	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il+1-nsnow,iv)+diffCH4_snow(ip,il,iv))/2.
3150	!Define terms a,b and c of matrix A:
3151	!a_CH4soil=a_CH4snow,b_CH4soil=b_CH4snow,c_CH4soil=c_CH4snow,and
3152	!Bv_CH4soil=Bv_CH4snow,
3153	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3154	/(2. ((zf_snow(ip,nsnow+1-il,iv))*2.))
3155	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3156	/(2. * ((zf_snow(ip,nsnow+1-il,iv))**2.))
3157	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3158	!Define vector B using O2 concentration in previous time step:
3159	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_snow(ip,il-1,iv) &
3160	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_snow(ip,il,iv)&
3161	+c_CH4soil(ip,il,iv)*CH4_soil(ip,1,iv)
3162	ELSE
3163	ildiff(ip,iv) = il+1
3164	ENDIF
3165	ENDIF
3166
3167	!
3168	!1.1.2.4 First soil level with snow top
3169	!
3170
3171	! Whether top level is a snow level then the first soil level is :
3172	IF ( il .EQ. nsnow+1) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3173	!Diffusion coefficient at half level above and below:
3174	!il-nsnow is to convert il dimension into ndeep dimension
3175	diffCH4_halfUP(ip,il,iv) = (diffCH4_snow(ip,nsnow,iv) + diffCH4_soil(ip,il-nsnow,iv))/2.
3176	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il-nsnow+1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3177	!Define terms a,b and c of matrix A:
3178	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3179	/(2. ((zf_soil(il-nsnow))*2.))
3180	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3181	/(2. ((zf_soil(il-nsnow))*2.))
3182	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3183	!Define vector B using O2 concentration in previous time step:
3184	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_snow(ip,nsnow,iv) &
3185	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,il-nsnow,iv) &
3186	+ c_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow+1,iv)
3187	ENDIF
3188
3189	!
3190	!1.1.2.4 First soil level with snow top
3191	!
3192
3193	! Whether top level is a snow level then the first soil level is :
3194	IF ( il .EQ. nsnow+1) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3195	!Diffusion coefficient at half level above and below:
3196	!il-nsnow is to convert il dimension into ndeep dimension
3197	diffCH4_halfUP(ip,il,iv) = (diffCH4_snow(ip,nsnow,iv) + diffCH4_soil(ip,il-nsnow,iv))/2.
3198	! diffCH4_halfUP(ip,il,iv) = diffCH4_soil(ip,il-nsnow,iv)
3199	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il-nsnow+1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3200	!Define terms a,b and c of matrix A:
3201	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3202	/(2.((zf_soil(il-nsnow))*2.))
3203	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3204	/(2.((zf_soil(il-nsnow))*2.))
3205	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3206	!Define vector B using O2 concentration in previous time step:
3207	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_snow(ip,nsnow,iv) &
3208	+ (1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,il-nsnow,iv) &
3209	+ c_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow+1,iv)
3210	ENDIF
3211
3212	!
3213	!1.1.2.5 Middle soil level with snow top
3214	!
3215	IF ((il .GE. nsnow+2).AND.(il .LT. nsnow+ndeep)) THEN
3216	!Diffusion coefficient at half level above and below:
3217	!il-nsnow is to convert il dimension into ndeep dimension
3218	diffCH4_halfUP(ip,il,iv) = (diffCH4_soil(ip,il-nsnow-1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3219	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il-nsnow+1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3220	!Define terms a,b and c of matrix A:
3221	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3222	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3223	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3224	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3225	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3226	!Define vector B using O2 concentration in previous time step:
3227	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow-1,iv) &
3228	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,il-nsnow,iv) &
3229	+ c_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow+1,iv)
3230	ENDIF
3231
3232	!
3233	!1.1.2.6 Bottom soil level with snow top:last level of soil column
3234	!
3235
3236	IF ( il .EQ. (nsnow+ndeep)) THEN !il(=top soil level) is defined withnsnow+ndeep levels
3237
3238	!Diffusion coefficient at half level above and below:
3239	diffCH4_halfUP(ip,il,iv) = (diffCH4_soil(ip,ndeep-1,iv)+diffCH4_soil(ip,ndeep,iv))/2.
3240	diffCH4_halfDOWN(ip,il,iv) = diffCH4_soil(ip,ndeep,iv)
3241	!Define terms a,b and c of matrix A:
3242	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3243	/(2. ((zf_soil(ndeep) - zf_soil(ndeep-1))*2.))
3244	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3245	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3246	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3247	!Define vector B using O2 concentration in previous time step:
3248	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_soil(ip,ndeep-1,iv) &
3249	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,ndeep,iv) &
3250	+c_CH4soil(ip,il,iv)*CH4_soil(ip,ndeep,iv)
3251	!O2 concentration at z+1(=ndeep+1 level does not exist) is supposed to
3252	!be the same than at z=ndeep. We assume that below the soil column there
3253	!is a level with the same O2 concentration.
3254	ENDIF
3255
3256	else!#########THERE IS NO SNOWTOP
3257
3258	!
3259	! 1.1.3 There is no snow cover: atmosphere/soil
3260	!
3261	IF (il .LE. nsnow)THEN
3262	ENDIF
3263	!
3264	!1.1.3.1 First soil level NO snow top:
3265	!
3266
3267	IF ( il .EQ. (nsnow+1)) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3268	!Diffusion coefficient at half level above and below:
3269	!il-nsnow is to convert il dimension into ndeep dimension
3270	diffCH4_halfUP(ip,il,iv) = (diffCH4_air + diffCH4_soil(ip,il-nsnow,iv))/2.
3271	! diffCH4_halfUP(ip,il,iv) = diffCH4_soil(ip,il-nsnow,iv)
3272	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il-nsnow+1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3273	!Define terms a,b and c of matrix A:
3274	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3275	/(2. ((zf_soil(il-nsnow))*2.))
3276	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3277	/(2. * ((zf_soil(il-nsnow))**2.))
3278	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3279	!Define vector B using O2 concentration in previous time step:
3280	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4atm(ip,iv) &
3281	+ (1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,il-nsnow,iv) &
3282	+ c_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow+1,iv)
3283
3284	ENDIF
3285
3286	!
3287	!1.1.3.2 Middle soil level NO snow top
3288	!
3289	IF ((il .GE. nsnow+2).AND.(il .LT. nsnow+ndeep)) THEN
3290	!Diffusion coefficient at half level above and below:
3291	!il-nsnow is to convert il dimension into ndeep dimension
3292	diffCH4_halfUP(ip,il,iv) = (diffCH4_soil(ip,il-nsnow-1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3293	diffCH4_halfDOWN(ip,il,iv) = (diffCH4_soil(ip,il-nsnow+1,iv)+diffCH4_soil(ip,il-nsnow,iv))/2.
3294	!Define terms a,b and c of matrix A:
3295	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3296	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3297	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3298	/(2. ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))*2.))
3299	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3300	!Define vector B using O2 concentration in previous time step:
3301	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow-1,iv) &
3302	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,il-nsnow,iv) &
3303	+c_CH4soil(ip,il,iv)*CH4_soil(ip,il-nsnow+1,iv)
3304	ENDIF
3305
3306	!
3307	!1.1.3.3 Bottom soil level NO snow top:last level of soil column
3308	!
3309
3310	IF ( il .EQ. (nsnow+ndeep)) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3311
3312	!Diffusion coefficient at half level above and below:
3313	diffCH4_halfUP(ip,il,iv) =(diffCH4_soil(ip,ndeep-1,iv)+diffCH4_soil(ip,ndeep,iv))/2.
3314	diffCH4_halfDOWN(ip,il,iv) = diffCH4_soil(ip,ndeep,iv)
3315	!Define terms a,b and c of matrix A:
3316	a_CH4soil(ip,il,iv) = time_step * diffCH4_halfUP(ip,il,iv) &
3317	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3318	c_CH4soil(ip,il,iv) = time_step * diffCH4_halfDOWN(ip,il,iv) &
3319	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3320	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3321	!Define vector B using O2 concentration in previous time step:
3322	Bv_CH4soil(ip,il,iv) = a_CH4soil(ip,il,iv)*CH4_soil(ip,ndeep-1,iv) &
3323	+(1.-a_CH4soil(ip,il,iv)-c_CH4soil(ip,il,iv))*CH4_soil(ip,ndeep,iv) &
3324	+ c_CH4soil(ip,il,iv)*CH4_soil(ip,ndeep,iv)
3325	!O2 concentration at z+1(=ndeep+1 level does not exist) is supposed to
3326	!be the same than at z=ndeep. We assume that below the soil column there
3327	!is a level with the same O2 concentration.
3328	ENDIF
3329
3330
3331	endif !###############LOOP THERE IS SNOW TOP OR NOT
3332	ENDDO
3333	ENDDO
3334	ENDDO
3335
3336	END SUBROUTINE soil_gasdiff_coeff_CH4
3337
3338	!!
3339	!================================================================================================================================
3340	!! SUBROUTINE : soil_gasdiff_diff_CH4
3341	!!
3342	!>\BRIEF : This routine compute diffusion equation for oxygen in the snow and
3343	!soil with diffusion coefficient that is not constant D=D(z)
3344	!!
3345	!! DESCRIPTION : Considering diffusion equation du/dt=d/dz(D(z)x(du/dz)) with
3346	!! u:oxygen concentration; z:depth position and D: diffusion coefficient.
3347	!! Using the forward time centered space(FTCS) method (defined in Numerical
3348	!! recipes in fortran 77: the art of scientific computing by W. Press, W.A.
3349	!! Teukolsky et al.) the diffusion equation becomes:
3350	!!
3351	!(u(n+1,j)-u(n,j))/(t(n+1)-t(n))=((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3352	!! with n: time index and j: position index
3353	!! Using Crank-Nicolson method (the average of the implicite and explicite
3354	!! method) at time step centered at n+1/2 for both side of the equation:
3355	!! (u(n+1,j)-u(n,j))/(t(n+1)-t(n))= 1/2.
3356	!!
3357	!((D(z(j+1/2)).(u(n+1,j+1)-u(n+1,j)))-(D(z(j-1/2)).(u(n+1,j)-u(n+1,j-1))))/(z(j+1)-z(j))**2
3358	!!
3359	!+((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3360	!! After moving all u(n+1) term on one side and u(n) on the other side we can
3361	!consider:
3362	!! a=(t(n+1)-t(n))xD(z(j+1/2)/(2x(z(j+1)-z(j))**2)
3363	!! c=(t(n+1)-t(n))xD(z(j-1/2)/(2x(z(j+1)-z(j))**2)
3364	!! b=1+a+c
3365	!! a,b and c are the term of a tridiagonal matrix A such as:
3366	!! Axu(n+1,j)=B(u(n,j))
3367	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
3368	!timestep n+1)
3369	!! Then the tridiagonal algorithm define in Numerical recipes is employed to
3370	!! solve this linear system using forward then backward substitution method.
3371	!!
3372	!! RECENT CHANGE(S) : changed by Elodie Salmon on August 2018
3373	!!
3374	!! MAIN OUTPUT VARIABLE(S) :
3375	!!
3376	!! REFERENCE(S) : Numerical recipes in fortran 77: the art of scientific
3377	!computing by W. Press, W.A.
3378	!! Teukolsky et al. 1986-1992
3379	!!
3380	!! FLOWCHART11 : None
3381	!! \n
3382	!_
3383	!================================================================================================================================
3384
3385	SUBROUTINE soil_gasdiff_diff_CH4(kjpindex, time_step,CH4atm, CH4_snow,CH4_soil)!, a_soil, b_soil, c_soil, Bv_soil)
3386
3387	!! 0. Variable and parameter declaration
3388
3389	!! 0.1 Input variables
3390	INTEGER(i_std), INTENT(in) :: kjpindex!! number of grid points
3391	INTEGER(i_std) :: il
3392	! INTEGER(i_std), INTENT(in) :: ildiff !!!begining value
3393	! index for il when computing diffusion with a thin snow top cover
3394	INTEGER(i_std) :: j
3395	INTEGER(i_std) :: ip
3396	INTEGER(i_std) :: iv
3397	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
3398	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: CH4atm !!atmospheric methane content
3399	!! 0.2 Output variables
3400
3401	!! 0.3 Modified variables
3402
3403	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow !! methane (g CH4/m**3 air)
3404	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane (g CH4/m**3 air)
3405
3406	!! 0.4 local variables
3407
3408	INTEGER(i_std) :: it
3409	LOGICAL,DIMENSION(kjpindex,nvm) :: snowtop
3410	REAL(r_std), DIMENSION(kjpindex,nvm ) :: A11_CH4 !!the first term of matrix A e.g.A11=b_soil(1)
3411	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: u_CH4 !!vector containing oxygen concentration at each level: store results of the tridiagonal algorithm
3412	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: gam_CH4 !!A matrix term are substituded to new coefficients stored in gam vector
3413
3414	! To solve linear system defined in subroutine
3415	! soil_gasdiff_coeff_CH4 we use a trigiagonal algorithm described in
3416	! Numerical recipes. Then we save the results according to snow and soil
3417	! levels.
3418
3419	!Here for il=1,nsnow then
3420	!!a_soil=a_snow,b_soil=b_snow,c_soil=c_snow,and Bv_soil=Bv_snow,
3421	! and for il=nsnow, ndeep+nsnow then
3422	!a_soil=a_soil,b_soil=b_soil,c_soil=c_soil,and Bv_soil=Bv_soil
3423
3424	DO ip=1,kjpindex
3425	DO iv = 1, nvm
3426
3427	!! Initial values:
3428	A11_CH4(ip,iv) = zero
3429
3430	if ( heights_snow(ip,iv) .GT. hmin_tcalc ) then !There is snowtop
3431
3432	!In matrix A, a_CH4soil= -a_CH4soil, c_CH4soil= -c_CH4soil and
3433	!b_CH4soil=1+a+c
3434	DO il = ildiff(ip,iv), nsnow+ndeep
3435	!! ildiff =1 if all three snow layers are filled with snow;
3436	!! ildiff =2 if 2 snow layers are filled with snow
3437	!! ildiff =3 if 1 snow layer is filled with snow
3438	!! ildiff =4 if the layer of snow is too small to consider the
3439	!layer
3440	!! nsnow+ndeep = 3 +32=35
3441	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3442	a_CH4soil(ip,il,iv) = -1. * a_CH4soil(ip,il,iv)
3443	c_CH4soil(ip,il,iv) = -1. * c_CH4soil(ip,il,iv)
3444	gam_CH4(ip,il,iv) = zero
3445	ENDDO
3446
3447	!Check that the first term of matrix A e.g.A11=b_soil(1) is different than
3448	!0 to avoid
3449	!division by zero
3450	if (b_CH4soil(ip,ildiff(ip,iv),iv) .EQ. 0 ) then
3451	write(numout,*) 'ESdebugCH4diff: Error after soil_gasdiff_diff_CH4:b_CH4soil(il)=',b_CH4soil(ip,il,iv),'ip=',ip,'iv=',iv,'il=',il,'a_CH4soil(il)=',a_CH4soil(ip,il,iv),'c_CH4soil(il)=',c_CH4soil(ip,il,iv),'Bv_CH4soil(il)',Bv_CH4soil(ip,il,iv)
3452	stop "Error in soil_gasdiff_diff_CH4 for b_soil(1)"
3453	endif
3454
3455	!Decomposition and forward substitution
3456	A11_CH4(ip,iv) = b_CH4soil(ip,ildiff(ip,iv),iv) !!first term of matrix A
3457
3458	u_CH4(ip,ildiff(ip,iv),iv) = Bv_CH4soil(ip,ildiff(ip,iv),iv) /A11_CH4(ip,iv) !!first term of vector u:CH4 concentration for each level
3459	j = nsnow+ndeep
3460	DO il = ildiff(ip,iv)+1,j
3461	!!Here A matrix term are substituded to new coefficients stored in
3462	!gam vector:
3463	gam_CH4(ip,il,iv) = c_CH4soil(ip,il-1,iv) / A11_CH4(ip,iv)
3464	!!In order to avoid a division by zero in u(j) below we define
3465	!minimum condition for A11 based on minimum CH4 concentration :
3466	!under CH4 concentration < min_stomate such as min_stomate then
3467	!u(j)=Bv_soil=min_stomate
3468	!then assuming a_soil=0 so A11=1
3469	A11_CH4(ip,iv) = b_CH4soil(ip,il,iv) - a_CH4soil(ip,il,iv) * gam_CH4(ip,il,iv)
3470	u_CH4(ip,il,iv) = (Bv_CH4soil(ip,il,iv) - a_CH4soil(ip,il,iv) * u_CH4(ip,il-1,iv))/A11_CH4(ip,iv)
3471	ENDDO
3472	!Backsubstitution to solve linear system with triagonal matrix:
3473	DO il = j-1,ildiff(ip,iv),-1
3474	u_CH4(ip,il,iv) = u_CH4(ip,il,iv) - gam_CH4(ip,il+1,iv) * u_CH4(ip,il+1,iv)
3475	u_CH4(ip,il,iv) = max(min_stomate, u_CH4(ip,il,iv))
3476	ENDDO
3477
3478	!record methane concentration profil in CH4_snow and CH4_soil:
3479	IF (ildiff(ip,iv) .LT. 4) THEN
3480	DO il = ildiff(ip,iv), nsnow
3481	CH4_snow(ip,il,iv) = u_CH4(ip,il,iv)
3482	ENDDO
3483	ENDIF
3484	DO il = nsnow+1, nsnow+ndeep
3485	CH4_soil(ip,il-nsnow,iv) = u_CH4(ip,il,iv)
3486	ENDDO
3487
3488
3489	else !there is not snowtop
3490	!! ndeep levels si nsnow+1<il<ndeep
3491	!Here for il=nsnow, ndeep+nsnow then
3492	!a_soil=a_soil,b_soil=b_soil,c_soil=c_soil,and Bv_soil=Bv_soil
3493	!In matrix A, a_soil= -a_soil, c_soil= -c_soil and b_soil=1+a+c
3494	DO il = 1+nsnow, nsnow+ndeep
3495	b_CH4soil(ip,il,iv) = 1. + a_CH4soil(ip,il,iv) + c_CH4soil(ip,il,iv)
3496	a_CH4soil(ip,il,iv) = -1. * a_CH4soil(ip,il,iv)
3497	c_CH4soil(ip,il,iv) = -1. * c_CH4soil(ip,il,iv)
3498	gam_CH4(ip,il,iv) = zero
3499	ENDDO
3500	!Check that the first term of matrix A e.g.A11=b_soil(1) is different than
3501	!0 to avoid
3502	!division by zero
3503	if (b_CH4soil(ip,1+nsnow,iv) .EQ. 0 ) then
3504	write(numout,*) 'ESdebugCH4diff:Error after soil_gasdiff_diff_CH4:b_CH4soil(il)=',b_CH4soil(ip,il,iv),'ip=',ip,'iv=',iv,'il=',il,'a_CH4soil(il)=',a_CH4soil(ip,il,iv),'c_CH4soil(il)=',c_CH4soil(ip,il,iv),'Bv_CH4soil(il)',Bv_CH4soil(ip,il,iv)
3505	stop "Error in soil_gasdiff_diff_CH4 for b_CH4soil(1)"
3506	endif
3507
3508	!Decomposition and forward substitution
3509	A11_CH4(ip,iv)=b_CH4soil(ip,nsnow+1,iv) !!first term of matrix A
3510	u_CH4(ip,nsnow+1,iv)=Bv_CH4soil(ip,nsnow+1,iv)/A11_CH4(ip,iv) !!first term of vector u:methane concetration for each level
3511	j = nsnow+ndeep
3512	DO il=nsnow+2,j
3513	!!Here A matrix term are substituded to new coefficients stored in
3514	!gam vector:
3515	gam_CH4(ip,il,iv) = c_CH4soil(ip,il-1,iv) / A11_CH4(ip,iv)
3516	!!In order to avoid a division by zero in u(j) below we define
3517	!minimum condition for A11 based on minimum methane concentration:
3518	!under CH4 concentration < min_stomate then u(j)=Bv_soil=min_stomate
3519	!then assuming a_soil=0 so A11=1
3520	A11_CH4(ip,iv) = b_CH4soil(ip,il,iv) - a_CH4soil(ip,il,iv) * gam_CH4(ip,il,iv)
3521	u_CH4(ip,il,iv) = (Bv_CH4soil(ip,il,iv) - a_CH4soil(ip,il,iv) * u_CH4(ip,il-1,iv))/A11_CH4(ip,iv)
3522	ENDDO
3523	!Backsubstitution to solve linear system with triagonal matrix:
3524	DO il=j-1,1+nsnow,-1
3525	u_CH4(ip,il,iv) = u_CH4(ip,il,iv) - gam_CH4(ip,il+1,iv) * u_CH4(ip,il+1,iv)
3526	u_CH4(ip,il,iv) = max(min_stomate, u_CH4(ip,il,iv))
3527	ENDDO
3528
3529	!record methane concentration profil in CH4_soil:
3530	DO il = nsnow+1, ndeep+nsnow
3531	CH4_soil(ip,il-nsnow,iv) = u_CH4(ip,il,iv)
3532	ENDDO
3533	end if
3534	ENDDO
3535	ENDDO
3536
3537
3538	END SUBROUTINE soil_gasdiff_diff_CH4
3539
3540	!!
3541	!================================================================================================================================
3542	!! SUBROUTINE : soil_gasdiff_coeff_O2
3543	!!
3544	!>\BRIEF This routine calculate coeff related to gas diffuvisity
3545	!!
3546	!! DESCRIPTION : Considering diffusion equation du/dt=d/dz(D(z)x(du/dz)) with
3547	!! u:oxygen concentration; z:depth position and D: diffusion coefficient.
3548	!! Using the forward time centered space(FTCS) method (defined in Numerical
3549	!! recipes in fortran 77: the art of scientific computing by W. Press, W.A.
3550	!! Teukolsky et al.) the diffusion equation becomes:
3551	!!
3552	!(u(n+1,j)-u(n,j))/(t(n+1)-t(n))=((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3553	!! with n: time index and j: position index
3554	!! Using Crank-Nicolson method (the average of the implicite and explicite
3555	!! method) at time step centered at n+1/2 for both side of the equation:
3556	!! (u(n+1,j)-u(n,j))/(t(n+1)-t(n))= 1/2.
3557	!!
3558	!((D(z(j+1/2)).(u(n+1,j+1)-u(n+1,j)))-(D(z(j-1/2)).(u(n+1,j)-u(n+1,j-1))))/(z(j+1)-z(j))**2
3559	!!
3560	!+((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3561	!! After moving all u(n+1) term on one side and u(n) on the other side we can
3562	!! consider:
3563	!! a=(t(n+1)-t(n))xD(z(j+1/2)/(2x(z(j+1)-z(j))**2)
3564	!! c=(t(n+1)-t(n))xD(z(j-1/2)/(2x(z(j+1)-z(j))**2)
3565	!! b=1+a+c
3566	!! a,b and c are the term of a tridiagonal matrix A such as:
3567	!! A.u(n+1,j)=B(u(n,j))
3568	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
3569	!timestep n+1)
3570	!! Then the tridiagonal algorithm define in Numerical recipes is employed to
3571	!! solve this linear system using forward then backward substitution method.
3572	!!
3573	!! RECENT CHANGE(S) : changed by Elodie Salmon on August 2018
3574	!!
3575	!! MAIN OUTPUT VARIABLE(S) :
3576	!!
3577	!! REFERENCE(S) : Numerical recipes in fortran 77: the art of scientific
3578	!computing by W. Press, W.A.
3579	!! Teukolsky et al. 1986-1992
3580	!!
3581	!! FLOWCHART11 : None
3582	!! \n
3583	!_
3584	!================================================================================================================================
3585
3586	SUBROUTINE soil_gasdiff_coeff_O2(kjpindex, time_step, O2atm, tsurf, O2_snow, &
3587	diffO2_snow,totporO2_snow,O2_soil, &
3588	diffO2_soil,totporO2_soil, zi_snow, zf_snow)!, &
3589
3590	!! 0. Variable and parameter declaration
3591
3592	!! 0.1 Input variables
3593
3594	!Domain size
3595	INTEGER(i_std), INTENT(in) :: kjpindex !!number of grid points
3596	INTEGER(i_std) :: il
3597	INTEGER(i_std) :: ip
3598	INTEGER(i_std) :: iv
3599
3600	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
3601	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !!Surface temperature
3602	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: diffO2_snow !!oxygen diffusivity (m**2/s)
3603	REAL(r_std), DIMENSION(nsnow), INTENT(in) :: totporO2_snow !!total O2 porosity (Tans, 1998)
3604	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: diffO2_soil !!oxygen diffusion coefficient in the soil (m**2/s) (compute in get_gasdiff)
3605	REAL(r_std), DIMENSION(ndeep), INTENT(in) :: totporO2_soil !!total O2 porosity (Tans, 1998)
3606	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow !!oxygen (g O2/m**3 air)
3607	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !!oxygen (g O2/m**3 air)
3608	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(in) :: zf_snow !!depths of full levels (m)
3609	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in) :: zi_snow !!depths of intermediate levels (m)
3610
3611
3612	!! 0.2 Output variables
3613	!! 0.3 Modified variables
3614
3615	!! 0.4 local variables
3616	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: diffO2_halfUP !!average diffusion coefficient at half level up
3617	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: diffO2_halfDOWN !!average diffusion coefficient at half level down
3618
3619	REAL(r_std),DIMENSION(kjpindex,nvm), INTENT(in) :: O2atm
3620	LOGICAL,DIMENSION(kjpindex,nvm) :: snowtop
3621	!LOGICAL :: snow_height_mask_2d
3622	!LOGICAL, SAVE :: firstcall = .true.
3623
3624	! loop over materials (soil, snow), beginning at the top
3625	! diffusion is considered to be continued through soil and snow
3626	! so il is defined between 1 and nsnow+ndeep levels
3627	! but diffO2_soil, zf_soil, O2_soil are defined over ndeep levels
3628	! and diffO2_snow, zf_snow, O2_snow are defined over nsnow levels
3629	!
3630	! 1.0 Boundary conditions
3631	!
3632
3633	!!!Define terms a,b and c of matrix A:
3634	!! a=(t(n+1)-t(n)).D(z(j+1/2)/(2.(z(j+1)-z(j))**2)
3635	!! c=(t(n+1)-t(n)).D(z(j-1/2)/(2.(z(j+1)-z(j))**2)
3636	!! b=1+a+c
3637	!! a,b and c are the term of a tridiagonal matrix A such as:
3638	!! A.u(n+1,j)=B(u(n,j))
3639	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
3640	!! timestep n+1)
3641	!
3642	! 1.1 Above snow: atmosphere/snow
3643	! 1.1.1 Determine whether there is snow top cover.
3644	!
3645
3646	!
3647	! O2 land surface concentration
3648	!
3649	DO ip = 1, kjpindex
3650	DO iv = 1,nvm
3651	DO il = 1, nsnow+ndeep
3652
3653	!!!Default values
3654
3655
3656	if ( heights_snow(ip,iv) .GT. hmin_tcalc ) then
3657
3658	!
3659	! 1.1.2 There is snow cover: atmosphere/snow
3660	!
3661	!
3662	!1.1.2.1 top snow level
3663	!
3664
3665	ildiff(ip,iv) = 1 !!define top snow layer for diffusion. This value changes
3666	!! with the amont of snow whether there is 1, 2 or 3 layer
3667	!! of snow that are filled in
3668	IF ( il .EQ. 1 ) THEN !here 1 is the top snow level
3669	IF ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv) .GT.0)) THEN !here 1 is the top snow level
3670	!Diffusion coefficient at half level above and below:
3671	diffO2_halfUP(ip,il,iv) = (diffO2_air + diffO2_snow(ip,il,iv))/2.
3672	diffO2_halfDOWN(ip,il,iv)=(diffO2_snow(ip,il+1,iv)+diffO2_snow(ip,il,iv))/2.
3673	!Define terms a,b and c of matrix A:
3674	!a_O2soil=a_O2snow,b_O2soil=b_O2snow,c_O2soil=c_O2snow,and
3675	!Bv_O2soil=Bv_O2snow,
3676	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3677	/(2. * ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv))**2.))
3678	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3679	/(2. * ((zf_snow(ip,nsnow,iv)-zf_snow(ip,nsnow-1,iv))**2.))
3680	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3681	!Define vector B using O2 concentration in previous time step:
3682	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2atm(ip,iv) &
3683	+(1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_snow(ip,nsnow,iv) &
3684	+c_O2soil(ip,il,iv)*O2_snow(ip,nsnow-1,iv)
3685	ELSE
3686	ildiff(ip,iv) = il+1
3687	ENDIF
3688	ENDIF
3689
3690	!
3691	!1.1.2.2 Middle snow level
3692	!
3693	IF ((il .GT. 1) .AND. (il .LT. nsnow)) THEN
3694	IF ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv).GT.0)) THEN
3695
3696	!Diffusion coefficient at half level above and below:
3697	!nsnow+1-il is to convert il dimension into nsnow dimension
3698	diffO2_halfUP(ip,il,iv) = (diffO2_snow(ip,il+1,iv) + diffO2_snow(ip,il,iv))/2.
3699	diffO2_halfDOWN(ip,il,iv) =(diffO2_snow(ip,il-1,iv)+ diffO2_snow(ip,il,iv))/2.
3700	!Define terms a,b and c of matrix A:
3701	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3702	/(2. ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv))*2.))
3703	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3704	/(2. ((zf_snow(ip,il+1,iv)-zf_snow(ip,il,iv))*2.))
3705	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3706	!Define vector B using O2 concentration in previous time step:
3707	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_snow(ip,il-1,iv) &
3708	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_snow(ip,il,iv) &
3709	+ c_O2soil(ip,il,iv)*O2_snow(ip,il+1,iv)
3710	ELSE
3711	ildiff(ip,iv) =il+1
3712	ENDIF
3713	ENDIF
3714
3715
3716	!
3717	!1.1.2.3 Bottom snow level
3718	!
3719
3720	! Whether top level is a snow level then the bottom snow level is :
3721	IF ( il .EQ. nsnow) THEN !here nsnow is the bottom snow level
3722	IF ((zf_snow(ip,nsnow+1-il,iv).GT.0)) THEN !here nsnow is the bottom snow level
3723
3724	!Diffusion coefficient at half level above and below:
3725	diffO2_halfUP(ip,il,iv) = (diffO2_snow(ip,il-1,iv) + diffO2_snow(ip,il,iv))/2.
3726	diffO2_halfDOWN(ip,il,iv) =(diffO2_soil(ip,il+1-nsnow,iv) + diffO2_snow(ip,il,iv))/2.
3727	!Define terms a,b and c of matrix A:
3728	!a_soil=a_snow,b_soil=b_snow,c_soil=c_snow,and Bv_soil=Bv_snow,
3729	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3730	/(2. * ((zf_snow(ip,nsnow+1-il,iv))**2.))
3731	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3732	/(2. * ((zf_snow(ip,nsnow+1-il,iv))**2.))
3733	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3734	!Define vector B using O2 concentration in previous time step:
3735	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_snow(ip,il-1,iv) &
3736	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_snow(ip,il,iv) &
3737	+ c_O2soil(ip,il,iv)*O2_soil(ip,1,iv)
3738	ELSE
3739	ildiff(ip,iv) = il+1
3740	ENDIF
3741
3742	ENDIF
3743
3744	!
3745	!1.1.2.4 First soil level with snow top
3746	!
3747
3748
3749	! Whether top level is a snow level then the first soil level is :
3750	IF ( il .EQ. nsnow+1) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3751	!Diffusion coefficient at half level above and below:
3752	!il-nsnow is to convert il dimension into ndeep dimension
3753	diffO2_halfUP(ip,il,iv) = (diffO2_snow(ip,nsnow,iv) + diffO2_soil(ip,il-nsnow,iv))/2.
3754	diffO2_halfDOWN(ip,il,iv)=(diffO2_soil(ip,il-nsnow+1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3755	!Define terms a,b and c of matrix A:
3756	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3757	/(2. * ((zf_soil(il-nsnow))**2.))
3758	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3759	/(2. * ((zf_soil(il-nsnow))**2.))
3760	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3761	!Define vector B using O2 concentration in previous time step:
3762	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_snow(ip,nsnow,iv) &
3763	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,il-nsnow,iv) &
3764	+ c_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow+1,iv)
3765	ENDIF
3766
3767	!
3768	!1.1.2.5 Middle soil level with snow top
3769	!
3770	IF ((il .GE. nsnow+2) .AND. (il .LT. nsnow+ndeep)) THEN
3771	!Diffusion coefficient at half level above and below:
3772	!il-nsnow is to convert il dimension into ndeep dimension
3773	diffO2_halfUP(ip,il,iv) = (diffO2_soil(ip,il-nsnow-1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3774	diffO2_halfDOWN(ip,il,iv) = (diffO2_soil(ip,il-nsnow+1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3775	!Define terms a,b and c of matrix A:
3776	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3777	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3778	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3779	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3780	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3781	!Define vector B using O2 concentration in previous time step:
3782	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow-1,iv) &
3783	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,il-nsnow,iv)&
3784	+ c_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow+1,iv)
3785	ENDIF
3786
3787	!
3788	!1.1.2.6 Bottom soil level with snow top:last level of soil column
3789	!
3790	IF ( il .EQ. (nsnow+ndeep)) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3791
3792	!Diffusion coefficient at half level above and below:
3793	diffO2_halfUP(ip,il,iv) = (diffO2_soil(ip,ndeep-1,iv)+diffO2_soil(ip,ndeep,iv))/2.
3794	diffO2_halfDOWN(ip,il,iv) = diffO2_soil(ip,ndeep,iv)
3795	!Define terms a,b and c of matrix A:
3796	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3797	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3798	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3799	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3800	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3801	!Define vector B using O2 concentration in previous time step:
3802	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_soil(ip,ndeep-1,iv) &
3803	+(1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,ndeep,iv) &
3804	+c_O2soil(ip,il,iv)*O2_soil(ip,ndeep,iv)
3805	!O2 concentration at z+1(=ndeep+1 level does not exist) is supposed to
3806	!be the same than at z=ndeep. We assume that below the soil column there
3807	!is a level with the same O2 concentration.
3808	ENDIF
3809
3810	else!#########THERE IS NO SNOWTOP
3811
3812	!
3813	! 1.1.3 There is no snow cover: atmosphere/soil
3814	!
3815	IF (il .LE. nsnow)THEN
3816	ENDIF
3817
3818	!
3819	!1.1.3.1 First soil level NO snow top:
3820	!
3821
3822	IF ( il .EQ. (nsnow+1)) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3823	!Diffusion coefficient at half level above and below:
3824	!il-nsnow is to convert il dimension into ndeep dimension
3825	diffO2_halfUP(ip,il,iv) = (diffO2_air + diffO2_soil(ip,il-nsnow,iv))/2.
3826	diffO2_halfDOWN(ip,il,iv) = (diffO2_soil(ip,il-nsnow+1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3827	!Define terms a,b and c of matrix A:
3828	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3829	/(2. * ((zf_soil(il-nsnow))**2.))
3830	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3831	/(2. * ((zf_soil(il-nsnow))**2.))
3832	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3833	!Define vector B using O2 concentration in previous time step:
3834	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2atm(ip,iv) &
3835	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,il-nsnow,iv) &
3836	+ c_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow+1,iv)
3837	ENDIF
3838
3839	!
3840	!1.1.3.2 Middle soil level NO snow top
3841	!
3842
3843	IF ((il .GE. nsnow+2).AND.(il .LT. nsnow+ndeep)) THEN
3844	!Diffusion coefficient at half level above and below:
3845	!il-nsnow is to convert il dimension into ndeep dimension
3846	diffO2_halfUP(ip,il,iv) = (diffO2_soil(ip,il-nsnow-1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3847	diffO2_halfDOWN(ip,il,iv) =(diffO2_soil(ip,il-nsnow+1,iv)+diffO2_soil(ip,il-nsnow,iv))/2.
3848	!Define terms a,b and c of matrix A:
3849	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3850	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3851	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3852	/(2. * ((zf_soil(il-nsnow) - zf_soil(il-nsnow-1))**2.))
3853	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3854	!Define vector B using O2 concentration in previous time step:
3855	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow-1,iv) &
3856	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,il-nsnow,iv) &
3857	+ c_O2soil(ip,il,iv)*O2_soil(ip,il-nsnow+1,iv)
3858	ENDIF
3859
3860	!
3861	!1.1.3.3 Bottom soil level NO snow top:last level of soil column
3862	!
3863	IF ( il .EQ. (nsnow+ndeep)) THEN !il(=top soil level) is defined with nsnow+ndeep levels
3864
3865	!Diffusion coefficient at half level above and below:
3866	diffO2_halfUP(ip,il,iv) = (diffO2_soil(ip,ndeep-1,iv)+diffO2_soil(ip,ndeep,iv))/2.
3867	diffO2_halfDOWN(ip,il,iv) = diffO2_soil(ip,ndeep,iv)
3868	!Define terms a,b and c of matrix A:
3869	a_O2soil(ip,il,iv) = time_step * diffO2_halfUP(ip,il,iv) &
3870	/(2. ((zf_soil(ndeep) - zf_soil(ndeep-1))*2.))
3871	c_O2soil(ip,il,iv) = time_step * diffO2_halfDOWN(ip,il,iv) &
3872	/(2. * ((zf_soil(ndeep) - zf_soil(ndeep-1))**2.))
3873	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3874	!Define vector B using O2 concentration in previous time step:
3875	Bv_O2soil(ip,il,iv) = a_O2soil(ip,il,iv)*O2_soil(ip,ndeep-1,iv) &
3876	+ (1.-a_O2soil(ip,il,iv)-c_O2soil(ip,il,iv))*O2_soil(ip,ndeep,iv) &
3877	+ c_O2soil(ip,il,iv)*O2_soil(ip,ndeep,iv)
3878	!O2 concentration at z+1(=ndeep+1 level does not exist) is supposed to
3879	!be the same than at z=ndeep. We assume that below the soil column there
3880	!is a level with the same O2 concentration.
3881	ENDIF
3882
3883	endif !###############LOOP THERE IS SNOW TOP OR NOT
3884	ENDDO
3885	ENDDO
3886	ENDDO
3887
3888
3889
3890	END SUBROUTINE soil_gasdiff_coeff_O2
3891
3892	!!
3893	!================================================================================================================================
3894	!! SUBROUTINE : soil_gasdiff_diff_O2
3895	!!
3896	!>\BRIEF : This routine compute diffusion equation for oxygen in the snow and
3897	!soil with diffusion coefficient that is not constant D=D(z)
3898	!!
3899	!! DESCRIPTION : Considering diffusion equation du/dt=d/dz(D(z)x(du/dz)) with
3900	!! u:oxygen concentration; z:depth position and D: diffusion coefficient.
3901	!! Using the forward time centered space(FTCS) method (defined in Numerical
3902	!! recipes in fortran 77: the art of scientific computing by W. Press, W.A.
3903	!! Teukolsky et al.) the diffusion equation becomes:
3904	!!
3905	!(u(n+1,j)-u(n,j))/(t(n+1)-t(n))=((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3906	!! with n: time index and j: position index
3907	!! Using Crank-Nicolson method (the average of the implicite and explicite
3908	!! method) at time step centered at n+1/2 for both side of the equation:
3909	!! (u(n+1,j)-u(n,j))/(t(n+1)-t(n))= 1/2.
3910	!!
3911	!((D(z(j+1/2)).(u(n+1,j+1)-u(n+1,j)))-(D(z(j-1/2)).(u(n+1,j)-u(n+1,j-1))))/(z(j+1)-z(j))**2
3912	!!
3913	!+((D(z(j+1/2)).(u(n,j+1)-u(n,j)))-(D(z(j-1/2)).(u(n,j)-u(n,j-1))))/(z(j+1)-z(j))**2
3914	!! After moving all u(n+1) term on one side and u(n) on the other side we can
3915	!consider:
3916	!! a=(t(n+1)-t(n))xD(z(j+1/2)/(2x(z(j+1)-z(j))**2)
3917	!! c=(t(n+1)-t(n))xD(z(j-1/2)/(2x(z(j+1)-z(j))**2)
3918	!! b=1+a+c
3919	!! a,b and c are the term of a tridiagonal matrix A such as:
3920	!! Axu(n+1,j)=B(u(n,j))
3921	!! with B(u(n,j))= a.u(n,j+1)+(1-a-c).u(n,j)+c.u(n,j-1) (all known terms at
3922	!timestep n+1)
3923	!! Then the tridiagonal algorithm define in Numerical recipes is employed to
3924	!! solve this linear system using forward then backward substitution method.
3925	!!
3926	!! RECENT CHANGE(S) : changed by Elodie Salmon on August 2018
3927	!!
3928	!! MAIN OUTPUT VARIABLE(S) :
3929	!!
3930	!! REFERENCE(S) : Numerical recipes in fortran 77: the art of scientific
3931	!computing by W. Press, W.A.
3932	!! Teukolsky et al. 1986-1992
3933	!!
3934	!! FLOWCHART11 : None
3935	!! \n
3936	!_
3937	!================================================================================================================================
3938
3939	SUBROUTINE soil_gasdiff_diff_O2(kjpindex, time_step,O2atm, O2m,O2_snow,O2_soil)!, a_soil, b_soil, c_soil, Bv_soil)
3940
3941	!! 0. Variable and parameter declaration
3942
3943	!! 0.1 Input variables
3944	INTEGER(i_std), INTENT(in) :: kjpindex!! number of grid points
3945	INTEGER(i_std) :: il
3946	INTEGER(i_std) :: j
3947	INTEGER(i_std) :: ip
3948	INTEGER(i_std) :: iv
3949	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
3950	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: O2atm
3951	REAL(r_std),INTENT(in) :: O2m !! oxygen concentration [g/m3] below which there is anoxy
3952	!! 0.2 Output variables
3953
3954	!! 0.3 Modified variables
3955
3956	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow !! oxygen (g O2/m**3 air)
3957	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !! oxygen (g O2/m**3 air)
3958
3959	!! 0.4 local variables
3960
3961	INTEGER(i_std) :: it
3962	LOGICAL,DIMENSION(kjpindex,nvm) :: snowtop
3963	REAL(r_std), DIMENSION(kjpindex,nvm ) :: A11_O2 !!the first term of matrix A e.g.A11=b_soil(1)
3964	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: u_O2 !! vector containing oxygen concentration at each level: store results of the tridiagonal algorithm
3965	REAL(r_std), DIMENSION(kjpindex,nsnow+ndeep,nvm) :: gam_O2 !!A matrix term are substituded to new coefficients stored in gam vector
3966
3967	! To solve linear system defined in subroutine
3968	! soil_gasdiff_coeff_O2 we use a trigiagonal algorithm described in
3969	! Numerical recipes. Then we save the results according to snow and soil
3970	! levels.
3971
3972	! WHERE ( snowtop(:,:)) !! if there is snow top then size domain
3973	! il=nsnow+ndeep
3974	!Here for il=1,nsnow then
3975	!!a_soil=a_snow,b_soil=b_snow,c_soil=c_snow,and Bv_soil=Bv_snow,
3976	! and for il=nsnow, ndeep+nsnow then
3977	!a_soil=a_soil,b_soil=b_soil,c_soil=c_soil,and Bv_soil=Bv_soil
3978	DO ip=1,kjpindex
3979	DO iv = 1, nvm
3980
3981	!! Initial values:
3982	A11_O2(ip,iv) = zero
3983
3984	if ( heights_snow(ip,iv) .GT. hmin_tcalc ) then !There is snowtop
3985
3986	!In matrix A, a_soil= -a_soil, c_soil= -c_soil and b_soil=1+a+c
3987	DO il = ildiff(ip,iv), nsnow+ndeep
3988	!! ildiff =1 if all three snow layers are filled with snow;
3989	!! ildiff =2 if 2 snow layers are filled with snow
3990	!! ildiff =3 if 1 snow layer is filled with snow
3991	!! ildiff =4 if the layer of snow is too small to consider the
3992	!layer
3993	!! nsnow+ndeep = 3 +32=35
3994	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
3995	a_O2soil(ip,il,iv) = -1. * a_O2soil(ip,il,iv)
3996	c_O2soil(ip,il,iv) = -1. * c_O2soil(ip,il,iv)
3997	gam_O2(ip,il,iv) = zero
3998	ENDDO
3999	!Check that the first term of matrix A e.g.A11=b_soil(1) is different than
4000	!0 to avoid division by zero
4001	if (b_O2soil(ip,ildiff(ip,iv),iv) .EQ. 0 ) then
4002	write(numout,*) 'ESdebugO2diff: Error after soil_gasdiff_diff_O2:b_O2soil(il)=',b_O2soil(ip,il,iv),'ip=',ip,'iv=',iv,'il=',il,'a_O2soil(il)=',a_O2soil(ip,il,iv),'c_O2soil(il)=',c_O2soil(ip,il,iv),'Bv_O2soil(il)',Bv_O2soil(ip,il,iv)
4003	stop "Error in soil_gasdiff_diff_O2 for b_O2soil(1)"
4004	endif
4005	!Decomposition and forward substitution
4006	A11_O2(ip,iv) = b_O2soil(ip,ildiff(ip,iv),iv) !!first term of matrix A
4007	u_O2(ip,1,iv) = Bv_O2soil(ip,ildiff(ip,iv),iv) / A11_O2(ip,iv) !!first term of vector u:oxygen concentration for each level
4008	j = nsnow+ndeep
4009	DO il = ildiff(ip,iv)+1,j
4010	!!Here A matrix term are substituded to new coefficients stored in
4011	!gam vector:
4012	gam_O2(ip,il,iv) = c_O2soil(ip,il-1,iv) / A11_O2(ip,iv)
4013	!!In order to avoid a division by zero in u(j) below we define
4014	!minimum condition for A11 based on minimum oxygen concentration
4015	!below which there is anoxy (O2m):
4016	!under O2 concentration < O2m such as O2m-1 then u(j)=Bv_soil=O2m-1
4017	!then assuming a_soil=0 so A11=1
4018	A11_O2(ip,iv) = b_O2soil(ip,il,iv) - a_O2soil(ip,il,iv) * gam_O2(ip,il,iv)
4019
4020	u_O2(ip,il,iv) = (Bv_O2soil(ip,il,iv) - a_O2soil(ip,il,iv) * u_O2(ip,il-1,iv))/A11_O2(ip,iv)
4021	ENDDO
4022
4023	!Backsubstitution to solve linear system with triagonal matrix:
4024	DO il = j-1,ildiff(ip,iv),-1
4025	u_O2(ip,il,iv) = u_O2(ip,il,iv) - gam_O2(ip,il+1,iv) * u_O2(ip,il+1,iv)
4026	u_O2(ip,il,iv) = max(min_stomate, u_O2(ip,il,iv))
4027	ENDDO
4028
4029	!record Oxygen concentration profil in O2_snow and O2_soil:
4030	IF (ildiff(ip,iv) .LT. 4) THEN
4031	DO il = ildiff(ip,iv), nsnow
4032	O2_snow(ip,il,iv) = u_O2(ip,il,iv)
4033	ENDDO
4034	ENDIF
4035	DO il = nsnow+1, nsnow+ndeep
4036	O2_soil(ip,il-nsnow,iv) = u_O2(ip,il,iv)
4037	ENDDO
4038
4039	else !there is not snowtop
4040
4041	!Here for il=nsnow, ndeep+nsnow then
4042	!a_O2soil=a_O2soil,b_O2soil=b_O2soil,c_O2soil=c_O2soil,and
4043	!Bv_O2soil=Bv_O2soil
4044	!In matrix A, a_O2soil= -a_O2soil, c_O2soil= -c_O2soil and b_O2soil=1+a+c
4045	DO il = 1+nsnow, nsnow+ndeep
4046	b_O2soil(ip,il,iv) = 1. + a_O2soil(ip,il,iv) + c_O2soil(ip,il,iv)
4047	a_O2soil(ip,il,iv) = -1. * a_O2soil(ip,il,iv)
4048	c_O2soil(ip,il,iv) = -1. * c_O2soil(ip,il,iv)
4049	gam_O2(ip,il,iv) = zero
4050	ENDDO
4051	!Check that the first term of matrix A e.g.A11=b_soil(1) is different than
4052	!0 to avoid division by zero
4053	if (b_O2soil(ip,1+nsnow,iv) .EQ. 0 ) then
4054	write(numout,*) 'ESdebugO2diff:Error after soil_gasdiff_diff_O2:b_O2soil(il)=',b_O2soil(ip,il,iv),'ip=',ip,'iv=',iv,'il=',il,'a_O2soil(il)=',a_O2soil(ip,il,iv),'c_O2soil(il)=',c_O2soil(ip,il,iv),'Bv_O2soil(il)',Bv_O2soil(ip,il,iv)
4055	stop "Error in soil_gasdiff_diff_O2 for b_O2soil(1)"
4056	endif
4057
4058	!Decomposition and forward substitution
4059	A11_O2(ip,iv)=b_O2soil(ip,nsnow+1,iv) !!first term of matrix A
4060	u_O2(ip,nsnow+1,iv)=Bv_O2soil(ip,nsnow+1,iv)/A11_O2(ip,iv) !!first term of vector u:oxygen concetration for each level
4061	j = nsnow+ndeep
4062	DO il=nsnow+2,j
4063	!!Here A matrix term are substituded to new coefficients stored in
4064	!gam vector:
4065	gam_O2(ip,il,iv) = c_O2soil(ip,il-1,iv) / A11_O2(ip,iv)
4066	!!In order to avoid a division by zero in u(j) below we define
4067	!minimum condition for A11 based on minimum oxygen concentration
4068	!below which there is anoxy (O2m):
4069	!under O2 concentration < O2m such as O2m-1 then u(j)=Bv_soil=O2m-1
4070	!then assuming a_soil=0 so A11=1
4071	A11_O2(ip,iv) = b_O2soil(ip,il,iv) - a_O2soil(ip,il,iv) * gam_O2(ip,il,iv)
4072	u_O2(ip,il,iv) = (Bv_O2soil(ip,il,iv) - a_O2soil(ip,il,iv) * u_O2(ip,il-1,iv))/A11_O2(ip,iv)
4073	ENDDO
4074
4075	!Backsubstitution to solve linear system with triagonal matrix:
4076	DO il=j-1,1+nsnow,-1
4077	u_O2(ip,il,iv) = u_O2(ip,il,iv) - gam_O2(ip,il+1,iv) * u_O2(ip,il+1,iv)
4078	u_O2(ip,il,iv) = max(min_stomate, u_O2(ip,il,iv))
4079	ENDDO
4080
4081	!record Oxygen concentration profil in O2_soil:
4082	DO il = nsnow+1, ndeep+nsnow
4083	O2_soil(ip,il-nsnow,iv) = u_O2(ip,il,iv)
4084	ENDDO
4085	end if
4086	ENDDO
4087	ENDDO
4088
4089	END SUBROUTINE soil_gasdiff_diff_O2
4090
4091	!!
4092	!================================================================================================================================
4093	!! SUBROUTINE : get_gasdiff
4094	!!
4095	!>\BRIEF This routine update oxygen and methane in the snow and soil
4096	!!
4097	!! DESCRIPTION : Compute average gas diffusion coefficient relative to the
4098	!proportion of gas and aqueous volume in the pore of each layer. Available
4099	!volume for each gas is defined depending on the relative humidity in pores of
4100	!each layer
4101	!!
4102	!! RECENT CHANGE(S) : None
4103	!!
4104	!! MAIN OUTPUT VARIABLE(S) :
4105	!!
4106	!! REFERENCE(S) : None
4107	!!
4108	!! FLOWCHART11 : None
4109	!! \n
4110	!_
4111	!================================================================================================================================
4112	SUBROUTINE get_gasdiff (kjpindex,poros_layt_pft,hslong,shumCH4_rel,tprof,snow,airvol_snow, &
4113	totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
4114	airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
4115
4116	!! 0. Variable and parameter declaration
4117
4118	!! 0.1 Input variables
4119
4120	INTEGER(i_std), INTENT(in) :: kjpindex !! number of grid points
4121	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: poros_layt_pft !! porosity per layer and pft defined in constant_mtc.f90
4122	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: hslong !! deep long term soil humidity profile
4123	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: shumCH4_rel !!relative soil humidity profile, relative to water saturation content (mcs define in hydrol.f90)
4124	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: tprof !! Soil temperature (K)
4125	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in) :: snowrho !! snow density
4126	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
4127	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: z_organic !! depth to organic soil
4128
4129	!! 0.2 Output variables (but initialised in deep_carbcycle --> inout)
4130
4131	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: airvol_soil
4132	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: totporO2_soil !! total O2 porosity (Tans, 1998)
4133	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: totporCH4_soil !! total CH4 porosity
4134	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: diffO2_soil !! oxygen diffusivity (m**2/s)
4135	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: diffCH4_soil !! methane diffusivity (m**2/s)
4136	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: airvol_snow
4137	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: totporO2_snow !! total O2 porosity (Tans, 1998)
4138	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: totporCH4_snow !! total CH4 porosity (Tans, 1998)
4139	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: diffO2_snow !! oxygen diffusivity (m**2/s)
4140	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: diffCH4_snow !! methane diffusivity (m**2/s)
4141
4142	!! 0.3 Modified variables
4143
4144	!! 0.4 local variables
4145
4146	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: density_snow
4147	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: porosity_snow
4148	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: tortuosity_snow
4149	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: density_soil
4150	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: porosity_soil
4151	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: tortuosity_soil
4152	INTEGER(i_std) :: it,ip, il, iv
4153	REAL(r_std) :: x, rho_iw
4154	REAL(r_std) :: csat, fng
4155	REAL(r_std), SAVE :: cond_fact
4156	LOGICAL, SAVE :: pr_fois=.TRUE.
4157
4158	IF (pr_fois) THEN
4159	cond_fact=1.
4160	CALL getin_p('COND_FACT',cond_fact)
4161	WRITE(,) 'COND_FACT=',cond_fact
4162	pr_fois=.FALSE.
4163	ENDIF
4164
4165	!
4166	! 1. Three-layers snow model with snow density resolved at each snow layer
4167	!
4168	DO iv = 1, nvm
4169	density_snow(:,:,iv) = snowrho(:,:)
4170	ENDDO
4171	porosity_snow(:,:,:) = (1. - density_snow(:,:,:)/rho_ice )
4172	tortuosity_snow(:,:,:) = porosity_snow(:,:,:)**(1./3.) ! based on Sommerfeld et al., GBC, 1996
4173	diffO2_snow(:,:,:) = diffO2_air * porosity_snow(:,:,:) * tortuosity_snow(:,:,:)
4174	diffCH4_snow(:,:,:) = diffCH4_air * porosity_snow(:,:,:) * tortuosity_snow(:,:,:)
4175	airvol_snow(:,:,:) = MAX(porosity_snow(:,:,:),avm) !!avm = 0.01 m3 air/m3 soil minimum air volume
4176	totporO2_snow(:,:,:) = airvol_snow(:,:,:)
4177	totporCH4_snow(:,:,:) = airvol_snow(:,:,:)
4178	!
4179	! 2. soil: depends on temperature and soil humidity
4180	!
4181	DO ip = 1, kjpindex
4182	!
4183	DO iv = 1, nvm
4184	!
4185	IF ( veget_mask_2d(ip,iv) ) THEN
4186	!
4187	DO il = 1, ndeep
4188	!
4189	! 2.1 soil dry density, porosity, and dry heat capacity
4190	!
4191	porosity_soil(ip,il,iv) = poros_layt_pft(ip,il,iv)
4192	IF (perma_peat) THEN
4193	IF ( iv .EQ. 14 ) THEN
4194	porosity_soil(ip,il,iv) = tetamoss !!!see tetamoss=0.92 in src_parameters/constantes_var.f90
4195	ELSE
4196	porosity_soil(ip,il,iv) = poros_layt_pft(ip,il,iv)
4197	END IF
4198	END IF
4199
4200
4201	!
4202	!
4203	! 2.2 heat capacity and density as a function of
4204	! ice and water content
4205	! removed these as we are calculating thermal evolution in the sechiba subroutines
4206
4207	!
4208	! 2.3 oxygen diffusivity: soil can get waterlogged,
4209	! therefore take soil humidity into account
4210	!
4211	tortuosity_soil(ip,il,iv) = 2./3. ! Hillel, 1980
4212	airvol_soil(ip,il,iv) = porosity_soil(ip,il,iv)*(1.0_r_std-shumCH4_rel(ip,il,iv))
4213	totporO2_soil(ip,il,iv) = airvol_soil(ip,il,iv) + porosity_soil(ip,il,iv)BunsenO2shumCH4_rel(ip,il,iv)
4214	totporCH4_soil(ip,il,iv) = airvol_soil(ip,il,iv) + porosity_soil(ip,il,iv)BunsenCH4shumCH4_rel(ip,il,iv)
4215	diffO2_soil(ip,il,iv) = (diffO2_air*airvol_soil(ip,il,iv) + &
4216	diffO2_wBunsenO2shumCH4_rel(ip,il,iv)porosity_soil(ip,il,iv))tortuosity_soil(ip,il,iv)
4217	diffCH4_soil(ip,il,iv) = (diffCH4_air*airvol_soil(ip,il,iv) + &
4218	diffCH4_wBunsenCH4shumCH4_rel(ip,il,iv)porosity_soil(ip,il,iv))tortuosity_soil(ip,il,iv)
4219	!
4220
4221	END DO
4222	ELSE
4223	tortuosity_soil(ip,:,iv) = EPSILON(0.)
4224	airvol_soil(ip,:,iv) = EPSILON(0.)
4225	totporO2_soil(ip,:,iv) = EPSILON(0.)
4226	totporCH4_soil(ip,:,iv) = EPSILON(0.)
4227	diffO2_soil(ip,:,iv) = EPSILON(0.)
4228	diffCH4_soil(ip,:,iv) = EPSILON(0.)
4229	END IF
4230	ENDDO
4231	ENDDO
4232
4233	END SUBROUTINE get_gasdiff
4234
4235	!!
4236	!================================================================================================================================
4237	!! SUBROUTINE : traMplan
4238	!!
4239	!>\BRIEF This routine calculates plant-mediated transport of methane
4240	!!
4241	!! DESCRIPTION :
4242	!!
4243	!! RECENT CHANGE(S) : None
4244	!!
4245	!! MAIN OUTPUT VARIABLE(S) :
4246	!!
4247	!! REFERENCE(S) : None
4248	!!
4249	!! FLOWCHART11 : None
4250	!! \n
4251	!_
4252	!================================================================================================================================
4253	SUBROUTINE traMplan(CH4_soil,O2_soil, delta_O2_soil,delta_CH4_soil,&
4254	kjpindex,time_step,totporCH4_soil,totporO2_soil,z_root,&
4255	rootlev,Tgr,Tref,hslong,veget_max, lai,flupmt, &
4256	TpltL,snowdz,refdep, zi_soil, tprof, pb, deltaC3,tsurf)
4257
4258	!! 0. Variable and parameter declaration
4259
4260	!! 0.1 Input variables
4261
4262	INTEGER(i_std), INTENT(in) :: kjpindex
4263	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
4264	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporO2_soil !! total oxygen porosity
4265	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporCH4_soil !! total methane porosity
4266	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT(in) :: tprof !! soil temperature (K)
4267	INTEGER(i_std),DIMENSION(kjpindex,nvm),INTENT(in) :: rootlev !! the deepest model level within the rooting depth
4268	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: z_root !! the rooting depth
4269	REAL(r_std), INTENT(in) :: Tgr !! Temperature at which plants begin to grow (C)
4270	REAL(r_std), DIMENSION(ndeep), INTENT(in) :: zi_soil !! depths at intermediate levels
4271	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: hslong !! deep soil humidity
4272	REAL(r_std), DIMENSION(kjpindex),INTENT(in) :: pb
4273	REAL(r_std), DIMENSION(kjpindex),INTENT(in) :: tsurf
4274	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! Maximum vegetation fraction
4275
4276	!! 0.2 Output variables
4277
4278	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout) :: flupmt !! plant-mediated methane flux (g m-2 s-1)
4279
4280	!! 0.3 Modified variables
4281
4282	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout) :: Tref !! Ref. temperature for growing season caluculation (C)
4283	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil
4284	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil
4285	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC3
4286	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: TpltL
4287
4288	!! 0.4 local variables
4289	REAL(r_std), DIMENSION(kjpindex,nvm) :: CH4atm !! CH4 atm concentration
4290	REAL(r_std), DIMENSION(kjpindex,ndeep, nvm) :: dCH4 !! delta CH4 per m3 air
4291	REAL(r_std), DIMENSION(kjpindex,nvm) :: dO2 !! O2 change
4292	REAL(r_std), DIMENSION(kjpindex,nvm) :: fgrow !! Plant growing state (maturity index)
4293	REAL(r_std),DIMENSION(kjpindex,ndeep,nvm) :: froot !! vertical distribution of roots
4294	REAL(r_std) :: Tmat !! Temperature at which plants reach maturity (C)
4295	REAL(r_std), PARAMETER :: La_min = zero
4296	REAL(r_std), PARAMETER :: La = 4.
4297	REAL(r_std), PARAMETER :: La_max = La_min + La
4298	! REAL(r_std), PARAMETER :: Tveg = 10 !! Vegetation type control on the plant-mediated transport, Adjustable parameter,
4299	!! but we start from 10 following Walter et al (2001) tundra value
4300	REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: lai !! Leaf area index @tex $(m^2 m^{-2})$ @endtex
4301	REAL(r_std), DIMENSION(kjpindex,nvm) :: Tveg !! Vegetation type control on the plant-mediated transport, Adjustable parameter
4302	REAL(r_std), DIMENSION(kjpindex,nvm) :: zplt_root !! the rooting depth
4303
4304	! REAL(r_std), PARAMETER :: Mrox = 0.5 !! fraction of methane oxydized near the roots
4305	LOGICAL, SAVE :: firstcall=.TRUE.
4306	INTEGER(i_std) :: il,ip, iv
4307	LOGICAL, SAVE :: check = .FALSE.
4308	REAL(r_std), INTENT(in) :: refdep !! Depth to compute reference temperature for the growing season (m)
4309	INTEGER(i_std), SAVE :: reflev = 0 !! Level closest to reference depth refdep
4310	Real(r_std) :: maxox_CH4
4311	!! Add by YH, maximum oxidation of CH4 because of limited O2
4312	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: delta_O2_soil !!accumulated amount of O2 used for oxydation
4313	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: delta_CH4_soil !!accumulated amount of methane used
4314	REAL(r_std), PARAMETER :: kplt = 0.01 !!rate constant of unit time in [1/h] (Water and Heimann 2001)
4315	REAL(r_std), DIMENSION(kjpindex) :: kplt_tstp !!local variable: rate constant ideal for time_step
4316	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in) :: snowdz !! Snow depth [m]
4317
4318
4319
4320	IF (firstcall) THEN
4321	firstcall = .FALSE.
4322
4323	! Find the level closest to refdep
4324	DO il=1,ndeep
4325	IF (zi_soil(il) .GT. refdep .AND. reflev.EQ.0) reflev = il-1
4326	ENDDO
4327	IF (reflev.EQ.0) reflev = ndeep
4328
4329
4330	IF (check) THEN
4331	OPEN (28,file='pmt.dat',status='unknown')
4332	OPEN (29,file='pmtf.dat',status='unknown')
4333	ENDIF
4334	ENDIF
4335
4336	! Update seasonal reference temperature trace record
4337	WHERE ( veget_mask_2d(:,:) )
4338	Tref(:,:) = tprof(:,reflev,:) - ZeroCelsius
4339	END WHERE
4340
4341	Tmat = Tgr + 10._r_std
4342	flupmt(:,:) = zero
4343	TpltL(:,:,:)=zero
4344
4345	DO ip = 1,kjpindex
4346	DO iv = 1, nvm
4347	CH4atm(ip,iv) = pb(ip)/(RRtsurf(ip)) CH4_surf * wCH4
4348	ENDDO
4349	ENDDO
4350
4351	! Plant growing state (maturity index)
4352	!Old version from Walter et al. 2000
4353	! WHERE (Tref(:,:).LE.Tgr .AND. veget_mask_2d(:,:) )
4354	! fgrow(:,:) = La_min
4355	! ELSEWHERE (Tref(:,:).GE.Tmat .AND. veget_mask_2d(:,:) )
4356	! fgrow(:,:) = La_max
4357	! ELSEWHERE ( veget_mask_2d(:,:))
4358	! fgrow(:,:) = La_min + La * (1 - ((Tmat - Tref(:,:))/(Tmat - Tgr))**2)
4359	! ENDWHERE
4360
4361	! New version for plant growing state:
4362	DO ip=1,kjpindex
4363	DO iv = 1, nvm
4364	fgrow(ip,iv) = lai(ip,iv)
4365	ENDDO
4366	ENDDO
4367
4368	!ES: Tveg is the capacity of plant to conduct gas (Walter et al.
4369	!2000). Tveg is defined here for each pft:
4370	Tveg(:,:) = zero
4371	zplt_root(:,:) = zero
4372	DO ip=1,kjpindex
4373	DO iv = 1, nvm
4374	IF (perma_peat) THEN
4375	IF ( iv .EQ. 14 ) THEN
4376	Tveg(ip,iv) =tveg_ch4(iv) !tveg_ch4_mtc(iv+1) !!pft peat->iv=15 replace pft iv=14
4377	zplt_root(ip,iv) = z_rootpeat
4378	ELSE
4379	Tveg(ip,iv) = tveg_ch4(iv)
4380	zplt_root(ip,iv) = z_root(ip,iv)
4381	ENDIF
4382	ENDIF
4383	ENDDO
4384	ENDDO
4385
4386
4387
4388	DO ip=1,kjpindex
4389	DO iv = 1, nvm
4390	IF ( (z_root(ip,iv) .GT. 0.) .AND. veget_mask_2d(ip,iv) .AND. (snowdz(ip,1) .EQ. 0.) ) THEN ! added this to prevent pmt calcs when soil frozen
4391	DO il=1, ndeep
4392	! vertical distribution of roots
4393	froot(ip,il,iv) = MAX( 2_r_std * (zplt_root(ip,iv) - REAL( zi_soil(il) )) / zplt_root(ip,iv), zero)
4394	! Methane removal from a given depth. We assume that the methane
4395	! in air pores is always in equilibrium with that dissolved
4396	! in water-filled pores. If soil humidity is low,
4397	! with root water as well
4398	! We assume that PMT is proportional to soil humidity
4399
4400	!!The rate constante of plant transport processes can not be small
4401	!than the time step. Here is tested whether or not this is true:
4402	kplt_tstp(ip)=kplt/3600_r_std !!conversion of keb from 1/h to 1/s
4403	kplt_tstp(ip)=MIN(kplt_tstp(ip),1_r_std/time_step)
4404
4405	dCH4(ip,il,iv) = kplt_tstp(ip) * Tveg(ip,iv) * froot(ip,il,iv) * fgrow(ip,iv)(CH4_soil(ip,il,iv) - CH4atm(ip,iv)) time_step
4406
4407	! Constrains: No transport if soil concentration is less than atmospheric
4408	! the amount of methane that is removed can not be larger than
4409	! the existing amount in the layer
4410	dCH4(ip,il,iv) = min(CH4_soil(ip,il,iv), (max(dCH4(ip,il,iv),zero)))
4411
4412	! IF (dCH4(ip,iv).LT.CH4atm(ip,iv)) dCH4(ip,iv) = zero
4413	! ! Strange thing in WH 2001: 0.01Tvegfroot*fgrow > 1
4414	! ! at Tveg=15, froot&fgrow=max, i.e. more CH4 is taken than available
4415	! ! So need to impose a limitation:
4416	! IF (dCH4(ip,iv).GT.CH4_soil(ip,il,iv)) dCH4(ip,iv) = CH4_soil(ip,il,iv)
4417
4418	!Accumulated amount of methane that is emitted over one time
4419	!step
4420	delta_CH4_soil(ip,il,iv)=delta_CH4_soil(ip,il,iv)+dCH4(ip,il,iv)
4421
4422	! Methane concentration is decreased within the root layer:
4423	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) - dCH4(ip,il,iv)
4424	! O2 concentration is decreased in reaction with
4425	! dCH4Mroxtime_step
4426	dO2(ip,iv) = dCH4(ip,il,iv)Mrox wO2/wCH4 * totporCH4_soil(ip,il,iv)/totporO2_soil(ip,il,iv)
4427	IF ( dO2(ip,iv).LT.O2_soil(ip,il,iv) ) O2_soil(ip,il,iv) = O2_soil(ip,il,iv) - dO2(ip,iv)
4428
4429	! CO2 concentration is increased by dCH4(:)*Mrox
4430	! Integration
4431	flupmt(ip,iv) = flupmt(ip,iv) + dCH4(ip,il,iv)totporCH4_soil(ip,il,iv)/time_step (1 - Mrox) * ( zf_soil(il) - zf_soil(il-1) )
4432	!methane amount transported by plant per layers and pft
4433	TpltL(ip,il,iv) = TpltL(ip,il,iv) + dCH4(ip,il,iv) * (1 - Mrox)
4434	!the amount of carbon that is produced from methane oxydation to CO2
4435	deltaC3(ip,il,iv)=deltaC3(ip,il,iv) + dCH4(ip,il,iv)totporCH4_soil(ip,il,iv)Mrox*wC/wCH4
4436
4437
4438	ENDDO
4439	END IF
4440	ENDDO
4441	ENDDO
4442
4443
4444	IF (check) THEN
4445	WRITE(29,*) flupmt(:,:)
4446	CALL flush(28)
4447	CALL flush(29)
4448	END IF
4449
4450	END SUBROUTINE traMplan
4451
4452	!!
4453	!================================================================================================================================
4454	!! SUBROUTINE : ebullition
4455	!!
4456	!>\BRIEF This routine calculates CH4 ebullition
4457	!!
4458	!! DESCRIPTION :
4459	!!
4460	!! RECENT CHANGE(S) : None
4461	!!
4462	!! MAIN OUTPUT VARIABLE(S) :
4463	!!
4464	!! REFERENCE(S) : None
4465	!!
4466	!! FLOWCHART11 : None
4467	!! \n
4468	!_
4469	!================================================================================================================================
4470	SUBROUTINE ebullition (kjpindex,time_step,tprof,totporCH4_soil,hslong, &
4471	shumCH4_rel,delta_CH4_soil, poros_layt_pft, &
4472	CH4_soil, febul,TebL, pb)
4473
4474	!! 0. Variable and parameter declaration
4475
4476	!! 0.1 Input variables
4477
4478	INTEGER(i_std), INTENT(in) :: kjpindex
4479	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
4480	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT(in) :: tprof !! soil temperature (K)
4481	REAL(r_std), DIMENSION(kjpindex),INTENT(in) :: pb !! Surface pressure in hectoPa
4482	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporCH4_soil !! total methane porosity
4483	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: hslong !! deep soil humidity
4484	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in) :: shumCH4_rel !!relative soil humidity profile, relative to water saturation content (mcs define in hydrol.f90)
4485
4486	!! 0.2 Output variables (but initialised in deep_carbcycle --> inout)
4487
4488	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout) :: febul !! CH4 ebullition
4489	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: TebL !! [gCH4/m3/it/pft]CH4 ebullition
4490	!! 0.3 Modified variables
4491
4492	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane
4493	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: delta_CH4_soil !!amount of methane remove from the layer in one time step
4494
4495	!! 0.4 Local variables
4496	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4d
4497	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: dCH4
4498	INTEGER(i_std) :: ip, il, iv
4499	REAL(r_std) :: dz
4500	REAL(r_std), PARAMETER :: tortuosity=2./3. !! Hillel 1980
4501	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: wsize !!proportion of water in the soil layer. Size of water âdropletsâ dispersed in the soil defined to be 1cm (Khvorostyanov et al. 2008)
4502	! REAL(r_std), DIMENSION(kjpindex) :: mxrCH4 !! mixing ration of methane in the bulle going to the surface (Walter and Heimann 2001, default value=27%)
4503	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: porosity_soil
4504	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: poros_layt_pft
4505
4506
4507	! REAL(r_std), PARAMETER :: CH4wm = 12. !! CH4 concentration threshold for ebullition (8-16 g/m3 in Walter&Heimann 2000)
4508	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: CH4th !! CH4 concentration threshold for ebullition (Morel et al. 2019)
4509	REAL(r_std), DIMENSION(kjpindex,ndeep) :: Psoil !! Soil pressure
4510	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: hum
4511	REAL(r_std), PARAMETER :: keb = 1.0 !!rate constant of unit time in [1/h] (Walter and Heimann 2001)
4512	REAL(r_std), DIMENSION(kjpindex) :: keb_tstp !!local variable: rate constant ideal for time_step
4513
4514
4515
4516	DO ip=1,kjpindex
4517	DO iv = 1, nvm
4518	IF ( veget_mask_2d(ip,iv) ) THEN
4519	febul(ip,iv) = zero
4520
4521	!Old verrsion:
4522	! IF (hslong(ip,1,iv).GT.ebuthr) THEN
4523	! DO il = ndeep, 1, -1
4524	! CH4d = Ch4_soil(ip,il,iv) - CH4wm/BunsenCH4
4525	! IF (CH4d .GT. EPSILON(0.)) THEN
4526	! IF (il.GT.1) THEN
4527	! dz = zi_soil(il) - zi_soil(il-1)
4528	! hum = ( hslong(ip,il,iv) + hslong(ip,il-1,iv) ) / 2
4529	! ELSE
4530	! dz = zi_soil(1)
4531	! hum = hslong(ip,1,iv)
4532	! ENDIF
4533	!
4534	! dCH4 = hum*( dz/wsize/tortuosity ) CH4d
4535	! dCH4 = CH4d
4536	!
4537	! Ch4_soil(ip,il,iv) = Ch4_soil(ip,il,iv) - dCH4
4538	!!!New version:
4539	!! Define CH4 concentration threshold as function of soil pressure
4540	!! and temperature as described by Morel et al. 2019
4541	!! This scheme define the concentration theshold for ebullition
4542	!! assuming that methane mixing ratios in the bulles is around 27%.
4543	!! This assumption is based on empirical observation by Walter and
4544	!! Heimann (2001, figure 3) which suggest the methane concentration
4545	!! rich a theshold around 500microM-1000microM at depth below 20cm.
4546
4547	DO il=1,ndeep
4548	IF (il .le. 9) THEN ! il=9 correspond a depth of 0.749m at which
4549	! Walter and Heimann defined the maximum
4550	! concentration value of 1000microM.
4551
4552	!! Define soil pressure
4553
4554	Psoil(ip,il)=(pb(ip)/100.0)+(rho_watercte_grav( zf_soil(il)-zf_soil(il-1) ))
4555
4556
4557	!!CH4 concentration threshold for ebullition
4558	CH4th(ip,il,iv)=(mxrCH4Psoil(ip,il)wCH4)/(RR*tprof(ip,il,iv))
4559
4560
4561	ELSE ! Below that depth methane concentration threshold is constant
4562	CH4th(ip,il,iv)=CH4th(ip,9,iv)
4563	END IF
4564	ENDDO
4565	DO il = ndeep, 1, -1
4566	!!Define porosity for pft 14 if peatlands
4567	IF (perma_peat) THEN
4568	IF ( iv .EQ. 14 ) THEN
4569	porosity_soil(ip,il,iv) = tetamoss !!!see tetamoss=0.92 in src_parameters/constantes_var.f90
4570	ELSE
4571	porosity_soil(ip,il,iv) = poros_layt_pft(ip,il,iv)
4572	END IF
4573	END IF
4574
4575	!
4576	! Define the amoutn of methane available for ebullition
4577	!
4578	!!The rate constante of the ebullition process can not be small
4579	!than the time step. Here is tested whether or not this is true:
4580	keb_tstp(ip)=keb/3600.0_r_std !!conversion of keb from 1/h to 1/s
4581	keb_tstp(ip)=MIN(keb_tstp(ip),1.0_r_std/time_step)
4582
4583
4584	TebL(ip,il,iv) = zero
4585	! ! Option 1: Constant threshold over depth
4586	! CH4d(ip,il,iv) = (CH4_soil(ip,il,iv) - CH4wm/BunsenCH4) * keb_tstp(ip)*time_step
4587
4588	! Option 1: Threshold varies with soil pessure and temprature
4589	CH4d(ip,il,iv) = (CH4_soil(ip,il,iv) - CH4th(ip,il,iv)/BunsenCH4) keb_tstp(ip)time_step
4590
4591	CH4d(ip,il,iv) = min(max(zero, CH4d(ip,il,iv)),CH4_soil(ip,il,iv))
4592	!
4593	! Probability to which bulles rich soil surface
4594	!
4595	! wsize(ip,il,iv)= 0.01_r_std
4596	wsize(ip,il,iv)= wsize_cst
4597	dCH4(ip,il,iv) = (shumCH4_rel(ip,il,iv)*(zf_soil(il)/(wsize(ip,il,iv)tortuosity) )) * CH4d(ip,il,iv)
4598	dCH4(ip,il,iv) = min(max(zero, dCH4(ip,il,iv)),CH4_soil(ip,il,iv))
4599
4600	!
4601	! varaibles output
4602	!
4603	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) - dCH4(ip,il,iv)
4604	delta_CH4_soil(ip,il,iv)=delta_CH4_soil(ip,il,iv)+dCH4(ip,il,iv)
4605
4606	TebL(ip,il,iv) = TebL(ip,il,iv) + dCH4(ip,il,iv)
4607
4608	febul(ip,iv) = febul(ip,iv) + dCH4(ip,il,iv) * totporCH4_soil(ip,il,iv) *( zf_soil(il) - zf_soil(il-1) ) / time_step
4609
4610	ENDDO
4611	END IF
4612	ENDDO
4613	ENDDO
4614
4615	END SUBROUTINE ebullition
4616
4617	!!
4618	!================================================================================================================================
4619	!! SUBROUTINE : microactem
4620	!!
4621	!>\BRIEF This routine calculates parameters describing bacterial activity (time constant tau[s]) as a function of temperature
4622	!!
4623	!! DESCRIPTION :
4624	!!
4625	!! RECENT CHANGE(S) : None
4626	!!
4627	!! MAIN OUTPUT VARIABLE(S) :
4628	!!
4629	!! REFERENCE(S) : None
4630	!!
4631	!! FLOWCHART11 : None
4632	!! \n
4633	!_
4634	!================================================================================================================================
4635	FUNCTION microactem ( temp, frozen_respiration_func, moist_in, i_ind, j_ind, k_ind, zi_soil, mc_peat) RESULT ( fbact )
4636	!!!qcj++ peatland
4637
4638	!! 0. Variable and parameter declaration
4639
4640	!! 0.1 Input variables
4641
4642	INTEGER(i_std), INTENT(in) :: i_ind !kjpindex
4643	INTEGER(i_std), INTENT(in) :: j_ind !ndeep
4644	INTEGER(i_std), INTENT(in) :: k_ind !nvm
4645	INTEGER(i_std), INTENT(in) :: frozen_respiration_func
4646	REAL, DIMENSION(i_ind, j_ind, k_ind), INTENT(in) :: moist_in
4647	REAL, DIMENSION(i_ind, j_ind, k_ind), INTENT(in) :: temp
4648	!! 0.2 Output variables
4649
4650	!! 0.3 Modified variables
4651
4652	!! 0.4 Local variables
4653	!!!qcj++ peatland
4654	REAL(r_std), DIMENSION (i_ind,j_ind), INTENT(in) :: mc_peat
4655	REAL(r_std), DIMENSION(j_ind),INTENT(in) :: zi_soil
4656	REAL, DIMENSION(j_ind,k_ind) :: peat_tau
4657	REAL, DIMENSION(i_ind, j_ind, k_ind) :: moistfunc_result_peat
4658	REAL(r_std),DIMENSION(45) :: mc !!!! used for Moyano et al., 2012, volumetric moisture, 0.01 interval
4659	REAL(r_std),DIMENSION(45) :: pcsr
4660	REAL(r_std),DIMENSION(45) :: sr
4661	REAL(r_std),DIMENSION(45) :: corgmat
4662	INTEGER(i_std) :: ind
4663	INTEGER(i_std) :: mc_ind
4664	INTEGER(i_std) :: agri_mc_ind
4665
4666	REAL, DIMENSION(i_ind, j_ind, k_ind) :: fbact
4667	REAL, DIMENSION(i_ind, j_ind, k_ind) :: tempfunc_result
4668	REAL, DIMENSION(i_ind, j_ind, k_ind) :: temp_kelvin
4669	INTEGER(i_std), PARAMETER :: ntconfun = 7
4670	REAL(r_std), DIMENSION(ntconfun) :: tconfun
4671	REAL(r_std), DIMENSION(ntconfun) :: tauconfun
4672	INTEGER :: itz
4673	INTEGER :: ii, ij, ik
4674	REAL, DIMENSION(i_ind, j_ind, k_ind) :: moistfunc_result
4675	REAL(r_std), parameter :: q10 = 2.0
4676	REAL(r_std), PARAMETER :: stomate_tau = 4.699E6 !4.7304E7 !4.699E6
4677	logical, parameter :: limit_decomp_moisture = .true.
4678
4679	temp_kelvin(:,:,:) = temp(:,:,:) + ZeroCelsius
4680	SELECT CASE(frozen_respiration_func)
4681
4682	CASE(0) ! this is the standard ORCHIDEE state
4683
4684	tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
4685	tempfunc_result(:,:,:) = MIN( 1._r_std, tempfunc_result(:,:,:) )
4686
4687	CASE(1) ! cutoff respiration when T < -1C
4688	WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
4689	tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
4690	ELSEWHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius - 1. ) ! linear dropoff to zero
4691	tempfunc_result(:,:,:) = (temp_kelvin(:,:,:) - (ZeroCelsius - 1.)) * &
4692	EXP( log(q10) * ( ZeroCelsius - (ZeroCelsius+30.) ) / 10. )
4693	ELSEWHERE ! zero
4694	tempfunc_result(:,:,:) = EPSILON(0.)
4695	endwhere
4696
4697	tempfunc_result(:,:,:) = MAX(MIN( 1._r_std, tempfunc_result(:,:,:) ), EPSILON(0.))
4698
4699	CASE(2) ! cutoff respiration when T < -3C
4700	WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
4701	tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
4702	ELSEWHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius - 3. ) ! linear dropoff to zero
4703	tempfunc_result(:,:,:) = ((temp_kelvin(:,:,:) - (ZeroCelsius - 3.))/3.) * &
4704	EXP( log(q10) * ( ZeroCelsius - (ZeroCelsius+30.) ) / 10. )
4705	ELSEWHERE ! zero
4706	tempfunc_result(:,:,:) = EPSILON(0.)
4707	endwhere
4708
4709	CASE(3) ! q10 = 100 when below zero
4710	WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
4711	tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
4712	ELSEWHERE
4713	tempfunc_result(:,:,:) = EXP( log(100.) * ( temp_kelvin(:,:,:) - (ZeroCelsius) ) / 10. ) * &
4714	EXP( log(q10) * ( -30. ) / 10. )
4715	endwhere
4716
4717	CASE(4) ! q10 = 1000 when below zero
4718	WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
4719	tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
4720	ELSEWHERE
4721	tempfunc_result(:,:,:) = EXP( log(1000.) * ( temp_kelvin(:,:,:) - (ZeroCelsius) ) / 10. ) * &
4722	EXP( log(q10) * ( -30. ) / 10. )
4723	endwhere
4724
4725	CASE DEFAULT
4726	WRITE(,) 'microactem ERROR: frozen_respiration_func not in list: ', frozen_respiration_func
4727	STOP
4728
4729	END SELECT
4730	tempfunc_result(:,:,:) = MAX(MIN( 1._r_std, tempfunc_result(:,:,:) ), EPSILON(0.))
4731
4732	!---- stomate residence times: -----!
4733	! residence times in carbon pools (days)
4734	!carbon_tau(iactive) = .149 * one_year !!!!???? 1.5 years
4735	!carbon_tau(islow) = 5.48 * one_year !!!!???? 25 years
4736	!carbon_tau(ipassive) = 241. * one_year !!!!???? 1000 years
4737	!-----------------------------------!
4738	IF ( limit_decomp_moisture ) THEN
4739	! stomate moisture control function
4740	moistfunc_result(:,:,:) = -1.1 * moist_in(:,:,:) * moist_in(:,:,:) + 2.4 * moist_in(:,:,:) - 0.29
4741	moistfunc_result(:,:,:) = max( 0.25_r_std, min( 1._r_std, moistfunc_result(:,:,:) ) )
4742	ELSE
4743	moistfunc_result(:,:,:) = 1._r_std
4744	ENDIF
4745
4746	!!!qcj++ peatland
4747	!!! new moistfunction for peatsoil
4748	!!! by qcj
4749	! IF (perma_peat) THEN
4750	! DO ii=1,i_ind
4751	! DO ij=1,j_ind
4752	! DO ik=1,k_ind
4753	! IF (is_peat(ik)) THEN
4754	! moistfunc_result_peat(ii,ij,ik)=-14.79mc_peat(ii,ij)mc_peat(ii,ij)+16.57*mc_peat(ii,ij)-3.64
4755	! IF (mc_peat(ii,ij) .LT. 0.54) THEN !!!optimal moisture=0.6*mcs=0.54
4756	! moistfunc_result_peat(ii,ij,ik)= max(lim2, min(1._r_std, moistfunc_result_peat(ii,ij,ik)))
4757	! ELSE
4758	! moistfunc_result_peat(ii,ij,ik)= max(lim1, min(1._r_std, moistfunc_result_peat(ii,ij,ik)))
4759	! ENDIF
4760	! ENDIF
4761	! ENDDO
4762	! ENDDO
4763	! ENDDO
4764	! ENDIF
4765
4766	!!! Moyano et al., 2012,for organic soils
4767	!!volumetric moisture, 0.02 interval
4768	IF (perma_peat) THEN
4769	DO ii=1,45
4770	mc(ii)=0.01+0.02*(ii-1)
4771	ENDDO
4772	ENDIF
4773	!!calculate pcsr according to equation2 in Moyano et al., 2012
4774	!!for orgainc soil, bd=1.2 g/cm3, clay=0.3 fraction, organic carbon 0.05 g/g
4775	IF (perma_peat) THEN
4776	pcsr(:)=0.97509-0.48212mc(:)+1.83997(mc(:)*2)-1.56379(mc(:)**3)+ &
4777	0.098671.2+1.399440.05+0.179380.3-0.30307mc(:)1.2-0.30885mc(:)*0.3
4778	ENDIF
4779	!!relative respiration
4780	IF (perma_peat) THEN
4781	DO ii=1,45
4782	IF (ii==1) THEN
4783	sr(ii) = pcsr(ii)
4784	ELSE
4785	sr(ii)=sr(ii-1)* pcsr(ii)
4786	ENDIF
4787	ENDDO
4788	sr(:)=sr(:)/ MAXVAL(sr)
4789	ENDIF
4790
4791	!!!rescaling respiration from 0 to 1 in the range of 0 to optimum
4792	IF (perma_peat) THEN
4793	corgmat(:)=sr(:)
4794	ind= MAXLOC(corgmat,1)
4795	corgmat(1:ind)=corgmat(1:ind)-MINVAL(corgmat(1:ind))
4796	corgmat(1:ind)=corgmat(1:ind)/MAXVAL(corgmat(1:ind))
4797	ENDIF
4798
4799	!!! find corgmat value corresponding to current volumetric moisture
4800	IF (perma_peat) THEN
4801	DO ii=1,i_ind
4802	DO ij=1,j_ind
4803	DO ik=1,k_ind
4804	IF (is_peat(ik)) THEN
4805	mc_ind = MIN(45, MAX(1, INT(mc_peat(ii,ij)/0.02)+1))
4806	moistfunc_result_peat(ii,ij,ik)= corgmat(mc_ind)
4807	moistfunc_result_peat(ii,ij,ik)= MIN(un,MAX(EPSILON(0.),moistfunc_result_peat(ii,ij,ik)))
4808	ELSE
4809	moistfunc_result_peat(ii,ij,ik)= un
4810	ENDIF
4811	ENDDO
4812	ENDDO
4813	ENDDO
4814	ENDIF
4815
4816	IF (agri_peat) THEN
4817	DO ii=1,i_ind
4818	DO ij=1,j_ind
4819	DO ik=1,k_ind
4820	IF (ik==15 .OR. ik==16) THEN !!crops on peatland
4821	agri_mc_ind = MIN(45, MAX(1, INT(moist_in(ii,ij,ik)/0.02)+1))
4822	moistfunc_result(ii,ij,ik)= corgmat(agri_mc_ind)
4823	moistfunc_result(ii,ij,ik)= MIN(un,MAX(EPSILON(0.),moistfunc_result(ii,ij,ik)))
4824	ENDIF
4825	ENDDO
4826	ENDDO
4827	ENDDO
4828	ENDIF
4829	!!! peat turnover time increase with depth
4830	IF (perma_peat) THEN
4831	DO ik=1,k_ind
4832	DO ij=1, j_ind
4833	IF (is_peat(ik)) THEN
4834	IF (ij .LE. 12) THEN
4835	peat_tau(ij,ik)= tau_peat*EXP(zi_soil(ij)/z_tau)
4836	ELSE
4837	peat_tau(ij,ik)= tau_peat*EXP(zi_soil(12)/z_tau)
4838	ENDIF
4839	ENDIF
4840	ENDDO
4841	ENDDO
4842
4843	DO ii=1,i_ind
4844	DO ij=1,j_ind
4845	DO ik=1,k_ind
4846	IF (is_peat(ik)) THEN
4847	fbact(ii,ij,ik)= peat_tau(ij,ik)/(moistfunc_result_peat(ii,ij,ik)* tempfunc_result(ii,ij,ik))
4848	ELSE
4849	fbact(ii,ij,ik)= stomate_tau/(moistfunc_result(ii,ij,ik) * tempfunc_result(ii,ij,ik))
4850	ENDIF
4851	ENDDO
4852	ENDDO
4853	ENDDO
4854	ELSE
4855	fbact(:,:,:) = stomate_tau/(moistfunc_result(:,:,:) * tempfunc_result(:,:,:))
4856	ENDIF
4857
4858	DO ik=1,k_ind
4859	IF (ik==15 .OR. ik==16) THEN
4860	fbact(:,:,ik) = fbact(:,:,ik)/flux_tot_coeff(1)
4861	ENDIF
4862	ENDDO
4863
4864	END FUNCTION microactem
4865
4866
4867	!!
4868	!================================================================================================================================
4869	!! SUBROUTINE : snowlevels
4870	!!
4871	!>\BRIEF This routine calculates depths of full levels and intermediate
4872	!! levels related to snow pack
4873	!!
4874	!! DESCRIPTION :
4875	!!
4876	!! RECENT CHANGE(S) : None
4877	!!
4878	!! MAIN OUTPUT VARIABLE(S) :
4879	!!
4880	!! REFERENCE(S) : None
4881	!!
4882	!! FLOWCHART11 : None
4883	!! \n
4884	!_
4885	!================================================================================================================================
4886
4887	SUBROUTINE snowlevels( kjpindex, snowdz, zi_snow, zf_snow, veget_max )
4888
4889	!! 0. Variable and parameter declaration
4890
4891	!! 0.1 Input variables
4892
4893	INTEGER(i_std), INTENT(in) :: kjpindex
4894	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! maximum vegetation fraction
4895	REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(in) :: snowdz !! snow depth
4896
4897	!! 0.2 Output variables
4898
4899	!! 0.3 Modified variables
4900
4901	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(inout) :: zf_snow !! depths of full levels (m)
4902	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: zi_snow !! depths of intermediate levels (m)
4903
4904	!! 0.4 Local variables
4905
4906	REAL(r_std), DIMENSION(kjpindex,nvm) :: z_alpha !! parameter of the geometric series
4907	INTEGER(i_std) :: il,it, ix, iv
4908	INTEGER(i_std) :: it_beg,it_end
4909	INTEGER(i_std), PARAMETER :: niter = 10
4910	REAL(r_std), DIMENSION(kjpindex) :: dxmin
4911	INTEGER(i_std), DIMENSION(kjpindex) :: imin
4912	INTEGER(i_std) :: i,j
4913	REAL(r_std), DIMENSION(kjpindex,nvm) :: xi, xf
4914	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: snowdz_pft
4915
4916	snowdz_pft(:,:,:) = 0.0
4917	DO il = 1,nsnow
4918	DO iv = 1, nvm
4919	WHERE ( veget_mask_2d(:,iv) )
4920	snowdz_pft(:,il,iv) = snowdz(:,il)
4921	ENDWHERE
4922	ENDDO
4923	ENDDO
4924	!
4925	! calculate snow discretisation
4926	!
4927	WHERE ( veget_mask_2d(:,:) )
4928	zf_snow(:,0,:) = 0.
4929	END WHERE
4930	!
4931	DO il = 1, nsnow
4932	IF ( il .EQ. 1 ) THEN
4933	WHERE ( veget_mask_2d(:,:) )
4934
4935	zi_snow(:,il,:) = snowdz_pft(:,1,:) / 2.
4936
4937	zf_snow(:,il,:) = snowdz_pft(:,1,:)
4938
4939	END WHERE
4940	ENDIF
4941
4942	IF ( il .GT. 1 ) THEN
4943	WHERE ( veget_mask_2d(:,:) )
4944
4945	zi_snow(:,il,:) = zf_snow(:,il-1,:) + snowdz_pft(:,il,:) / 2
4946
4947	zf_snow(:,il,:) = SUM(snowdz_pft(:,1:il,:),2)
4948
4949	END WHERE
4950	ENDIF
4951
4952	ENDDO
4953
4954	DO ix = 1, kjpindex
4955	DO il = 1, nsnow
4956	zi_snow_nopftdim(ix,il) = SUM(zi_snow(ix,il,:)*veget_max(ix,:))
4957	zf_snow_nopftdim(ix,il) = SUM(zf_snow(ix,il,:)*veget_max(ix,:))
4958	END DO
4959	END DO
4960
4961	END SUBROUTINE snowlevels
4962
4963	!!
4964	!================================================================================================================================
4965	!! SUBROUTINE : snow_interpol
4966	!!
4967	!>\BRIEF This routine interpolates oxygen and methane into snow layers
4968	!!
4969	!! DESCRIPTION :
4970	!!
4971	!! RECENT CHANGE(S) : None
4972	!!
4973	!! MAIN OUTPUT VARIABLE(S) :
4974	!!
4975	!! REFERENCE(S) : None
4976	!!
4977	!! FLOWCHART11 : None
4978	!! \n
4979	!_
4980	!================================================================================================================================
4981
4982	SUBROUTINE snow_interpol (kjpindex,snowO2, snowCH4, zi_snow, zf_snow, veget_max, snowdz)
4983
4984	!! 0. Variable and parameter declaration
4985
4986	!! 0.1 Input variables
4987
4988	INTEGER(i_std), INTENT(in) :: kjpindex
4989	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in) :: snowdz !! snow depth at each layer
4990	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! maximum vegetation fraction
4991
4992	!! 0.2 Output variables
4993
4994	!! 0.3 Modified variables
4995
4996	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: snowO2 !! snow oxygen (g O2/m**3 air)
4997	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: snowCH4 !! snow methane (g CH4/m**3 air), needed just for num. scheme
4998	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(inout) :: zf_snow !! depths at full levels
4999	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: zi_snow !! depths at intermediate levels
5000
5001	!! 0.4 Local variables
5002	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: isnow !! index of first old layer that is deeper
5003	INTEGER(i_std), DIMENSION(kjpindex,nsnow,nvm) :: i1,i2 !! indices of the layers used for the inter- or extrapolation
5004	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: snowO2o !! initial snow oxygen (g O2/m**3 air)
5005	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: snowCH4o !! initial snow methane (g CH4/m**3 air)
5006	REAL(r_std), DIMENSION(kjpindex,nvm) :: dzio !! initial distance between two levels
5007	INTEGER(i_std) :: il, it, ip, ill, iv !! indices
5008	REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm) :: zfo !! initial depths at full levels
5009	REAL(r_std), DIMENSION(kjpindex,nsnow,nvm) :: zio !! initial depths at intermediate levels
5010
5011
5012
5013	! 1. save old discretisation and temperatures
5014
5015	zio(:,:,:) = zi_snow(:,:,:)
5016
5017	zfo(:,:,:) = zf_snow(:,:,:)
5018
5019	snowO2o(:,:,:) = snowO2(:,:,:)
5020	snowCH4o(:,:,:) = snowCH4(:,:,:)
5021
5022	! 2. new discretisation
5023
5024	CALL snowlevels( kjpindex, snowdz, zi_snow, zf_snow, veget_max)
5025
5026	! 3. for each new intermediate layer, look for the first old intermediate
5027	! layer that is deeper
5028
5029	DO il = 1, nsnow
5030
5031	isnow(:,il,:) = -1
5032
5033	DO ill = nsnow,1,-1
5034
5035	WHERE ( zio(:,ill,:) .GT. zi_snow(:,il,:) .AND. veget_mask_2d(:,:) )
5036
5037	isnow(:,il,:) = ill
5038
5039	ENDWHERE
5040
5041	ENDDO
5042
5043	ENDDO
5044
5045	! 4. determine which levels to take for the inter- or extrapolation
5046
5047
5048	DO ip = 1, kjpindex
5049	DO iv = 1, nvm
5050	IF ( veget_mask_2d(ip,iv) ) THEN
5051	DO il = 1, nsnow
5052	!
5053	IF ( isnow(ip,il,iv) .EQ. 1 ) THEN
5054	!
5055	! 4.1 first old layer is below new layer:
5056	! extrapolation from layers 1 and 2
5057	!
5058	i1(ip,il,iv) = 1
5059	i2(ip,il,iv) = 2
5060	!
5061	ELSEIF ( isnow(ip,il,iv) .EQ. -1 ) THEN
5062	!
5063	! 4.2 new layer is below last old layer:
5064	! extrapolation from layers nsnow-1 and nsnow
5065	!
5066	i1(ip,il,iv) = nsnow-1
5067	i2(ip,il,iv) = nsnow
5068	!
5069	ELSE
5070	!
5071	! 4.3 new layer is between two old layers: interpolation
5072	!
5073	i1(ip,il,iv) = isnow(ip,il,iv)-1
5074	i2(ip,il,iv) = isnow(ip,il,iv)
5075	!
5076	ENDIF
5077
5078	ENDDO
5079	ENDIF
5080	ENDDO
5081	ENDDO
5082
5083	! 5. inter- or extrapolate
5084
5085	DO ip = 1, kjpindex
5086	DO iv = 1, nvm
5087	IF ( veget_mask_2d(ip,iv) ) THEN
5088	DO il = 1, nsnow
5089	dzio(ip,iv) = zio(ip,i2(ip,il,iv),iv) - zio(ip,i1(ip,il,iv),iv)
5090
5091	IF ( dzio(ip,iv) .GT. min_stomate ) THEN
5092
5093	snowO2(ip,il,iv) = snowO2o(ip,i1(ip,il,iv),iv) + &
5094	( zi_snow(ip,il,iv) - zio(ip,i1(ip,il,iv),iv) ) / dzio(ip,iv) * &
5095	( snowO2o(ip,i2(ip,il,iv),iv) - snowO2o(ip,i1(ip,il,iv),iv) )
5096	snowCH4(ip,il,iv) = snowCH4o(ip,i1(ip,il,iv),iv) + &
5097	( zi_snow(ip,il,iv) - zio(ip,i1(ip,il,iv),iv) ) / dzio(ip,iv) * &
5098	( snowCH4o(ip,i2(ip,il,iv),iv) - snowCH4o(ip,i1(ip,il,iv),iv) )
5099
5100	ELSE
5101
5102	snowO2(ip,il,iv) = snowO2o(ip,i1(ip,il,iv),iv)
5103	snowCH4(ip,il,iv) = snowCH4o(ip,i1(ip,il,iv),iv)
5104
5105	ENDIF
5106
5107	ENDDO
5108	ENDIF
5109	ENDDO
5110
5111	ENDDO
5112	END SUBROUTINE snow_interpol
5113
5114	!!
5115	!================================================================================================================================
5116	!! SUBROUTINE : permafrost_carbon_clear
5117	!!
5118	!>\BRIEF
5119	!!
5120	!! DESCRIPTION :
5121	!!
5122	!! RECENT CHANGE(S) : None
5123	!!
5124	!! MAIN OUTPUT VARIABLE(S) :
5125	!!
5126	!! REFERENCE(S) : None
5127	!!
5128	!! FLOWCHART11 : None
5129	!! \n
5130	!_
5131	!================================================================================================================================
5132	SUBROUTINE permafrost_carbon_clear()
5133	IF (ALLOCATED(veget_mask_2d)) DEALLOCATE(veget_mask_2d)
5134	IF (ALLOCATED(heights_snow)) DEALLOCATE(heights_snow)
5135	IF (ALLOCATED(zf_soil)) DEALLOCATE(zf_soil)
5136	IF (ALLOCATED(zi_soil)) DEALLOCATE(zi_soil)
5137	IF (ALLOCATED(zf_snow)) DEALLOCATE(zf_snow)
5138	IF (ALLOCATED(zi_snow)) DEALLOCATE(zi_snow)
5139	! IF (ALLOCATED(alphaO2_soil )) DEALLOCATE(alphaO2_soil )
5140	! IF (ALLOCATED(betaO2_soil )) DEALLOCATE(betaO2_soil )
5141	! IF (ALLOCATED(alphaCH4_soil )) DEALLOCATE(alphaCH4_soil )
5142	! IF (ALLOCATED(betaCH4_soil )) DEALLOCATE(betaCH4_soil )
5143	! IF (ALLOCATED(alphaO2_snow )) DEALLOCATE(alphaO2_snow )
5144	! IF (ALLOCATED(betaO2_snow )) DEALLOCATE(betaO2_snow )
5145	! IF (ALLOCATED(alphaCH4_snow )) DEALLOCATE(alphaCH4_snow )
5146	! IF (ALLOCATED(betaCH4_snow )) DEALLOCATE(betaCH4_snow )
5147	IF (ALLOCATED(zf_coeff_snow )) DEALLOCATE(zf_coeff_snow )
5148	IF (ALLOCATED(zi_coeff_snow )) DEALLOCATE(zi_coeff_snow )
5149	! IF (ALLOCATED(mu_snow )) DEALLOCATE(mu_snow )
5150	IF (ALLOCATED(deepc_pftmean )) DEALLOCATE(deepc_pftmean )
5151	IF (ALLOCATED(O2atm )) DEALLOCATE(O2atm )
5152	IF (ALLOCATED(CH4atm )) DEALLOCATE(CH4atm )
5153	IF (ALLOCATED(ildiff )) DEALLOCATE(ildiff )
5154	IF (ALLOCATED(a_O2soil )) DEALLOCATE(a_O2soil )
5155	IF (ALLOCATED(b_O2soil )) DEALLOCATE(b_O2soil )
5156	IF (ALLOCATED(c_O2soil )) DEALLOCATE(c_O2soil )
5157	IF (ALLOCATED(Bv_O2soil )) DEALLOCATE(Bv_O2soil )
5158	IF (ALLOCATED(a_CH4soil )) DEALLOCATE(a_CH4soil )
5159	IF (ALLOCATED(b_CH4soil )) DEALLOCATE(b_CH4soil )
5160	IF (ALLOCATED(c_CH4soil )) DEALLOCATE(c_CH4soil )
5161	IF (ALLOCATED(Bv_CH4soil )) DEALLOCATE(Bv_CH4soil )
5162
5163	END SUBROUTINE permafrost_carbon_clear
5164
5165	!!
5166	!================================================================================================================================
5167	!! SUBROUTINE : initialize_yedoma_carbonstocks
5168	!!
5169	!>\BRIEF This routine intialize soil carbon in yedoma region
5170	!!
5171	!! DESCRIPTION :
5172	!!
5173	!! RECENT CHANGE(S) : None
5174	!!
5175	!! MAIN OUTPUT VARIABLE(S) :
5176	!!
5177	!! REFERENCE(S) : None
5178	!!
5179	!! FLOWCHART11 : None
5180	!! \n
5181	!_
5182	!================================================================================================================================
5183
5184	SUBROUTINE initialize_yedoma_carbonstocks(kjpindex, lalo, soilc_a, soilc_s, soilc_p, zz_deep, &
5185	yedoma_map_filename, yedoma_depth, yedoma_cinit_act, yedoma_cinit_slo, yedoma_cinit_pas, altmax_ind)
5186
5187	!! 0. Variable and parameter declaration
5188
5189	!! 0.1 Input variables
5190
5191	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
5192	REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: lalo !! geographic lat/lon
5193	REAL(r_std), DIMENSION(ndeep), INTENT (in) :: zz_deep !! deep vertical profile
5194	CHARACTER(LEN=80), INTENT (in) :: yedoma_map_filename !! yedoma map
5195	REAL(r_std), INTENT(in) :: yedoma_depth !! depth of yedoma carbon stock
5196	REAL(r_std), INTENT(in) :: yedoma_cinit_act !! initial active soil C concentration
5197	REAL(r_std), INTENT(in) :: yedoma_cinit_slo !! initial slow soil C concentration
5198	REAL(r_std), INTENT(in) :: yedoma_cinit_pas !! initial passive soil C concentration
5199	INTEGER(i_std), DIMENSION(kjpindex,nvm),INTENT(in) :: altmax_ind !! Maximum over the year active-layer index
5200
5201	!! 0.2 Output variables
5202
5203	!! 0.3 Modified variables
5204
5205	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_a !! active soil C concentration
5206	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_s !! slow soil C concentration
5207	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_p !! passive soil C concentration
5208
5209	!! 0.4 Local variables
5210	REAL(r_std), DIMENSION(kjpindex) :: yedoma
5211	INTEGER(i_std) :: il, ils, ip, ix, iy, imin, jmin, ier, iv
5212	REAL(r_std) :: dlon, dlonmin, dlat, dlatmin
5213	INTEGER(i_std) :: iml, jml, lml, tml, fid
5214	REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: xx,yy, yedoma_file
5215	REAL(r_std),ALLOCATABLE,DIMENSION(:) :: x,y
5216	REAL(r_std) :: lev(1), date, dt
5217	INTEGER(i_std) :: itau(1)
5218	INTEGER(i_std) :: yedoma_depth_index, iz
5219
5220	! plus bas, on prend la temperature lue dans un fichier climato si celui-ci existe
5221
5222	IF ( yedoma_map_filename .EQ. "NONE" ) THEN
5223	yedoma(:) = zero
5224	ELSE IF ( yedoma_map_filename .EQ. "EVERYWHERE" ) THEN
5225	yedoma(:) = 1.
5226	ELSE
5227	CALL flininfo(yedoma_map_filename,iml, jml, lml, tml, fid)
5228
5229	ALLOCATE (yy(iml,jml),stat=ier)
5230	IF (ier.NE.0) THEN
5231	WRITE (numout,*) ' error in yy allocation. We stop. We need ',iml,' fois ',jml,' words = '&
5232	& , iml*jml
5233	STOP 'deep_carbcycle'
5234	END IF
5235
5236	ALLOCATE (xx(iml,jml),stat=ier)
5237	IF (ier.NE.0) THEN
5238	WRITE (numout,*) ' error in xx allocation. We stop. We need ',iml,'fois ',jml,' words = '&
5239	& , iml*jml
5240	STOP 'deep_carbcycle'
5241	END IF
5242
5243	ALLOCATE (x(iml),stat=ier)
5244	IF (ier.NE.0) THEN
5245	WRITE (numout,*) ' error in x allocation. We stop. We need',iml,' words = '&
5246	& , iml
5247	STOP 'deep_carbcycle'
5248	END IF
5249
5250	ALLOCATE (y(jml),stat=ier)
5251	IF (ier.NE.0) THEN
5252	WRITE (numout,*) ' error in y allocation. We stop. We need',jml,'words = '&
5253	& , jml
5254	STOP 'deep_carbcycle'
5255	END IF
5256
5257	ALLOCATE (yedoma_file(iml,jml),stat=ier)
5258	IF (ier.NE.0) THEN
5259	WRITE (numout,*) ' error in yedoma_file allocation. We stop. We need ',iml,'fois ',jml,' words = '&
5260	& , iml*jml
5261	STOP 'deep_carbcycle'
5262	END IF
5263
5264	CALL flinopen (yedoma_map_filename, .FALSE., iml, jml, lml, &
5265	xx, yy, lev, tml, itau, date, dt, fid)
5266	CALL flinget (fid, 'yedoma', iml, jml, lml, tml, &
5267	1, 1, yedoma_file)
5268	CALL flinclo (fid)
5269	! On suppose que le fichier est regulier.
5270	! Si ce n'est pas le cas, tant pis. Les temperatures seront mal
5271	! initialisees et puis voila. De toute maniere, il faut avoir
5272	! l'esprit mal tourne pour avoir l'idee de faire un fichier de
5273	! climatologie avec une grille non reguliere.
5274	x(:) = xx(:,1)
5275	y(:) = yy(1,:)
5276	! prendre la valeur la plus proche
5277	DO ip = 1, kjpindex
5278	dlonmin = HUGE(1.)
5279	DO ix = 1,iml
5280	dlon = MIN( ABS(lalo(ip,2)-x(ix)), ABS(lalo(ip,2)+360.-x(ix)), ABS(lalo(ip,2)-360.-x(ix)) )
5281	IF ( dlon .LT. dlonmin ) THEN
5282	imin = ix
5283	dlonmin = dlon
5284	ENDIF
5285	ENDDO
5286	dlatmin = HUGE(1.)
5287	DO iy = 1,jml
5288	dlat = ABS(lalo(ip,1)-y(iy))
5289	IF ( dlat .LT. dlatmin ) THEN
5290	jmin = iy
5291	dlatmin = dlat
5292	ENDIF
5293	ENDDO
5294	yedoma(ip) = yedoma_file(imin,jmin)
5295	ENDDO
5296	DEALLOCATE (yy)
5297	DEALLOCATE (xx)
5298	DEALLOCATE (x)
5299	DEALLOCATE (y)
5300	DEALLOCATE (yedoma_file)
5301	ENDIF
5302
5303	yedoma_depth_index = 0
5304	DO iz = 1, ndeep
5305	IF (zz_deep(iz) .LE. yedoma_depth ) yedoma_depth_index = yedoma_depth_index + 1
5306	END DO
5307	WRITE(,) 'yedoma_depth_index ', yedoma_depth_index, ' at depth ', yedoma_depth
5308
5309	IF ( yedoma_depth_index .GT. 0) THEN
5310	DO ix = 1, kjpindex
5311	DO iv = 2, nvm !!! no yedoma carbon for PFT zero.
5312	IF ( veget_mask_2d(ix,iv) ) THEN
5313	DO iz = 1, yedoma_depth_index
5314	IF (yedoma(ix) .GT. 0.) THEN
5315	IF ( iz .GE. altmax_ind(ix,iv) ) THEN !!! only put yedoma carbon at base of and below the active layer
5316	soilc_a(ix, iz,iv) = yedoma_cinit_act
5317	soilc_s(ix, iz,iv) = yedoma_cinit_slo
5318	soilc_p(ix, iz,iv) = yedoma_cinit_pas
5319	ELSE
5320	soilc_a(ix, iz,iv) = zero
5321	soilc_s(ix, iz,iv) = zero
5322	soilc_p(ix, iz,iv) = zero
5323	ENDIF
5324	ELSE
5325	soilc_a(ix, iz,iv) = zero
5326	soilc_s(ix, iz,iv) = zero
5327	soilc_p(ix, iz,iv) = zero
5328	END IF
5329	END DO
5330	ENDIF
5331	ENDDO
5332	ENDDO
5333	ENDIF
5334
5335	END SUBROUTINE initialize_yedoma_carbonstocks
5336	!!
5337	!================================================================================================================================
5338	!! SUBROUTINE : carbinput
5339	!!
5340	!>\BRIEF This routine calculate carbon input to the soil
5341	!!
5342	!! DESCRIPTION :
5343	!!
5344	!! RECENT CHANGE(S) : None
5345	!!
5346	!! MAIN OUTPUT VARIABLE(S) :
5347	!!
5348	!! REFERENCE(S) : None
5349	!!
5350	!! FLOWCHART11 : None
5351	!! \n
5352	!_
5353	!================================================================================================================================
5354	SUBROUTINE carbinput(kjpindex,time_step,time,no_pfrost_decomp,tprof,tsurf,hslong, dayno,z_root,altmax, &
5355	soilc_a, soilc_s, soilc_p, soilc_in, dc_litter_z, z_organic, veget_max, rprof)
5356
5357	!! 0. Variable and parameter declaration
5358
5359	!! 0.1 Input variables
5360
5361	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
5362	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
5363	REAL(r_std), INTENT(in) :: time
5364	LOGICAL, INTENT(in) :: no_pfrost_decomp
5365	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: tprof !! Soil temperature (K)
5366	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: tsurf !! Surface temperature (K)
5367	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: hslong !! deep soil humidity
5368	INTEGER(i_std), INTENT(in) :: dayno !! current day of year
5369	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: z_root !! the rooting depth
5370	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: altmax !! Maximum over the year active-layer thickness
5371	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: z_organic !! depth to organic soil
5372	REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! Maximum fraction of vegetation type
5373	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT(in) :: soilc_in !! quantity of carbon going into carbon pools from litter decomposition (gC/(m**2 of ground)/day)
5374
5375	!! 0.2 Output variables
5376
5377	REAL(r_std), DIMENSION(kjpindex,ncarb,ndeep,nvm), INTENT(out) :: dc_litter_z !! depth_dependent carbon input due to litter
5378
5379	!! 0.3 Modified variables
5380
5381	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_a !! active soil C
5382	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_s !! slow soil C
5383	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: soilc_p !! passive soil C
5384
5385	!! 0.4 Local variables
5386
5387	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm) :: dc_litter !! depth-integrated carbon input due to litter decomposition
5388	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm) :: soilc_in_finite
5389	REAL(r_std), DIMENSION(kjpindex,nvm) :: intdep !! integral depth of carbon deposition
5390	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm) :: carbinp_correction
5391	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm) :: soilc_in_TS
5392	LOGICAL, SAVE :: firstcall = .TRUE.
5393	REAL(r_std), DIMENSION(kjpindex,nvm) :: z_lit !! litter input e-folding depth
5394	INTEGER :: il,ic,iv, ix, ip
5395	LOGICAL, SAVE :: check = .FALSE.
5396	REAL(r_std), PARAMETER :: dgyrst = 96.
5397	INTEGER(i_std), SAVE :: id, id2, id3, id4
5398	CHARACTER(LEN=16) :: buf
5399	INTEGER :: recn
5400	LOGICAL, SAVE :: correct_carboninput_vertprof = .TRUE.
5401	LOGICAL, SAVE :: new_carbinput_intdepzlit = .FALSE.
5402	REAL(r_std), DIMENSION(ndeep), SAVE :: z_thickness
5403	REAL(r_std), DIMENSION(ndeep) :: root_prof
5404	REAL(r_std), SAVE :: minaltmax = 0.1
5405	REAL(r_std), SAVE :: maxaltmax = 2.
5406	REAL(r_std), SAVE :: finerootdepthratio = 0.5 !! the ratio of fine root to overall root e-folding depth (for C inputs)
5407	REAL(r_std), SAVE :: altrootratio = 0.5 !! the maximum ratio of fine root depth to active layer thickness (for C inputs)
5408	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: rprof !! root depth (m)
5409	INTEGER, save :: tcounter
5410
5411
5412
5413	IF (no_pfrost_decomp) THEN
5414	!
5415	! no carbon input during spinup
5416	!
5417	dc_litter(:,:,:) = 0.
5418	!
5419	ELSE
5420	!
5421	IF (firstcall) THEN
5422
5423	DO il = 1, ndeep
5424	z_thickness(il) = zf_soil(il) - zf_soil(il-1)
5425	END DO
5426
5427	DO il=1,ndeep
5428	IF (il .lt. 12) THEN
5429	write(numout,*)'EScarb:il',il,'zf_soil(il)',zf_soil(il)
5430	write(numout,*)'EScarb:zf_soil(il-1)',zf_soil(il-1)
5431	write(numout,*)'EScarb:zf_soil(il)-zf_soil(il-1)',zf_soil(il)-zf_soil(il-1)
5432	write(numout,*)'EScarb:zi_soil(il)',zi_soil(il)
5433	ENDIF
5434	ENDDO
5435
5436	!
5437	!Config Key = new_carbinput_intdepzlit
5438	!Config Desc =
5439	!Config Def = n
5440	!Config If = OK_PC
5441	!Config Help =
5442	!Config Units = [flag]
5443	CALL getin_p('new_carbinput_intdepzlit', new_carbinput_intdepzlit)
5444
5445	!
5446	!Config Key = correct_carboninput_vertprof
5447	!Config Desc =
5448	!Config Def = n
5449	!Config If = OK_PC
5450	!Config Help =
5451	!Config Units = [flag]
5452	CALL getin_p('correct_carboninput_vertprof', correct_carboninput_vertprof)
5453
5454
5455	! Diagnostic output init
5456
5457	IF (check) THEN
5458	tcounter = 1
5459	WRITE(buf,'(I3)') yr_len
5460	id2 = 0
5461	CALL fliocrfd ('alt.nc', (/'geo ','veg ','time'/), (/kjpindex, nvm, -1/), id, id2, 'REPLACE')
5462	CALL fliodefv (id,'time',(/ 3 /),units='seconds since 0000-01-01 00:00:00',v_t=flio_r8)
5463	CALL flioputa (id,'time','title','time')
5464	CALL flioputa (id,'time','calendar',TRIM(buf)//'d')
5465	CALL fliodefv (id,'alt',(/ 1,2,3 /),units='m',v_t=flio_r8)
5466
5467	CALL fliocrfd ('soilc_litterinput.nc', (/'geo ','carb','veg ','time'/), (/kjpindex,ncarb,nvm,-1/), id3, id4, 'REPLACE')
5468	CALL fliodefv (id3,'time',(/ 4 /),units='seconds since 0000-01-01 00:00:00',v_t=flio_r8)
5469	CALL flioputa (id3,'time','title','time')
5470	CALL flioputa (id3,'time','calendar',TRIM(buf)//'d')
5471	CALL fliodefv (id3,'dc_litter',(/ 1,2,3,4 /),units='g C / ts',v_t=flio_r8)
5472	CALL fliodefv (id3,'soilc_in_TS',(/ 1,2,3,4 /),units='g C / ts',v_t=flio_r8)
5473
5474
5475	ENDIF ! check
5476
5477	firstcall = .FALSE.
5478	!
5479	ENDIF ! firstcall
5480
5481	!
5482	! 1. Litter input and decomposition
5483	!
5484	! add up the soil carbon from all veg pools, and change units from (gC/(m**2 of ground)/day) to gC/m^2 per timestep
5485	soilc_in_TS(:,:,:) = soilc_in(:,:,:)*time_step/one_day
5486
5487
5488	! 2. Carbon input e-folding depth. We distribute with e-depth = min(z_root,intdep)
5489	! and integral depth = min(altmax,z_org)
5490	! ! e-folding depth cannot be greater than integral depth
5491
5492	! change to make intdep equal to z_root alone
5493	DO ip = 1, kjpindex
5494	DO iv = 1, nvm
5495
5496	IF ( .NOT. new_carbinput_intdepzlit ) THEN
5497	z_lit(ip,iv) = z_root(ip,iv)
5498	intdep(ip,iv) = z_root(ip,iv)
5499	IF (perma_peat) THEN
5500	IF ( iv .EQ. 14 ) THEN
5501	z_lit(ip,14) = z_rootpeat
5502	intdep(ip,14) = z_rootpeat
5503	ENDIF
5504	ENDIF
5505	ELSE
5506	!change to separate e-folding depths for roots from total depth over which to integrate
5507	z_lit(ip,iv) = MIN(rprof(ip,iv)finerootdepthratio, altmax(ip,iv)altrootratio) ! z_lit is the e-folding depth
5508	intdep(ip,iv) = MIN(altmax(ip,iv), maxaltmax) ! intdep is the maximum depth of integration;
5509	IF (perma_peat) THEN
5510	IF ( iv .EQ. 14 ) THEN
5511	z_lit(:,14) = z_rootpeat
5512	intdep(:,14) = z_rootpeat
5513	ENDIF
5514	ENDIF
5515	ENDIF
5516
5517	ENDDO
5518	ENDDO
5519
5520	! Litter is decomposed somehow (?) even when alt == 0. To avoid carbon loss,
5521	! we distribute this carbon within the first 2 soil layers when alt == 0
5522	WHERE ( intdep(:,:) .LT. zi_soil(2) ) intdep(:,:) = zi_soil(2) +EPSILON(0.)
5523	WHERE ( z_lit(:,:) .LT. zi_soil(2) ) z_lit(:,:) = zi_soil(2)
5524
5525	!
5526	! 3. Carbon input.
5527	!
5528	dc_litter_z(:,:,:,:) = zero
5529
5530	dc_litter(:,:,:)=zero
5531
5532
5533	DO il = 1, ndeep
5534	DO ic = 1, ncarb
5535
5536	! 3.1. from litter.
5537
5538	WHERE ( zi_soil(il) .LT. intdep(:,:) .AND. veget_mask_2d(:,:) )
5539	dc_litter_z(:,ic,il,:) = soilc_in_TS(:,ic,:) / z_lit(:,:) / ( 1. - EXP( -intdep(:,:) / z_lit(:,:) ) ) &
5540	* EXP( -zi_soil(il) / z_lit(:,:) )
5541	ELSEWHERE
5542	dc_litter_z(:,ic,il,:) = zero
5543	ENDWHERE
5544
5545	dc_litter(:,ic,:) = dc_litter(:,ic,:) + dc_litter_z(:,ic,il,:) * (zf_soil(il)-zf_soil(il-1))
5546	ENDDO
5547
5548	ENDDO
5549
5550
5551	IF ( correct_carboninput_vertprof ) THEN
5552	!! correct for the truncated carbon adddition profile here by multiplying by a scalar
5553	DO ic = 1, ncarb
5554	WHERE ( dc_litter(:,ic,:) .GT. EPSILON(0.) .AND. veget_mask_2d(:,:) )
5555	carbinp_correction(:,ic,:) = soilc_in_TS(:,ic,:)/dc_litter(:,ic,:)
5556	ELSEWHERE
5557	carbinp_correction(:,ic,:) = 0.
5558	END WHERE
5559	END DO
5560
5561	dc_litter(:,:,:)=0.
5562	DO ic = 1, ncarb
5563	DO il = 1, ndeep
5564	WHERE ( veget_mask_2d(:,:) )
5565	dc_litter_z(:,ic,il,:) = carbinp_correction(:,ic,:)*dc_litter_z(:,ic,il,:)
5566	END WHERE
5567	dc_litter(:,ic,:) = dc_litter(:,ic,:) + dc_litter_z(:,ic,il,:) * (zf_soil(il)-zf_soil(il-1)) !! check again
5568	END DO
5569	END DO
5570
5571
5572	ENDIF
5573
5574	DO il = 1, ndeep
5575
5576	WHERE ( veget_mask_2d(:,:) )
5577	soilc_a(:,il,:) = soilc_a(:,il,:) + dc_litter_z(:,iactive,il,:)
5578	soilc_s(:,il,:) = soilc_s(:,il,:) + dc_litter_z(:,islow,il,:)
5579	soilc_p(:,il,:) = soilc_p(:,il,:) + dc_litter_z(:,ipassive,il,:)
5580	END WHERE
5581
5582	END DO
5583
5584	! Diagnostic output
5585
5586	IF (check) THEN
5587	recn = NINT(time/time_step)
5588	tcounter = tcounter + 1
5589	WRITE(,) 'carbinput check: output to .nc number',recn
5590	WRITE(,) 'time',time
5591	WRITE(,) 'time_step',time_step
5592
5593	CALL flioputv (id,'time', time, (/ tcounter /) )
5594	CALL flioputv (id,'alt', altmax(:,:), start = (/ 1, 1, tcounter /), count = (/ kjpindex, nvm, 1 /) )
5595	CALL fliosync(id)
5596
5597	CALL flioputv (id3,'time', time, (/ tcounter /) )
5598	CALL flioputv (id3,'soilc_in_TS', soilc_in_TS(:,:,:), start = (/ 1, 1, 1, tcounter /), &
5599	count = (/ kjpindex, ncarb, nvm, 1 /) )
5600	CALL flioputv (id3,'dc_litter', dc_litter(:,:,:), start = (/ 1, 1, 1, tcounter /), &
5601	count = (/ kjpindex, ncarb, nvm, 1 /) )
5602	CALL fliosync(id3)
5603	ENDIF
5604
5605	ENDIF
5606
5607	END SUBROUTINE carbinput
5608
5609	!!
5610	!================================================================================================================================
5611	!! SUBROUTINE : cryoturbate
5612	!!
5613	!>\BRIEF This routine calculates cryoturbation process
5614	!!
5615	!! DESCRIPTION :
5616	!!
5617	!! RECENT CHANGE(S) : None
5618	!!
5619	!! MAIN OUTPUT VARIABLE(S) :
5620	!!
5621	!! REFERENCE(S) : None
5622	!!
5623	!! FLOWCHART11 : None
5624	!! \n
5625	!_
5626	!================================================================================================================================
5627
5628	SUBROUTINE cryoturbate(kjpindex, time_step, dayno, altmax_ind, deepC_a, deepC_s, deepC_p, &
5629	action, diff_k_const, bio_diff_k_const, altmax_lastyear, fixed_cryoturbation_depth)
5630
5631	!! 0. Variable and parameter declaration
5632
5633	!! 0.1 Input variables
5634
5635	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
5636	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
5637	INTEGER(i_std), INTENT(in) :: dayno !! number of the day in the current year
5638	INTEGER(i_std), DIMENSION(kjpindex,nvm),INTENT(in) :: altmax_ind !! Maximum over the year active-layer index
5639	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in) :: altmax_lastyear !! Maximum over the year active-layer thickness
5640	CHARACTER(LEN=*), INTENT(in) :: action !! what to do
5641	REAL(r_std), INTENT(in) :: diff_k_const
5642	REAL(r_std), INTENT(in) :: bio_diff_k_const
5643
5644	!! 0.2 Output variables
5645
5646	!! 0.3 Modified variables
5647	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_a !! soil carbon (g/m**3) active
5648	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_s !! soil carbon (g/m**3) slow
5649	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_p !! soil carbon (g/m**3) passive
5650	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout) :: fixed_cryoturbation_depth !! depth to hold cryoturbation to for fixed runs
5651
5652	!! 0.4 Local variables
5653	LOGICAL, SAVE :: firstcall = .TRUE.
5654	LOGICAL, SAVE :: use_new_cryoturbation
5655	INTEGER, SAVE :: cryoturbation_method
5656	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deepC_a_old !! soil carbon (g/m**3) active before timestep
5657	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deepC_s_old !! soil carbon (g/m**3) slow before timestep
5658	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: deepC_p_old !! soil carbon (g/m**3) passive before timestep
5659	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_a_old !! soil carbon (g/m**2) active integrated over active layer before cryoturbation
5660	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_s_old !! soil carbon (g/m**2) slow integrated over active layer before cryoturbation
5661	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_p_old !! soil carbon (g/m**2) passive integrated over active layer before cryoturbation
5662	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_a
5663	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_s
5664	REAL(r_std), DIMENSION(kjpindex,nvm) :: altC_p
5665	INTEGER(i_std), PARAMETER :: n_totakefrom = 3 !! how many surface layers to subtract from in mass balance
5666	REAL(r_std), DIMENSION(kjpindex,nvm) :: surfC_totake_a !! active soil carbon to subtract from surface layers to maintain mass balance (g/m**3)
5667	REAL(r_std), DIMENSION(kjpindex,nvm) :: surfC_totake_s !! slow soil carbon to subtract from surface layers to maintain mass balance (g/m**3)
5668	REAL(r_std), DIMENSION(kjpindex,nvm) :: surfC_totake_p !! passive soil carbon to subtract from surface layers to maintain mass balance (g/m**3)
5669	REAL(r_std), DIMENSION(kjpindex,nvm) :: error_a
5670	REAL(r_std), DIMENSION(kjpindex,nvm) :: error_s
5671	REAL(r_std), DIMENSION(kjpindex,nvm) :: error_p
5672	INTEGER(i_std) :: ip, il, ier, iv
5673	CHARACTER(LEN=20), SAVE :: last_action = 'not called'
5674	INTEGER(i_std) :: cryoturb_date
5675	REAL(r_std), SAVE :: max_cryoturb_alt
5676	REAL(r_std), SAVE :: min_cryoturb_alt
5677	REAL(r_std), SAVE :: bioturbation_depth
5678	LOGICAL, SAVE :: reset_fixed_cryoturbation_depth = .FALSE.
5679	LOGICAL, SAVE :: use_fixed_cryoturbation_depth = .FALSE.
5680	REAL(r_std), DIMENSION(kjpindex,nvm) :: cryoturbation_depth
5681
5682
5683	! 1. ensure that we do not repeat actions
5684	!
5685	IF ( action .EQ. last_action ) THEN
5686	!
5687	WRITE(,) 'CANNOT TAKE THE SAME ACTION TWICE: ',TRIM(action)
5688	STOP
5689	!
5690	ENDIF
5691
5692	IF ( action .EQ. 'diffuse' ) THEN
5693	IF (firstcall) THEN
5694
5695	! 2. faire les trucs du debut
5696
5697	! 2.1 allocation des variables
5698	ALLOCATE (xe_a(kjpindex,nvm),stat=ier)
5699	IF (ier.NE.0) THEN
5700	WRITE (numout,*) ' error in xe_a allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
5701	& , kjpindex*nvm
5702	STOP 'deep_carbcycle'
5703	END IF
5704
5705	ALLOCATE (xe_s(kjpindex,nvm),stat=ier)
5706	IF (ier.NE.0) THEN
5707	WRITE (numout,*) ' error in xe_s allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
5708	& , kjpindex*nvm
5709	STOP 'deep_carbcycle'
5710	END IF
5711
5712	ALLOCATE (xe_p(kjpindex,nvm),stat=ier)
5713	IF (ier.NE.0) THEN
5714	WRITE (numout,*) ' error in xe_p allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
5715	& , kjpindex*nvm
5716	STOP 'deep_carbcycle'
5717	END IF
5718
5719	ALLOCATE (xc_cryoturb(kjpindex,ndeep,nvm),stat=ier)
5720	IF (ier.NE.0) THEN
5721	WRITE (numout,*) ' error in xc_cryoturb allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5722	& , kjpindexndeepnvm
5723	STOP 'deep_carbcycle'
5724	END IF
5725
5726	ALLOCATE (xd_cryoturb(kjpindex,ndeep,nvm),stat=ier)
5727	IF (ier.NE.0) THEN
5728	WRITE (numout,*) ' error in xd_cryoturb allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5729	& , kjpindexndeepnvm
5730	STOP 'deep_carbcycle'
5731	END IF
5732
5733	ALLOCATE (alpha_a(kjpindex,ndeep,nvm),stat=ier)
5734	IF (ier.NE.0) THEN
5735	WRITE (numout,*) ' error in alpha_a allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5736	& , kjpindexndeepnvm
5737	STOP 'deep_carbcycle'
5738	END IF
5739	alpha_a(:,:,:)=0.
5740
5741	ALLOCATE (alpha_s(kjpindex,ndeep,nvm),stat=ier)
5742	IF (ier.NE.0) THEN
5743	WRITE (numout,*) ' error in alpha_s allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5744	& , kjpindexndeepnvm
5745	STOP 'deep_carbcycle'
5746	END IF
5747	alpha_s(:,:,:)=0.
5748
5749	ALLOCATE (alpha_p(kjpindex,ndeep,nvm),stat=ier)
5750	IF (ier.NE.0) THEN
5751	WRITE (numout,*) ' error in alpha_p allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5752	& , kjpindexndeepnvm
5753	STOP 'deep_carbcycle'
5754	END IF
5755	alpha_p(:,:,:)=0.
5756
5757	ALLOCATE (beta_a(kjpindex,ndeep,nvm),stat=ier)
5758	IF (ier.NE.0) THEN
5759	WRITE (numout,*) ' error in beta_a allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5760	& , kjpindexndeepnvm
5761	STOP 'deep_carbcycle'
5762	END IF
5763	beta_a(:,:,:)=0.
5764
5765	ALLOCATE (beta_s(kjpindex,ndeep,nvm),stat=ier)
5766	IF (ier.NE.0) THEN
5767	WRITE (numout,*) ' error in beta_s allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5768	& , kjpindexndeepnvm
5769	STOP 'deep_carbcycle'
5770	END IF
5771	beta_s(:,:,:)=0.
5772
5773	ALLOCATE (beta_p(kjpindex,ndeep,nvm),stat=ier)
5774	IF (ier.NE.0) THEN
5775	WRITE (numout,*) ' error in beta_p allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5776	& , kjpindexndeepnvm
5777	STOP 'deep_carbcycle'
5778	END IF
5779	beta_p(:,:,:)=0.
5780
5781	ALLOCATE (diff_k(kjpindex,ndeep,nvm),stat=ier)
5782	IF (ier.NE.0) THEN
5783	WRITE (numout,*) ' error in diff_k allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
5784	& , kjpindexndeepnvm
5785	STOP 'deep_carbcycle'
5786	END IF
5787
5788	ALLOCATE (cryoturb_location(kjpindex,nvm),stat=ier)
5789	IF (ier.NE.0) THEN
5790	WRITE (numout,*) ' error in cryoturb_location allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
5791	& , kjpindex*nvm
5792	STOP 'deep_carbcycle'
5793	END IF
5794
5795	ALLOCATE (bioturb_location(kjpindex,nvm),stat=ier)
5796	IF (ier.NE.0) THEN
5797	WRITE (numout,*) ' error in bioturb_location allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
5798	& , kjpindex*nvm
5799	STOP 'deep_carbcycle'
5800	END IF
5801
5802
5803	cryoturb_location(:,:) = .false.
5804	use_new_cryoturbation = .false.
5805	!
5806	!Config Key = use_new_cryoturbation
5807	!Config Desc =
5808	!Config Def = n
5809	!Config If = OK_PC
5810	!Config Help =
5811	!Config Units = [flag]
5812	CALL getin_p('use_new_cryoturbation', use_new_cryoturbation)
5813	!
5814	!Config Key = cryoturbation_method
5815	!Config Desc =
5816	!Config Def = 1
5817	!Config If = OK_PC
5818	!Config Help =
5819	!Config Units = []
5820	cryoturbation_method = 4
5821	CALL getin_p('cryoturbation_method', cryoturbation_method)
5822	!
5823	!Config Key = max_cryoturb_alt
5824	!Config Desc =
5825	!Config Def = 1
5826	!Config If = OK_PC
5827	!Config Help =
5828	!Config Units = []
5829	max_cryoturb_alt = 3.
5830	CALL getin_p('max_cryoturb_alt',max_cryoturb_alt)
5831	!
5832	!Config Key = min_cryoturb_alt
5833	!Config Desc =
5834	!Config Def = 1
5835	!Config If = OK_PC
5836	!Config Help =
5837	!Config Units = []
5838	min_cryoturb_alt = 0.01
5839	CALL getin_p('min_cryoturb_alt',min_cryoturb_alt)
5840	!
5841	!Config Key = reset_fixed_cryoturbation_depth
5842	!Config Desc =
5843	!Config Def = n
5844	!Config If = OK_PC
5845	!Config Help =
5846	!Config Units = [flag]
5847	CALL getin_p('reset_fixed_cryoturbation_depth',reset_fixed_cryoturbation_depth)
5848	IF (reset_fixed_cryoturbation_depth) THEN
5849	fixed_cryoturbation_depth = altmax_lastyear
5850	ENDIF
5851	!
5852	!Config Key = use_fixed_cryoturbation_depth
5853	!Config Desc =
5854	!Config Def = n
5855	!Config If = OK_PC
5856	!Config Help =
5857	!Config Units = [flag]
5858	CALL getin_p('use_fixed_cryoturbation_depth',use_fixed_cryoturbation_depth)
5859	bioturb_location(:,:) = .false.
5860	!
5861	!Config Key = bioturbation_depth
5862	!Config Desc = maximum bioturbation depth
5863	!Config Def = 2
5864	!Config If = ok_pc
5865	!Config Help =
5866	!Config Units = m
5867	bioturbation_depth = 2.
5868	CALL getin_p('bioturbation_depth',bioturbation_depth)
5869
5870	firstcall = .FALSE.
5871	ELSE
5872	! 1. calculate the total soil carbon in the active layer
5873	deepC_a_old = deepC_a
5874	deepC_s_old = deepC_s
5875	deepC_p_old = deepC_p
5876	altC_a_old(:,:) = zero
5877	altC_s_old(:,:) = zero
5878	altC_p_old(:,:) = zero
5879	altC_a(:,:) = zero
5880	altC_s(:,:) = zero
5881	altC_p(:,:) = zero
5882
5883	DO ip = 1, kjpindex
5884	DO iv = 1, nvm
5885	IF ( cryoturb_location(ip,iv) .OR. bioturb_location(ip,iv) )THEN
5886	! 1. calculate the total soil carbon in the active layer
5887	DO il = 1, ndeep
5888	altC_a_old(ip,iv) = altC_a_old(ip,iv) + deepC_a(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5889	altC_s_old(ip,iv) = altC_s_old(ip,iv) + deepC_s(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5890	altC_p_old(ip,iv) = altC_p_old(ip,iv) + deepC_p(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5891	ENDDO
5892
5893	! 2. diffuse the soil carbon
5894	deepC_a(ip,1,iv) = (deepC_a(ip,1,iv)+mu_soilbeta_a(ip,1,iv)) / (1.+mu_soil(1.-alpha_a(ip,1,iv)))
5895	deepC_s(ip,1,iv) = (deepC_s(ip,1,iv)+mu_soilbeta_s(ip,1,iv)) / (1.+mu_soil(1.-alpha_s(ip,1,iv)))
5896	deepC_p(ip,1,iv) = (deepC_p(ip,1,iv)+mu_soilbeta_p(ip,1,iv)) / (1.+mu_soil(1.-alpha_p(ip,1,iv)))
5897
5898	DO il = 2, ndeep
5899	deepC_a(ip,il,iv) = alpha_a(ip,il-1,iv)*deepC_a(ip,il-1,iv) + beta_a(ip,il-1,iv)
5900	deepC_s(ip,il,iv) = alpha_s(ip,il-1,iv)*deepC_s(ip,il-1,iv) + beta_s(ip,il-1,iv)
5901	deepC_p(ip,il,iv) = alpha_p(ip,il-1,iv)*deepC_p(ip,il-1,iv) + beta_p(ip,il-1,iv)
5902	ENDDO
5903
5904	! 3. recalculate the total soil carbon in the active layer
5905	DO il = 1, ndeep
5906	altC_a(ip,iv) = altC_a(ip,iv) + deepC_a(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5907	altC_s(ip,iv) = altC_s(ip,iv) + deepC_s(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5908	altC_p(ip,iv) = altC_p(ip,iv) + deepC_p(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
5909	ENDDO
5910
5911	! 4. subtract the soil carbon in the top layer(s) so that the total carbon content of the active layer is conserved.
5912	! for now remove this correction term...
5913	surfC_totake_a(ip,iv) = (altC_a(ip,iv)-altC_a_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
5914	surfC_totake_s(ip,iv) = (altC_s(ip,iv)-altC_s_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
5915	surfC_totake_p(ip,iv) = (altC_p(ip,iv)-altC_p_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
5916	deepC_a(ip,1:altmax_ind(ip,iv),iv) = deepC_a(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_a(ip,iv)
5917	deepC_s(ip,1:altmax_ind(ip,iv),iv) = deepC_s(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_s(ip,iv)
5918	deepC_p(ip,1:altmax_ind(ip,iv),iv) = deepC_p(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_p(ip,iv)
5919
5920	! if negative values appear, we don't subtract the delta-C from top layers
5921	IF (ANY(deepC_a(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
5922	deepC_a(ip,1:altmax_ind(ip,iv),iv)=deepC_a(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_a(ip,iv)
5923	IF (altC_a(ip,iv) .GT. zero) THEN
5924	deepC_a(ip,:,iv)=deepC_a(ip,:,iv)*altC_a_old(ip,iv)/altC_a(ip,iv)
5925	ENDIF
5926	ENDIF
5927	IF (ANY(deepC_s(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
5928	deepC_s(ip,1:altmax_ind(ip,iv),iv)=deepC_s(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_s(ip,iv)
5929	IF (altC_s(ip,iv) .GT. zero) THEN
5930	deepC_s(ip,:,iv)=deepC_s(ip,:,iv)*altC_s_old(ip,iv)/altC_s(ip,iv)
5931	ENDIF
5932	ENDIF
5933	IF (ANY(deepC_p(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
5934	deepC_p(ip,1:altmax_ind(ip,iv),iv)=deepC_p(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_p(ip,iv)
5935	IF (altC_p(ip,iv) .GT. zero) THEN
5936	deepC_p(ip,:,iv)=deepC_p(ip,:,iv)*altC_p_old(ip,iv)/altC_p(ip,iv)
5937	ENDIF
5938	ENDIF
5939
5940	! Consistency check. Potentially add to STRICT_CHECK flag
5941	IF ( ANY(deepC_a(ip,:,iv) .LT. zero) ) THEN
5942	WRITE (numout,*) 'cryoturbate: deepC_a<0','ip=',ip,'iv=',iv,'deepC_a=',deepC_a(ip,:,iv)
5943	CALL ipslerr_p (3,'cryoturbate','','','')
5944	ENDIF
5945	IF ( ANY(deepC_s(ip,:,iv) .LT. zero) ) THEN
5946	WRITE (numout,*) 'cryoturbate: deepC_s<0','ip=',ip,'iv=',iv,'deepC_s=',deepC_s(ip,:,iv)
5947	CALL ipslerr_p (3,'cryoturbate','','','')
5948	ENDIF
5949	IF ( ANY(deepC_p(ip,:,iv) .LT. zero) ) THEN
5950	WRITE (numout,*) 'cryoturbate: deepC_p<0','ip=',ip,'iv=',iv,'deepC_p=',deepC_p(ip,:,iv)
5951	CALL ipslerr_p (3,'cryoturbate','','','')
5952	ENDIF
5953
5954	ENDIF
5955	ENDDO
5956	ENDDO
5957
5958
5959	!WHERE (deepC_a(:,:,:) .LT. zero) deepC_a(:,:,:) = zero
5960	!WHERE (deepC_s(:,:,:) .LT. zero) deepC_s(:,:,:) = zero
5961	!WHERE (deepC_p(:,:,:) .LT. zero) deepC_p(:,:,:) = zero
5962
5963	ENDIF
5964
5965
5966	ELSEIF ( action .EQ. 'coefficients' ) THEN
5967	IF (firstcall) THEN
5968	WRITE(,) 'error: initilaizations have to happen before coefficients calculated. we stop.'
5969	STOP
5970	ENDIF
5971
5972	cryoturb_location(:,:) = ( altmax_lastyear(:,:) .LT. max_cryoturb_alt ) &
5973	!In the former vertical discretization scheme the first level was at 0.016 cm; now it's only 0.00048 so we set an equivalent threshold directly as a fixed depth of 1 cm,
5974	.AND. ( altmax_lastyear(:,:) .GE. min_cryoturb_alt ) .AND. veget_mask_2d(:,:)
5975	IF (use_fixed_cryoturbation_depth) THEN
5976	cryoturbation_depth(:,:) = fixed_cryoturbation_depth(:,:)
5977	ELSE
5978	cryoturbation_depth(:,:) = altmax_lastyear(:,:)
5979	ENDIF
5980
5981	bioturb_location(:,:) = ( ( altmax_lastyear(:,:) .GE. max_cryoturb_alt ) .AND. veget_mask_2d(:,:) )
5982
5983	DO ip = 1, kjpindex
5984	DO iv = 1,nvm
5985	IF ( cryoturb_location(ip,iv) ) THEN
5986	!
5987	IF (use_new_cryoturbation) THEN
5988	SELECT CASE(cryoturbation_method)
5989	CASE(1)
5990	!
5991	DO il = 1, ndeep ! linear dropoff to zero between alt and 2*alt
5992	IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
5993	diff_k(ip,il,iv) = diff_k_const
5994	ELSE
5995	diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)/cryoturbation_depth(ip,iv))-un,un),zero))
5996	ENDIF
5997	END DO
5998	!
5999	CASE(2)
6000	!
6001	DO il = 1, ndeep ! exponential dropoff with e-folding distace = alt, below the active layer
6002	IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
6003	diff_k(ip,il,iv) = diff_k_const
6004	ELSE
6005	diff_k(ip,il,iv) = diff_k_const*(EXP(-MAX((zi_soil(il)/cryoturbation_depth(ip,iv)-un),zero)))
6006	ENDIF
6007	END DO
6008	!
6009	CASE(3)
6010	!
6011	! exponential dropoff with e-folding distace = alt, starting at surface
6012	diff_k(ip,:,iv) = diff_k_const*(EXP(-(zi_soil(:)/cryoturbation_depth(ip,iv))))
6013	!
6014	CASE(4)
6015	!
6016	DO il = 1, ndeep ! linear dropoff to zero between alt and 3*alt
6017	IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
6018	diff_k(ip,il,iv) = diff_k_const
6019	ELSE
6020	diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)-cryoturbation_depth(ip,iv))/ &
6021	(2.*cryoturbation_depth(ip,iv)),un),zero))
6022	ENDIF
6023	IF ( zi_soil(il) .GT. max_cryoturb_alt ) THEN
6024	diff_k(ip,il,iv) = zero
6025	ENDIF
6026	END DO
6027	!
6028	IF (printlev>=3) WRITE(,) 'cryoturb method 4: ip, iv, diff_k(ip,:,iv): ', ip, iv, diff_k(ip,:,iv)
6029	CASE(5)
6030	!
6031	DO il = 1, ndeep ! linear dropoff to zero between alt and 3m
6032	IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
6033	diff_k(ip,il,iv) = diff_k_const
6034	ELSE
6035	diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)-cryoturbation_depth(ip,iv))/ &
6036	(3.-cryoturbation_depth(ip,iv)),un),zero))
6037	ENDIF
6038	END DO
6039	!
6040	IF (printlev>=3) WRITE(,) 'cryoturb method 5: ip, iv, diff_k(ip,:,iv): ', ip, iv, diff_k(ip,:,iv)
6041	END SELECT
6042
6043	ELSE ! old cryoturbation scheme
6044	!
6045	diff_k(ip,1:altmax_ind(ip,iv),iv) = diff_k_const
6046	diff_k(ip, altmax_ind(ip,iv)+1,iv) = diff_k_const/10.
6047	diff_k(ip, altmax_ind(ip,iv)+2,iv) = diff_k_const/100.
6048	diff_k(ip,(altmax_ind(ip,iv)+3):ndeep,iv) = zero
6049	ENDIF
6050	ELSE IF ( bioturb_location(ip,iv) ) THEN
6051	DO il = 1, ndeep
6052	IF ( zi_soil(il) .LE. bioturbation_depth ) THEN
6053	diff_k(ip,il,iv) = bio_diff_k_const
6054	ELSE
6055	diff_k(ip,il,iv) = zero
6056	ENDIF
6057	END DO
6058	ELSE
6059	diff_k(ip,:,iv) = zero
6060	END IF
6061	END DO
6062	END DO
6063
6064	DO il = 1,ndeep-1
6065	WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:) )
6066	xc_cryoturb(:,il,:) = (zf_soil(il)-zf_soil(il-1)) / time_step
6067	xd_cryoturb(:,il,:) = diff_k(:,il,:) / (zi_soil(il+1)-zi_soil(il))
6068	endwhere
6069	ENDDO
6070
6071	WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:) )
6072	xc_cryoturb(:,ndeep,:) = (zf_soil(ndeep)-zf_soil(ndeep-1)) / time_step
6073
6074	!bottom
6075	xe_a(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
6076	xe_s(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
6077	xe_p(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
6078	alpha_a(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_a(:,:)
6079	alpha_s(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_s(:,:)
6080	alpha_p(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_p(:,:)
6081	beta_a(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_a(:,ndeep,:) / xe_a(:,:)
6082	beta_s(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_s(:,ndeep,:) / xe_s(:,:)
6083	beta_p(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_p(:,ndeep,:) / xe_p(:,:)
6084	END WHERE
6085
6086	!other levels
6087	DO il = ndeep-2,1,-1
6088	WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:) )
6089	xe_a(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_a(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
6090	xe_s(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_s(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
6091	xe_p(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_s(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
6092	alpha_a(:,il,:) = xd_cryoturb(:,il,:) / xe_a(:,:)
6093	alpha_s(:,il,:) = xd_cryoturb(:,il,:) / xe_s(:,:)
6094	alpha_p(:,il,:) = xd_cryoturb(:,il,:) / xe_p(:,:)
6095	beta_a(:,il,:) = (xc_cryoturb(:,il+1,:)deepC_a(:,il+1,:)+xd_cryoturb(:,il+1,:)beta_a(:,il+1,:)) / xe_a(:,:)
6096	beta_s(:,il,:) = (xc_cryoturb(:,il+1,:)deepC_s(:,il+1,:)+xd_cryoturb(:,il+1,:)beta_s(:,il+1,:)) / xe_s(:,:)
6097	beta_p(:,il,:) = (xc_cryoturb(:,il+1,:)deepC_p(:,il+1,:)+xd_cryoturb(:,il+1,:)beta_p(:,il+1,:)) / xe_p(:,:)
6098	END WHERE
6099	ENDDO
6100
6101	ELSE
6102	!
6103	! do not know this action
6104	!
6105	CALL ipslerr_p(3, 'cryoturbate', 'DO NOT KNOW WHAT TO DO:', TRIM(action), '')
6106	!
6107	ENDIF
6108
6109	! keep last action in mind
6110	!
6111	last_action = action
6112
6113	END SUBROUTINE cryoturbate
6114
6115	!!
6116	!================================================================================================================================
6117	!! SUBROUTINE : permafrost_decomp
6118	!!
6119	!>\BRIEF This routine calculates carbon decomposition
6120	!! DESCRIPTION :
6121	!!
6122	!! RECENT CHANGE(S) : None
6123	!!
6124	!! MAIN OUTPUT VARIABLE(S) :
6125	!!
6126	!! REFERENCE(S) : None
6127	!!
6128	!! FLOWCHART11 : None
6129	!! \n
6130	!_
6131	!================================================================================================================================
6132
6133	SUBROUTINE permafrost_decomp (kjpindex, time_step, tprof, Nconfun, airvol_soil, &
6134	oxlim, tau_CH4troph, ok_methane, fbactratio, O2m, &
6135	totporO2_soil, totporCH4_soil,poros_layt_pft, hslong, clay, &
6136	no_pfrost_decomp, methane_gene_diff, deepC_a, deepC_s, deepC_p, deltaCH4g, deltaCH4,&
6137	deltaC1_a, deltaC1_s, deltaC1_p, deltaC2, &
6138	deltaC3, O2_soil,delta_O2_soil, delta_CH4_soil, CH4_soil, fbact_out, MG_useallCpools, O2atm,&
6139	!!!qcj++ peatland
6140	deepC_pt,deepC_peat,peat_OLT)
6141
6142	!! 0. Variable and parameter declaration
6143
6144	!! 0.1 Input variables
6145
6146	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
6147	REAL(r_std), INTENT(in) :: time_step !! time step in seconds
6148	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: tprof !! deep temperature profile
6149	INTEGER(i_std), INTENT(in) :: Nconfun
6150	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: airvol_soil
6151	LOGICAL, INTENT(in) :: oxlim !! O2 limitation taken into account
6152	REAL(r_std), INTENT(in) :: tau_CH4troph !! time constant of methanetrophy (s)
6153	LOGICAL, INTENT(in) :: ok_methane !! Is Methanogenesis and -trophy taken into account?
6154	LOGICAL, INTENT(in) :: methane_gene_diff!!when false: methane generation and diffusion is turn off
6155	REAL(r_std), INTENT(in) :: fbactratio !! time constant of methanogenesis (ratio to that of oxic)
6156	REAL(r_std), INTENT(in) :: O2m !! oxygen concentration [g/m3] below which there is anoxy
6157	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporO2_soil !! total O2 porosity (Tans, 1998)
6158	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: totporCH4_soil !! total CH4 porosity (Tans, 1998)
6159	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: poros_layt_pft
6160	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: hslong !! deep soil humidity
6161	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: clay !! clay content
6162	LOGICAL, INTENT(in) :: no_pfrost_decomp!! Whether this is a spinup run
6163	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: fbact_out
6164	LOGICAL, INTENT(in) :: MG_useallCpools !! Do we allow all three C pools to feed methanogenesis?
6165	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: O2atm
6166
6167	!! 0.2 Output variables
6168
6169	!! 0.3 Modified variables
6170
6171	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_a !! soil carbon (g/m**3) active
6172	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_s !! soil carbon (g/m**3) slow
6173	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_p !! soil carbon (g/m**3) passive
6174	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaCH4
6175	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaCH4g
6176	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC1_a
6177	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC1_s
6178	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC1_p
6179	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC2
6180	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deltaC3
6181	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil !! oxygen (g O2/m**3 air)
6182	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil !! methane (g CH4/m**3 air)
6183	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: delta_O2_soil !! accumulated oxygen consumed in one time step
6184	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: delta_CH4_soil !!accumulated methane used (transPlan+ebul+methanotrophy)
6185	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: porosity_soil
6186
6187	!!!qcj++ peatland
6188	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out) ::deepC_pt
6189	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_peat
6190	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(out) :: peat_OLT
6191	REAL(r_std), DIMENSION(ndeep) :: peat_BD !bulk density of the soil
6192	REAL(r_std), DIMENSION(ndeep) :: peat_SOC !soil carbon concentration of the soil
6193	REAL(r_std), ALLOCATABLE, DIMENSION(:),SAVE :: Cmax ! maximum allowed carbon content at each soil layer
6194	REAL(r_std) :: excessC
6195	REAL(r_std) :: max_vsreal
6196	REAL(r_std) :: trans_flux
6197	REAL(r_std) :: Cthick
6198	!! 0.4 Local variables
6199
6200	LOGICAL, SAVE :: firstcall = .TRUE.
6201	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: fc !! flux fractions within carbon pools
6202	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: fr !! fraction of decomposed carbon that goes into the atmosphere
6203	INTEGER(i_std) :: ier
6204	REAL(r_std), DIMENSION(3,3) :: cflux !! fluxes between soil carbon reservoirs
6205	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm) :: nadd_soil !! number of moles created / m**3 of air
6206	REAL(r_std) :: fbact_a,fbact_s, fbact_p,temp
6207	REAL(r_std) :: fbactCH4_a, fbactCH4_s, fbactCH4_p
6208	REAL(r_std) :: dC,dCm
6209	REAL(r_std) :: dCH4,dCH4m,dO2
6210	INTEGER(i_std) :: il, ip, iv
6211
6212
6213	IF (firstcall) THEN
6214
6215	ALLOCATE (fc(kjpindex,3,3,nvm),stat=ier)
6216	IF (ier.NE.0) THEN
6217	WRITE (numout,*) ' error in fc allocation. We stop. We need ',kjpindex,' fois ',3,' fois ',3,' fois ',nvm,' words = '&
6218	& , kjpindex33*nvm
6219	STOP 'deep_carbcycle'
6220	END IF
6221	ALLOCATE (fr(kjpindex,3,nvm),stat=ier)
6222	IF (ier.NE.0) THEN
6223	WRITE (numout,*) ' error in fc allocation. We stop. We need ',kjpindex,' fois ',3,' fois ',nvm,' words = '&
6224	& , kjpindex3nvm
6225	STOP 'deep_carbcycle'
6226	END IF
6227	!!!qcj++ peatland
6228	ALLOCATE (Cmax(ndeep),stat=ier)
6229	IF (ier.NE.0) THEN
6230	WRITE (numout,*) ' error in Cmax allocation. We stop. We need ',ndeep,' fois '
6231	STOP 'deep_carbcycle'
6232	ENDIF
6233	!
6234	! calculate carbon flux fractions
6235	!
6236	DO iv =1,nvm
6237	fc(:,iactive,iactive,iv) = 0.0_r_std
6238	fc(:,iactive,ipassive,iv) = 0.004_r_std
6239	fc(:,iactive,islow,iv) = 1._r_std - (.85-.68*clay(:)) - fc(:,iactive,ipassive,iv)
6240	!
6241	fc(:,islow,islow,iv) = .0_r_std
6242	fc(:,islow,iactive,iv) = .42_r_std
6243	fc(:,islow,ipassive,iv) = .03_r_std
6244	!
6245	fc(:,ipassive,ipassive,iv) = .0_r_std
6246	fc(:,ipassive,iactive,iv) = .45_r_std
6247	fc(:,ipassive,islow,iv) = .0_r_std
6248	!
6249	fr(:,:,iv) = 1._r_std-fc(:,:,iactive,iv)-fc(:,:,islow,iv)-fc(:,:,ipassive,iv)
6250
6251	firstcall = .FALSE.
6252	END DO
6253
6254	!!!qcj++ peatland
6255	! bulk density of the soil
6256	peat_BD(:) = peat_bulk_density(:) !in g/cm3
6257	!
6258	! soil organic carbon concentration
6259	! peat_SOC(:) = 1._r_std/((peat_BD(:)+0.27)*3.48)(1._r_std+3*peat_BD(:))
6260	! peat_SOC(:)=1._r_std/((0.4peat_BD(:)+0.13)*2.19)
6261	peat_SOC(:)=1._r_std/((0.4peat_BD(:)+0.122)*2.19)
6262	peat_SOC(:) = (peat_SOC(:)+SOCyshift)*0.01
6263	! the maximum allowed carbon content per soil layer
6264	!zf_soil,zi_soil: in m
6265	!peat_BD in g/cm3
6266	DO il=1,ndeep
6267	Cmax(il) = peat_BD(il)1.E6peat_SOC(il)(zf_soil(il)-zf_soil(il-1)) !Cmax in g/m*2
6268	ENDDO
6269
6270
6271	IF (printlev>=3) THEN
6272	DO ip = 1,kjpindex
6273	WRITE(,) 'cdk: permafrost_decomp: i, fraction respired gridcell(i) :', ip, fr(ip,:,1)
6274	END DO
6275	ENDIF
6276	ENDIF
6277
6278
6279	!
6280	! calculate carbon consumption
6281	!
6282	nadd_soil(:,:,:) = zero
6283	cflux(:,:) = zero
6284
6285	deltaC1_a(:,:,:) = zero
6286	deltaC1_s(:,:,:) = zero
6287	deltaC1_p(:,:,:) = zero
6288	deltaCH4(:,:,:) = zero
6289	deltaCH4g(:,:,:) = zero
6290	deltaC2(:,:,:) = zero
6291	deltaC3(:,:,:) = zero
6292	DO ip = 1, kjpindex
6293	!
6294	DO iv = 1, nvm
6295	!
6296	IF ( veget_mask_2d(ip,iv) ) THEN
6297	!
6298	DO il = 1, ndeep
6299	!
6300	! 1 function that gives carbon residence time as a function of
6301	! soil temperature (in seconds)
6302	!
6303	temp = tprof(ip,il,iv) - ZeroCelsius
6304	IF (no_pfrost_decomp) THEN
6305	! no decomposition during spinup
6306	fbact_a = HUGE(1.0)
6307	ELSE
6308	fbact_a = fbact_out(ip,il,iv)
6309	fbact_a = MAX(fbact_a,time_step)
6310	ENDIF
6311	!
6312
6313	IF ( fbact_a/HUGE(1.) .GT. .1 ) THEN
6314	fbact_s = fbact_a
6315	fbact_p = fbact_a
6316	ELSE
6317	fbact_s = fbact_a * fslow
6318	fbact_p = fbact_a * fpassive
6319	ENDIF
6320	!
6321	! methanogenesis: first guess, 10 times (fbactratio) slower than oxic
6322	! decomposition
6323	IF ( fbact_a/HUGE(1.) .GT. .1 ) THEN
6324	fbactCH4_a = fbact_a
6325	fbactCH4_s = fbact_s
6326	fbactCH4_p = fbact_p
6327	ELSE
6328	fbactCH4_a = fbact_a * fbactratio
6329	IF ( MG_useallCpools ) THEN
6330	fbactCH4_s = fbact_s * fbactratio
6331	fbactCH4_p = fbact_p * fbactratio
6332	ELSE
6333	fbactCH4_s = HUGE(1.0)
6334	fbactCH4_p = HUGE(1.0)
6335	ENDIF
6336	ENDIF
6337	!
6338	! 2 oxic decomposition: carbon and oxygen consumption
6339	!
6340	! 2.1 active
6341	!
6342	! IF (oxlim) THEN
6343	dCm = O2_soil(ip,il,iv)airvol_soil(ip,il,iv)wC/wO2
6344	dC = MIN(deepC_a(ip,il,iv) * time_step/fbact_a, dCm)
6345	! ELSE
6346	! dC = deepC_a(ip,il,iv) * time_step/fbact_a
6347	! ENDIF
6348
6349	! pour actif
6350	dC = dC * ( 1. - .75 * clay(ip) )
6351
6352
6353	! flux vers les autres reservoirs
6354	cflux(iactive,ipassive) = fc(ip,iactive,ipassive,iv) * dC
6355	cflux(iactive,islow) = fc(ip,iactive,islow,iv) * dC
6356	!
6357	deepC_a(ip,il,iv) = deepC_a(ip,il,iv) - dC
6358
6359	dO2 = wO2/wC * dC*fr(ip,iactive,iv) / totporO2_soil(ip,il,iv)
6360	delta_O2_soil(ip,il,iv)=delta_O2_soil(ip,il,iv)+dO2
6361	O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
6362	! keep delta C * fr in memory (generates energy)
6363	deltaC1_a(ip,il,iv) = dC*fr(ip,iactive,iv) !!this line!!!
6364
6365	!
6366	! 2.2 slow
6367	!
6368	IF (oxlim) THEN
6369	dCm = O2_soil(ip,il,iv)airvol_soil(ip,il,iv)wC/wO2
6370	dC = MIN(deepC_s(ip,il,iv) * time_step/fbact_s,dCm)
6371	ELSE
6372	dC = deepC_s(ip,il,iv) * time_step/fbact_s
6373	ENDIF
6374
6375	! flux vers les autres reservoirs
6376	cflux(islow,iactive) = fc(ip,islow,iactive,iv) * dC
6377	cflux(islow,ipassive) = fc(ip,islow,ipassive,iv) * dC
6378	!
6379	deepC_s(ip,il,iv) = deepC_s(ip,il,iv) - dC
6380	dO2 = wO2/wC * dC*fr(ip,islow,iv) / totporO2_soil(ip,il,iv)
6381	delta_O2_soil(ip,il,iv)=delta_O2_soil(ip,il,iv)+dO2
6382	O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
6383	! keep delta C * fr in memory (generates energy)
6384	deltaC1_s(ip,il,iv) = dC*fr(ip,islow,iv)
6385
6386
6387	!
6388	! 2.3 passive
6389	!
6390	IF (oxlim) THEN
6391	dCm = O2_soil(ip,il,iv)airvol_soil(ip,il,iv)wC/wO2
6392	dC = MIN(deepC_p(ip,il,iv) * time_step/fbact_p,dCm)
6393	ELSE
6394	dC = deepC_p(ip,il,iv) * time_step/fbact_p
6395	ENDIF
6396
6397
6398	! flux vers les autres reservoirs
6399	cflux(ipassive,iactive) = fc(ip,ipassive,iactive,iv) * dC
6400	cflux(ipassive,islow) = fc(ip,ipassive,islow,iv) * dC
6401	!
6402	deepC_p(ip,il,iv) = deepC_p(ip,il,iv) - dC
6403	dO2 = wO2/wC * dC*fr(ip,ipassive,iv) / totporO2_soil(ip,il,iv)
6404	delta_O2_soil(ip,il,iv)=delta_O2_soil(ip,il,iv)+dO2
6405	O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
6406	! keep delta C * fr in memory (generates energy)
6407	deltaC1_p(ip,il,iv) = dC*fr(ip,ipassive,iv)
6408
6409
6410	!
6411	!
6412	! 3 methanogenesis or methanotrophy
6413	!
6414	!
6415	IF (ok_methane) THEN
6416	!
6417	IF (perma_peat) THEN
6418	IF ( iv .EQ. 14 ) THEN
6419	porosity_soil(ip,il,iv) = tetamoss !!!see tetamoss=0.92 in src_parameters/constantes_var.f90
6420	ELSE
6421	porosity_soil(ip,il,iv) = poros_layt_pft(ip,il,iv)
6422	END IF
6423	END IF
6424
6425	!
6426	! 3.1 active pool methanogenesis
6427	dC = deepC_a(ip,il,iv) * (time_step / fbactCH4_a)* EXP((-O2_soil(ip,il,iv) *totporO2_soil(ip,il,iv)/porosity_soil(ip,il,iv))/O2m)
6428	!DKtest: when commented, no ox lim for MG
6429	! pour actif
6430	dC = dC * ( 1.0 -(0.75 * clay(ip)) )
6431	dCH4 = dcfr(ip,iactive,iv) (wCH4/wC) / totporCH4_soil(ip,il,iv)
6432
6433	!
6434	!
6435	! flux vers les autres reservoirs
6436	cflux(iactive,ipassive)=cflux(iactive,ipassive)+fc(ip,iactive,ipassive,iv)*dC
6437	cflux(iactive,islow)=cflux(iactive,islow)+fc(ip,iactive,islow,iv)*dC
6438	!
6439	deepC_a(ip,il,iv) = deepC_a(ip,il,iv) - dC
6440	!
6441	deltaCH4g(ip,il,iv) = dCH4
6442	!
6443	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
6444	! keep delta C*fr in memory (generates energy)
6445	deltaC2(ip,il,iv) = dC*fr(ip,iactive,iv)
6446	!
6447	! how many moles of gas / m**3 of air did we generate?
6448	! (methanogenesis generates 1 molecule net if we take
6449	! B -> B' + CH4 )
6450	nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + (dCH4/wCH4)
6451	!
6452	!
6453	IF ( MG_useallCpools ) THEN
6454	!
6455	! 3.2 slow pool methanogenesis cdk: adding this to allow other carbon pools to participate in MG
6456	dC = deepC_s(ip,il,iv) * (time_step / fbactCH4_s)* EXP((-O2_soil(ip,il,iv)*totporO2_soil(ip,il,iv)/porosity_soil(ip,il,iv))/O2m)
6457	!DKtest: when commented, no ox lim for MG
6458	dCH4 = dcfr(ip,islow,iv) (wCH4/wC) / totporCH4_soil(ip,il,iv)
6459	!
6460	! flux vers les autres reservoirs
6461	cflux(islow,ipassive)=cflux(islow,ipassive)+(fc(ip,islow,ipassive,iv)*dC)
6462	cflux(islow,iactive)=cflux(islow,iactive)+(fc(ip,islow,iactive,iv)*dC)
6463	!
6464	deepC_s(ip,il,iv) = deepC_s(ip,il,iv) - dC
6465	!
6466	deltaCH4g(ip,il,iv) = deltaCH4g(ip,il,iv) + dCH4
6467	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
6468	! keep delta C*fr in memory (generates energy)
6469	deltaC2(ip,il,iv) = deltaC2(ip,il,iv) + (dC*fr(ip,islow,iv))
6470	!
6471	! how many moles of gas / m**3 of air did we generate?
6472	! (methanogenesis generates 1 molecule net if we take
6473	! B -> B' + CH4 )
6474	nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + (dCH4/wCH4)
6475	!
6476	!
6477	!
6478	! 3.3 passive pool methanogenesis cdk: adding this to allow other carbon pools to participate in MG
6479	dC = deepC_p(ip,il,iv) ( time_step / fbactCH4_p) EXP((-O2_soil(ip,il,iv) *totporO2_soil(ip,il,iv)/porosity_soil(ip,il,iv))/O2m)
6480	!DKtest: when commented, no ox lim for MG
6481	dCH4 = dcfr(ip,ipassive,iv) (wCH4/wC) / totporCH4_soil(ip,il,iv)
6482	!
6483	! flux vers les autres reservoirs
6484	cflux(ipassive,islow)=cflux(ipassive,islow)+(fc(ip,ipassive,islow,iv)*dC)
6485	cflux(ipassive,iactive)=cflux(ipassive,iactive)+(fc(ip,ipassive,iactive,iv)*dC)
6486	!
6487	deepC_p(ip,il,iv) = deepC_p(ip,il,iv) - dC
6488	!
6489	deltaCH4g(ip,il,iv) = deltaCH4g(ip,il,iv) + dCH4
6490	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
6491	! keep delta C*fr in memory (generates energy)
6492	deltaC2(ip,il,iv) = deltaC2(ip,il,iv) + (dC*fr(ip,ipassive,iv))
6493	!
6494	! how many moles of gas / m**3 of air did we generate?
6495	! (methanogenesis generates 1 molecule net if we take
6496	! B -> B' + CH4 )
6497	nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + (dCH4/wCH4)
6498	!
6499	!
6500	ENDIF
6501	!
6502	! methanotrophy:
6503	! no temperature dependence except that T>0ï¿œï¿œC (Price et
6504	! al, GCB 2003; Koschorrek and Conrad, GBC 1993).
6505	! tau_CH4troph is such that we fall between values of
6506	! soil methane oxidation flux given by these authors.
6507	!
6508	IF ( temp .GE. zero ) THEN
6509	!
6510	dCH4m = (O2_soil(ip,il,iv)/2.0) (wCH4/wO2) (totporO2_soil(ip,il,iv)/totporCH4_soil(ip,il,iv))* (time_step/MAX(tau_CH4troph,time_step))
6511	!!DKtest - no ox lim to trophy
6512	dCH4 = MIN( CH4_soil(ip,il,iv) * time_step/MAX(tau_CH4troph,time_step), dCH4m )
6513	CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) - dCH4
6514	dO2 = 2.0dCH4 (wO2/wCH4) * (totporCH4_soil(ip,il,iv)/totporO2_soil(ip,il,iv))
6515	O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
6516	!Accumulated amount of O2 (Csoil+CH4 oxi) and CH4
6517	!(transPlan+ebul+methanotrophy) removed from soil layers
6518	!to define ideal diffusion time step
6519	delta_O2_soil(ip,il,iv)=delta_O2_soil(ip,il,iv)+dO2
6520
6521	delta_CH4_soil(ip,il,iv)=delta_CH4_soil(ip,il,iv)+dCH4
6522
6523	! keep delta CH4 in memory (generates energy)
6524	deltaCH4(ip,il,iv) = dCH4
6525	! carbon (g/m3 soil) transformed to CO2
6526	deltaC3(ip,il,iv)=(dCH4/wCH4)wCtotporCH4_soil(ip,il,iv)
6527	! how many moles of gas / m**3 of air did we generate?
6528	! (methanotrophy consumes 2 molecules net if we take
6529	! CH4 + 2 O2 -> CO2 + 2 H2O )
6530	nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv)-2.0*(dCH4/wCH4)
6531	!
6532	ENDIF
6533
6534	ENDIF !end ok_methane
6535
6536	! 4 add fluxes between reservoirs
6537
6538	deepC_a(ip,il,iv)=deepC_a(ip,il,iv)+cflux(islow,iactive)+cflux(ipassive,iactive)
6539	deepC_s(ip,il,iv)=deepC_s(ip,il,iv)+cflux(iactive,islow)+cflux(ipassive,islow)
6540	deepC_p(ip,il,iv)=deepC_p(ip,il,iv)+cflux(iactive,ipassive)+cflux(islow,ipassive)
6541
6542	ENDDO
6543
6544	ELSE
6545
6546	ENDIF
6547
6548	ENDDO
6549
6550	ENDDO
6551	!!!qcj++ peatland
6552	IF (perma_peat) THEN
6553	deepC_pt(:,:,:)=zero
6554	deepC_peat(:,:,:)=zero
6555	ENDIF
6556
6557	!!!qcj++ peatland
6558	IF (perma_peat) THEN
6559	DO ip = 1, kjpindex
6560	DO il = 1, ndeep
6561	DO iv = 1, nvm
6562	IF (is_peat(iv) .AND. veget_mask_2d(ip,iv)) THEN
6563	!!total carbon in each layer (sum of active,slow,passive)
6564	deepC_peat(ip,il,iv)=deepC_a(ip,il,iv)+deepC_s(ip,il,iv)+deepC_p(ip,il,iv) !g/m^3
6565	deepC_peat(ip,il,iv)=deepC_peat(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))!g/m^2
6566	ENDIF
6567	ENDDO
6568	ENDDO
6569	ENDDO
6570	ENDIF
6571
6572	!!!compare deepC_peat with Cmax, the excess will be transferred to lower layer
6573	IF (perma_peat) THEN
6574	DO ip = 1, kjpindex
6575	DO il = 1, ndeep-1
6576	DO iv = 1, nvm
6577	IF (is_peat(iv) .AND. veget_mask_2d(ip,iv)) THEN
6578	IF (deepC_peat(ip,il,iv) .GT. frac1Cmax(il)) THEN !frac1Cmax(il)
6579	! excessC= MAX(deepC_peat(ip,il,iv)*frac2,deepC_peat(ip,il,iv)-Cmax(il))
6580	! excessC=deepC_peat(ip,il,iv)-Cmax(il)
6581	excessC=deepC_peat(ip,il,iv)*frac2
6582	max_vsreal= (deepC_peat(ip,il,iv)-excessC)/deepC_peat(ip,il,iv)
6583	deepC_peat(ip,il,iv)=deepC_peat(ip,il,iv)-excessC
6584	deepC_a(ip,il,iv)= deepC_a(ip,il,iv)* max_vsreal
6585
6586	deepC_s(ip,il,iv)= deepC_s(ip,il,iv)* max_vsreal
6587	deepC_p(ip,il,iv)= deepC_p(ip,il,iv)* max_vsreal
6588
6589	trans_flux=excessC*(zf_soil(il)-zf_soil(il-1))/(zf_soil(il+1)-zf_soil(il))
6590	deepC_a(ip,il+1,iv)= deepC_a(ip,il+1,iv)+(deepC_a(ip,il,iv)/deepC_peat(ip,il,iv))*trans_flux
6591	deepC_s(ip,il+1,iv)= deepC_s(ip,il+1,iv)+(deepC_s(ip,il,iv)/deepC_peat(ip,il,iv))*trans_flux
6592	deepC_p(ip,il+1,iv)= deepC_p(ip,il+1,iv)+(deepC_p(ip,il,iv)/deepC_peat(ip,il,iv))*trans_flux
6593	deepC_peat(ip,il+1,iv)= deepC_peat(ip,il+1,iv)+ trans_flux
6594	ENDIF
6595	deepC_pt(ip,il,iv)=deepC_peat(ip,il,iv)/(zf_soil(il)-zf_soil(il-1))
6596	ENDIF
6597	ENDDO
6598	ENDDO
6599	ENDDO
6600	ENDIF
6601
6602	IF (perma_peat) THEN
6603	! DO ip = 1, kjpindex
6604	! DO iv=1,nvm
6605	! IF (veget_mask_2d(ip,iv)) THEN
6606	! peat_OLT(ip,iv) = zero
6607	! il=1
6608	! DO WHILE ( (deepC_peat(ip,il,iv) .GT. Cmax(il)*frac3) .AND. (il < ndeep+1) )
6609	! Cthick = zf_soil(il)-zf_soil(il-1)
6610	! peat_OLT(ip,iv)=peat_OLT(ip,iv)+Cthick
6611	! il=il+1
6612	! ENDDO
6613	! ENDIF
6614	! ENDDO
6615	! ENDDO
6616	DO ip = 1, kjpindex
6617	DO iv=1,nvm
6618	IF (veget_mask_2d(ip,iv)) THEN
6619	peat_OLT(ip,iv) = zero
6620	IF (is_peat(iv)) THEN
6621	il=1
6622	DO WHILE ((deepC_peat(ip,il,iv) .GT. min_stomate) .AND. (il<ndeep))
6623	Cthick = (zf_soil(il)-zf_soil(il-1))*deepC_peat(ip,il,iv)/Cmax(il)
6624	peat_OLT(ip,iv)=zf_soil(il-1)+Cthick
6625	il=il+1
6626	ENDDO
6627	IF ((il==ndeep) .AND. (deepC_peat(ip,il,iv) .GT. min_stomate))THEN
6628	Cthick =(zf_soil(il)-zf_soil(il-1))*deepC_peat(ip,il,iv)/Cmax(il)
6629	peat_OLT(ip,iv)=zf_soil(il-1)+Cthick
6630	peat_OLT(ip,iv)= MIN(zf_soil(il),peat_OLT(ip,iv))
6631	ENDIF
6632	ENDIF
6633	ENDIF
6634	ENDDO
6635	ENDDO
6636
6637	ENDIF
6638
6639	END SUBROUTINE permafrost_decomp
6640
6641
6642	!!
6643	!================================================================================================================================
6644	!! SUBROUTINE : calc_vert_int_soil_carbon
6645	!!
6646	!>\BRIEF This routine calculates carbon decomposition
6647	!!
6648	!! DESCRIPTION :
6649	!!
6650	!! RECENT CHANGE(S) : None
6651	!!
6652	!! MAIN OUTPUT VARIABLE(S) :
6653	!!
6654	!! REFERENCE(S) : None
6655	!!
6656	!! FLOWCHART11 : None
6657	!! \n
6658	!_
6659	!================================================================================================================================
6660
6661	SUBROUTINE calc_vert_int_soil_carbon(kjpindex, deepC_a, deepC_s, deepC_p, carbon, carbon_surf, zf_soil)
6662
6663	!! 0. Variable and parameter declaration
6664
6665	!! 0.1 Input variables
6666
6667	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
6668	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: deepC_a !! active pool deepc
6669	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: deepC_s !! slow pool deepc
6670	REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in) :: deepC_p !! passive pool deepc
6671	REAL(r_std), DIMENSION(0:ndeep), INTENT(in) :: zf_soil !! depths at full levels
6672
6673	!! 0.2 Output variables
6674
6675	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out) :: carbon !! vertically-integrated carbon pool: active, slow, or passive, (gC/(m**2 of ground))
6676	REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out):: carbon_surf!! vertically-integrated carbon pool to 1 meter: active, slow, or passive,(gC/(m**2 of ground))
6677
6678	!! 0.3 Modified variables
6679
6680	!! 0.4 Local variables
6681	INTEGER(i_std) :: il
6682	real(r_std), parameter :: maxdepth=2.!! depth to which we intergrate the carbon for carbon_surf calculation
6683
6684	carbon(:,:,:) = zero
6685	DO il = 1, ndeep
6686	WHERE ( veget_mask_2d(:,:) )
6687	carbon(:,iactive,:) = carbon(:,iactive,:) + deepC_a(:,il,:)*(zf_soil(il)-zf_soil(il-1))
6688	carbon(:,islow,:) = carbon(:,islow,:) + deepC_s(:,il,:)*(zf_soil(il)-zf_soil(il-1))
6689	carbon(:,ipassive,:) = carbon(:,ipassive,:) + deepC_p(:,il,:)*(zf_soil(il)-zf_soil(il-1))
6690	END WHERE
6691	ENDDO
6692
6693	carbon_surf(:,:,:) = zero
6694	DO il = 1, ndeep
6695	if (zf_soil(il-1) .lt. maxdepth ) then
6696	where ( veget_mask_2d(:,:) )
6697	carbon_surf(:,iactive,:) = carbon_surf(:,iactive,:) + deepC_a(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
6698	carbon_surf(:,islow,:) = carbon_surf(:,islow,:) + deepC_s(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
6699	carbon_surf(:,ipassive,:) = carbon_surf(:,ipassive,:) + deepC_p(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
6700	end where
6701	endif
6702	ENDDO
6703
6704	END SUBROUTINE calc_vert_int_soil_carbon
6705
6706	END MODULE stomate_permafrost_soilcarbon

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd_mict_peat_ch4/src_stomate/stomate_permafrost_soilcarbon.f90 @ 7346

Download in other formats: