Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

grassland_management.f90 @ 6737

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

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

Context Navigation

source: branches/publications/ORCHIDEE_GLUC_r6545/src_stomate/grassland_management.f90 @ 6737

Download in other formats: