Context Navigation

source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/grassland_management.f90 @ 5816

Last change on this file since 5816 was 5816, checked in by jinfeng.chang, 5 years ago
copy ORCHIDEE-GMv3.2 for publication
File size: 181.1 KB

Line
1	! =================================================================================================================================
2	! MODULE : grassland_management
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 Groups the subroutines that: (1) initialize all variables in
11	!! grassland management, (2) call subroutines of major grassland management
12	!! modules (cut/harvest, grazing, fertilization) , (3) read external maps
13	!! such as mangement, livestock density, fertilization, wild animal density
14	!! (4) calculate plants status such as developement stage and tgrowth
15	!!
16	!!\n DESCRIPTION : None
17	!!
18	!! RECENT CHANGE(S) : None
19	!!
20	!! REFERENCE(S) : None
21	!!
22	!! \n
23	!_
24	!================================================================================================================================
25
26	MODULE grassland_management
27	! this module include grassland management from PaSim
28	! graze - cut - fertilisation
29	! with auto management or user-defined management
30
31	USE grassland_constantes
32	USE constantes
33	USE grassland_fonctions
34	USE grassland_grazing
35	!USE applic_plant
36	USE grassland_cutting
37	USE grassland_fertilisation
38	USE ioipsl
39	USE ioipsl_para
40	USE mod_orchidee_para
41	USE xios_orchidee
42	USE netcdf
43	USE defprec
44	USE grid
45	USE matrix_resolution
46	USE interpol_help ! necessary for management map input
47	! USE parallel
48
49	IMPLICIT NONE
50
51	PUBLIC grassmanag_clear
52
53	LOGICAL, SAVE :: first_call_grassland_manag = .TRUE.
54	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake
55	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakemax
56	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_litter
57	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animal_litter
58	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: litter_avail_totDM
59	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazing_litter
60	! shoot dry matter afer cutting Kg/m2
61	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wshtotcutinit
62	! lai after cutting (m2 leaf/m2)
63	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: lcutinit
64	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: devstage
65	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesc
66	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesn
67	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinen
68	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinec
69	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nel
70	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nanimaltot
71	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tgrowth
72	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wsh
73	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtotinit
74	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtot
75	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wr
76	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wrtot
77	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wanimal
78	! concentration totale en N (kg n/kg)
79	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ntot
80	! concentration en C du substrat de la plante (kg C/kg)
81	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: c
82	! concentration en N du substrat de la plante (kg N/kg)
83	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: n
84	! n in structral mass kgN/kg
85	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fn
86	! n concentration of apoplast (kgN/kg)
87	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: napo
88	! n concentration of symplast (kgN/kg)
89	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsym
90	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wnapo
91	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wnsym
92	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wn
93	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nanimal
94	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tanimal
95	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: danimal
96	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut
97	! day of fertilisation (management) (d)
98	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert
99	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Nliquidmanure
100	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nslurry
101	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Nsolidmanure
102	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: legume_fraction
103	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soil_fertility
104	! Threshold shoot dry matter, under which animals are moved out (kg/m2)
105	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Animalwgrazingmin
106	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: AnimalkintakeM
107	! parameter for calculation of vegetation compartement selection by animals (-)
108	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: AnimalDiscremineQualite
109	! Valeurs associées à la croissance aérienne entre 2 évènements de fertilisation (autogestion fauches)
110	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: controle_azote
111	! Carbon flux from Organic fertilization to metabolic SOM pool (kg C m-2 day-1)
112	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertmetabolicsum
113	! Carbon flux from Organic fertilization to strcutural SOM pool (kg C m-2 day-1)
114	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertstructsum
115	! Nitrogen flux from Organic fertilization to strcutural SOM pool (kg N m-2 day-1)
116	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertmetabolicsum
117	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertstructsum
118	! Nitrogen flux coming from slurry and liquid manure (k N.m-2)
119	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFerturinesum
120	! Nitrogen deposition (kg N m-2 year-1)
121	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnatmsum
122	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: controle_azote_sum
123	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nfertamm
124	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nfertnit
125	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakesum
126	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakensum
127	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animal
128	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animalsum
129	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PIYcow
130	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PIMcow
131	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCSYcow
132	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCSMcow
133	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PICcow
134	! Age of dairy primi cow
135	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: AGE_cow_P
136	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: AGE_cow_M
137	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Autogestion_out
138	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Forage_quantity
139	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut_modif
140	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: countschedule
141	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mux
142	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mugmean
143	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sigx
144	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sigy
145	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gmeanslope
146	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gzero
147	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gcor
148	INTEGER (i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: cuttingend
149	LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut_verif
150	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: regcount
151	INTEGER(i_std) :: tcutmodel
152	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshcutinit
153	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gmean
154	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgmean
155	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wc_frac
156	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wgn
157	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tasum
158	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: loss
159	! perte en C lors de la fauche
160	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: lossc
161	! perte en N lors de la fauche
162	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: lossn
163	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tlossstart
164	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: flag_fertilisation
165	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount
166	! C/N dans le réservoir stucturel = 150
167	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: c2nratiostruct
168	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtot
169	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittot
170	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtotyear
171	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittotyear
172	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtotprevyear
173	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittotprevyear
174	! metabolic C in slurry and manure (kg C/m**2/d)
175	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertmetabolic
176	! structural C in slurry and manure (kg C/m**2/d)
177	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertstruct
178	! urine N in slurry and manure (kg N/m**2/d)
179	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFerturine
180	! metabolic N in slurry and manure (kg N/m**2/d)
181	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertmetabolic
182	! struct N in slurry and manure (kg N/m**2/d)
183	REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertstruct
184
185
186	! variables pour l'auto gestion de nicolas
187	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsatur_somerror_temp
188	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsatur_somerror
189	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_modif
190	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nnonlimit_SOMerror
191	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nnonlimit_SOMerrormax
192	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: controle_azote_sum_mem
193	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: n_auto
194	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: stoplimitant
195	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount_start
196	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount_current
197	LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertil_year
198	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: toto
199	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtotsumprevyear
200	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_sr_ugb_C3
201	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_nb_ani_C3
202	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_grazed_frac_C3
203	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_import_yield_C3
204	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_wshtotsum_C3
205	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_sr_ugb_C4
206	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_nb_ani_C4
207	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_grazed_frac_C4
208	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_import_yield_C4
209	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_wshtotsum_C4
210
211	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: DM_cutyearly
212	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: C_cutyearly
213	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: YIELD_RETURN
214	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sr_ugb_init
215
216	INTEGER(i_std) , SAVE :: cut_year
217	INTEGER(i_std) , SAVE :: compt_fert
218	INTEGER(i_std) , SAVE :: min_fert
219	INTEGER(i_std) , SAVE :: fert_max
220	INTEGER(i_std) , SAVE :: i_compt
221	REAL(r_std) , SAVE :: deltat ! = 0.02
222	! couter number of years of simulation
223	INTEGER(i_std) , SAVE :: count_year
224	INTEGER(i_std) , SAVE :: year_count1
225	! couter number of years of simulation
226	INTEGER(i_std) , SAVE :: year_count2
227	! couter number of years of simulation
228
229	CHARACTER(len=500), ALLOCATABLE,SAVE,DIMENSION (:) :: file_management
230	CHARACTER(len=500) , SAVE :: file_param_init
231	CHARACTER(len=500) , SAVE :: file_import_yield
232
233	INTEGER(i_std) , SAVE :: Type_animal
234	INTEGER(i_std) , SAVE :: mcut_C3
235	INTEGER(i_std) , SAVE :: mauto_C3
236	INTEGER(i_std) , SAVE :: mcut_C4
237	INTEGER(i_std) , SAVE :: mauto_C4
238	! yearly total azote by fertilization
239	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: apport_azote
240	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: trampling
241
242	! new variables for get map of management
243	INTEGER(i_std) , SAVE :: f_management_map
244	CHARACTER(len=500) , SAVE :: management_map
245	CHARACTER(len=500) , SAVE :: fertility_map
246
247	INTEGER(i_std) , SAVE :: f_deposition_map
248	CHARACTER(len=500) , SAVE :: deposition_map
249	INTEGER(i_std) , SAVE :: f_grazing_map
250	CHARACTER(len=500) , SAVE :: grazing_map
251	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ndeposition
252	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: N_fert_total
253	REAL(r_std) , SAVE :: N_effect
254	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: compt_cut
255	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: frequency_cut
256	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: sr_wild
257	INTEGER(i_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: flag_cutting
258	! from applic_plant
259	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean1
260	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean2
261	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean3
262	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean4
263	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean5
264	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean6
265	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tameand
266	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tameanw
267	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tacumm
268	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tacummprev
269	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilcumm
270	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilcummprev
271	REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilmeand
272	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: tcut0
273
274	! flag for verify that without twice fertilisation at same time
275	LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif
276	LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif2 ! idem
277	LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif3 ! idem
278
279	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_sn
280	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_on
281	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_PRP
282
283	CONTAINS
284
285	SUBROUTINE main_grassland_management(&
286	npts ,lalo, neighbours, resolution, contfrac, &
287	dt, tjulian, t2m_daily, t2m_min_daily, &
288	t2m_14, tsoil, snowfall_daily, biomass, bm_to_litter, &
289	litter, litter_avail, litter_not_avail , &
290	! !spitfire
291	! fuel_1hr, fuel_10hr, &
292	! fuel_100hr, fuel_1000hr, &
293	! !end spitfire
294	new_day, new_year, when_growthinit_cut, nb_grazingdays,&
295	lai, sla_calc, leaf_age, leaf_frac, &
296	wshtotsum, sr_ugb, compt_ugb, &
297	nb_ani, grazed_frac, import_yield, N_limfert, &
298	!JCADD top 5 layer grassland soil moisture for grazing
299	moiavail_daily, tmc_topgrass_daily,fc_grazing, snowmass_daily,&
300	after_snow, after_wet, wet1day, wet2day, &
301	!ENDJCADD
302	harvest_gm, ranimal_gm, ch4_pft_gm, cinput_gm, n2o_pft_gm)
303
304	INTEGER(i_std) , INTENT(in) :: npts
305	INTEGER(i_std),DIMENSION(npts,8),INTENT(in) :: neighbours !!Neighoring grid points if land for the DGVM
306	!!(unitless)
307	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo !!Geographical coordinates (latitude,longitude)
308	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution !! Size in x an y of the grid (m) - surface area of
309	!! the gridbox
310	REAL(r_std),DIMENSION (npts), INTENT (in) :: contfrac !!Fraction of continent in the grid cell (unitless)
311	REAL(r_std) , INTENT(in) :: dt
312	INTEGER(i_std) , INTENT(in) :: tjulian
313	! julien day
314	REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_daily
315	! air temperature
316	REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_min_daily
317	! daily minimum temperature
318	REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_14
319	! 14 days mean temperature
320	REAL(r_std), DIMENSION(npts) , INTENT(in) :: tsoil
321	! soil surface t (k)
322	REAL(r_std), DIMENSION(npts) , INTENT(in) :: snowfall_daily
323	! snow fall (mm/d)
324	REAL(r_std), DIMENSION(npts) , INTENT(in) :: snowmass_daily
325	! snow mass (kg/m2)
326	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass
327	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter
328	! conv of biomass to litter (gC/(m**2/agri ground)) / day
329	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter
330	REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail
331	REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail
332	LOGICAL , INTENT(in) :: new_day
333	! flag indicate new day
334	LOGICAL , INTENT(in) :: new_year
335	! flag indicate new year
336	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit_cut
337	! how many days ago was the beginning of the last cut
338	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_grazingdays
339	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: lai
340	! leaf area index OF AN INDIVIDUAL PLANT
341	! !spitfire
342	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1hr
343	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_10hr
344	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_100hr
345	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1000hr
346	! !end spitfire
347	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: sla_calc
348	REAL(r_std), DIMENSION(npts,nvm,nleafages) , INTENT(inout) :: leaf_frac
349	REAL(r_std), DIMENSION(npts,nvm,nleafages) , INTENT(inout) :: leaf_age
350	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: wshtotsum
351	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_ugb
352	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: compt_ugb
353	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_ani
354	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: grazed_frac
355	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: import_yield
356	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: N_limfert
357	!JCADD top 5 layer grassland soil moisture for grazing
358	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily
359	REAL(r_std),DIMENSION (npts), INTENT(in) :: tmc_topgrass_daily
360	REAL(r_std),DIMENSION (npts), INTENT(in) :: fc_grazing
361	REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_snow
362	REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_wet
363	REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet1day
364	REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet2day
365	!ENDJCADD
366	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: harvest_gm
367	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ranimal_gm
368	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ch4_pft_gm
369	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cinput_gm
370	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: n2o_pft_gm
371
372	LOGICAL :: l_error = .FALSE.
373	INTEGER(i_std) :: ier, i, j, k,h, m
374	REAL(r_std), DIMENSION(npts) :: xtmp_npts
375	REAL(r_std), DIMENSION(npts,ngmean) :: xtmp_npts_3d
376	REAL(r_std), DIMENSION(npts,nvm) :: regcount_real
377	REAL(r_std), DIMENSION(npts,nvm) :: fertcount_real
378	INTEGER(i_std) :: fertcount_next
379	REAL(r_std) :: intakemax_t
380	REAL(r_std) :: wanimal_t
381	REAL(r_std), DIMENSION(ncut) ::wshtotcutinit_t
382	REAL(r_std), DIMENSION(npts,nvm) :: lm_before
383	REAL(r_std), DIMENSION(npts,nvm) :: lm_after
384	REAL(r_std), DIMENSION(npts,nvm) :: bm_cut
385
386	REAL(r_std), PARAMETER :: n2o_EF1 = 0.01
387	REAL(r_std), PARAMETER :: n2o_EF2 = 0.015
388	REAL(r_std), PARAMETER :: n2o_EF3 = 0.01
389	REAL(r_std), PARAMETER :: n2o_EF4 = 0.0075
390	REAL(r_std), PARAMETER :: n2o_FracGASF = 0.10
391	REAL(r_std), PARAMETER :: n2o_FracGASM = 0.20
392	REAL(r_std), PARAMETER :: n2o_FracLEACH_H = 0.30
393
394
395	! REAL(r_std), DIMENSION(npts,nvm) :: N_fert_total
396	REAL(r_std) :: fertility_legume_t
397
398	! 1. initialisations
399	init_grassland : IF (first_call_grassland_manag) THEN
400
401	first_call_grassland_manag = .FALSE.
402
403	! 1.1 allocate variables
404
405	ALLOCATE (intake (npts,nvm) , stat=ier)
406	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake', 'Not enough memory', '')
407	ALLOCATE (intakemax (npts,nvm) , stat=ier)
408	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakemax', 'Not enough memory', '')
409	ALLOCATE (intake_litter (npts,nvm) , stat=ier)
410	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_litter', 'Not enough memory', '')
411	ALLOCATE (intake_animal_litter (npts,nvm) , stat=ier)
412	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animal_litter', 'Not enough memory', '')
413	ALLOCATE (grazing_litter (npts,nvm) , stat=ier)
414	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'grazing_litter', 'Not enough memory', '')
415	ALLOCATE (litter_avail_totDM (npts,nvm) , stat=ier)
416	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'litter_avail_totDM', 'Not enough memory', '')
417	ALLOCATE (wshtotcutinit (npts,nvm,ncut) , stat=ier)
418	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotcutinit', 'Not enough memory', '')
419	ALLOCATE (lcutinit (npts,nvm,ncut) , stat=ier)
420	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lcutinit', 'Not enough memory', '')
421	ALLOCATE (devstage (npts,nvm) , stat=ier)
422	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'devstage', 'Not enough memory', '')
423	ALLOCATE (faecesc (npts,nvm) , stat=ier)
424	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'faecesc', 'Not enough memory', '')
425	ALLOCATE (faecesn (npts,nvm) , stat=ier)
426	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'faecesn', 'Not enough memory', '')
427	ALLOCATE (urinen (npts,nvm) , stat=ier)
428	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'urinen', 'Not enough memory', '')
429	ALLOCATE (urinec (npts,nvm) , stat=ier)
430	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'urinec', 'Not enough memory', '')
431	ALLOCATE (nel (npts,nvm) , stat=ier)
432	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nel', 'Not enough memory', '')
433	ALLOCATE (nanimaltot (npts,nvm) , stat=ier)
434	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nanimaltot', 'Not enough memory', '')
435	ALLOCATE (tgrowth (npts,nvm) , stat=ier)
436	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tgrowth', 'Not enough memory', '')
437	ALLOCATE (wsh (npts,nvm) , stat=ier)
438	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wsh', 'Not enough memory', '')
439	ALLOCATE (wshtot (npts,nvm) , stat=ier)
440	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtot', 'Not enough memory', '')
441	ALLOCATE (wshtotinit (npts,nvm) , stat=ier)
442	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotinit', 'Not enough memory', '')
443	ALLOCATE (wr (npts,nvm) , stat=ier)
444	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wr', 'Not enough memory', '')
445	ALLOCATE (wrtot (npts,nvm) , stat=ier)
446	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wrtot', 'Not enough memory', '')
447	ALLOCATE (wanimal (npts,nvm) , stat=ier)
448	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wanimal', 'Not enough memory', '')
449	ALLOCATE (ntot (npts,nvm) , stat=ier)
450	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'ntot', 'Not enough memory', '')
451	ALLOCATE (c (npts,nvm) , stat=ier)
452	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'c', 'Not enough memory', '')
453	ALLOCATE (n (npts,nvm) , stat=ier)
454	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'n', 'Not enough memory', '')
455	ALLOCATE (fn (npts,nvm) , stat=ier)
456	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fn', 'Not enough memory', '')
457	ALLOCATE (napo (npts,nvm) , stat=ier)
458	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'napo', 'Not enough memory', '')
459	ALLOCATE (nsym (npts,nvm) , stat=ier)
460	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsym', 'Not enough memory', '')
461	ALLOCATE (wnapo (npts,nvm) , stat=ier)
462	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wnapo', 'Not enough memory', '')
463	ALLOCATE (wnsym (npts,nvm) , stat=ier)
464	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wnsym', 'Not enough memory', '')
465	ALLOCATE (wn (npts,nvm) , stat=ier)
466	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wn', 'Not enough memory', '')
467	ALLOCATE (nanimal (npts,nvm,nstocking), stat=ier)
468	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nanimal', 'Not enough memory', '')
469	ALLOCATE (tanimal (npts,nvm,nstocking), stat=ier)
470	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tanimal', 'Not enough memory', '')
471	ALLOCATE (danimal (npts,nvm,nstocking), stat=ier)
472	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'danimal', 'Not enough memory', '')
473	ALLOCATE (tcut (npts,nvm,nstocking), stat=ier)
474	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut', 'Not enough memory', '')
475	ALLOCATE (tfert (npts,nvm,nstocking), stat=ier)
476	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert', 'Not enough memory', '')
477	ALLOCATE (Nliquidmanure (npts,nvm,nstocking), stat=ier)
478	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Nliquidmanure', 'Not enough memory', '')
479	ALLOCATE (nslurry (npts,nvm,nstocking), stat=ier)
480	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nslurry', 'Not enough memory', '')
481	ALLOCATE (Nsolidmanure (npts,nvm,nstocking), stat=ier)
482	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Nsolidmanure', 'Not enough memory', '')
483	ALLOCATE (legume_fraction (npts,nvm) , stat=ier)
484	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'legume_fraction', 'Not enough memory', '')
485	ALLOCATE (soil_fertility (npts,nvm) , stat=ier)
486	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'soil_fertility', 'Not enough memory', '')
487	ALLOCATE (Animalwgrazingmin (npts,nvm) , stat=ier)
488	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Animalwgrazingmin', 'Not enough memory', '')
489	ALLOCATE (AnimalkintakeM (npts,nvm) , stat=ier)
490	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AnimalkintakeM', 'Not enough memory', '')
491	ALLOCATE (AnimalDiscremineQualite (npts,nvm) , stat=ier)
492	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AnimalDiscremineQualite', 'Not enough memory', '')
493	ALLOCATE (controle_azote (npts,nvm,nstocking), stat=ier)
494	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote', 'Not enough memory', '')
495	ALLOCATE (fcOrganicFertmetabolicsum (npts,nvm) , stat=ier)
496	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertmetabolicsum', 'Not enough memory', '')
497	ALLOCATE (fcOrganicFertstructsum (npts,nvm) , stat=ier)
498	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertstructsum', 'Not enough memory', '')
499	ALLOCATE (fnOrganicFertmetabolicsum (npts,nvm) , stat=ier)
500	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertmetabolicsum', 'Not enough memory', '')
501	ALLOCATE (fnOrganicFertstructsum (npts,nvm) , stat=ier)
502	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertstructsum', 'Not enough memory', '')
503	ALLOCATE (fnOrganicFerturinesum (npts,nvm) , stat=ier)
504	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFerturinesum', 'Not enough memory', '')
505	ALLOCATE (fnatmsum (npts,nvm) , stat=ier)
506	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnatmsum', 'Not enough memory', '')
507	ALLOCATE (controle_azote_sum (npts,nvm) , stat=ier)
508	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote_sum', 'Not enough memory', '')
509	ALLOCATE (nfertamm (npts,nvm,nstocking), stat=ier)
510	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertamm', 'Not enough memory', '')
511	ALLOCATE (nfertnit (npts,nvm,nstocking), stat=ier)
512	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnit', 'Not enough memory', '')
513	ALLOCATE (intakesum (npts,nvm) , stat=ier)
514	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakesum', 'Not enough memory', '')
515	ALLOCATE (intakensum (npts,nvm) , stat=ier)
516	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakensum', 'Not enough memory', '')
517	ALLOCATE (intake_animal (npts,nvm) , stat=ier)
518	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animal', 'Not enough memory', '')
519	ALLOCATE (intake_animalsum (npts,nvm) , stat=ier)
520	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animalsum', 'Not enough memory', '')
521	ALLOCATE (PIYcow (npts,nvm,nstocking), stat=ier)
522	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PIYcow', 'Not enough memory', '')
523	ALLOCATE (PIMcow (npts,nvm,nstocking), stat=ier)
524	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PIMcow', 'Not enough memory', '')
525	ALLOCATE (BCSYcow (npts,nvm,nstocking), stat=ier)
526	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'BCSYcow', 'Not enough memory', '')
527	ALLOCATE (BCSMcow (npts,nvm,nstocking), stat=ier)
528	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'BCSMcow', 'Not enough memory', '')
529	ALLOCATE (PICcow (npts,nvm,nstocking), stat=ier)
530	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PICcow', 'Not enough memory', '')
531	ALLOCATE (AGE_cow_P (npts,nvm,nstocking), stat=ier)
532	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AGE_cow_P', 'Not enough memory', '')
533	ALLOCATE (AGE_cow_M (npts,nvm,nstocking), stat=ier)
534	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AGE_cow_M', 'Not enough memory', '')
535	ALLOCATE (Autogestion_out (npts,nvm,n_out) , stat=ier)
536	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Autogestion_out', 'Not enough memory', '')
537	ALLOCATE (Forage_quantity (npts,nvm,nstocking), stat=ier)
538	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Forage_quantity', 'Not enough memory', '')
539	ALLOCATE (tcut_modif (npts,nvm,nstocking), stat=ier)
540	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut_modif', 'Not enough memory', '')
541	ALLOCATE (countschedule (npts,nvm) , stat=ier)
542	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'countschedule', 'Not enough memory', '')
543	ALLOCATE (mux (npts,nvm) , stat=ier)
544	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'mux', 'Not enough memory', '')
545	ALLOCATE (mugmean (npts,nvm) , stat=ier)
546	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'mugmean', 'Not enough memory', '')
547	ALLOCATE (sigx (npts,nvm) , stat=ier)
548	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sigx', 'Not enough memory', '')
549	ALLOCATE (sigy (npts,nvm) , stat=ier)
550	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sigy', 'Not enough memory', '')
551	ALLOCATE (gmeanslope (npts,nvm) , stat=ier)
552	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gmeanslope', 'Not enough memory', '')
553	ALLOCATE (gzero (npts,nvm) , stat=ier)
554	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gzero', 'Not enough memory', '')
555	ALLOCATE (gcor (npts,nvm) , stat=ier)
556	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gcor', 'Not enough memory', '')
557	ALLOCATE (cuttingend (npts,nvm) , stat=ier)
558	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'cuttingend', 'Not enough memory', '')
559	ALLOCATE (tcut_verif (npts,nvm,nstocking), stat=ier)
560	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut_verif', 'Not enough memory', '')
561	ALLOCATE (tfert_verif (npts,nvm,nstocking), stat=ier)
562	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif', 'Not enough memory', '')
563	ALLOCATE (tfert_verif2 (npts,nvm,nstocking), stat=ier)
564	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif2', 'Not enough memory', '')
565	ALLOCATE (tfert_verif3 (npts,nvm,nstocking), stat=ier)
566	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif3', 'Not enough memory', '')
567	ALLOCATE (regcount (npts,nvm) , stat=ier)
568	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'regcount', 'Not enough memory', '')
569	ALLOCATE (wshcutinit (npts,nvm) , stat=ier)
570	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshcutinit', 'Not enough memory', '')
571	ALLOCATE (gmean (npts,nvm,ngmean) , stat=ier)
572	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gmean', 'Not enough memory', '')
573	ALLOCATE (tgmean (npts,nvm,ngmean) , stat=ier)
574	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tgmean', 'Not enough memory', '')
575	ALLOCATE (wc_frac (npts,nvm) , stat=ier)
576	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wc_frac', 'Not enough memory', '')
577	ALLOCATE (wgn (npts,nvm) , stat=ier)
578	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wgn', 'Not enough memory', '')
579	ALLOCATE (tasum (npts,nvm) , stat=ier)
580	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tasum', 'Not enough memory', '')
581	ALLOCATE (loss (npts,nvm) , stat=ier)
582	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'loss', 'Not enough memory', '')
583	ALLOCATE (lossc (npts,nvm) , stat=ier)
584	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lossc', 'Not enough memory', '')
585	ALLOCATE (lossn (npts,nvm) , stat=ier)
586	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lossn', 'Not enough memory', '')
587	ALLOCATE (tlossstart (npts,nvm) , stat=ier)
588	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tlossstart', 'Not enough memory', '')
589	ALLOCATE (flag_fertilisation (npts,nvm) , stat=ier)
590	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'flag_fertilisation', 'Not enough memory', '')
591	ALLOCATE (fertcount (npts,nvm) , stat=ier)
592	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount', 'Not enough memory', '')
593	ALLOCATE (c2nratiostruct (npts,nvm) , stat=ier)
594	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'c2nratiostruct', 'Not enough memory', '')
595	ALLOCATE (nfertammtot (npts,nvm) , stat=ier)
596	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtot', 'Not enough memory', '')
597	ALLOCATE (nfertnittot (npts,nvm) , stat=ier)
598	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittot', 'Not enough memory', '')
599	ALLOCATE (nfertammtotyear (npts,nvm) , stat=ier)
600	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtotyear', 'Not enough memory', '')
601	ALLOCATE (nfertnittotyear (npts,nvm) , stat=ier)
602	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittotyear', 'Not enough memory', '')
603	ALLOCATE (nfertammtotprevyear (npts,nvm) , stat=ier)
604	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtotprevyear', 'Not enough memory', '')
605	ALLOCATE (nfertnittotprevyear (npts,nvm) , stat=ier)
606	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittotprevyear', 'Not enough memory', '')
607	ALLOCATE (fcOrganicFertmetabolic (npts,nvm) , stat=ier)
608	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertmetabolic', 'Not enough memory', '')
609	ALLOCATE (fcOrganicFertstruct (npts,nvm) , stat=ier)
610	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertstruct', 'Not enough memory', '')
611	ALLOCATE (fnOrganicFerturine (npts,nvm) , stat=ier)
612	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFerturine', 'Not enough memory', '')
613	ALLOCATE (fnOrganicFertstruct (npts,nvm) , stat=ier)
614	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertstruct', 'Not enough memory', '')
615	ALLOCATE (fnOrganicFertmetabolic (npts,nvm) , stat=ier)
616	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertmetabolic', 'Not enough memory', '')
617	ALLOCATE (nsatur_somerror_temp (npts,nvm) , stat=ier)
618	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsatur_somerror_temp', 'Not enough memory', '')
619	ALLOCATE (nsatur_somerror (npts,nvm) , stat=ier)
620	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsatur_somerror', 'Not enough memory', '')
621	ALLOCATE (tfert_modif (npts,nvm,nstocking), stat=ier)
622	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_modif', 'Not enough memory', '')
623	ALLOCATE (nnonlimit_SOMerror (npts,nvm) , stat=ier)
624	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nnonlimit_SOMerror', 'Not enough memory', '')
625	ALLOCATE (nnonlimit_SOMerrormax (npts,nvm) , stat=ier)
626	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nnonlimit_SOMerrormax', 'Not enough memory', '')
627	ALLOCATE (controle_azote_sum_mem (npts,nvm) , stat=ier)
628	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote_sum_mem', 'Not enough memory', '')
629	ALLOCATE (n_auto (npts,nvm) , stat=ier)
630	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'n_auto', 'Not enough memory', '')
631	ALLOCATE (stoplimitant (npts,nvm) , stat=ier)
632	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'stoplimitant', 'Not enough memory', '')
633	ALLOCATE (fertcount_start (npts,nvm) , stat=ier)
634	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount_start', 'Not enough memory', '')
635	ALLOCATE (fertcount_current (npts,nvm) , stat=ier)
636	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount_current', 'Not enough memory', '')
637	ALLOCATE (wshtotsumprev (npts,nvm) , stat=ier)
638	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotsumprev', 'Not enough memory', '')
639	ALLOCATE (fertil_year (npts,nvm) , stat=ier)
640	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertil_year', 'Not enough memory', '')
641	ALLOCATE (toto (npts) , stat=ier)
642	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'toto', 'Not enough memory', '')
643	ALLOCATE (apport_azote (npts,nvm) , stat=ier)
644	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'apport_azote', 'Not enough memory', '')
645	ALLOCATE (trampling (npts,nvm) , stat=ier)
646	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'trampling', 'Not enough memory', '')
647	ALLOCATE (wshtotsumprevyear (npts,nvm) , stat=ier)
648	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotsumprevyear', 'Not enough memory', '')
649	ALLOCATE(file_management (nvm) , stat=ier)
650	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'file_management', 'Not enough memory', '')
651	ALLOCATE (tmp_sr_ugb_C3 (npts) , stat=ier)
652	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_sr_ugb_C3', 'Not enough memory', '')
653	ALLOCATE (tmp_nb_ani_C3 (npts) , stat=ier)
654	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_nb_ani_C3', 'Not enough memory', '')
655	ALLOCATE (tmp_grazed_frac_C3 (npts) , stat=ier)
656	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_grazed_frac_C3', 'Not enough memory', '')
657	ALLOCATE (tmp_import_yield_C3 (npts) , stat=ier)
658	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_import_yield_C3', 'Not enough memory', '')
659	ALLOCATE (tmp_wshtotsum_C3 (npts) , stat=ier)
660	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_wshtotsum_C3', 'Not enough memory', '')
661	ALLOCATE (tmp_sr_ugb_C4 (npts) , stat=ier)
662	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_sr_ugb_C4', 'Not enough memory', '')
663	ALLOCATE (tmp_nb_ani_C4 (npts) , stat=ier)
664	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_nb_ani_C4', 'Not enough memory', '')
665	ALLOCATE (tmp_grazed_frac_C4 (npts) , stat=ier)
666	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_grazed_frac_C4', 'Not enough memory', '')
667	ALLOCATE (tmp_import_yield_C4 (npts) , stat=ier)
668	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_import_yield_C4', 'Not enough memory', '')
669	ALLOCATE (tmp_wshtotsum_C4 (npts) , stat=ier)
670	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_wshtotsum_C4', 'Not enough memory', '')
671	ALLOCATE (DM_cutyearly (npts,nvm) , stat=ier)
672	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'DM_cutyearly', 'Not enough memory', '')
673	ALLOCATE (C_cutyearly (npts,nvm) , stat=ier)
674	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'C_cutyearly', 'Not enough memory', '')
675	ALLOCATE (YIELD_RETURN (npts,nvm) , stat=ier)
676	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'YIELD_RETURN', 'Not enough memory', '')
677	ALLOCATE (sr_ugb_init (npts) , stat=ier)
678	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sr_ugb_init', 'Not enough memory', '')
679	ALLOCATE (N_fert_total (npts,nvm) , stat=ier)
680	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'N_fert_total', 'Not enough memory', '')
681	ALLOCATE (ndeposition (npts,nvm) , stat=ier)
682	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'ndeposition', 'Not enough memory', '')
683	ALLOCATE (compt_cut (npts,nvm) , stat=ier)
684	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'compt_cut', 'Not enough memory', '')
685	ALLOCATE (frequency_cut (npts,nvm) , stat=ier)
686	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'frequency_cut', 'Not enough memory', '')
687	ALLOCATE (sr_wild (npts,nvm) , stat=ier)
688	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sr_wild', 'Not enough memory', '')
689	ALLOCATE (flag_cutting (npts,nvm) , stat=ier)
690	IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'flag_cutting', 'Not enough memory', '')
691
692	! from applic_plant
693	ALLOCATE (tamean1 (npts), stat=ier)
694	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean1', 'Not enough memory', '')
695	ALLOCATE (tamean2 (npts), stat=ier)
696	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean2', 'Not enough memory', '')
697	ALLOCATE (tamean3 (npts), stat=ier)
698	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean3', 'Not enough memory', '')
699	ALLOCATE (tamean4 (npts), stat=ier)
700	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean4', 'Not enough memory', '')
701	ALLOCATE (tamean5 (npts), stat=ier)
702	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean5', 'Not enough memory', '')
703	ALLOCATE (tamean6 (npts), stat=ier)
704	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean6', 'Not enough memory', '')
705	ALLOCATE (tameand (npts), stat=ier)
706	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tameand', 'Not enough memory', '')
707	ALLOCATE (tameanw (npts), stat=ier)
708	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tameanw', 'Not enough memory', '')
709	ALLOCATE (tacumm (npts), stat=ier)
710	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tacumm', 'Not enough memory', '')
711	ALLOCATE (tacummprev (npts), stat=ier)
712	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tacummprev', 'Not enough memory', '')
713	ALLOCATE (tsoilcumm (npts), stat=ier)
714	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilcumm', 'Not enough memory', '')
715	ALLOCATE (tsoilcummprev (npts), stat=ier)
716	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilcummprev', 'Not enough memory', '')
717	ALLOCATE (tsoilmeand (npts), stat=ier)
718	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilmeand', 'Not enough memory', '')
719	ALLOCATE (tcut0 (npts,nvm), stat=ier)
720	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tcut0', 'Not enough memory', '')
721	ALLOCATE (Fert_sn (npts,nvm), stat=ier)
722	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_sn', 'Not enough memory', '')
723	ALLOCATE (Fert_on (npts,nvm), stat=ier)
724	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_on', 'Not enough memory', '')
725	ALLOCATE (Fert_PRP (npts,nvm), stat=ier)
726	IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_PRP', 'Not enough memory', '')
727
728	! 1.2 set flags and variables need to read in Pasim
729
730	! saturant N supply
731	f_saturant = 0
732	CALL getin_p('GRM_F_SATURANT',f_saturant)
733	! N fertilization without limitation
734	f_nonlimitant = 0
735	CALL getin_p('GRM_F_NONLIMITANT',f_nonlimitant)
736	! f_autogestion = 1-5
737	! 1: auto cut for PFT m_auto
738	! 2: auto graze for PFT m_auto
739	! 3: auto cut and graze for PFT m_cut and m_grazed with increasing sr_ugb
740	! 4: auto cut and graze for PFT m_cut and m_grazed with constant sr_ugb
741	! 5: auto graze for PFT m_grazed with grazing litter during winter for LGM period
742	f_autogestion = 0
743	CALL getin_p('GRM_F_AUTOGESTION',f_autogestion)
744	WRITE(numout,*) 'GRM_F_AUTOGESTION',f_autogestion
745	! whether animal is fed by extra feedstuffs
746	f_complementation = 0
747	CALL getin_p('GRM_F_COMPLEMENTATION',f_complementation)
748	! whether apply fertilizer
749	f_fertilization = 1
750	CALL getin_p('GRM_F_FERTILIZATION',f_fertilization)
751	! JCCOMMENT 10April2015 already set and read at src_parameter
752	! ! number of management year cycled
753	! nb_year_management(:) = 0
754	! CALL getin_p('NB_YEAR_MANAGEMENT',nb_year_management)
755	! WRITE(numout,*) 'NB_YEAR_MANAGEMENT',nb_year_management
756	! f_postauto = 0-5
757	! 1: after f_autogestion=2 with varied sr_ugb and nb_ani
758	! 2: after f_postauto=1 with varied sr_ugb and nb_ani
759	! 3: simulation with constant sr_ugb and grazed_frac
760	! 4: simulation with increasing sr_ugb and constant grazed_frac
761	! 5: global simulation with prescribed sr_ugb from external file
762	f_postauto = 0
763	CALL getin_p('GRM_F_POSTAUTO',f_postauto)
764	WRITE(numout,*) 'GRM_F_POSTAUTO',f_postauto
765	! the maximum impact to vcmax due to N fertilization
766	! N_effect =0.0 - 1.0
767	N_effect=0.6
768	CALL getin_p('N_EFFECT',N_effect)
769	IF (N_effect .LT. 0.0 .OR. N_effect .GT. 1.0) THEN
770	N_effect =0.6
771	ENDIF
772
773	! 1.3 READ INITIAL CONDITION FILE FOR OLD/NEW ANIMAL MODULE
774
775	file_param_init='/home/orchidee_ns/lhli/Modele_ORCHIDEE/Management/param_init.txt'
776
777	CALL getin_p('FILE_PARAM_INIT',file_param_init)
778	WRITE (numout,*) 'FILE_PARAM_INIT',file_param_init
779	OPEN(unit=61, file = file_param_init)
780
781	READ(61, *, iostat = ier) toto(:)
782	READ(61, *, iostat = ier) (wshtotcutinit_t(h), h=1,ncut)
783	READ(61, *, iostat = ier) toto(:)
784	READ(61, *, iostat = ier) toto(:)
785	READ(61, *, iostat = ier) toto(:)
786
787	READ(61, *, iostat = ier) toto(:)
788	READ(61, *, iostat = ier) toto(:)
789	READ(61, *, iostat = ier) toto(:)
790	READ(61, *, iostat = ier) toto(:)
791	READ(61, *, iostat = ier) toto(:)
792
793	READ(61, *, iostat = ier) toto(:)
794	READ(61, *, iostat = ier) toto(:)
795	READ(61, *, iostat = ier) toto(:)
796	READ(61, *, iostat = ier) toto(:)
797	READ(61, *, iostat = ier) toto(:)
798
799	READ(61, *, iostat = ier) toto(:)
800	READ(61, *, iostat = ier) toto(:)
801	READ(61, *, iostat = ier) toto(:)
802	READ(61, *, iostat = ier) toto(:)
803	READ(61, *, iostat = ier) toto(:)
804
805	READ(61, *, iostat = ier) toto(:)
806	READ(61, *, iostat = ier) toto(:)
807	READ(61, *, iostat = ier) toto(:)
808	READ(61, *, iostat = ier) toto(:)
809	READ(61, *, iostat = ier) toto(:)
810
811	READ(61, *, iostat = ier) toto(:)
812	READ(61, *, iostat = ier) toto(:)
813	READ(61, *, iostat = ier) toto(:)
814	READ(61, *, iostat = ier) tcutmodel
815	READ(61, *, iostat = ier) intakemax_t
816
817	READ(61, *, iostat = ier) wanimal_t
818	READ(61, *, iostat = ier) Type_animal
819	READ(61, *, iostat = ier) toto(:)
820	READ(61, *, iostat = ier) toto(:)
821	READ(61, *, iostat = ier) toto(:)
822
823	READ(61, *, iostat = ier) toto(:)
824	READ(61, *, iostat = ier) toto(:)
825	READ(61, *, iostat = ier) toto(:)
826	READ(61, *, iostat = ier) toto(:)
827	READ(61, *, iostat = ier) toto(:)
828
829	READ(61, *, iostat = ier) toto(:)
830	READ(61, *, iostat = ier) toto(:)
831	READ(61, *, iostat = ier) toto(:)
832	READ(61, *, iostat = ier) toto(:)
833	READ(61, *, iostat = ier) toto(:)
834
835	READ(61, *, iostat = ier) toto(:)
836	READ(61, *, iostat = ier) toto(:)
837
838	intakemax(:,:)=intakemax_t
839	wanimal(:,:)=wanimal_t
840	DO h=1,ncut
841	wshtotcutinit(:,:,h)=wshtotcutinit_t(h)
842	END DO
843	CLOSE (61)
844	WRITE(numout,*) 'Animal type',Type_Animal
845
846	! 1.4 set constantes and initialise variables allocated above
847
848	! 1.4.1 initialisation the variables lied on animals cattle or sheep ?
849	! Type_Animal = 1,2,3 : Dairy cows, suckler cows, cows in old module
850	! Type_Animal = 4,5 : Dairy heifers, suckler heifers
851	! Type_Animal = 6 : sheep in old module
852	IF (Type_Animal==3) THEN ! old module
853	!090810 AIG changement du seuil de sortie des animaux Animalwgrazingmin trop faible
854	! changement de AnimalkintakeM pour garder que l'ingere garde la meme pente
855	! en fonction de la biomasse disponible et pour eviter un artefact de calcul
856	! Animalwgrazingmin = 0.03 ! Threshold shoot dry matter, under which animals are moved out for old module (kg.m-2)
857	Animalwgrazingmin(:,:) = 0.03 ! N. Vuichard
858	!AnimalkintakeM = 0.18 ! AI Graux
859	AnimalkintakeM(:,:) = 0.1 ! N. Vuichard
860	AnimalDiscremineQualite(:,:) = 2 ! AI Graux
861	ELSEIF (Type_Animal .EQ. 6)THEN ! Sheep
862	Animalwgrazingmin(:,:) = 0.015
863	AnimalkintakeM(:,:) = 0.045
864	AnimalDiscremineQualite(:,:) = 3
865	ELSE !new module
866	!Animalwgrazingmin = 0.11 ! AI Graux ! unsued in the new module
867	!AnimalkintakeM = 0.18 ! AI Graux ! unsued in the new module
868	AnimalDiscremineQualite(:,:) = 2 ! AI Graux
869	ENDIF ! Type_Animal
870
871	! 1.4.2 concentrations : mean value
872	c(:,:) = 0.0365122 ! 4.22e-02
873	n(:,:) = 0.00732556 ! 8.17e-03
874	napo(:,:) = 0.000542054 ! 6.39e-04
875	nsym(:,:) = 0.0108071 ! 6.15e-03
876	fn(:,:) = 0.0316223 ! 4.15e-02 ! 2.64e-02
877	ntot(:,:) = 0.03471895 ! 2.89e-02
878
879	! 1.4.3 initialisations of variables allocated above
880	intake(:,:) = 0.0
881	intake_litter(:,:) = 0.0
882	intake_animal_litter(:,:) = 0.0
883	grazing_litter(:,:) = 2
884	litter_avail_totDM(:,:) = 0.0
885	devstage(:,:) = 0.0
886	faecesc(:,:) = 0.0
887	faecesn(:,:) = 0.0
888	urinen(:,:) = 0.0
889	urinec(:,:) = 0.0
890	nel(:,:) = 0.0
891	nanimaltot(:,:) = 0.0
892	!grazingcstruct(:,:) = 0.0
893	!grazingnstruct(:,:) = 0.0
894	tgrowth(:,:) = 0.0
895	wshtot(:,:) = (biomass(:,:,ileaf,icarbon) + biomass(:,:,isapabove,icarbon) + &
896	& biomass(:,:,ifruit,icarbon))/(1000*CtoDM) ! Unit: kgDM/m2
897	wsh(:,:) = wshtot(:,:) / (1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
898	wshtotinit(:,:) = wshtot(:,:)
899	wrtot(:,:) = (biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon))/ &
900	& (1000*CtoDM) ! Unit: kg/m2
901	wr(:,:) = wrtot(:,:) / (1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
902	wnapo(:,:) = 0.0
903	wnsym(:,:) = 0.0
904	mux(:,:) = 0.0
905	mugmean(:,:) = 0.0
906	sigx(:,:) = 0.0
907	sigy(:,:) = 0.0
908	gmeanslope(:,:) = 0.0
909	gzero(:,:) = 0.0
910	gcor(:,:) = 0.0
911	countschedule(:,:) = 0
912	cuttingend(:,:) = 0
913	regcount(:,:) = 1
914	gmean(:,:,:) = 0.0
915	tgmean(:,:,:) = 0.0
916	wc_frac(:,:) = 0.0
917	wgn(:,:) = 0.0
918	tasum(:,:) = 0.0
919	loss(:,:) = 0.0
920	lossc(:,:) = 0.0
921	lossn(:,:) = 0.0
922	tlossstart(:,:) = 0.0
923	wshcutinit(:,:) = 0.0
924	deltat = dt
925	fertcount(:,:) = 0.0
926	c2nratiostruct(:,:) = 150.0
927	nfertammtot(:,:) = 0.0
928	nfertnittot(:,:) = 0.0
929	nfertammtotyear(:,:) = 0.0
930	nfertnittotyear(:,:) = 0.0
931	nfertammtotprevyear(:,:) = 0.0
932	nfertnittotprevyear(:,:) = 0.0
933	fcOrganicFertmetabolic(:,:) = 0.0
934	fcOrganicFertstruct(:,:) = 0.0
935	fnOrganicFertmetabolic(:,:) = 0.0
936	fnOrganicFertstruct(:,:) = 0.0
937	fnOrganicFerturine(:,:) = 0.0
938	flag_fertilisation(:,:) = 0
939	fertil_year(:,:) = .TRUE.
940	tcut_verif(:,:,:) = .FALSE.
941	tfert_verif(:,:,:) = .FALSE.
942	tfert_verif2(:,:,:) = .FALSE.
943	tfert_verif3(:,:,:) = .FALSE.
944	nsatur_somerror_temp(:,:) = 0.0
945	nsatur_somerror(:,:) = 0.0
946	stoplimitant(:,:) = 0
947	fertcount_start(:,:) = 0
948	fertcount_current(:,:) = 0
949	nnonlimit_SOMerror(:,:) = 0.0
950	nnonlimit_SOMerrormax(:,:) = 0.5
951	controle_azote_sum_mem(:,:) = 0.0
952	n_auto(:,:) = 4
953	flag_fertilisation(:,:) = 0
954	YIELD_RETURN(:,:) = 0.0
955	sr_ugb_init(:) = 0.0
956	compt_cut(:,:) =0.0
957	frequency_cut(:,:) =0.0
958	sr_wild(:,:) = 0.0
959	flag_cutting(:,:) = 0
960	tamean1(:) = 273.0
961	tamean2(:) = 273.0
962	tamean3(:) = 273.0
963	tamean4(:) = 273.0
964	tamean5(:) = 273.0
965	tamean6(:) = 273.0
966	tameand(:) = 273.0
967	tameanw(:) = 0.0
968	tacumm(:) = 0.0
969	tacummprev(:) = 0.0
970	tsoilcumm(:) = 0.0
971	tsoilcummprev(:) = 0.0
972	tsoilmeand(:) = 273.0
973	tcut0(:,:) = 0.0
974	N_fert_total(:,:) = 0.0
975	Fert_on(:,:) = 0.0
976	Fert_sn(:,:) = 0.0
977	Fert_PRP(:,:) = 0.0
978	! 1.5 Define PFT that used for optimization, cutting, and grazing
979	DO j=2,nvm
980	IF (is_grassland_cut(j) .AND. (.NOT. is_grassland_grazed(j)) .AND. &
981	(.NOT. is_c4(j)) .AND. (.NOT.is_tree(j))) THEN
982	mcut_C3=j
983	END IF
984	IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. &
985	(.NOT.is_grassland_grazed(j)) .AND. (.NOT. is_c4(j)) .AND. &
986	(.NOT. is_tree(j))) THEN
987	mauto_C3=j
988	END IF
989	IF (is_grassland_manag(j) .AND. (is_grassland_grazed(j)) .AND. &
990	(.NOT. is_grassland_cut(j)) .AND. (.NOT. is_c4(j)) .AND. &
991	(.NOT. is_tree(j))) THEN
992	mgraze_C3=j
993	END IF
994	IF (is_grassland_cut(j) .AND. (.NOT. is_grassland_grazed(j)) .AND. &
995	(is_c4(j)) .AND. (.NOT. is_tree(j))) THEN
996	mcut_C4=j
997	END IF
998	IF ( is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. &
999	(.NOT. is_grassland_grazed(j)) .AND. (is_c4(j)) .AND. &
1000	(.NOT. is_tree(j))) THEN
1001	mauto_C4=j
1002	END IF
1003	IF ( is_grassland_manag(j) .AND. (is_grassland_grazed(j)) .AND. &
1004	(.NOT. is_grassland_cut(j)) .AND. (is_c4(j)) .AND. &
1005	(.NOT. is_tree(j))) THEN
1006	mgraze_C4=j
1007	END IF
1008	IF ((.NOT. is_grassland_manag(j)) .AND. (.NOT. is_grassland_grazed(j)) .AND. &
1009	(.NOT. is_grassland_cut(j)) .AND. (.NOT. is_c4(j)) .AND. &
1010	(.NOT. is_tree(j)) .AND. natural(j)) THEN
1011	mnatural_C3=j
1012	END IF
1013	IF ((.NOT. is_grassland_manag(j)) .AND. (.NOT. is_grassland_grazed(j)).AND. &
1014	(.NOT. is_grassland_cut(j)) .AND. (is_c4(j)) .AND. &
1015	(.NOT. is_tree(j)) .AND. natural(j)) THEN
1016	mnatural_C4=j
1017	END IF
1018	END DO ! nvm
1019	!WRITE(numout,*) 'PFT_M',mauto_C3,mcut_C3,mgraze_C3,mauto_C4,mcut_C4,mgraze_C4,mnatural_C3,mnatural_C4
1020	! avoid PFT = 0
1021	IF (mauto_C4 .EQ. 0) THEN
1022	mauto_C4=1
1023	ENDIF
1024	IF (mcut_C4 .EQ. 0) THEN
1025	mcut_C4=1
1026	ENDIF
1027	IF (mgraze_C4 .EQ. 0) THEN
1028	mgraze_C4=1
1029	ENDIF
1030	IF (mauto_C3 .EQ. 0) THEN
1031	mauto_C3=1
1032	ENDIF
1033	IF (mcut_C3 .EQ. 0) THEN
1034	mcut_C3=1
1035	ENDIF
1036	IF (mgraze_C3 .EQ. 0) THEN
1037	mgraze_C3=1
1038	ENDIF
1039	IF (mnatural_C4 .EQ. 0) THEN
1040	mnatural_C4=1
1041	ENDIF
1042	IF (mnatural_C3 .EQ. 0) THEN
1043	mnatural_C3=1
1044	ENDIF
1045	WRITE(numout,*) 'PFT_M2',mauto_C3,mcut_C3,mgraze_C3,mauto_C4,mcut_C4,mgraze_C4,mnatural_C3,mnatural_C4
1046
1047	! 1.6 Initialization of management related parameters
1048	! for each management option
1049	IF (f_postauto .EQ. 0) THEN
1050	IF (f_autogestion .EQ. 1) THEN
1051	! 1: auto cut for PFT m_auto
1052	! keep wshtotsum for mauto_C3 and C4
1053	sr_ugb = 1e-5
1054	compt_ugb = 0.0
1055	nb_ani = 5e-6
1056	grazed_frac = 0.50
1057	ELSE IF (f_autogestion .EQ. 2) THEN
1058	! 2: auto graze for PFT m_auto
1059	! keep wshtotsum for each year calculation of import_yield
1060	CALL getin_p('NB_CUT_YEAR',cut_year)
1061	WHERE ( wshtotsum(:,mauto_C3) .GE. 0.0)
1062	import_yield(:,mauto_C3) = wshtotsum(:,mauto_C3) / cut_year
1063	ENDWHERE
1064	WHERE ( wshtotsum(:,mauto_C4) .GE. 0.0)
1065	import_yield(:,mauto_C4) = wshtotsum(:,mauto_C4) / cut_year
1066	ENDWHERE
1067	! keep sr_ugb, compt_ugb, nb_ani, grazed_frac
1068	! infact it could be keep just the value read from restart
1069	compt_ugb = 0.0
1070	ELSE IF ((f_autogestion .GE. 3) .AND. &
1071	(f_autogestion .LE. 5)) THEN
1072	! 3: auto cut and graze for PFT m_cut and m_grazed with increasing sr_ugb
1073	! 4: auto cut and graze for PFT m_cut and m_grazed with constant sr_ugb
1074	! 5: auto graze for PFT m_grazed with grazing litter during winter for LGM
1075	! keep the grazing variables from restart
1076	compt_ugb = 0.0
1077	wshtotsum (:,:) = 0.0
1078	import_yield (:,:) = 0.0
1079	ELSE ! f_postauto = 0 and f_autogestion > 5
1080	sr_ugb = 1e-5
1081	compt_ugb = 0.0
1082	nb_ani = 5e-6
1083	grazed_frac = 0.50
1084	wshtotsum (:,:) = 0.0
1085	import_yield (:,:) = 0.0
1086	ENDIF ! f_autogestion
1087	ELSE IF (f_postauto .EQ. 1) THEN
1088	! 1: after f_autogestion=2 with varied sr_ugb and nb_ani
1089	! ONLY run for one years
1090	tmp_sr_ugb_C3(:)=sr_ugb(:,mauto_C3)
1091	tmp_sr_ugb_C4(:)=sr_ugb(:,mauto_C4)
1092	sr_ugb = 1e-5
1093	sr_ugb(:,mgraze_C3) = tmp_sr_ugb_C3(:)
1094	sr_ugb(:,mgraze_C4) = tmp_sr_ugb_C4(:)
1095	tmp_nb_ani_C3(:)=nb_ani(:,mauto_C3)
1096	tmp_nb_ani_C4(:)=nb_ani(:,mauto_C4)
1097	nb_ani = 5e-6
1098	nb_ani(:,mgraze_C3) = tmp_nb_ani_C3(:)
1099	nb_ani(:,mgraze_C4) = tmp_nb_ani_C4(:)
1100	tmp_grazed_frac_C3(:)=grazed_frac(:,mauto_C3)
1101	tmp_grazed_frac_C4(:)=grazed_frac(:,mauto_C4)
1102	grazed_frac = 0.50
1103	grazed_frac(:,mgraze_C3) = tmp_grazed_frac_C3(:)
1104	grazed_frac(:,mgraze_C4) = tmp_grazed_frac_C4(:)
1105	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0)
1106	grazed_frac(:,mgraze_C3) = nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
1107	ELSEWHERE
1108	grazed_frac(:,mgraze_C3) = tmp_grazed_frac_C3(:)
1109	ENDWHERE
1110	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0)
1111	grazed_frac(:,mgraze_C4) = nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
1112	ELSEWHERE
1113	grazed_frac(:,mgraze_C4) = tmp_grazed_frac_C4(:)
1114	ENDWHERE
1115	compt_ugb = 0.0
1116	wshtotsum (:,:) = 0.0
1117	tmp_import_yield_C3(:) = import_yield(:,mauto_C3)
1118	tmp_import_yield_C4(:) = import_yield(:,mauto_C4)
1119	import_yield = 0.0
1120	import_yield (:,mgraze_C3) = tmp_import_yield_C3(:)
1121	import_yield (:,mgraze_C4) = tmp_import_yield_C4(:)
1122	ELSE IF (f_postauto .GE. 2) THEN
1123	! 2: after f_postauto=1 with varied sr_ugb and nb_ani
1124	! 3: simulation with constant sr_ugb and grazed_frac
1125	! 4: simulation with increasing sr_ugb and constant grazed_frac
1126	! 5: global simulation with prescribed sr_ugb from external file
1127	! keep the grazing variables from restart
1128	compt_ugb = 0.0
1129	wshtotsum (:,:) = 0.0
1130	! keep import_yield from restart for mean value saving
1131	! import_yield = 0.0
1132	ELSE
1133	sr_ugb = 1e-5
1134	compt_ugb = 0.0
1135	nb_ani = 5e-6
1136	grazed_frac = 0.50
1137	compt_ugb = 0.0
1138	wshtotsum (:,:) = 0.0
1139	import_yield = 0.0
1140	ENDIF ! f_autogestion or f_postauto
1141
1142	wshtotsumprevyear(:,:) = 0.0
1143	DM_cutyearly(:,:)=0.0
1144	C_cutyearly(:,:) =0.0
1145	wshtotsumprev (:,:) = 0.0
1146	controle_azote(:,:,:) = 0.0
1147	controle_azote_sum(:,:) = 0.0
1148	trampling(:,:) = 0.0
1149	count_year = 1
1150	year_count1 = 0
1151	year_count2 = 0
1152	tcut(:,:,:) = 500.0
1153	tfert(:,:,:) = 500.0
1154	nfertamm(:,:,:) = 0.0
1155	nfertnit(:,:,:) = 0.0
1156	nanimal(:,:,:) = 0.0
1157	tanimal(:,:,:) = 500.0
1158	danimal(:,:,:) = 0.0
1159	nliquidmanure(:,:,:) = 0.0
1160	nslurry(:,:,:) = 0.0
1161	nsolidmanure(:,:,:) = 0.0
1162	legume_fraction(:,:) =0.0
1163	soil_fertility(:,:) = 1.0
1164	ndeposition(:,:) = 0.0
1165	PIYcow(:,:,:) = 0.0
1166	PIMcow(:,:,:) = 0.0
1167	BCSYcow(:,:,:) = 0.0
1168	BCSMcow(:,:,:) = 0.0
1169	PICcow(:,:,:) = 0.0
1170	AGE_cow_P(:,:,:) = 36.0
1171	AGE_cow_M(:,:,:) = 54.0
1172	Forage_quantity(:,:,:) = 0
1173
1174	IF (blabla_pasim) PRINT *, 'PASIM : end memory allocation'
1175
1176	! 1.7 read management maps/files
1177	! get_map of 1 spatial .nc file or 0 old txt/dat file
1178	CALL getin_p ('GRM_F_MANAGEMENT_MAP',f_management_map)
1179	WRITE(numout,*) 'GRM_F_MANAGEMENT_MAP',f_management_map
1180	CALL getin_p ('GRM_F_DEPOSITION_MAP',f_deposition_map)
1181	WRITE(numout,*) 'GRM_F_DEPOSITION_MAP',f_deposition_map
1182	CALL getin_p ('GRM_F_GRAZING_MAP',f_grazing_map)
1183	WRITE(numout,*) 'GRM_F_GRAZING_MAP',f_grazing_map
1184
1185	IF (f_management_map) THEN
1186	management_map='/ccc/work/cont003/dsm/p529chan/data/eur_management_interpolated.nc'
1187	CALL getin_p('GRM_MANAGEMENT_MAP',management_map)
1188	WRITE(numout,*) 'GRM_MANAGEMENT_MAP',management_map
1189	fertility_map='/ccc/work/cont003/dsm/p529chan/data/eur_fertility.nc'
1190	CALL getin_p('GRM_FERTILITY_MAP',fertility_map)
1191	WRITE(numout,*) 'GRM_FERTILITY_MAP',fertility_map
1192
1193	deposition_map='/ccc/work/cont003/dsm/p529chan/data/eur_Ndeposition_NCAR.nc'
1194	CALL getin_p('GRM_DEPOSITION_MAP',deposition_map)
1195	WRITE(numout,*) 'GRM_DEPOSITION_MAP',deposition_map
1196	grazing_map='/ccc/scratch/cont003/dsm/p529chan/glbdata/glb_sr_ugb_1961_2010_adjusted.nc'
1197	CALL getin_p('GRM_GRAZING_MAP',grazing_map)
1198	WRITE(numout,*) 'GRM_GRAZING_MAP',grazing_map
1199
1200	! read management map
1201	CALL reading_map_manag(&
1202	npts,lalo, neighbours, resolution, contfrac, &
1203	count_year, nb_year_management,&
1204	management_intensity,&
1205	management_start,&
1206	tcut, tfert, nfertamm, nfertnit,&
1207	nanimal, tanimal, danimal,&
1208	nliquidmanure, nslurry, nsolidmanure,&
1209	legume_fraction,soil_fertility,&
1210	deposition_start,ndeposition,sr_ugb,sr_wild)
1211	! calculate effect of N fertilizer to vcmax
1212	CALL calc_N_limfert(&
1213	npts,nfertamm, nfertnit,&
1214	nliquidmanure, nslurry, nsolidmanure,&
1215	legume_fraction,soil_fertility,ndeposition,&
1216	N_fert_total,N_limfert)
1217	ELSE
1218	! re-initial management variables
1219	tcut(:,:,:) = 500.0
1220	tfert(:,:,:) = 500.0
1221	nfertamm(:,:,:) = 0.0
1222	nfertnit(:,:,:) = 0.0
1223	nanimal(:,:,:) = 0.0
1224	tanimal(:,:,:) = 500.0
1225	danimal(:,:,:) = 0.0
1226	nliquidmanure(:,:,:) = 0.0
1227	nslurry(:,:,:) = 0.0
1228	nsolidmanure(:,:,:) = 0.0
1229	ndeposition(:,:) = 0.0
1230	!! delete FIRE_MANAGEMENT READ: not used in LGM
1231	CALL getin_p('FILE_MANAGEMENT',file_management)
1232	WRITE(numout,*) 'FILE_MANAGEMENT',file_management
1233	IF (blabla_pasim) PRINT *, 'PASIM : reading management conditions'
1234	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1235	!!!!!!!!! READ NEW MANAGEMENT TXT DAT FILE JCADD
1236	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1237	CALL reading_new_animal(&
1238	npts , &
1239	nb_year_management , &
1240	tcutmodel , &
1241	tcut , &
1242	tfert , &
1243	nfertamm , &
1244	nfertnit , &
1245	nanimal , &
1246	tanimal , &
1247	danimal , &
1248	nliquidmanure , &
1249	nslurry , &
1250	nsolidmanure , &
1251	PIYcow , &
1252	PIMcow , &
1253	BCSYcow , &
1254	BCSMcow , &
1255	PICcow , &
1256	AGE_cow_P , &
1257	AGE_cow_M , &
1258	Forage_quantity)
1259	CALL getin('SOIL_FERTILITY',fertility_legume_t)
1260	soil_fertility(:,:)=fertility_legume_t
1261	CALL getin('LEGUME_FRACTION',fertility_legume_t)
1262	legume_fraction(:,:)=fertility_legume_t
1263
1264	CALL calc_N_limfert(&
1265	npts,nfertamm, nfertnit,&
1266	nliquidmanure, nslurry, nsolidmanure,&
1267	legume_fraction,soil_fertility,ndeposition,&
1268	N_fert_total,N_limfert)
1269
1270	ENDIF ! f_management_map
1271
1272	DO k=1,nstocking
1273	WHERE (tfert(:,:,k) .NE. 500)
1274	apport_azote(:,:) = apport_azote(:,:) + nfertamm(:,:,k) + nfertnit(:,:,k)
1275	END WHERE
1276	END DO
1277	!************************************************
1278	!************************************************
1279	! modifs Nico 20/07/2004
1280	!************************************************
1281	!************************************************
1282	! MODIF INN
1283	IF (f_nonlimitant .EQ. 1) THEN
1284	IF (f_autogestion .NE. 2) THEN
1285	WHERE (tcut(:,:,1) .EQ. 500.0)
1286	stoplimitant(:,:) = 1
1287	END WHERE
1288	ENDIF
1289	DO j=2,nvm
1290	DO i=1,npts
1291	IF (tfert(i,j,1) .EQ. 500.0) THEN
1292	stoplimitant(i,j) = 1
1293	ELSE
1294	compt_fert = 1
1295	min_fert = 1
1296	DO WHILE (tfert(i,j,compt_fert) .NE. 500.0)
1297	! print *, compt_fert, min_fert
1298	! print *, controle_azote(i,j,compt_fert)
1299	! print *, controle_azote(i,j,min_fert)
1300	IF (controle_azote(i,j,compt_fert) .GT. controle_azote(i,j,min_fert)) THEN
1301	min_fert = compt_fert
1302	ENDIF
1303	compt_fert = compt_fert + 1
1304	END DO
1305	fert_max = compt_fert - 1
1306	IF ((min_fert - 1) .EQ. 0) THEN
1307	fertcount_start(i,j) = fert_max
1308	ELSE
1309	fertcount_start(i,j) = min_fert - 1
1310	ENDIF
1311	i_compt = min_fert + 1
1312	DO WHILE ( tfert(i,j,i_compt) .NE. 500.0 )
1313	controle_azote(i,j,i_compt) = controle_azote(i,j,i_compt - 1)+&
1314	controle_azote(i,j,i_compt)
1315	i_compt = i_compt + 1
1316	END DO
1317	IF ( min_fert .NE. 1. ) THEN
1318	controle_azote(i,j,1) = controle_azote(i,j,1) + controle_azote(i,j,fert_max)
1319	i_compt = 2
1320	DO WHILE (i_compt .NE. min_fert)
1321	controle_azote(i,j,i_compt) = controle_azote(i,j,i_compt-1)+&
1322	controle_azote(i,j,i_compt)
1323	i_compt = i_compt + 1
1324	END DO
1325	ENDIF
1326	ENDIF
1327	END DO ! i
1328	END DO !j
1329	fertcount_current(:,:) = fertcount_start(:,:)
1330	ENDIF
1331	! fin initialisation auto gestion nicolas
1332	END IF init_grassland
1333
1334	! 2 updating variables each day (new_day)
1335	! update the root/shoot dry matter variables
1336	wshtot(:,:) = (biomass(:,:,ileaf,icarbon) + biomass(:,:,isapabove,icarbon) + &
1337	& biomass(:,:,ifruit,icarbon))/(1000*CtoDM) ! Unit: kgDM/m2
1338	wsh(:,:) = wshtot(:,:) / (1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
1339	wrtot(:,:) = (biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon))/ &
1340	& (1000*CtoDM) ! Unit: kg/m2
1341	wr(:,:) = wrtot(:,:) / (1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
1342
1343	n_day : IF (new_day) THEN
1344
1345	! GMEAN
1346	! Taux de croissance moyen de la repousse
1347	h = 1
1348
1349	DO WHILE (h .LT. ngmean)
1350	gmean(:,:,h ) = gmean(:,:,h +1)
1351	h = h + 1
1352	END DO
1353
1354	DO j=2,nvm
1355	DO i=1,npts
1356	IF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GE. 2.0)) THEN
1357	gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)))/tgrowth(i,j))
1358	ELSEIF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GT. 0.0) .AND. &
1359	& (regcount(i,j) .GT. 1)) THEN
1360	gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)))/tgrowth(i,j))
1361	ELSEIF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GT. 0.0) .AND. &
1362	& (regcount(i,j) .EQ. 1)) THEN
1363	gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotinit(i,j))/tgrowth(i,j))
1364	ELSE
1365	gmean(i,j,ngmean) = 0.0
1366	ENDIF
1367	END DO
1368	ENDDO
1369
1370	h = 1
1371	DO WHILE (h .LE. ngmean)
1372	tgmean(:,:,h) = h
1373	h = h + 1
1374	END DO
1375	! for each new day the daily value should be reset to 0
1376	! otherwise, it will be repeatly cumulated
1377	Fert_on(:,:) = 0.0
1378	Fert_sn(:,:) = 0.0
1379	Fert_PRP(:,:) = 0.0
1380	END IF n_day
1381
1382	! 3 updating variables at the end of the year (last day = new_year =
1383	! EndOfYear
1384	n_year : IF (new_year) THEN
1385	WRITE(numout,*) 'EndOfYear gm'
1386	tcut_verif(:,:,:) = .FALSE.
1387	fertil_year(:,:) = .TRUE.
1388	tasum(:,:) = 0.0
1389	regcount(:,:) = 1
1390	nfertammtotprevyear(:,:) = nfertammtot
1391	nfertnittotprevyear(:,:) = nfertnittot
1392	fertcount(:,:) = 0
1393	nfertammtotyear(:,:) = 0.0
1394	nfertnittotyear(:,:) = 0.0
1395	fnatmsum(:,:) = 0.0
1396	tfert_verif(:,:,:) = .FALSE.
1397	tfert_verif2(:,:,:) = .FALSE.
1398	tfert_verif3(:,:,:) = .FALSE.
1399	fcOrganicFertmetabolicsum(:,:) = 0.0
1400	fcOrganicFertstructsum(:,:) = 0.0
1401	fnOrganicFertmetabolicsum(:,:) = 0.0
1402	fnOrganicFertstructsum(:,:) = 0.0
1403	fnOrganicFerturinesum(:,:) = 0.0
1404	devstage(:,:) = 0.0
1405	fertcount(:,:) = 0
1406	tgrowth (:,:) = 0.0
1407	tfert_modif(:,:,:) = 500.0
1408	frequency_cut(:,:) = compt_cut(:,:)
1409	compt_cut(:,:) = 0.0
1410
1411	IF (f_saturant .EQ. 1) THEN
1412	nfertamm(:,:,:) = 0.025
1413	nfertnit(:,:,:) = 0.025
1414	nsatur_somerror(:,:) = 0.0
1415	nsatur_somerror_temp(:,:) = 0.0
1416	END IF
1417	! calculate annual grass forage production
1418	DM_cutyearly(:,:)= wshtotsum(:,:)-wshtotsumprevyear(:,:)
1419	C_cutyearly(:,:) = DM_cutyearly(:,:) * 1000 * CtoDM
1420	! should be after calculating the import_yield
1421	!wshtotsumprevyear(:,:) = wshtotsum(:,:)
1422
1423	! calculate import_yield saved to restart for output
1424	! and for updating grazing variables in grazing subroutine
1425	IF ((f_postauto .GE. 1) .OR. (f_autogestion .EQ. 4) .OR. &
1426	!!!! JCMODIF 290714 for postaut = 5
1427	(f_autogestion .EQ. 3) ) THEN
1428	import_yield(:,mgraze_C3) = wshtotsum(:,mcut_C3)-wshtotsumprevyear(:,mcut_C3)
1429	wshtotsumprevyear(:,mcut_C3) = wshtotsum(:,mcut_C3)
1430	import_yield(:,mgraze_C4) = wshtotsum(:,mcut_C4)-wshtotsumprevyear(:,mcut_C4)
1431	wshtotsumprevyear(:,mcut_C4) = wshtotsum(:,mcut_C4)
1432	! if as trunk that restart and initiailize every year
1433	! save wshtotsumprevyear is useless
1434	! but if as NV driver run for many years
1435	! save wshtotsumprevyear is necessary because wshtotsum will keep
1436	! inscresing
1437	END IF
1438
1439	wshtotsumprevyear(:,:) = wshtotsum(:,:)
1440	wshtotsumprev(:,:) = 0.0
1441	c(:,:) = 0.0365122 ! 4.22e-02
1442	n(:,:) = 0.00732556 ! 8.17e-03
1443	napo(:,:) = 0.000542054 ! 6.39e-04
1444	nsym(:,:) = 0.0108071 ! 6.15e-03
1445	fn(:,:) = 0.0316223 ! 4.15e-02 ! 2.64e-02
1446	ntot(:,:) = 0.03471895 ! 2.89e-02
1447
1448	! count_year is useless for trunk driver
1449	! only necessary for NV driver run for many years
1450	! unless save it to restart in the future
1451	count_year = count_year + 1
1452	IF (count_year .LT. 30) THEN
1453	year_count1 = count_year-1
1454	year_count2 = 0
1455	ELSEIF (count_year .GE. 30) THEN
1456	year_count1 = 29
1457	year_count2 = count_year - 29
1458	ELSE
1459	year_count1 = 29
1460	year_count2 = 21
1461	ENDIF
1462
1463	!JCCOMMENT There is no need to read again in standard trunk driver
1464	!!! ! read management map at the end of year
1465	!!! ! is only useful for NV driver and multi-year maps
1466	!!! ! for trunk driver, the annual file will be changed every year
1467	!!! ! and read when initialize
1468	!!!
1469	!!! ! get_map of spatial .nc file or old txt/dat file
1470	!!! IF (f_management_map) THEN
1471	!!! ! re-initial management variables
1472	!!! tcut(:,:,:) = 500.0
1473	!!! tfert(:,:,:) = 500.0
1474	!!! nfertamm(:,:,:) = 0.0
1475	!!! nfertnit(:,:,:) = 0.0
1476	!!! nanimal(:,:,:) = 0.0
1477	!!! tanimal(:,:,:) = 500.0
1478	!!! danimal(:,:,:) = 0.0
1479	!!! nliquidmanure(:,:,:) = 0.0
1480	!!! nslurry(:,:,:) = 0.0
1481	!!! nsolidmanure(:,:,:) = 0.0
1482	!!! ndeposition(:,:) = 0.0
1483	!!! CALL reading_map_manag(&
1484	!!! npts, lalo, neighbours, resolution, contfrac, &
1485	!!! count_year, nb_year_management,&
1486	!!! management_intensity,&
1487	!!! management_start,&
1488	!!! tcut, tfert, nfertamm, nfertnit,&
1489	!!! nanimal, tanimal, danimal,&
1490	!!! nliquidmanure, nslurry, nsolidmanure,&
1491	!!! legume_fraction,soil_fertility,&
1492	!!! deposition_start,ndeposition,sr_ugb,sr_wild)
1493	!!!
1494	!!! CALL calc_N_limfert(&
1495	!!! npts,nfertamm, nfertnit,&
1496	!!! nliquidmanure, nslurry, nsolidmanure,&
1497	!!! legume_fraction,soil_fertility,ndeposition,&
1498	!!! N_fert_total,N_limfert)
1499	!!!
1500	!!! ELSE
1501	!!! IF (ANY(nb_year_management(:) .GT. 1)) THEN
1502	!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1503	!!! !!!!!!!!!! READ NEW MANAGEMENT FILE JCADD
1504	!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1505	!!! !!! delete FIRE_MANAGEMENT READ: not used in LGM
1506	!!! ! CALL reading_new_animal(&
1507	!!! ! npts , &
1508	!!! ! nb_year_management , &
1509	!!! ! tcutmodel , &
1510	!!! ! tcut , &
1511	!!! ! tfert , &
1512	!!! ! nfertamm , &
1513	!!! ! nfertnit , &
1514	!!! ! nanimal , &
1515	!!! ! tanimal , &
1516	!!! ! danimal , &
1517	!!! ! nliquidmanure , &
1518	!!! ! nslurry , &
1519	!!! ! nsolidmanure , &
1520	!!! ! PIYcow , &
1521	!!! ! PIMcow , &
1522	!!! ! BCSYcow , &
1523	!!! ! BCSMcow , &
1524	!!! ! PICcow , &
1525	!!! ! AGE_cow_P , &
1526	!!! ! AGE_cow_M , &
1527	!!! ! Forage_quantity)
1528	!!! ! re-initial management variables
1529	!!! tcut(:,:,:) = 500.0
1530	!!! tfert(:,:,:) = 500.0
1531	!!! nfertamm(:,:,:) = 0.0
1532	!!! nfertnit(:,:,:) = 0.0
1533	!!! nanimal(:,:,:) = 0.0
1534	!!! tanimal(:,:,:) = 500.0
1535	!!! danimal(:,:,:) = 0.0
1536	!!! nliquidmanure(:,:,:) = 0.0
1537	!!! nslurry(:,:,:) = 0.0
1538	!!! nsolidmanure(:,:,:) = 0.0
1539	!!! ndeposition(:,:) = 0.0
1540	!!! CALL calc_N_limfert(&
1541	!!! npts,nfertamm, nfertnit,&
1542	!!! nliquidmanure, nslurry, nsolidmanure,&
1543	!!! legume_fraction,soil_fertility,ndeposition,&
1544	!!! N_fert_total,N_limfert)
1545	!!!
1546	!!! END IF ! nb_year_management
1547	!!!
1548	!!! DO k=1,nstocking
1549	!!! WHERE (tfert(:,:,k) .NE. 500)
1550	!!! apport_azote(:,:) = apport_azote(:,:) + nfertamm(:,:,k) + nfertnit(:,:,k)
1551	!!! END WHERE
1552	!!! END DO
1553	!!!
1554	!!! END IF ! f_management_map
1555
1556	END IF n_year
1557
1558	! 4 fertilization
1559	! Fertilisation from PaSim 2011
1560	! 4.1 **** RUN USERS OR RUN SATURANT ***
1561	users_or_saturant_fert : IF ((tcutmodel .EQ. 0) .AND. (f_saturant .EQ. 0)) THEN
1562
1563	! flag_fertilisation : flag for spatialization of cutting
1564
1565	DO k=1,nstocking
1566	flag_fertilisation(:,:) = 0
1567	DO j=2 ,nvm
1568	DO i=1,npts
1569	IF (tfert_verif(i,j,k) .EQ. .FALSE. ) THEN
1570	IF ((tfert(i,j,k)-0.5 .LE. REAL(tjulian)) .AND. &
1571	(tfert(i,j,k)+0.9 .GE. REAL(tjulian)) .AND. &
1572	(tfert_verif(i,j,k) .EQ. .FALSE.)) THEN
1573	tfert_verif(i,j,k) = .TRUE.
1574	flag_fertilisation(i,j) = 1
1575	Fert_sn(i,j) = Fert_sn(i,j) + nfertamm(i,j,k) + nfertnit(i,j,k)
1576	!counter for fertilizer application
1577	fertcount(i,j) = fertcount(i,j) + 1
1578	!mineral fertilization
1579	nfertammtot(i,j) = nfertammtot(i,j) + nfertamm(i,j,fertcount(i,j))
1580	nfertnittot(i,j) = nfertnittot(i,j) + nfertnit(i,j,fertcount(i,j))
1581
1582	nfertammtotyear(i,j) = nfertammtot(i,j) - nfertammtotprevyear(i,j)
1583	nfertnittotyear(i,j) = nfertnittot(i,j) - nfertnittotprevyear(i,j)
1584	IF (f_nonlimitant .EQ. 1.) THEN
1585	controle_azote_sum_mem(i,j) = controle_azote_sum(i,j)
1586	IF (.NOT. (tfert_verif3(i,j,fertcount_start(i,j))) ) THEN
1587	tfert_verif3(i,j,fertcount_start(i,j))= .TRUE.
1588	controle_azote_sum(i,j) = 0.
1589	END IF
1590	END IF
1591	END IF
1592	END IF
1593	END DO ! i
1594	END DO ! j
1595	END DO ! k
1596	!*****************************************
1597	! MODIFS NICO AUTO MANAGEMENT DE PASIM
1598	!*****************************************
1599
1600	ELSE IF (f_saturant .EQ. 1) THEN !*** RUN SATURANT *****
1601
1602	flag_fertilisation(:,:) = 0
1603	DO j=2 ,nvm
1604	DO i=1,npts
1605	IF (( tjulian .GE. tfert(i,j,fertcount(i,j) + 1)) .AND. &
1606	( tjulian .LT. (tfert(i,j,fertcount(i,j) + 2) - 1))) THEN
1607	!JCmodif 110523 with problem
1608	!above means tjulian between two tfert
1609	!undaily(i) uptake n daily always=0
1610	!thetas volumetric water content in soil layer h
1611	!thetasfc water field capacity
1612	!!!!! For we did not consider undaily , there will be no point need to fert???
1613	! IF ((undaily(i) .GT. 0.0) .AND. (thetas(i,1) .LE. thetasfc(i,1))) THEN
1614	flag_fertilisation(i,j) = 1
1615	!counter for fertilizer application
1616	fertcount(i,j) = fertcount(i,j) + 1
1617	!mineral fertilization
1618	nfertammtot(i,j) = nfertammtot(i,j) + nfertamm(i,j,fertcount(i,j))
1619	nfertnittot(i,j) = nfertnittot(i,j) + nfertnit(i,j,fertcount(i,j))
1620
1621	nfertammtotyear(i,j) = nfertammtot(i,j) - nfertammtotprevyear(i,j)
1622	nfertnittotyear(i,j) = nfertnittot(i,j) - nfertnittotprevyear(i,j)
1623	IF (f_nonlimitant .EQ. 1.) THEN
1624	controle_azote_sum_mem(i,j) = controle_azote_sum(i,j)
1625	IF (.NOT. (tfert_verif3(i,j,fertcount_start(i,j))) ) THEN
1626	tfert_verif3(i,j,fertcount_start(i,j))= .TRUE.
1627	controle_azote_sum(i,j) = 0.
1628	END IF
1629	END IF
1630
1631	IF (controle_azote_sum(i,j) .GT. 0.) THEN
1632	nsatur_somerror_temp(i,j) = &
1633	ABS(controle_azote(i,j,fertcount(i,j)) - controle_azote_sum(i,j)) / &
1634	controle_azote_sum(i,j)
1635	ENDIF
1636	IF (nsatur_somerror_temp(i,j) .GT. nsatur_somerror(i,j)) THEN
1637	nsatur_somerror(i,j) = nsatur_somerror_temp(i,j)
1638	ENDIF
1639	controle_azote(i,j,fertcount(i,j) ) = controle_azote_sum(i,j)
1640	tfert_modif(i,j,fertcount(i,j) ) = tjulian
1641	ELSE
1642	flag_fertilisation(i,j) = 2
1643
1644	IF ((tjulian .GE. (tfert(i,j,fertcount(i,j)+2)-1)) .AND. &
1645	(tjulian .LE. (tfert(i,j,fertcount(i,j)+2)-0.1)) .AND. &
1646	(.NOT.(tfert_verif2(i,j,fertcount(i,j)+2)) )) THEN
1647	flag_fertilisation(i,j) = 1
1648	tfert_verif2(i,j,fertcount(i,j)+2) = .TRUE.
1649	nfertamm(i,j,fertcount(i,j) + 1) = 0.
1650	nfertnit(i,j,fertcount(i,j) + 1) = 0.
1651	tfert_modif(i,j,fertcount(i,j) + 1) = 500.0
1652
1653	!counter for fertilizer application
1654	fertcount(i,j) = fertcount(i,j) + 1
1655	!mineral fertilization
1656	nfertammtot(i,j) = nfertammtot(i,j) + nfertamm(i,j,fertcount(i,j))
1657	nfertnittot(i,j) = nfertnittot(i,j) + nfertnit(i,j,fertcount(i,j))
1658
1659	nfertammtotyear(i,j) = nfertammtot(i,j) - nfertammtotprevyear(i,j)
1660	nfertnittotyear(i,j) = nfertnittot(i,j) - nfertnittotprevyear(i,j)
1661	IF (f_nonlimitant .EQ. 1.) THEN
1662	controle_azote_sum_mem(i,j) = controle_azote_sum(i,j)
1663	IF (.NOT. (tfert_verif3(i,j,fertcount_start(i,j))) ) THEN
1664	tfert_verif3(i,j,fertcount_start(i,j))= .TRUE.
1665	controle_azote_sum(i,j) = 0.
1666	END IF
1667	END IF
1668
1669	END IF
1670
1671	END IF
1672	END DO
1673	END DO
1674
1675	! JC comment not sure what is it for
1676	! WHERE (flag_fertilisation(:,:) .NE. 2)
1677	! flag_fertilisation(:,:) = 0
1678	! END WHERE
1679	END IF users_or_saturant_fert
1680
1681
1682	! 4.2 *** RUN NONLIMITANT ***
1683	! recherche des erreurs pour l'équilibre
1684	! recherche de stoplimitant (fin du run)
1685	run_nonlimitant : IF ((f_nonlimitant .EQ. 1) .AND. (ANY(stoplimitant(:,:) .EQ. 0))) THEN ! any ?
1686
1687	DO j=2,nvm
1688	DO i=1,npts
1689	! search the last time of fertilization
1690	IF (tfert(i,j,fertcount_current(i,j) + 1) .EQ. 500) THEN
1691	fertcount_next = 1
1692	ELSE
1693	fertcount_next = fertcount_current(i,j) + 1
1694	ENDIF
1695
1696	! if tjulian correspond to next time of fertilization
1697	IF ((tjulian .GE. tfert(i,j,fertcount_next)) .AND. &
1698	(tjulian .LE. tfert(i,j,fertcount_next)+0.9) .AND. &
1699	(tfert_verif2(i,j,fertcount_next) .EQV. .FALSE.)) THEN
1700
1701	tfert_verif2(i,j,fertcount_next) = .TRUE.
1702
1703	! calcul de somerror
1704	IF(controle_azote(i,j,fertcount_next) .GT. 0.) THEN
1705	nnonlimit_SOMerror(i,j) = &
1706	(controle_azote(i,j,fertcount_next) - controle_azote_sum_mem(i,j))/ &
1707	controle_azote(i,j,fertcount_next)
1708	ELSE
1709	nnonlimit_SOMerror(i,j) = 0.
1710	ENDIF
1711	! on regarde si on ne dépasse pas l'erreur max voulue
1712	! puis on réajuste cette erreur max suivant dans quel cas
1713	! nous sommes
1714	IF (nnonlimit_SOMerror(i,j) .GT. nnonlimit_SOMerrormax(i,j)) THEN
1715
1716	nfertamm(i,j,fertcount_current(i,j)) = nfertamm(i,j,fertcount_current(i,j)) + 0.00125
1717	nfertnit(i,j,fertcount_current(i,j)) = nfertnit(i,j,fertcount_current(i,j)) + 0.00125
1718	PRINT *, '!!! apport en azote !!! pour fertcount_current = ', fertcount_current(i,j) &
1719	,' nfertamm= ',nfertamm(i,j,fertcount_current(i,j))
1720	ELSE
1721	fertcount_current(i,j) = fertcount_current(i,j) + 1
1722
1723	IF(tfert(i,j,fertcount_current(i,j)) .EQ. 500.) THEN
1724	fertcount_current(i,j) = 1
1725	ENDIF
1726
1727	IF (fertcount_current(i,j) .EQ. fertcount_start(i,j)) THEN
1728	nnonlimit_SOMerrormax(i,j) = nnonlimit_SOMerrormax(i,j) - n_auto(i,j)*0.05
1729	n_auto(i,j) = n_auto(i,j) - 1.
1730	IF ( nnonlimit_SOMerrormax(i,j) .LE. 0.) THEN
1731	nnonlimit_SOMerrormax(i,j)=0.025
1732	ENDIF
1733	IF (n_auto(i,j) .LT. 0.) THEN
1734	stoplimitant(i,j) = 1
1735	print ,'********************************'
1736	print *,'stoplimitant =1 '
1737	print ,'*******************************'
1738	ENDIF ! n_auto
1739	ENDIF ! fertcount_current
1740	ENDIF ! nnonlimit
1741	ENDIF ! tjulian
1742	END DO ! npts
1743	END DO ! nvm
1744	END IF run_nonlimitant
1745
1746	! 4.3 run spatialize fertilization
1747	! calculating organic C input into soil
1748	CALL fertilisation_pas_temps(&
1749	npts , &
1750	fertcount , &
1751	dt , &
1752	tjulian , &
1753	deltat , &
1754	tfert , &
1755	Nliquidmanure , &
1756	nslurry , &
1757	Nsolidmanure , &
1758	fcOrganicFertmetabolic , &
1759	fcOrganicFertstruct , &
1760	fnOrganicFerturine , &
1761	fnOrganicFertmetabolic , &
1762	fnOrganicFertstruct , &
1763	c2nratiostruct , &
1764	Fert_on)
1765
1766	DO j=2,nvm
1767	CALL Euler_funct(npts, dt, MAX(0.0,(t2m_daily - 278.15)), tasum(:,j))
1768	END DO
1769
1770	! 5 calculate variables that not included in ORCHIDEE
1771	! liste :
1772	! * devstage
1773	! * tgrowth
1774	CALL Main_appl_pre_animal(&
1775	npts , &
1776	dt , &
1777	tjulian , &
1778	t2m_daily , &
1779	tsoil , &
1780	new_day , &
1781	new_year , &
1782	regcount , &
1783	tcut , &
1784	devstage , &
1785	tgrowth )
1786
1787	! 6 start grazing practice
1788	! 6.1 updating available litter for wild animal grazing
1789	!JCADD prepare litter_avail for grazing litter
1790	! kg DM/m^2
1791	litter_avail_totDM(:,:) = (litter_avail(:,istructural,:) + &
1792	& litter_avail(:,imetabolic,:)) / (1000. * CtoDM)
1793	!ENDJCADD
1794	! 6.2 grazing
1795	IF ((Type_animal.EQ.3).OR.(Type_animal.EQ.6)) THEN ! old animal module
1796	CALL Animaux_main(&
1797	npts, dt, devstage, wsh, intakemax, &
1798	snowfall_daily, wshtot, Animalwgrazingmin, &
1799	AnimalkintakeM, nel, wanimal, nanimaltot, &
1800	ntot, intake, urinen, faecesn, urinec, faecesc, &
1801	tgrowth, new_year, new_day, &
1802	nanimal, tanimal, danimal, &
1803	tcutmodel, tjulian, import_yield, &
1804	intakesum, intakensum, fn, c, n, leaf_frac, &
1805	intake_animal, intake_animalsum, &
1806	biomass, trampling, sr_ugb,sr_wild, &
1807	compt_ugb, nb_ani, grazed_frac,AnimalDiscremineQualite, &
1808	YIELD_RETURN,sr_ugb_init,year_count1,year_count2, &
1809	grazing_litter, litter_avail_totDM, &
1810	intake_animal_litter, intake_litter,nb_grazingdays, &
1811	!JCADD top 5 layer grassland soil moisture for grazing
1812	moiavail_daily, tmc_topgrass_daily,fc_grazing, &
1813	after_snow, after_wet, wet1day, wet2day, &
1814	snowmass_daily, t2m_daily, &
1815	!ENDJCADD
1816	ranimal_gm, ch4_pft_gm, Fert_PRP)
1817	ELSE ! new animal module
1818
1819	CALL Animaux_main_dynamic(&
1820	npts, dt, devstage , &
1821	intakemax, snowfall_daily, wshtot, wsh , &
1822	nel, nanimaltot , &
1823	intake , &
1824	import_yield , &
1825	new_year, new_day , &
1826	nanimal, tanimal, danimal , &
1827	PIYcow, PIMcow, BCSYcow , &
1828	BCSMcow, PICcow, AGE_cow_P , &
1829	AGE_cow_M, tcutmodel, tjulian , &
1830	intakesum , &
1831	intakensum, fn, ntot, c, n,leaf_frac, &
1832	intake_animal, intake_animalsum , &
1833	t2m_min_daily, type_animal , &
1834	t2m_daily, intakemax, Autogestion_out , &
1835	Forage_quantity,t2m_14 , &
1836	intake_tolerance , &
1837	q_max_complement , &
1838	biomass, urinen, faecesn, urinec,faecesc, &
1839	file_param_init,trampling,sr_ugb,sr_wild, &
1840	compt_ugb, nb_ani,grazed_frac,AnimalDiscremineQualite, &
1841	grazing_litter, nb_grazingdays)
1842
1843	ENDIF ! Type_Animal
1844
1845	! 7 CUTTING
1846	! Cutting Management: auto_fauche and user_fauche
1847	flag_cutting(:,:) = 0
1848	! 7.1 user defined cut
1849	user_fauche : IF ((f_autogestion .EQ. 0) .AND. (f_postauto .EQ. 0)) THEN
1850
1851	flag_cutting(:,:) = 0
1852	when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt
1853	lm_before(:,:)= biomass(:,:,ileaf,icarbon)
1854
1855	DO k=1,nstocking
1856
1857	flag_cutting(:,:) = 0
1858
1859	DO j=2,nvm
1860	IF (is_grassland_manag(j) )THEN
1861
1862	IF (ANY(tcut_verif(:,j,k) .EQ. .FALSE.)) THEN
1863	WHERE ((tjulian .GE. tcut(:,j,k)) .AND. (tjulian .LE. tcut(:,j,k)+0.9) .AND. &
1864	(tcut_verif(:,j,k) .EQ. .FALSE.))
1865
1866	tcut_verif(:,j,k) = .TRUE.
1867	flag_cutting(:,j) = 1
1868	compt_cut(:,j) = compt_cut(:,j) + 1
1869	when_growthinit_cut(:,j) = 0.0
1870	END WHERE
1871	END IF
1872	END IF
1873	END DO
1874	IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN
1875
1876	IF (blabla_pasim) PRINT *, 'cutting users', tjulian
1877
1878	CALL cutting_spa(&
1879	npts , &
1880	tjulian , &
1881	flag_cutting , &
1882	wshtotcutinit , &
1883	lcutinit , &
1884	wsh , &
1885	wshtot , &
1886	wr , &
1887	c , &
1888	n , &
1889	napo , &
1890	nsym , &
1891	fn , &
1892	tjulian , &
1893	nel , &
1894	biomass , &
1895	devstage , &
1896	regcount , &
1897	wshcutinit , &
1898	gmean , &
1899	wc_frac , &
1900	wnapo , &
1901	wnsym , &
1902	wgn , &
1903	tasum , &
1904	tgrowth , &
1905	loss , &
1906	lossc , &
1907	lossn , &
1908	tlossstart , &
1909	lai , &
1910	tcut , &
1911	tcut_modif , &
1912	wshtotsum , &
1913	controle_azote_sum)
1914
1915	WHERE ((wsh + wr .GT. 0.0).AND. (flag_cutting .EQ. 1))
1916	c = wc_frac / (wsh + wr)
1917	n = (wnapo + wnsym) / (wsh + wr)
1918	fn = wgn / (wr + wsh)
1919	napo = wnapo / (wsh + wr)
1920	nsym = wnsym / (wsh + wr)
1921	END WHERE
1922
1923	WHERE (wshtot + wrtot .GT. 0.0)
1924	ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot)
1925	END WHERE
1926	END IF
1927
1928	END DO !nstocking
1929
1930	END IF user_fauche
1931
1932	! 7.2 auto cut
1933	n_day_autofauche : IF (new_day) THEN
1934	DO j=2,nvm
1935	CALL linreg_pasim (&
1936	npts , &
1937	ngmean , &
1938	tgmean(:,j,:) , &
1939	gmean(:,j,:) , &
1940	ngmean , &
1941	misval , &
1942	mux(:,j) , &
1943	mugmean(:,j) , &
1944	sigx(:,j) , &
1945	sigy(:,j) , &
1946	gmeanslope(:,j) , &
1947	gzero(:,j) , &
1948	gcor(:,j))
1949	END DO
1950	countschedule(:,:) = 1
1951
1952	auto_fauche : IF (f_autogestion .EQ. 1) THEN ! for optimalize sr_ugb and nb_ani
1953
1954	flag_cutting(:,:) = 0
1955	when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt
1956	DO j=2,nvm
1957	IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. &
1958	(.NOT. is_grassland_grazed(j)))THEN
1959
1960	! FIRST test for automanagement > 45 days
1961	WHERE((nanimal(:,j,1) .EQ. 0.0) .AND. (cuttingend(:,j) .EQ. 0) .AND. &
1962	(countschedule(:,j) .EQ. 1) .AND. (((tgrowth(:,j) .GE. tgrowthmin) .AND. &
1963	(gmean(:,j,ngmean) .GT. 0.0) .AND.(lai(:,j) .GE. 2.5) .AND. &
1964	(devstage(:,j) .GT. devstagemin ) .AND. &
1965	(gmeanslope(:,j) .LT. gmeansloperel * mugmean(:,j)))))
1966
1967	flag_cutting(:,j) = 1
1968	countschedule(:,j) = countschedule(:,j) + 1
1969	compt_cut(:,j) = compt_cut(:,j) + 1
1970	END WHERE
1971	END IF
1972	END DO !nvm
1973
1974	! If there is at least one point concerned (flag_cutting = 1)
1975	IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN
1976	! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV ', tjulian
1977	! There will be one fertilization the day after cutting
1978	! A COURT-CIRCUITER si couplage autogestion ferti avec INN
1979	! AIG 06/10/2009
1980
1981	IF (f_fertilization.NE.1) THEN
1982	DO j=2,nvm
1983	DO i=1,npts
1984	IF (flag_cutting(i,j) .EQ. 1) THEN
1985	tfert(i,j,regcount(i,j) + 1) = tjulian + 1
1986	! print*, 'FERTILISATION AVEC METHODE NV', tjulian
1987	END IF
1988	END DO
1989	END DO
1990	END IF
1991
1992	CALL cutting_spa(&
1993	npts , &
1994	tjulian , &
1995	flag_cutting , &
1996	wshtotcutinit , &
1997	lcutinit , &
1998	wsh , &
1999	wshtot , &
2000	wr , &
2001	c , &
2002	n , &
2003	napo , &
2004	nsym , &
2005	fn , &
2006	tjulian , &
2007	nel , &
2008	biomass , &
2009	devstage , &
2010	regcount , &
2011	wshcutinit , &
2012	gmean , &
2013	wc_frac , &
2014	wnapo , &
2015	wnsym , &
2016	wgn , &
2017	tasum , &
2018	tgrowth , &
2019	loss , &
2020	lossc , &
2021	lossn , &
2022	tlossstart , &
2023	lai , &
2024	tcut , &
2025	tcut_modif , &
2026	wshtotsum , &
2027	controle_azote_sum)
2028
2029	! ******************************************************
2030	! update plant c n concentrations
2031	! ******************************************************
2032
2033	WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1) )
2034	c = wc_frac / (wsh + wr)
2035	n = (wnapo + wnsym) / (wsh + wr)
2036	fn = wgn / (wr + wsh)
2037	napo = wnapo / (wsh + wr)
2038	nsym = wnsym / (wsh + wr)
2039	END WHERE
2040
2041	WHERE (wshtot + wrtot .GT. 0.0)
2042	ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot)
2043	END WHERE
2044
2045	END IF
2046
2047	WHERE (flag_cutting(:,:) .EQ. 1)
2048	when_growthinit_cut(:,:) = 0.0
2049	END WHERE
2050
2051	! SECOND test for automanagement lai & accumulated temperature over shreshold
2052	flag_cutting(:,:) = 0
2053
2054	DO j=2,nvm
2055	IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. &
2056	(.NOT. is_grassland_grazed(j))) THEN
2057
2058	WHERE ((countschedule(:,j) .EQ. 1) .AND. (nanimal(:,j,1) .EQ. 0.0) .AND. &
2059	(devstage(:,j) .LT. 2.0) .AND. (tasum(:,j) .GE. tasumrep ) .AND. &
2060	(lai(:,j) .GE. 2.5))
2061
2062	flag_cutting(:,j) = 1
2063
2064	countschedule(:,j) = countschedule(:,j) + 1
2065	compt_cut(:,j) = compt_cut(:,j) + 1
2066	END WHERE
2067	END IF
2068	END DO !nvm
2069
2070	! If there is at least one point concerned
2071	IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN
2072	! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV', tjulian
2073
2074	! There will be one fertilization the day after cutting
2075	! MODIF INN
2076	!courciruiter le calcul de tfert si f_fertiliZation = 0
2077	IF (f_fertilization.NE.1) THEN
2078	DO j=2,nvm
2079	DO i=1,npts
2080	IF (flag_cutting(i,j) .EQ. 1) THEN
2081	tfert(i,j,regcount(i,j) + 1) = tjulian + 1
2082	! print*, 'FERTILISATION AVEC METHODE NV', tjulian
2083	END IF
2084	END DO
2085	END DO
2086	END IF
2087
2088	CALL cutting_spa(&
2089	npts , &
2090	tjulian , &
2091	flag_cutting , &
2092	wshtotcutinit , &
2093	lcutinit , &
2094	wsh , &
2095	wshtot , &
2096	wr , &
2097	c , &
2098	n , &
2099	napo , &
2100	nsym , &
2101	fn , &
2102	tjulian , &
2103	nel , &
2104	biomass , &
2105	devstage , &
2106	regcount , &
2107	wshcutinit , &
2108	gmean , &
2109	wc_frac , &
2110	wnapo , &
2111	wnsym , &
2112	wgn , &
2113	tasum , &
2114	tgrowth , &
2115	loss , &
2116	lossc , &
2117	lossn , &
2118	tlossstart , &
2119	lai , &
2120	tcut , &
2121	tcut_modif , &
2122	wshtotsum , &
2123	controle_azote_sum)
2124
2125	! ******************************************************
2126	! update plant c n concentrations
2127	! ******************************************************
2128	WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1))
2129	c = wc_frac / (wsh + wr)
2130	n = (wnapo + wnsym) / (wsh + wr)
2131	fn = wgn / (wr + wsh)
2132	napo = wnapo / (wsh + wr)
2133	nsym = wnsym / (wsh + wr)
2134	END WHERE
2135
2136	WHERE (wshtot + wrtot .GT. 0.0)
2137	ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot)
2138	END WHERE
2139
2140	END IF
2141
2142	WHERE (flag_cutting(:,:) .EQ. 1)
2143	when_growthinit_cut(:,:) = 0.0
2144	END WHERE
2145
2146	!If there are ncut cutting, it's finish
2147
2148	WHERE (regcount(:,:) .EQ. ncut )
2149	cuttingend(:,:) = 1
2150	END WHERE
2151
2152	!end of the cutting season by snow fall
2153
2154	ELSE IF ((f_postauto .EQ.1 ) .OR. (f_autogestion .EQ. 3) .OR. &
2155	(f_autogestion .EQ. 4) &
2156	!! JCMODIF 290714 for postauto 5
2157	.OR. (f_postauto .GE. 2)) THEN
2158
2159	flag_cutting(:,:) = 0
2160	when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt
2161	! JCADD 07082016 reset lossc to zero for history writing
2162	! NOTE:the flag_cutting will be determined twice a day, thus we cannot
2163	! reset them in the cutting subroutine
2164	loss(:,:) = 0.0
2165	lossc(:,:) = 0.0
2166	lossn(:,:) = 0.0
2167	tlossstart(:,:) = 500.0
2168	! FIRST test for automanagement
2169	WHERE((nanimal(:,mcut_C3,1) .EQ. 0.0) .AND. (cuttingend(:,mcut_C3) .EQ. 0) .AND. &
2170	(countschedule(:,mcut_C3) .EQ. 1) .AND. (((tgrowth(:,mcut_C3).GE.tgrowthmin) .AND. &
2171	(gmean(:,mcut_C3,ngmean).GT. 0.0) .AND. &
2172	(lai(:,mcut_C3) .GE. 2.5) .AND. (devstage(:,mcut_C3) .GT. devstagemin ) .AND. &
2173	(gmeanslope(:,mcut_C3) .LT.gmeansloperel * mugmean(:,mcut_C3)))))
2174
2175	flag_cutting(:,mcut_C3) = 1
2176	countschedule(:,mcut_C3) = countschedule(:,mcut_C3) + 1
2177	compt_cut(:,mcut_C3) = compt_cut(:,mcut_C3) + 1
2178	END WHERE
2179
2180	WHERE((nanimal(:,mcut_C4,1) .EQ. 0.0) .AND. (cuttingend(:,mcut_C4) .EQ. 0).AND. &
2181	(countschedule(:,mcut_C4) .EQ. 1) .AND. (((tgrowth(:,mcut_C4).GE.tgrowthmin).AND. &
2182	(gmean(:,mcut_C4,ngmean).GT. 0.0) .AND. &
2183	(lai(:,mcut_C4) .GE. 2.5) .AND. (devstage(:,mcut_C4) .GT. devstagemin ).AND. &
2184	(gmeanslope(:,mcut_C4) .LT.gmeansloperel * mugmean(:,mcut_C4)))))
2185
2186	flag_cutting(:,mcut_C4) = 1
2187	countschedule(:,mcut_C4) = countschedule(:,mcut_C4) + 1
2188	compt_cut(:,mcut_C4) = compt_cut(:,mcut_C4) + 1
2189	END WHERE
2190
2191	! If there is at least one point concerned (flag_cutting = 1)
2192
2193	IF ((ANY(flag_cutting(:,mcut_C3) .EQ. 1)) .OR. &
2194	(ANY(flag_cutting(:,mcut_C4) .EQ. 1))) THEN
2195	! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV ', tjulian
2196	! There will be one fertilization the day after cutting
2197	! A COURT-CIRCUITER si couplage autogestion ferti avec INN
2198	! AIG 06/10/2009
2199
2200	IF (f_fertilization.NE.1) THEN
2201	DO j=2,nvm
2202	DO i=1,npts
2203	IF (flag_cutting(i,j) .EQ. 1) THEN
2204	tfert(i,j,regcount(i,j) + 1) = tjulian + 1
2205	! print*, 'FERTILISATION AVEC METHODE NV', tjulian
2206	END IF
2207	END DO
2208	END DO
2209	END IF
2210	CALL cutting_spa(&
2211	npts , &
2212	tjulian , &
2213	flag_cutting , &
2214	wshtotcutinit , &
2215	lcutinit , &
2216	wsh , &
2217	wshtot , &
2218	wr , &
2219	c , &
2220	n , &
2221	napo , &
2222	nsym , &
2223	fn , &
2224	tjulian , &
2225	nel , &
2226	biomass , &
2227	devstage , &
2228	regcount , &
2229	wshcutinit , &
2230	gmean , &
2231	wc_frac , &
2232	wnapo , &
2233	wnsym , &
2234	wgn , &
2235	tasum , &
2236	tgrowth , &
2237	loss , &
2238	lossc , &
2239	lossn , &
2240	tlossstart , &
2241	lai , &
2242	tcut , &
2243	tcut_modif , &
2244	wshtotsum , &
2245	controle_azote_sum)
2246
2247	! ******************************************************
2248	! mise à jour des concentrations
2249	! ******************************************************
2250
2251	WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1) )
2252	c = wc_frac / (wsh + wr)
2253	n = (wnapo + wnsym) / (wsh + wr)
2254	fn = wgn / (wr + wsh)
2255	napo = wnapo / (wsh + wr)
2256	nsym = wnsym / (wsh + wr)
2257	END WHERE
2258
2259	WHERE (wshtot + wrtot .GT. 0.0)
2260	ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot)
2261	END WHERE
2262
2263	END IF
2264
2265	WHERE (flag_cutting(:,mcut_C3) .EQ. 1)
2266	when_growthinit_cut(:,mcut_C3) = 0.0
2267	END WHERE
2268	WHERE (flag_cutting(:,mcut_C4) .EQ. 1)
2269	when_growthinit_cut(:,mcut_C4) = 0.0
2270	END WHERE
2271
2272	! SECOND test for automanagement
2273	flag_cutting(:,mcut_C3) = 0
2274	flag_cutting(:,mcut_C4) = 0
2275
2276	WHERE ((countschedule(:,mcut_C3) .EQ. 1) .AND. (nanimal(:,mcut_C3,1) .EQ.0.0) .AND. &
2277	(devstage(:,mcut_C3) .LT. 2.0) .AND. (tasum(:,mcut_C3) .GE. tasumrep ) .AND. &
2278	(lai(:,mcut_C3) .GE. 2.5))
2279
2280	flag_cutting(:,mcut_C3) = 1
2281	countschedule(:,mcut_C3) = countschedule(:,mcut_C3) + 1
2282	compt_cut(:,mcut_C3) = compt_cut(:,mcut_C3) + 1
2283	END WHERE
2284
2285	WHERE ((countschedule(:,mcut_C4) .EQ. 1) .AND. (nanimal(:,mcut_C4,1).EQ.0.0) .AND. &
2286	(devstage(:,mcut_C4) .LT. 2.0) .AND. (tasum(:,mcut_C4) .GE. tasumrep ).AND. &
2287	(lai(:,mcut_C4) .GE. 2.5))
2288
2289	flag_cutting(:,mcut_C4) = 1
2290	countschedule(:,mcut_C4) = countschedule(:,mcut_C4) + 1
2291	compt_cut(:,mcut_C4) = compt_cut(:,mcut_C4) + 1
2292	END WHERE
2293
2294	! If there is at least one point concerned
2295	IF ((ANY(flag_cutting(:,mcut_C3) .EQ. 1)) .OR. &
2296	(ANY(flag_cutting(:,mcut_C4) .EQ. 1))) THEN
2297
2298	! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV', tjulian
2299
2300	! There will be one fertilization the day after cutting
2301	! MODIF INN
2302	!courciruiter le calcul de tfert si f_fertiliZation = 0
2303	IF (f_fertilization.NE.1) THEN
2304	DO j=2,nvm
2305	DO i=1,npts
2306	IF (flag_cutting(i,j) .EQ. 1) THEN
2307	tfert(i,j,regcount(i,j) + 1) = tjulian + 1
2308	! print*, 'FERTILISATION AVEC METHODE NV', tjulian
2309	END IF
2310	END DO
2311	END DO
2312	END IF
2313
2314	CALL cutting_spa(&
2315	npts , &
2316	tjulian , &
2317	flag_cutting , &
2318	wshtotcutinit , &
2319	lcutinit , &
2320	wsh , &
2321	wshtot , &
2322	wr , &
2323	c , &
2324	n , &
2325	napo , &
2326	nsym , &
2327	fn , &
2328	tjulian , &
2329	nel , &
2330	biomass , &
2331	devstage , &
2332	regcount , &
2333	wshcutinit , &
2334	gmean , &
2335	wc_frac , &
2336	wnapo , &
2337	wnsym , &
2338	wgn , &
2339	tasum , &
2340	tgrowth , &
2341	loss , &
2342	lossc , &
2343	lossn , &
2344	tlossstart , &
2345	lai , &
2346	tcut , &
2347	tcut_modif , &
2348	wshtotsum , &
2349	controle_azote_sum)
2350
2351	! ******************************************************
2352	! update plant c n concentrations
2353	! ******************************************************
2354	WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1))
2355	c = wc_frac / (wsh + wr)
2356	n = (wnapo + wnsym) / (wsh + wr)
2357	fn = wgn / (wr + wsh)
2358	napo = wnapo / (wsh + wr)
2359	nsym = wnsym / (wsh + wr)
2360	END WHERE
2361
2362	WHERE (wshtot + wrtot .GT. 0.0)
2363	ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot)
2364	END WHERE
2365
2366	END IF
2367
2368	WHERE (flag_cutting(:,mcut_C3) .EQ. 1)
2369	when_growthinit_cut(:,mcut_C3) = 0.0
2370	END WHERE
2371
2372	!If there are ncut cutting, it's finish
2373	WHERE (regcount(:,mcut_C3) .EQ. ncut )
2374	cuttingend(:,mcut_C3) = 1
2375	END WHERE
2376
2377	WHERE (flag_cutting(:,mcut_C4) .EQ. 1)
2378	when_growthinit_cut(:,mcut_C4) = 0.0
2379	END WHERE
2380
2381	!If there are ncut cutting, it's finish
2382
2383	WHERE (regcount(:,mcut_C4) .EQ. ncut )
2384	cuttingend(:,mcut_C4) = 1
2385	END WHERE
2386
2387	!end of the cutting season by snow fall
2388
2389	END IF auto_fauche
2390	END IF n_day_autofauche
2391
2392	! 8 updating plant and soil variables after management practice
2393	! maintenant nous allons regarder les changements que le management apporte à Orchidee.
2394	! Dans un premier temps uniquement ceux sur le Carbone vu qu'Orchidee n'a pas d'azote.
2395	! ******************************************************
2396	! 8.1 updating soil status
2397	! ******************************************************
2398	CALL chg_sol_bio(&
2399	npts , &
2400	tjulian , &
2401	bm_to_litter , &
2402	litter , &
2403	litter_avail , &
2404	litter_not_avail , &
2405	! !spitfire
2406	! fuel_1hr, &
2407	! fuel_10hr, &
2408	! fuel_100hr, &
2409	! fuel_1000hr, &
2410	! !end spitfire
2411	litter_avail_totDM , &
2412	intake_litter , &
2413	biomass , &
2414	faecesc , &
2415	urinec , &
2416	fcOrganicFertmetabolic , &
2417	fcOrganicFertstruct , &
2418	fnOrganicFerturine , &
2419	fnOrganicFertstruct , &
2420	fnOrganicFertmetabolic , &
2421	trampling , &
2422	YIELD_RETURN , &
2423	harvest_gm, cinput_gm)
2424
2425	!jcadd calculate N2O emission
2426	! Fert_sn mineral fertilizer N kg N m-2 d-1
2427	! Fert_on organic fertilizer N kg N m-2 d-1
2428	! Fert_PRP N in grazing excreta kg N m-2 d-1
2429	! ndeposition N deposition kg N ha yr-1
2430	n2o_pft_gm = &
2431	! Direct emission
2432	((Fert_sn+Fert_on + ndeposition/1e4/365.) * n2o_EF1 + &
2433	Fert_PRP * n2o_EF2) + &
2434	! Volatilization
2435	((Fert_sn + ndeposition/1e4/365.) * n2o_FracGASF + &
2436	(Fert_on + Fert_PRP) * n2o_FracGASM) * n2o_EF3 + &
2437	! Leaching
2438	(Fert_sn+Fert_on + ndeposition/1e4/365. + Fert_PRP) * &
2439	n2o_FracLEACH_H * n2o_EF4
2440	!end jcadd
2441
2442	lai(:,:) = biomass(:,:,ileaf,icarbon)*sla_calc(:,:)
2443
2444	! 8.2 write history
2445	! HISTWRITE
2446	CALL xios_orchidee_send_field("FERT_SN",Fert_sn)
2447	CALL xios_orchidee_send_field("FERT_ON",Fert_on)
2448	CALL xios_orchidee_send_field("FERT_PRP",Fert_PRP)
2449	CALL xios_orchidee_send_field("WSHTOT",wshtot)
2450	CALL xios_orchidee_send_field("WRTOT",wrtot)
2451	CALL xios_orchidee_send_field("WSHTOTSUM",wshtotsum)
2452	CALL xios_orchidee_send_field("SR_UGB",sr_ugb)
2453	CALL xios_orchidee_send_field("FCORGFERTMET",fcOrganicFertmetabolic)
2454	CALL xios_orchidee_send_field("FCORGFERTSTR",fcOrganicFertstruct)
2455	CALL xios_orchidee_send_field("LOSSC",lossc)
2456	CALL xios_orchidee_send_field("C_CUTYEARLY",C_cutyearly)
2457	CALL xios_orchidee_send_field("FREQUENCY_CUT",frequency_cut)
2458	CALL xios_orchidee_send_field("NFERT_TOTAL",N_fert_total)
2459	CALL xios_orchidee_send_field("NDEP",ndeposition)
2460	CALL xios_orchidee_send_field("TMCGRASS_DAILY",tmc_topgrass_daily)
2461	CALL xios_orchidee_send_field("FC_GRAZING",fc_grazing)
2462	CALL xios_orchidee_send_field("CINPUT_GM",cinput_gm)
2463	CALL xios_orchidee_send_field("HARVEST_GM",harvest_gm)
2464
2465	CALL xios_orchidee_send_field("NSLURRY",nslurry(:,:,1))
2466	CALL xios_orchidee_send_field("NFERTAMM",nfertamm(:,:,1))
2467	CALL xios_orchidee_send_field("NFERTNIT",nfertnit(:,:,1))
2468	regcount_real = regcount
2469	fertcount_real = fertcount
2470	CALL histwrite_p(hist_id_stomate ,'YIELD_RETURN',itime,YIELD_RETURN,npts*nvm, horipft_index)
2471	CALL histwrite_p(hist_id_stomate ,'REGCOUNT' ,itime ,regcount_real , npts*nvm, horipft_index)
2472	CALL histwrite_p(hist_id_stomate ,'FERTCOUNT',itime ,fertcount_real, npts*nvm, horipft_index)
2473	CALL histwrite_p(hist_id_stomate ,'GMEAN1',itime ,gmean(:,:,1) ,npts*nvm, horipft_index)
2474	CALL histwrite_p(hist_id_stomate ,'GMEAN2',itime ,gmean(:,:,2) ,npts*nvm, horipft_index)
2475	CALL histwrite_p(hist_id_stomate ,'GMEAN3',itime ,gmean(:,:,3) ,npts*nvm, horipft_index)
2476	CALL histwrite_p(hist_id_stomate ,'GMEAN4',itime ,gmean(:,:,4) ,npts*nvm, horipft_index)
2477	CALL histwrite_p(hist_id_stomate ,'GMEAN5',itime ,gmean(:,:,5) ,npts*nvm, horipft_index)
2478	CALL histwrite_p(hist_id_stomate ,'GMEAN6',itime ,gmean(:,:,6) ,npts*nvm, horipft_index)
2479	CALL histwrite_p(hist_id_stomate ,'GMEAN7',itime ,gmean(:,:,7) ,npts*nvm, horipft_index)
2480	CALL histwrite_p(hist_id_stomate ,'GMEAN8',itime ,gmean(:,:,8) ,npts*nvm, horipft_index)
2481	CALL histwrite_p(hist_id_stomate ,'GMEAN9',itime ,gmean(:,:,9) ,npts*nvm, horipft_index)
2482	CALL histwrite_p(hist_id_stomate ,'GMEAN0',itime ,gmean(:,:,10) ,npts*nvm, horipft_index)
2483	CALL histwrite_p(hist_id_stomate ,'WSH' ,itime , wsh , npts*nvm, horipft_index)
2484	CALL histwrite_p(hist_id_stomate ,'WSHTOT',itime , wshtot, npts*nvm, horipft_index)
2485	CALL histwrite_p(hist_id_stomate ,'WR', itime , wr, npts*nvm, horipft_index)
2486	CALL histwrite_p(hist_id_stomate ,'WRTOT', itime , wrtot, npts*nvm, horipft_index)
2487	CALL histwrite_p(hist_id_stomate ,'WSHTOTSUM', itime , wshtotsum, npts*nvm, horipft_index)
2488	CALL histwrite_p(hist_id_stomate ,'SR_UGB', itime , sr_ugb, npts*nvm,horipft_index)
2489	! HISTWRITE POUR LA FERTIILSATION
2490	CALL histwrite_p(hist_id_stomate ,'FCORGFERTMET',itime , fcOrganicFertmetabolic,npts*nvm, horipft_index)
2491	CALL histwrite_p(hist_id_stomate ,'FCORGFERTSTR' ,itime , fcOrganicFertstruct ,npts*nvm, horipft_index)
2492	!CALL histwrite_p(hist_id_stomate ,'FNORGFERTURINE' ,itime , fnOrganicFerturine ,npts*nvm, horipft_index)
2493	!CALL histwrite_p(hist_id_stomate ,'FNORGFERTSTR' ,itime , fnOrganicFertstruct ,npts*nvm, horipft_index)
2494	!CALL histwrite_p(hist_id_stomate ,'FNORGFERTMET',itime , fnOrganicFertmetabolic,npts*nvm, horipft_index)
2495	!CALL histwrite_p(hist_id_stomate ,'NFERTNITTOT' ,itime , nfertnit(:,:,1) ,npts*nvm, horipft_index)
2496	!CALL histwrite_p(hist_id_stomate ,'NFERTAMMTOT' ,itime , nfertamm(:,:,1) ,npts*nvm, horipft_index)
2497	! HISTWRITE POUR LA FAUCHE
2498	CALL histwrite_p(hist_id_stomate ,'LOSS' ,itime ,loss ,npts*nvm, horipft_index)
2499	CALL histwrite_p(hist_id_stomate ,'LOSSC',itime ,lossc ,npts*nvm, horipft_index)
2500	CALL histwrite_p(hist_id_stomate ,'LOSSN',itime ,lossn ,npts*nvm, horipft_index)
2501	CALL histwrite_p(hist_id_stomate ,'DM_CUTYEARLY',itime ,DM_cutyearly ,npts*nvm, horipft_index)
2502	CALL histwrite_p(hist_id_stomate ,'C_CUTYEARLY',itime ,C_cutyearly ,npts*nvm, horipft_index)
2503	CALL histwrite_p(hist_id_stomate ,'COMPT_CUT' ,itime ,compt_cut ,npts*nvm, horipft_index)
2504	CALL histwrite_p(hist_id_stomate ,'FREQUENCY_CUT',itime ,frequency_cut ,npts*nvm, horipft_index)
2505	CALL histwrite_p(hist_id_stomate ,'NFERT_TOTAL',itime ,N_fert_total ,npts*nvm, horipft_index)
2506	CALL histwrite_p(hist_id_stomate ,'NDEP',itime ,ndeposition ,npts*nvm,horipft_index)
2507	CALL histwrite_p(hist_id_stomate ,'LEGUME_FRACTION',itime ,legume_fraction ,npts*nvm, horipft_index)
2508	CALL histwrite_p(hist_id_stomate ,'SOIL_FERTILITY',itime ,soil_fertility ,npts*nvm, horipft_index)
2509	CALL histwrite_p(hist_id_stomate ,'C' ,itime, c , npts*nvm, horipft_index)
2510	CALL histwrite_p(hist_id_stomate ,'N' ,itime, n , npts*nvm, horipft_index)
2511	CALL histwrite_p(hist_id_stomate ,'FN' ,itime, fn , npts*nvm, horipft_index)
2512	CALL histwrite_p(hist_id_stomate ,'NTOT' ,itime, ntot , npts*nvm, horipft_index)
2513	CALL histwrite_p(hist_id_stomate ,'NAPO' ,itime, napo , npts*nvm, horipft_index)
2514	CALL histwrite_p(hist_id_stomate ,'NSYM' ,itime, nsym , npts*nvm, horipft_index)
2515	CALL histwrite_p(hist_id_stomate ,'DEVSTAGE',itime, devstage, npts*nvm, horipft_index)
2516	CALL histwrite_p(hist_id_stomate ,'TGROWTH' ,itime, tgrowth , npts*nvm, horipft_index)
2517	CALL histwrite_p(hist_id_stomate ,'GRAZINGCSTRUCT',itime, grazingcstruct , npts*nvm, horipft_index)
2518	CALL histwrite_p(hist_id_stomate ,'GRAZINGNSTRUCT',itime, grazingnstruct , npts*nvm, horipft_index)
2519	CALL histwrite_p(hist_id_stomate ,'GRAZINGWN' ,itime, Substrate_grazingwn, npts*nvm, horipft_index)
2520	CALL histwrite_p(hist_id_stomate ,'GRAZINGWC' ,itime, Substrate_grazingwc, npts*nvm, horipft_index)
2521	!JCADD top 5 layer grassland soil moisture for grazing
2522	CALL histwrite_p(hist_id_stomate ,'TMCGRASS_DAILY',itime,tmc_topgrass_daily, npts, hori_index)
2523	CALL histwrite_p(hist_id_stomate ,'FC_GRAZING',itime,fc_grazing, npts, hori_index)
2524	!ENDJCADD
2525	END SUBROUTINE main_grassland_management
2526
2527	! modules calculating devstage and tgrowth for grazing
2528	! liste of functions calculated
2529	! - devstage
2530	! - tgrowth
2531	! - dndfi
2532	SUBROUTINE Main_appl_pre_animal(&
2533	npts , &
2534	dt , &
2535	tjulian , &
2536	t2m_daily , &
2537	tsoil , &
2538	new_day , &
2539	new_year , &
2540	regcount , &
2541	tcut , &
2542	devstage , &
2543	tgrowth )
2544
2545	INTEGER (i_std) , INTENT(in) :: npts
2546	LOGICAL , INTENT(in) :: new_day
2547	LOGICAL , INTENT(in) :: new_year
2548	REAL(r_std) , INTENT(in) :: dt
2549	INTEGER(i_std) , INTENT(in) :: tjulian
2550	REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_daily
2551	! air temperature (K)
2552	REAL(r_std), DIMENSION(npts) , INTENT(in) :: tsoil
2553	! soil surface temperature
2554	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tcut
2555	INTEGER(i_std) , DIMENSION(npts,nvm) , INTENT(in) :: regcount
2556	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: devstage
2557	! state of developpement of growth
2558	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tgrowth
2559	! time from last cut (d)
2560
2561	INTEGER(i_std) :: ier
2562	REAL(r_std), DIMENSION(npts) :: xtmp_npts
2563	IF (new_year) THEN
2564	tcut0(:,:) = 0.0
2565	END IF
2566
2567	CALL cal_devstage(npts, dt, t2m_daily, tsoil, new_day, &
2568	new_year, regcount, devstage)
2569	CALL cal_tgrowth(npts, dt, devstage, tjulian, new_day, &
2570	new_year, regcount, tcut, tgrowth)
2571
2572
2573	END SUBROUTINE Main_appl_pre_animal
2574
2575	! module calculating devstage
2576	SUBROUTINE cal_devstage(&
2577	npts,dt,t2m_daily,tsoil,new_day, &
2578	new_year, regcount, devstage)
2579
2580	INTEGER (i_std) , INTENT(in) :: npts
2581	REAL(r_std) , INTENT(in) :: dt
2582	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily
2583	REAL(r_std), DIMENSION(npts), INTENT(in) :: tsoil
2584	LOGICAL , INTENT(in) :: new_day
2585	LOGICAL , INTENT(in) :: new_year
2586	INTEGER(i_std) , DIMENSION(npts,nvm), INTENT(in) :: regcount
2587	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: devstage
2588
2589	INTEGER(i_std) :: i,j
2590
2591	CALL Euler_funct(npts,dt,t2m_daily,tacumm)
2592	CALL Euler_funct(npts,dt,tsoil,tsoilcumm)
2593
2594	CALL histwrite_p(hist_id_stomate ,'TSOILCUMM',itime,tsoilcumm, npts, hori_index)
2595
2596
2597	IF (new_day) THEN
2598
2599	tamean1(:) = tamean2(:)
2600	tamean2(:) = tamean3(:)
2601	tamean3(:) = tamean4(:)
2602	tamean4(:) = tamean5(:)
2603	tamean5(:) = tamean6(:)
2604	tamean6(:) = tameand(:)
2605
2606	tameand(:) = tacumm(:) - tacummprev(:)
2607	tacummprev(:) = tacumm(:)
2608
2609	tameanw(:) = (&
2610	tamean1(:) + &
2611	tamean2(:) + &
2612	tamean3(:) + &
2613	tamean4(:) + &
2614	tamean5(:) + &
2615	tamean6(:) + &
2616	tameand(:))/7.0
2617
2618	tsoilmeand(:) = tsoilcumm(:) - tsoilcummprev(:)
2619	tsoilcummprev(:) = tsoilcumm(:)
2620
2621	DO j=2,nvm
2622	DO i=1,npts
2623
2624	IF ((devstage(i,j) .LE. 0.0) .AND. ( (tameanw(i) .GT. trep) .OR. &
2625	(regcount(i,j) .EQ. 2) ) ) THEN
2626
2627	devstage(i,j) = MAX(0.0, tameand(i) - tbase)/tasumrep
2628
2629	ELSEIF ((devstage(i,j) .GT. 0.0) .AND. &
2630	(tsoilmeand(i) .GT. tbase) .AND. &
2631	(devstage(i,j) .LT. 2.0) ) THEN
2632
2633	devstage(i,j) = devstage(i,j) + MAX(0.0, tameand(i) - &
2634	tbase)/tasumrep
2635
2636	ELSE
2637	devstage(i,j) = devstage(i,j)
2638
2639	ENDIF
2640	END DO ! npts
2641	END DO ! nvm
2642	END IF
2643
2644	IF (new_year) THEN
2645
2646	devstage(:,:) = 0.0
2647
2648	END IF
2649
2650	END SUBROUTINE cal_devstage
2651
2652	! module calculating tgrowth
2653	SUBROUTINE cal_tgrowth(&
2654	npts, dt, devstage, tjulian, new_day, &
2655	new_year, regcount, tcut, tgrowth)
2656
2657	INTEGER(i_std) , INTENT(in) :: npts
2658	REAL(r_std) , INTENT(in) :: dt
2659	INTEGER(i_std) , INTENT(in) :: tjulian ! julien day (d)
2660	LOGICAL , INTENT(in) :: new_day
2661	LOGICAL , INTENT(in) :: new_year
2662	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: devstage ! state of developpement
2663	INTEGER(i_std) , DIMENSION(npts,nvm), INTENT(in) :: regcount ! number of cut
2664	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tcut ! cut date
2665	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tgrowth ! regrowth time after last cut (d)
2666
2667	INTEGER(i_std) :: i,j
2668
2669	IF (new_day) THEN
2670
2671	! TGROWTH
2672	!(robson, m. j. et al., 1988)
2673	DO j=2,nvm
2674	WHERE ((devstage(:,j) .GT. 0.0) .AND. (tcut0(:,j) .LE. 0.0))
2675
2676	tcut0(:,j) = FLOAT(tjulian)
2677
2678	END WHERE
2679	END DO
2680
2681	DO j=2,nvm
2682	DO i=1,npts
2683	IF ((regcount(i,j) .EQ. 1) .AND. (tcut0(i,j) .LE. 0.0)) THEN
2684
2685	tgrowth(i,j) = 0.0
2686	ELSEIF (regcount(i,j) .EQ. 1) THEN
2687
2688	tgrowth(i,j) = tjulian - tcut0(i,j)
2689
2690	ELSE
2691
2692	tgrowth(i,j) = tjulian - tcut(i,j,regcount(i,j)-1)
2693
2694	ENDIF
2695	END DO ! npts
2696	END DO ! nvm
2697	END IF
2698
2699	IF (new_year) THEN
2700	tgrowth(:,:) = 0.0
2701	END IF
2702	END SUBROUTINE cal_tgrowth
2703
2704	! module updating soil status
2705	SUBROUTINE chg_sol_bio(&
2706	npts , &
2707	tjulian , &
2708	bm_to_litter , &
2709	litter , &
2710	litter_avail , &
2711	litter_not_avail , &
2712	! !spitfire
2713	! fuel_1hr, &
2714	! fuel_10hr, &
2715	! fuel_100hr, &
2716	! fuel_1000hr, &
2717	! !end spitfire
2718	litter_avail_totDM , &
2719	intake_litter , &
2720	biomass , &
2721	faecesc , &
2722	urinec , &
2723	fcOrganicFertmetabolic , &
2724	fcOrganicFertstruct , &
2725	fnOrganicFerturine , &
2726	fnOrganicFertstruct , &
2727	fnOrganicFertmetabolic , &
2728	trampling , &
2729	YIELD_RETURN , &
2730	harvest_gm, cinput_gm)
2731
2732	INTEGER , INTENT(in) :: npts
2733	INTEGER(i_std) , INTENT(in) :: tjulian ! jour julien
2734	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter
2735	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter
2736	REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail
2737	REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_not_avail
2738	! !spitfire
2739	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1hr
2740	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_10hr
2741	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_100hr
2742	! REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1000hr
2743	! !end spitfire
2744	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout):: litter_avail_totDM
2745	REAL(r_std), DIMENSION(npts,nvm), INTENT(in):: intake_litter
2746	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: faecesc
2747	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: urinec
2748	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass
2749	! totalité de masse sèche du shoot(kg/m**2)
2750	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fcOrganicFertmetabolic
2751	! metabolic C in slurry and manure (kg C/m**2/d)
2752	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fcOrganicFertstruct
2753	! structural C in slurry and manure (kg C/m**2/d)
2754	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFerturine
2755	! urine N in slurry and manure (kg N/m**2/d)
2756	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFertstruct
2757	! structural N in slurry and manure (kg N/m**2/d)
2758	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFertmetabolic
2759	! metabolic N in slurry and manure (kg N/m**2/d)
2760	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: trampling
2761	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: YIELD_RETURN
2762
2763	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: harvest_gm
2764	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cinput_gm
2765
2766	REAL(r_std), DIMENSION(npts,nvm) :: litter_avail_totDM_old
2767	REAL(r_std), DIMENSION(npts,nvm) :: fcloss
2768	REAL(r_std), DIMENSION(npts,nvm) :: fnloss
2769	REAL(r_std), DIMENSION(npts,nvm) :: floss
2770	REAL(r_std), DIMENSION(npts,nvm) :: fcplantsoil
2771	REAL(r_std), DIMENSION(npts,nvm) :: fnplantsoil
2772	REAL(r_std), DIMENSION(npts,nvm) :: fplantsoil
2773	REAL(r_std), DIMENSION(npts,nvm) :: l2nratio
2774	REAL(r_std), DIMENSION(npts,nvm) :: fmetabolic
2775	REAL(r_std), DIMENSION(npts,nvm) :: manure_barn
2776	INTEGER(i_std) :: j
2777	REAL(r_std), PARAMETER :: yieldloss = 0.05
2778	! !spitfire
2779	! REAL(r_std), DIMENSION(npts,nvm,nlitt) :: fuel_all_type
2780	! REAL(r_std), DIMENSION(npts,nvm,nlitt,4) :: fuel_type_frac
2781	! !end spitfire
2782
2783	IF (blabla_pasim) PRINT *, 'PASIM main grassland : call chg_sol_bio'
2784	fmetabolic = 0.0
2785
2786	! !spitfire
2787	! fuel_type_frac(:,:,:,:) = zero
2788	! fuel_all_type(:,:,:) = fuel_1hr(:,:,:) + fuel_10hr(:,:,:) + &
2789	! fuel_100hr(:,:,:) + fuel_1000hr(:,:,:)
2790	! WHERE (fuel_all_type(:,:,:) .GT. min_stomate)
2791	! fuel_type_frac(:,:,:,1) = fuel_1hr(:,:,:)/fuel_all_type(:,:,:)
2792	! fuel_type_frac(:,:,:,2) = fuel_10hr(:,:,:)/fuel_all_type(:,:,:)
2793	! fuel_type_frac(:,:,:,3) = fuel_100hr(:,:,:)/fuel_all_type(:,:,:)
2794	! fuel_type_frac(:,:,:,4) = fuel_1000hr(:,:,:)/fuel_all_type(:,:,:)
2795	! ENDWHERE
2796	! !end spitfire
2797
2798	DO j=2,nvm
2799	! tlossstart will be set to tjulian when cutting is trigered at the point
2800	! deltat = 1.000000
2801	WHERE ((tjulian .GE. tlossstart(:,j)) .AND. &
2802	(tjulian .LT. (tlossstart(:,j) + deltat/2.0)))
2803
2804	fcloss(:,j) = lossc(:,j)/deltat
2805	fnloss(:,j) = lossn(:,j)/deltat
2806	floss(:,j) = loss(:,j) /deltat
2807	! loss is 5% of total harvest, 95% is exported out of ecosystem
2808	! kgC m-2 day-1 -> g C m-2 day-1
2809	harvest_gm(:,j) = fcloss(:,j)/yieldloss(1-yieldloss)1e3
2810
2811	ELSEWHERE
2812
2813	fcloss(:,j) = zero
2814	fnloss(:,j) = zero
2815	floss(:,j) = zero
2816	harvest_gm(:,j) = zero
2817	END WHERE
2818
2819	cinput_gm(:,j) = (fcOrganicFertstruct(:,j)+fcOrganicFertmetabolic(:,j))*1e3
2820
2821	fcplantsoil(:,j) = fcloss(:,j)
2822	fnplantsoil(:,j) = fnloss(:,j)
2823	fplantsoil(:,j) = floss(:,j)
2824
2825	WHERE (fnplantsoil(:,j) .GT. 0.0)
2826
2827	l2nratio(:,j) = fligninresidue * fplantsoil(:,j)/ fnplantsoil(:,j)
2828
2829	ELSEWHERE
2830
2831	l2nratio(:,j) = 0.0
2832
2833	END WHERE
2834
2835	IF (is_grassland_cut(j).AND.(.NOT.is_grassland_grazed(j)))THEN
2836
2837	! Manure produced at barn
2838	! 0.05 yieldloss 0.95 import_yield/harvest 0.85 loss during trasportation
2839	! 0.12 fraction of manure spread to field in total intake dry matter at barn (0.85*0.95harvest)
2840	!JCcomment for accounting for Manurefert only not return
2841	! WHERE (YIELD_RETURN(:,:) .GT. 0.0)
2842	! manure_barn(:,j) = fcplantsoil(:,j) / 0.05 * 0.95 * 0.85 *0.12 +&
2843	! YIELD_RETURN(:,:) * CtoDM
2844	! YIELD_RETURN(:,:) = 0.0
2845	! ELSEWHERE
2846	! manure_barn(:,j) = fcplantsoil(:,j) / 0.05 * 0.95 * 0.85 *0.12
2847	! ENDWHERE
2848	manure_barn(:,j) = 0.0
2849
2850	ELSE
2851	manure_barn(:,j) = 0.0
2852	END IF
2853
2854	fmetabolic(:,j) = MAX(0.625,MIN(0.85 - 0.018 * l2nratio(:,j), 1.0 - fligninresidue))
2855	bm_to_litter(:,j,ileaf,icarbon) = bm_to_litter(:,j,ileaf,icarbon) + &
2856	& fmetabolic(:,j) * (fcplantsoil(:,j) * 1000.0 + trampling(:,j))
2857
2858	bm_to_litter(:,j,isapabove,icarbon) = bm_to_litter(:,j,isapabove,icarbon) + &
2859	& (1.0 - fmetabolic(:,j)) * (fcplantsoil(:,j) * 1000.0 + trampling(:,j))
2860	litter_avail_totDM_old(:,j) = litter_avail_totDM(:,j)
2861	! new litter available tot DM after intake litter
2862	litter_avail_totDM(:,j) = litter_avail_totDM(:,j) - intake_litter(:,j)
2863	IF (ANY(litter_avail_totDM(:,j) .LT. -0.01 ) ) THEN
2864	WRITE(numout,*) 'zd ','litter avail', j, litter_avail_totDM_old(:,j)
2865	WRITE(numout,*) 'zd ','intake litter', j, intake_litter(:,j)
2866	STOP 'available litter is not enough for grazing'
2867
2868	ENDIF
2869	! litter available C left is recalculated
2870	! assuming the same structural and metabolic fraction
2871	WHERE (litter_avail_totDM_old(:,j) .GT. 0.0 )
2872	litter_avail(:,istructural,j) = litter_avail(:,istructural,j) * &
2873	& (litter_avail_totDM(:,j)/litter_avail_totDM_old(:,j))
2874	litter_avail(:,imetabolic,j) = litter_avail(:,imetabolic,j) * &
2875	& (litter_avail_totDM(:,j)/litter_avail_totDM_old(:,j))
2876	ELSEWHERE
2877	litter_avail(:,istructural,j) = litter_avail(:,istructural,j)
2878	litter_avail(:,imetabolic,j) = litter_avail(:,imetabolic,j)
2879	ENDWHERE
2880	! new litter not available after manure/urine
2881
2882	litter_not_avail(:,istructural,j) = litter_not_avail(:,istructural,j) + &
2883	& (faecesc(:,j) + urinec(:,j) + manure_barn(:,j) ) * 1000.0 * (1.0 - fmetabolic(:,j)) + &
2884	& fcOrganicFertstruct(:,j) * 1000.0
2885
2886	litter_not_avail(:,imetabolic,j) = litter_not_avail(:,imetabolic,j) + &
2887	& (faecesc(:,j) + urinec(:,j) + manure_barn(:,j) ) * 1000.0 * fmetabolic(:,j) + &
2888	& fcOrganicFertmetabolic(:,j) * 1000.0
2889	! update litter
2890	litter(:,:,j,iabove,icarbon) = litter_avail(:,:,j) + litter_not_avail(:,:,j)
2891	! !spitfire
2892	! fuel_1hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,1)
2893	! fuel_10hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,2)
2894	! fuel_100hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,3)
2895	! fuel_1000hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,4)
2896	! !endspit
2897
2898	END DO
2899	END SUBROUTINE chg_sol_bio
2900
2901	! clear memory used by grassland management module
2902	SUBROUTINE grassmanag_clear
2903	IF (ALLOCATED(intake)) DEALLOCATE(intake)
2904	IF (ALLOCATED(intakemax)) DEALLOCATE(intakemax)
2905	IF (ALLOCATED(intake_litter)) DEALLOCATE(intake_litter)
2906	IF (ALLOCATED(intake_animal_litter)) DEALLOCATE(intake_animal_litter)
2907	IF (ALLOCATED(grazing_litter)) DEALLOCATE(grazing_litter)
2908	IF (ALLOCATED(litter_avail_totDM)) DEALLOCATE(litter_avail_totDM)
2909	IF (ALLOCATED(wshtotcutinit)) DEALLOCATE(wshtotcutinit)
2910	IF (ALLOCATED(lcutinit)) DEALLOCATE(lcutinit)
2911	IF (ALLOCATED(devstage)) DEALLOCATE(devstage)
2912	IF (ALLOCATED(faecesc)) DEALLOCATE(faecesc)
2913	IF (ALLOCATED(faecesn)) DEALLOCATE(faecesn)
2914	IF (ALLOCATED(urinen)) DEALLOCATE(urinen)
2915	IF (ALLOCATED(urinec)) DEALLOCATE(urinec)
2916	IF (ALLOCATED(nel)) DEALLOCATE(nel)
2917	IF (ALLOCATED(nanimaltot)) DEALLOCATE(nanimaltot)
2918	IF (ALLOCATED(tgrowth)) DEALLOCATE(tgrowth)
2919	IF (ALLOCATED(wsh)) DEALLOCATE(wsh)
2920	IF (ALLOCATED(wshtot)) DEALLOCATE(wshtot)
2921	IF (ALLOCATED(wshtotinit)) DEALLOCATE(wshtotinit)
2922	IF (ALLOCATED(wr)) DEALLOCATE(wr)
2923	IF (ALLOCATED(wrtot)) DEALLOCATE(wrtot)
2924	IF (ALLOCATED(wanimal)) DEALLOCATE(wanimal)
2925	IF (ALLOCATED(ntot)) DEALLOCATE(ntot)
2926	IF (ALLOCATED(c)) DEALLOCATE(c)
2927	IF (ALLOCATED(n)) DEALLOCATE(n)
2928	IF (ALLOCATED(fn)) DEALLOCATE(fn)
2929	IF (ALLOCATED(napo)) DEALLOCATE(napo)
2930	IF (ALLOCATED(nsym)) DEALLOCATE(nsym)
2931	IF (ALLOCATED(wnapo)) DEALLOCATE(wnapo)
2932	IF (ALLOCATED(wnsym)) DEALLOCATE(wnsym)
2933	IF (ALLOCATED(wn)) DEALLOCATE(wn)
2934	IF (ALLOCATED(nanimal)) DEALLOCATE(nanimal)
2935	IF (ALLOCATED(tanimal)) DEALLOCATE(tanimal)
2936	IF (ALLOCATED(danimal)) DEALLOCATE(danimal)
2937	IF (ALLOCATED(tcut)) DEALLOCATE(tcut)
2938	IF (ALLOCATED(tfert)) DEALLOCATE(tfert)
2939	IF (ALLOCATED(Nliquidmanure)) DEALLOCATE(Nliquidmanure)
2940	IF (ALLOCATED(nslurry)) DEALLOCATE(nslurry)
2941	IF (ALLOCATED(Nsolidmanure)) DEALLOCATE(Nsolidmanure)
2942	IF (ALLOCATED(legume_fraction)) DEALLOCATE(legume_fraction)
2943	IF (ALLOCATED(soil_fertility)) DEALLOCATE(soil_fertility)
2944	IF (ALLOCATED(Animalwgrazingmin)) DEALLOCATE(Animalwgrazingmin)
2945	IF (ALLOCATED(AnimalkintakeM)) DEALLOCATE(AnimalkintakeM)
2946	IF (ALLOCATED(AnimalDiscremineQualite)) DEALLOCATE(AnimalDiscremineQualite)
2947	IF (ALLOCATED(controle_azote)) DEALLOCATE(controle_azote)
2948	IF (ALLOCATED(fcOrganicFertmetabolicsum)) DEALLOCATE(fcOrganicFertmetabolicsum)
2949	IF (ALLOCATED(fcOrganicFertstructsum)) DEALLOCATE(fcOrganicFertstructsum)
2950	IF (ALLOCATED(fnOrganicFertmetabolicsum)) DEALLOCATE(fnOrganicFertmetabolicsum)
2951	IF (ALLOCATED(fnOrganicFertstructsum)) DEALLOCATE(fnOrganicFertstructsum)
2952	IF (ALLOCATED(fnOrganicFerturinesum)) DEALLOCATE(fnOrganicFerturinesum)
2953	IF (ALLOCATED(fnatmsum)) DEALLOCATE(fnatmsum)
2954	IF (ALLOCATED(controle_azote_sum)) DEALLOCATE(controle_azote_sum)
2955	IF (ALLOCATED(nfertamm)) DEALLOCATE(nfertamm)
2956	IF (ALLOCATED(nfertnit)) DEALLOCATE(nfertnit)
2957	IF (ALLOCATED(intakesum)) DEALLOCATE(intakesum)
2958	IF (ALLOCATED(intakensum)) DEALLOCATE(intakensum)
2959	IF (ALLOCATED(intake_animal)) DEALLOCATE(intake_animal)
2960	IF (ALLOCATED(intake_animalsum)) DEALLOCATE(intake_animalsum)
2961	IF (ALLOCATED(PIYcow)) DEALLOCATE(PIYcow)
2962	IF (ALLOCATED(PIMcow)) DEALLOCATE(PIMcow)
2963	IF (ALLOCATED(BCSYcow)) DEALLOCATE(BCSYcow)
2964	IF (ALLOCATED(BCSMcow)) DEALLOCATE(BCSMcow)
2965	IF (ALLOCATED(PICcow)) DEALLOCATE(PICcow)
2966	IF (ALLOCATED(AGE_cow_P)) DEALLOCATE(AGE_cow_P)
2967	IF (ALLOCATED(AGE_cow_M)) DEALLOCATE(AGE_cow_M)
2968	IF (ALLOCATED(Autogestion_out)) DEALLOCATE(Autogestion_out)
2969	IF (ALLOCATED(Forage_quantity)) DEALLOCATE(Forage_quantity)
2970	IF (ALLOCATED(tcut_modif)) DEALLOCATE(tcut_modif)
2971	IF (ALLOCATED(countschedule)) DEALLOCATE(countschedule)
2972	IF (ALLOCATED(mux)) DEALLOCATE(mux)
2973	IF (ALLOCATED(mugmean)) DEALLOCATE(mugmean)
2974	IF (ALLOCATED(sigx)) DEALLOCATE(sigx)
2975	IF (ALLOCATED(sigy)) DEALLOCATE(sigy)
2976	IF (ALLOCATED(gmeanslope)) DEALLOCATE(gmeanslope)
2977	IF (ALLOCATED(gzero)) DEALLOCATE(gzero)
2978	IF (ALLOCATED(gcor)) DEALLOCATE(gcor)
2979	IF (ALLOCATED(cuttingend)) DEALLOCATE(cuttingend)
2980	IF (ALLOCATED(tcut_verif)) DEALLOCATE(tcut_verif)
2981	IF (ALLOCATED(tfert_verif)) DEALLOCATE(tfert_verif)
2982	IF (ALLOCATED(tfert_verif2)) DEALLOCATE(tfert_verif2)
2983	IF (ALLOCATED(tfert_verif3)) DEALLOCATE(tfert_verif3)
2984	IF (ALLOCATED(regcount)) DEALLOCATE(regcount)
2985	IF (ALLOCATED(wshcutinit)) DEALLOCATE(wshcutinit)
2986	IF (ALLOCATED(gmean)) DEALLOCATE(gmean)
2987	IF (ALLOCATED(tgmean)) DEALLOCATE(tgmean)
2988	IF (ALLOCATED(wc_frac)) DEALLOCATE(wc_frac)
2989	IF (ALLOCATED(wgn)) DEALLOCATE(wgn)
2990	IF (ALLOCATED(tasum)) DEALLOCATE(tasum)
2991	IF (ALLOCATED(loss)) DEALLOCATE(loss)
2992	IF (ALLOCATED(lossc)) DEALLOCATE(lossc)
2993	IF (ALLOCATED(lossn)) DEALLOCATE(lossn)
2994	IF (ALLOCATED(tlossstart)) DEALLOCATE(tlossstart)
2995	IF (ALLOCATED(flag_fertilisation)) DEALLOCATE(flag_fertilisation)
2996	IF (ALLOCATED(fertcount)) DEALLOCATE(fertcount)
2997	IF (ALLOCATED(c2nratiostruct)) DEALLOCATE(c2nratiostruct)
2998	IF (ALLOCATED(nfertammtot)) DEALLOCATE(nfertammtot)
2999	IF (ALLOCATED(nfertnittot)) DEALLOCATE(nfertnittot)
3000	IF (ALLOCATED(nfertammtotyear)) DEALLOCATE(nfertammtotyear)
3001	IF (ALLOCATED(nfertnittotyear)) DEALLOCATE(nfertnittotyear)
3002	IF (ALLOCATED(nfertammtotprevyear)) DEALLOCATE(nfertammtotprevyear)
3003	IF (ALLOCATED(nfertnittotprevyear)) DEALLOCATE(nfertnittotprevyear)
3004	IF (ALLOCATED(fcOrganicFertmetabolic)) DEALLOCATE(fcOrganicFertmetabolic)
3005	IF (ALLOCATED(fcOrganicFertstruct)) DEALLOCATE(fcOrganicFertstruct)
3006	IF (ALLOCATED(fnOrganicFerturine)) DEALLOCATE(fnOrganicFerturine)
3007	IF (ALLOCATED(fnOrganicFertstruct)) DEALLOCATE(fnOrganicFertstruct)
3008	IF (ALLOCATED(fnOrganicFertmetabolic)) DEALLOCATE(fnOrganicFertmetabolic)
3009	IF (ALLOCATED(nsatur_somerror_temp)) DEALLOCATE(nsatur_somerror_temp)
3010	IF (ALLOCATED(nsatur_somerror)) DEALLOCATE(nsatur_somerror)
3011	IF (ALLOCATED(tfert_modif)) DEALLOCATE(tfert_modif)
3012	IF (ALLOCATED(nnonlimit_SOMerror)) DEALLOCATE(nnonlimit_SOMerror)
3013	IF (ALLOCATED(nnonlimit_SOMerrormax)) DEALLOCATE(nnonlimit_SOMerrormax)
3014	IF (ALLOCATED(controle_azote_sum_mem)) DEALLOCATE(controle_azote_sum_mem)
3015	IF (ALLOCATED(n_auto)) DEALLOCATE(n_auto)
3016	IF (ALLOCATED(stoplimitant)) DEALLOCATE(stoplimitant)
3017	IF (ALLOCATED(fertcount_start)) DEALLOCATE(fertcount_start)
3018	IF (ALLOCATED(fertcount_current)) DEALLOCATE(fertcount_current)
3019	IF (ALLOCATED(wshtotsumprev)) DEALLOCATE(wshtotsumprev)
3020	IF (ALLOCATED(fertil_year)) DEALLOCATE(fertil_year)
3021	IF (ALLOCATED(toto)) DEALLOCATE(toto)
3022	IF (ALLOCATED(apport_azote)) DEALLOCATE(apport_azote)
3023	IF (ALLOCATED(trampling)) DEALLOCATE(trampling)
3024	IF (ALLOCATED(wshtotsumprevyear)) DEALLOCATE(wshtotsumprevyear)
3025	IF (ALLOCATED(file_management)) DEALLOCATE(file_management)
3026	IF (ALLOCATED(tmp_sr_ugb_C3)) DEALLOCATE(tmp_sr_ugb_C3)
3027	IF (ALLOCATED(tmp_nb_ani_C3)) DEALLOCATE(tmp_nb_ani_C3)
3028	IF (ALLOCATED(tmp_grazed_frac_C3)) DEALLOCATE(tmp_grazed_frac_C3)
3029	IF (ALLOCATED(tmp_import_yield_C3)) DEALLOCATE(tmp_import_yield_C3)
3030	IF (ALLOCATED(tmp_wshtotsum_C3)) DEALLOCATE(tmp_wshtotsum_C3)
3031	IF (ALLOCATED(tmp_sr_ugb_C4)) DEALLOCATE(tmp_sr_ugb_C4)
3032	IF (ALLOCATED(tmp_nb_ani_C4)) DEALLOCATE(tmp_nb_ani_C4)
3033	IF (ALLOCATED(tmp_grazed_frac_C4)) DEALLOCATE(tmp_grazed_frac_C4)
3034	IF (ALLOCATED(tmp_import_yield_C4)) DEALLOCATE(tmp_import_yield_C4)
3035	IF (ALLOCATED(tmp_wshtotsum_C4)) DEALLOCATE(tmp_wshtotsum_C4)
3036	IF (ALLOCATED(DM_cutyearly)) DEALLOCATE(DM_cutyearly)
3037	IF (ALLOCATED(C_cutyearly)) DEALLOCATE(C_cutyearly)
3038	IF (ALLOCATED(YIELD_RETURN)) DEALLOCATE(YIELD_RETURN)
3039	IF (ALLOCATED(sr_ugb_init)) DEALLOCATE(sr_ugb_init)
3040	IF (ALLOCATED(N_fert_total)) DEALLOCATE(N_fert_total)
3041	IF (ALLOCATED(ndeposition)) DEALLOCATE(ndeposition)
3042	IF (ALLOCATED(compt_cut)) DEALLOCATE(compt_cut)
3043	IF (ALLOCATED(frequency_cut)) DEALLOCATE(frequency_cut)
3044	IF (ALLOCATED(sr_wild)) DEALLOCATE(sr_wild)
3045	IF (ALLOCATED(flag_cutting)) DEALLOCATE(flag_cutting)
3046	! from applic_plant
3047	IF (ALLOCATED(tamean1)) DEALLOCATE(tamean1)
3048	IF (ALLOCATED(tamean2)) DEALLOCATE(tamean2)
3049	IF (ALLOCATED(tamean3)) DEALLOCATE(tamean3)
3050	IF (ALLOCATED(tamean4)) DEALLOCATE(tamean4)
3051	IF (ALLOCATED(tamean5)) DEALLOCATE(tamean5)
3052	IF (ALLOCATED(tamean6)) DEALLOCATE(tamean6)
3053	IF (ALLOCATED(tameand)) DEALLOCATE(tameand)
3054	IF (ALLOCATED(tameanw)) DEALLOCATE(tameanw)
3055	IF (ALLOCATED(tacumm)) DEALLOCATE(tacumm)
3056	IF (ALLOCATED(tacummprev)) DEALLOCATE(tacummprev)
3057	IF (ALLOCATED(tsoilcumm)) DEALLOCATE(tsoilcumm)
3058	IF (ALLOCATED(tsoilcummprev)) DEALLOCATE(tsoilcummprev)
3059	IF (ALLOCATED(tsoilmeand)) DEALLOCATE(tsoilmeand)
3060	IF (ALLOCATED(tcut0)) DEALLOCATE(tcut0)
3061	IF (ALLOCATED(Fert_sn)) DEALLOCATE(Fert_sn)
3062	IF (ALLOCATED(Fert_on)) DEALLOCATE(Fert_on)
3063	IF (ALLOCATED(Fert_PRP)) DEALLOCATE(Fert_PRP)
3064	CALL animal_clear
3065
3066	END SUBROUTINE grassmanag_clear
3067
3068	! ________________________________________________________________
3069	! Functions read management.dat text file (not used for non-site simulation
3070	! ________________________________________________________________
3071
3072	SUBROUTINE reading_new_animal(&
3073	npts , &
3074	nb_year_management, &
3075	tcutmodel , &
3076	tcut , &
3077	tfert , &
3078	nfertamm , &
3079	nfertnit , &
3080	nanimal , &
3081	tanimal , &
3082	danimal , &
3083	nliquidmanure , &
3084	nslurry , &
3085	nsolidmanure , &
3086	PIYcow , &
3087	PIMcow , &
3088	BCSYcow , &
3089	BCSMcow , &
3090	PICcow , &
3091	AGE_cow_P , &
3092	AGE_cow_M , &
3093	Forage_quantity)
3094
3095	INTEGER (i_std) , INTENT(in) :: npts
3096	INTEGER(i_std) , INTENT(in) :: tcutmodel
3097	INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: nb_year_management
3098	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tcut
3099	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tfert
3100	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertamm
3101	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertnit
3102	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nanimal
3103	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tanimal
3104	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: danimal
3105	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nliquidmanure
3106	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nslurry
3107	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nsolidmanure
3108	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PIYcow
3109	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PIMcow
3110	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: BCSYcow
3111	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: BCSMcow
3112	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PICcow
3113	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: AGE_cow_P
3114	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: AGE_cow_M
3115	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: Forage_quantity
3116
3117	REAL(r_std), DIMENSION(nstocking) :: nanimal_t
3118	REAL(r_std), DIMENSION(nstocking) :: tanimal_t
3119	REAL(r_std), DIMENSION(nstocking) :: danimal_t
3120	REAL(r_std), DIMENSION(nstocking) :: tcut_t
3121	REAL(r_std), DIMENSION(nstocking) :: tfert_t
3122	REAL(r_std), DIMENSION(nstocking) :: nfertamm_t
3123	REAL(r_std), DIMENSION(nstocking) :: nfertnit_t
3124	REAL(r_std), DIMENSION(nstocking) :: nliquidmanure_t
3125	REAL(r_std), DIMENSION(nstocking) :: nslurry_t
3126	REAL(r_std), DIMENSION(nstocking) :: nsolidmanure_t
3127
3128	REAL(r_std), DIMENSION(nstocking) :: PIYcow_t
3129	REAL(r_std), DIMENSION(nstocking) :: PIMcow_t
3130	REAL(r_std), DIMENSION(nstocking) :: BCSYcow_t
3131	REAL(r_std), DIMENSION(nstocking) :: BCSMcow_t
3132	REAL(r_std), DIMENSION(nstocking) :: PICcow_t
3133	REAL(r_std), DIMENSION(nstocking) :: AGE_cow_P_t
3134	REAL(r_std), DIMENSION(nstocking) :: AGE_cow_M_t
3135	REAL(r_std), DIMENSION(nstocking) :: Forage_quantity_t
3136
3137	INTEGER(i_std) :: ier, i, year, fin,j
3138	CHARACTER(len=200) :: description
3139
3140	DO j=2,nvm
3141	OPEN(unit=60, file = file_management(j))
3142
3143	READ(60, * , iostat = ier) description
3144	read_management : IF (tcutmodel .EQ. 0) THEN
3145	IF (blabla_pasim) PRINT *, 'USERS MANAGEMENT'
3146
3147	IF (nb_year_management(j) .LT. 1 ) STOP 'error with the nb_year_management'
3148
3149	IF (MOD(count_year,nb_year_management(j)) .EQ. 0) THEN
3150	fin = nb_year_management(j)
3151	ELSE
3152	fin = MOD(count_year,nb_year_management(j))
3153	END IF
3154
3155	DO year = 1, fin
3156	READ(60, *, iostat=ier) tcut_t(:)
3157	READ(60, *, iostat=ier) tfert_t(:)
3158	READ(60, *, iostat=ier) nfertamm_t(:)
3159	READ(60, *, iostat=ier) nfertnit_t(:)
3160	READ(60, *, iostat=ier) nanimal_t(:)
3161	READ(60, *, iostat=ier) tanimal_t(:)
3162	READ(60, *, iostat=ier) danimal_t(:)
3163	READ(60, *, iostat=ier) nliquidmanure_t(:)
3164	READ(60, *, iostat=ier) nslurry_t(:)
3165	READ(60, *, iostat=ier) nsolidmanure_t(:)
3166
3167	READ(60, *, iostat=ier) PIYcow_t(:)
3168	READ(60, *, iostat=ier) PIMcow_t(:)
3169	READ(60, *, iostat=ier) BCSYcow_t(:)
3170	READ(60, *, iostat=ier) BCSMcow_t(:)
3171	READ(60, *, iostat=ier) PICcow_t(:)
3172	READ(60, *, iostat=ier) AGE_cow_P_t(:)
3173	READ(60, *, iostat=ier) AGE_cow_M_t(:)
3174	READ(60, *, iostat=ier) Forage_quantity_t(:)
3175	DO i=1,npts
3176	nanimal(i,j,:)=nanimal_t(:)
3177	tanimal(i,j,:)=tanimal_t(:)
3178	danimal(i,j,:)=danimal_t(:)
3179	tcut(i,j,:)=tcut_t(:)
3180	tfert(i,j,:)=tfert_t(:)
3181	nfertamm(i,j,:)=nfertamm_t(:)
3182	nfertnit(i,j,:)=nfertnit_t(:)
3183	nliquidmanure(i,j,:)=nliquidmanure_t(:)
3184	nslurry(i,j,:)=nslurry_t(:)
3185	nsolidmanure(i,j,:)=nsolidmanure_t(:)
3186
3187	PIYcow(i,j,:)=PIYcow_t(:)
3188	PIMcow(i,j,:)=PIMcow_t(:)
3189	BCSYcow(i,j,:)=BCSYcow_t(:)
3190	BCSMcow(i,j,:)=BCSMcow_t(:)
3191	PICcow(i,j,:)=PICcow_t(:)
3192	AGE_cow_P(i,j,:)=AGE_cow_P_t(:)
3193	AGE_cow_M(i,j,:)=AGE_cow_M_t(:)
3194	Forage_quantity(i,j,:)=Forage_quantity_t(:)
3195
3196	END DO
3197	END DO
3198
3199	ELSE IF (tcutmodel .EQ. 1) THEN
3200
3201	PRINT *, 'AUTO MANAGEMENT'
3202	READ(61, *, iostat = ier) toto(:)
3203	READ(61, *, iostat = ier) toto(:)
3204	READ(61, *, iostat = ier) toto(:)
3205	READ(61, *, iostat = ier) toto(:)
3206
3207	READ(60, *, iostat=ier) nanimal_t
3208	DO i=1,npts
3209	nanimal(i,j,:)=nanimal_t(:)
3210	END DO
3211	ELSE
3212
3213	STOP 'PASIM ERROR :: tcutmodel must be 0 or 1'
3214
3215	END IF read_management
3216	CLOSE(60)
3217	END DO !nvm
3218	END SUBROUTINE reading_new_animal
3219
3220	! subroutine for reading management from map nc file
3221
3222	SUBROUTINE reading_map_manag(&
3223	npts, lalo, neighbours, resolution, contfrac, &
3224	count_year , &
3225	nb_year_management, &
3226	management_intensity, &
3227	management_start, &
3228	tcut , &
3229	tfert , &
3230	nfertamm , &
3231	nfertnit , &
3232	nanimal , &
3233	tanimal , &
3234	danimal , &
3235	nliquidmanure , &
3236	nslurry , &
3237	nsolidmanure , &
3238	legume_fraction, &
3239	soil_fertility , &
3240	deposition_start, &
3241	ndeposition, &
3242	sr_ugb, &
3243	sr_wild)
3244
3245	INTEGER (i_std) , INTENT(in) :: npts
3246	INTEGER(i_std),DIMENSION(npts,8),INTENT(in) :: neighbours !!Neighoring grid points if land for the DGVM
3247	!!(unitless)
3248	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo !!Geographical coordinates (latitude,longitude)
3249	!! for pixels (degrees)
3250	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution !! Size in x an y of the grid (m) - surface area of
3251	!! the gridbox
3252	REAL(r_std),DIMENSION (npts), INTENT (in) :: contfrac !! Fraction of continent in the grid cell (unitless)
3253	INTEGER (i_std) , INTENT(in) :: count_year
3254	INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: nb_year_management
3255	INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: management_intensity
3256	INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: management_start
3257	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tcut
3258	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tfert
3259	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertamm
3260	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertnit
3261	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nanimal
3262	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tanimal
3263	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: danimal
3264	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nliquidmanure
3265	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nslurry
3266	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nsolidmanure
3267	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: legume_fraction
3268	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: soil_fertility
3269	INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: deposition_start
3270	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: ndeposition
3271	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: sr_ugb
3272	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: sr_wild
3273	! new variables for get map of management
3274	REAL(r_std), DIMENSION(npts) :: nfert_temp
3275	REAL(r_std), DIMENSION(npts) :: nmanure_temp
3276	REAL(r_std), DIMENSION(npts) :: nanimal_temp
3277	REAL(r_std), DIMENSION(npts) :: tcut_temp
3278	REAL(r_std), DIMENSION(npts) :: grazing_temp
3279	REAL(r_std), DIMENSION(npts) :: wild_temp
3280	INTEGER(i_std) :: management_year
3281	INTEGER(i_std) :: deposition_year
3282	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage1
3283	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage2
3284	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage3
3285	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage4
3286	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage5
3287	REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage6
3288	INTEGER(i_std) :: j
3289	! CROP spec
3290	INTEGER(i_std) :: yrlen
3291	CHARACTER(LEN=30) :: strManage
3292	CHARACTER(LEN=30) :: strVar1
3293	CHARACTER(LEN=30) :: strVar2
3294	CHARACTER(LEN=30) :: strVar3
3295	CHARACTER(LEN=30) :: strVar4
3296	CHARACTER(LEN=30) :: strVar5
3297	CHARACTER(LEN=30) :: strVar6
3298	!initialize variables
3299	tcut(:,:,:) = 500.0
3300	tfert(:,:,:) = 500.0
3301	nfertamm(:,:,:) = 0.0
3302	nfertnit(:,:,:) = 0.0
3303	nanimal(:,:,:) = 0.0
3304	tanimal(:,:,:) = 500.0
3305	danimal(:,:,:) = 0.0
3306	nliquidmanure(:,:,:) = 0.0
3307	nslurry(:,:,:) = 0.0
3308	nsolidmanure(:,:,:) = 0.0
3309
3310	legume_fraction(:,:) =0.0
3311	soil_fertility(:,:) = 1.0
3312	ndeposition(:,:) = 0.0
3313
3314	nfert_temp(:) =0.0
3315	nmanure_temp(:) =0.0
3316	nanimal_temp(:) = 0.0
3317	grazing_temp(:) =0.0
3318	wild_temp(:) =0.0
3319
3320	!JCMODIF to avoid read nc file many times (cost lot of CPU time)
3321	! modify the processes to read only once the file and save all variables
3322	! then put the temporary variables to PFTs that need it
3323	! though in this case the ManagInput module is only for postauto = 5
3324	! rather than general reading
3325	yrlen=1
3326	! read file
3327	! fixed variable name
3328	! if run non-global simulation, should still present all 6 variables
3329	strManage = "GRM_MANAGEMENT_MAP"
3330	strVar1 = "Ndep"
3331	strVar2 = "Nmanure"
3332	strVar3 = "Nmineral"
3333	strVar4 = "Tfert"
3334	strVar5 = "sr_ugb"
3335	strVar6 = "sr_wild"
3336
3337	CALL slowproc_GRM_ManageInput(npts,lalo,neighbours,resolution,contfrac, &
3338	strManage,strVar1,manage1,strVar2,manage2,strVar3,manage3,&
3339	strVar4,manage4,strVar5,manage5,strVar6,manage6,yrlen)
3340	! JCADD add this for grids fail to read grid (fopt=0)
3341	WHERE (manage1 .EQ. val_exp)
3342	manage1 = 0.0
3343	ENDWHERE
3344	WHERE (manage2 .EQ. val_exp)
3345	manage2 = 0.0
3346	ENDWHERE
3347	WHERE (manage3 .EQ. val_exp)
3348	manage3 = 0.0
3349	ENDWHERE
3350	! Tfert default is 500 (no Tfert)
3351	WHERE (manage4 .EQ. val_exp)
3352	manage4 = 500.0
3353	ENDWHERE
3354	WHERE (manage5 .EQ. val_exp)
3355	manage5 = 0.0
3356	ENDWHERE
3357	WHERE (manage6 .EQ. val_exp)
3358	manage6 = 0.0
3359	ENDWHERE
3360
3361	DO j=2,nvm
3362	! NOT necessary in reading 2D management since they are all 1 year per
3363	! file
3364	! IF (nb_year_management(j) .LT. 1 ) STOP 'error with the nb_year_management'
3365	! get which year of management should be read
3366	IF (MOD(count_year,nb_year_management(j)) .EQ. 0) THEN
3367	management_year = nb_year_management(j) + management_start(j)-1
3368	deposition_year = nb_year_management(j) + deposition_start(j)-1
3369	ELSE
3370	management_year = MOD(count_year,nb_year_management(j)) + management_start(j)-1
3371	deposition_year = MOD(count_year,nb_year_management(j)) + deposition_start(j)-1
3372	END IF
3373	WRITE(numout,*) management_year,deposition_year
3374	!!!! read deposition global file for all grassland including nature
3375	IF ( (.NOT. is_tree(j)) .AND. natural(j) .AND. (f_deposition_map .EQ. 1)) THEN
3376	ndeposition(:,j)=manage1(:,1,1)
3377	ELSE
3378	ndeposition(:,j)=0.0
3379	ENDIF
3380	!!!! read fertilization global file
3381	IF (management_intensity(j) .EQ. 4) THEN
3382	nslurry(:,j,1)=manage2(:,1,1)/10000.
3383	nfertamm(:,j,1)=0.5*manage3(:,1,1)/10000.
3384	nfertnit(:,j,1)=0.5*manage3(:,1,1)/10000.
3385	! tfert at global scale is not defined, set to 1st April
3386	tfert(:,j,1) = manage4(:,1,1)
3387	!JC comment for now the tfert is only available for grid with mineral N input
3388	tfert(:,j,1)=90
3389	ENDIF
3390	!!!! read sr_ugb global file
3391	IF (f_postauto .EQ. 5 .AND. f_grazing_map .EQ. 1) THEN
3392	sr_ugb(:,mgraze_C3)=manage5(:,1,1)/10000.
3393	sr_ugb(:,mgraze_C4)=manage5(:,1,1)/10000.
3394	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.001)
3395	sr_ugb(:,mgraze_C3) = 0.001
3396	sr_ugb(:,mgraze_C4) = 0.001
3397	END WHERE
3398	if (ANY(sr_ugb(:,mgraze_C3) .EQ. 0.001)) then
3399	print *, 'error sr_ugb',sr_ugb(:,mgraze_C3)
3400	endif
3401	!!!! read sr_wild global file wild animal density
3402	!!!! only natural grassland will be grazed by wild animal
3403	!!!! only when f_autogestion = 5 or f_postauto = 5
3404	IF ((.NOT. is_tree(j)) .AND. natural(j) .AND. &
3405	& (.NOT. is_grassland_cut(j)) .AND. &
3406	& (.NOT.is_grassland_grazed(j)) .AND. &
3407	& is_grassland_wild(j)) THEN
3408	sr_wild(:,j)=manage6(:,1,1)/10000.
3409	ENDIF
3410	ENDIF
3411
3412	IF (management_intensity(j) .EQ. 1) THEN
3413	! low intensity of management in Europe ; NOT used anymore
3414	ELSEIF (management_intensity(j) .EQ. 2) THEN
3415	! middle intensity of management in Europe ; for Leip et al., data only
3416	nslurry(:,j,1)=manage2(:,1,1)/10000.
3417	nfertamm(:,j,1)=0.5*manage3(:,1,1)/10000.
3418	nfertnit(:,j,1)=0.5*manage3(:,1,1)/10000.
3419	tfert(:,j,1)=90!manage4(:,1,1)
3420	ELSEIF (management_intensity(j) .EQ. 3) THEN
3421	! high intensity of management in Europe ; NOT used anymore
3422	ENDIF
3423
3424	END DO ! nvm
3425	END SUBROUTINE reading_map_manag
3426
3427	! subrouting calculate Nitrogen effect to vcmax
3428	SUBROUTINE calc_N_limfert(&
3429	npts,nfertamm, nfertnit,&
3430	nliquidmanure, nslurry, nsolidmanure,&
3431	legume_fraction,soil_fertility,ndeposition,&
3432	N_fert_total,N_limfert)
3433
3434	INTEGER (i_std) , INTENT(in) :: npts
3435	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertamm
3436	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertnit
3437	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nliquidmanure
3438	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nslurry
3439	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nsolidmanure
3440	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: legume_fraction
3441	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: soil_fertility
3442	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: N_fert_total
3443	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: N_limfert
3444	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: ndeposition
3445
3446	INTEGER(i_std) :: k,j
3447
3448	N_fert_total(:,:) = 0.0
3449	DO k=1,nstocking
3450	N_fert_total(:,:) = (N_fert_total(:,:) + nfertamm(:,:,k) + &
3451	nfertnit(:,:,k) + nliquidmanure(:,:,k) + &
3452	nslurry(:,:,k) + nsolidmanure(:,:,k))
3453	ENDDO
3454	N_fert_total(:,:) = N_fert_total(:,:) * 10000. + ndeposition(:,:)
3455	N_fert_total(:,1) = 0.0
3456	! DO j=2,nvm
3457	! IF ((management_intensity(j) .EQ. 2).AND. (.NOT. is_c4(j))) THEN
3458	! N_fert_total(:,mcut_C3)=N_fert_total(:,j)
3459	! N_fert_total(:,mgraze_C3)=N_fert_total(:,j)
3460	! ENDIF
3461	! IF ((management_intensity(j) .EQ. 2).AND. (is_c4(j))) THEN
3462	! N_fert_total(:,mcut_C4)=N_fert_total(:,j)
3463	! N_fert_total(:,mgraze_C4)=N_fert_total(:,j)
3464	! ENDIF
3465	!
3466	! ENDDO
3467	!JCADD new fertilization effect
3468	! linear
3469	!N_limfert(:,:) = 1.0 + (1.60-1.0)/320 * N_fert_total(:,:)
3470	! index
3471	N_limfert(:,:) = 1. + N_effect - N_effect * (0.75 ** (N_fert_total(:,:)/30))
3472
3473	WHERE (N_limfert(:,:) .LT. 1.0)
3474	N_limfert(:,:) = 1.0
3475	ELSEWHERE (N_limfert(:,:) .GT. 2.0)
3476	N_limfert(:,:) = 1.+N_effect
3477	ENDWHERE
3478
3479	END SUBROUTINE calc_N_limfert
3480
3481	! Author: Xuhui Wang
3482	! Date: Oct. 18th, 2010
3483	! Interpolate (extract) Planting Date information
3484	! for a specific crop type
3485	! Modified by Jinfeng Chang
3486	! Date: Dec. 1st, 2014
3487	! General management map reading for grassland management module
3488	! Modified by Jinfeng Chang
3489	! Date: Apr. 21st, 2016
3490	! to speed up the running, only open management file once
3491	! reading all variables
3492	SUBROUTINE slowproc_GRM_ManageInput(npts,lalo,neighbours,resolution,contfrac, &
3493	strIn,varname1,manage1,varname2,manage2,varname3,manage3,&
3494	varname4,manage4,varname5,manage5,varname6,manage6,yrlen)
3495
3496	! INTEGER, parameter :: i_std = 4
3497	! REAL, parameter :: r_std = 8
3498	!
3499	! 0.1 INPUT
3500	!
3501	INTEGER(i_std), INTENT(in) :: npts ! Number of points for which the data needs to be interpolated (extracted)
3502	REAL(r_std), INTENT(in) :: lalo(npts,2) ! Vector of latitude and longtitude
3503	INTEGER(i_std), INTENT(in) :: neighbours(npts,8) ! Vectors of neighbours for each grid point
3504	! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
3505	REAL(r_std),INTENT(in) :: resolution(npts,2) ! The size in km of each grid box in lat and lon
3506	!REAL(r_std) :: resolution(npts,2) ! The size in km of each
3507	!grid box in lat and lon
3508	REAL(r_std),INTENT(in) :: contfrac(npts) ! The fraction of land in each grid box
3509	CHARACTER(LEN=30),INTENT(in) :: strIn ! getin parameter and Call Sign of the management data
3510	CHARACTER(LEN=30),INTENT(in) :: varname1 ! variable name in the nc file
3511	CHARACTER(LEN=30),INTENT(in) :: varname2 ! variable name in the nc file
3512	CHARACTER(LEN=30),INTENT(in) :: varname3 ! variable name in the nc file
3513	CHARACTER(LEN=30),INTENT(in) :: varname4 ! variable name in the nc file
3514	CHARACTER(LEN=30),INTENT(in) :: varname5 ! variable name in the nc file
3515	CHARACTER(LEN=30),INTENT(in) :: varname6 ! variable name in the nc file
3516
3517	!
3518	! 0.2 OUTPUT
3519	!
3520	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage1(:,:,:) ! The planting date of the crop: npts, veg, year
3521	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage2(:,:,:)
3522	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage3(:,:,:)
3523	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage4(:,:,:)
3524	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage5(:,:,:)
3525	REAL(r_std),ALLOCATABLE, INTENT(out) :: manage6(:,:,:)
3526	! nvm is the number of PFTs, there may not be planting date for all the PFTs
3527	INTEGER(i_std), INTENT(out) :: yrlen ! year length of the output matrix
3528	!
3529	! 0.3 LOCAL
3530	!
3531	INTEGER(i_std) :: nbvmax ! a parameter for interpolation
3532	REAL(r_std) :: myres(npts,2)
3533	CHARACTER(LEN=80) :: filename
3534	INTEGER(i_std) :: iml, jml, lml, tml, fid, fid1
3535	INTEGER(i_std) :: ip, jp, ib, ilf, fopt, it ! for-loop variable
3536	INTEGER(i_std) :: nbexp
3537	REAL(r_std) :: lev(1), date, dt
3538	REAL(r_std) :: missing_val
3539	INTEGER(i_std) :: itau(1)
3540
3541	INTEGER(i_std) :: nb_dim
3542	INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w
3543	LOGICAL :: l_ex
3544
3545	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel
3546	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat1 ! LON LAT VEGET, Time
3547	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat2
3548	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat3
3549	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat4
3550	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat5
3551	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat6
3552	! JC for loop variables
3553	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: manage_mat_all
3554	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_all
3555	INTEGER(i_std) :: nb_var_manag
3556	INTEGER(i_std) :: iv_manag
3557	! ENDJCADD
3558	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
3559	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: temp_data
3560	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area
3561	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index
3562
3563	REAL(r_std) :: sgn, sum_float
3564	INTEGER(i_std) :: ivgt ! , icyc, pltcyc
3565	CHARACTER(LEN=30) :: callsign
3566	LOGICAL :: ok_interpol
3567	INTEGER :: ALLOC_ERR
3568	LOGICAL :: mydebug = .true.
3569
3570	! ! croptype = TRIM(croptype) !if croptype is a string
3571	! ! else a switch expression is needed
3572	! filename = "/work/cont003/p529tan/WXH/plt_date_modif.nc" ! default input
3573	! file
3574	! ! String operation needed
3575	filename = "PlantingDate.nc"
3576	CALL getin_p(strIn,filename)
3577
3578	IF (is_root_prc) THEN
3579	! ? what does is_root_prc mean?
3580	CALL flininfo(filename, iml, jml, lml, tml, fid)
3581	ENDIF
3582	CALL bcast(iml)
3583	CALL bcast(jml)
3584	! CALL bcast(lml)
3585	! CALL bcast(tml)
3586
3587	! Printing information for debugging
3588	IF (mydebug) THEN
3589	WRITE(numout, *) "Xuhui's debug info for slowproc_ManageInput #1:"
3590	WRITE(numout, *) "string in: ", strIn
3591	WRITE(numout, *) "variable name: ", varname1,varname2,varname3,&
3592	varname4,varname5,varname6
3593	WRITE(numout, *) "filename is: ", filename
3594	WRITE(numout, *) "Dimension 1, lon, iml:", iml
3595	WRITE(numout, *) "Dimension 2, lat, jml:", jml
3596	WRITE(numout, *) "Dimension 3, veget, lml:", lml
3597	WRITE(numout, *) "Dimension 4, time, tml:", tml
3598	ENDIF
3599	! apparently, flinget function is not designed to take veget but levels to
3600	! be the
3601	! 3rd dimension, modification to lml is needed
3602
3603	!JG all flio calls must be done by is_root_prc
3604	IF (is_root_prc) THEN
3605	CALL flioopfd(filename,fid1)
3606	! JC here only use dimension of the first variable
3607	CALL flioinqv(fid1,v_n=varname1, l_ex = l_ex, nb_dims = nb_dim, len_dims =l_d_w)
3608	IF (lml == 0) THEN
3609	! CALL
3610	! flioinqv(fid1,v_n="PLNTDT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w)
3611	lml=l_d_w(3)
3612	IF (mydebug) THEN
3613	WRITE(numout, *) "len_dims: ", l_d_w
3614	WRITE(numout, *) "lml AFTER revision"
3615	WRITE(numout, *) "lml: ", lml
3616	ENDIF
3617	ENDIF
3618	IF (mydebug) THEN
3619	WRITE(numout,*) "nb_dim: ", nb_dim
3620	WRITE(numout,*) "resolution: ", resolution(1,:)
3621	ENDIF
3622
3623	IF (nb_dim .NE. 4) THEN
3624	WRITE(numout,*) "dimension not supported for ", nb_dim
3625	ENDIF
3626	tml = l_d_w(4)
3627	!yrlen = tml
3628	END IF
3629	IF (mydebug) THEN
3630	WRITE(numout, *) "Now the tml is, :", tml
3631	WRITE(numout, *) "Now the lml is:", lml
3632	ENDIF
3633
3634	!JG REMVOVE CALL flioclo(fid1)
3635	CALL bcast(lml)
3636	CALL bcast(tml)
3637	CALL bcast(nb_dim)
3638	! CALL bcast(plantcyc)
3639
3640	! JG yrlen must not be done after bcast(tml)
3641	yrlen = tml
3642	nb_var_manag = INT(6)
3643
3644	ALLOC_ERR=-1
3645	ALLOCATE(manage_all(nb_var_manag,npts,lml,tml),STAT=ALLOC_ERR)
3646	IF (ALLOC_ERR/=0) THEN
3647	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3648	ENDIF
3649	WRITE(numout,*) "manage ALLOCATED"
3650	!CALL bcast(manage)
3651	ALLOC_ERR=-1
3652	ALLOCATE(manage1(npts,lml,tml),STAT=ALLOC_ERR)
3653	IF (ALLOC_ERR/=0) THEN
3654	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3655	ENDIF
3656	WRITE(numout,*) "manage ALLOCATED"
3657	!CALL bcast(manage)
3658	ALLOC_ERR=-1
3659	ALLOCATE(manage2(npts,lml,tml),STAT=ALLOC_ERR)
3660	IF (ALLOC_ERR/=0) THEN
3661	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3662	ENDIF
3663	WRITE(numout,*) "manage ALLOCATED"
3664	!CALL bcast(manage)
3665	ALLOC_ERR=-1
3666	ALLOCATE(manage3(npts,lml,tml),STAT=ALLOC_ERR)
3667	IF (ALLOC_ERR/=0) THEN
3668	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3669	ENDIF
3670	WRITE(numout,*) "manage ALLOCATED"
3671	!CALL bcast(manage)
3672	ALLOC_ERR=-1
3673	ALLOCATE(manage4(npts,lml,tml),STAT=ALLOC_ERR)
3674	IF (ALLOC_ERR/=0) THEN
3675	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3676	ENDIF
3677	WRITE(numout,*) "manage ALLOCATED"
3678	!CALL bcast(manage)
3679	ALLOC_ERR=-1
3680	ALLOCATE(manage5(npts,lml,tml),STAT=ALLOC_ERR)
3681	IF (ALLOC_ERR/=0) THEN
3682	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3683	ENDIF
3684	WRITE(numout,*) "manage ALLOCATED"
3685	!CALL bcast(manage)
3686	ALLOC_ERR=-1
3687	ALLOCATE(manage6(npts,lml,tml),STAT=ALLOC_ERR)
3688	IF (ALLOC_ERR/=0) THEN
3689	WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
3690	ENDIF
3691	WRITE(numout,*) "manage ALLOCATED"
3692	!CALL bcast(manage)
3693	!
3694	ALLOC_ERR=-1
3695	ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
3696	IF (ALLOC_ERR/=0) THEN
3697	WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
3698	STOP
3699	ENDIF
3700	! CALL bcast(lat_rel)
3701
3702	ALLOC_ERR=-1
3703	ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
3704	IF (ALLOC_ERR/=0) THEN
3705	WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
3706	STOP
3707	ENDIF
3708	! CALL bcast(lon_rel)
3709
3710	ALLOC_ERR=-1
3711	ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
3712	IF (ALLOC_ERR/=0) THEN
3713	WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
3714	STOP
3715	ENDIF
3716	! CALL bcast(mask)
3717
3718
3719	ALLOC_ERR=-1
3720	ALLOCATE(manage_mat_all(nb_var_manag,iml,jml,lml,tml), STAT=ALLOC_ERR)
3721	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3722	IF (ALLOC_ERR/=0) THEN
3723	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3724	STOP
3725	ENDIF
3726
3727	ALLOC_ERR=-1
3728	ALLOCATE(manage_mat1(iml,jml,lml,tml), STAT=ALLOC_ERR)
3729	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3730	IF (ALLOC_ERR/=0) THEN
3731	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3732	STOP
3733	ENDIF
3734	! CALL bcast(manage_mat)
3735	ALLOC_ERR=-1
3736	ALLOCATE(manage_mat2(iml,jml,lml,tml), STAT=ALLOC_ERR)
3737	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3738	IF (ALLOC_ERR/=0) THEN
3739	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3740	STOP
3741	ENDIF
3742	! CALL bcast(manage_mat)
3743	ALLOC_ERR=-1
3744	ALLOCATE(manage_mat3(iml,jml,lml,tml), STAT=ALLOC_ERR)
3745	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3746	IF (ALLOC_ERR/=0) THEN
3747	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3748	STOP
3749	ENDIF
3750	! CALL bcast(manage_mat)
3751	ALLOC_ERR=-1
3752	ALLOCATE(manage_mat4(iml,jml,lml,tml), STAT=ALLOC_ERR)
3753	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3754	IF (ALLOC_ERR/=0) THEN
3755	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3756	STOP
3757	ENDIF
3758	! CALL bcast(manage_mat)
3759	ALLOC_ERR=-1
3760	ALLOCATE(manage_mat5(iml,jml,lml,tml), STAT=ALLOC_ERR)
3761	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3762	IF (ALLOC_ERR/=0) THEN
3763	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3764	STOP
3765	ENDIF
3766	! CALL bcast(manage_mat)
3767	ALLOC_ERR=-1
3768	ALLOCATE(manage_mat6(iml,jml,lml,tml), STAT=ALLOC_ERR)
3769	! !lml is supposed to be nvm (number of PFTs), if not ,change it
3770	IF (ALLOC_ERR/=0) THEN
3771	WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
3772	STOP
3773	ENDIF
3774	! CALL bcast(manage_mat)
3775	! WRITE (numout,*) 'bcast manage_mat'
3776
3777	! input of some attributes
3778	IF (is_root_prc) THEN
3779	! JG with the flioclo, done before this was not ok. Now ok
3780	CALL flinget(fid, 'LON', iml, jml, lml, tml, 1, 1, lon_rel)
3781	CALL flinget(fid, 'LAT', iml, jml, lml, tml, 1, 1, lat_rel)
3782	ENDIF
3783	CALL bcast(lon_rel)
3784	CALL bcast(lat_rel)
3785	WRITE (numout,*) 'lon_rel size: ', SIZE(lon_rel)
3786	WRITE (numout,*) 'lat_rel size: ', SIZE(lat_rel)
3787
3788
3789	! input of the matrix
3790	IF (is_root_prc) THEN
3791	! CALL flinget(fid, 'PLNTDT', iml, jml, lml, tml, 1, 1, plntdt_mat)
3792	! JG remove CALL flioopfd: already done
3793	! CALL flioopfd(filename,fid1)
3794	CALL fliogetv(fid1,trim(varname1),manage_mat1,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3795	CALL fliogetv(fid1,trim(varname2),manage_mat2,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3796	CALL fliogetv(fid1,trim(varname3),manage_mat3,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3797	CALL fliogetv(fid1,trim(varname4),manage_mat4,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3798	CALL fliogetv(fid1,trim(varname5),manage_mat5,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3799	CALL fliogetv(fid1,trim(varname6),manage_mat6,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
3800	! get missing_val
3801	CALL fliogeta(fid1,varname1,'missing_value',missing_val)
3802
3803	CALL flioclo(fid1)
3804	ENDIF
3805	CALL bcast(manage_mat1)
3806	CALL bcast(manage_mat2)
3807	CALL bcast(manage_mat3)
3808	CALL bcast(manage_mat4)
3809	CALL bcast(manage_mat5)
3810	CALL bcast(manage_mat6)
3811	WRITE (numout,*) 'bcast manage_mat'
3812
3813	! JC combine matrix for loop
3814	manage_mat_all(1,:,:,:,:) = manage_mat1
3815	manage_mat_all(2,:,:,:,:) = manage_mat2
3816	manage_mat_all(3,:,:,:,:) = manage_mat3
3817	manage_mat_all(4,:,:,:,:) = manage_mat4
3818	manage_mat_all(5,:,:,:,:) = manage_mat5
3819	manage_mat_all(6,:,:,:,:) = manage_mat6
3820
3821	! WRITE(numout,*) 'manage_mat size: ',SIZE(manage_mat)
3822	! WRITE(numout,*) 'missing value: ', missing_val
3823	! WRITE(numout,*) 'lat(361,284): ',lat_rel(361,284)
3824	! WRITE(numout,*) 'lon(361,284): ',lon_rel(361,284)
3825	! WRITE(numout,*) 'plntdt(361,284,1,1): ',plntdt_mat(361,284,1,1)
3826
3827	IF (is_root_prc) CALL flinclo(fid)
3828
3829	manage1(:,:,:) = zero ! npts veget year
3830	manage2(:,:,:) = zero ! npts veget year
3831	manage3(:,:,:) = zero ! npts veget year
3832	manage4(:,:,:) = zero ! npts veget year
3833	manage5(:,:,:) = zero ! npts veget year
3834	manage6(:,:,:) = zero ! npts veget year
3835	manage_all(:,:,:,:) = zero
3836
3837	DO iv_manag = 1,nb_var_manag
3838	DO it = 1,tml
3839	DO ivgt = 1,lml ! ? We can suppose PFTs less than 10 are natural veg without planting date, but not now
3840	! IF (.NOT. natural(ivgt)) THEN
3841	WRITE(numout,*) "variable, veget, time: ",iv_manag, ivgt,it
3842	nbexp = 0
3843	! the number of exceptions
3844
3845	!JCCOMMENT GRM_input.nc for every grid value >=0
3846	! thus mask = un
3847	! mask of available value
3848	! mask(:,:) = zero; ! Defined in constante.f90
3849	IF (iv_manag .EQ. 1) THEN
3850	mask(:,:) = un
3851	! DO ip = 1,iml
3852	! DO jp = 1,jml
3853	! IF ((manage_mat_all(iv_manag,ip,jp,ivgt,it) .GT. min_sechiba) .AND. &
3854	! (manage_mat_all(iv_manag,ip,jp,ivgt,it) /= missing_val)) THEN
3855	! mask(ip,jp) = un; ! Defined in constante.f90
3856	! ! here we assumed that for each plant cycle at each
3857	! ! there might be missing data at different grid
3858	! ! in this case, mask has to be generated each plant
3859	! ! cycle each time step
3860	! ENDIF
3861	! ENDDO
3862	! ENDDO
3863
3864	! Interpolation started
3865	nbvmax = 200
3866	! the maximum amount of fine grids that one coarse grid may have
3867
3868	callsign = strIn
3869
3870	ok_interpol = .FALSE.
3871
3872	DO WHILE ( .NOT. ok_interpol )
3873	WRITE(numout,*) "Pojection arrays for ", callsign, ":"
3874	WRITE(numout,*) "nbvmax = ", nbvmax
3875
3876	ALLOC_ERR = -1
3877	ALLOCATE(temp_data(nbvmax,lml), STAT=ALLOC_ERR)
3878	IF (ALLOC_ERR /=0) THEN
3879	WRITE(numout,*) "ERROR IN ALLOCATION OF temp_data :", ALLOC_ERR
3880	STOP
3881	ENDIF
3882	ALLOC_ERR = -1
3883	ALLOCATE(sub_index(npts,nbvmax,2), STAT=ALLOC_ERR)
3884	IF (ALLOC_ERR /=0) THEN
3885	WRITE(numout,*) "ERROR IN ALLOCATION OF sub_index :", ALLOC_ERR
3886	STOP
3887	ENDIF
3888	sub_index(:,:,:) = zero
3889	ALLOC_ERR = -1
3890	ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR)
3891	IF (ALLOC_ERR /=0) THEN
3892	WRITE(numout,*) "ERROR IN ALLOCATION OF sub_area :",ALLOC_ERR
3893	STOP
3894	ENDIF
3895	sub_area(:,:) = zero
3896	myres(:,:) = resolution(:,:)/1000 !m -> km
3897	write(numout,*) "resolution updated: ", myres(1,:), " km"
3898	!CALL bcast(myres)
3899	! CALL bcast(myres)
3900
3901	write(,) "calling aggregate_p? "
3902	CALL aggregate_p(npts, lalo, neighbours, myres, contfrac, &
3903	& iml, jml, lon_rel, lat_rel, mask, callsign, &
3904	& nbvmax, sub_index, sub_area, ok_interpol)
3905	write(numout,*) "wu: we finished aggregate_p:) "
3906
3907	IF ( .NOT. ok_interpol ) THEN
3908	DEALLOCATE(temp_data)
3909	DEALLOCATE(sub_index)
3910	DEALLOCATE(sub_area)
3911	nbvmax = nbvmax * 2
3912	ENDIF
3913	ENDDO
3914
3915	WRITE(numout,*) "called aggregate_p"
3916	ENDIF ! only call aggregate once
3917	! assign the values to plantdate
3918	! values should be given to all PFTs
3919	DO ib = 1, npts
3920	! examing all sub_point we found
3921	fopt = COUNT(sub_area(ib,:)>zero)
3922
3923	! confirm that we found some points
3924	IF ( fopt .EQ. 0) THEN
3925	nbexp = nbexp + 1
3926	manage_all(iv_manag,ib,ivgt,it) = val_exp
3927	ELSE
3928	DO ilf = 1,fopt
3929	! !Not to get lat and lon in wrong order
3930	temp_data(ilf,ivgt) = manage_mat_all(iv_manag,sub_index(ib,ilf,1),sub_index(ib,ilf,2),ivgt,it)
3931	ENDDO
3932
3933	sgn = zero
3934	sum_float = zero
3935	DO ilf = 1,fopt
3936	! average the data weighted by area ! better to
3937	! multiply
3938	! PFT HERE
3939	! need to add management specific judgem
3940	sum_float = sum_float + temp_data(ilf,ivgt)*sub_area(ib,ilf)
3941	sgn = sgn + sub_area(ib,ilf)
3942	ENDDO
3943
3944	! Normalize the surface
3945	! sgn can be a scaler, however, to prepare it for future
3946	! incorporation of fraction
3947	! I make it a vector with nvm values which are equal to
3948	! each
3949	! other
3950	IF ( sgn .LT. min_sechiba) THEN
3951	nbexp = nbexp + 1
3952	manage_all(iv_manag,ib,ivgt,it) = val_exp ! plantdate_default(ivgt)
3953	ELSE
3954	! ANINT is used for plant date integer
3955	! BUT not for grassland management input
3956	!manage(ib,ivgt,it) = ANINT(sum_float/sgn)
3957	manage_all(iv_manag,ib,ivgt,it) = sum_float/sgn
3958	ENDIF
3959
3960	ENDIF
3961
3962	ENDDO ! ib
3963	WRITE(numout,*) 'fopt subarea',fopt!,sub_area
3964
3965	IF ( nbexp .GT. 0) THEN
3966	WRITE(numout,*) 'slowproc_ManageInput : exp_val was applied in', nbexp, 'grid(s)'
3967	WRITE(numout,*) 'slowproc_ManageInput : These are either coastal points or having missing data'
3968	ENDIF
3969	!JC keep the sub_area sub_index till all variables read
3970	! DEALLOCATE (sub_area)
3971	! DEALLOCATE (sub_index)
3972	! DEALLOCATE (temp_data)
3973	! WRITE(numout,*) 'Planting Date of Site 1 veget ',ivgt,' :
3974	! ',plantdate(1,ivgt,icyc)
3975	! ENDIF
3976	ENDDO
3977	! End of Veget cycle
3978	ENDDO
3979	! End of Time Axis cycle
3980	ENDDO
3981	! End of variables
3982	! JCADD
3983	DEALLOCATE (sub_area)
3984	DEALLOCATE (sub_index)
3985	DEALLOCATE (temp_data)
3986
3987	DEALLOCATE (lat_rel)
3988	DEALLOCATE (lon_rel)
3989	DEALLOCATE (mask)
3990	! JCADD multivariables
3991	manage1(:,:,:) = manage_all(1,:,:,:)
3992	manage2(:,:,:) = manage_all(2,:,:,:)
3993	manage3(:,:,:) = manage_all(3,:,:,:)
3994	manage4(:,:,:) = manage_all(4,:,:,:)
3995	manage5(:,:,:) = manage_all(5,:,:,:)
3996	manage6(:,:,:) = manage_all(6,:,:,:)
3997	DEALLOCATE (manage_mat1)
3998	DEALLOCATE (manage_mat2)
3999	DEALLOCATE (manage_mat3)
4000	DEALLOCATE (manage_mat4)
4001	DEALLOCATE (manage_mat5)
4002	DEALLOCATE (manage_mat6)
4003	DEALLOCATE (manage_mat_all)
4004	DEALLOCATE (manage_all)
4005
4006	WRITE (numout,*) 'Output Management Date:'
4007	WRITE (numout,*) 'time_step 1:'
4008	WRITE (numout,*) manage1(1,:,1), manage2(1,:,1), manage3(1,:,1), &
4009	manage4(1,:,1), manage5(1,:,1), manage6(1,:,1)
4010	IF (tml>1) THEN
4011	WRITE (numout,*) 'time_step 2:'
4012	WRITE (numout,*) manage1(1,:,2)
4013	ENDIF
4014	WRITE (numout,) 'END of DEBUG INFO slowproc_ManageInput*'
4015	RETURN
4016
4017	END SUBROUTINE slowproc_GRM_ManageInput
4018	! End of Edition by Xuhui, Mar. 16th 2011
4019
4020	END MODULE grassland_management

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

Download in other formats: