Context Navigation

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

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

Line
1	! =================================================================================================================================
2	! MODULE : grassland_grazing
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 This module excute grazing practice of
11	!! grassland management, (1) initialize variables used in grazing,
12	!! (2) calculate energy requirement of animal, (3) calculate
13	!! animal intake, (4) calculate biomass change and animal
14	!! trampling, (5) calculate milk/meat production,
15	!! (6) calculate animal respiration and enteric fermentation
16	!! methane emission, (7) calculate animal excreta (manure/urine),
17	!! (8) write animal related output
18	!!
19	!!\n DESCRIPTION : None
20	!!
21	!! RECENT CHANGE(S) : None
22	!!
23	!! REFERENCE(S) : None
24	!!
25	!! \n
26	!_
27	!================================================================================================================================
28	MODULE grassland_grazing
29
30	USE xios_orchidee
31	USE grassland_fonctions
32	USE grassland_constantes
33	USE stomate_data
34	USE constantes
35	USE ioipsl
36	USE ioipsl_para
37	! USE parallel
38
39	IMPLICIT NONE
40
41	PUBLIC animal_clear
42
43	LOGICAL, SAVE :: l_first_Animaux = .TRUE.
44	REAL(r_std), PARAMETER :: fnurine = 0.6
45	! repartition de n dans l'urine et les fèces (-)
46	REAL(r_std), PARAMETER :: kintake = 1.0
47	! parameter zu intake (m2/m2)
48	REAL(r_std), PARAMETER :: fmethane = 0.03
49	! c-pertes en méthane (-)
50	REAL(r_std), PARAMETER :: AnimalqintakeM = 3.0
51	REAL(r_std), PARAMETER :: franimal = 0.5
52	! c-pertes en respiration (-)
53
54	! parameter subroutine :: grazing_fonction
55	REAL(r_std), PARAMETER :: rf1 = 0.17
56	REAL(r_std), PARAMETER :: rf3 = 0.22
57	REAL(r_std), PARAMETER :: rf7 = 0.36
58	REAL(r_std ), PARAMETER :: t_seuil_OMD = 288.15
59	! threshold temperature for calculation of temperature effect on OMD (K)
60	!JCADD 05Feb2016 avoid wet grazing
61	REAL(r_std), PARAMETER :: ct_threshold = 10.0
62	REAL(r_std), PARAMETER :: ct_max = 12
63	REAL(r_std), PARAMETER :: moi_threshold = 0.99
64	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
65	!!!!!! Variables locales au module
66	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
67	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milk
68	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkn
69	! n dans le lait (kg n /(m*2d))
70	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkc
71	! c dans le lait (kg c /(m*2d))
72	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ranimal
73	! c perte en respiration (kg c /(m*2d))
74	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Methane
75	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesnsumprev
76	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkndaily
77	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesndaily
78	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinendaily
79	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milksum
80	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nelgrazingsum
81	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkcsum
82	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ranimalsum
83	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Methanesum
84	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinecsum
85	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecescsum
86	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesnsum
87	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinensum
88	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milknsum
89	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milknsumprev
90	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinensumprev
91	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: stockingstart
92	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: stockingend
93	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtotstart
94	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingc
95	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingn
96	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: forage_complementc
97	! C flux associated to complemtation with forage and concentrate (kg C m-2 d-1)
98	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: forage_complementn
99	! N flux associated to complemtation with forage and concentrate (kg C m-2 d-1)
100	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: forage_complementcsum
101	! C flux associated to complemtation with forage and concentrate (kg C m-2 d-1)
102	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: forage_complementnsum
103	! N flux associated to complemtation with forage and concentrate (kg C m-2 d-1)
104	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingsum
105	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingcsum
106	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingnsum
107	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingnsumprev
108	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingndaily
109	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: methane_ani
110	! Enteric methane emission per animal(kg C animal-1 d-1)
111	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: methane_aniSum
112	! Annual enteric methane emission per animal(kg C animal-1 )
113	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkanimalSum
114	! Annual milk production per animal(kg C animal-1 )
115	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: milkanimal
116	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ugb
117	! equals 0 (no animals) or 1 (animals)
118	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ok_ugb
119	! 1 if autogestion is optimal; 0 else
120	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: extra_feed
121	! Forage necessary to feed animals at barn when stocking rate autogestion (kg DM m-2)
122
123	!local module Variables for cow (npts,2) for young and adult cow
124	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Wanimalcow
125	! Animal liveweight (kg/animal) (young:1, adult:2)
126	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCScow
127	! Body score condition cow (young in first, and adult in second) (/5)
128	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCScow_prev
129	! previous Body score condition cow (young in first, and adult in second) (/5)
130	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: AGEcow
131	! Age of cow (necessary for dairy cow and not necessary for suckler cow) (month)
132
133	!Local modul variable for complementation
134	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Forage_quantity_period
135	! forage quantity for the current grazing period (Kg/Animal/d)
136
137	!local module variable for milk productivity cow
138	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcowsum
139	! Annual milk production of cows (young in first, and adult in second)(kg/y)
140	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcow2sum
141	! Annual milk production of a cow (young in first, and adult in second)(kg/animal/d)
142	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcow2_prec
143	! Daily actual milk production per animal for primiparous or multiparous cows at previous time step (kg/animal/d)
144
145
146	!local modul variable for Bilan N C cow
147	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcowN
148	! N in daily milk production per m2 for primiparous or multiparous cows (kgN/m2/d)
149	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcowC
150	! C in daily milk production per m2 for primiparous or multiparous cows (kgC/m2/d)
151	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcowCsum
152	! Cumulated C in milk production per m2 for primiparous or multiparous cows (kgC/m2)
153	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPcowNsum
154	! Cumulated N in milk production per m2 for primiparous or multiparous cows (kgN/m2)
155
156	!Intake cow
157	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIcowsum
158	! Cumulated intake per m2 for primiparous or multiparous cows(kg/m2)
159	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIcowNsum
160	! N in Cumulated intake per m2 for primiparous or multiparous cows(kgN/m2)
161	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIcowCsum
162	! C in Cumulated intake per m2 for primiparous or multiparous cows(kgC/m2)
163	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIcowanimalsum
164	! Cumulated animal intake for primiparous or multiparous cows(kg/animal)
165	!local module variable for calves
166	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Wanimalcalf
167	! Calf liveweigth (kg/animal)
168	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DMIcalfsum
169	! Cumulated calf intake per m2(kg/m2)
170	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DMIcalfnsum
171	! N in cumulated calf intake per m2(kgN/m2)
172	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DMIcalfanimalsum
173	! Cumulated calf intake per animal kg/animal)
174
175	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Tcalving
176	! Calving date (d)
177	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Tsevrage
178	! Suckling period of calves (d)
179	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Age_sortie_calf
180	! Calf age at sale (d)
181	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Pyoung
182	! Fraction of young or primiparous in the cattle (-)
183	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Wcalfborn
184	! Calf liveweigth at birth (kg/animal)
185	INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: calfinit
186	! Boolean to calf weight computation
187	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Wanimalcalfinit
188	! Initial calf liveweigth (kg/animal) (birth liveweight or liveweight at the beginning of the grazing period)
189	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nanimaltot_prec
190	! nanimaltot at previous time step (animal/m2)
191
192	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: Gestation
193	! equals 0 (outside of the gestation period) or 1 (during gestation)
194	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: Calf
195	! equals 0 (when calves are sale or at barn) or 1 (when calves are at pasture)
196
197	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: compte_pature
198	! Number of the pasture periode when stocking rate automanagement
199	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: autogestion_weightcow
200	! Initial cow liveweight when stocking rate automanagement (kg/animal)
201	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: autogestion_BCScow
202	! Initial BCS when stocking rate automanagement (-)
203	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: autogestion_AGEcow
204	! Initial age when stocking rate automanagement (months)
205	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: autogestion_init
206	! to intialize cow liveweight and BCS the first time step when f_autogestion=2
207	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: QIc
208	! to intialize concentrate amount per kg of milk per day or per kg of Liveweight per day (Kg)
209	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: EVf
210	! to intialize forage energy content (UF/kg)
211	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: FVf
212	! to intialize forage fill value (UE/kg)
213	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: EVc
214	! to intialize concentrate energy content(UF/kg)
215	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fN_forage
216	! Nitrogen fraction in the forage (kgN/kg)
217	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fN_concentrate
218	! Nitrogen fraction in the concentrate (kgN/kg)
219	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: NEBcow_prec
220	! Net energy Balance at previous time step (young:1, mature:2)
221	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: MPwmax
222	! Maximum of theoretical milk production (kg/animal/d)
223	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: Fday_pasture
224	! the first julian day of the actual pasture periode
225	INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: delai_ugb
226	! time before start grazing is possible
227	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Local_autogestion_out
228	! Fraction F (npts,1), ratio F (npts,2), and lenght of the grazing period when autgestion
229	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PEmax
230	! Perte d'etat maximale des vaches laitières sur la periode de paturage
231	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PEpos
232	! Perte d'etat possible des vaches laitières au jour j
233	REAL(r_std), SAVE :: BM_threshold
234	! Biomass threshold above which animals are moved out the paddock (kg/m2)
235	REAL(r_std), SAVE :: BM_threshold_turnout
236	! [autogestion] Biomass threshold above which animals are moved in the paddock (kg/m2)
237	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIc
238	! concentrate ingested with auto-complementation (dairy cow only)
239	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: DMIf
240	! forage ingested with auto-complementation (suckler cow only)
241
242	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: NER
243	! Net energy requirement (MJ)
244
245	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Substrate_grazingwc
246	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Substrate_grazingwn
247	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingcstruct
248	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingnstruct
249
250	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DNDFlam
251	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DNDF
252	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: NDF
253	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DNDFI
254	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DNDFstem
255	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: DNDFear
256	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: NDFmean
257	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: plam
258	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pstem
259	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pear
260	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: MassePondTot
261	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingstruct
262	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazinglam
263	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingstem
264	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazingear
265
266	! REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: nb_grazingdays
267	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: amount_yield
268	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: consump
269	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: outside_food
270	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: add_nb_ani
271	!JCADD
272	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: ct_dry
273	! counter determine the days of wet/dry soil
274	REAL(r_std), SAVE :: buffer_snow = 3
275	REAL(r_std), SAVE :: buffer_wet = 0.05
276	! flag that disable grazing by snowmass default FALSE = no impact
277	LOGICAL, SAVE :: disable_snowgrazing
278	! flag that disable grazing by wet soil default FALSE = no impact
279	LOGICAL, SAVE :: disable_wetgrazing
280	! flag that disable grazing by low air temperature < 273.15K default FALSE = no impact
281	LOGICAL, SAVE :: disable_coldgrazing
282	REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:) :: t2m_below_zero
283
284	!ENDJCADD
285	REAL(r_std), SAVE :: DNDFlam1 = 0.92
286	REAL(r_std), SAVE :: DNDFlam2 = 0.82
287	REAL(r_std), SAVE :: DNDFlam3 = 0.76
288	REAL(r_std), SAVE :: DNDFlam4 = 0.74
289
290	REAL(r_std), ALLOCATABLE, SAVE , DIMENSION(:,:) :: NDFlam !0.6
291	REAL(r_std), ALLOCATABLE, SAVE , DIMENSION(:,:) :: NDFstem !0.7
292	REAL(r_std), ALLOCATABLE, SAVE , DIMENSION(:,:) :: NDFear !0.8
293
294	REAL(r_std), SAVE :: DNDFstem1 = 0.84
295	REAL(r_std), SAVE :: DNDFstem2 = 0.65
296	REAL(r_std), SAVE :: DNDFstem3 = 0.53
297	REAL(r_std), SAVE :: DNDFstem4 = 0.50
298
299	REAL(r_std), SAVE :: DNDFear1 = 0.76
300	REAL(r_std), SAVE :: DNDFear2 = 0.48
301	REAL(r_std), SAVE :: DNDFear3 = 0.30
302	REAL(r_std), SAVE :: DNDFear4 = 0.26
303
304	REAL(r_std), SAVE :: LimDiscremine = 0.10
305
306	INTEGER(i_std) , SAVE :: mgraze_C3
307	INTEGER(i_std) , SAVE :: mgraze_C4
308	INTEGER(i_std) , SAVE :: mnatural_C3
309	INTEGER(i_std) , SAVE :: mnatural_C4
310
311	REAL(r_std), ALLOCATABLE, SAVE , DIMENSION(:,:) :: able_grazing
312
313	CONTAINS
314
315	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
316	!!!!!!!!!!!!!!!! FONCTION PRINCIPALE
317	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
318
319
320	SUBROUTINE Animaux_main(&
321	npts , &
322	dt , &
323	devstage , &
324	wsh , &
325	intakemax , &
326	snowfall_daily , &
327	wshtot , &
328	Animalwgrazingmin , &
329	AnimalkintakeM , &
330	nel , &
331	wanimal , &
332	nanimaltot , &
333	ntot , &
334	intake , &
335	urinen , &
336	faecesn , &
337	urinec , &
338	faecesc , &
339	tgrowth , &
340	new_year , &
341	new_day , &
342	nanimal , &
343	tanimal , &
344	danimal , &
345	tcutmodel , &
346	tjulian , &
347	import_yield , &
348	intakesum , &
349	intakensum , &
350	fn , &
351	c , &
352	n , &
353	leaf_frac , &
354	intake_animal , &
355	intake_animalsum , &
356	biomass,trampling,sr_ugb,sr_wild, &
357	compt_ugb,nb_ani,grazed_frac, &
358	AnimalDiscremineQualite, &
359	YIELD_RETURN,sr_ugb_init, &
360	year_count1,year_count2, &
361	grazing_litter, litter_avail_totDM, &
362	intake_animal_litter, intake_litter, &
363	nb_grazingdays, &
364	!JCADD top 5 layer grassland soil moisture for grazing
365	moiavail_daily, tmc_topgrass_daily,fc_grazing, &
366	after_snow, after_wet, wet1day, wet2day, &
367	snowmass_daily,t2m_daily, &
368	!ENDJCADD
369	ranimal_gm, ch4_pft_gm, Fert_PRP)
370	!!!!!!!!!!!!!!!!
371	! Déclaration des variables
372	!!!!!!!!!!!!!!!!
373
374	INTEGER(i_std) , INTENT(in) :: npts
375	REAL(r_std) , INTENT(in) :: dt
376	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: devstage
377	! stade de développement
378	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wsh
379	! totalité de masse sèche structurelle des pousses (kg/m**2) ----> total structural dry mass of shoots
380	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: intakemax
381	! Potential eating rate of lactating cows (kg/(GVEm*2) ----> potential intake
382	REAL(r_std), DIMENSION(npts) , INTENT(in) :: snowfall_daily
383	! neige ----> snow
384	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wshtot
385	! totalité de masse sèche de la pousse (kg/m**2) ----> total dry mass of the shoots
386	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: Animalwgrazingmin
387	! ????----> LiLH
388	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: AnimalkintakeM
389	! ????----> LiLH
390	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: nel
391	! énergie nette de lactation (mj/kg)
392	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wanimal
393	! weight of lactating cows (kg)
394	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: nanimaltot
395	! densité de paturage (gve/m**2)
396	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: ntot
397	! concentration totale en n
398	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: intake
399	! intake
400	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: urinen
401	! n dans l'urine (kg n /(m**2 d))
402	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: faecesn
403	! n dans les fèces (kg n /(m*2d))
404	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: urinec
405	! c dans les urines
406	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: faecesc
407	! c dans les fèces (kg c /(m*2d))
408	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: tgrowth
409	! instant de la repousse
410	LOGICAL , INTENT(in) :: new_year
411	LOGICAL , INTENT(in) :: new_day
412	INTEGER(i_std) , INTENT(in) :: tcutmodel
413	! flag for management
414	INTEGER(i_std) , INTENT(in) :: tjulian
415	! day julian
416	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nanimal
417	! densité du paturage h (1,..,nstocking) (gve/m**2)
418	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tanimal
419	! début du paturage h (1,..,nstocking) (d)
420	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: danimal
421	! durée du paturage h (1,..,nstocking) (d)
422	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: import_yield
423	! rendement de la prairie fauchee (g m-2 yr-1) (autogestion NV runs saturant nonlimitant)
424	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intakesum
425	! Yearly intake (kg animal-1 y-1)
426	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intakensum
427	! N in daily intake per m2(kgN/m2)
428	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fn
429	! nitrogen in structural dry matter
430	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: n
431	! nitrogen substrate concentration in plant,(kg n/kg)
432	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: c
433	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout):: leaf_frac
434	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_animal
435	! Daily intake per animal(kg animal-1 d-1)
436	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intake_animalsum
437	! Yearly intake per animal(kg animal-1 d-1)
438	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass
439	! totalité de masse sèche du shoot(kg/m**2)
440	REAL(r_std), DIMENSION(npts,nvm), INTENT(out):: trampling
441	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_ugb
442	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_wild
443	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: compt_ugb
444	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_ani
445	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: grazed_frac
446	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: AnimalDiscremineQualite
447	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: YIELD_RETURN
448	REAL(r_std), DIMENSION(npts), INTENT(in) :: sr_ugb_init
449	INTEGER(i_std) , INTENT(in) :: year_count1
450	INTEGER(i_std) , INTENT(in) :: year_count2
451	!JCADD for autogestion 5 grazing AGB and litter
452	! flag determine grazing litter (1) or AGB (0)
453	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(inout) :: grazing_litter
454	! available litter for grazing (exclude litter from manure) kg/DM/m^2
455	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: litter_avail_totDM
456	! daily animal intake per LSU 10 kgDM/LSU/day
457	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_animal_litter
458	! animal intake kgDM/m^2/day
459	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_litter
460	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_grazingdays
461	!ENDJCADD
462	!JCADD top 5 layer grassland soil moisture for grazing
463	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily
464	REAL(r_std),DIMENSION (npts), INTENT(in) :: tmc_topgrass_daily
465	REAL(r_std),DIMENSION (npts), INTENT(in) :: fc_grazing
466	REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_snow
467	REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_wet
468	REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet1day
469	REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet2day
470	REAL(r_std),DIMENSION (npts), INTENT(in) :: snowmass_daily
471	REAL(r_std),DIMENSION (npts), INTENT(in) :: t2m_daily
472	!ENDJCADD
473	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ranimal_gm
474	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ch4_pft_gm
475	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: Fert_PRP
476
477	INTEGER(i_std) :: h,i,j,k
478	REAL(r_std), DIMENSION(npts) :: xtmp_npts
479	REAL(r_std), DIMENSION(npts,nvm) :: wshtotgrazing
480	REAL(r_std), DIMENSION(npts,nvm) :: deltaanimal
481
482	INTEGER(i_std) :: type_animal
483	! local Variables:
484
485	REAL(r_std) , DIMENSION(npts,nvm) :: nb_ani_old
486	! Actual stocking rate per ha of total pasture "D" at previous iteration (animal (ha of total grassland)-1)
487	REAL(r_std) , DIMENSION(npts,2) :: tampon
488	REAL(r_std), DIMENSION(npts,nvm) :: wshtotinit
489
490	tampon=0.0
491
492
493	! 1 initialisation
494	init_animal : IF (l_first_animaux) THEN
495
496	IF (blabla_pasim) PRINT *, 'PASIM Animals : initialisation'
497
498	disable_wetgrazing = .FALSE.
499	CALL getin_p('DISABLE_WETGRAZING',disable_wetgrazing)
500	WRITE (numout,*) 'disable_wetgrazing',disable_wetgrazing
501
502	disable_snowgrazing = .FALSE.
503	CALL getin_p('DISABLE_SNOWGRAZING',disable_snowgrazing)
504	WRITE (numout,*) 'disable_snowgrazing',disable_snowgrazing
505
506	disable_coldgrazing = .FALSE.
507	CALL getin_p('DISABLE_COLDGRAZING',disable_coldgrazing)
508	WRITE (numout,*) 'disable_coldgrazing',disable_coldgrazing
509
510	CALL Animal_Init(npts, nanimal , type_animal , intake_tolerance)
511
512	CALL variablesPlantes(&
513	npts,biomass,&
514	c,n,intake_animal,intakemax,&
515	AnimalDiscremineQualite)
516	END IF init_animal
517
518	! 2 at the end of year EndOfYear
519	! updating grazing variables for restart and/or next year
520	n_year : IF (new_year .EQ. .TRUE. ) THEN
521
522	IF (blabla_pasim) PRINT *, 'PASIM Animals : initialisation pour une nouvelle année'
523
524	! 2.1 initialize variables
525	! not necessary for trunk restart every year
526	nanimaltot = 0.0
527	faecesnsum = 0.0
528	faecesnsumprev = 0.0
529	milksum = 0.0
530	nelgrazingsum = 0.0
531	milkcsum = 0.0
532	ranimalsum = 0.0
533	MethaneSum = 0.0
534	faecescsum = 0.0
535	urinecsum = 0.0
536	faecesnsum = 0.0
537	urinensum = 0.0
538	urinensumprev = 0.0
539	milknsum = 0.0
540	milknsumprev = 0.0
541	stockingstart = 0
542	stockingend = 0
543	grazingnsum = 0.0
544	grazingcsum = 0.0
545	grazingnsumprev= 0.0
546	grazingsum = 0.0
547	intake_animalsum = 0.0
548	intakesum = 0.0
549	intakensum = 0.0
550	milkanimalsum = 0.0
551	milkanimal = 0.0
552	methane_aniSum= 0.0
553
554	ugb = 0
555	!JCcomment for not start immidiently
556	! delai_ugb = -1
557	! print *, 'min_grazing', min_grazing
558	YIELD_RETURN=0.0
559	!************************************************
560	! modifications added by Nicolas Vuichard
561
562	!modif ugb0azot
563
564	!070703 AIG à confirmer
565	!******* Stocking rate calculation if grazing autogestion ********
566	! the model will pass the loop if flag "non limitant"
567	! The module calculates the optimal yield "Y" of a cut grassland plot,
568	! when optimizing cut events and N fertilisation.
569	! Then the model simulates the same grasslang plot with animals. Stocking rate "S"
570	! is incremented at each optimization step. For each stocking rate, the program
571	! determines the number of days for which animal in the barn (365 - compt_ugb(:))and
572	! thus, the forage necessary to feed them at the barn "X".
573	! The fraction F of grazed pastures is calculated as: Y (1-F) - X = 0
574	! F = Y /(Y+X)
575	! F = 1 / (1 + X/Y)
576	! Then the program calculates the actual stocking rate per ha of grazed pasture "D",
577	! D = SF
578	! code equivalences
579	! Y = import_yield
580	! X = extra_feed
581	! S = sr_ugb
582	! F = 1 / (1 + extra_feed(:) / (import_yield * 0.85))
583	! D = nb_ani
584	! 0.85 = 1 - 0.15: pertes à la récolte
585	!MODIF INN
586	! Pouvoir rentrer dans la boucle quand (f_autogestion .EQ. 2) AND (f_fertilization .EQ. 1)
587	IF ((tcutmodel .EQ. 0) .AND. (f_autogestion .EQ. 0) .AND. (f_postauto .EQ. 0)) THEN
588	nb_grazingdays(:,:)=compt_ugb(:,:)
589	compt_ugb(:,:) = 0
590	ENDIF
591
592	IF(f_nonlimitant .EQ. 0) THEN
593	!modif nico ugb
594	! mauto_C3 mauto_C4 auto grazing
595	IF (f_autogestion .EQ. 2) THEN
596	DO j=2,nvm
597	IF (is_grassland_manag(j) .AND. & !(.NOT. is_c4(j)) .AND. &
598	(.NOT. is_grassland_cut(j)).AND.(.NOT.is_grassland_grazed(j)))THEN
599	!equal to mauto_C3 and mauto_C4
600	WHERE ((ok_ugb(:,j) .EQ. 0))
601	! import_yield has been calculated when initialize in main
602	! grassland_management
603	!15.5 : amount of dry matter (Kg) per animal in stabulation
604	WHERE ( import_yield(:,j) .GT. 0.0 )
605	extra_feed(:,j) = (365 - compt_ugb(:,j)) * 18 * sr_ugb(:,j)
606	nb_ani_old(:,j) = nb_ani(:,j)
607	nb_ani(:,j) = 1 / (1 + extra_feed(:,j) / (import_yield(:,j) * 0.85)) * sr_ugb(:,j)
608	grazed_frac(:,j) = 1 / (1 + extra_feed(:,j) / (import_yield(:,j) * 0.85))
609	ELSEWHERE
610	nb_ani(:,j) = 0.0
611	grazed_frac(:,j) = 0.0
612	sr_ugb(:,j) =0.0
613	ok_ugb(:,j) = 1
614	ENDWHERE
615	!JCCOMMENT increment < 0.5% considering
616	! stop adding stocking rate
617	WHERE (((nb_ani(:,j)-nb_ani_old(:,j))/nb_ani(:,j)) .LT. 0.005 &
618	.AND. (grazed_frac(:,j) .LT. 0.7) .AND. &
619	(sr_ugb(:,j) .GT.0.0))
620	ok_ugb(:,j) = 1
621	sr_ugb(:,j) = sr_ugb(:,j) - 0.00001
622	! avoid all cut grassland
623	ELSEWHERE (grazed_frac(:,j) .LE. 0.25)
624	ok_ugb(:,j) = 1
625	sr_ugb(:,j) = sr_ugb(:,j) - 0.00001
626	ELSEWHERE
627	sr_ugb(:,j) = sr_ugb(:,j) + 0.00002
628	END WHERE
629	!JCCOMMENT move the check above to make sure it will not stop too early
630	! e.g., still grazed_frac > 0.7 but it stoped with ok_ugb = 1
631	! WHERE ((grazed_frac(:,j) .GT. 0.7).AND.(sr_ugb(:,j) .GT.0.0))
632	! sr_ugb(:,j) = sr_ugb(:,j) + 0.00001
633	! END WHERE
634	END WHERE ! ok_ugb
635	! save nb_grazingdays for restart and history write
636	nb_grazingdays(:,j) = compt_ugb(:,j)
637	compt_ugb(:,j) = 0
638	END IF ! manag + c3 or c4
639	END DO ! nvm
640	ENDIF ! autogestion=2
641	! f_autogestion = 3 4 5
642	!modif nico ugb
643	! 3: auto cut and graze for PFT m_cut and m_grazed with increasing sr_ugb
644	! search for curve of extra_feed requirement
645	! that compared to yield from fixing fraction of harvested grassland or
646	! crop feed
647	IF (f_autogestion .EQ. 3) THEN
648	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0))
649	extra_feed(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18 *sr_ugb(:,mgraze_C3)
650	sr_ugb(:,mgraze_C3) = sr_ugb(:,mgraze_C3) + 0.00001
651	END WHERE
652	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
653	compt_ugb(:,mgraze_C3) = 0
654	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0))
655	extra_feed(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18 *sr_ugb(:,mgraze_C4)
656	sr_ugb(:,mgraze_C4) = sr_ugb(:,mgraze_C4) + 0.00001
657	END WHERE
658	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
659	compt_ugb(:,mgraze_C4) = 0
660	ENDIF
661	! 4: auto cut and graze for PFT m_cut and m_grazed with constant sr_ugb
662	! search for extra_feed requirement with certain stocking rate
663	! under climate change or CO2 change
664	IF (f_autogestion .EQ. 4) THEN
665	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0))
666	amount_yield(:,mgraze_C3)=import_yield(:,mgraze_C3)
667	extra_feed(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18*sr_ugb(:,mgraze_C3)
668	END WHERE
669	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
670	compt_ugb(:,mgraze_C3) = 0
671	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0))
672	amount_yield(:,mgraze_C4)=import_yield(:,mgraze_C4)
673	extra_feed(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18*sr_ugb(:,mgraze_C4)
674	END WHERE
675	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
676	compt_ugb(:,mgraze_C4) = 0
677	ENDIF
678	! 5: auto graze for PFT m_grazed with grazing litter during winter for LGM
679	!JCADD for grazing biomass in summer and litter in winter
680	IF (f_autogestion .EQ. 5) THEN
681	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. &
682	& (compt_ugb(:,mgraze_C3) .GE. 310))
683	sr_ugb(:,mgraze_C3) = sr_ugb(:,mgraze_C3) + 0.000001
684	ELSEWHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. &
685	& (compt_ugb(:,mgraze_C3) .LT. 300))
686	sr_ugb(:,mgraze_C3) = sr_ugb(:,mgraze_C3) - 0.000001
687	END WHERE
688	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
689	compt_ugb(:,mgraze_C3) = 0
690	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. &
691	& (compt_ugb(:,mgraze_C4) .GE. 310))
692	sr_ugb(:,mgraze_C4) = sr_ugb(:,mgraze_C4) + 0.000001
693	ELSEWHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. &
694	& (compt_ugb(:,mgraze_C4) .LT. 300))
695	sr_ugb(:,mgraze_C4) = sr_ugb(:,mgraze_C4) - 0.000001
696	END WHERE
697	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
698	compt_ugb(:,mgraze_C4) = 0
699	ENDIF
700	!ENDJCADD
701
702	! start selection of f_postauto
703	!modif nico ugb
704	! NOTE: import_yield has been calculated in main_grassland_management
705	! just before EndOfYear here
706	IF ((f_postauto .EQ. 1) .OR. (f_postauto .EQ. 2)) THEN
707
708	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
709	extra_feed(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18.0*sr_ugb(:,mgraze_C3)
710	! total yield of las year (kg DM/m^2 total grassland)
711	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * (1-grazed_frac(:,mgraze_C3)) * 0.85
712	! total animal indoor consumption of last year (kg DM/m^2 total grassland)
713	consump(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18.0 * nb_ani(:,mgraze_C3)
714	! food surplus (outside_food > 0) or deficit (outside_food < 0)
715	outside_food(:,mgraze_C3) = amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
716	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0) animals
717	! 0.2 means that farmers' decision will based the on the mean status
718	! of the past 5 years
719	add_nb_ani(:,mgraze_C3) = outside_food(:,mgraze_C3)/ (18.0 * 365) * 0.2
720	!! New animal density for total grassland
721	nb_ani(:,mgraze_C3)=nb_ani(:,mgraze_C3)+add_nb_ani(:,mgraze_C3)
722	!! New fraction of grazed grassland in total grassland (keep the same stocking rate)
723	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0)
724	grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
725	ENDWHERE
726	WHERE (sr_ugb(:,mgraze_C3) .LE. 0.0)
727	grazed_frac(:,mgraze_C3)=0.0
728	sr_ugb(:,mgraze_C3)=0.0
729	nb_ani(:,mgraze_C3)=0.0
730	ENDWHERE
731	!! Threshold of fraction as least 30 % was cut
732	WHERE ((grazed_frac(:,mgraze_C3) .GT. 0.7) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
733	sr_ugb(:,mgraze_C3)=sr_ugb(:,mgraze_C3)+0.00001
734	grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
735	END WHERE
736	WHERE (grazed_frac(:,mgraze_C3) .GT. 1.0)
737	grazed_frac(:,mgraze_C3)=1.0
738	ENDWHERE
739	ELSEWHERE
740	! prevent the sr_ugb to be 0
741	! to give it possibility to re-increase
742	! especially for the first year when import_yield might be 0
743	sr_ugb(:,mgraze_C3) = 1e-6
744	nb_ani(:,mgraze_C3) = 5e-7
745	grazed_frac(:,mgraze_C3) = 0.5
746	amount_yield(:,mgraze_C3) = 0.0
747	outside_food(:,mgraze_C3) = 0.0
748	consump(:,mgraze_C3) = 0.0
749	add_nb_ani(:,mgraze_C3) = 0.0
750	END WHERE
751	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. (sr_ugb(:,mgraze_C4).GT. 0.0))
752	extra_feed(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) 18.0sr_ugb(:,mgraze_C4)
753	! total yield of las year (kg DM/m^2 total grassland)
754	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) (1-grazed_frac(:,mgraze_C4)) 0.85
755	! total animal indoor consumption of last year (kg DM/m^2 total grassland)
756	consump(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
757	! food surplus (outside_food > 0) or deficit (outside_food < 0)
758	outside_food(:,mgraze_C4) = amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
759	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0) animals
760	add_nb_ani(:,mgraze_C4) = outside_food(:,mgraze_C4)/ (18.0 365) 0.2
761	!! New animal density for total grassland
762	nb_ani(:,mgraze_C4)=nb_ani(:,mgraze_C4)+add_nb_ani(:,mgraze_C4)
763	!! New fraction of grazed grassland in total grassland (keep
764	!the same stocking rate)
765	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0)
766	grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
767	ENDWHERE
768	WHERE (sr_ugb(:,mgraze_C4) .LE. 0.0)
769	grazed_frac(:,mgraze_C4)=0.0
770	sr_ugb(:,mgraze_C4)=0.0
771	nb_ani(:,mgraze_C4)=0.0
772	ENDWHERE
773	!! Threshold of fraction as least 30 % was cut
774	WHERE ((grazed_frac(:,mgraze_C4) .GT. 0.7) .AND.(sr_ugb(:,mgraze_C4) .GT. 0.0))
775	sr_ugb(:,mgraze_C4)=sr_ugb(:,mgraze_C4)+0.00002
776	grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
777	END WHERE
778	WHERE (grazed_frac(:,mgraze_C4) .GT. 1.0)
779	grazed_frac(:,mgraze_C4)=1.0
780	ENDWHERE
781	ELSEWHERE
782	sr_ugb(:,mgraze_C4) = 1e-6
783	nb_ani(:,mgraze_C4) = 5e-7
784	grazed_frac(:,mgraze_C4) = 0.5
785	amount_yield(:,mgraze_C4) = 0.0
786	outside_food(:,mgraze_C4) = 0.0
787	consump(:,mgraze_C4) = 0.0
788	add_nb_ani(:,mgraze_C4) = 0.0
789	END WHERE
790
791	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
792	compt_ugb(:,mgraze_C3) = 0
793	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
794	compt_ugb(:,mgraze_C4) = 0
795	ENDIF ! f_postauto=1 or 2
796
797	! F_POSTAUTO=5 for global simulation with
798	! prescibed livestock density read from extra file
799	! grazed_frac is not used
800	! but extra_feed might be used in the future
801	IF (f_postauto .EQ. 5) THEN
802	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. &
803	(sr_ugb(:,mgraze_C3) .GT. 0.0))
804	extra_feed(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18.0*sr_ugb(:,mgraze_C3)
805	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * (1-grazed_frac(:,mgraze_C3)) * 0.85
806	consump(:,mgraze_C3) = 0.0 !(365 - compt_ugb(:,mgraze_C3)) * 18.0 * nb_ani(:,mgraze_C3)
807	outside_food(:,mgraze_C3) = 0.0 !amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
808	add_nb_ani(:,mgraze_C3) = 0.0 !outside_food(:,mgraze_C3)/ (18.0 * 365) * 0.2
809	nb_ani(:,mgraze_C3)=nb_ani(:,mgraze_C3)+add_nb_ani(:,mgraze_C3)
810	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0)
811	grazed_frac(:,mgraze_C3)=0.5 !nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
812	ENDWHERE
813	WHERE (sr_ugb(:,mgraze_C3) .LE. 0.0)
814	grazed_frac(:,mgraze_C3)=0.0
815	sr_ugb(:,mgraze_C3)=0.0
816	nb_ani(:,mgraze_C3)=0.0
817	ENDWHERE
818	ELSEWHERE
819	sr_ugb(:,mgraze_C3) = 0.0
820	nb_ani(:,mgraze_C3) = 0.0
821	grazed_frac(:,mgraze_C3)=0.0
822	amount_yield(:,mgraze_C3) =0.0
823	outside_food(:,mgraze_C3) = 0.0
824	consump(:,mgraze_C3) =0.0
825	add_nb_ani(:,mgraze_C3) = 0.0
826	END WHERE
827
828	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. (sr_ugb(:,mgraze_C4).GT. 0.0))
829	extra_feed(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) 18.0sr_ugb(:,mgraze_C4)
830	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) (1-grazed_frac(:,mgraze_C4)) 0.85
831	consump(:,mgraze_C4) = 0.0 !(365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
832	outside_food(:,mgraze_C4) = 0.0 !amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
833	add_nb_ani(:,mgraze_C4) = 0.0 !outside_food(:,mgraze_C4)/ (18.0 365) 0.2
834	nb_ani(:,mgraze_C4)=nb_ani(:,mgraze_C4)+add_nb_ani(:,mgraze_C4)
835	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0)
836	grazed_frac(:,mgraze_C4)=0.5 !nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
837	ENDWHERE
838	WHERE (sr_ugb(:,mgraze_C4) .LE. 0.0)
839	grazed_frac(:,mgraze_C4)=0.0
840	sr_ugb(:,mgraze_C4)=0.0
841	nb_ani(:,mgraze_C4)=0.0
842	ENDWHERE
843	ELSEWHERE
844	sr_ugb(:,mgraze_C4) = 0.0
845	nb_ani(:,mgraze_C4) = 0.0
846	grazed_frac(:,mgraze_C4)=0.0
847	amount_yield(:,mgraze_C4) =0.0
848	outside_food(:,mgraze_C4) = 0.0
849	consump(:,mgraze_C4) =0.0
850	add_nb_ani(:,mgraze_C4) = 0.0
851	END WHERE
852	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
853	compt_ugb(:,mgraze_C3) = 0
854	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
855	compt_ugb(:,mgraze_C4) = 0
856	! due to possible grazing by wild animal
857	! we save nb_grazingdays for possible use
858	nb_grazingdays(:,mnatural_C3) = compt_ugb(:,mnatural_C3)
859	compt_ugb(:,mnatural_C3) = 0
860	nb_grazingdays(:,mnatural_C4) = compt_ugb(:,mnatural_C4)
861	compt_ugb(:,mnatural_C4) = 0
862	ENDIF ! f_postauto=5
863
864	!! F_POSTAUTO=3 for control simulation with
865	!! constant livestock density and grazed fraction
866	!! add yield_return to return extra forage to soil
867	IF (f_postauto .EQ. 3)THEN
868	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
869	! total yield of las year (kg DM/m^2 total grassland)
870	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * (1-grazed_frac(:,mgraze_C3)) * 0.85
871	! total animal indoor consumption of last year (kg DM/m^2
872	! total grassland)
873	consump(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18.0 * nb_ani(:,mgraze_C3)
874	! food surplus (outside_food > 0) or deficit (outside_food <
875	! 0)
876	outside_food(:,mgraze_C3) = amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
877	WHERE ((outside_food(:,mgraze_C3) .GT. 0.0 ) .AND. (grazed_frac(:,mgraze_C3) .LT. 1.0))
878	YIELD_RETURN(:,mgraze_C3) = outside_food(:,mgraze_C3) / (1-grazed_frac(:,mgraze_C3))
879	ELSEWHERE
880	YIELD_RETURN(:,mgraze_C3)=0.0
881	ENDWHERE
882	ELSEWHERE
883	sr_ugb(:,mgraze_C3) = 0.0
884	nb_ani(:,mgraze_C3) = 0.0
885	grazed_frac(:,mgraze_C3)=0.0
886	amount_yield(:,mgraze_C3) =0.0
887	outside_food(:,mgraze_C3) = 0.0
888	consump(:,mgraze_C3) =0.0
889	YIELD_RETURN(:,mgraze_C3) = 0.0
890	END WHERE
891	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
892	compt_ugb(:,mgraze_C3) = 0
893
894	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. (sr_ugb(:,mgraze_C4).GT. 0.0))
895	! total yield of las year (kg DM/m^2 total grassland)
896	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) (1-grazed_frac(:,mgraze_C4)) 0.85
897	! total animal indoor consumption of last year (kg DM/m^2
898	! total grassland)
899	consump(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
900	! food surplus (outside_food > 0) or deficit (outside_food <
901	! 0)
902	outside_food(:,mgraze_C4) =amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
903	WHERE ((outside_food(:,mgraze_C4) .GT. 0.0 ) .AND.(grazed_frac(:,mgraze_C4) .LT. 1.0))
904	YIELD_RETURN(:,mgraze_C4) = outside_food(:,mgraze_C4) /(1-grazed_frac(:,mgraze_C4))
905	ELSEWHERE
906	YIELD_RETURN(:,mgraze_C4)=0.0
907	ENDWHERE
908	ELSEWHERE
909	sr_ugb(:,mgraze_C4) = 0.0
910	nb_ani(:,mgraze_C4) = 0.0
911	grazed_frac(:,mgraze_C4)=0.0
912	amount_yield(:,mgraze_C4) =0.0
913	outside_food(:,mgraze_C4) = 0.0
914	consump(:,mgraze_C4) =0.0
915	YIELD_RETURN(:,mgraze_C4) = 0.0
916	END WHERE
917	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
918	compt_ugb(:,mgraze_C4) = 0
919
920	ENDIF ! f_postauto=3
921
922	!! F_POSTAUTO=4 for historical simulation with
923	!! prescribed increased then decreased livestock density
924	!! and constant grazed fraction
925	!! add yield_return to return extra forage to soil
926	!!!! JCADD 09Aug2016 Europe future run 1
927	!! with constant nb_ani, but varied grazed_frac according to varied sr_ugb
928	IF (f_postauto .EQ. 4)THEN
929	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
930	! total yield of las year (kg DM/m^2 total grassland)
931	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * (1-grazed_frac(:,mgraze_C3)) * 0.85
932	! total animal indoor consumption of last year (kg DM/m^2
933	! total grassland)
934	consump(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * 18.0 * nb_ani(:,mgraze_C3)
935	! food surplus (outside_food > 0) or deficit (outside_food <
936	! 0)
937	outside_food(:,mgraze_C3) = amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
938	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0)
939	! animals
940	! 0.2 means that farmers' decision will based the on the mean status
941	! of the past 5 years
942	add_nb_ani(:,mgraze_C3) = outside_food(:,mgraze_C3)/ (18.0 * 365) * 0.2
943	!add_nb_ani(:,mgraze_C3) = zero
944	!! New animal density for total grassland
945	nb_ani(:,mgraze_C3)=nb_ani(:,mgraze_C3)!+add_nb_ani(:,mgraze_C3)
946	!! New fraction of grazed grassland in total grassland (keep the
947	!same stocking rate)
948	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0)
949	grazed_frac(:,mgraze_C3)=(nb_ani(:,mgraze_C3)+add_nb_ani(:,mgraze_C3))/sr_ugb(:,mgraze_C3)
950	ENDWHERE
951	WHERE (sr_ugb(:,mgraze_C3) .LE. 0.0)
952	grazed_frac(:,mgraze_C3)=0.0
953	sr_ugb(:,mgraze_C3)=0.0
954	nb_ani(:,mgraze_C3)=0.0
955	ENDWHERE
956	!! Threshold of fraction as least 30 % was cut
957	WHERE ((grazed_frac(:,mgraze_C3) .GT. 0.7) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
958	sr_ugb(:,mgraze_C3)=sr_ugb(:,mgraze_C3)+0.00001
959	grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
960	END WHERE
961	WHERE (grazed_frac(:,mgraze_C3) .GT. 1.0)
962	grazed_frac(:,mgraze_C3)=1.0
963	ENDWHERE
964
965	YIELD_RETURN(:,mgraze_C3) = zero
966	! WHERE ((outside_food(:,mgraze_C3) .GT. 0.0 ) .AND. (grazed_frac(:,mgraze_C3) .LT. 1.0))
967	! YIELD_RETURN(:,mgraze_C3) = outside_food(:,mgraze_C3) / (1-grazed_frac(:,mgraze_C3))
968	! ELSEWHERE
969	! YIELD_RETURN(:,mgraze_C3)=0.0
970	! ENDWHERE
971	! sr_ugb(:,mgraze_C3) = sr_ugb_init(:) * &
972	! (1+year_count10.0033-year_count20.0263)
973	! nb_ani(:,mgraze_C3) = sr_ugb(:,mgraze_C3) * grazed_frac(:,mgraze_C3)
974	ELSEWHERE
975	sr_ugb(:,mgraze_C3) = 1e-6
976	nb_ani(:,mgraze_C3) = 5e-7
977	grazed_frac(:,mgraze_C3)= 0.5
978	amount_yield(:,mgraze_C3) = 0.0
979	outside_food(:,mgraze_C3) = 0.0
980	consump(:,mgraze_C3) = 0.0
981	add_nb_ani(:,mgraze_C3) = 0.0
982	YIELD_RETURN(:,mgraze_C3) = 0.0
983	END WHERE
984	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
985	compt_ugb(:,mgraze_C3) = 0
986
987	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. (sr_ugb(:,mgraze_C4).GT. 0.0))
988	! total yield of las year (kg DM/m^2 total grassland)
989	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) (1-grazed_frac(:,mgraze_C4)) 0.85
990	! total animal indoor consumption of last year (kg DM/m^2
991	! total grassland)
992	consump(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
993	! food surplus (outside_food > 0) or deficit (outside_food <
994	! 0)
995	outside_food(:,mgraze_C4) =amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
996	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0)
997	! animals
998	add_nb_ani(:,mgraze_C4) = outside_food(:,mgraze_C4)/ (18.0 365) 0.2
999	!add_nb_ani(:,mgraze_C4) = zero
1000	!! New animal density for total grassland
1001	nb_ani(:,mgraze_C4)=nb_ani(:,mgraze_C4)!+add_nb_ani(:,mgraze_C4)
1002	!! New fraction of grazed grassland in total grassland (keep
1003	!the same stocking rate)
1004	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0)
1005	grazed_frac(:,mgraze_C4)=(nb_ani(:,mgraze_C4)+add_nb_ani(:,mgraze_C4))/sr_ugb(:,mgraze_C4)
1006	ENDWHERE
1007	WHERE (sr_ugb(:,mgraze_C4) .LE. 0.0)
1008	grazed_frac(:,mgraze_C4)=0.0
1009	sr_ugb(:,mgraze_C4)=0.0
1010	nb_ani(:,mgraze_C4)=0.0
1011	ENDWHERE
1012	!! Threshold of fraction as least 30 % was cut
1013	WHERE ((grazed_frac(:,mgraze_C4) .GT. 0.7) .AND.(sr_ugb(:,mgraze_C4) .GT. 0.0))
1014	sr_ugb(:,mgraze_C4)=sr_ugb(:,mgraze_C4)+0.00002
1015	grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
1016	END WHERE
1017	WHERE (grazed_frac(:,mgraze_C4) .GT. 1.0)
1018	grazed_frac(:,mgraze_C4)=1.0
1019	ENDWHERE
1020
1021	YIELD_RETURN(:,mgraze_C4) = zero
1022	! WHERE ((outside_food(:,mgraze_C4) .GT. 0.0 ) .AND.(grazed_frac(:,mgraze_C4) .LT. 1.0))
1023	! YIELD_RETURN(:,mgraze_C4) = outside_food(:,mgraze_C4) /(1-grazed_frac(:,mgraze_C4))
1024	! ELSEWHERE
1025	! YIELD_RETURN(:,mgraze_C4)=0.0
1026	! ENDWHERE
1027	! sr_ugb(:,mgraze_C4) = sr_ugb_init(:) * &
1028	! (1+year_count10.0033-year_count20.0263)
1029	! nb_ani(:,mgraze_C4) = sr_ugb(:,mgraze_C4) *grazed_frac(:,mgraze_C4)
1030	ELSEWHERE
1031	sr_ugb(:,mgraze_C4) = 1e-6
1032	nb_ani(:,mgraze_C4) = 5e-7
1033	grazed_frac(:,mgraze_C4)= 0.5
1034	amount_yield(:,mgraze_C4) = 0.0
1035	outside_food(:,mgraze_C4) = 0.0
1036	consump(:,mgraze_C4) = 0.0
1037	add_nb_ani(:,mgraze_C4) = 0.0
1038	YIELD_RETURN(:,mgraze_C4) = 0.0
1039	END WHERE
1040	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
1041	compt_ugb(:,mgraze_C4) = 0
1042	ENDIF ! f_postauto=4
1043
1044	ENDIF ! f_nonlimitant=0
1045
1046	END IF n_year
1047
1048	! one per day
1049	n_day : IF (new_day .EQ. .TRUE. ) THEN
1050
1051	IF (blabla_pasim) PRINT *, 'PASIM Animals : initialisation for new_day'
1052
1053	wshtotgrazing = wshtotstart
1054	faecesnsumprev = faecesnsum
1055	milknsumprev = milknsum
1056	urinensumprev = urinensum
1057	grazingnsumprev= grazingnsum
1058
1059	able_grazing = 500.
1060	nanimaltot =0.0
1061
1062	calc_nanimaltot : IF ((tcutmodel .EQ. 0) .AND. (f_autogestion .EQ. 0) &
1063	.AND. (f_postauto .EQ. 0) ) THEN
1064	!WRITE(numout, *) "JC wrong routine",tanimal(:,16,1)
1065	!WRITE(numout, *) "JC wrong nanimal",nanimal(:,16,1)
1066	nanimaltot (:,:) = 0.0
1067	h = 1
1068	DO WHILE(h .LT. nstocking)
1069	WHERE((tjulian .GE. tanimal(:,:,h)) .AND. &
1070	(tjulian .LT. (tanimal(:,:,h) + danimal(:,:,h))))
1071
1072	nanimaltot (:,:) = nanimaltot (:,:) + nanimal(:,:,h)
1073
1074	END WHERE
1075	h = h + 1
1076	END DO
1077
1078	WHERE (wshtot(:,:) .GE. (min_grazing + 0.05))
1079	delai_ugb(:,:) = delai_ugb(:,:) +1
1080	WHERE ((delai_ugb(:,:) .GE. 0) .AND. &
1081	(nanimaltot(:,:) .GT. 0.0))
1082	ugb(:,:) = 1
1083	ELSEWHERE
1084	ugb(:,:) = 0
1085	ENDWHERE
1086	ELSEWHERE ((wshtot(:,:) .LT. (min_grazing + 0.05)) .AND. &
1087	(wshtot(:,:) .GE. min_grazing))
1088	WHERE ((delai_ugb(:,:) .GE. 0) .AND. (nanimaltot(:,:) .GT. 0.0))
1089	ugb(:,:) = 1
1090	ELSEWHERE
1091	ugb(:,:) = 0
1092	ENDWHERE
1093	ELSEWHERE (wshtot(:,:) .LT. min_grazing)
1094
1095	nanimaltot (:,:) = 0.0
1096	ugb(:,:) = 0
1097	delai_ugb(:,:) = -15
1098
1099	END WHERE
1100	WHERE (ugb(:,:) .EQ. 1)
1101
1102	compt_ugb(:,:) = compt_ugb(:,:) + 1
1103
1104
1105	END WHERE
1106
1107
1108	ELSEIF (tcutmodel .EQ. 1) THEN
1109
1110	WHERE ((nanimal(:,:,1) .GT. 0.0) .AND. (devstage(:,:) .GT. devstocking) .AND. &
1111	(stockingstart(:,:) .EQ. 0))
1112
1113	nanimaltot (:,:) = nanimal(:,:,1)
1114	stockingstart(:,:) = 1
1115
1116	END WHERE
1117	DO j=2,nvm
1118	IF (tjulian .GT. tseasonendmin) THEN
1119	WHERE ((stockingstart(:,j) .EQ. 1) .AND. (stockingend(:,j) .EQ. 0) .AND. &
1120	(snowfall_daily(:) .GT. 1e-3))
1121
1122	stockingend(:,j) = 1
1123
1124	END WHERE
1125	END IF
1126	END DO
1127	WHERE (stockingend(:,:) .EQ. 1)
1128
1129	nanimaltot (:,:) = 0.0
1130
1131	ELSEWHERE ( (nanimal(:,:,1) .GT. 0.0) .AND. &
1132	(stockingstart(:,:) .EQ. 1))
1133
1134	deltaanimal(:,:) = MIN (0.0001,(wshtot(:,:) - nanimaltot(:,:)*intake(:,:))/intakemax(:,:))
1135	nanimaltot (:,:) = MIN (MAX (0.0, nanimaltot (:,:) +deltaanimal(:,:)), nanimaltotmax)
1136
1137	END WHERE
1138
1139	ENDIF calc_nanimaltot
1140
1141	!JCADD 05Feb2016 calculate count days of wet/dry soil
1142	IF ( .NOT. hydrol_cwrr ) THEN
1143	WHERE (moiavail_daily .GT. moi_threshold)
1144	ct_dry(:,:) = ct_dry(:,:) - 1
1145	ELSEWHERE
1146	ct_dry(:,:) = ct_dry(:,:) + 1
1147	ENDWHERE
1148	WHERE (ct_dry .GE. ct_max)
1149	ct_dry(:,:) = ct_max
1150	ELSEWHERE (ct_dry .LE. 0)
1151	ct_dry(:,:) = 0
1152	ENDWHERE
1153	ELSE
1154	DO j=1,nvm
1155	WHERE (tmc_topgrass_daily .GT. 1.5 )!tmc_topgrass_sat_daily) !fc_grazing)
1156	!JCMODIF fc_grazing is soiltype dependent now 0.15 0.25 0.35!tmcf_threshold)
1157	ct_dry(:,j) = ct_dry(:,j) - 1
1158	ELSEWHERE
1159	ct_dry(:,j) = ct_dry(:,j) + 1
1160	ENDWHERE
1161	ENDDO
1162	WHERE (ct_dry .GE. ct_max)
1163	ct_dry(:,:) = ct_max
1164	ELSEWHERE (ct_dry .LE. 0)
1165	ct_dry(:,:) = 0
1166	ENDWHERE
1167	ENDIF
1168	!ENDJCADD
1169
1170	!JCADD 25July2016
1171	! incorporating impact of tmc_topgrass_daily, snowmass_daily and t2m_daily
1172	! on grazing
1173	IF (disable_wetgrazing) THEN
1174	DO i=1,npts
1175	IF (tmc_topgrass_daily(i) .GT. (fc_grazing(i) - buffer_wet)) THEN
1176	IF (wet1day(i) .LE. 4 .AND. wet2day(i) .LE. 4) THEN
1177	after_wet(i) = 10
1178	ELSE
1179	after_wet(i) = after_wet(i) -1
1180	ENDIF
1181	wet2day(i) = wet1day(i) + 1
1182	wet1day(i) = 1
1183	ELSE
1184	after_wet(i) = after_wet(i) -1
1185	wet1day(i) = wet1day(i) + 1
1186	wet2day(i) = wet2day(i) + 1
1187	ENDIF
1188	ENDDO
1189	WHERE (wet1day .GT. 6)
1190	wet1day(:) = 6
1191	ELSEWHERE
1192	wet1day(:) = wet1day(:)
1193	ENDWHERE
1194	WHERE (wet2day .GT. 6)
1195	wet2day(:) = 6
1196	ELSEWHERE
1197	wet2day(:) = wet2day(:)
1198	ENDWHERE
1199	WHERE (after_wet .LT. 0)
1200	after_wet(:) = 0
1201	ELSEWHERE
1202	after_wet(:) = after_wet(:)
1203	ENDWHERE
1204	ELSE
1205	after_wet(:) = 0
1206	ENDIF ! disable_wetgrazing
1207
1208	IF (disable_coldgrazing) THEN
1209	WHERE (t2m_daily .LE. 273.15)
1210	t2m_below_zero(:) = 1
1211	ELSEWHERE
1212	t2m_below_zero(:) = 0
1213	ENDWHERE
1214	WHERE (t2m_below_zero .LT. 0)
1215	t2m_below_zero(:) = 0
1216	ELSEWHERE
1217	t2m_below_zero(:) = t2m_below_zero(:)
1218	ENDWHERE
1219	ELSE
1220	t2m_below_zero(:) = 0
1221	ENDIF
1222
1223	IF (disable_snowgrazing) THEN
1224	WHERE (snowmass_daily .GT. 0.01)
1225	after_snow(:) = buffer_snow
1226	ELSEWHERE
1227	after_snow(:) = after_snow(:) - 1
1228	ENDWHERE
1229	WHERE (after_snow .LT. 0)
1230	after_snow(:) = 0
1231	ELSEWHERE
1232	after_snow(:) = after_snow(:)
1233	ENDWHERE
1234	ELSE
1235	after_snow(:) = 0
1236	ENDIF ! disable_snowgrazing
1237
1238	!ENDJCADD
1239	IF (f_autogestion .EQ. 2) THEN
1240	DO j=2,nvm
1241	IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. &
1242	(.NOT.is_grassland_grazed(j)))THEN
1243	!JCCOMMENT delete the start of grazing after 15 days
1244	! WHERE (wshtot(:,j) .GE. (min_grazing + 0.05))
1245	! BM_threshold_turnout = 0.08333
1246	WHERE (wshtot(:,j) .GE. 0.13 .AND. ct_dry(:,j) .GE. ct_threshold)
1247
1248	delai_ugb(:,j) = delai_ugb(:,j) +1
1249	! WHERE (delai_ugb(:,j) .GE. 0)
1250	ugb(:,j) = 1
1251	! ENDWHERE
1252
1253	! ELSEWHERE (wshtot(:,j) .LT. min_grazing)
1254	! BM_threshold =0.058
1255	ELSEWHERE (wshtot(:,j) .LT. 0.058)
1256
1257	nanimaltot (:,j) = 0.0
1258	ugb(:,j) = 0
1259	delai_ugb(:,j) = -15
1260
1261	ELSEWHERE (ct_dry(:,j) .LT. ct_threshold)
1262	nanimaltot (:,j) = 0.0
1263	ugb(:,j) = 0
1264
1265	END WHERE
1266	! IF (tjulian .GT. tseasonendmin) THEN
1267	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1268	.OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1269	nanimaltot (:,j) = 0.0
1270	ugb(:,j) = 0
1271	END WHERE
1272	! ENDIF
1273
1274	WHERE (ugb(:,j) .EQ. 1)
1275
1276	compt_ugb(:,j) = compt_ugb(:,j) + 1
1277	nanimaltot (:,j) = sr_ugb(:,j)
1278
1279	END WHERE
1280
1281	END IF!manag not cut not graze
1282	END DO ! nvm
1283	END IF ! f_autogestion =2
1284
1285	! JCMODIF for LGM autogestion = 3 move it as postauto =5
1286	! IF ((f_autogestion .EQ. 3) .OR. (f_autogestion .EQ. 4)) THEN
1287	IF (f_autogestion .EQ. 4) THEN
1288	WHERE (wshtot(:,mgraze_C3) .GE. (min_grazing + 0.05))
1289
1290	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1291	WHERE (delai_ugb(:,mgraze_C3) .GE. 0 .AND. &
1292	ct_dry(:,mgraze_C3) .GE. ct_threshold)
1293	ugb(:,mgraze_C3) = 1
1294	ENDWHERE
1295
1296	ELSEWHERE (wshtot(:,mgraze_C3) .LT. min_grazing)
1297
1298	nanimaltot (:,mgraze_C3) = 0.0
1299	ugb(:,mgraze_C3) = 0
1300	delai_ugb(:,mgraze_C3) = -15
1301	END WHERE
1302	WHERE (ct_dry(:,mgraze_C3) .LT. ct_threshold)
1303	nanimaltot (:,mgraze_C3) = 0.0
1304	ugb(:,mgraze_C3) = 0
1305	ENDWHERE
1306	! IF (tjulian .GT. tseasonendmin) THEN
1307	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1308	.OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1309	nanimaltot (:,mgraze_C3) = 0.0
1310	ugb(:,mgraze_C3) = 0
1311	ENDWHERE
1312	! ENDIF
1313	WHERE (ugb(:,mgraze_C3) .EQ. 1)
1314	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
1315	nanimaltot (:,mgraze_C3) = sr_ugb(:,mgraze_C3)
1316	END WHERE
1317
1318	WHERE (wshtot(:,mgraze_C4) .GE. (min_grazing + 0.05))
1319
1320	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1321	WHERE (delai_ugb(:,mgraze_C4) .GE. 0 .AND. &
1322	ct_dry(:,mgraze_C4) .GE. ct_threshold)
1323	ugb(:,mgraze_C4) = 1
1324	ENDWHERE
1325
1326	ELSEWHERE (wshtot(:,mgraze_C4) .LT. min_grazing)
1327
1328	nanimaltot (:,mgraze_C4) = 0.0
1329	ugb(:,mgraze_C4) = 0
1330	delai_ugb(:,mgraze_C4) = -15
1331	END WHERE
1332	WHERE (ct_dry(:,mgraze_C4) .LT. ct_threshold)
1333	nanimaltot (:,mgraze_C4) = 0.0
1334	ugb(:,mgraze_C4) = 0
1335	ENDWHERE
1336	! IF (tjulian .GT. tseasonendmin) THEN
1337	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1338	.OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1339	nanimaltot (:,mgraze_C4) = 0.0
1340	ugb(:,mgraze_C4) = 0
1341	ENDWHERE
1342	! ENDIF
1343	WHERE (ugb(:,mgraze_C4) .EQ. 1)
1344	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
1345	nanimaltot (:,mgraze_C4) = sr_ugb(:,mgraze_C4)
1346	END WHERE
1347
1348	ENDIF ! f_autogestion=4
1349
1350	IF ((f_postauto .EQ. 1) .OR. (f_postauto .EQ. 2) .OR. &
1351	(f_postauto .EQ. 3) .OR. (f_postauto .EQ. 4)) THEN
1352
1353	! WHERE (wshtot(:,mgraze_C3) .GE. (min_grazing + 0.05))
1354	WHERE (wshtot(:,mgraze_C3) .GE. 0.13)
1355	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1356	!JCMODIF Feb2015 for start grazing too late
1357	WHERE (delai_ugb(:,mgraze_C3) .GE. 0 .AND. &
1358	ct_dry(:,mgraze_C3) .GE. ct_threshold)
1359	ugb(:,mgraze_C3) = 1
1360	ENDWHERE
1361
1362	! ELSEWHERE (wshtot(:,mgraze_C3) .LT. min_grazing)
1363	ELSEWHERE (wshtot(:,mgraze_C3) .LT. 0.058)
1364	nanimaltot (:,mgraze_C3) = 0.0
1365	ugb(:,mgraze_C3) = 0
1366	delai_ugb(:,mgraze_C3) = -15
1367	END WHERE
1368	!WRITE(numout, *) "JC 1st test ugb",tjulian,ugb(:,16)
1369	!WRITE(numout, *) "JC 1st test nanimaltot",nanimaltot(:,16)
1370	WHERE (ct_dry(:,mgraze_C3) .LT. ct_threshold)
1371	nanimaltot (:,mgraze_C3) = 0.0
1372	ugb(:,mgraze_C3) = 0
1373	ENDWHERE
1374	!WRITE(numout, *) "JC 2ndt test ugb",ugb(:,16)
1375	!WRITE(numout, *) "JC 2nd test nanimaltot",nanimaltot(:,16)
1376	! IF (tjulian .GT. tseasonendmin) THEN
1377	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1378	.OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1379	nanimaltot (:,mgraze_C3) = 0.0
1380	ugb(:,mgraze_C3) = 0
1381	ENDWHERE
1382	!WRITE(numout, *) "JC 3rd test ugb",ugb(:,16)
1383	!WRITE(numout, *) "JC 3rd test nanimaltot",nanimaltot(:,16)
1384	!WRITE(numout, *) "JC 3rd test snow",snowfall_daily(:)
1385	!WRITE(numout, *) "JC 3rd test t2m",t2m_below_zero(:)
1386	!WRITE(numout, *) "JC 3rd test wet",after_wet(:)
1387	!WRITE(numout, *) "JC 3rd test aftersnow",after_snow(:)
1388	! ENDIF
1389	WHERE (ugb(:,mgraze_C3) .EQ. 1)
1390	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
1391	nanimaltot (:,mgraze_C3) = sr_ugb(:,mgraze_C3)
1392	END WHERE
1393	!WRITE(numout, *) "JC 4rd test ugb",ugb(:,16)
1394	!WRITE(numout, *) "JC 4rd test nanimaltot",nanimaltot(:,16)
1395	! WHERE (wshtot(:,mgraze_C4) .GE. (min_grazing + 0.05))
1396	WHERE (wshtot(:,mgraze_C4) .GE. 0.13)
1397	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1398	WHERE (delai_ugb(:,mgraze_C4) .GE. 0 .AND. &
1399	ct_dry(:,mgraze_C4) .GE. ct_threshold)
1400	ugb(:,mgraze_C4) = 1
1401	ENDWHERE
1402
1403	! ELSEWHERE (wshtot(:,mgraze_C4) .LT. min_grazing)
1404	ELSEWHERE (wshtot(:,mgraze_C4) .LT. 0.058)
1405	nanimaltot (:,mgraze_C4) = 0.0
1406	ugb(:,mgraze_C4) = 0
1407	delai_ugb(:,mgraze_C4) = -15
1408	END WHERE
1409	WHERE (ct_dry(:,mgraze_C4) .LT. ct_threshold)
1410	nanimaltot (:,mgraze_C4) = 0.0
1411	ugb(:,mgraze_C4) = 0
1412	ENDWHERE
1413	! IF (tjulian .GT. tseasonendmin) THEN
1414	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1415	.OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1416	nanimaltot (:,mgraze_C4) = 0.0
1417	ugb(:,mgraze_C4) = 0
1418	ENDWHERE
1419	! ENDIF
1420	WHERE (ugb(:,mgraze_C4) .EQ. 1)
1421	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
1422	nanimaltot (:,mgraze_C4) = sr_ugb(:,mgraze_C4)
1423	END WHERE
1424	ENDIF ! f_postauto=1 2 3 4
1425
1426	! JCMODIF for differen sr_ugb given varied threshold
1427	! with 1 LSU of 250 gDM and stop grazing with 0.8 * 250 g DM
1428	! with < 1 LSU of 22^(1-sr_ugb10000)sr_ugb10000*125
1429	! e.g., 0.5 LSU 180 gDM 0.1 LSU 46 gDM
1430	! 0.01 LSU 5 gDM
1431	!!! JCADD for global simulation with wild animal grazing natural grassland
1432	IF ((f_postauto .EQ. 5) .OR. (f_autogestion .EQ. 3)) THEN
1433	! IF (f_autogestion .EQ. 3) THEN
1434	able_grazing(:,mgraze_C3) = sr_ugb(:,mgraze_C3) * 10000.0 * 130.0 * &
1435	2.0*(1.0-(sr_ugb(:,mgraze_C3)10000.0))/1000.0
1436	able_grazing(:,mgraze_C4) = sr_ugb(:,mgraze_C4) * 10000.0 * 130.0 * &
1437	2.0*(1.0-(sr_ugb(:,mgraze_C4)10000.0))/1000.0
1438	! > 1 LSU/ha using 0.25 kgDM
1439	WHERE (sr_ugb(:,mgraze_C3) .GE. 0.0001)
1440	WHERE (wshtot(:,mgraze_C3) .GE. 0.13)
1441
1442	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1443	WHERE (delai_ugb(:,mgraze_C3) .GE. 0 .AND. &
1444	ct_dry(:,mgraze_C3) .GE. ct_threshold)
1445	ugb(:,mgraze_C3) = 1
1446	grazing_litter(:,mgraze_C3) = 0
1447	ENDWHERE
1448
1449	ELSEWHERE (wshtot(:,mgraze_C3) .LT. 0.058)
1450
1451	nanimaltot (:,mgraze_C3) = 0.0
1452	ugb(:,mgraze_C3) = 0
1453	delai_ugb(:,mgraze_C3) = -15
1454	grazing_litter(:,mgraze_C3) = 2
1455	END WHERE
1456	WHERE (ct_dry(:,mgraze_C3) .LT. ct_threshold)
1457	nanimaltot (:,mgraze_C3) = 0.0
1458	ugb(:,mgraze_C3) = 0
1459	grazing_litter(:,mgraze_C3) = 2
1460	ENDWHERE
1461	ELSEWHERE (sr_ugb(:,mgraze_C3) .GE. 0.00002 .AND. sr_ugb(:,mgraze_C3) .LT. 0.0001)
1462	WHERE (wshtot(:,mgraze_C3) .GE. able_grazing(:,mgraze_C3))
1463
1464	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1465	WHERE (delai_ugb(:,mgraze_C3) .GE. 0 .AND. &
1466	ct_dry(:,mgraze_C3) .GE. ct_threshold)
1467	ugb(:,mgraze_C3) = 1
1468	grazing_litter(:,mgraze_C3) = 0
1469	ENDWHERE
1470
1471	ELSEWHERE (wshtot(:,mgraze_C3) .LT. able_grazing(:,mgraze_C3)*0.45)
1472
1473	nanimaltot (:,mgraze_C3) = 0.0
1474	ugb(:,mgraze_C3) = 0
1475	delai_ugb(:,mgraze_C3) = -15
1476	grazing_litter(:,mgraze_C3) = 2
1477	END WHERE
1478	WHERE (ct_dry(:,mgraze_C3) .LT. ct_threshold)
1479	nanimaltot (:,mgraze_C3) = 0.0
1480	ugb(:,mgraze_C3) = 0
1481	grazing_litter(:,mgraze_C3) = 2
1482	ENDWHERE
1483	ELSEWHERE (sr_ugb(:,mgraze_C3) .LT. 0.00002)
1484	WHERE (wshtot(:,mgraze_C3) .GE. able_grazing(:,mgraze_C3))
1485
1486	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1487	WHERE (delai_ugb(:,mgraze_C3) .GE. 0 .AND. &
1488	ct_dry(:,mgraze_C3) .GE. ct_threshold)
1489	ugb(:,mgraze_C3) = 1
1490	grazing_litter(:,mgraze_C3) = 0
1491	ENDWHERE
1492
1493	ELSEWHERE (wshtot(:,mgraze_C3) .LT. able_grazing(:,mgraze_C3)*0.45)
1494
1495	nanimaltot (:,mgraze_C3) = 0.0
1496	ugb(:,mgraze_C3) = 0
1497	delai_ugb(:,mgraze_C3) = -15
1498	grazing_litter(:,mgraze_C3) = 2
1499	END WHERE
1500	WHERE (ct_dry(:,mgraze_C3) .LT. ct_threshold)
1501	nanimaltot (:,mgraze_C3) = 0.0
1502	ugb(:,mgraze_C3) = 0
1503	grazing_litter(:,mgraze_C3) = 2
1504	ENDWHERE
1505	ENDWHERE
1506	! IF (tjulian .GT. tseasonendmin) THEN
1507	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1508	.OR. after_snow(:) .GT. 0.5)
1509	! wet grazing is only avoid at Europe scale
1510	! .OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1511	nanimaltot (:,mgraze_C3) = 0.0
1512	ugb(:,mgraze_C3) = 0
1513	grazing_litter(:,mgraze_C3) = 2
1514	ENDWHERE
1515	! ENDIF
1516	WHERE (ugb(:,mgraze_C3) .EQ. 1)
1517	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
1518	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.00002)
1519	nanimaltot (:,mgraze_C3) = sr_ugb(:,mgraze_C3)
1520	ELSEWHERE
1521	nanimaltot (:,mgraze_C3) = 0.00002
1522	ENDWHERE
1523	END WHERE
1524	! > 1 LSU/ha using 0.25 kgDM
1525	WHERE (sr_ugb(:,mgraze_C4) .GE. 0.0001)
1526	WHERE (wshtot(:,mgraze_C4) .GE. 0.13)
1527
1528	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1529	WHERE (delai_ugb(:,mgraze_C4) .GE. 0 .AND. &
1530	ct_dry(:,mgraze_C4) .GE. ct_threshold)
1531	ugb(:,mgraze_C4) = 1
1532	grazing_litter(:,mgraze_C4) = 0
1533	ENDWHERE
1534
1535	ELSEWHERE (wshtot(:,mgraze_C4) .LT. 0.058)
1536
1537	nanimaltot (:,mgraze_C4) = 0.0
1538	ugb(:,mgraze_C4) = 0
1539	delai_ugb(:,mgraze_C4) = -15
1540	grazing_litter(:,mgraze_C4) = 2
1541	END WHERE
1542	WHERE (ct_dry(:,mgraze_C4) .LT. ct_threshold)
1543	nanimaltot (:,mgraze_C4) = 0.0
1544	ugb(:,mgraze_C4) = 0
1545	grazing_litter(:,mgraze_C4) = 2
1546	ENDWHERE
1547	ELSEWHERE (sr_ugb(:,mgraze_C4) .GE. 0.00002 .AND. sr_ugb(:,mgraze_C4) .LT. 0.0001)
1548	WHERE (wshtot(:,mgraze_C4) .GE. able_grazing(:,mgraze_C4))
1549
1550	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1551	WHERE (delai_ugb(:,mgraze_C4) .GE. 0 .AND. &
1552	ct_dry(:,mgraze_C4) .GE. ct_threshold)
1553	ugb(:,mgraze_C4) = 1
1554	grazing_litter(:,mgraze_C4) = 0
1555	ENDWHERE
1556
1557	ELSEWHERE (wshtot(:,mgraze_C4) .LT. able_grazing(:,mgraze_C4)*0.45)
1558
1559	nanimaltot (:,mgraze_C4) = 0.0
1560	ugb(:,mgraze_C4) = 0
1561	delai_ugb(:,mgraze_C4) = -15
1562	grazing_litter(:,mgraze_C4) = 2
1563	END WHERE
1564	WHERE (ct_dry(:,mgraze_C4) .LT. ct_threshold)
1565	nanimaltot (:,mgraze_C4) = 0.0
1566	ugb(:,mgraze_C4) = 0
1567	grazing_litter(:,mgraze_C4) = 2
1568	ENDWHERE
1569	ELSEWHERE (sr_ugb(:,mgraze_C4) .LT. 0.00002)
1570	WHERE (wshtot(:,mgraze_C4) .GE. able_grazing(:,mgraze_C4))
1571
1572	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1573	WHERE (delai_ugb(:,mgraze_C4) .GE. 0 .AND. &
1574	ct_dry(:,mgraze_C4) .GE. ct_threshold)
1575	ugb(:,mgraze_C4) = 1
1576	grazing_litter(:,mgraze_C4) = 0
1577	ENDWHERE
1578
1579	ELSEWHERE (wshtot(:,mgraze_C4) .LT. able_grazing(:,mgraze_C4)*0.45)
1580
1581	nanimaltot (:,mgraze_C4) = 0.0
1582	ugb(:,mgraze_C4) = 0
1583	delai_ugb(:,mgraze_C4) = -15
1584	grazing_litter(:,mgraze_C4) = 2
1585	END WHERE
1586	WHERE (ct_dry(:,mgraze_C4) .LT. ct_threshold)
1587	nanimaltot (:,mgraze_C4) = 0.0
1588	ugb(:,mgraze_C4) = 0
1589	grazing_litter(:,mgraze_C4) = 2
1590	ENDWHERE
1591	ENDWHERE
1592	! IF (tjulian .GT. tseasonendmin) THEN
1593	WHERE (snowfall_daily(:) .GT. 1e-3 .OR. t2m_below_zero(:) .GT. 0.5 &
1594	.OR. after_snow(:) .GT. 0.5)
1595	! wet grazing is only avoid at Europe
1596	! .OR. after_wet(:) .GT. 0.5 .OR. after_snow(:) .GT. 0.5)
1597	nanimaltot (:,mgraze_C4) = 0.0
1598	ugb(:,mgraze_C4) = 0
1599	grazing_litter(:,mgraze_C4) = 2
1600	ENDWHERE
1601	! ENDIF
1602	WHERE (ugb(:,mgraze_C4) .EQ. 1)
1603	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
1604	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.00002)
1605	nanimaltot (:,mgraze_C4) = sr_ugb(:,mgraze_C4)
1606	ELSEWHERE
1607	nanimaltot (:,mgraze_C4) = 0.00002
1608	ENDWHERE
1609	END WHERE
1610	!!!!!! JCADD for global simulation with wild animal grazing natural grassland
1611	able_grazing(:,mnatural_C3) = sr_wild(:,mnatural_C3) * 10000.0 * 130.0 * &
1612	2.0*(1.0-(sr_wild(:,mnatural_C3)10000.0))/1000.0
1613	able_grazing(:,mnatural_C4) = sr_wild(:,mnatural_C4) * 10000.0 * 130.0 * &
1614	2.0*(1.0-(sr_wild(:,mnatural_C4)10000.0))/1000.0
1615
1616	WHERE (able_grazing(:,mnatural_C3) .GE. 0.13)
1617	able_grazing(:,mnatural_C3) = 0.13
1618	ELSEWHERE (able_grazing(:,mnatural_C3) .LT. 0.006)
1619	able_grazing(:,mnatural_C3) = 0.006
1620	ENDWHERE
1621	WHERE (able_grazing(:,mnatural_C4) .GE. 0.13)
1622	able_grazing(:,mnatural_C4) = 0.13
1623	ELSEWHERE (able_grazing(:,mnatural_C4) .LT. 0.006)
1624	able_grazing(:,mnatural_C4) = 0.006
1625	ENDWHERE
1626	!
1627	! > 1 LSU/ha using 0.25 kgDM
1628	! grazing biomass or litter
1629	WHERE (wshtot(:,mnatural_C3) .GE. able_grazing(:,mnatural_C3) .AND. &
1630	sr_wild(:,mnatural_C3) .GT. 0.0)
1631	delai_ugb(:,mnatural_C3) = delai_ugb(:,mnatural_C3) +1
1632	WHERE (delai_ugb(:,mnatural_C3) .GE. 0)
1633	! can grazing
1634	ugb(:,mnatural_C3) = 1
1635	! grazing biomass
1636	grazing_litter(:,mnatural_C3) = 0
1637	ELSEWHERE (delai_ugb(:,mnatural_C3) .LT. 0)
1638	WHERE (litter_avail_totDM(:,mnatural_C3) .GE. able_grazing(:,mnatural_C3))
1639	! can grazing
1640	ugb(:,mnatural_C3) = 1
1641	! grazing litter
1642	grazing_litter(:,mnatural_C3) = 1
1643	ELSEWHERE (litter_avail_totDM(:,mnatural_C3) .LT. able_grazing(:,mnatural_C3))
1644	! cannot grazing
1645	ugb(:,mnatural_C3) = 0
1646	! no grazing
1647	grazing_litter(:,mnatural_C3) = 2
1648	ENDWHERE
1649	ENDWHERE
1650	ELSEWHERE (wshtot(:,mnatural_C3) .LT. able_grazing(:,mnatural_C3) .AND. &
1651	sr_wild(:,mnatural_C3) .GT. 0.0)
1652	delai_ugb(:,mnatural_C3) = -15
1653	WHERE (litter_avail_totDM(:,mnatural_C3) .GE. able_grazing(:,mnatural_C3))
1654	! can grazing
1655	ugb(:,mnatural_C3) = 1
1656	! grazing litter
1657	grazing_litter(:,mnatural_C3) = 1
1658	ELSEWHERE (litter_avail_totDM(:,mnatural_C3) .LT. able_grazing(:,mnatural_C3))
1659	! cannot grazing
1660	ugb(:,mnatural_C3) = 0
1661	! no grazing
1662	grazing_litter(:,mnatural_C3) = 2
1663	ENDWHERE
1664	ENDWHERE
1665	WHERE (ugb(:,mnatural_C3) .EQ. 1)
1666	compt_ugb(:,mnatural_C3) = compt_ugb(:,mnatural_C3) + 1
1667	nanimaltot (:,mnatural_C3) = sr_wild(:,mnatural_C3)
1668	END WHERE
1669	! C4 grass
1670	! > 1 LSU/ha using 0.25 kgDM
1671	! grazing biomass or litter
1672	WHERE (wshtot(:,mnatural_C4) .GE. able_grazing(:,mnatural_C4) .AND. &
1673	sr_wild(:,mnatural_C4) .GT. 0.0)
1674	delai_ugb(:,mnatural_C4) = delai_ugb(:,mnatural_C4) +1
1675	WHERE (delai_ugb(:,mnatural_C4) .GE. 0)
1676	! can grazing
1677	ugb(:,mnatural_C4) = 1
1678	! grazing biomass
1679	grazing_litter(:,mnatural_C4) = 0
1680	ELSEWHERE (delai_ugb(:,mnatural_C4) .LT. 0)
1681	WHERE (litter_avail_totDM(:,mnatural_C4) .GE. able_grazing(:,mnatural_C4))
1682	! can grazing
1683	ugb(:,mnatural_C4) = 1
1684	! grazing litter
1685	grazing_litter(:,mnatural_C4) = 1
1686	ELSEWHERE (litter_avail_totDM(:,mnatural_C4) .LT. able_grazing(:,mnatural_C4))
1687	! cannot grazing
1688	ugb(:,mnatural_C4) = 0
1689	! no grazing
1690	grazing_litter(:,mnatural_C4) = 2
1691	ENDWHERE
1692	ENDWHERE
1693	ELSEWHERE (wshtot(:,mnatural_C4) .LT. able_grazing(:,mnatural_C4) .AND. &
1694	sr_wild(:,mnatural_C4) .GT. 0.0)
1695	delai_ugb(:,mnatural_C4) = -15
1696	WHERE (litter_avail_totDM(:,mnatural_C4) .GE. able_grazing(:,mnatural_C4))
1697	! can grazing
1698	ugb(:,mnatural_C4) = 1
1699	! grazing litter
1700	grazing_litter(:,mnatural_C4) = 1
1701	ELSEWHERE (litter_avail_totDM(:,mnatural_C4) .LT. able_grazing(:,mnatural_C4))
1702	! cannot grazing
1703	ugb(:,mnatural_C4) = 0
1704	! no grazing
1705	grazing_litter(:,mnatural_C4) = 2
1706	ENDWHERE
1707	ENDWHERE
1708	WHERE (ugb(:,mnatural_C4) .EQ. 1)
1709	compt_ugb(:,mnatural_C4) = compt_ugb(:,mnatural_C4) + 1
1710	nanimaltot (:,mnatural_C4) = sr_wild(:,mnatural_C4)
1711	END WHERE
1712
1713
1714	ENDIF ! f_postauto=5 or f_autogestion=3
1715
1716	! JCADD for MICT LGM grazing biomass and litter
1717	! differen sr_ugb given varied threshold
1718	! with 1 LSU of 250 gDM and stop grazing with 0.5 * 250 g DM
1719	! with < 1 LSU of 22^(1-sr_ugb10000)sr_ugb10000*125
1720	! e.g., 0.5 LSU 180 gDM 0.1 LSU 46 gDM
1721	! 0.01 LSU 5 gDM
1722	IF (f_autogestion .EQ. 5) THEN
1723
1724	able_grazing(:,mgraze_C3) = sr_ugb(:,mgraze_C3) * 10000.0 * 250.0 * &
1725	2.0*(1.0-(sr_ugb(:,mgraze_C3)10000.0))/1000.0
1726	able_grazing(:,mgraze_C4) = sr_ugb(:,mgraze_C4) * 10000.0 * 250.0 * &
1727	2.0*(1.0-(sr_ugb(:,mgraze_C4)10000.0))/1000.0
1728	WHERE (able_grazing(:,mgraze_C3) .GE. 0.25)
1729	able_grazing(:,mgraze_C3) = 0.25
1730	ELSEWHERE (able_grazing(:,mgraze_C3) .LT. 0.006)
1731	able_grazing(:,mgraze_C3) = 0.006
1732	ENDWHERE
1733	WHERE (able_grazing(:,mgraze_C4) .GE. 0.25)
1734	able_grazing(:,mgraze_C4) = 0.25
1735	ELSEWHERE (able_grazing(:,mgraze_C3) .LT. 0.006)
1736	able_grazing(:,mgraze_C4) = 0.006
1737	ENDWHERE
1738	!
1739	! > 1 LSU/ha using 0.25 kgDM
1740	! grazing biomass or litter
1741	WHERE (wshtot(:,mgraze_C3) .GE. 0.5*able_grazing(:,mgraze_C3))
1742	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
1743	WHERE (delai_ugb(:,mgraze_C3) .GE. 0)
1744	! can grazing
1745	ugb(:,mgraze_C3) = 1
1746	! grazing biomass
1747	grazing_litter(:,mgraze_C3) = 0
1748	ELSEWHERE (delai_ugb(:,mgraze_C3) .LT. 0)
1749	WHERE (litter_avail_totDM(:,mgraze_C3) .GE. 0.5*able_grazing(:,mgraze_C3))
1750	! can grazing
1751	ugb(:,mgraze_C3) = 1
1752	! grazing litter
1753	grazing_litter(:,mgraze_C3) = 1
1754	ELSEWHERE (litter_avail_totDM(:,mgraze_C3) .LT. 0.5*able_grazing(:,mgraze_C3))
1755	! cannot grazing
1756	ugb(:,mgraze_C3) = 0
1757	! no grazing
1758	grazing_litter(:,mgraze_C3) = 2
1759	ENDWHERE
1760	ENDWHERE
1761	ELSEWHERE (wshtot(:,mgraze_C3) .LT. 0.5*able_grazing(:,mgraze_C3))
1762	delai_ugb(:,mgraze_C3) = -15
1763	WHERE (litter_avail_totDM(:,mgraze_C3) .GE. 0.5*able_grazing(:,mgraze_C3))
1764	! can grazing
1765	ugb(:,mgraze_C3) = 1
1766	! grazing litter
1767	grazing_litter(:,mgraze_C3) = 1
1768	ELSEWHERE (litter_avail_totDM(:,mgraze_C3) .LT. 0.5*able_grazing(:,mgraze_C3))
1769	! cannot grazing
1770	ugb(:,mgraze_C3) = 0
1771	! no grazing
1772	grazing_litter(:,mgraze_C3) = 2
1773	ENDWHERE
1774	ENDWHERE
1775	WHERE (ugb(:,mgraze_C3) .EQ. 1)
1776	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
1777	nanimaltot (:,mgraze_C3) = sr_ugb(:,mgraze_C3)
1778	END WHERE
1779	! WRITE(numout,*) 'zd ','sr_ugb', mgraze_C3,sr_ugb(:,mgraze_C3)
1780	! WRITE(numout,*) 'zd ','litter_ava',mgraze_C3,litter_avail_totDM(:,mgraze_C3)
1781	! WRITE(numout,*) 'zd ','able_gr',mgraze_C4,able_grazing(:,mgraze_C3)
1782	! WRITE(numout,*) 'zd ','animal',mgraze_C4,intake_animal_litter(:,mgraze_C3)
1783	! WRITE(numout,*) 'zd ','mgraze',mgraze_C3,grazing_litter(:,mgraze_C3)
1784	! C4 grass
1785	! > 1 LSU/ha using 0.25 kgDM
1786	! grazing biomass or litter
1787	WHERE (wshtot(:,mgraze_C4) .GE. 0.5*able_grazing(:,mgraze_C4))
1788	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
1789	WHERE (delai_ugb(:,mgraze_C4) .GE. 0)
1790	! can grazing
1791	ugb(:,mgraze_C4) = 1
1792	! grazing biomass
1793	grazing_litter(:,mgraze_C4) = 0
1794	ELSEWHERE (delai_ugb(:,mgraze_C4) .LT. 0)
1795	WHERE (litter_avail_totDM(:,mgraze_C4) .GE. 0.5*able_grazing(:,mgraze_C4))
1796	! can grazing
1797	ugb(:,mgraze_C4) = 1
1798	! grazing litter
1799	grazing_litter(:,mgraze_C4) = 1
1800	ELSEWHERE (litter_avail_totDM(:,mgraze_C4) .LT. 0.5*able_grazing(:,mgraze_C4))
1801	! cannot grazing
1802	ugb(:,mgraze_C4) = 0
1803	! no grazing
1804	grazing_litter(:,mgraze_C4) = 2
1805	ENDWHERE
1806	ENDWHERE
1807	ELSEWHERE (wshtot(:,mgraze_C4) .LT. 0.5*able_grazing(:,mgraze_C4))
1808	delai_ugb(:,mgraze_C4) = -15
1809	WHERE (litter_avail_totDM(:,mgraze_C4) .GE. 0.5*able_grazing(:,mgraze_C4))
1810	! can grazing
1811	ugb(:,mgraze_C4) = 1
1812	! grazing litter
1813	grazing_litter(:,mgraze_C4) = 1
1814	ELSEWHERE (litter_avail_totDM(:,mgraze_C4) .LT. 0.5*able_grazing(:,mgraze_C4))
1815	! cannot grazing
1816	ugb(:,mgraze_C4) = 0
1817	! no grazing
1818	grazing_litter(:,mgraze_C4) = 2
1819	ENDWHERE
1820	ENDWHERE
1821	WHERE (ugb(:,mgraze_C4) .EQ. 1)
1822	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
1823	nanimaltot (:,mgraze_C4) = sr_ugb(:,mgraze_C4)
1824	END WHERE
1825	ENDIF ! f_autogestion=5
1826
1827
1828	END IF n_day
1829
1830
1831	CALL nel_grazing_calcul(&
1832	npts, dt , &
1833	nanimaltot , &
1834	devstage, tgrowth, nel, &
1835	ntot)
1836
1837	CALL Grazing_intake(&
1838	npts, dt, wsh , &
1839	intakemax , &
1840	Animalwgrazingmin , &
1841	AnimalkintakeM , &
1842	intake , &
1843	intakesum , &
1844	tanimal , &
1845	danimal , &
1846	tjulian , &
1847	intakensum , &
1848	fn , &
1849	n , &
1850	intake_animal , &
1851	intake_animalsum , &
1852	nanimaltot , &
1853	intake_litter , &
1854	intake_animal_litter, &
1855	grazing_litter)
1856
1857	CALL variablesPlantes(&
1858	npts,biomass,&
1859	c,n,intake_animal,intakemax,&
1860	AnimalDiscremineQualite)
1861
1862	CALL chg_plante(&
1863	npts, dt, biomass , &
1864	c, n,leaf_frac , &
1865	wsh, wshtot , &
1866	nanimaltot, intake_animal, &
1867	trampling,intake, &
1868	NDF,DNDF,DNDFI, &
1869	grazing_litter)
1870
1871	! CALL variablesPlantes(&
1872	! npts,biomass,NDF,DNDF,DNDFI,&
1873	! c,n,intake_animal,intakemax,&
1874	! AnimalDiscremineQualite)
1875
1876
1877	CALL Milk_Animal(&
1878	npts, dt, nel, intake_animal, &
1879	wanimal, nanimaltot )
1880
1881	!JCADD 110525
1882	!!!!!! In order to get the variables that needed by Respiration_Methane and Urine_Faeces
1883	!!!!!! we need to calculate new grazingn and grazingc using intake from above
1884	!!!!!! So we call modified cal_grazing which from MODULE applic_plant to get variables needed
1885	CALL cal_grazing(&
1886	npts , &
1887	nanimaltot , &
1888	intake_animal , &
1889	wsh , &
1890	wshtot , &
1891	c , &
1892	n , &
1893	fn , &
1894	Substrate_grazingwc , &
1895	Substrate_grazingwn , &
1896	grazingcstruct , &
1897	grazingnstruct , &
1898	intake)
1899
1900	IF (f_autogestion .NE. 5 .AND. f_postauto .NE. 5) THEN
1901	WHERE (nanimaltot.NE.0)
1902	grazingn = grazingnstruct + Substrate_grazingwn
1903	!JCMODIF to balance the carbon with 45% of intake DM
1904	! grazingc = grazingcstruct + Substrate_grazingwc
1905	grazingc = intake * CtoDM
1906	!ENDJCMODIF
1907	ELSEWHERE
1908	grazingn=0
1909	grazingc=0
1910	END WHERE
1911
1912	ELSEIF (f_autogestion .EQ. 5 .OR. f_postauto .EQ. 5) THEN
1913	! grazing AGB
1914	WHERE (nanimaltot.NE.0 .AND. grazing_litter(:,:) .EQ. 0)
1915	grazingn = grazingnstruct + Substrate_grazingwn
1916	!JCMODIF to balance the carbon with 45% of intake DM
1917	! grazingc = grazingcstruct + Substrate_grazingwc
1918	grazingc = intake * CtoDM
1919	!ENDJCMODIF
1920	! grazing litter
1921	ELSEWHERE (nanimaltot.NE.0 .AND. grazing_litter(:,:) .EQ. 1)
1922
1923	grazingc = intake_litter * CtoDM
1924	grazingn = grazingc * fn / fcsh
1925	ELSEWHERE
1926	grazingn=0
1927	grazingc=0
1928	END WHERE
1929
1930	ENDIF ! f_autogestion = 5
1931
1932	DO j=2,nvm
1933	CALL Euler_funct (npts,dt,grazingn(:,j), grazingnsum(:,j))
1934	CALL Euler_funct (npts, dt, grazingc(:,j), grazingcsum(:,j))
1935	END DO
1936
1937	CALL Respiration_Methane(&
1938	npts, dt, grazingc, &
1939	nanimaltot, DNDFI, wanimal )
1940
1941	CALL Urine_Faeces(&
1942	npts, dt , &
1943	grazingn, grazingc, &
1944	urinen, faecesn , &
1945	urinec, faecesc )
1946
1947	Fert_PRP = urinen + faecesn
1948
1949	! kgC m-2 day-1 -> gC m-1 day-1
1950	ranimal_gm = ranimal*1e3
1951	ch4_pft_gm = Methane*1e3
1952
1953	CALL xios_orchidee_send_field("GRAZINGC",grazingc)
1954	CALL xios_orchidee_send_field("NANIMALTOT",nanimaltot)
1955	CALL xios_orchidee_send_field("INTAKE_ANIMAL",intake_animal)
1956	CALL xios_orchidee_send_field("INTAKE",intake)
1957	CALL xios_orchidee_send_field("TRAMPLING",trampling)
1958	CALL xios_orchidee_send_field("CT_DRY",ct_dry)
1959	CALL xios_orchidee_send_field("INTAKE_ANIMAL_LITTER",intake_animal_litter)
1960	CALL xios_orchidee_send_field("INTAKE_LITTER",intake_litter)
1961	CALL xios_orchidee_send_field("SR_WILD",sr_wild)
1962	CALL xios_orchidee_send_field("MILK",milk)
1963	CALL xios_orchidee_send_field("MILKC",milkc)
1964	CALL xios_orchidee_send_field("METHANE",Methane)
1965	CALL xios_orchidee_send_field("RANIMAL",ranimal)
1966	CALL xios_orchidee_send_field("URINEC",urinec)
1967	CALL xios_orchidee_send_field("FAECESC",faecesc)
1968	CALL xios_orchidee_send_field("GRAZED_FRAC",grazed_frac)
1969	CALL xios_orchidee_send_field("NB_ANI",nb_ani)
1970	CALL xios_orchidee_send_field("IMPORT_YIELD",import_yield)
1971	CALL xios_orchidee_send_field("NB_GRAZINGDAYS",nb_grazingdays)
1972	CALL xios_orchidee_send_field("OUTSIDE_FOOD",outside_food)
1973	CALL xios_orchidee_send_field("AFTER_SNOW",after_snow)
1974	CALL xios_orchidee_send_field("AFTER_WET",after_wet)
1975	CALL xios_orchidee_send_field("WET1DAY",wet1day)
1976	CALL xios_orchidee_send_field("WET2DAY",wet2day)
1977	CALL xios_orchidee_send_field("DELAI_UGB",real(delai_ugb))
1978
1979	!grazed
1980	CALL histwrite_p(hist_id_stomate ,'GRAZINGC',itime ,grazingc ,npts*nvm, horipft_index)
1981	CALL histwrite_p(hist_id_stomate ,'GRAZINGCSUM',itime ,grazingcsum ,npts*nvm, horipft_index)
1982	CALL histwrite_p(hist_id_stomate ,'NANIMALTOT',itime ,nanimaltot ,npts*nvm, horipft_index)
1983	CALL histwrite_p(hist_id_stomate ,'INTAKE_ANIMAL' ,itime ,intake_animal ,npts*nvm, horipft_index)
1984	CALL histwrite_p(hist_id_stomate ,'INTAKE' ,itime ,intake ,npts*nvm, horipft_index)
1985	CALL histwrite_p(hist_id_stomate ,'INTAKESUM' ,itime ,intakesum ,npts*nvm, horipft_index)
1986	CALL histwrite_p(hist_id_stomate ,'TRAMPLING' ,itime ,trampling ,npts*nvm, horipft_index)
1987	!JCADD for avoid grazing domestic over wet soil
1988	CALL histwrite_p(hist_id_stomate ,'CT_DRY' ,itime ,ct_dry ,npts*nvm, horipft_index)
1989	!JCADD for grazing litter
1990	CALL histwrite_p(hist_id_stomate ,'INTAKE_ANIMAL_LITTER' ,itime ,intake_animal_litter ,npts*nvm, horipft_index)
1991	CALL histwrite_p(hist_id_stomate ,'INTAKE_LITTER' ,itime ,intake_litter ,npts*nvm, horipft_index)
1992	CALL histwrite_p(hist_id_stomate ,'GRAZING_LITTER' ,itime ,float(grazing_litter) ,npts*nvm, horipft_index)
1993	CALL histwrite_p(hist_id_stomate ,'SR_WILD' ,itime ,sr_wild ,npts*nvm, horipft_index)
1994	!ENDJCADD
1995	!milk
1996	CALL histwrite_p(hist_id_stomate ,'MILK' ,itime ,milk ,npts*nvm, horipft_index)
1997	CALL histwrite_p(hist_id_stomate ,'MILKSUM' ,itime ,milksum ,npts*nvm, horipft_index)
1998	CALL histwrite_p(hist_id_stomate ,'MILKCSUM' ,itime ,milkcsum ,npts*nvm, horipft_index)
1999	CALL histwrite_p(hist_id_stomate ,'MILKC' ,itime ,milkc ,npts*nvm, horipft_index)
2000	CALL histwrite_p(hist_id_stomate ,'MILKN' ,itime ,milkn ,npts*nvm, horipft_index)
2001	CALL histwrite_p(hist_id_stomate, 'MILKANIMAL' ,itime , milkanimal,npts*nvm, horipft_index )
2002
2003	!methane & respiration
2004	CALL histwrite_p(hist_id_stomate ,'METHANE',itime ,Methane ,npts*nvm, horipft_index)
2005	CALL histwrite_p(hist_id_stomate ,'METHANE_ANI',itime ,Methane_ani ,npts*nvm, horipft_index)
2006	CALL histwrite_p(hist_id_stomate ,'RANIMALSUM',itime ,ranimalsum ,npts*nvm, horipft_index)
2007	CALL histwrite_p(hist_id_stomate ,'METHANESUM',itime ,MethaneSum ,npts*nvm, horipft_index)
2008	CALL histwrite_p(hist_id_stomate ,'RANIMAL' ,itime ,ranimal ,npts*nvm, horipft_index)
2009
2010	!farces and urine
2011	CALL histwrite_p(hist_id_stomate ,'FAECESNSUM',itime ,faecesnsum ,npts*nvm, horipft_index)
2012	CALL histwrite_p(hist_id_stomate ,'FAECESCSUM',itime ,faecescsum ,npts*nvm, horipft_index)
2013	CALL histwrite_p(hist_id_stomate ,'URINECSUM' ,itime ,urinecsum ,npts*nvm, horipft_index)
2014	CALL histwrite_p(hist_id_stomate ,'URINENSUM' ,itime ,urinensum ,npts*nvm, horipft_index)
2015	CALL histwrite_p(hist_id_stomate ,'NEL' ,itime ,nel ,npts*nvm, horipft_index)
2016	CALL histwrite_p(hist_id_stomate ,'URINEN' ,itime ,urinen ,npts*nvm, horipft_index)
2017	CALL histwrite_p(hist_id_stomate ,'URINEC' ,itime ,urinec ,npts*nvm, horipft_index)
2018	CALL histwrite_p(hist_id_stomate ,'FAECESC' ,itime ,faecesc ,npts*nvm, horipft_index)
2019	CALL histwrite_p(hist_id_stomate ,'FAECESN' ,itime ,faecesn ,npts*nvm, horipft_index)
2020
2021	CALL histwrite_p(hist_id_stomate ,'GRAZED_FRAC' ,itime ,grazed_frac ,npts*nvm, horipft_index)
2022	CALL histwrite_p(hist_id_stomate ,'NB_ANI' ,itime ,nb_ani ,npts*nvm, horipft_index)
2023	CALL histwrite_p(hist_id_stomate ,'IMPORT_YIELD' ,itime ,import_yield ,npts*nvm, horipft_index)
2024	CALL histwrite_p(hist_id_stomate ,'EXTRA_FEED' ,itime ,extra_feed ,npts*nvm, horipft_index)
2025	CALL histwrite_p(hist_id_stomate ,'COMPT_UGB',itime ,compt_ugb ,npts*nvm, horipft_index)
2026	CALL histwrite_p(hist_id_stomate ,'NB_GRAZINGDAYS',itime ,nb_grazingdays,npts*nvm, horipft_index)
2027
2028	CALL histwrite_p(hist_id_stomate ,'AMOUNT_YIELD',itime ,amount_yield ,npts*nvm,horipft_index)
2029	CALL histwrite_p(hist_id_stomate ,'CONSUMP',itime ,consump ,npts*nvm,horipft_index)
2030	CALL histwrite_p(hist_id_stomate ,'OUTSIDE_FOOD',itime ,outside_food,npts*nvm,horipft_index)
2031
2032	CALL histwrite_p(hist_id_stomate ,'ADD_NB_ANI',itime ,add_nb_ani ,npts*nvm,horipft_index)
2033
2034
2035	END SUBROUTINE Animaux_main
2036
2037
2038	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2039	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2040	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2041	!!!! Animal_Init : ALL CHANGED ACCORDING TO PASIM 2011 Animal_Init and
2042	!!!! used by both Animaux_main and Animaux_main_dynamic
2043	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2044	!!!!!!!!!!!!!!!!
2045	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2046	SUBROUTINE Animal_Init(&
2047	npts , &
2048	nanimal , &
2049	type_animal , &
2050	intake_tolerance)
2051
2052	INTEGER (i_std) , INTENT(in) :: npts
2053	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nanimal ! Stocking density h (1,..,nstocking) (animal m-2)
2054	INTEGER (i_std) , INTENT(in) :: type_animal ! 1: Dairy cows, 2: Suckler cows, 3: Old module, 4: Dairy heifers, 5 : Suckler heifers
2055	REAL(r_std), INTENT(in) :: intake_tolerance ! Intake tolerance threshold (-)
2056
2057
2058	LOGICAL :: l_error = .FALSE.
2059	INTEGER(i_std) :: ier,j
2060
2061	!
2062	! initialisation
2063	!
2064
2065	IF (blabla_pasim) PRINT *, 'PASIM Animals : allocation memory in Animals_Orchidee'
2066
2067
2068	l_first_animaux =.FALSE.
2069	l_error = .FALSE.
2070	ALLOCATE (milk (npts,nvm), stat=ier)
2071	ALLOCATE (milkn (npts,nvm), stat=ier)
2072	ALLOCATE (milkc (npts,nvm), stat=ier)
2073	ALLOCATE (ranimal (npts,nvm), stat=ier)
2074	ALLOCATE (Methane (npts,nvm), stat=ier)
2075	ALLOCATE (faecesnsumprev (npts,nvm), stat=ier)
2076	ALLOCATE (milkndaily (npts,nvm), stat=ier)
2077	ALLOCATE (faecesndaily (npts,nvm), stat=ier)
2078	ALLOCATE (urinendaily (npts,nvm), stat=ier)
2079	ALLOCATE (milksum (npts,nvm), stat=ier)
2080	ALLOCATE (nelgrazingsum (npts,nvm), stat=ier)
2081	ALLOCATE (milkcsum (npts,nvm), stat=ier)
2082	ALLOCATE (ranimalsum (npts,nvm), stat=ier)
2083	ALLOCATE (Methanesum (npts,nvm), stat=ier)
2084	ALLOCATE (urinecsum (npts,nvm), stat=ier)
2085	ALLOCATE (faecescsum (npts,nvm), stat=ier)
2086	ALLOCATE (urinensum (npts,nvm), stat=ier)
2087	ALLOCATE (faecesnsum (npts,nvm), stat=ier)
2088	ALLOCATE (milknsum (npts,nvm), stat=ier)
2089	ALLOCATE (milknsumprev (npts,nvm), stat=ier)
2090	ALLOCATE (urinensumprev (npts,nvm), stat=ier)
2091	ALLOCATE (stockingstart (npts,nvm), stat=ier)
2092	ALLOCATE (stockingend (npts,nvm), stat=ier)
2093	ALLOCATE (wshtotstart (npts,nvm), stat=ier)
2094	ALLOCATE (grazingsum (npts,nvm), stat=ier)
2095	ALLOCATE (grazingcsum (npts,nvm), stat=ier)
2096	ALLOCATE (grazingnsum (npts,nvm), stat=ier)
2097	ALLOCATE (grazingc (npts,nvm), stat=ier)
2098	ALLOCATE (grazingn (npts,nvm), stat=ier)
2099	ALLOCATE (grazingnsumprev (npts,nvm), stat=ier)
2100	ALLOCATE (grazingndaily (npts,nvm), stat=ier)
2101	ALLOCATE (forage_complementc(npts,nvm), stat=ier)
2102	ALLOCATE (forage_complementn(npts,nvm), stat=ier)
2103	ALLOCATE (forage_complementcsum(npts,nvm), stat=ier)
2104	ALLOCATE (forage_complementnsum(npts,nvm), stat=ier)
2105	ALLOCATE (methane_ani (npts,nvm), stat=ier)
2106	ALLOCATE (methane_aniSum (npts,nvm), stat=ier)
2107	ALLOCATE (milkanimalsum (npts,nvm), stat=ier)
2108	ALLOCATE (milkanimal (npts,nvm), stat=ier)
2109	ALLOCATE (ugb (npts,nvm), stat=ier)
2110	ALLOCATE (ok_ugb (npts,nvm), stat=ier)
2111	ALLOCATE (extra_feed (npts,nvm), stat=ier)
2112	ALLOCATE (Wanimalcow (npts,nvm,2),stat=ier)
2113	ALLOCATE (BCScow (npts,nvm,2),stat=ier)
2114	ALLOCATE (BCScow_prev (npts,nvm,2),stat=ier)
2115	ALLOCATE (AGEcow (npts,nvm,2),stat=ier)
2116	ALLOCATE (Forage_quantity_period (npts,nvm),stat=ier)
2117	ALLOCATE (MPcowCsum (npts,nvm,2),stat=ier)
2118	ALLOCATE (MPcowNsum (npts,nvm,2),stat=ier)
2119	ALLOCATE (MPcowN (npts,nvm,2),stat=ier)
2120	ALLOCATE (MPcowC (npts,nvm,2),stat=ier)
2121	ALLOCATE (MPcowsum (npts,nvm,2),stat=ier)
2122	ALLOCATE (MPcow2sum (npts,nvm,2),stat=ier)
2123	ALLOCATE (MPcow2_prec (npts,nvm,2),stat=ier)
2124	ALLOCATE (DMIcowsum (npts,nvm,2),stat=ier)
2125	ALLOCATE (DMIcowNsum (npts,nvm,2),stat=ier)
2126	ALLOCATE (DMIcowCsum (npts,nvm,2),stat=ier)
2127	ALLOCATE (DMIcowanimalsum (npts,nvm,2),stat=ier)
2128	ALLOCATE (Wanimalcalf (npts,nvm),stat=ier)
2129	ALLOCATE (DMIcalfsum (npts,nvm),stat=ier)
2130	ALLOCATE (DMIcalfnsum (npts,nvm),stat=ier)
2131	ALLOCATE (DMIcalfanimalsum (npts,nvm),stat=ier)
2132	ALLOCATE (Tcalving (npts,nvm), stat=ier)
2133	ALLOCATE (Tsevrage (npts,nvm), stat=ier)
2134	ALLOCATE (Age_sortie_calf (npts,nvm), stat=ier)
2135	ALLOCATE (Pyoung (npts,nvm), stat=ier)
2136	ALLOCATE (Wcalfborn (npts,nvm), stat=ier)
2137	ALLOCATE (calfinit (npts,nvm),stat=ier)
2138	ALLOCATE (Wanimalcalfinit (npts,nvm), stat=ier)
2139	ALLOCATE (calf (npts,nvm),stat=ier)
2140	ALLOCATE (nanimaltot_prec (npts,nvm), stat=ier)
2141	ALLOCATE (Gestation (npts,nvm),stat=ier)
2142	ALLOCATE (compte_pature (npts,nvm), stat=ier)
2143	ALLOCATE (autogestion_weightcow (npts,nvm,4), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2144	ALLOCATE (autogestion_BCScow (npts,nvm,4), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2145	ALLOCATE (autogestion_AGEcow (npts,nvm,4), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2146	ALLOCATE (autogestion_init (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2147	ALLOCATE (QIc (npts,nvm,2) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2148	ALLOCATE (EVf (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2149	ALLOCATE (EVc (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2150	ALLOCATE (FVf (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2151	ALLOCATE (fN_forage (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2152	ALLOCATE (fN_concentrate (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2153	ALLOCATE (NEBcow_prec (npts,nvm,2) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2154	ALLOCATE (MPwmax (npts,nvm,2) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2155	ALLOCATE (Fday_pasture (npts,nvm) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2156	ALLOCATE (delai_ugb (npts,nvm) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2157	ALLOCATE (Local_autogestion_out (npts,nvm,n_out) , stat=ier); l_error=l_error .OR. (ier .NE. 0)
2158	ALLOCATE (PEmax (npts,nvm,2),stat=ier); l_error=l_error .OR. (ier .NE. 0)
2159	ALLOCATE (PEpos (npts,nvm,2),stat=ier); l_error=l_error .OR. (ier .NE. 0)
2160	ALLOCATE (DMIc (npts,nvm,2),stat=ier); l_error=l_error .OR. (ier .NE. 0)
2161	ALLOCATE (DMIf (npts,nvm,2),stat=ier); l_error=l_error .OR. (ier .NE. 0)
2162	ALLOCATE (NER (npts,nvm,2),stat=ier); l_error=l_error .OR. (ier .NE. 0)
2163	ALLOCATE (Substrate_grazingwc (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2164	ALLOCATE (Substrate_grazingwn (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2165	ALLOCATE (grazingcstruct (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2166	ALLOCATE (grazingnstruct (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2167	ALLOCATE (DNDFlam (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2168	ALLOCATE (DNDF (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2169	ALLOCATE (NDF (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2170	ALLOCATE (DNDFI (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2171	ALLOCATE (DNDFstem (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2172	ALLOCATE (DNDFear (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2173	ALLOCATE (NDFmean (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2174	ALLOCATE (NDFlam (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2175	ALLOCATE (NDFstem (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2176	ALLOCATE (NDFear (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2177
2178	ALLOCATE (plam (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2179	ALLOCATE (pstem (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2180	ALLOCATE (pear (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2181	ALLOCATE (MassePondTot (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2182	ALLOCATE (grazingstruct (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2183	ALLOCATE (grazinglam (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2184	ALLOCATE (grazingstem (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2185	ALLOCATE (grazingear (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2186
2187
2188	! ALLOCATE (nb_grazingdays (npts,nvm), stat=ier); l_error=l_error .OR. (ier.NE. 0)
2189	ALLOCATE (amount_yield (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2190	ALLOCATE (consump (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2191	ALLOCATE (outside_food (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2192	ALLOCATE (add_nb_ani (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2193
2194	ALLOCATE (able_grazing (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2195	!JCADD
2196	ALLOCATE (ct_dry (npts,nvm), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2197	ALLOCATE (t2m_below_zero (npts), stat=ier); l_error=l_error .OR. (ier .NE. 0)
2198	IF ( l_error ) THEN
2199	STOP 'Animaux_init: error in memory allocation'
2200	ENDIF
2201
2202	IF (blabla_pasim) PRINT *, 'PASIM Animals : end of allocation memory in Animals_Orchidee'
2203	milk = 0.0
2204	milknsumprev = 0.0
2205	urinensumprev = 0.0
2206	milknsum = 0.0
2207	ranimalsum = 0.0
2208	milkcsum = 0.0
2209	urinecsum = 0.0
2210	faecescsum = 0.0
2211	urinensum = 0.0
2212	faecesnsum = 0.0
2213	Methanesum = 0.0
2214	milksum = 0.0
2215	nelgrazingsum = 0.0
2216	milkndaily = 0.0
2217	faecesndaily = 0.0
2218	urinendaily = 0.0
2219	milkn = 0.0
2220	milkc = 0.0
2221	ranimal = 0.0
2222	methane = 0.0
2223	faecesnsumprev = 0.0
2224	stockingstart = 0
2225	stockingend = 0
2226	wshtotstart(:,:) = 0.0
2227	grazingsum = 0.0
2228	grazingcsum = 0.0
2229	grazingnsum = 0.0
2230	grazingc = 0.0
2231	grazingn = 0.0
2232	grazingnsumprev = 0.0
2233	grazingndaily = 0.0
2234	forage_complementc= 0.0
2235	forage_complementn= 0.0
2236	forage_complementcsum= 0.0
2237	forage_complementnsum= 0.0
2238	methane_ani = 0.0
2239	methane_aniSum = 0.0
2240	milkanimalsum = 0.0
2241	milkanimal = 0.0
2242	MPcowsum=0.0
2243	MPcow2sum=0.0
2244	MPcowN=0.0
2245	MPcowC=0.0
2246	MPcowCsum=0.0
2247	MPcowNsum=0.0
2248	DMIcowsum=0.0
2249	DMIcowNsum=0.0
2250	DMIcowCsum=0.0
2251	DMIcowanimalsum=0.0
2252	DMIcalfanimalsum=0.0
2253	Wanimalcow = 0.0
2254	BCScow = 0.0
2255	AGEcow = 0.0
2256	Forage_quantity_period = 0.0
2257	Wanimalcalf = 0.0
2258	Wanimalcalfinit = 0.0
2259	nanimaltot_prec = 0.0
2260	compte_pature = 0.0
2261	autogestion_weightcow = 0.0
2262	autogestion_BCScow = 0.0
2263	autogestion_AGEcow = 0.0
2264	QIc= 0.0
2265	EVf = 0.0
2266	EVc = 0.0
2267	FVf = 0.0
2268	autogestion_init = 0.0
2269	NEBcow_prec= 0.0
2270	MPwmax=0.0
2271	NER = 0.0
2272	DNDF = 0.0
2273	NDF = 0.0
2274	DNDFI = 0.0
2275	NDFmean = 0.0
2276	NDFear = 0.80 !!! @equation principal::NDFear
2277	NDFlam = 0.60 !!! @equation principal::NDFlam
2278	NDFstem = 0.70 !!! @equation principal::NDFstem
2279
2280	DNDFstem = 0.0
2281	DNDFlam = 0.0
2282	DNDFear = 0.0
2283	pstem = 0.0
2284	plam = 0.0
2285	pear = 0.0
2286	MassePondTot = 0.0
2287	grazingstruct = 0.0
2288	grazinglam = 0.0
2289	grazingstem = 0.0
2290	grazingear = 0.0
2291
2292
2293	BM_threshold=0.0
2294	BM_threshold_turnout = 0.0
2295	IF(type_animal.EQ.1) THEN
2296	BM_threshold=LOG10((1.-intake_tolerance)/16.95)/(-0.00275*10000)
2297	BM_threshold_turnout = LOG10((1- (intake_tolerance +0.1))/16.95)/(-0.00275*10000)
2298	ELSE
2299	BM_threshold=LOG10(1.-intake_tolerance)/(-0.0012*10000)
2300	BM_threshold_turnout=LOG10(1-(intake_tolerance +0.1))/(-0.0012*10000)
2301	ENDIF
2302	!print *,'BM_threshold',BM_threshold,BM_threshold_turnout
2303	DO j=2,nvm
2304	IF (is_grassland_grazed(j).AND.(.NOT.is_grassland_cut(j)) .AND. &
2305	(.NOT. is_c4(j)) .AND. (.NOT.is_tree(j)))THEN
2306	mgraze_C3=j
2307	END IF
2308	IF (is_grassland_grazed(j).AND.(.NOT.is_grassland_cut(j)) .AND. &
2309	(is_c4(j)) .AND. (.NOT.is_tree(j)))THEN
2310	mgraze_C4=j
2311	END IF
2312	IF ( (.NOT.is_grassland_manag(j)) .AND.(.NOT.is_grassland_grazed(j)).AND. &
2313	(.NOT.is_grassland_cut(j)) .AND. (.NOT. is_c4(j)) .AND. (.NOT.is_tree(j)) &
2314	.AND. natural(j))THEN
2315	mnatural_C3=j
2316	END IF
2317	IF ( (.NOT.is_grassland_manag(j)) .AND.(.NOT.is_grassland_grazed(j)).AND. &
2318	(.NOT.is_grassland_cut(j)) .AND. (is_c4(j)) .AND. (.NOT.is_tree(j)) &
2319	.AND. natural(j))THEN
2320	mnatural_C4=j
2321	END IF
2322	END DO
2323	! nb_grazingdays(:,:) = 0.0
2324	amount_yield(:,:) = 0.0
2325	consump(:,:) = 0.0
2326	outside_food(:,:) = 0.0
2327	add_nb_ani(:,:) = 0.0
2328	!JCADD
2329	ct_dry(:,:) = 11.0
2330	t2m_below_zero(:) = 0.0
2331	IF (f_postauto .NE. 1) THEN
2332
2333	Local_autogestion_out = 0.0
2334
2335	ugb = 0
2336
2337	ok_ugb = 1
2338
2339	delai_ugb=-15
2340	ELSE
2341
2342	Local_autogestion_out = 0.0
2343
2344	ugb = 0
2345
2346	ok_ugb = 1
2347
2348	delai_ugb=-15
2349
2350	ENDIF
2351
2352
2353	IF ((f_autogestion .GE. 2) .OR. (f_postauto .NE. 0)) THEN
2354
2355	ok_ugb = 0
2356
2357	ENDIF
2358
2359
2360	END SUBROUTINE Animal_Init
2361
2362
2363
2364	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2365	!!!!!!!!!!!!!!!! GRAZING INTAKE
2366	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2367
2368	SUBROUTINE Grazing_intake(&
2369	npts , &
2370	dt , &
2371	wsh , &
2372	intakemax , &
2373	Animalwgrazingmin , &
2374	AnimalkintakeM , &
2375	intake , &
2376	intakesum , &
2377	tanimal , &
2378	danimal , &
2379	tjulian , &
2380	intakensum , &
2381	fn , &
2382	n , &
2383	intake_animal , &
2384	intake_animalsum , &
2385	nanimaltot , &
2386	intake_litter , &
2387	intake_animal_litter, &
2388	grazing_litter)
2389
2390	!! Declarations des variables
2391	INTEGER(i_std) , INTENT(in) :: npts
2392	REAL(r_std) , INTENT(in) :: dt
2393	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wsh
2394	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intakemax
2395
2396	! variables dependant du type des animaux sur les prairies
2397	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: Animalwgrazingmin ! 0.03
2398	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: AnimalkintakeM
2399	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake
2400	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intakesum
2401	! Yearly intake per m2 (kg m-2 y-1)
2402	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_animal
2403	! Daily intake per animal(kg animal-1 d-1)
2404	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intake_animalsum
2405	! Yearly intake per animal(kg animal-1 y-1)
2406
2407	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tanimal
2408	! début du paturage h (1,..,nstocking) (d)
2409	REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: danimal
2410	! durée du paturage h (1,..,nstocking) (d)
2411	INTEGER(i_std), INTENT(in) :: tjulian
2412	! Julian day (-)
2413	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: intakensum
2414	! N in daily intake per m2(kgN/m2)
2415	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fn
2416	! nitrogen in structural dry matter
2417	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: n
2418	! nitrogen substrate concentration in plant,(kg n/kg)
2419	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
2420	! Stocking rate (animal m-2)
2421	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_litter
2422	! Daily intake per animal(kg animal-1 d-1)
2423	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: intake_animal_litter
2424	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: grazing_litter
2425
2426	INTEGER :: i,h,j
2427	REAL(r_std), DIMENSION(npts,nvm) ::temp
2428
2429	intake = 0.0
2430	intake_animal = 0.0
2431	intake_litter = 0.0
2432	intake_animal_litter = 0.0
2433
2434	IF (f_autogestion .NE. 5 .AND. f_postauto .NE. 5) THEN
2435	!grazing intake per animal
2436	! JC MODIF for global simulation
2437	! start to have intake after 5gDM/m^2
2438	WHERE ((wsh - (Animalwgrazingmin-0.025)) .LE. 0.0)
2439
2440	intake_animal = 0.0
2441
2442	intake = 0.0
2443
2444	ELSEWHERE (wsh .GE. 0.150)
2445
2446	intake_animal = intakemax * &
2447	((wsh - Animalwgrazingmin)** AnimalqintakeM/ &
2448	((AnimalkintakeM - Animalwgrazingmin)**AnimalqintakeM + &
2449	(wsh - Animalwgrazingmin)**AnimalqintakeM))
2450
2451	intake = intake_animal * nanimaltot
2452
2453	ELSEWHERE (wsh .LT. 0.150 .and. ((wsh - (Animalwgrazingmin-0.025)) .GT. 0.0))
2454
2455	intake_animal = intakemax * 0.8
2456
2457	intake = intake_animal * nanimaltot
2458
2459	END WHERE
2460
2461
2462	WHERE (nanimaltot .EQ.0)
2463	intake_animal=0.0
2464	ENDWHERE
2465	! cumulated value
2466
2467	DO j=2,nvm
2468	DO i=1,npts
2469	h = 1
2470	DO WHILE(h .LT. nstocking)
2471	! During the grazing period, wich begins at tanimal and finishes at tanimal+danimal
2472	IF((tjulian .GE. tanimal(i,j,h)) .AND. &
2473	(tjulian .LT. (tanimal(i,j,h) + danimal(i,j,h)))) THEN
2474	CALL Euler_funct(1, dt, intake(i,j), intakesum(i,j))
2475	CALL Euler_funct(1, dt, intake_animal(i,j), intake_animalsum(i,j))
2476	temp(i,j)=intake(i,j)*(n(i,j)+fn(i,j))
2477	CALL Euler_funct(1, dt, temp(i,j), intakensum(i,j))
2478	ENDIF
2479	h= h+1
2480	ENDDO
2481	ENDDO
2482	ENDDO
2483
2484	ELSEIF (f_autogestion .EQ. 5 .OR. f_postauto .EQ. 5) THEN
2485
2486	WHERE (ugb(:,:) .EQ. 1 .AND. grazing_litter(:,:) .EQ. 0 &
2487	& .AND. nanimaltot .GT. 0.0 )
2488	intake_animal = 18.0 ! 20kgDM/LSU/day for grazing biomass
2489	intake = intake_animal * nanimaltot
2490	intake_animal_litter = 0.0
2491	intake_litter =0.0
2492	ELSEWHERE (ugb(:,:) .EQ. 1 .AND. grazing_litter(:,:) .EQ. 1 &
2493	& .AND. nanimaltot .GT. 0.0 )
2494	intake_animal = 0.0 ! 10kgDM/LSU/day for grazing litter
2495	intake = 0.0
2496	intake_animal_litter = 10.0
2497	intake_litter = intake_animal_litter * nanimaltot
2498	ELSEWHERE
2499	intake_animal = 0.0
2500	intake = 0.0
2501	intake_animal_litter = 0.0
2502	intake_litter =0.0
2503	ENDWHERE
2504
2505	ENDIF
2506	END SUBROUTINE Grazing_intake
2507
2508	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2509	!!!!!!!!!!!!!!!! MILK ANIMAL
2510	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2511
2512	SUBROUTINE Milk_Animal(&
2513	npts , &
2514	dt , &
2515	nel , &
2516	intake_animal , &
2517	wanimal , &
2518	nanimaltot )
2519
2520	!! Déclaration des variables
2521	INTEGER(i_std) , INTENT(in) :: npts
2522	REAL(r_std) , INTENT(in) :: dt
2523	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nel
2524	!nettoenergie laktation (mj/kg)
2525	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake_animal
2526	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wanimal
2527	!lebendgewicht laktierender kuehe (kg)
2528	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
2529	!beweidungsdichte (gve/m**2)
2530	INTEGER :: j
2531
2532	!JCMODIF for global simulation assuming no milk production
2533	IF (f_autogestion .EQ. 0 .AND. f_postauto .EQ. 0 ) THEN
2534
2535	!(forschungsanstalt posieux, 1994)
2536	WHERE (nanimaltot .GT. 0)
2537	milkanimal = MAX(0.0,(nel*intake_animal - (wanimal/20.0 + 5.0))/3.14)
2538
2539	milk = nanimaltot *milkanimal
2540	milkc = 0.0588*milk
2541	milkn = 0.00517*milk
2542	ELSEWHERE
2543	milkanimal = 0.0
2544	milk = 0.0
2545	milkc = 0.0
2546	milkn = 0.0
2547	END WHERE
2548
2549	DO j=2,nvm
2550	CALL Euler_funct(npts, dt, milk(:,j) , milksum(:,j))
2551	CALL Euler_funct(npts, dt, milkc(:,j), milkcsum(:,j))
2552	CALL Euler_funct(npts, dt, milkn(:,j), milknsum(:,j))
2553
2554	milkndaily(:,j) = milknsum(:,j) - milknsumprev(:,j)
2555	CALL Euler_funct(npts, dt, nel(:,j)intake_animal(:,j)nanimaltot(:,j) , nelgrazingsum(:,j))
2556
2557	CALL Euler_funct(npts, dt, milkanimal(:,j), milkanimalsum(:,j))
2558	!!! @equation animaux::milkanimalsum
2559	END DO
2560
2561	ELSE ! all other auto management
2562	milkanimal = 0.0
2563	milk = 0.0
2564	milkc = 0.0
2565	milkn = 0.0
2566	ENDIF
2567
2568	END SUBROUTINE Milk_Animal
2569
2570	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2571	!!!!!!!!!!!!!!!! RESPIRATION METHANE
2572	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2573
2574	SUBROUTINE Respiration_Methane(&
2575	npts , &
2576	dt , &
2577	grazingc , &
2578	nanimaltot, DNDFI, wanimal)
2579
2580	INTEGER(i_std) , INTENT(in) :: npts
2581	REAL(r_std) , INTENT(in) :: dt
2582	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: grazingc
2583	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
2584	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: DNDFI
2585	! Amount of digestible neutral detergent fiber in the intake (kg d-1)
2586	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: Wanimal
2587	! Animal life weight (kg)
2588
2589	! variables locales
2590	REAL(r_std), DIMENSION(npts,nvm) :: methane_ani !c im methan (kg c /(m*2d))
2591	INTEGER :: j
2592
2593	!respiration and methane loss
2594	!(minonzio et al., 1998)
2595
2596	ranimal = franimal * grazingc
2597
2598	methane = fmethane * grazingc
2599
2600	WHERE (nanimaltot .GT. 0.0)
2601
2602	WHERE((aCH4 + bCH4 * DNDFI) .GE. 0.0)
2603
2604	!(2) p88 equation (1)
2605	! Inversion de ach4 & bch4
2606
2607	methane_ani = (ach4 + bch4 * DNDFI)wanimalch4toc
2608	methane = methane_ani*nanimaltot
2609
2610	ELSEWHERE
2611
2612	methane = 0.0
2613	methane_ani = 0.0
2614
2615	END WHERE
2616
2617
2618	ELSEWHERE
2619	methane = 0.0
2620	methane_ani = 0.0
2621	END WHERE
2622	DO j=2,nvm
2623	CALL Euler_funct(npts, dt, ranimal(:,j), ranimalsum(:,j))
2624
2625	CALL Euler_funct(npts, dt, methane(:,j), Methanesum(:,j))
2626
2627	CALL Euler_funct(npts, dt, methane_ani(:,j), Methane_aniSum(:,j))
2628
2629	ENDDO
2630	END SUBROUTINE Respiration_Methane
2631
2632	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2633	!!!!!!!!!!!!!!!! URINE FAECES
2634	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2635
2636	SUBROUTINE Urine_Faeces(&
2637	npts , &
2638	dt , &
2639	grazingn , &
2640	grazingc , &
2641	urinen , &
2642	faecesn , &
2643	urinec , &
2644	faecesc )
2645
2646	INTEGER(i_std) , INTENT(in) :: npts
2647	REAL(r_std) , INTENT(in) :: dt
2648	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: grazingn
2649	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: grazingc
2650	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: urinen
2651	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: faecesn
2652	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: urinec
2653	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: faecesc
2654
2655	! variables locales
2656	REAL(r_std), DIMENSION(npts,nvm) :: excretan
2657	INTEGER :: j
2658	!urine and faeces
2659	!(thornley 1998)
2660
2661	!n in excreta
2662	excretan = grazingn - milkn
2663
2664	! équation (4.4d) de "Grassland dynamics" Thornley
2665
2666	urinen = fnurine*excretan
2667	faecesn = (1.0 - fnurine)*excretan
2668
2669
2670	DO j=2,nvm
2671	CALL Euler_funct(npts, dt, urinen, urinensum(:,j))
2672	urinendaily(:,j) = urinensum(:,j) - urinensumprev(:,j)
2673
2674	CALL Euler_funct(npts, dt, faecesn(:,j), faecesnsum(:,j))
2675	faecesndaily(:,j) = faecesnsum(:,j) - faecesnsumprev(:,j)
2676	END DO
2677	!c respired and in excreta
2678	! équation (4.4e) de "grassland dynamics" thornley
2679	urinec = fnurineexcretan12.0/28.0
2680	! = urinen 12.0/28.0
2681	! 12 => un atome de C
2682	! 28 => deux atomes de N
2683
2684	faecesc = &
2685	grazingc - & ! gross C intake
2686	milkc - & ! lait
2687	ranimal - & ! maintenance respiration
2688	methane - & ! methane production
2689	urinec ! urine
2690
2691
2692
2693	DO j=2,nvm
2694	CALL Euler_funct(npts, dt, urinec(:,j), urinecsum(:,j))
2695	CALL Euler_funct(npts, dt, faecesc(:,j), faecescsum(:,j))
2696	ENDDO
2697
2698	END SUBROUTINE Urine_Faeces
2699
2700
2701
2702	! ******************************************************************************
2703	!!!!!!!!!!!! JCmodif 110525 del calculation of grazingc and grazingn
2704	!!!!!!!!!!!! they have been moved before Respiration
2705
2706	SUBROUTINE nel_grazing_calcul(&
2707	npts , &
2708	dt , &
2709	nanimaltot , &
2710	devstage , &
2711	tgrowth , &
2712	nel , &
2713	ntot)
2714
2715
2716	INTEGER(i_std) , INTENT(in) :: npts
2717	! r_std du domaine
2718	REAL(r_std) , INTENT(in) :: dt
2719	! pas de temps
2720	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
2721	! nombre d'animaux
2722	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: devstage
2723	! stade de développement de la pousse
2724	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: tgrowth
2725	! instant de repousse de la coupe actuelle(d)
2726	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: nel
2727	! energie nette de lactation (mj/kg)
2728	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ntot
2729	! concentration en n totale (kg n/kg)
2730
2731
2732	! variables locales :
2733	REAL(r_std), DIMENSION(npts,nvm) :: os
2734	! organische substanz (kg/kg)
2735	REAL(r_std), DIMENSION(npts,nvm) :: rp
2736	! rohproteingehalt (kg/kg)
2737	REAL(r_std), DIMENSION(npts,nvm) :: be
2738	! bruttoenergie (mj/kg)
2739	REAL(r_std), DIMENSION(npts,nvm) :: vos
2740	! verdauliche organische substanz (kg/kg)
2741	REAL(r_std), DIMENSION(npts,nvm) :: fvos
2742	REAL(r_std), DIMENSION(npts,nvm) :: vp
2743	REAL(r_std), DIMENSION(npts,nvm) :: ue
2744	! energie métabolisable (mj/kg)
2745	REAL(r_std), DIMENSION(npts,nvm) :: knel
2746	REAL(r_std), DIMENSION(npts,nvm) :: rf
2747	! rohfasergehalt (concentration en cellulose) (kg/kg)
2748	REAL(r_std), DIMENSION(npts,nvm) :: temp_ratio
2749
2750	os (:,:) = 0.0
2751	rp (:,:) = 0.0
2752	be (:,:) = 0.0
2753	vos (:,:) = 0.0
2754	fvos (:,:) = 0.0
2755	vp (:,:) = 0.0
2756	ue (:,:) = 0.0
2757	knel (:,:) = 0.0
2758	rf (:,:) = 0.0
2759
2760	!calcul de nel
2761	os(:,:) = 0.9
2762	rp(:,:) = 6.25*ntot(:,:)
2763	be(:,:) = 18.8os(:,:) + 7.8 rp (:,:)
2764
2765	WHERE (devstage .LT. 2.0)
2766
2767	rf = MIN (rf7 , rf1 + (rf3 - rf1)*devstage/devear)
2768
2769	ELSEWHERE (nanimaltot .LE. 0.0)
2770
2771	rf = MIN (rf7, rf1 + (rf3 - rf1)*tgrowth/49.0)
2772
2773	ELSEWHERE
2774	rf = rf1
2775
2776	END WHERE
2777
2778
2779	fvos(:,:) = 0.835 + &
2780	0.114*rp(:,:) /os(:,:) - &
2781	1.45(rf(:,:) /os(:,:) )*2
2782
2783	vos(:,:) = fvos(:,:) *os(:,:)
2784
2785	vp(:,:) = rp(:,:) * (0.33 + 3.3rp(:,:)/os(:,:) - 6.1(rp(:,:)/os(:,:))**2)
2786
2787	WHERE (vp .GT. 0.0)
2788	temp_ratio=vos/vp
2789	ELSEWHERE
2790	temp_ratio=8.
2791	ENDWHERE
2792	WHERE (temp_ratio .LT. 7.0)
2793
2794	ue = 14.2vos + 5.9 vp
2795
2796	ELSEWHERE
2797
2798	ue = 15.1*vos
2799
2800	END WHERE
2801
2802	knel(:,:) = 0.463 + 0.24*ue(:,:) /be(:,:)
2803
2804	nel(:,:) = knel(:,:) * ue(:,:) * 0.9752
2805
2806
2807
2808	END SUBROUTINE nel_grazing_calcul
2809
2810
2811
2812
2813
2814	! SUBROUTINE deallocation_animaux
2815	SUBROUTINE animal_clear
2816	INTEGER(i_std) :: ier
2817	IF (ALLOCATED(milk )) DEALLOCATE (milk )
2818	IF (ALLOCATED(milkn )) DEALLOCATE (milkn )
2819	IF (ALLOCATED(milkc )) DEALLOCATE (milkc )
2820	IF (ALLOCATED(ranimal )) DEALLOCATE (ranimal )
2821	IF (ALLOCATED(methane )) DEALLOCATE (methane )
2822	IF (ALLOCATED(faecesnsumprev )) DEALLOCATE (faecesnsumprev )
2823	IF (ALLOCATED(milkndaily )) DEALLOCATE (milkndaily )
2824	IF (ALLOCATED(faecesndaily )) DEALLOCATE (faecesndaily )
2825	IF (ALLOCATED(urinendaily )) DEALLOCATE (urinendaily )
2826	IF (ALLOCATED(milksum )) DEALLOCATE (milksum )
2827	IF (ALLOCATED(nelgrazingsum )) DEALLOCATE (nelgrazingsum )
2828	IF (ALLOCATED(ranimalsum )) DEALLOCATE (ranimalsum )
2829	IF (ALLOCATED(milkcsum )) DEALLOCATE (milkcsum )
2830	IF (ALLOCATED(Methanesum )) DEALLOCATE (Methanesum )
2831	IF (ALLOCATED(urinecsum )) DEALLOCATE (urinecsum )
2832	IF (ALLOCATED(faecescsum )) DEALLOCATE (faecescsum )
2833	IF (ALLOCATED(urinensum )) DEALLOCATE (urinensum )
2834	IF (ALLOCATED(faecesnsum )) DEALLOCATE (faecesnsum )
2835	IF (ALLOCATED(milknsum )) DEALLOCATE (milknsum )
2836	IF (ALLOCATED(milknsumprev )) DEALLOCATE (milknsumprev )
2837	IF (ALLOCATED(urinensumprev )) DEALLOCATE (urinensumprev )
2838	IF (ALLOCATED(stockingstart )) DEALLOCATE (stockingstart )
2839	IF (ALLOCATED(stockingend )) DEALLOCATE (stockingend )
2840	IF (ALLOCATED(wshtotstart )) DEALLOCATE (wshtotstart )
2841	IF (ALLOCATED(grazingsum )) DEALLOCATE (grazingsum )
2842	IF (ALLOCATED(grazingcsum )) DEALLOCATE (grazingcsum )
2843	IF (ALLOCATED(grazingnsum )) DEALLOCATE (grazingnsum )
2844	IF (ALLOCATED(grazingc )) DEALLOCATE (grazingc )
2845	IF (ALLOCATED(grazingn )) DEALLOCATE (grazingn )
2846	IF (ALLOCATED(grazingnsumprev )) DEALLOCATE (grazingnsumprev )
2847	IF (ALLOCATED(grazingndaily )) DEALLOCATE (grazingndaily )
2848	IF (ALLOCATED(forage_complementc)) DEALLOCATE(forage_complementc)
2849	IF (ALLOCATED(forage_complementn)) DEALLOCATE(forage_complementn)
2850	IF (ALLOCATED(forage_complementcsum)) DEALLOCATE(forage_complementcsum)
2851	IF (ALLOCATED(forage_complementnsum)) DEALLOCATE(forage_complementnsum)
2852	IF (ALLOCATED(methane_ani)) DEALLOCATE(methane_ani)
2853	IF (ALLOCATED(methane_aniSum)) DEALLOCATE(methane_aniSum)
2854	IF (ALLOCATED(milkanimalsum)) DEALLOCATE(milkanimalsum)
2855	IF (ALLOCATED(milkanimal)) DEALLOCATE(milkanimal)
2856	IF (ALLOCATED(ugb)) DEALLOCATE(ugb)
2857	IF (ALLOCATED(ok_ugb)) DEALLOCATE(ok_ugb)
2858	IF (ALLOCATED(extra_feed)) DEALLOCATE(extra_feed)
2859	IF (ALLOCATED(Wanimalcow)) DEALLOCATE(Wanimalcow)
2860	IF (ALLOCATED(BCScow)) DEALLOCATE(BCScow)
2861	IF (ALLOCATED(BCScow_prev)) DEALLOCATE(BCScow_prev)
2862	IF (ALLOCATED(AGEcow)) DEALLOCATE(AGEcow)
2863	IF (ALLOCATED(Forage_quantity_period)) DEALLOCATE(Forage_quantity_period)
2864	IF (ALLOCATED(MPcowCsum)) DEALLOCATE(MPcowCsum)
2865	IF (ALLOCATED(MPcowNsum)) DEALLOCATE(MPcowNsum)
2866	IF (ALLOCATED(MPcowN)) DEALLOCATE(MPcowN)
2867	IF (ALLOCATED(MPcowC)) DEALLOCATE(MPcowC)
2868	IF (ALLOCATED(MPcowsum)) DEALLOCATE(MPcowsum)
2869	IF (ALLOCATED(MPcow2sum)) DEALLOCATE(MPcow2sum)
2870	IF (ALLOCATED(MPcow2_prec)) DEALLOCATE(MPcow2_prec)
2871	IF (ALLOCATED(DMIcowsum)) DEALLOCATE(DMIcowsum)
2872	IF (ALLOCATED(DMIcowNsum)) DEALLOCATE(DMIcowNsum)
2873	IF (ALLOCATED(DMIcowCsum)) DEALLOCATE(DMIcowCsum)
2874	IF (ALLOCATED(DMIcowanimalsum)) DEALLOCATE(DMIcowanimalsum)
2875	IF (ALLOCATED(Wanimalcalf)) DEALLOCATE(Wanimalcalf)
2876	IF (ALLOCATED(DMIcalfsum)) DEALLOCATE(DMIcalfsum)
2877	IF (ALLOCATED(DMIcalfnsum)) DEALLOCATE(DMIcalfnsum)
2878	IF (ALLOCATED(DMIcalfanimalsum)) DEALLOCATE(DMIcalfanimalsum)
2879	IF (ALLOCATED(Tcalving)) DEALLOCATE(Tcalving)
2880	IF (ALLOCATED(Tsevrage)) DEALLOCATE(Tsevrage)
2881	IF (ALLOCATED(Age_sortie_calf)) DEALLOCATE(Age_sortie_calf)
2882	IF (ALLOCATED(Pyoung)) DEALLOCATE(Pyoung)
2883	IF (ALLOCATED(Wcalfborn)) DEALLOCATE(Wcalfborn)
2884	IF (ALLOCATED(calfinit)) DEALLOCATE(calfinit)
2885	IF (ALLOCATED(Wanimalcalfinit)) DEALLOCATE(Wanimalcalfinit)
2886	IF (ALLOCATED(calf)) DEALLOCATE(calf)
2887	IF (ALLOCATED(nanimaltot_prec)) DEALLOCATE(nanimaltot_prec)
2888	IF (ALLOCATED(Gestation)) DEALLOCATE(Gestation)
2889	IF (ALLOCATED(compte_pature)) DEALLOCATE(compte_pature)
2890	IF (ALLOCATED(autogestion_weightcow)) DEALLOCATE(autogestion_weightcow)
2891	IF (ALLOCATED(autogestion_BCScow)) DEALLOCATE(autogestion_BCScow)
2892	IF (ALLOCATED(autogestion_AGEcow)) DEALLOCATE(autogestion_AGEcow)
2893	IF (ALLOCATED(autogestion_init)) DEALLOCATE(autogestion_init)
2894	IF (ALLOCATED(QIc)) DEALLOCATE(QIc)
2895	IF (ALLOCATED(EVf)) DEALLOCATE(EVf)
2896	IF (ALLOCATED(EVc)) DEALLOCATE(EVc)
2897	IF (ALLOCATED(FVf)) DEALLOCATE(FVf)
2898	IF (ALLOCATED(fN_forage)) DEALLOCATE(fN_forage)
2899	IF (ALLOCATED(fN_concentrate)) DEALLOCATE(fN_concentrate)
2900	IF (ALLOCATED(NEBcow_prec)) DEALLOCATE(NEBcow_prec)
2901	IF (ALLOCATED(MPwmax)) DEALLOCATE(MPwmax)
2902	IF (ALLOCATED(Fday_pasture)) DEALLOCATE(Fday_pasture)
2903	IF (ALLOCATED(delai_ugb)) DEALLOCATE(delai_ugb)
2904	IF (ALLOCATED(Local_autogestion_out)) DEALLOCATE(Local_autogestion_out)
2905	IF (ALLOCATED(PEmax)) DEALLOCATE(PEmax)
2906	IF (ALLOCATED(PEpos)) DEALLOCATE(PEpos)
2907	IF (ALLOCATED(DMIc)) DEALLOCATE(DMIc)
2908	IF (ALLOCATED(DMIf)) DEALLOCATE(DMIf)
2909	IF (ALLOCATED(NER)) DEALLOCATE(NER)
2910	IF (ALLOCATED(Substrate_grazingwc)) DEALLOCATE(Substrate_grazingwc)
2911	IF (ALLOCATED(Substrate_grazingwn)) DEALLOCATE(Substrate_grazingwn)
2912	IF (ALLOCATED(grazingcstruct)) DEALLOCATE(grazingcstruct)
2913	IF (ALLOCATED(grazingnstruct)) DEALLOCATE(grazingnstruct)
2914	IF (ALLOCATED(DNDFlam)) DEALLOCATE(DNDFlam)
2915	IF (ALLOCATED(DNDF)) DEALLOCATE(DNDF)
2916	IF (ALLOCATED(NDF)) DEALLOCATE(NDF)
2917	IF (ALLOCATED(DNDFI)) DEALLOCATE(DNDFI)
2918	IF (ALLOCATED(DNDFstem)) DEALLOCATE(DNDFstem)
2919	IF (ALLOCATED(DNDFear)) DEALLOCATE(DNDFear)
2920	IF (ALLOCATED(NDFmean)) DEALLOCATE(NDFmean)
2921	IF (ALLOCATED(NDFlam)) DEALLOCATE(NDFlam)
2922	IF (ALLOCATED(NDFstem)) DEALLOCATE(NDFstem)
2923	IF (ALLOCATED(NDFear)) DEALLOCATE(NDFear)
2924	IF (ALLOCATED(plam)) DEALLOCATE(plam)
2925	IF (ALLOCATED(pstem)) DEALLOCATE(pstem)
2926	IF (ALLOCATED(pear)) DEALLOCATE(pear)
2927	IF (ALLOCATED(MassePondTot)) DEALLOCATE(MassePondTot)
2928	IF (ALLOCATED(grazingstruct)) DEALLOCATE(grazingstruct)
2929	IF (ALLOCATED(grazinglam)) DEALLOCATE(grazinglam)
2930	IF (ALLOCATED(grazingstem)) DEALLOCATE(grazingstem)
2931	IF (ALLOCATED(grazingear)) DEALLOCATE(grazingear)
2932	! IF (ALLOCATED(nb_grazingdays)) DEALLOCATE(nb_grazingdays)
2933	IF (ALLOCATED(amount_yield)) DEALLOCATE(amount_yield)
2934	IF (ALLOCATED(consump)) DEALLOCATE(consump)
2935	IF (ALLOCATED(outside_food)) DEALLOCATE(outside_food)
2936	IF (ALLOCATED(add_nb_ani)) DEALLOCATE(add_nb_ani)
2937	IF (ALLOCATED(able_grazing)) DEALLOCATE(able_grazing)
2938	!JCADD
2939	IF (ALLOCATED(ct_dry)) DEALLOCATE(ct_dry)
2940
2941
2942	END SUBROUTINE animal_clear
2943	! END SUBROUTINE deallocation_animaux
2944
2945	SUBROUTINE cal_grazing(&
2946	npts , &
2947	nanimaltot , &
2948	intake_animal , &
2949	wsh , &
2950	wshtot , &
2951	c , &
2952	n , &
2953	fn , &
2954	Substrate_grazingwc , &
2955	Substrate_grazingwn , &
2956	grazingcstruct , &
2957	grazingnstruct , &
2958	intake)
2959
2960	! liste des variables d'entrée
2961	INTEGER (i_std) , INTENT(in) :: npts
2962	! nombre de points de simulations
2963	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
2964	! densité de paturage (gve/m**2)
2965	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake_animal
2966	! ingéré
2967	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wsh
2968	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wshtot
2969	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: c
2970	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: n
2971	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fn
2972	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: Substrate_grazingwc
2973	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: Substrate_grazingwn
2974	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: grazingcstruct
2975	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: grazingnstruct
2976	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake
2977
2978	WHERE (wshtot .GT. 0.0)
2979
2980	Substrate_grazingwc = intakec wsh/wshtot
2981	Substrate_grazingwn = intaken wsh/wshtot
2982	grazingstruct = intake * wsh/wshtot
2983
2984	grazingcstruct = fcsh * grazingstruct ! kg C/(m2d)
2985	grazingnstruct = fn * grazingstruct ! kg N/(m2d)
2986
2987	ELSEWHERE (wshtot .EQ. 0.0)
2988
2989	Substrate_grazingwc = 0.0
2990	Substrate_grazingwn = 0.0
2991
2992	grazingstruct = 0.0
2993	grazingcstruct = fcsh * grazingstruct ! kg C/(m2d)
2994	grazingnstruct = fn * grazingstruct ! kg N/(m2d)
2995
2996	END WHERE
2997
2998
2999	END SUBROUTINE cal_grazing
3000
3001	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3002	!!!!!!!! chg_plante was introduced from Grassland_Management, put after intake calculation
3003	!!!!!!!! to get the biomass change, and calculate DNDF NDF & DNDFI for dynamic
3004	!!!!!!!! DNDF NDF & DNDFI were cited from SUBROUTINE variablesPlantes of PASIM2011
3005	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3006	SUBROUTINE chg_plante(&
3007	npts, dt, biomass , &
3008	c, n,leaf_frac , &
3009	wsh, wshtot , &
3010	nanimaltot, intake_animal, &
3011	trampling,intake, &
3012	NDF,DNDF,DNDFI, &
3013	grazing_litter)
3014
3015	! idée : enlever un pourcentage de la masse sèche de la limbe, et de la tige (et de l'épis ??)
3016	! idea: remove a percentage of the dry mass of leaf and stem (and ears?)
3017
3018	! 1. variables d'entrées de la subroutine
3019	! input variables of the subroutine
3020
3021	INTEGER(i_std) , INTENT(in) :: npts
3022	REAL(r_std) , INTENT(in) :: dt
3023	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass
3024	! totalité de masse sèche du shoot (kg/m2) --> total dry mass of shoot
3025	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: c
3026	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: n
3027	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
3028	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wsh
3029	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: wshtot
3030	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
3031	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake_animal
3032	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: trampling
3033	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake
3034	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: DNDF
3035	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: NDF
3036	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: DNDFI
3037	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: grazing_litter
3038
3039	REAL(r_std), DIMENSION(npts,nvm) :: wlam
3040	! masse sèche (structurelle) de la limbe (kg/m2) ----> dry mass (structural) of the lamina
3041	REAL(r_std), DIMENSION(npts,nvm) :: wst
3042	! masse sèche (structurelle) de la tige (kg/m2) ----> dry mass (structural) of the stem
3043	REAL(r_std), DIMENSION(npts,nvm) :: wear
3044	! masse sèche (structurelle) de la tige (kg/m2) ----> dry mass (structural) of the ear
3045	REAL(r_std), DIMENSION(npts,nvm) :: lm_old_ani
3046
3047	REAL(r_std), DIMENSION(npts,nvm) :: tmp_fracsum
3048	REAL(r_std), DIMENSION(npts,nvm,nleafages) :: tmp_frac
3049	INTEGER(i_std) :: m
3050
3051	REAL(r_std), DIMENSION(npts,nvm) :: fGrazinglam
3052	REAL(r_std), DIMENSION(npts,nvm) :: PlantLaminazlamgrazing
3053	REAL(r_std), DIMENSION(npts,nvm) :: fGrazingstem
3054	REAL(r_std), DIMENSION(npts,nvm) :: PlantEarzeargrazing
3055	REAL(r_std), DIMENSION(npts,nvm) :: PlantStemzstemgrazing
3056
3057	DNDF (:,:) = 0.0
3058	NDF (:,:) = 0.0
3059	DNDFI (:,:) = 0.0
3060	! Initialisations
3061	fGrazinglam (:,:) = 0.0
3062	PlantLaminazlamgrazing (:,:) = 0.0
3063	fGrazingstem (:,:) = 0.0
3064	PlantEarzeargrazing (:,:) = 0.0
3065	PlantStemzstemgrazing (:,:) = 0.0
3066	lm_old_ani(:,:) = 0.0
3067
3068	IF (blabla_pasim) PRINT *, 'PASIM main grassland : call chg_plante'
3069
3070
3071	wlam(:,:) = (biomass(:,:,ileaf,icarbon)/(1000*CtoDM)) / &
3072	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) ) ! leaf dry mass
3073	wst(:,:) = (biomass(:,:,isapabove,icarbon)/(1000*CtoDM)) / &
3074	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) ) ! stem dry mass
3075	wear(:,:) = (biomass(:,:,ifruit,icarbon)/(1000*CtoDM)) / &
3076	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) ) ! ear dry mass
3077
3078	WHERE (wshtot .GT. 0.0)
3079	grazingstruct = intake * wsh/wshtot
3080	ELSEWHERE
3081
3082	grazingstruct = 0.0
3083
3084	END WHERE
3085	!!!!!!!!
3086	!JCADD 130418 component selection in animal intake
3087	!!!!!!!!
3088	WHERE ((wlam .GT. 0.0) .AND. (MassePondTot .GT. 0.0) &
3089	.AND. (grazingstruct .GT. 0.0))
3090	! # factor of lam structural dry mass preference
3091	fgrazinglam = plam*wlam/MassePondTot
3092
3093	! # structural dry matter flux from LAMS into the animal per unit ground aera
3094	grazinglam = fgrazinglam*grazingstruct
3095
3096	! # fraction of the intake in the available lam strutural dry mass
3097	PlantLaminazlamgrazing = grazinglam/(wlam)
3098
3099	DNDFlam = &
3100	DNDFlam1*leaf_frac(:,:,1) + &
3101	DNDFlam2*leaf_frac(:,:,2) + &
3102	DNDFlam3*leaf_frac(:,:,3) + &
3103	DNDFlam4*leaf_frac(:,:,4)
3104
3105	ELSEWHERE
3106
3107	fgrazinglam = 0.
3108
3109	grazinglam = 0.
3110
3111	plam = 0.0
3112
3113	PlantLaminazlamgrazing = 0.0
3114
3115	DNDFlam = 0.0
3116
3117	END WHERE
3118
3119	! updating leaf dry mass
3120	wlam = wlam * (1. - PlantLaminazlamgrazing)
3121	WHERE (wlam .LT. 0.0)
3122	wlam = 0.0
3123	ENDWHERE
3124
3125	IF (ANY(PlantLaminazlamgrazing .GT. 1.0)) THEN
3126	print *, 'warning: Component LAM not enough for grazing'
3127	print *, grazingstruct(:,5)
3128	print *, wlam(:,5)
3129	ENDIF
3130	IF (ANY(PlantLaminazlamgrazing .LT. 0.0)) print *, 'warning: Component LAM over grazing'
3131	!print *, 'PlantLam'
3132	WHERE ((wst .GT. 0.0) .AND. (MassePondTot .GT. 0.0) .AND. &
3133	(grazingstruct .GT. 0.0))
3134	! # factor of stem structural dry mass preference
3135	fgrazingstem = pstem*wst/MassePondTot
3136
3137	! # structural dry matter flux from STEMS into the animal per unit ground aera
3138	grazingstem = fgrazingstem*grazingstruct
3139
3140	! # fraction of the intake in the available stem strutural dry mass
3141	PlantStemzstemgrazing = grazingstem/wst
3142
3143	DNDFstem = &
3144	DNDFstem1*leaf_frac(:,:,1) + &
3145	DNDFstem2*leaf_frac(:,:,2) + &
3146	DNDFstem3*leaf_frac(:,:,3) + &
3147	DNDFstem4*leaf_frac(:,:,4)
3148
3149	ELSEWHERE
3150
3151	fgrazingstem = 0.
3152
3153	grazingstem = 0.
3154
3155	PlantStemzstemgrazing = 0.0
3156
3157	pstem = 0.0
3158
3159	DNDFstem = 0.0
3160
3161	END WHERE
3162	!JCADD 20141121 for avoid over grazing stem and leaf simutaneously
3163	WHERE ((fgrazingstem + fgrazinglam) .GT. 1.0 .AND. (grazingstruct .GT. 0.0) &
3164	.AND.( wst .GT. 0.0))
3165	fgrazingstem = 1.0 - fgrazinglam
3166	grazingstem = fgrazingstem*grazingstruct
3167	PlantStemzstemgrazing = grazingstem/wst
3168	DNDFstem = &
3169	DNDFstem1*leaf_frac(:,:,1) + &
3170	DNDFstem2*leaf_frac(:,:,2) + &
3171	DNDFstem3*leaf_frac(:,:,3) + &
3172	DNDFstem4*leaf_frac(:,:,4)
3173	ENDWHERE
3174	!ENDJCADD
3175	! updating stem dry mass
3176	wst = wst * (1. - PlantStemzstemgrazing)
3177	WHERE (wst .LT. 0.0)
3178	wst = 0.0
3179	ENDWHERE
3180
3181	IF (ANY(PlantStemzstemgrazing .GT. 1.0)) print *, 'warning: Component STEM not enough for grazing'
3182
3183	IF (ANY(PlantStemzstemgrazing .LT. 0.0)) print *, 'warning: Component STEM over grazing'
3184	!print *, 'PlantStem',PlantStemzstemgrazing(:,6)
3185	! # structural dry matter flux from EARS into the animal per unit ground aera
3186	grazingear = (1. - fgrazingstem - fgrazinglam)*grazingstruct
3187
3188	WHERE (wear .GT. 0.0)
3189
3190	PlantEarzeargrazing = grazingear/wear
3191
3192	DNDFear = &
3193	DNDFear1*leaf_frac(:,:,1) + &
3194	DNDFear2*leaf_frac(:,:,2) + &
3195	DNDFear3*leaf_frac(:,:,3) + &
3196	DNDFear4*leaf_frac(:,:,4)
3197
3198	ELSEWHERE
3199
3200	PlantEarzeargrazing = 0.0
3201
3202	grazingear = 0.0
3203
3204	pear = 0.0
3205
3206	DNDFear = 0.0
3207
3208	END WHERE
3209
3210	! updating ear dry mass
3211	wear = wear * (1. - PlantEarzeargrazing)
3212	WHERE (wear .LT. 0.0)
3213	wear = 0.0
3214	ENDWHERE
3215
3216	IF (ANY(PlantEarzeargrazing .GT. 1.0)) print *, 'warning: Component EAR not enough for grazing'
3217	IF (ANY(PlantEarzeargrazing .LT. 0.0)) print *, 'warning: Component STEM LAM over grazing'
3218	!print *, 'PlantEar',PlantEarzeargrazing(:,6)
3219	!!!!!!!!
3220	!JCADD 120409 new update leaf_frac for each class
3221	!!!! we assumed a grazing preference with 70% age class 1, 30% age clas 2 3 4
3222	WHERE (grazinglam .GT. 0.0 .AND. wlam .GT. 0)
3223	lm_old_ani=wlam+grazinglam
3224
3225	WHERE (leaf_frac(:,:,1)lm_old_ani .GT. 0.90 grazinglam)
3226	!!if there is enough biomass of leaf age 1 for eating (0.7 of total intake), animal prefer to eat more
3227	!young leaf
3228	leaf_frac(:,:,1) = (leaf_frac(:,:,1)lm_old_ani - 0.9 grazinglam)/wlam
3229
3230	ELSEWHERE
3231	!!if not enough biomass of leaf age 1 can be eat, only 10% of it left
3232	leaf_frac(:,:,1) = (leaf_frac(:,:,1)lm_old_ani 0.10)/wlam
3233	END WHERE
3234	ENDWHERE
3235	tmp_fracsum(:,:)=0.0
3236	tmp_frac(:,:,:)= 0.0
3237	DO m = 2, nleafages
3238	tmp_frac(:,:,m)= leaf_frac(:,:,m)
3239	tmp_fracsum(:,:)= tmp_fracsum(:,:)+ tmp_frac(:,:,m)
3240	ENDDO
3241	DO m = 2, nleafages
3242	WHERE (tmp_fracsum(:,:) .GT. 0.0)
3243	leaf_frac(:,:,m)=tmp_frac(:,:,m)/tmp_fracsum(:,:)*(1.0-leaf_frac(:,:,1))
3244	ENDWHERE
3245	ENDDO
3246	!print *,'after frac'
3247	!!! 05212013 JCADD NDF and DNDF DNDFI in grazed grassland put after grazing
3248	WHERE (grazingstruct .GT. 0.)
3249
3250	! # FRACTION OF DIGESTIBLE FIBRES IN THE TOTAL FIBRES
3251	! Vuichard Thesis p.86 equation (4)
3252	!---------------------
3253
3254	DNDF = (&
3255	DNDFlam * grazinglam + &
3256	DNDFstem * grazingstem + &
3257	DNDFear * grazingear) / grazingstruct
3258
3259	! # FRACTION OF FIBRES IN THE INTAKE
3260	! Vuichard Thesis p.86 equation (3)
3261	!---------------------
3262
3263	NDF = (&
3264	NDFlam * grazinglam + &
3265	NDFstem * grazingstem + &
3266	NDFear * grazingear) / grazingstruct
3267
3268	ELSEWHERE
3269	DNDF = 0.0
3270	NDF = 0.0
3271	END WHERE
3272	WHERE ((ABS(wlam+wst) .GT. 10e-15) .AND. (intake_animal .GT. 0.0))
3273
3274	DNDFI = NDF * DNDF * intake_animal * dm2om
3275	ELSEWHERE
3276	DNDFI = 0.0
3277	ENDWHERE
3278
3279
3280	!!!!!!!!!!!!!!!!!!!!!!!!!!! Trampingling and excretal returns effects
3281	!! according to Vuichard,2007 an additional 0.8% of the aboveground herbage
3282	!biomass is returned each day
3283	!! to litter for an instantaneous stocking rate of 1 LSU/ha
3284	! when grazing AGB trampling exist
3285	! when grazing litter, now assumed to be without trampling
3286	WHERE (nanimaltot(:,:) .GT. 0.0 .AND. grazing_litter(:,:) .NE. 1 )
3287	trampling(:,:) = nanimaltot(:,:) * 10000 * 0.008 * &
3288	(wlam(:,:)+wst(:,:)+wear(:,:))* 1000CtoDM &
3289	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
3290	wlam(:,:) = wlam(:,:) * (1 - nanimaltot(:,:) * 10000 * 0.008 )
3291	wst(:,:) = wst(:,:) * (1 - nanimaltot(:,:) * 10000 * 0.008 )
3292	wear(:,:) = wear(:,:) * (1 - nanimaltot(:,:) * 10000 * 0.008 )
3293	!!JCMODIF for gaps in NBP calculation
3294	! trampling(:,:) = nanimaltot * 10000 * 0.008 *(biomass(:,:,ileaf)+biomass(:,:,isapabove)+biomass(:,:,ifruit))
3295
3296	ELSEWHERE
3297	trampling(:,:) = 0.0
3298	ENDWHERE
3299
3300	biomass(:,:,ileaf,icarbon) = (wlam(:,:) * 1000CtoDM) &
3301	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
3302	biomass(:,:,isapabove,icarbon) = (wst(:,:) * 1000CtoDM) &
3303	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
3304	biomass(:,:,ifruit,icarbon) = (wear(:,:) * 1000CtoDM) &
3305	(1.0 + (mc /12.0)c(:,:) + (mn /14.0)n(:,:) )
3306
3307
3308
3309	END SUBROUTINE chg_plante
3310
3311
3312	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3313	!!!!!!!! variablesPlantes was introduced from Plantes.f90 of PaSim
3314	!!!!!!!! to get state variables need be intake selection before chg_plante
3315	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3316	SUBROUTINE variablesPlantes(&
3317	npts,biomass,&
3318	c,n,intake_animal,intakemax,&
3319	AnimalDiscremineQualite)
3320
3321	! 1. variables d'entrées de la subroutine
3322	! input variables of the subroutine
3323
3324	INTEGER(i_std) , INTENT(in) :: npts
3325	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in):: biomass
3326	! totalité de masse sèche du shoot (kg/m2) --> total dry mass of shoot
3327	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: c
3328	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: n
3329	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intake_animal
3330	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: intakemax
3331	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: AnimalDiscremineQualite
3332
3333	REAL(r_std), DIMENSION(npts,nvm) :: wlam
3334	! masse sèche(structurelle) de la limbe (kg/m2) ----> dry mass (structural) of the lamina
3335	REAL(r_std), DIMENSION(npts,nvm) :: wst
3336	! masse sèche(structurelle) de la tige (kg/m2) ----> dry mass (structural) of the stem
3337	REAL(r_std), DIMENSION(npts,nvm) :: wear
3338	! masse sèche(structurelle) de la tige (kg/m2) ----> dry mass (structural) of the ear
3339
3340	REAL(r_std), DIMENSION(npts,nvm) :: test_lam
3341	REAL(r_std), DIMENSION(npts,nvm) :: test_stem
3342	REAL(r_std), DIMENSION(npts,nvm) :: test_ear
3343	REAL(r_std), DIMENSION(npts,nvm) :: ncomp
3344	REAL(r_std), DIMENSION(npts,nvm) :: betaGrazing
3345
3346	REAL(r_std), DIMENSION(npts,nvm) :: DNDF_total
3347	REAL(r_std), DIMENSION(npts,nvm) :: NDF_total
3348
3349	REAL(r_std), DIMENSION(npts,nvm) :: exposant_lam
3350	REAL(r_std), DIMENSION(npts,nvm) :: exposant_stem
3351
3352	test_lam (:,:) = 0.0
3353	test_stem (:,:) = 0.0
3354	test_ear (:,:) = 0.0
3355	exposant_lam (:,:) = 0.0
3356	exposant_stem (:,:) = 0.0
3357
3358	IF (blabla_pasim) PRINT *, 'PASIM main grassland : call variablesPlantes'
3359
3360
3361	wlam(:,:) = (biomass(:,:,ileaf,icarbon)/(1000*CtoDM)) / &
3362	(1.0 + (mc /12.0) * c(:,:)+ (mn /14.0)*n(:,:) ) ! leaf dry mass
3363	wst(:,:) = (biomass(:,:,isapabove,icarbon)/(1000*CtoDM)) / &
3364	(1.0 + (mc /12.0) * c(:,:)+ (mn /14.0)*n(:,:) ) ! stem dry mass
3365	wear(:,:) = biomass(:,:,ifruit,icarbon)/(1000*CtoDM) / &
3366	(1.0 + (mc /12.0)* c(:,:) + (mn/14.0)*n(:,:) ) ! ear dry mass
3367
3368	!!!! update state variables from PaSim variablesPlantes
3369	! # TEST
3370	WHERE (wlam .GT. 0.)
3371	test_lam = 1.
3372	ELSEWHERE
3373	test_lam = 0.
3374	ENDWHERE
3375	WHERE (wst .GT. 0.)
3376	test_stem = 1.
3377	ELSEWHERE
3378	test_stem = 0.
3379	ENDWHERE
3380	WHERE (wear .GT. 0.)
3381	test_ear = 1.
3382	ELSEWHERE
3383	test_ear = 0.
3384	ENDWHERE
3385
3386	! # NUMBER OF SHOOT EXISTING COMPARTMENTS
3387	ncomp = test_lam + test_stem + test_ear
3388	! I check that ncomp > 0 to avoid divisions when ncomp is nul
3389	WHERE (ncomp .GT. 0.0)
3390	NDFmean = (&
3391	NDFlam * test_lam + &
3392	NDFstem * test_stem + &
3393	NDFear * test_ear) / ncomp
3394	ELSEWHERE
3395	NDFmean=0.0
3396	ENDWHERE
3397
3398	! # PARAMETER beta FOR THE CALCULATION OF ANIMAL'S PREFERENCE FOR ONE
3399	! COMPARTMENT
3400	! Vuichard Thesis p.66 equation (64)
3401	WHERE (ncomp .GT. 1.)
3402	! 070531 AIG end
3403
3404	betaGrazing = (2.* AnimalDiscremineQualite * ncomp)/&
3405	(100. * (ncomp - 1.) * (1. - 2.*LimDiscremine))
3406	ELSEWHERE
3407	betaGrazing = 0.0
3408	END WHERE
3409
3410	WHERE (ABS(wlam+wst) .GT. 10e-15)
3411
3412	DNDF_total = (&
3413	DNDFlam * wlam + &
3414	DNDFstem * wst + &
3415	DNDFear * wear) / (wlam+wst+wear)
3416
3417	NDF_total = (&
3418	NDFlam * wlam + &
3419	NDFstem * wst + &
3420	NDFear * wear) / (wlam+wst+wear)
3421
3422	ENDWHERE
3423
3424
3425	!---------------------
3426	! WEIGHTING FACTORS CORREPONDING TO THE ANIMAL'S INTAKE PREFERENCE
3427	!---------------------
3428	WHERE ((ABS(wlam+wst) .GT. 10e-15) .AND. (intake_animal .GT. 0.0))
3429	! # for the sheath&stem compartment
3430	exposant_stem = -2. * betagrazing * &
3431	MAX(0.,1.-(intakemax - intake_animal))(NDFmean - NDFstem )100.
3432
3433	pstem = 1./(ncomp)((1. - 2.LimDiscremine)*(1. - exp(exposant_stem))/ &
3434	(1. + EXP(exposant_stem))+1.)
3435
3436	! # for the lam compartment
3437	exposant_lam = -2.betagrazing &
3438	MAX(0.,1.-(intakemax - intake_animal))(NDFmean - NDFlam)100.
3439
3440	plam = 1./(ncomp)((1. - 2.LimDiscremine)*(1. - EXP(exposant_lam)) / &
3441	(1. + EXP(exposant_lam))+1.)
3442
3443	!JCADD 08Sep2015 to avoid pstem and plam over 1
3444	WHERE (pstem .GT. 1.0)
3445	pstem = 1.0
3446	ELSEWHERE (pstem .LT. 0.0)
3447	pstem = 0.0
3448	ENDWHERE
3449	WHERE (plam .GT. 1.0)
3450	plam = 1.0
3451	ELSEWHERE (plam .LT. 0.0)
3452	plam = 0.0
3453	ENDWHERE
3454	WHERE ((plam + pstem) .GT. 1.0)
3455	plam = 1.0
3456	pstem = 0.0
3457	ENDWHERE
3458	!ENDJCADD
3459	! # for the ear compartment
3460	pear = 1. - (plam + pstem)
3461
3462	MassePondTot = plam * wlam + pstem * wst + pear * wear
3463	ELSEWHERE
3464	pstem = 0.0
3465	plam = 0.0
3466	pear = 0.0
3467	MassePondTot = 0.0
3468
3469	ENDWHERE
3470
3471	END SUBROUTINE variablesPlantes
3472
3473
3474	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3475	!!!!!!!!FROM PASIM2011 Animaux.f90 JC 110524
3476	!!!!!!!!
3477	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3478	!***************************************************************************************************
3479	!***************************************************************************************************
3480	! MODULE ANIMALE ALLAITANT/LAITIER
3481	!***************************************************************************************************
3482	!***************************************************************************************************
3483
3484	SUBROUTINE Animaux_main_dynamic(&
3485	npts, dt, devstage , &
3486	intakemax, snowfall_daily, wshtot, wsh , &
3487	nel, nanimaltot , &
3488	intake , &
3489	import_yield , &
3490	new_year, new_day , &
3491	nanimal, tanimal, danimal , &
3492	PIYcow, PIMcow, BCSYcow , &
3493	BCSMcow, PICcow, AGE_cow_P, AGE_cow_M , &
3494	tcutmodel, tjulian , &
3495	intakesum , &
3496	intakensum, fn,ntot, c, n, leaf_frac, &
3497	intake_animal, intake_animalsum , &
3498	tadmin, type_animal , &
3499	tadmoy, IC_tot, Autogestion_out , &
3500	Forage_quantity,tmoy_14 , &
3501	intake_tolerance , &
3502	q_max_complement , &
3503	biomass, urinen, faecesn, urinec, faecesc, &
3504	file_param_init,trampling,sr_ugb,sr_wild , &
3505	compt_ugb,nb_ani,grazed_frac,AnimalDiscremineQualite, &
3506	grazing_litter, nb_grazingdays)
3507
3508	! Declarations:
3509
3510	INTEGER(i_std), INTENT(in) :: npts
3511	! Number of spatial points (-)
3512	REAL(r_std ), INTENT(in) :: dt
3513	! Time step (d)
3514	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: devstage
3515	! Developmental stage (-)
3516	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: intakemax
3517	! intake capacity of the cattle (kg/(animalm*2)
3518	REAL(r_std ), DIMENSION(npts), INTENT(in) :: snowfall_daily
3519	! Snow cover (mm)
3520	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wshtot
3521	! Total (structure + substrate) shoot dry matter(kg m-2)
3522	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wsh
3523	! (structure + substrate) shoot dry matter(kg m-2)
3524	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: nel
3525	! Net energy content of the forage (MJ kg-1)
3526	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: nanimaltot
3527	! Stocking rate (animal m-2)
3528	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: intake
3529	! intake (kg DM m2-)
3530	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: import_yield
3531	! ajout de Nicolas pour les runs saturant nonlimitant
3532	LOGICAL, INTENT(in) :: new_year
3533	LOGICAL, INTENT(in) :: new_day
3534	INTEGER(i_std), INTENT(in) :: tcutmodel
3535	INTEGER(i_std ), INTENT(in) :: tjulian
3536	! Julian day (-)
3537	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: nanimal
3538	! Stocking density h (1,..,nstocking) (animal m-2)
3539	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: tanimal
3540	! Beginning of the grazing period h (1,..,nstocking) (d)
3541	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: danimal
3542	! Lenght of the grazing period h (1,..,nstocking) (d)
3543	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: PIYcow
3544	! Initial weight of Young cow (Kg)
3545	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: PIMcow
3546	! Initial weight of Mature cow (Kg)
3547	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: BCSYcow
3548	! Initial body score condition of Young cow(Kg)
3549	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: BCSMcow
3550	! Initial body score condition of mature cow(Kg)
3551	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: PICcow
3552	! Initial weight of cow's calves (Kg)
3553	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: AGE_cow_P
3554	! Average age of dairy primiparous cows for autogestion
3555	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(inout) :: AGE_cow_M
3556	! Average age of dairy multiparous cows for autogestion
3557	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: intakesum
3558	! Yearly intake (kg animal-1 y-1)
3559	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: intakensum
3560	! N in daily intake per m2(kgN/m2)
3561	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: fn
3562	! nitrogen in structural dry matter
3563	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: ntot
3564	! nitrogen substrate concentration in plant,(kg n/kg)
3565	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: c
3566	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: n
3567	! nitrogen substrate concentration in plant,(kg n/kg)
3568	REAL(r_std ), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
3569	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: intake_animal
3570	! Daily intake per animal(kg animal-1 d-1)
3571	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: intake_animalsum
3572	! Yearly intake per animal(kg animal-1 d-1)
3573	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmin
3574	! Daily minimum temperature
3575	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmoy
3576	! Daily average temperature (K)
3577	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: IC_tot
3578	! Daily average ingested capacity of cows (kg)
3579	REAL(r_std ), DIMENSION(npts,nvm,n_out),INTENT(out) :: Autogestion_out
3580	! Fraction F (npts,1), ratio F (npts,2), and lenght of the grazing period when autgestion
3581
3582	! To write in import_yiels File(npts,3)
3583	INTEGER(i_std), INTENT(in) :: type_animal
3584	! 1: Dairy cows, 2: Suckler cows, 3: Old module, 4: Dairy heifers, 5 : Suckler heifers
3585	REAL(r_std ), DIMENSION(npts,nvm,nstocking),INTENT(inout) :: Forage_quantity
3586	! Net energy ingested for cow (young in first, and adult in second) (MJ)
3587	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tmoy_14
3588	! 14 day running average of daily air temperature (K)
3589	REAL(r_std ), INTENT(in) :: intake_tolerance
3590	! intake tolerance threshold (-)
3591	REAL(r_std ), INTENT(in) :: q_max_complement
3592	! Maximum quantity of forage or concentrate to supplement animals when auto-supplementation (kg)
3593	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout):: biomass
3594	! totalité de masse sèche du shoot(kg/m**
3595	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: urinen
3596	! n dans l'urine (kg n /(m**2 d))
3597	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: faecesn
3598	! n dans les fèces (kg n /(m*2d))
3599	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: urinec
3600	! c dans les urines
3601	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: faecesc
3602	! c dans les fèces (kg c /(m*2d))
3603	CHARACTER(len=500) , INTENT(in) :: file_param_init
3604	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: trampling
3605	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_ugb
3606	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_wild
3607	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: compt_ugb
3608	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_ani
3609	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: grazed_frac
3610	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: AnimalDiscremineQualite
3611	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(inout) :: grazing_litter
3612	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_grazingdays
3613
3614	! - nanimaltotmax : maximum stocking rate during optimisation (animal/ha)
3615
3616	!Variable Local : Variable n'ayant pas besoin d'etre sauvées entre les appels du module Main_animal_cow
3617	REAL(r_std ) , DIMENSION(npts,nvm) :: wshtotgrazing
3618	! Grazing shoot biomass (kg DM m-2)
3619	REAL(r_std ) , DIMENSION(npts,nvm) :: deltaanimal
3620	REAL(r_std ) , DIMENSION(npts,nvm) :: extra_feed
3621	! Forage necessary to feed animals at barn when stocking rate autogestion (kg DM m-2)
3622	REAL(r_std ) , DIMENSION(npts,nvm) :: nb_ani_old
3623	! Actual stocking rate per ha of total pasture "D" at previous iteration (animal (ha of total grassland)-1)
3624	INTEGER(i_std) , DIMENSION(npts,nvm) :: ugb_last
3625	! Equals 0 (no animals) or 1 (animals) for console display
3626
3627	REAL(r_std ), DIMENSION(npts,nvm) :: OMD
3628	! Digestible organic matter in the intake(kg/kg)
3629	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEIcow
3630	! Total net energy intake (1:young, 2:adult) (MJ)
3631	! to check
3632	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEIh
3633	! Net energy intake from the ingested herbage(1:young, 2:adult) (MJ)
3634	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEIf
3635	! Net energy intake from the ingested forage(1:young, 2:adult) (MJ)
3636	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEIc
3637	! Net energy intake from the ingested concentrate(1:young, 2:adult) (MJ)
3638
3639	!milk
3640	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPwcow2
3641	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
3642	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPcow2
3643	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
3644	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPcow
3645	! Daily milk production per m2 for primiparous or multiparous cows (kg/m-2/d)
3646	REAL(r_std ), DIMENSION(npts,nvm) :: milkKG
3647	! Daily actual milk production per animal for the whole cattle (kg/animal/d)
3648
3649	!intake capacity and DMI
3650	REAL(r_std ), DIMENSION(npts,nvm,2) :: ICcow
3651	! Cow intake capacity of primiparous or multiparous cows(kg/animal/d)
3652	REAL(r_std ), DIMENSION(npts,nvm,2) :: DMIcowanimal
3653	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
3654	REAL(r_std ), DIMENSION(npts,nvm,2) :: DMIcow
3655	! Daily intake per m2 for primiparous or multiparous cows(kg/m2/d)
3656	REAL(r_std ), DIMENSION(npts,nvm) :: ICcalf
3657	! Calf intake capacity (kg/animal/d)
3658	REAL(r_std ), DIMENSION(npts,nvm) :: DMIcalfanimal
3659	! Daily calf intake per animal(kg/animal/d)
3660	REAL(r_std ), DIMENSION(npts,nvm) :: DMIcalf
3661	! Daily calf intake per m2 (Kg/d)
3662
3663	!Energie Balance
3664	REAL(r_std ), DIMENSION(npts,nvm) :: NELherbage
3665	! Energetic content of the herbage (MJ/kg)
3666	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEPcow
3667	! Net energy for production (young :1 , adult:2) (MJ)
3668	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEPlactcow
3669	! Net energy for milk production (young :1 , adult:2) (MJ)
3670	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEPgestcow
3671	! Net energy for gestation (suckler cows)(young :1 , adult:2) (MJ)
3672	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEMcow
3673	! Net energy for maintenance (young :1 , adult:2) (MJ)
3674	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEBcow
3675	! Net energy Balance (young :1 , adult:2) (MJ)
3676	REAL(r_std ), DIMENSION(npts,nvm,2) :: NEGcow
3677	! Net energy for gestation (dairy cows)(young :1 , adult:2) (MJ)
3678	REAL(r_std ), DIMENSION(npts,nvm) :: NEIcalf
3679	! Net energy intake for calves (from milk and ingested herbage) (MJ)
3680	REAL(r_std ), DIMENSION(npts,nvm) :: NEIherbagecalf
3681	! Net energy intake for calves (from only ingested herbage) (MJ)
3682	REAL(r_std ), DIMENSION(npts,nvm) :: NEImilkcalf
3683	! Net energy intake for calves (from only ingested milk) (MJ)
3684	REAL(r_std ), DIMENSION(npts,nvm) :: NEGcalf
3685	! Net energy for calf growth (MJ)
3686	REAL(r_std ), DIMENSION(npts,nvm) :: NEMcalf
3687	! Net energy for calf maintenance (MJ)
3688	!BILAN N C
3689	REAL(r_std ), DIMENSION(npts,nvm) :: faecesNcow
3690	! Nitrogen in faeces (young in first, and adult in second)(Kg N m-2)
3691	REAL(r_std ), DIMENSIOn(npts,nvm) :: faecesCcow
3692	! Carbon in faeces (young in first, and adult in second)(Kg C m-2)
3693	REAL(r_std ), DIMENSIOn(npts,nvm) :: urineNcow
3694	! Nitrogen in urine (young in first, and adult in second)(Kg N m-2)
3695	REAL(r_std ), DIMENSIOn(npts,nvm) :: urineCcow
3696	! Carbon in Urine (young in first, and adult in second)(Kg C m-2)
3697	REAL(r_std ), DIMENSION(npts,nvm) :: nWeekLact
3698	! Lactation week (in weeks from calving)
3699	REAL(r_std ), DIMENSION(npts,nvm) :: nweekGest
3700	! Gestation week (in weeks from mating)
3701	REAL(r_std ), DIMENSION(npts,nvm,2) :: AGE_animal
3702	! Animal age in case of simulation of dairy cows (months)
3703	REAL(r_std ), DIMENSION(npts,nvm,2) :: CH4h
3704	! Daily enteric methane production from ingested herbage (kg C animal-1 d-1)
3705	REAL(r_std ), DIMENSION(npts,nvm,2) :: deltaBCS
3706	! Body condition score variation between two consecutive time steps (-)
3707	INTEGER(i_std), DIMENSION(npts,nvm) :: in_grazing
3708	INTEGER(i_std) :: i,j
3709	! For loop
3710	REAL(selected_real_kind(3,2)) :: tempTjulian
3711	! TO round Tjulian
3712
3713	REAL(r_std ),DIMENSION(npts,nvm) :: FVh
3714	! Herbage Fill Value (UE)
3715	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPpos
3716	! Possible milk production of dairy cows according to the diet (kg/animal/d)
3717
3718	REAL(r_std), DIMENSION(npts,nvm) :: WanimalMOYcow
3719	! The average weigth of live of the cattle (Kg / animal)
3720
3721	REAL(r_std), DIMENSION(npts,nvm,2) :: CH4animal
3722	! Daily enteric methane production from ingested herbage (kg C animal-1 d-1)
3723
3724	REAL(r_std), DIMENSION(npts) :: xtmp_npts
3725	INTEGER(i_std) :: h,k !!! for Verif_management
3726
3727	REAL(r_std) :: tcalving_t
3728	REAL(r_std) :: tsevrage_t
3729	REAL(r_std) :: Age_sortie_calf_t
3730	REAL(r_std) :: Pyoung_t
3731	REAL(r_std) :: Wcalfborn_t
3732	REAL(r_std) :: EVc_t
3733	REAL(r_std) :: EVf_t
3734	REAL(r_std) :: FVf_t
3735	REAL(r_std) :: fN_forage_t
3736	REAL(r_std) :: fN_concentrate_t
3737
3738	REAL(r_std), DIMENSION(2) :: QIc_t
3739	REAL(r_std), DIMENSION(4) :: autogestion_weightcow_t
3740	REAL(r_std), DIMENSION(4) :: autogestion_BCScow_t
3741	REAL(r_std), DIMENSION(4) :: autogestion_AGEcow_t
3742	REAL(r_std), DIMENSION(2) :: MPwmax_t
3743	INTEGER(i_std) :: ier
3744	REAL(r_std),DIMENSION(npts) :: toto
3745
3746	!TEMPORAIRE
3747	MPpos=0.0
3748	MPwcow2=0.0
3749	MPcow2=0.0
3750	MPcow=0.0
3751	milkKG=0.0
3752	ICcow=0.0
3753	ICcalf=0.0
3754	DMIcowanimal=0.0
3755	DMIcalfanimal=0.0
3756	DMIcow=0.0
3757	DMIcalf=0.0
3758	NELherbage=0.0
3759	NEIcow=0.0
3760	! to check
3761	NEIh=0.0
3762	NEIf=0.0
3763	NEIc=0.0
3764	NEPcow=0.0
3765	NEPlactcow=0.0
3766	NEPgestcow=0.0
3767	NEMcow=0.0
3768	NEBcow=0.0
3769	NEIcalf=0.0
3770	NEIherbagecalf=0.0
3771	NEImilkcalf=0.0
3772	NEGcalf=0.0
3773	NEMcalf=0.0
3774	faecesNcow=0.0
3775	faecesCcow=0.0
3776	urineNcow=0.0
3777	urineCcow=0.0
3778	OMD=0.0
3779	AGE_animal=0
3780	FVh=0.0
3781
3782	! initialisation
3783
3784	init_animal : IF (l_first_animaux) THEN
3785
3786	IF (blabla_pasim) PRINT *, 'PASIM Animals : initialisation'
3787
3788	CALL Animal_Init(npts, nanimal , type_animal , intake_tolerance)
3789
3790	CALL variablesPlantes(&
3791	npts,biomass,&
3792	c,n,intake_animal,intakemax,&
3793	AnimalDiscremineQualite)
3794
3795	!----------------------------------
3796	! 0 - Input data Reading
3797	!----------------------------------
3798	!!!!JC comm we do not need to read these variables now, but needed for new animals
3799	! CALL read_init_animals(&
3800	! npts, nbfichier_par, nsoil, &
3801	! parfile_input, error_point, &
3802	! lim_inf, lim_sup, Type_animal)
3803	!!!!!!!!!!!read variables for new animal module
3804	!file_param_init='/home/orchidee_ns/lhli/Modele_ORCHIDEE/Management/param_init.txt'
3805
3806	!CALL getin('FILE_PARAM_INIT',file_param_init)
3807
3808	! lecture données dans le fichier ==> read data from the file
3809	! pour l'instant uniquement lecture d'un seul point d'espace de management, mais possibilité plusieurs années
3810
3811	OPEN(unit=61, file = file_param_init)
3812
3813	READ(61, *, iostat = ier) toto(:)
3814	READ(61, *, iostat = ier) toto(:)
3815	READ(61, *, iostat = ier) toto(:)
3816	READ(61, *, iostat = ier) toto(:)
3817	READ(61, *, iostat = ier) toto(:)
3818
3819	READ(61, *, iostat = ier) toto(:)
3820	READ(61, *, iostat = ier) toto(:)
3821	READ(61, *, iostat = ier) toto(:)
3822	READ(61, *, iostat = ier) toto(:)
3823	READ(61, *, iostat = ier) toto(:)
3824
3825	READ(61, *, iostat = ier) toto(:)
3826	READ(61, *, iostat = ier) toto(:)
3827	READ(61, *, iostat = ier) toto(:)
3828	READ(61, *, iostat = ier) toto(:)
3829	READ(61, *, iostat = ier) toto(:)
3830
3831	READ(61, *, iostat = ier) toto(:)
3832	READ(61, *, iostat = ier) toto(:)
3833	READ(61, *, iostat = ier) toto(:)
3834	READ(61, *, iostat = ier) toto(:)
3835	READ(61, *, iostat = ier) toto(:)
3836
3837	READ(61, *, iostat = ier) toto(:)
3838	READ(61, *, iostat = ier) toto(:)
3839	READ(61, *, iostat = ier) toto(:)
3840	READ(61, *, iostat = ier) toto(:)
3841	READ(61, *, iostat = ier) toto(:)
3842
3843	READ(61, *, iostat = ier) toto(:)
3844	READ(61, *, iostat = ier) toto(:)
3845	READ(61, *, iostat = ier) toto(:)
3846	READ(61, *, iostat = ier) toto(:)
3847	READ(61, *, iostat = ier) toto(:)
3848
3849	READ(61, *, iostat = ier) toto(:)
3850	READ(61, *, iostat = ier) toto(:)
3851	READ(61, *, iostat = ier) tcalving_t
3852	READ(61, *, iostat = ier) tsevrage_t
3853	READ(61, *, iostat = ier) Age_sortie_calf_t
3854
3855	READ(61, *, iostat = ier) Pyoung_t
3856	READ(61, *, iostat = ier) Wcalfborn_t
3857	IF ((type_animal.EQ.1).OR.(type_animal.EQ.2)) THEN
3858	READ(61, *, iostat = ier) (MPwmax_t(h),h=1,2)
3859	ELSE
3860	READ(61, *, iostat = ier) MPwmax_t(1)
3861	ENDIF
3862	READ(61, *, iostat = ier) QIc_t(1)
3863	READ(61, *, iostat = ier) EVc_t
3864
3865	READ(61, *, iostat = ier) EVf_t
3866	READ(61, *, iostat = ier) FVf_t
3867	READ(61, *, iostat = ier) fN_forage_t
3868	READ(61, *, iostat = ier) fN_concentrate_t
3869	!Comme le concetrate est spécifié par l'utilisateur, primipare et multipare ou le même apport
3870
3871	QIc_t(2)=QIc_t(1)
3872	! 21/01/09 AIG
3873
3874	! On recalcule la concentration en N du fourrage et du concentré à partir de la MAT
3875
3876	! = matière azotée totale renseignée en entrée par l'utilisateur.
3877
3878	fN_forage_t= fN_forage_t/(6.25*1000)
3879
3880	fN_concentrate_t= fN_concentrate_t/(6.25*1000)
3881
3882	IF(f_complementation.EQ.0) THEN
3883
3884	QIc_t(1)=0.0
3885
3886	QIc_t(2)=0.0
3887
3888	ENDIF
3889
3890	IF (f_autogestion.EQ.2) THEN
3891	! Initial cow liveweight when stocking rate automanagement (kg /animal)
3892	READ(61, *, iostat = ier) (autogestion_weightcow_t(h),h=1,2)
3893	! Initial BCS when stocking rate automanagement (-)
3894	READ(61, *, iostat = ier) (autogestion_BCScow_t(h),h=1,2)
3895	! Initial age when stocking rate automanagement (months)
3896	READ(61, *, iostat = ier) (autogestion_AGEcow_t(h),h=1,2)
3897	autogestion_weightcow_t(3)=autogestion_weightcow_t(1)
3898
3899	autogestion_weightcow_t(4)=autogestion_weightcow_t(2)
3900
3901	autogestion_BCScow_t(3)=autogestion_BCScow_t(1)
3902
3903	autogestion_BCScow_t(4)=autogestion_BCScow_t(2)
3904
3905	autogestion_AGEcow_t(3)=autogestion_AGEcow_t(1)
3906
3907	autogestion_AGEcow_t(4)=autogestion_AGEcow_t(2)
3908
3909	ENDIF
3910
3911	DO i=1,npts
3912	tcalving(i,:)=tcalving_t
3913	tsevrage(i,:)=tsevrage_t
3914	Age_sortie_calf(i,:)=Age_sortie_calf_t
3915	Pyoung(i,:)=Pyoung_t
3916	Wcalfborn(i,:)=Wcalfborn_t
3917	EVc(i,:)=EVc_t
3918	EVf(i,:)=EVf_t
3919	FVf(i,:)=FVf_t
3920	fN_forage(i,:)=fN_forage_t
3921	fN_concentrate(i,:)=fN_concentrate_t
3922	DO h=1,2
3923	MPwmax(i,:,h)=MPwmax_t(h)
3924	QIc(i,:,h)=QIc_t(h)
3925	END DO
3926	DO h=1,4
3927	autogestion_weightcow(i,:,h)=autogestion_weightcow_t(h)
3928	autogestion_BCScow(i,:,h)=autogestion_BCScow_t(h)
3929	autogestion_AGEcow(i,:,h)=autogestion_AGEcow_t(h)
3930	END DO
3931	END DO
3932	CLOSE (61)
3933
3934	!!!!!!JC comm test management file, if the grazing period was overlap, can be used
3935	h=0
3936	IF ((tcutmodel .EQ. 0) .AND. (f_autogestion .NE. 2)) THEN
3937	h=Verif_management(npts,nstocking, tanimal,danimal)
3938	ENDIF
3939
3940	IF(h.EQ.1) THEN
3941	STOP "ERROR : Overlap of grazing periode in management file"
3942	ENDIF
3943
3944	END IF init_animal
3945
3946
3947	!______________________________________________
3948	!----------------------------------
3949	! - CALL OF FUNCTIONS -
3950	!----------------------------------
3951	!______________________________________________
3952	! once per year
3953	n_year : IF (new_year .EQV. .TRUE. ) THEN
3954
3955	nanimaltot = 0.0
3956	nanimaltot_prec= 0.0
3957	faecesnsum = 0.0
3958	milksum = 0.0
3959	nelgrazingsum = 0.0
3960	milkcsum = 0.0
3961	ranimalsum = 0.0
3962	MethaneSum = 0.0
3963	faecescsum = 0.0
3964	urinecsum = 0.0
3965	urinensum = 0.0
3966	milknsum = 0.0
3967	stockingstart = 0
3968	stockingend = 0
3969	grazingnsum = 0.0
3970	grazingcsum = 0.0
3971	intakesum = 0.0
3972	intake_animalsum = 0.0
3973	intakensum = 0.0
3974	milkanimalsum = 0.0
3975	methane_aniSum= 0.0
3976	MPcow2_prec=0
3977	DMIc=0.0
3978	DMIf=0.0
3979
3980	!réinitialisation des variable global cow
3981	MPcowsum=0.0
3982	MPcow2sum=0.0
3983	MPcowN=0.0
3984	MPcowC=0.0
3985	MPcowCsum = 0.0
3986	MPcowNsum = 0.0
3987	DMIcowsum = 0.0
3988
3989	DMIcowNsum = 0.0
3990	DMIcowCsum = 0.0
3991	DMIcowanimalsum = 0.0
3992	DMIcalfanimalsum = 0.0
3993	DMIcalfsum=0.0
3994	calfinit=0
3995
3996	autogestion_init=0.0
3997	Fday_pasture=0
3998	compte_pature=0
3999	!pour remettre aux valeurs de cond_init
4000	autogestion_BCScow(:,:,1)=autogestion_BCScow(:,:,3)
4001	autogestion_BCScow(:,:,2)=autogestion_BCScow(:,:,4)
4002	autogestion_weightcow(:,:,1)=autogestion_weightcow(:,:,3)
4003	autogestion_weightcow(:,:,2)=autogestion_weightcow(:,:,4)
4004	autogestion_AGEcow(:,:,1)=autogestion_AGEcow(:,:,3)
4005	autogestion_AGEcow(:,:,2)=autogestion_AGEcow(:,:,4)
4006	!Autogestion_out(:,3)=0.0
4007
4008	Autogestion_out(:,:,1)=0.0
4009	Autogestion_out(:,:,2)=0.0
4010
4011
4012	!tout les ans on réinitialise les variables permettant d'ecrire le fichier management
4013	IF (f_autogestion.EQ.2) THEN
4014	tanimal=0.0
4015	danimal=0.0
4016	nanimal=0.0
4017	BCSYcow=0.0
4018	BCSMcow=0.0
4019	PICcow=0.0
4020	PIYcow=0.0
4021	PIMcow=0.0
4022	AGE_cow_P=0.0
4023	AGE_cow_M=0.0
4024	Forage_quantity=0.0
4025	ENDIF
4026	ugb = 0
4027
4028	delai_ugb = -1
4029
4030	!************************************************
4031	! modifications added by Nicolas Vuichard
4032
4033	!modif ugb0azot
4034
4035	!070703 AIG à confirmer
4036	!******* Stocking rate calculation if grazing autogestion ********
4037	! the model will pass the loop if flag "non limitant"
4038	! The module calculates the optimal yield "Y" of a cut grassland plot,
4039	! when optimizing cut events and N fertilisation.
4040	! Then the model simulates the same grasslang plot with animals. Stocking rate "S"
4041	! is incremented at each optimization step. For each stocking rate, the program
4042	! determines the number of days for which animals are in the barn (365 - compt_ugb(:))
4043	! and thus, the forage necessary to feed them at the barn "X".
4044	! The fraction F of grazed pastures is calculated as: Y (1-F) - X = 0
4045	! F = Y /(Y+X)
4046	! F = 1 / (1 + X/Y)
4047	! Then the program calculates the actual stocking rate per ha of total pasture "D",
4048	! D = SF
4049	! code equivalences
4050	! Y = import_yield
4051	! X = extra_feed
4052	! S = sr_ugb
4053	! F = 1 / (1 + extra_feed(:) / (import_yield * 0.85))
4054	! D = nb_ani
4055	! 0.85 = 1 - 0.15: pertes à la récolte
4056
4057	!Local_autogestion_out(:,1): ratio X/Y: fourrages non consommés/fourrages disponibles
4058	!Local_autogestion_out(:,2): fraction of grazed pastures
4059
4060	IF(f_nonlimitant .EQ. 0) THEN
4061	!modif nico ugb
4062	IF (f_autogestion .EQ. 2) THEN
4063	DO j=2,nvm
4064	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)) .AND. &
4065	(.NOT.is_grassland_grazed(j)))THEN
4066
4067	print*, "Number of grazed days (d):", compt_ugb(:,j)
4068	print*, "Stocking rate S for the grazed pasture(animal.m-2):", sr_ugb(:,j)
4069	!print*, "fraction F of grazed pastures (-): ", Local_autogestion_out(:,1)
4070	print*, "Forage requirements/Forage available (-): ", Local_autogestion_out(:,j,1)
4071	!print, "Global stocking rate D (animal.m-2:)", sr_ugb(:,j) Local_autogestion_out(:,1)
4072	print, "Global stocking rate D (animal.m-2:)", sr_ugb(:,j) Local_autogestion_out(:,j,2)
4073	!print*, "Ratio of grazed vs cut grasslands: ", Local_autogestion_out(:,2)
4074	print*, "Fraction F of grazed pastures (-): ", Local_autogestion_out(:,j,2)
4075	print*,"--------------"
4076
4077	WHERE ((ok_ugb(:,j) .EQ. 0))
4078
4079	extra_feed(:,j) = (365 - compt_ugb(:,j)) * 18 * sr_ugb(:,j)
4080	nb_ani_old(:,j) = nb_ani(:,j)
4081	nb_ani(:,j) = 1 / (1 + extra_feed(:,j) / (import_yield(:,j) * 0.85)) * sr_ugb(:,j)
4082
4083	!Local_autogestion_out(:,1)=1 / (1 + extra_feed(:) / (import_yield * 0.85))
4084	!Local_autogestion_out(:,2)=1/(1+Local_autogestion_out(:,1))
4085	Local_autogestion_out(:,j,1)= extra_feed(:,j) / (import_yield(:,j) * 0.85)
4086	Local_autogestion_out(:,j,2)=1 / (1 + Local_autogestion_out(:,j,1))
4087	Autogestion_out(:,j, 3)= compt_ugb(:,j)
4088
4089	grazed_frac(:,j) = 1 / (1 + extra_feed(:,j) / (import_yield(:,j) * 0.85))
4090
4091
4092	WHERE ((ABS(nb_ani(:,j)-nb_ani_old(:,j))/nb_ani(:,j)) .LT. 0.01)
4093
4094	ok_ugb(:,j) = 1
4095	sr_ugb(:,j) = sr_ugb(:,j) -0.00001
4096	ELSEWHERE
4097	!recherche du 0 par la méthode de newton
4098	Local_autogestion_out(:,j,1)= extra_feed(:,j) / (import_yield(:,j) * 0.85)
4099	Local_autogestion_out(:,j,2)=1 / (1 + Local_autogestion_out(:,j,1))
4100	Autogestion_out(:,j, 3)= compt_ugb(:,j)
4101
4102	WHERE ((ABS(nb_ani(:,j)-nb_ani_old(:,j))/nb_ani(:,j)) .LT. 0.01)
4103
4104	ok_ugb(:,j) = 1
4105	sr_ugb(:,j) = sr_ugb(:,j) - 0.00001
4106
4107	ELSEWHERE
4108	sr_ugb(:,j) = sr_ugb(:,j) + 0.00001
4109
4110	END WHERE
4111
4112	END WHERE
4113	ENDWHERE
4114	print*,"---critere nb_ani :", (ABS(nb_ani(:,j)-nb_ani_old(:,j))/nb_ani(:,j))
4115
4116	nb_grazingdays(:,j) = compt_ugb(:,j)
4117	compt_ugb(:,j) = 0
4118	print*, "sr_ugb_apres:", sr_ugb(:,j)
4119	print*, "ok_ugb :", ok_ugb(:,j)
4120	print*,"--------------"
4121	END IF
4122	END DO
4123
4124	ENDIF
4125	ENDIF
4126	!fin modif ugb0azot
4127
4128	IF(f_nonlimitant .EQ. 0) THEN
4129	!modif nico ugb
4130	IF (f_postauto .EQ. 1) THEN
4131
4132	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0))
4133	! total yield of last year (kg DM/m^2 total grassland)
4134	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * &
4135	(1-grazed_frac(:,mgraze_C3)) * 0.85
4136	! total animal indoor consumption of last year (kg DM/m^2 total grassland)
4137	consump(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * &
4138	18.0 * nb_ani(:,mgraze_C3)
4139	! food surplus (outside_food > 0) or deficit (outside_food < 0)
4140	outside_food(:,mgraze_C3) = amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
4141	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0) animals
4142	add_nb_ani(:,mgraze_C3) = outside_food(:,mgraze_C3)/ (18.0 * 365)*0.2
4143	! New animal density for total grassland
4144	nb_ani(:,mgraze_C3)=nb_ani(:,mgraze_C3)+add_nb_ani(:,mgraze_C3)
4145	! New fraction of grazed grassland in total grassland (keep the same stocking rate)
4146	grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
4147	! Threshold of fraction as least 30 % was cut
4148	WHERE (grazed_frac(:,mgraze_C3) .GT. 0.7)
4149	sr_ugb(:,mgraze_C3)=sr_ugb(:,mgraze_C3)+0.00002
4150	grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
4151	END WHERE
4152	Local_autogestion_out(:,mgraze_C3,1)= extra_feed(:,mgraze_C3)/ &
4153	(import_yield(:,mgraze_C3) * 0.85)
4154	Local_autogestion_out(:,mgraze_C3,2)=1 / (1+Local_autogestion_out(:,mgraze_C3,1))
4155	Autogestion_out(:,mgraze_C3, 3)= compt_ugb(:,mgraze_C3)
4156	END WHERE
4157
4158	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
4159	compt_ugb(:,mgraze_C3) = 0
4160
4161	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0))
4162	! total yield of last year (kg DM/m^2 total grassland)
4163	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) * &
4164	(1-grazed_frac(:,mgraze_C4)) * 0.85
4165	! total animal indoor consumption of last year (kg DM/m^2
4166	! total grassland)
4167	consump(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
4168	! food surplus (outside_food > 0) or deficit (outside_food <
4169	! 0)
4170	outside_food(:,mgraze_C4) =amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
4171	! farmers' decision of buy (add_nb_ani > 0) or sell
4172	! (add_nb_ani < 0) animals
4173	add_nb_ani(:,mgraze_C4) = outside_food(:,mgraze_C4)/ (18.0 365)0.2
4174	! New animal density for total grassland
4175	nb_ani(:,mgraze_C4)=nb_ani(:,mgraze_C4)+add_nb_ani(:,mgraze_C4)
4176	! New fraction of grazed grassland in total grassland (keep
4177	! the same stocking rate)
4178	grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
4179	! Threshold of fraction as least 30 % was cut
4180	WHERE (grazed_frac(:,mgraze_C4) .GT. 0.7)
4181	sr_ugb(:,mgraze_C4)=sr_ugb(:,mgraze_C4)+0.00002
4182	grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
4183	END WHERE
4184	Local_autogestion_out(:,mgraze_C4,1)=extra_feed(:,mgraze_C4)/&
4185	(import_yield(:,mgraze_C4) * 0.85)
4186	Local_autogestion_out(:,mgraze_C4,2)=1 /(1+Local_autogestion_out(:,mgraze_C4,1))
4187	Autogestion_out(:,mgraze_C4, 3)= compt_ugb(:,mgraze_C4)
4188	END WHERE
4189
4190	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
4191	compt_ugb(:,mgraze_C4) = 0
4192
4193
4194	ENDIF
4195
4196	!JCADD postauto=5
4197	!! F_POSTAUTO=5 for global simulation with
4198	!! prescibed livestock density read from
4199	!! extra file
4200	IF (f_postauto .EQ. 5) THEN
4201	WHERE ((ok_ugb(:,mgraze_C3) .EQ. 0) .AND. &
4202	(sr_ugb(:,mgraze_C3) .GT. 0.0))
4203	extra_feed(:,mgraze_C3) = (365 - compt_ugb(:,mgraze_C3)) * &
4204	18.0*sr_ugb(:,mgraze_C3)
4205	! total yield of las year (kg DM/m^2 total grassland)
4206	amount_yield(:,mgraze_C3) = import_yield(:,mgraze_C3) * &
4207	(1-grazed_frac(:,mgraze_C3)) * 0.85
4208	! total animal indoor consumption of last year (kg DM/m^2 total grassland)
4209	consump(:,mgraze_C3) = 0.0
4210	!(365 - compt_ugb(:,mgraze_C3)) * 18.0 * nb_ani(:,mgraze_C3)
4211	! food surplus (outside_food > 0) or deficit (outside_food < 0)
4212	outside_food(:,mgraze_C3) = 0.0
4213	!amount_yield(:,mgraze_C3)-consump(:,mgraze_C3)
4214	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0) animals
4215	add_nb_ani(:,mgraze_C3) = 0.0
4216	!outside_food(:,mgraze_C3)/ (18.0 * 365) * 0.2
4217	!! New animal density for total grassland
4218	nb_ani(:,mgraze_C3)=nb_ani(:,mgraze_C3)+add_nb_ani(:,mgraze_C3)
4219	!! New fraction of grazed grassland in total grassland (keep the same stocking rate)
4220	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0)
4221	grazed_frac(:,mgraze_C3)=0.5
4222	!nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
4223	ENDWHERE
4224	WHERE (sr_ugb(:,mgraze_C3) .LE. 0.0)
4225	grazed_frac(:,mgraze_C3)=0.0
4226	sr_ugb(:,mgraze_C3)=0.0
4227	nb_ani(:,mgraze_C3)=0.0
4228	ENDWHERE
4229	! !! Threshold of fraction as least 30 % was cut
4230	! WHERE ((grazed_frac(:,mgraze_C3) .GT. 0.7) .AND. (sr_ugb(:,mgraze_C3) .GT. 0.0))
4231	! sr_ugb(:,mgraze_C3)=sr_ugb(:,mgraze_C3)+0.00001
4232	! grazed_frac(:,mgraze_C3)=nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3)
4233	! END WHERE
4234	! WHERE (grazed_frac(:,mgraze_C3) .GT. 1.0)
4235	! grazed_frac(:,mgraze_C3)=1.0
4236	! ENDWHERE
4237	Local_autogestion_out(:,mgraze_C3,1)= extra_feed(:,mgraze_C3)/(import_yield(:,mgraze_C3) * 0.85)
4238	Local_autogestion_out(:,mgraze_C3,2)=1 / (1+Local_autogestion_out(:,mgraze_C3,1))
4239	Autogestion_out(:,mgraze_C3, 3)= compt_ugb(:,mgraze_C3)
4240	ELSEWHERE
4241	sr_ugb(:,mgraze_C3) = 0.0
4242	nb_ani(:,mgraze_C3) = 0.0
4243	grazed_frac(:,mgraze_C3)=0.0
4244	amount_yield(:,mgraze_C3) =0.0
4245	outside_food(:,mgraze_C3) = 0.0
4246	consump(:,mgraze_C3) =0.0
4247	add_nb_ani(:,mgraze_C3) = 0.0
4248	extra_feed(:,mgraze_C3) = 0.0
4249	Local_autogestion_out(:,mgraze_C3,1)= extra_feed(:,mgraze_C3)/&
4250	(import_yield(:,mgraze_C3) * 0.85)
4251	Local_autogestion_out(:,mgraze_C3,2)=1 / (1+Local_autogestion_out(:,mgraze_C3,1))
4252	Autogestion_out(:,mgraze_C3, 3)= compt_ugb(:,mgraze_C3)
4253	END WHERE
4254
4255	WHERE ((ok_ugb(:,mgraze_C4) .EQ. 0) .AND. (sr_ugb(:,mgraze_C4).GT. 0.0))
4256
4257	extra_feed(:,mgraze_C4) = (365 - compt_ugb(:,mgraze_C4)) * &
4258	18.0*sr_ugb(:,mgraze_C4)
4259	! total yield of las year (kg DM/m^2 total grassland)
4260	amount_yield(:,mgraze_C4) = import_yield(:,mgraze_C4) * &
4261	(1-grazed_frac(:,mgraze_C4)) * 0.85
4262	! total animal indoor consumption of last year (kg DM/m^2 total grassland)
4263	consump(:,mgraze_C4) = 0.0 !(365 - compt_ugb(:,mgraze_C4)) * 18.0 *nb_ani(:,mgraze_C4)
4264	! food surplus (outside_food > 0) or deficit (outside_food < 0)
4265	outside_food(:,mgraze_C4) = 0.0 !amount_yield(:,mgraze_C4)-consump(:,mgraze_C4)
4266	! farmers' decision of buy (add_nb_ani > 0) or sell (add_nb_ani < 0) animals
4267	add_nb_ani(:,mgraze_C4) = 0.0 !outside_food(:,mgraze_C4)/ (18.0 365) 0.2
4268	!! New animal density for total grassland
4269	nb_ani(:,mgraze_C4)=nb_ani(:,mgraze_C4)+add_nb_ani(:,mgraze_C4)
4270	!! New fraction of grazed grassland in total grassland (keep
4271	!the same stocking rate)
4272	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0)
4273	grazed_frac(:,mgraze_C4)=0.5 !nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
4274	ENDWHERE
4275	WHERE (sr_ugb(:,mgraze_C4) .LE. 0.0)
4276	grazed_frac(:,mgraze_C4)=0.0
4277	sr_ugb(:,mgraze_C4)=0.0
4278	nb_ani(:,mgraze_C4)=0.0
4279	ENDWHERE
4280
4281	! !! Threshold of fraction as least 30 % was cut
4282	! WHERE ((grazed_frac(:,mgraze_C4) .GT. 0.9) .AND.(sr_ugb(:,mgraze_C4) .GT. 0.0))
4283	! sr_ugb(:,mgraze_C4)=sr_ugb(:,mgraze_C4)+0.00002
4284	! grazed_frac(:,mgraze_C4)=nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4)
4285	! END WHERE
4286	! WHERE (grazed_frac(:,mgraze_C4) .GT. 1.0)
4287	! grazed_frac(:,mgraze_C4)=1.0
4288	! ENDWHERE
4289	Local_autogestion_out(:,mgraze_C4,1)=extra_feed(:,mgraze_C4)/&
4290	(import_yield(:,mgraze_C4) * 0.85)
4291	Local_autogestion_out(:,mgraze_C4,2)=1 /(1+Local_autogestion_out(:,mgraze_C4,1))
4292	Autogestion_out(:,mgraze_C4, 3)= compt_ugb(:,mgraze_C4)
4293	ELSEWHERE
4294	sr_ugb(:,mgraze_C4) = 0.0
4295	nb_ani(:,mgraze_C4) = 0.0
4296	grazed_frac(:,mgraze_C4)=0.0
4297	amount_yield(:,mgraze_C4) =0.0
4298	outside_food(:,mgraze_C4) = 0.0
4299	consump(:,mgraze_C4) =0.0
4300	add_nb_ani(:,mgraze_C4) = 0.0
4301	extra_feed(:,mgraze_C4) = 0.0
4302	Local_autogestion_out(:,mgraze_C4,1)=extra_feed(:,mgraze_C4)/&
4303	(import_yield(:,mgraze_C4) * 0.85)
4304	Local_autogestion_out(:,mgraze_C4,2)=1 /(1+Local_autogestion_out(:,mgraze_C4,1))
4305	Autogestion_out(:,mgraze_C4, 3)= compt_ugb(:,mgraze_C4)
4306	END WHERE
4307
4308
4309	nb_grazingdays(:,mgraze_C3) = compt_ugb(:,mgraze_C3)
4310	compt_ugb(:,mgraze_C3) = 0
4311
4312	nb_grazingdays(:,mgraze_C4) = compt_ugb(:,mgraze_C4)
4313	compt_ugb(:,mgraze_C4) = 0
4314
4315	ENDIF
4316	!ENDJCADD
4317
4318	ENDIF
4319
4320	END IF n_year
4321
4322	ugb_last(:,:)=ugb(:,:)
4323	! once per day
4324	n_day : IF (new_day .EQV. .TRUE. ) THEN
4325
4326	wshtotgrazing = wshtotstart
4327
4328
4329	!MAJ age animal
4330	!!JCCOMM 120412 in this case if there is not enough biomass for animal, they
4331	!will be removed until next tanimal
4332	in_grazing=0
4333	CALL in_management(npts,nstocking,tanimal,danimal,tjulian,in_grazing)
4334	nanimaltot=nanimaltot*in_grazing
4335	DO j=2,nvm
4336	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)).AND.&
4337	(.NOT.is_grassland_grazed(j)))THEN
4338
4339	DO k=1,nstocking
4340	DO i=1,npts
4341	IF (tanimal(i,j,k).EQ. tjulian .AND.f_autogestion.NE.2 .AND. &
4342	f_postauto .NE. 1) THEN
4343	Wanimalcow(i,j,1)=PIYcow(i,j,k) ! Lecture du poids des jeunes vaches
4344	! si module vache ou bien des poids de génisses si module génisses
4345	Wanimalcow(i,j,2)=PIMcow(i,j,k)
4346	BCScow(i,j,1) =BCSYcow(i,j,k)
4347	BCScow(i,j,2) =BCSMcow(i,j,k)
4348	AGEcow(i,j,1) =AGE_cow_P(i,j,k)
4349	AGEcow(i,j,2) =AGE_cow_M(i,j,k)
4350	nanimaltot(i,j) =nanimal(i,j,k)
4351	Fday_pasture(i,j) =tanimal(i,j,k)
4352	!calcul de la perte d'etat max a l'entré de pature et initialisation a 0 de la note d'etat BCScow_prev
4353	BCScow_prev=0
4354
4355	IF(type_animal.EQ.1) THEN
4356	CALL calcul_perte_etat(npts,tjulian,BCScow,MPwmax,tcalving,PEmax)
4357	ENDIF
4358
4359	!On affecte PEpos a PEmax pour le premier pas de temps
4360	PEpos=PEmax
4361
4362	IF(f_complementation.EQ.0) THEN
4363	Forage_quantity_period(i,j)=0.0
4364	ELSE
4365	Forage_quantity_period(i,j)=Forage_quantity(i,j,k)
4366	ENDIF
4367	IF(PICcow(i,j,k).NE.0) THEN
4368	wanimalcalfinit(i,j) =PICcow(i,j,k)
4369	ELSE
4370	Wanimalcalfinit(i,j) =Wcalfborn(i,j)
4371	ENDIF
4372	calfinit(i,j)=0
4373	ENDIF
4374
4375	IF (( wshtot(i,j).GT.BM_threshold+0.05) .AND.f_autogestion.NE.2 .AND. &
4376	f_postauto .NE. 1 &
4377	.AND. (tjulian .GE. tanimal(i,j,k)) .AND. &
4378	(tjulian .LT. (tanimal(i,j,k) + danimal(i,j,k))) ) THEN
4379	nanimaltot(i,j) =nanimal(i,j,k)
4380	ENDIF
4381	ENDDO ! npts
4382
4383
4384	DO i=1,npts
4385	IF(tjulian .EQ.tcalving(i,j)) THEN
4386	Wanimalcalf(i,j)=Wcalfborn(i,j)
4387	END IF
4388	END DO
4389	END DO !k
4390	END IF
4391	END DO!nvm
4392
4393	! # CALCULS
4394	! Cas ou le paturage est calcule par le modele
4395	! Stocking rate calculation if grazing autogestion
4396	!-------------------------------------------------
4397
4398	! CALCUL 1 :
4399	!-------------------------------------------------
4400
4401	! tcutmodel = 1 dans le fichier de conditions initiales
4402	! flag qui existait dans la version initiale de PaSim permettant de faire
4403	! des fauches 'automatiquement'
4404	! le module d'autogestion developpe par N Vuichard utilise ce flagpour le
4405	! mode 'fauche' mais de manière 'transparente (pas besoin de l'activer)
4406	! pour info:
4407	! dans cette configuration,
4408	! - il fallait que le chargement de la premiere periode de paturage soit renseigne pour
4409	! initialiser le calcul du modele
4410	! - les animaux etaient sortis au dela de tseasonendmin = 250 (07/09)
4411	! - le chargement calcule etait seuille entre 0 et nanimaltotmax = 10 UGB/ha
4412	! - pasim ajoutait journalièrement 'deltanimal' animaux soit au minimum 1 UGB/ha, sinon
4413	! un nombre d'animaux calcule comme le ratio biomasse disponible:capacité d'ingestion maximale
4414	! d'un animal
4415	! AVEC wshtot - wshtotgrazing: biomasse disponible au jour j c'est a dire non paturee
4416	! intakemax: valeur de la capacité d'ingestion maximale d'un animal
4417	! (à defaut 15kg MS/UGB/m2)
4418
4419	calc_nanimaltot : IF (tcutmodel .EQ. 1) THEN
4420	DO j=2,nvm
4421	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)).AND.&
4422	(.NOT.is_grassland_grazed(j)))THEN
4423
4424
4425	WHERE ((nanimal(:,j,1) .GT. 0.0) .AND. (devstage(:,j) .GT. devstocking) .AND. &
4426	(stockingstart(:,j) .EQ. 0))
4427
4428	nanimaltot(:,j) = nanimal(:,j,1)
4429	stockingstart(:,j) = 1
4430
4431	END WHERE
4432
4433	IF (tjulian .GT. tseasonendmin) THEN
4434	WHERE ((stockingstart(:,j) .EQ. 1) .AND. (stockingend(:,j) .EQ. 0) .AND. &
4435	(snowfall_daily(:) .GT. 1e-3))
4436
4437	stockingend(:,j) = 1
4438
4439	END WHERE
4440	END IF
4441
4442	WHERE (stockingend(:,j) .EQ. 1)
4443
4444	nanimaltot(:,j) = 0.0
4445
4446	ELSEWHERE ( (nanimal(:,j,1) .GT. 0.0) .AND. (stockingstart(:,j) .EQ. 1))
4447
4448	deltaanimal(:,j) = MIN (0.0001,(wshtot(:,j) - wshtotgrazing(:,j))/intakemax(:,j))
4449	nanimaltot(:,j) = MIN (MAX (0.0, nanimaltot(:,j) + deltaanimal(:,j)), nanimaltotmax)
4450
4451	END WHERE
4452	END IF!manag not cut not graze
4453	END DO
4454
4455	ENDIF calc_nanimaltot
4456
4457	! CALCUL 2 :
4458	! Ajout Nicolas VUICHARD pour autogestion
4459	! si autogestion = 2 --> Animaux
4460	!-------------------------------------------------
4461
4462	!070703 AIG à confirmer
4463	! Les animaux sont sortis de la parcelle si la biomasse disponible devient inférieure à
4464	! min_grazing = 0.2 kg MS / m²
4465	! * stocking rate = 1 animal/ha on condition that shoot biomass is greater
4466	! than min_grazing + 0.05 (with min_grazing = 0.2 kg MS / m²)
4467	! * else we consider there is not enough biomass to feed animals and grazing
4468	! stop or not begin: stocking rate = 0 animal/ha
4469	! nanimaltot: stocking rate h(1...ntocking) (animal/m²) *!
4470
4471	IF (f_autogestion .EQ. 2) THEN
4472	! AIG 23/07/2010, min_grazing à changer pour BM_threshold
4473	DO j=2,nvm
4474	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)).AND. &
4475	(.NOT.is_grassland_grazed(j)))THEN
4476
4477	WHERE (wshtot(:,j) .GE. (BM_threshold_turnout))
4478
4479	delai_ugb(:,j) = delai_ugb(:,j) + 1
4480	! Potentialy I can put animals, if delai_ugb >=0
4481	WHERE (delai_ugb(:,j) .GE. 0)
4482	ugb(:,j) = 1 ! animals are in
4483	WHERE (compte_pature(:,j).LE.10)
4484	compt_ugb(:,j) = compt_ugb(:,j) + 1
4485	nanimaltot(:,j) = sr_ugb(:,j)
4486	ELSEWHERE
4487	nanimaltot(:,j)=0.0
4488	END WHERE
4489	ENDWHERE
4490	ELSEWHERE (wshtot(:,j) .LT. BM_threshold)
4491	! AIG 23/07/2010, min_grazing à changer pour BM_threshold
4492	! A la sortie des animaux sauvegarde des donnée a écrire dans le fichier Yield
4493
4494
4495	Autogestion_out(:,j,1)=Local_autogestion_out(:,j,1)
4496	Autogestion_out(:,j,2)=Local_autogestion_out(:,j,2)
4497
4498	nanimaltot(:,j) = 0.0
4499	!compt_ugb(:) = 0
4500	!Quand les animaux sont sortis on initialise delai_ugb au temps minimum
4501	!separant la nouvelle entrée en pature
4502	!delai_ugb = -15 ! RL 23 July 2010
4503	ugb(:,j) = 0 ! animals are moved out
4504
4505	END WHERE
4506	END IF!manag not cut not graze
4507	END DO
4508
4509
4510
4511	DO j=2,nvm
4512	DO i=1,npts
4513	IF ((nanimaltot_prec(i,j)>0.0).AND.(nanimaltot(i,j).EQ.0.0)) THEN
4514	delai_ugb(i,j) = -15
4515	ENDIF
4516	ENDDO
4517	ENDDO
4518
4519	END IF
4520
4521	IF (f_postauto .EQ. 1) THEN
4522	! AIG 23/07/2010, min_grazing à changer pour BM_threshold
4523
4524	WHERE (wshtot(:,mgraze_C3) .GE. (BM_threshold_turnout))
4525
4526	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) + 1
4527	! Potentialy I can put animals, if delai_ugb >=0
4528	WHERE (delai_ugb(:,mgraze_C3) .GE. 0)
4529	ugb(:,mgraze_C3) = 1 ! animals are in
4530	WHERE (compte_pature(:,mgraze_C3).LE.10)
4531	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
4532	nanimaltot(:,mgraze_C3) = sr_ugb(:,mgraze_C3)
4533	ELSEWHERE
4534	nanimaltot(:,mgraze_C3)=0.0
4535	END WHERE
4536	ENDWHERE
4537	ELSEWHERE (wshtot(:,mgraze_C3) .LT. BM_threshold)
4538	! AIG 23/07/2010, min_grazing à changer pour BM_threshold
4539	! A la sortie des animaux sauvegarde des donnée a écrire dans le
4540	! fichier Yield
4541	Autogestion_out(:,mgraze_C3,1)=Local_autogestion_out(:,mgraze_C3,1)
4542	Autogestion_out(:,mgraze_C3,2)=Local_autogestion_out(:,mgraze_C3,2)
4543
4544	nanimaltot(:,mgraze_C3) = 0.0
4545	!compt_ugb(:) = 0
4546	!Quand les animaux sont sortis on initialise delai_ugb au temps
4547	!minimum
4548	!separant la nouvelle entrée en pature
4549	!delai_ugb = -15 ! RL 23 July 2010
4550	ugb(:,mgraze_C3) = 0 ! animals are moved out
4551	END WHERE
4552
4553	WHERE (wshtot(:,mgraze_C4) .GE. (BM_threshold_turnout))
4554
4555	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) + 1
4556	! Potentialy I can put animals, if delai_ugb >=0
4557	WHERE (delai_ugb(:,mgraze_C4) .GE. 0)
4558	ugb(:,mgraze_C4) = 1 ! animals are in
4559	WHERE (compte_pature(:,mgraze_C4).LE.10)
4560	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
4561	nanimaltot(:,mgraze_C4) = sr_ugb(:,mgraze_C4)
4562	ELSEWHERE
4563	nanimaltot(:,mgraze_C4)=0.0
4564	END WHERE
4565	ENDWHERE
4566	ELSEWHERE (wshtot(:,mgraze_C4) .LT. BM_threshold)
4567	! AIG 23/07/2010, min_grazing à changer pour BM_threshold
4568	! A la sortie des animaux sauvegarde des donnée a écrire dans le
4569	! fichier Yield
4570	Autogestion_out(:,mgraze_C4,1)=Local_autogestion_out(:,mgraze_C4,1)
4571	Autogestion_out(:,mgraze_C4,2)=Local_autogestion_out(:,mgraze_C4,2)
4572
4573	nanimaltot(:,mgraze_C4) = 0.0
4574	!compt_ugb(:) = 0
4575	!Quand les animaux sont sortis on initialise delai_ugb au temps
4576	!minimum
4577	!separant la nouvelle entrée en pature
4578	!delai_ugb = -15 ! RL 23 July 2010
4579	ugb(:,mgraze_C4) = 0 ! animals are moved out
4580	END WHERE
4581
4582
4583	DO j=2,nvm
4584	DO i=1,npts
4585	IF ((nanimaltot_prec(i,j)>0.0).AND.(nanimaltot(i,j).EQ.0.0)) THEN
4586	delai_ugb(i,j) = -15
4587	ENDIF
4588	ENDDO
4589	ENDDO
4590
4591
4592	END IF
4593
4594
4595	! JCMODIF for differen sr_ugb given varied threshold
4596	! with 1 LSU of 250 gDM and stop grazing with 0.8 * 250 g DM
4597	! with < 1 LSU of 22^(1-sr_ugb10000)sr_ugb10000*125
4598	! e.g., 0.5 LSU 180 gDM 0.1 LSU 46 gDM
4599	! 0.01 LSU 5 gDM
4600
4601	IF (f_postauto .EQ. 5) THEN
4602
4603	able_grazing(:,mgraze_C3) = sr_ugb(:,mgraze_C3) * 10000.0 * 250.0 * &
4604	2.0*(1.0-(sr_ugb(:,mgraze_C3)10000.0))/1000.0
4605	able_grazing(:,mgraze_C4) = sr_ugb(:,mgraze_C4) * 10000.0 * 250.0 * &
4606	2.0*(1.0-(sr_ugb(:,mgraze_C4)10000.0))/1000.0
4607	!print *,'able_grazing', able_grazing(301:320,mgraze_C3)
4608	! > 1 LSU/ha using 0.25 kgDM
4609	WHERE (sr_ugb(:,mgraze_C3) .GE. 0.0001)
4610	WHERE (wshtot(:,mgraze_C3) .GE. (min_grazing + 0.05))
4611
4612	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
4613	WHERE (delai_ugb(:,mgraze_C3) .GE. 0)
4614	ugb(:,mgraze_C3) = 1
4615	ENDWHERE
4616
4617	ELSEWHERE (wshtot(:,mgraze_C3) .LT. (min_grazing - 0.075))
4618	Autogestion_out(:,mgraze_C3,1)=Local_autogestion_out(:,mgraze_C3,1)
4619	Autogestion_out(:,mgraze_C3,2)=Local_autogestion_out(:,mgraze_C3,2)
4620	nanimaltot (:,mgraze_C3) = 0.0
4621	ugb(:,mgraze_C3) = 0
4622	delai_ugb(:,mgraze_C3) = -15
4623	END WHERE
4624
4625	ELSEWHERE (sr_ugb(:,mgraze_C3) .GE. 0.00002 .and. &
4626	sr_ugb(:,mgraze_C3) .LT. 0.0001)
4627	WHERE (wshtot(:,mgraze_C3) .GE. able_grazing(:,mgraze_C3))
4628
4629	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
4630	WHERE (delai_ugb(:,mgraze_C3) .GE. 0)
4631	ugb(:,mgraze_C3) = 1
4632	ENDWHERE
4633
4634	ELSEWHERE (wshtot(:,mgraze_C3) .LT. able_grazing(:,mgraze_C3)*0.5)
4635	Autogestion_out(:,mgraze_C3,1)=Local_autogestion_out(:,mgraze_C3,1)
4636	Autogestion_out(:,mgraze_C3,2)=Local_autogestion_out(:,mgraze_C3,2)
4637	nanimaltot (:,mgraze_C3) = 0.0
4638	ugb(:,mgraze_C3) = 0
4639	delai_ugb(:,mgraze_C3) = -15
4640	END WHERE
4641	ELSEWHERE (sr_ugb(:,mgraze_C3) .LT. 0.00002)
4642	WHERE (wshtot(:,mgraze_C3) .GE. able_grazing(:,mgraze_C3))
4643
4644	delai_ugb(:,mgraze_C3) = delai_ugb(:,mgraze_C3) +1
4645	WHERE (delai_ugb(:,mgraze_C3) .GE. 0)
4646	ugb(:,mgraze_C3) = 1
4647	ENDWHERE
4648
4649	ELSEWHERE (wshtot(:,mgraze_C3) .LT. able_grazing(:,mgraze_C3)*0.3)
4650	Autogestion_out(:,mgraze_C3,1)=Local_autogestion_out(:,mgraze_C3,1)
4651	Autogestion_out(:,mgraze_C3,2)=Local_autogestion_out(:,mgraze_C3,2)
4652	nanimaltot (:,mgraze_C3) = 0.0
4653	ugb(:,mgraze_C3) = 0
4654	delai_ugb(:,mgraze_C3) = -15
4655	END WHERE
4656	ENDWHERE
4657	IF (tjulian .GT. tseasonendmin) THEN
4658	WHERE (snowfall_daily(:) .GT. 1e-3)
4659	nanimaltot (:,mgraze_C3) = 0.0
4660	ugb(:,mgraze_C3) = 0
4661	ENDWHERE
4662	ENDIF
4663	WHERE (ugb(:,mgraze_C3) .EQ. 1)
4664	compt_ugb(:,mgraze_C3) = compt_ugb(:,mgraze_C3) + 1
4665	WHERE (sr_ugb(:,mgraze_C3) .GT. 0.00002)
4666	nanimaltot (:,mgraze_C3) = sr_ugb(:,mgraze_C3)
4667	ELSEWHERE
4668	nanimaltot (:,mgraze_C3) = 0.00002
4669	ENDWHERE
4670	END WHERE
4671	! > 1 LSU/ha using 0.25 kgDM
4672	WHERE (sr_ugb(:,mgraze_C4) .GE. 0.0001)
4673	WHERE (wshtot(:,mgraze_C4) .GE. (min_grazing + 0.05))
4674
4675	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
4676	WHERE (delai_ugb(:,mgraze_C4) .GE. 0)
4677	ugb(:,mgraze_C4) = 1
4678	ENDWHERE
4679
4680	ELSEWHERE (wshtot(:,mgraze_C4) .LT. (min_grazing - 0.075))
4681	Autogestion_out(:,mgraze_C4,1)=Local_autogestion_out(:,mgraze_C4,1)
4682	Autogestion_out(:,mgraze_C4,2)=Local_autogestion_out(:,mgraze_C4,2)
4683	nanimaltot (:,mgraze_C4) = 0.0
4684	ugb(:,mgraze_C4) = 0
4685	delai_ugb(:,mgraze_C4) = -15
4686	END WHERE
4687	ELSEWHERE (sr_ugb(:,mgraze_C4) .GE. 0.00002 .and. &
4688	sr_ugb(:,mgraze_C4) .LT. 0.0001)
4689	WHERE (wshtot(:,mgraze_C4) .GE. able_grazing(:,mgraze_C4))
4690
4691	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
4692	WHERE (delai_ugb(:,mgraze_C4) .GE. 0)
4693	ugb(:,mgraze_C4) = 1
4694	ENDWHERE
4695
4696	ELSEWHERE (wshtot(:,mgraze_C4) .LT. able_grazing(:,mgraze_C4)*0.5)
4697	Autogestion_out(:,mgraze_C4,1)=Local_autogestion_out(:,mgraze_C4,1)
4698	Autogestion_out(:,mgraze_C4,2)=Local_autogestion_out(:,mgraze_C4,2)
4699	nanimaltot (:,mgraze_C4) = 0.0
4700	ugb(:,mgraze_C4) = 0
4701	delai_ugb(:,mgraze_C4) = -15
4702	END WHERE
4703	ELSEWHERE (sr_ugb(:,mgraze_C4) .LT. 0.00002)
4704	WHERE (wshtot(:,mgraze_C4) .GE. able_grazing(:,mgraze_C4))
4705
4706	delai_ugb(:,mgraze_C4) = delai_ugb(:,mgraze_C4) +1
4707	WHERE (delai_ugb(:,mgraze_C4) .GE. 0)
4708	ugb(:,mgraze_C4) = 1
4709	ENDWHERE
4710
4711	ELSEWHERE (wshtot(:,mgraze_C4) .LT. able_grazing(:,mgraze_C4)*0.3)
4712	Autogestion_out(:,mgraze_C4,1)=Local_autogestion_out(:,mgraze_C4,1)
4713	Autogestion_out(:,mgraze_C4,2)=Local_autogestion_out(:,mgraze_C4,2)
4714	nanimaltot (:,mgraze_C4) = 0.0
4715	ugb(:,mgraze_C4) = 0
4716	delai_ugb(:,mgraze_C4) = -15
4717	END WHERE
4718	ENDWHERE
4719	IF (tjulian .GT. tseasonendmin) THEN
4720	WHERE (snowfall_daily(:) .GT. 1e-3)
4721	nanimaltot (:,mgraze_C4) = 0.0
4722	ugb(:,mgraze_C4) = 0
4723	ENDWHERE
4724	ENDIF
4725	WHERE (ugb(:,mgraze_C4) .EQ. 1)
4726	compt_ugb(:,mgraze_C4) = compt_ugb(:,mgraze_C4) + 1
4727	WHERE (sr_ugb(:,mgraze_C4) .GT. 0.00002)
4728	nanimaltot (:,mgraze_C4) = sr_ugb(:,mgraze_C4)
4729	ELSEWHERE
4730	nanimaltot (:,mgraze_C4) = 0.00002
4731	ENDWHERE
4732	END WHERE
4733
4734	ENDIF
4735	!ENDJCADD
4736	IF (f_autogestion .EQ. 2) THEN
4737	DO j=2,nvm
4738	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)).AND. &
4739	(.NOT.is_grassland_grazed(j)))THEN
4740
4741	IF(ugb(1,j).NE.ugb_last(1,j)) THEN
4742	IF ((ugb(1,j).EQ.1)) THEN
4743	print*, 'Animaux in'
4744	ELSE
4745	print*, 'Animaux out'
4746	ENDIF
4747	ENDIF
4748	END IF!manag not cut not graze
4749	END DO
4750
4751	ENDIF
4752	IF (f_postauto .EQ. 1) THEN
4753	IF(ugb(1,mgraze_C3).NE.ugb_last(1,mgraze_C3)) THEN
4754	IF ((ugb(1,mgraze_C3).EQ.1)) THEN
4755	print*, 'Animaux in'
4756	ELSE
4757	print*, 'Animaux out'
4758	ENDIF
4759	ENDIF
4760	ENDIF
4761	! Mise a jour de tanimal, danimal, BCS(Y/M) et PI(Y/M) et des valeurs intiales pour le premier
4762	! chargement en cas d'autogestion
4763	! Renseignements des variables du fichier management pour ecriture de ce dernier en fin de
4764	! simulation
4765	IF (f_autogestion.EQ.2) THEN
4766	DO j=2,nvm
4767	IF (is_grassland_manag(j) .AND. (.NOT.is_grassland_cut(j)).AND.&
4768	(.NOT.is_grassland_grazed(j)))THEN
4769
4770	DO i=1,npts
4771	!Nous sommes sur une entrée en paturage, on initialise les valeurs de simulation et on sauvegarde
4772	!les données pour ecriture management
4773	IF((nanimaltot_prec(i,j).EQ.0).AND.(nanimaltot(i,j).NE.0).AND.&
4774	(compte_pature(i,j).LE.10)) THEN
4775	!nous sommes limites à 10 periodes de paturage
4776	compte_pature(i,j)=compte_pature(i,j)+1
4777	print *, "compte pature : ", compte_pature(i,j)
4778	IF(compte_pature(i,j).GT.10) THEN
4779	compte_pature(i,j)=10
4780	ENDIF
4781	BCScow(i,j,1)=autogestion_BCScow(i,j,1)
4782	BCScow(i,j,2)=autogestion_BCScow(i,j,2)
4783	Wanimalcow(i,j,1)=autogestion_weightcow(i,j,1)
4784	Wanimalcow(i,j,2)=autogestion_weightcow(i,j,2)
4785	AGEcow(i,j,1)=autogestion_AGEcow(i,j,1)+tjulian /30
4786	AGEcow(i,j,2)=autogestion_AGEcow(i,j,2)+tjulian /30
4787	Fday_pasture(i,j)=tjulian
4788
4789	autogestion_init(i,j)=1
4790
4791	PIYcow(i,j,compte_pature(i,j))=Wanimalcow(i,j,1)
4792	PIMcow(i,j,compte_pature(i,j))=Wanimalcow(i,j,2)
4793	BCSYcow(i,j,compte_pature(i,j))=BCScow(i,j,1)
4794	BCSMcow(i,j,compte_pature(i,j))=BCScow(i,j,2)
4795	AGE_cow_P(i,j,compte_pature(i,j))=AGEcow(i,j,1)
4796	AGE_cow_M(i,j,compte_pature(i,j))=AGEcow(i,j,2)
4797	nanimal(i,j,compte_pature(i,j))=nanimaltot(i,j)
4798	tanimal(i,j,compte_pature(i,j))=tjulian
4799	ENDIF
4800	!cas d'une sortie de paturage
4801	IF(nanimaltot_prec(i,j).NE.0.AND.nanimaltot(i,j).EQ.0) THEN
4802	print *, "compte pature : ", compte_pature(i,j)
4803	danimal(i,j,compte_pature(i,j))=tjulian -tanimal(i,j,compte_pature(i,j))
4804	!on sauvegarde les poids et BCS des vaches pour la prochaine entré en paturage
4805	autogestion_BCScow(i,j,1)=BCScow(i,j,1)
4806	autogestion_BCScow(i,j,2)=BCScow(i,j,2)
4807	autogestion_weightcow(i,j,1)=Wanimalcow(i,j,1)
4808	autogestion_weightcow(i,j,2)=Wanimalcow(i,j,2)
4809	ENDIF
4810	ENDDO !i
4811	END IF!manag not cut not graze
4812	END DO
4813	ELSE IF (f_postauto.EQ.1 .OR. f_postauto .EQ. 5) THEN
4814	DO i=1,npts
4815	!Nous sommes sur une entrée en paturage, on initialise les valeurs
4816	!de simulation et on sauvegarde
4817	!les données pour ecriture management
4818	IF((nanimaltot_prec(i,mgraze_C3).EQ.0).AND.&
4819	(nanimaltot(i,mgraze_C3).NE.0).AND.(compte_pature(i,mgraze_C3).LE.10))THEN
4820	!nous sommes limites à 10 periodes de paturage
4821	compte_pature(i,mgraze_C3)=compte_pature(i,mgraze_C3)+1
4822	print *, "compte pature : ", compte_pature(i,mgraze_C3)
4823	IF(compte_pature(i,mgraze_C3).GT.10) THEN
4824	compte_pature(i,mgraze_C3)=10
4825	ENDIF
4826	BCScow(i,mgraze_C3,1)=autogestion_BCScow(i,mgraze_C3,1)
4827	BCScow(i,mgraze_C3,2)=autogestion_BCScow(i,mgraze_C3,2)
4828	Wanimalcow(i,mgraze_C3,1)=autogestion_weightcow(i,mgraze_C3,1)
4829	Wanimalcow(i,mgraze_C3,2)=autogestion_weightcow(i,mgraze_C3,2)
4830	AGEcow(i,mgraze_C3,1)=autogestion_AGEcow(i,mgraze_C3,1)+tjulian /30
4831	AGEcow(i,mgraze_C3,2)=autogestion_AGEcow(i,mgraze_C3,2)+tjulian /30
4832	Fday_pasture(i,mgraze_C3)=tjulian
4833
4834	autogestion_init(i,mgraze_C3)=1
4835
4836	PIYcow(i,mgraze_C3,compte_pature(i,mgraze_C3))=Wanimalcow(i,mgraze_C3,1)
4837	PIMcow(i,mgraze_C3,compte_pature(i,mgraze_C3))=Wanimalcow(i,mgraze_C3,2)
4838	BCSYcow(i,mgraze_C3,compte_pature(i,mgraze_C3))=BCScow(i,mgraze_C3,1)
4839	BCSMcow(i,mgraze_C3,compte_pature(i,mgraze_C3))=BCScow(i,mgraze_C3,2)
4840	AGE_cow_P(i,mgraze_C3,compte_pature(i,mgraze_C3))=AGEcow(i,mgraze_C3,1)
4841	AGE_cow_M(i,mgraze_C3,compte_pature(i,mgraze_C3))=AGEcow(i,mgraze_C3,2)
4842	nanimal(i,mgraze_C3,compte_pature(i,mgraze_C3))=nanimaltot(i,mgraze_C3)
4843	tanimal(i,mgraze_C3,compte_pature(i,mgraze_C3))=tjulian
4844	ENDIF
4845	!cas d'une sortie de paturage
4846	IF(nanimaltot_prec(i,mgraze_C3).NE.0.AND.nanimaltot(i,mgraze_C3).EQ.0) THEN
4847	print *, "compte pature : ", compte_pature(i,mgraze_C3)
4848	danimal(i,mgraze_C3,compte_pature(i,mgraze_C3))=tjulian-tanimal(i,mgraze_C3,compte_pature(i,mgraze_C3))
4849	!on sauvegarde les poids et BCS des vaches pour la prochaine
4850	!entré en paturage
4851	autogestion_BCScow(i,mgraze_C3,1)=BCScow(i,mgraze_C3,1)
4852	autogestion_BCScow(i,mgraze_C3,2)=BCScow(i,mgraze_C3,2)
4853	autogestion_weightcow(i,mgraze_C3,1)=Wanimalcow(i,mgraze_C3,1)
4854	autogestion_weightcow(i,mgraze_C3,2)=Wanimalcow(i,mgraze_C3,2)
4855	ENDIF
4856
4857	IF((nanimaltot_prec(i,mgraze_C4).EQ.0).AND.&
4858	(nanimaltot(i,mgraze_C4).NE.0).AND.(compte_pature(i,mgraze_C4).LE.10))THEN
4859	!nous sommes limites à 10 periodes de paturage
4860	compte_pature(i,mgraze_C4)=compte_pature(i,mgraze_C4)+1
4861	print *, "compte pature : ", compte_pature(i,mgraze_C4)
4862	IF(compte_pature(i,mgraze_C4).GT.10) THEN
4863	compte_pature(i,mgraze_C4)=10
4864	ENDIF
4865	BCScow(i,mgraze_C4,1)=autogestion_BCScow(i,mgraze_C4,1)
4866	BCScow(i,mgraze_C4,2)=autogestion_BCScow(i,mgraze_C4,2)
4867	Wanimalcow(i,mgraze_C4,1)=autogestion_weightcow(i,mgraze_C4,1)
4868	Wanimalcow(i,mgraze_C4,2)=autogestion_weightcow(i,mgraze_C4,2)
4869	AGEcow(i,mgraze_C4,1)=autogestion_AGEcow(i,mgraze_C4,1)+tjulian/30
4870	AGEcow(i,mgraze_C4,2)=autogestion_AGEcow(i,mgraze_C4,2)+tjulian/30
4871	Fday_pasture(i,mgraze_C4)=tjulian
4872
4873	autogestion_init(i,mgraze_C4)=1
4874
4875	PIYcow(i,mgraze_C4,compte_pature(i,mgraze_C4))=Wanimalcow(i,mgraze_C4,1)
4876	PIMcow(i,mgraze_C4,compte_pature(i,mgraze_C4))=Wanimalcow(i,mgraze_C4,2)
4877	BCSYcow(i,mgraze_C4,compte_pature(i,mgraze_C4))=BCScow(i,mgraze_C4,1)
4878	BCSMcow(i,mgraze_C4,compte_pature(i,mgraze_C4))=BCScow(i,mgraze_C4,2)
4879	AGE_cow_P(i,mgraze_C4,compte_pature(i,mgraze_C4))=AGEcow(i,mgraze_C4,1)
4880	AGE_cow_M(i,mgraze_C4,compte_pature(i,mgraze_C4))=AGEcow(i,mgraze_C4,2)
4881	nanimal(i,mgraze_C4,compte_pature(i,mgraze_C4))=nanimaltot(i,mgraze_C4)
4882	tanimal(i,mgraze_C4,compte_pature(i,mgraze_C4))=tjulian
4883	ENDIF
4884	!cas d'une sortie de paturage
4885	IF(nanimaltot_prec(i,mgraze_C4).NE.0.AND.&
4886	nanimaltot(i,mgraze_C4).EQ.0)THEN
4887	print *, "compte pature : ", compte_pature(i,mgraze_C4)
4888	danimal(i,mgraze_C4,compte_pature(i,mgraze_C4))=tjulian-tanimal(i,mgraze_C4,compte_pature(i,mgraze_C4))
4889	!on sauvegarde les poids et BCS des vaches pour la prochaine
4890	!entré en paturage
4891	autogestion_BCScow(i,mgraze_C4,1)=BCScow(i,mgraze_C4,1)
4892	autogestion_BCScow(i,mgraze_C4,2)=BCScow(i,mgraze_C4,2)
4893	autogestion_weightcow(i,mgraze_C4,1)=Wanimalcow(i,mgraze_C4,1)
4894	autogestion_weightcow(i,mgraze_C4,2)=Wanimalcow(i,mgraze_C4,2)
4895	ENDIF
4896
4897
4898	ENDDO !i
4899
4900	ENDIF
4901
4902	END IF n_day !n_day
4903	!Flag gestation and calf computation
4904	gestation=0
4905	calf=0
4906	tempTjulian=int(Tjulian*100)
4907	tempTjulian=tempTjulian/100
4908	DO j=2,nvm
4909	DO i=1,npts
4910	IF (tempTjulian .GE. tcalving(i,j)) THEN
4911
4912	!84 est 365 moins la durée de gestation(280j)
4913	IF (tempTjulian - tcalving(i,j) .GE. 84) THEN
4914	gestation(i,j)=1
4915	ENDIF
4916	IF (tempTjulian-tcalving(i,j) .LE. age_sortie_calf(i,j)+1) THEN
4917	calf(i,j)=1
4918	ENDIF
4919	ELSE
4920	IF (tempTjulian+365-tcalving(i,j) .GE. 84 .and. &
4921	tempTjulian+365-tcalving(i,j) .LE. 365) THEN
4922	gestation(i,j)=1
4923	ENDIF
4924	IF (365-(tcalving(i,j)-tempTjulian).LT. age_sortie_calf(i,j)+1) THEN
4925	calf(i,j)=1
4926	ENDIF
4927	ENDIF
4928	ENDDO
4929	ENDDO
4930	WHERE (nanimaltot.EQ.0)
4931	calf=0
4932	gestation=0
4933	END WHERE
4934
4935	IF (type_animal.NE.2) THEN
4936	calf=0
4937	wanimalcalf=0.0
4938	ENDIF
4939
4940
4941	! dans le cas autogestion, le calcul du poids d u veau lorque les animaux commence le paturage
4942	! est estimé par un modèle
4943	IF(type_animal.EQ.2) THEN
4944	DO j=2,nvm
4945	IF (f_autogestion.EQ.2) THEN
4946	DO i=1,npts
4947	IF (nanimaltot_prec(i,j).EQ.0.AND.&
4948	nanimaltot(i,j).GT.0.AND.calf(i,j).EQ.1) THEN
4949	IF(tjulian.GT.tcalving(i,j)) THEN
4950	CALL estime_weightcalf(tjulian-tcalving(i,j),Wcalfborn(i,j),Wanimalcalf(i,j))
4951	ELSE
4952	CALL estime_weightcalf(365+tjulian-tcalving(i,j),Wcalfborn(i,j),Wanimalcalf(i,j))
4953	ENDIF
4954	PICcow(i,j,compte_pature(i,j))=Wanimalcalf(i,j)
4955	ENDIF
4956	IF (tjulian.EQ.tcalving(i,j)) THEN
4957	Wanimalcalf(i,j)=Wcalfborn(i,j)
4958	ENDIF
4959	ENDDO
4960	ELSE
4961	DO i=1,npts
4962	IF (calf(i,j) .EQ. 1 .AND. calfinit(i,j) .EQ. 0) THEN
4963	Wanimalcalf(i,j)=Wanimalcalfinit(i,j)
4964	calfinit(i,j)=1
4965	ENDIF
4966	ENDDO
4967	ENDIF
4968	ENDDO
4969	ENDIF
4970
4971
4972	WHERE(nanimaltot.GT.0)
4973	AGE_animal(:,:,1)=AGEcow(:,:,1)+(tjulian-Fday_pasture(:,:))/30
4974	AGE_animal(:,:,2)=AGEcow(:,:,2)+(tjulian-Fday_pasture(:,:))/30
4975	ENDWHERE
4976	nanimaltot_prec=nanimaltot
4977
4978
4979	!---------------------
4980	! Milk Production (MP)
4981	! Just the potential MP for dairy cows
4982	!---------------------
4983
4984	IF(type_animal.EQ.1) THEN ! Dairy cows
4985	!dans le cas dairy, on ne calcule que la production potentielle
4986	!necessaire au calcul de la complémentation et de la NEL totale
4987	!la production de lait du module dairy est fonction de l'ingéré
4988
4989	CALL Potentiel_dairy_d(npts,tjulian,Nweeklact,NweekGest,MPwmax,MPwcow2)
4990	!Affectation necessaire pour le calcul de la complémentation
4991	!le vrai potentiel est calculé apres car necessité de l'ingestion totale
4992
4993	MPcow2=MPwcow2
4994
4995	ELSEIF(type_animal.EQ.2) THEN ! Suckler cows
4996
4997	CALL Milk_Animal_cow( &
4998	npts, dt ,&
4999	nanimaltot,tjulian,NEBcow_prec ,&
5000	MPcow2,MPcow,MPwcow2,&
5001	MPcowC, MPcowN ,&
5002	MPcowCsum, MPcowNsum, milkanimalsum,milkKG)
5003
5004	ELSEIF(type_animal.EQ.4.OR.type_animal.EQ.5)THEN ! Heifers
5005	MPcow2=0.
5006	MPcow=0.
5007	MPwcow2=0.
5008	MPcowC=0.
5009	MPcowN=0.
5010	MPcowCsum=0.
5011	MPcowNsum=0.
5012	milkanimalsum=0.
5013	milkKG=0.
5014	nWeeklact=0.
5015	nWeekGest=0.
5016	ENDIF
5017
5018
5019	!---------------------
5020	! intake capacity (IC)
5021	!---------------------
5022	! Cow intake capacity (young/primiparous and old/multiparous)
5023	IF(type_animal.EQ.1) THEN !dairy
5024	CALL intake_capacity_cow_d(&
5025	npts,2, &
5026	MPwcow2 ,&
5027	BCScow, wanimalcow, nanimaltot, ICcow,&
5028	AGE_animal, nWeekLact,nWeekGest)
5029	ELSEIF(type_animal.EQ.2)THEN !suckler
5030	CALL intake_capacity_cow(&
5031	npts, wanimalcow , &
5032	MPwcow2, BCScow , &
5033	nanimaltot, ICcow)
5034	ELSEIF(type_animal.EQ.4.OR.type_animal.EQ.5) THEN
5035	CALL intake_capacity_heifer(npts, type_animal, Wcalfborn, wanimalcow, ICcow)
5036	ENDIF
5037
5038	! Cow average IC
5039	!------------------
5040	! C'est cette capacite d'ingestion qui sera utilisee pour le calcul
5041	! des processus de selection animale avec le nouveau module
5042
5043	IC_tot = ICcow(:,:,1) * pyoung(:,:) + ICcow(:,:,2) * (1-pyoung(:,:))
5044
5045	! Calf IC
5046	!---------------
5047	! MPwcow2 and BCScow must be here but not use in the calf case
5048
5049	IF(type_animal.EQ.2) THEN
5050	CALL intake_capacity_calves(&
5051	npts, wanimalcalf,&
5052	nanimaltot,tjulian, ICcalf)
5053	ENDIF
5054
5055	WHERE (calf.EQ.0)
5056	ICcalf=0
5057	ENDWHERE
5058
5059	!----------------------------
5060	! Dry matter ingestion (DMI)
5061	!----------------------------
5062
5063	IF(type_animal.EQ.1) THEN ! Dairy cows (primiparous and multiparous)
5064
5065	CALL Grazing_intake_cow_d( &
5066	npts, 2 ,&
5067	ntot,nanimaltot,DNDF ,&
5068	NDF,ICcow,tadmin,tadmoy ,&
5069	DMIcowanimal ,&
5070	OMD, wshtot, FVh,tmoy_14,&
5071	BM_threshold)
5072
5073	ELSEIF(type_animal.EQ.2) THEN ! Suckler cows
5074
5075	! DMI of young cows
5076	CALL Grazing_intake_cow( &
5077	npts, type_animal, wshtot,&
5078	tadmin,nanimaltot,DNDF ,&
5079	NDF,ICcow(:,:,1) ,&
5080	DMIcowanimal(:,:,1) ,&
5081	OMD, tadmoy, FVh, ntot ,&
5082	tmoy_14, BM_threshold)
5083
5084	! DMI of mature cows
5085	CALL Grazing_intake_cow( &
5086	npts, type_animal, wshtot,&
5087	tadmin,nanimaltot,DNDF ,&
5088	NDF,ICcow(:,:,2) ,&
5089	DMIcowanimal(:,:,2) ,&
5090	OMD, tadmoy, FVh, ntot ,&
5091	tmoy_14, BM_threshold)
5092
5093	! DMI of calves
5094	!----------------------------------
5095	CALL Grazing_intake_cow( &
5096	npts, type_animal, wshtot,&
5097	tadmin,nanimaltot,DNDF ,&
5098	NDF,ICcalf ,&
5099	DMIcalfanimal,OMD, tadmoy,&
5100	FVh, ntot,tmoy_14 ,&
5101	BM_threshold)
5102
5103	!integration of cumulated value for calves
5104	! (grazing_intake_complementation is never called for calves variables
5105
5106	DMIcalf=DMIcalfanimal*nanimaltot
5107	DO j=2,nvm
5108	CALL Euler_funct (npts,dt,DMIcalfanimal(:,j), DMIcalfanimalsum(:,j))
5109	CALL Euler_funct (npts,dt,DMIcalf(:,j), DMIcalfsum(:,j))
5110	CALL Euler_funct (npts,dt,DMIcalf(:,j)*(n(:,j)+fn(:,j)),DMIcalfnsum(:,j))
5111	END DO
5112
5113	ELSEIF(type_animal.EQ.4.OR.type_animal.EQ.5) THEN ! Heifers
5114
5115	CALL Grazing_intake_cow( &
5116	npts, type_animal, wshtot,&
5117	tadmin,nanimaltot,DNDF ,&
5118	NDF,ICcow(:,:,1) ,&
5119	DMIcowanimal(:,:,1) ,&
5120	OMD, tadmoy, FVh, ntot ,&
5121	tmoy_14, BM_threshold)
5122
5123	!Pour l'appel de grazing_intake_complementation
5124	!la dimension 2 sera remise a zero dans grazing_intake_complementation
5125	ICcow(:,:,2)=ICcow(:,:,1)
5126	DMIcow(:,:,2)=DMIcow(:,:,1)
5127
5128	ENDIF
5129
5130
5131	!---------------------------------------
5132	! Energetic content of the herbage (NEL)
5133	!---------------------------------------
5134
5135	CALL Calcul_NEL_herbage(npts,OMD, NELherbage)
5136
5137	!---------------------------------------
5138	! Energy required for cow - Necessary for auto-supplementation calculation
5139	!---------------------------------------
5140	!Si entrée en paturage alors MPcow2_prec = MPwcow2
5141	DO j=2,nvm
5142	DO k=1,nstocking
5143	DO i=1,npts
5144	IF (tanimal(i,j,k).EQ.tjulian.AND.f_autogestion.NE.2) THEN
5145	MPcow2_prec(i,j,1)=MPwcow2(i,j,1)
5146	MPcow2_prec(i,j,2)=MPwcow2(i,j,2)
5147	ENDIF
5148	ENDDO
5149	ENDDO
5150	ENDDO
5151	! AIG 04/07/2010
5152	! On calcule les besoins en energie pour realiser la production de lait potentielle (et non relle)
5153	! On doit donc passer en entree de la subroutine MPwcow2 tout le temps
5154	CALL Calcul_NER_cow(npts,2,wanimalcow,wcalfborn, Age_animal, nweekgest, MPcow2_prec,NER,NEGcow,NEMcow)
5155
5156	! MODULE COMPLEMENTATION
5157	! Complementation with herbage and concentrate in management or
5158	! auto-complementation with herbage for suckler cow and concentrate for dairy cow
5159	!---------------------------------
5160
5161	! Dans le cas des dairy, la production de lait n'est pas encore calculée, on prend donc la
5162	! la production de lait au pas de temps d'avant pour le calcul de la complémentation
5163	IF(type_animal.EQ.1) THEN
5164	MPcow2=MPcow2_prec
5165	ENDIF
5166	CALL grazing_intake_complementation(npts,dt ,&
5167	DMIcowanimal, FVh, ICcow, FVf ,&
5168	MPcow2,MPwcow2,Forage_quantity_period ,&
5169	QIc, NELherbage, EVf,nanimaltot ,&
5170	DMIcowsum,DMIcowanimalsum ,&
5171	DMIcow,DMIcowNsum,n,fn,pyoung ,&
5172	type_animal,intake_tolerance ,&
5173	Q_max_complement,forage_complementc ,&
5174	NER,forage_complementn,NEIcow,NEMcow ,&
5175	NEIh,NEIf,NEIc,NEGcow,f_complementation,&
5176	DMIc,DMIf)
5177
5178	! Update of cattle Variables(old & young cows + calf)
5179	!-------------------------------------
5180	WHERE (nanimaltot.EQ.0)
5181	intake_animal=0.0
5182	intake=0.0
5183	OMD=0.0
5184	! AIG et MG 06/02/2010
5185	intakemax=0.0
5186	ELSEWHERE
5187	intake_animal=DMIcalfanimal(:,:)+DMIcowanimal(:,:,1)pyoung+DMIcowanimal(:,:,2)(1-pyoung)
5188	intake=DMIcalf+DMIcow(:,:,1)+DMIcow(:,:,2)
5189	intakesum=DMIcowsum(:,:,1)+DMIcowsum(:,:,2)+DMIcalfsum(:,:)
5190	intakensum=DMIcalfnsum+DMIcowNsum(:,:,1)+DMIcowNsum(:,:,2)
5191	! AIG et MG 06/02/2010 calcul de l'intakemax qui sera utilisé dans plante
5192	! pour le calcul des préférences alimentaires des animaux
5193	intakemax = ICcow(:,:,1)pyoung + ICcow(:,:,2)(1-pyoung)+ ICcalf
5194	ENDWHERE
5195
5196	DO j=2,nvm
5197	CALL Euler_funct (npts,dt,intake_animal(:,j), intake_animalsum(:,j))
5198	END DO
5199
5200	CALL variablesPlantes(&
5201	npts,biomass,&
5202	c,n,intake_animal,intakemax,&
5203	AnimalDiscremineQualite)
5204
5205
5206	CALL chg_plante(&
5207	npts, dt, biomass , &
5208	c, n,leaf_frac , &
5209	wsh, wshtot , &
5210	nanimaltot, intake_animal, &
5211	trampling,intake, &
5212	NDF,DNDF,DNDFI, &
5213	grazing_litter)
5214
5215	! CALL variablesPlantes(&
5216	! npts,biomass,NDF,DNDF,DNDFI,&
5217	! c,n,intake_animal,intakemax,&
5218	! AnimalDiscremineQualite)
5219
5220
5221	!---------------------------------------------------------
5222	! Possible and observed Milk Production (MPpos and MPobs)
5223	! For dairy cows only
5224	!--------------------------------------------------------
5225	!
5226	WHERE(nanimaltot.GT.0.0.AND.MPcow2(:,:,1).GT.0.0.AND.&
5227	type_animal.eq.1.AND.f_complementation.EQ.4)
5228	Qic(:,:,1)=DMIc(:,:,1)/MPcow2(:,:,1)
5229	ENDWHERE
5230
5231	WHERE(nanimaltot.GT.0.0.AND.MPcow2(:,:,2).GT.0.0.AND.&
5232	type_animal.eq.1.AND.f_complementation.EQ.4)
5233	Qic(:,:,2)=DMIc(:,:,2)/MPcow2(:,:,2)
5234	ENDWHERE
5235
5236	IF(type_animal.EQ.1) THEN !Dairy cows
5237
5238	CALL calcul_NEI_cow_d(npts,2,MPcow2_prec,DMIcowanimal,NELherbage ,&
5239	EVf,Forage_quantity_period ,&
5240	EVc,Qic,NEIcow,NEMcow,NEIh,NEIf,&
5241	NEIc)
5242
5243	WHERE(BCScow_prev(:,:,1).EQ.0)
5244	deltaBCS(:,:,1)=0
5245	ELSEWHERE
5246	deltaBCS(:,:,1)=BCScow(:,:,1)-BCScow_prev(:,:,1)
5247	ENDWHERE
5248
5249	WHERE(BCScow_prev(:,:,2).EQ.0)
5250	deltaBCS(:,:,2)=0
5251	ELSEWHERE
5252	deltaBCS(:,:,2)=BCScow(:,:,2)-BCScow_prev(:,:,2)
5253	ENDWHERE
5254
5255	CALL Milk_Animal_cow_d( &
5256	npts, dt ,&
5257	nanimaltot,tjulian ,&
5258	MPcow2,MPcow,MPwcow2 ,&
5259	MPcowC, MPcowN ,&
5260	MPcowCsum, MPcowNsum, milkanimalsum,milkKG,&
5261	NWeekLact, NWeekGest,PEmax,PEpos,deltaBCS ,&
5262	MPpos,NEIcow,NEMcow,NEGcow,MPcow2_prec,MPwCow2)
5263
5264	! Une fois la quantité de lait produite, si les vaches laitières sont complémentées en concentré alors
5265	! il faut calculé la quantité Qic de concentré par litre de lait qui permet de faire les bilan d'energie
5266	ENDIF
5267
5268	!On remet a jour QIc
5269	WHERE(nanimaltot.GT.0.0.AND.MPcow2(:,:,1).GT.0.0.AND.&
5270	type_animal.eq.1.AND.f_complementation.EQ.4)
5271	Qic(:,:,1)=DMIc(:,:,1)/MPcow2(:,:,1)
5272	ENDWHERE
5273
5274	WHERE(nanimaltot.GT.0.0.AND.MPcow2(:,:,2).GT.0.0.AND.&
5275	type_animal.eq.1.AND.f_complementation.EQ.4)
5276	Qic(:,:,2)=DMIc(:,:,2)/MPcow2(:,:,2)
5277	ENDWHERE
5278
5279
5280	! Update of cattle Variables(mature/multi cow of cattle + young/primi of cattle)
5281	IF(type_animal.EQ.1.OR.type_animal.EQ.2) THEN
5282	milksum(:,:) =MPcowsum(:,:,1)+MPcowsum(:,:,2)
5283	milknsum(:,:) =MPcowNsum(:,:,1)+MPcowNsum(:,:,2)
5284	milkcsum(:,:) =MPcowCsum(:,:,1)+MPcowCsum(:,:,2)
5285	milkn(:,:) =MPcowN(:,:,1)+MPcowN(:,:,2)
5286	milkc(:,:) =MPcowC(:,:,1)+MPcowC(:,:,2)
5287	ENDIF
5288
5289
5290	!------------------------
5291	! Net energy balance (NEB)
5292	!------------------------
5293	IF(type_animal.EQ.1) THEN
5294	!NEB of dairy cows
5295	!------------------
5296	CALL balance_energy_cow_d(npts,2,dt,&
5297	MPcow2,MPwcow2,MPpos,&
5298	BCScow,BCScow_prev,AGE_animal,wanimalcow,nanimaltot)
5299
5300
5301	ELSEIF(type_animal.EQ.2) THEN
5302	!NEB of suckler cows
5303	!------------------
5304	!Young cows
5305	CALL balance_energy_cow(npts,dt ,&
5306	DMIcowanimal(:,:,1),MPcow2(:,:,1) ,&
5307	0, BCScow(:,:,1),tjulian,wanimalcow(:,:,1),nanimaltot,&
5308	NEBcow(:,:,1), NELherbage, EVf(:,:),DMIf(:,:,1),&
5309	EVc(:,:),Qic(:,:,1), NEIcow(:,:,1), NEIh(:,:,1),&
5310	NEIf(:,:,1), NEIc(:,:,1),& ! to check
5311	NEPgestcow(:,:,1), NEPlactcow(:,:,1) ,&
5312	NEPcow(:,:,1), NEMcow(:,:,1), NER(:,:,1))
5313	!Mature cows
5314	CALL balance_energy_cow(npts,dt ,&
5315	DMIcowanimal(:,:,2),MPcow2(:,:,2) ,&
5316	1, BCScow(:,:,2),tjulian,wanimalcow(:,:,2),nanimaltot,&
5317	NEBcow(:,:,2), NELherbage, EVf(:,:), DMIf(:,:,2),&
5318	EVc(:,:),Qic(:,:,2), NEIcow(:,:,2), NEIh(:,:,2), &
5319	NEIf(:,:,2), NEIc(:,:,2),& ! to check
5320	NEPgestcow(:,:,2), NEPlactcow(:,:,2) ,&
5321	NEPcow(:,:,2), NEMcow(:,:,2), NER(:,:,2))
5322
5323	!NEB of suckler calves
5324	!------------------
5325	CALL balance_energy_calf(npts,dt ,&
5326	DMIcalfanimal,milkKG,nanimaltot ,&
5327	wanimalcalf, NELherbage,NEIherbagecalf ,&
5328	NEImilkcalf, NEIcalf, NEMcalf, NEGcalf)
5329
5330
5331	ELSEIF(type_animal.EQ.4.OR.type_animal.EQ.5) THEN
5332	!NEB of heifers
5333	!------------------
5334	CALL balance_energy_heifer(npts,dt,nanimaltot,&
5335	DMIcowanimal(:,:,1),NELherbage,&
5336	EVf(:,:),DMIf(:,:,1),&
5337	wanimalcow(:,:,1),NEIcow(:,:,1),&
5338	NEIh(:,:,1), NEIf(:,:,1),type_animal)
5339	ENDIF
5340	NEBcow_prec=NEBcow
5341	nel=NELherbage
5342
5343
5344	DO j=2,nvm
5345	CALL Euler_funct (npts,dt,intake(:,j)*nel(:,j),nelgrazingsum(:,j))
5346	ENDDO
5347
5348
5349	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5350	!!!!!!!!ADD FROM Animaux_main_dynamic_post_plant
5351	!!!!!!!!
5352	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5353
5354	!!!!!! In order to get the variables that needed by Respiration_Methane and Urine_Faeces
5355	!!!!!! we need to calculate new grazingn and grazingc using intake from above
5356	!!!!!! So we call modified cal_grazing which from MODULE applic_plant to get variables needed
5357	CALL cal_grazing(&
5358	npts , &
5359	nanimaltot , &
5360	intake_animal , &
5361	wsh , &
5362	wshtot , &
5363	c , &
5364	n , &
5365	fn , &
5366	Substrate_grazingwc , &
5367	Substrate_grazingwn , &
5368	grazingcstruct , &
5369	grazingnstruct , &
5370	intake)
5371
5372	!-----------------------------------------------------------
5373	! CARBON NITROGEN BALANCE
5374	!-----------------------------------------------------------
5375
5376
5377	WHERE (nanimaltot.NE.0)
5378	grazingn = grazingnstruct + Substrate_grazingwn
5379	grazingc = grazingcstruct + Substrate_grazingwc
5380	ELSEWHERE
5381	grazingn=0
5382	grazingc=0
5383	ENDWHERE
5384	DO j=2,nvm
5385	CALL Euler_funct (npts,dt,grazingn(:,j), grazingnsum(:,j))
5386	CALL Euler_funct (npts, dt, grazingc(:,j), grazingcsum(:,j))
5387	ENDDO
5388	WanimalMOYcow = (Wanimalcow(:,:,1)*pyoung + &
5389	wanimalcow(:,:,2)*(1-pyoung) + wanimalcalf)
5390
5391	!--------------------------------
5392	!Respiration and CH4 emission
5393	!--------------------------------
5394	IF(f_CH4_methode) THEN
5395	! Calcul des emissions de methane selon N Vuichard
5396	CALL Respiration_Methane_cow(&
5397	npts, grazingc, &
5398	nanimaltot, DNDFI, wanimalMOYcow,&
5399	ranimal, methane)
5400	ELSE
5401	! Calcul des emissions de methane selon Vermorel et al 2008
5402	CALL Respiration_Methane_cow_2(npts,2,&
5403	type_animal,OMD,NEIh,NEIf,NEIc,&
5404	grazingc,nanimaltot,pyoung,&
5405	ranimal,methane,CH4animal,&
5406	MPcow2, forage_complementc,&
5407	f_complementation)
5408
5409	ENDIF
5410
5411
5412	WHERE (nanimaltot.EQ.0)
5413	methane_ani=0
5414	ELSEWHERE
5415	methane_ani=methane/nanimaltot
5416	ENDWHERE
5417	DO j=2,nvm
5418	CALL Euler_funct (npts, dt, ranimal(:,j), ranimalsum(:,j))
5419	!!! @equation animaux::ranimalsum
5420	CALL Euler_funct (npts, dt, methane(:,j), Methanesum(:,j))
5421	!!! @equation animaux::Methanesum
5422	CALL Euler_funct (npts, dt, methane_ani(:,j), Methane_aniSum(:,j))
5423	!!! @equation animaux::Methane_aniSum
5424	ENDDO
5425	!------------------
5426	!Excreta
5427	!------------------
5428	CALL Urine_Faeces_cow(&
5429	npts, grazingn, grazingc,&
5430	forage_complementc,&
5431	forage_complementn, nanimaltot ,&
5432	urineN, faecesN, &
5433	urineC, faecesC)
5434	DO j=2,nvm
5435	CALL Euler_funct (npts,dt,urineN(:,j),urineNsum(:,j))
5436	CALL Euler_funct (npts,dt,urineC(:,j),urineCsum(:,j))
5437	CALL Euler_funct (npts,dt,faecesN(:,j),faecesNsum(:,j))
5438	CALL Euler_funct (npts,dt,faecesC(:,j),faecesCsum(:,j))
5439	ENDDO
5440
5441
5442
5443	!!!History write
5444	CALL xios_orchidee_send_field("GRAZINGC",grazingc)
5445	CALL xios_orchidee_send_field("NANIMALTOT",nanimaltot)
5446	CALL xios_orchidee_send_field("INTAKE_ANIMAL",intake_animal)
5447	CALL xios_orchidee_send_field("INTAKE",intake)
5448	CALL xios_orchidee_send_field("TRAMPLING",trampling)
5449	CALL xios_orchidee_send_field("CT_DRY",ct_dry)
5450	! CALL xios_orchidee_send_field("INTAKE_ANIMAL_LITTER",intake_animal_litter)
5451	! CALL xios_orchidee_send_field("INTAKE_LITTER",intake_litter)
5452	! CALL xios_orchidee_send_field("SR_WILD",sr_wild)
5453	CALL xios_orchidee_send_field("MILK",milk)
5454	CALL xios_orchidee_send_field("MILKC",milkc)
5455	CALL xios_orchidee_send_field("METHANE",Methane)
5456	CALL xios_orchidee_send_field("RANIMAL",ranimal)
5457	CALL xios_orchidee_send_field("URINEC",urinec)
5458	CALL xios_orchidee_send_field("FAECESC",faecesc)
5459	CALL xios_orchidee_send_field("GRAZED_FRAC",grazed_frac)
5460	CALL xios_orchidee_send_field("NB_ANI",nb_ani)
5461	CALL xios_orchidee_send_field("IMPORT_YIELD",import_yield)
5462	CALL xios_orchidee_send_field("NB_GRAZINGDAYS",nb_grazingdays)
5463	CALL xios_orchidee_send_field("OUTSIDE_FOOD",outside_food)
5464
5465	!grazed
5466	CALL histwrite_p(hist_id_stomate ,'GRAZINGC',itime ,grazingc ,npts*nvm, horipft_index)
5467	CALL histwrite_p(hist_id_stomate ,'GRAZINGCSUM',itime ,grazingcsum ,npts*nvm, horipft_index)
5468	CALL histwrite_p(hist_id_stomate ,'NANIMALTOT',itime ,nanimaltot ,npts*nvm, horipft_index)
5469	CALL histwrite_p(hist_id_stomate ,'INTAKE_ANIMAL' ,itime ,intake_animal ,npts*nvm, horipft_index)
5470	CALL histwrite_p(hist_id_stomate ,'INTAKE' ,itime ,intake ,npts*nvm, horipft_index)
5471	CALL histwrite_p(hist_id_stomate ,'INTAKESUM' ,itime ,intakesum ,npts*nvm, horipft_index)
5472	CALL histwrite_p(hist_id_stomate ,'TRAMPLING' ,itime ,trampling ,npts*nvm, horipft_index)
5473	!JCADD for avoid grazing domestic over wet soil
5474	CALL histwrite_p(hist_id_stomate ,'CT_DRY' ,itime ,ct_dry ,npts*nvm, horipft_index)
5475	!milk NEW ANIMAL MODULE put in histwrite_p_cow_part1
5476
5477	CALL histwrite_p(hist_id_stomate ,'MILKSUM' ,itime ,milksum ,npts*nvm, horipft_index)
5478	CALL histwrite_p(hist_id_stomate ,'MILKCSUM' ,itime ,milkcsum ,npts*nvm, horipft_index)
5479	CALL histwrite_p(hist_id_stomate ,'MILKC' ,itime ,milkc ,npts*nvm, horipft_index)
5480	CALL histwrite_p(hist_id_stomate ,'MILKN' ,itime ,milkn ,npts*nvm, horipft_index)
5481
5482	CALL histwrite_cow_Part1(npts,DMicowanimal(:,:,1),DMIcowanimal(:,:,2),DMIcalfanimal, &
5483	pyoung,OMD,MPcow2,NEBcow, NEIcow, nanimaltot, type_animal,MPwcow2,MPpos,DMIc,DMIf)
5484
5485	!methane & respiration
5486	CALL histwrite_p(hist_id_stomate ,'METHANE',itime ,Methane ,npts*nvm, horipft_index)
5487	CALL histwrite_p(hist_id_stomate ,'METHANE_ANI',itime ,Methane_ani ,npts*nvm, horipft_index)
5488	CALL histwrite_p(hist_id_stomate ,'RANIMALSUM',itime ,ranimalsum ,npts*nvm, horipft_index)
5489	CALL histwrite_p(hist_id_stomate ,'METHANESUM',itime ,MethaneSum ,npts*nvm, horipft_index)
5490	CALL histwrite_p(hist_id_stomate ,'RANIMAL' ,itime ,ranimal ,npts*nvm, horipft_index)
5491
5492	CALL histwrite_cow_Part2(npts,CH4animal(:,:,1),CH4animal(:,:,2))
5493
5494	!farces and urine
5495	CALL histwrite_p(hist_id_stomate ,'FAECESNSUM',itime ,faecesnsum ,npts*nvm, horipft_index)
5496	CALL histwrite_p(hist_id_stomate ,'FAECESCSUM',itime ,faecescsum ,npts*nvm, horipft_index)
5497	CALL histwrite_p(hist_id_stomate ,'URINECSUM' ,itime ,urinecsum ,npts*nvm, horipft_index)
5498	CALL histwrite_p(hist_id_stomate ,'URINENSUM' ,itime ,urinensum ,npts*nvm, horipft_index)
5499	CALL histwrite_p(hist_id_stomate ,'NEL' ,itime ,nel ,npts*nvm, horipft_index)
5500	CALL histwrite_p(hist_id_stomate ,'URINEN' ,itime ,urinen ,npts*nvm, horipft_index)
5501	CALL histwrite_p(hist_id_stomate ,'URINEC' ,itime ,urinec ,npts*nvm, horipft_index)
5502	CALL histwrite_p(hist_id_stomate ,'FAECESC' ,itime ,faecesc ,npts*nvm, horipft_index)
5503	CALL histwrite_p(hist_id_stomate ,'FAECESN' ,itime ,faecesn ,npts*nvm, horipft_index)
5504
5505	CALL histwrite_p(hist_id_stomate ,'GRAZED_FRAC' ,itime ,grazed_frac ,npts*nvm, horipft_index)
5506	CALL histwrite_p(hist_id_stomate ,'NB_ANI' ,itime ,nb_ani ,npts*nvm, horipft_index)
5507	CALL histwrite_p(hist_id_stomate ,'IMPORT_YIELD' ,itime ,import_yield ,npts*nvm, horipft_index)
5508	CALL histwrite_p(hist_id_stomate ,'EXTRA_FEED' ,itime ,extra_feed ,npts*nvm, horipft_index)
5509	CALL histwrite_p(hist_id_stomate ,'COMPT_UGB',itime ,compt_ugb ,npts*nvm, horipft_index)
5510	CALL histwrite_p(hist_id_stomate ,'NB_GRAZINGDAYS',itime ,nb_grazingdays ,npts*nvm, horipft_index)
5511	CALL histwrite_p(hist_id_stomate ,'AMOUNT_YIELD',itime ,amount_yield,npts*nvm,horipft_index)
5512	CALL histwrite_p(hist_id_stomate ,'CONSUMP',itime ,consump,npts*nvm,horipft_index)
5513	CALL histwrite_p(hist_id_stomate ,'ADD_NB_ANI',itime ,add_nb_ani,npts*nvm,horipft_index)
5514	CALL histwrite_p(hist_id_stomate ,'OUTSIDE_FOOD',itime ,outside_food,npts*nvm,horipft_index)
5515
5516	!
5517	END SUBROUTINE Animaux_main_dynamic
5518
5519
5520
5521
5522
5523	!********************************************
5524	!********************************************
5525	! SUBROUTINE OF cow ANIMAL MODEL
5526	!********************************************
5527	!********************************************
5528
5529	!----------------------------------
5530	! 1 - intake capacity
5531	!----------------------------------
5532	!*suckler Cow
5533	SUBROUTINE intake_capacity_cow( &
5534	npts, wanimalcow, MPwcow2,BCScow , &
5535	nanimaltot, ICcow)
5536
5537	INTEGER, INTENT(in) :: npts
5538	! Number of spatial points (-)
5539	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: wanimalcow
5540	! Animal liveweight (kg/animal) (young:1, adult:2)
5541	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwcow2
5542	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
5543	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: BCScow
5544	! Body score condition cow (young in first, and adult in second) (/5)
5545	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
5546	! Stocking rate (animal m-2)
5547	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: ICcow
5548	! Cow intake capacity of primiparous or multiparous cows(kg/animal/d)
5549
5550	INTEGER :: i,j !for loop
5551
5552	ICcow= 3.2+0.015wanimalcow+0.25MPwcow2-(0.002wanimalcow((BCScow-2.5)))
5553	DO j=2,nvm
5554	DO i=1,npts
5555	IF (nanimaltot(i,j) .EQ. 0.0) THEN
5556	ICcow(i,j,:)= REAL(0.0,r_std )
5557	ENDIF
5558	ENDDO
5559	END DO
5560	ENDSUBROUTINE intake_capacity_cow
5561
5562	! Suckler Calf
5563
5564	SUBROUTINE intake_capacity_calves(&
5565	npts, wanimalcalf ,&
5566	nanimaltot, tjulian, ICcalf)
5567
5568	INTEGER, INTENT(in) :: npts
5569	! Number of spatial points (-)
5570	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wanimalcalf
5571	! Calf liveweigth (kg/animal)
5572	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
5573	! Stocking rate (animal m-2)
5574	INTEGER(i_std ), INTENT(in) :: tjulian
5575	! Julian day (-)
5576	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: ICcalf
5577	! Calf intake capacity (kg/animal/d)
5578
5579	INTEGER, DIMENSION(npts,nvm) :: dsevrage
5580	! Julian day of the suckling calf period
5581
5582	INTEGER :: i,j !for loop
5583
5584	dsevrage=tcalving+tsevrage
5585	DO j=2,nvm
5586	DO i=1,npts
5587	IF (tjulian.GT.dsevrage(i,j)) THEN
5588	ICcalf(i,j) = 0.0345(wanimalcalf(i,j)*0.9)
5589	ELSE
5590	IF (dsevrage(i,j).GT.365) THEN
5591	IF (tjulian.GT.dsevrage(i,j)-365.AND.tjulian.LT.tcalving(i,j)) THEN
5592	ICcalf(i,j)=0.0345(wanimalcalf(i,j)*0.9)
5593	ELSE
5594	ICcalf(i,j)= 0.0559exp(5.28(1-exp(-0.00703*wanimalcalf(i,j))))
5595	ENDIF
5596	ELSE
5597	ICcalf(i,j)= 0.0559exp(5.28(1-exp(-0.00703*wanimalcalf(i,j))))
5598	ENDIF
5599	ENDIF
5600	ENDDO
5601	END DO
5602	WHERE (nanimaltot.EQ.REAL(0.0,r_std ))
5603	ICcalf=REAL(0.0,r_std )
5604	ENDWHERE
5605
5606	ENDSUBROUTINE intake_capacity_calves
5607
5608	! Dairy Cow
5609	SUBROUTINE intake_capacity_cow_d(&
5610	npts,npta, &
5611	MPwcow2 ,&
5612	BCS, wanimalcow, nanimaltot, IC_animal,&
5613	AGE_animal, nWeekLact,nWeekGest)
5614
5615	INTEGER, INTENT(in) :: npts
5616	! Number of spatial points (-)
5617	INTEGER, INTENT(in) :: npta
5618	! equal 2 when cow (Young and old) and 1 when calf
5619	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPwcow2
5620	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
5621	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: BCS
5622	! Body Condition Score (for cow only /5)
5623	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: wanimalcow
5624	! Animal liveweight (kg/animal) (young:1, adult:2)
5625	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
5626	! Stocking rate (animal m-2)
5627	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: IC_animal
5628	! intake Capacity (Kg)
5629	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: AGE_animal
5630	! Animal age in case of simulation of dairy cows (months)
5631	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nWeekLact
5632	! Lactation week (in weeks from calving)
5633	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nWeekGest
5634	! Gestation week (in weeks from mating)
5635
5636	REAl(r_std ),DIMENSION(npts,nvm,npta) :: IL
5637	! Lactation Index
5638	REAL(r_std ),DIMENSION(npts,nvm) :: IG
5639	! Gestation Index
5640	REAL(r_std ),DIMENSION(npts,nvm,npta) :: IM
5641	! Maturity Index
5642
5643	!Lactation Indice computation
5644	IL(:,:,1)=0.6+(0.4)(1-exp(-0.16NWeekLact))
5645	IL(:,:,2)=0.7+(0.3)(1-exp(-0.16NWeekLact))
5646	IG=0.8+0.2(1-exp(-0.25(40-NWeekGest)))
5647	IM=-0.1+1.1(1-exp(-0.08AGE_animal))
5648
5649	Ic_animal(:,:,1)= (13.9+(0.015*(Wanimalcow(:,:,1)-600))+&
5650	(0.15MPwcow2(:,:,1))+(1.5(3-BCS(:,:,1))))IL(:,:,1)IG*IM(:,:,1)
5651	Ic_animal(:,:,2)= (13.9+(0.015*(Wanimalcow(:,:,2)-600))+&
5652	(0.15MPwcow2(:,:,2))+(1.5(3-BCS(:,:,2))))IL(:,:,2)IG*IM(:,:,2)
5653
5654	!Ingestion allaitante - test
5655	!Ic_animal(:,1)=3.2+0.015Wanimalcow(:,1)+0.25MPwcow2(:,1)-(0.002wanimalcow(:,1)((BCS(:,1)-2.5)))
5656	!Ic_animal(:,2)=3.2+0.015Wanimalcow(:,2)+0.25MPwcow2(:,2)-(0.002wanimalcow(:,2)((BCS(:,2)-2.5)))
5657	!print*, Ic_animal(:,1)
5658	!print*, Ic_animal(:,2)
5659
5660	WHERE (nanimaltot .EQ. 0.0)
5661	Ic_animal(:,:,1)=0.
5662	Ic_animal(:,:,2)=0.
5663	END WHERE
5664
5665
5666	ENDSUBROUTINE intake_capacity_cow_d
5667
5668	! Heifer
5669	! Equations from INRA feed tables 2007 p.75
5670	!------------------------------------------
5671	SUBROUTINE intake_capacity_heifer(&
5672	npts, type_animal,winit,wanimalcow,IC_animal)
5673	INTEGER, INTENT(in) :: npts
5674	! Number of spatial points (-)
5675	INTEGER, INTENT(in) :: type_animal
5676	! 1: Dairy cows, 2: Suckler cows, 3: Old module, 4: Dairy heifers, 5 : Suckler heifers
5677	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: winit
5678	! Initial live weigth of heifer
5679	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wanimalcow
5680	! Animal liveweight (kg/animal) (young:1, adult:2)
5681	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: IC_animal
5682	! Heifer intake capacity
5683
5684	! variable local
5685	REAL(r_std ), DIMENSION(npts,nvm) :: P1
5686	! Parameter for IC calculation
5687	REAL(r_std ), DIMENSION(npts,nvm) :: itype
5688	! Parameter for IC calculation
5689
5690	itype=0.
5691	P1=0.
5692
5693	WHERE(winit.LT.150)
5694	P1=0.2
5695	ELSEWHERE(winit.LT.300)
5696	P1=0.1
5697	ENDWHERE
5698
5699	IF(type_animal.EQ.1) THEN
5700	itype=0.039 ! Dairy heifers
5701	ELSE
5702	itype=0.03275 ! Suckler heifers
5703	ENDIF
5704
5705	IC_animal=itype(wanimalcow*0.9)+ P1
5706	!
5707	ENDSUBROUTINE intake_capacity_heifer
5708
5709
5710	!----------------------------------
5711	! 2 - intake
5712	!----------------------------------
5713
5714	SUBROUTINE Grazing_intake_cow(&
5715	npts, type_animal, wshtot ,&
5716	tadmin,nanimaltot,DNDF ,&
5717	NDF,IC ,&
5718	DMIanimal ,&
5719	OMD, tadmoy, FVh, ntot ,&
5720	tmoy_14, BM_threshold)
5721
5722	! declarations :
5723
5724	INTEGER, INTENT(in) :: npts
5725	! Number of spatial points (-)
5726	INTEGER, INTENT(in) :: type_animal
5727	! 1 or 2 or 4 or 5= > new module animal
5728	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wshtot
5729	! Shoot structural dry matter (kg m-2)
5730	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmin
5731	! Daily minimum temperature
5732	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: nanimaltot
5733	! Stocking rate (animal m-2)
5734	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DNDF
5735	! fraction of digestible fibres in total fibres (-)
5736	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: NDF
5737	! fraction of fibres in the intake(-)
5738	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: IC
5739	! intake capacity (Kg)
5740	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: DMIanimal
5741	! Dry Matter intake of a cow/calf (Kg)
5742	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: OMD
5743	! Digestible organic matter in the intake(kg/kg)
5744	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmoy
5745	! Daily average temperature (K)
5746	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: FVh
5747	! Herbage Fill Value (UE)
5748	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: ntot
5749	! nitrogen substrate concentration in plant,(kg n/kg)
5750	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tmoy_14
5751	! 14 day running average of daily air temperature (K)
5752	REAL(r_std ), INTENT(in) :: BM_threshold
5753	! Biomass threshold above which animals are moved out the paddock (kg/m2)
5754	!implicit variables intent(in) :
5755	! - AnimalqintakeM : intake parameter (m2 m-2)
5756
5757	!Local variables
5758	INTEGER :: i,j
5759	REAL(r_std ), DIMENSION(npts,nvm) :: NDFnd
5760	! fraction of non digestible fibres in the intake(g/Kg)
5761	REAL(r_std ), DIMENSION(npts) :: temperature_effect_OMD
5762	! temperature effect on organic matter digestibility (-)
5763
5764
5765	! Fraction of non digestible fibres in the intake(g/Kg)
5766	!-------------------------
5767	NDFnd=NDF(1-DNDF)1000
5768
5769	! Digestible organic matter in the intake (kg/kg)
5770	!-------------------------
5771	OMD=(89.49-0.1102*NDFnd)/100
5772
5773	!Temperature effect of herbage digestible organic matter
5774	!-------------------------
5775	temperature_effect_OMD=min(0.1,max(-0.1,(tmoy_14-t_seuil_OMD)*0.00645))
5776	DO j=2,nvm
5777	OMD(:,j)=max(0.4,min(1.0, OMD(:,j) - temperature_effect_OMD))
5778	END DO
5779	! Herbage fill value of the diet
5780	!-------------------------
5781	IF (type_animal.EQ.2) THEN
5782	FVh=95/(-13.9+145*OMD) ! suckler cows
5783	ELSE
5784	! Adapté de l'equation QIB des tables INRA 2007 p.177
5785	! sous hypothèse de prairies permanentes
5786	! et d'un coefficient de MS de 20%
5787	! MAT[g/kg]6.251000=ntot[kgN/kg]
5788	FVh=95/(6.44+65.5OMD+700.0ntot+13.58)! suckler or dairy heifers
5789	END IF
5790
5791	! Herbage dry matter intake without supplementation
5792	!-------------------------
5793	DO j=2,nvm
5794	! DO i=1,npts
5795	!JCMODIF new threshold
5796	! IF(((wshtot(i,j).GT.BM_threshold).OR.f_complementation.EQ.4).and.(nanimaltot(i,j).NE.0)) THEN
5797	WHERE(((wshtot(:,j).GT.able_grazing(:,j)).OR.&
5798	f_complementation.EQ.4).and.(nanimaltot(:,j).NE.0))
5799	!ENDJCMODIF
5800	!Dry Matter intake of a cow/calf
5801	!JCMODIF
5802	! DMIanimal(:,j)=(IC(:,j)/FVh(:,j))(1-exp(-0.0012wshtot(i,j)*10000))
5803	DMIanimal(:,j)=IC(:,j)
5804	!ENDJCMODIF
5805	! IF (f_temperature_DMI)THEN
5806	! WHERE ((tadmoy(:)>298.15).and.(tadmin(:)>295.15))
5807	! DMIanimal(:,j)=DMIanimal(:,j)(1-0.02(tadmoy(:)-298.15))
5808	! ENDWHERE
5809	! ENDIF
5810	ELSEWHERE
5811	DMIanimal(:,j) = 0.0
5812	!06/02/2010 AIG & MG
5813	WHERE (nanimaltot(:,j).NE.0.and.f_autogestion.NE.2)
5814	nanimaltot(:,j) = 0.0
5815	! print*, 'WARNING : unsufficient biomass -> cows have been moved out'
5816	ENDWHERE
5817	ENDWHERE
5818	! ENDDO
5819	END DO
5820	ENDSUBROUTINE Grazing_intake_cow
5821
5822
5823	!dairy
5824	SUBROUTINE Grazing_intake_cow_d(&
5825	npts, npta ,&
5826	ntot,nanimaltot,DNDF ,&
5827	NDF,IC,tadmin,tadmoy ,&
5828	DMIanimal, OMD, wshtot, FVh ,&
5829	tmoy_14,BM_threshold)
5830
5831	! declarations :
5832
5833	INTEGER, INTENT(in) :: npts
5834	! Number of spatial points (-)
5835	INTEGER, INTENT(in) :: npta
5836	! equal 2 for primi and multipare
5837	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: wshtot
5838	! Shoot structural dry matter (kg m-2)
5839	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: ntot
5840	! nitrogen substrate concentration in plant,(kg n/kg)
5841	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: nanimaltot
5842	! Stocking rate (animal m-2)
5843	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DNDF
5844	! fraction of digestible fibres in total fibres (-)
5845	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: NDF
5846	! fraction of fibres in the intake(-)
5847	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: IC
5848	! intake capacity (Kg)
5849	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmin
5850	! Daily minimum temperature
5851	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tadmoy
5852	! Daily average temperature
5853	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: DMIanimal
5854	! Dry Matter intake of a cow/calf (Kg)
5855
5856	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: OMD
5857	! Digestible organic matter in the intake(kg/kg)
5858	REAL(r_std ),DIMENSION(npts,nvm) , INTENT(out) :: FVh
5859	! Herbage fill value (UE)
5860	REAL(r_std ), DIMENSION(npts), INTENT(in) :: tmoy_14
5861	! 14 day running average of daily air temperature (K)
5862	REAL(r_std ), INTENT(in) :: BM_threshold
5863	! Biomass threshold above which animals are moved out the paddock (kg/m2)
5864	!Local variables
5865	REAL(r_std ),DIMENSION(npts,nvm) :: NDFnd
5866	! fraction of non digestible fibres in the intake(g/Kg)
5867	!06/02/2010 AIG & MG
5868	LOGICAL,DIMENSION(npts,nvm) :: Bool_movedout
5869	! Bolean to decide to move out animal
5870
5871	INTEGER :: i,j
5872
5873	REAL(r_std ),DIMENSION(npts) :: temperature_effect
5874	! temperature effect on dry matter intake (-)
5875	REAL(r_std ),DIMENSION(npts) :: temperature_effect_OMD
5876	! temperature effect on organic matter digestibility (-)
5877
5878
5879	! DO i=1,npts
5880	WHERE ((f_temperature_DMI.AND.tadmoy(:).GT.298.15).AND.(tadmin(:).GT.295.15))
5881	temperature_effect(:)= 1-0.02*(tadmoy(:)-298.15)
5882	ELSEWHERE
5883	temperature_effect(:)= 1.0
5884	ENDWHERE
5885	! END DO
5886
5887	!bool_movedout=0
5888	! Fraction of non digestible fibres in the intake(g/Kg)
5889	!-------------------------
5890	NDFnd=NDF(1-DNDF)1000
5891
5892	! Herbage digestible organic matter (g/g)
5893	!-------------------------
5894	OMD=(89.49-0.1102*NDFnd)/100
5895
5896	!Temperature effect of herbage digestible organic matter
5897	!-------------------------
5898	temperature_effect_OMD=min(0.1,max(-0.1,(tmoy_14-t_seuil_OMD)*0.00645))
5899	DO j=2,nvm
5900	OMD(:,j)=max(0.4,min(1.0, OMD(:,j) - temperature_effect_OMD))
5901	END DO
5902
5903	! Herbage fill value (UE)
5904	!-------------------------
5905	! Adapté de l'equation QIL des tables INRA 2007 p.177
5906	! sous hypothèse de prairies permanentes
5907	! et d'un coefficient de MS de 20%
5908	! MAT[g/kg]6.251000=ntot[kgN/kg]
5909
5910	FVh=140/(66.3+65.5OMD+612.5ntot+12.52)
5911
5912	!06/02/2010 AIG & MG
5913	bool_movedout=.FALSE.
5914
5915	!Cow dry Matter intake
5916	!-------------------------
5917	!06/02/2010 AIG & MG
5918
5919	DO j=2,nvm
5920	!JCMODIF new threshold
5921	! WHERE((nanimaltot(:,j).NE.0).AND.((wshtot(:,j).GT.BM_threshold).OR.(f_complementation.EQ.4)))
5922	WHERE((nanimaltot(:,j).NE.0).AND.&
5923	((wshtot(:,j).GT.able_grazing(:,j)).OR.(f_complementation.EQ.4)))
5924	!ENDJCMODIF
5925	!WHERE(nanimaltot.NE.0)
5926	! On calcule l'ingestion avec la limitation de la disponibilité en herbe proposée par
5927	! Jouven et al 2008
5928	!JCMODIF
5929	! DMIanimal(:,j,1)=(IC(:,j,1)/FVh(:,j))(1-16.95exp(-0.00275wshtot(:,j)10000))
5930	! DMIanimal(:,j,2)=(IC(:,j,2)/FVh(:,j))(1-16.95exp(-0.00275wshtot(:,j)10000))
5931	DMIanimal(:,j,1)=IC(:,j,1)
5932	DMIanimal(:,j,2)=IC(:,j,2)
5933	!ENDJCMODIF
5934	! Temperature effect on DMI
5935	! (Freer et al 1997)
5936	!-------------------------
5937	! WHERE ((tadmoy>298.15).and.(tadmin>295.15))
5938	! DMIanimal(:,j,1)=DMIanimal(:,j,1)*temperature_effect
5939	! DMIanimal(:,j,2)=DMIanimal(:,j,2)*temperature_effect
5940	! ENDWHERE
5941	ELSEWHERE
5942	DMIanimal(:,j,1) = 0.0
5943	DMIanimal(:,j,2) = 0.0
5944	!06/02/2010 AIG & MG
5945	!nanimaltot = 0.0
5946	bool_movedout(:,j)=.TRUE.
5947	ENDWHERE
5948	ENDDO
5949	IF(ANY(DMIanimal(:,:,:).LT.0)) THEN
5950	STOP "Herbage ingestion is negative"
5951	ENDIF
5952
5953	!06/02/2010 AIG & MG
5954	DO j=2,nvm
5955	! DO i=1,npts
5956	! en autogestion on ne sort qu'en début de journée
5957	WHERE(bool_movedout(:,j) .AND. nanimaltot(:,j) .NE. 0.0 .AND. f_autogestion .NE. 2)
5958	! print*,'WARNING : unsufficient biomass -> cows have been moved out. Pixel '
5959	nanimaltot(:,j)=0.0
5960	bool_movedout(:,j)=.FALSE.
5961	ENDWHERE
5962	! ENDDO
5963	END DO
5964
5965	ENDSUBROUTINE Grazing_intake_cow_d
5966
5967	SUBROUTINE grazing_intake_complementation(npts,dt ,&
5968	DMIcowanimal, FVh, ICcow, FVf ,&
5969	MPcow2,MPwcow2,Forage_quantity_period,&
5970	QIc, NELherbage, EVf,nanimaltot ,&
5971	DMIcowsum,DMIcowanimalsum ,&
5972	DMIcow,DMIcowNsum,n,fn,pyoung ,&
5973	type_animal,intake_tolerance ,&
5974	Q_max_complement,forage_complementc ,&
5975	NER,forage_complementn,NEI,NEM,NEIh ,&
5976	NEIf,NEIC,NEG,f_complementation,DMIc ,&
5977	DMIf)
5978
5979	INTEGER, INTENT(in) :: npts
5980	! Number of spatial points (-)
5981	REAL(r_std ), INTENT(in) :: dt
5982	! Time step (d)
5983	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: DMIcowanimal
5984	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
5985	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: FVh
5986	! Herbage Fill Value (UE)
5987	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: ICcow
5988	! Cow intake capacity of primiparous or multiparous cows(kg/animal/d)
5989	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: FVf
5990	! forage fill value (Kg)
5991	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPcow2
5992	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
5993	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwcow2
5994	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
5995	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(inout) :: forage_quantity_period
5996	! Daily forage quantity provided to herbivors during the current stocking period (Kg/Animal/d)
5997	REAL(r_std ), DIMENSION(npts,nvm,2) , INTENT(inout) :: QIc
5998	! Daily concentrate quantity per kg of milk or per kg of lw
5999	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: NELherbage
6000	! Energetic content of the herbage (MJ/kg)
6001	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: EVf
6002	! Energetic content of the forage (MJ/Kg)
6003	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
6004	! Stocking rate (animal/m²)
6005	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: DMIcowsum
6006	! Cumulated intake per m2 for primiparous or multiparous cows(kg/m2)
6007	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: DMIcowanimalsum
6008	! Cumulated animal intake for primiparous or multiparous cows(kg/animal)
6009	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIcow
6010	! Daily intake per m2 for primiparous or multiparous cows(kg/m2/d)
6011	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIcowNsum
6012	! N in daily intake per m2 for primiparous or multiparous cows(kgN/m2)
6013	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: n
6014	! nitrogen substrate concentration in plant,(kg n/kg)
6015	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: fn
6016	! nitrogen in structural dry matter
6017	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: pyoung
6018	! Fraction of young or primiparous in the cattle (-)
6019	INTEGER , INTENT(in) :: type_animal
6020	! kind of herbivores (1: dairy cows, 2 suckler cows+calf, 3 old module, 4 dairy heifers, 5 suckler heifers)
6021	REAL(r_std ) , INTENT(in) :: intake_tolerance
6022	! intake tolerance threshold (-)
6023	REAL(r_std ) , INTENT(in) :: Q_max_complement
6024	! Maximum quantity of forage or concentrate to supplement animals when auto-supplementation (kg)
6025	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NER
6026	! Net energy requirement (MJ)
6027	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: forage_complementc
6028	! fraction of carbon in Forage + concentrate (kgC/m²/d)
6029	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: forage_complementn
6030	! fraction of nitrogen in Forage + concentrate (kgC/m²/d)
6031	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: NEI
6032	! Net energy intake(MJ)
6033	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: NEM
6034	! Net energy requirements for maintenance(MJ)
6035	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: NEIh
6036	! Net Energy intake from ingested herbage(MJ)
6037	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: NEIf
6038	! Net Energy intake from ingested forage(MJ)
6039	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: NEIc
6040	! Net Energy intake from ingested concentrate(MJ)
6041	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEG
6042	! Net energy required for gestation (MJ)
6043	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIc
6044	! Concentrate intake (kg/animal/d)
6045	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIf
6046	! forage intake (kg/animal/d)
6047
6048	!local variables
6049	REAL(r_std ), DIMENSION(npts,nvm,2) :: Shf
6050	! substitution rate of herbage by forage in the cow diet (-)
6051	REAL(r_std ), DIMENSION(npts,nvm,2) :: Shc1
6052	! substitution rate of herbage by concentrate in the cow diet (-)
6053	REAL(r_std ), DIMENSION(npts,nvm,2) :: Shc2
6054	! substitution rate of herbage by concentrate in the cow diet (-)
6055	REAL(r_std ), DIMENSION(npts,nvm,2) :: Shfc
6056	! substitution rate of herbage by concentrate in the cow diet (-)
6057	REAL(r_std ), DIMENSION(npts,nvm,2) :: EDhf
6058	! substitution rate of herbage by concentrate in the cow diet (-)
6059	REAL(r_std ), DIMENSION(npts,nvm,2) :: A
6060	! intermediary variable
6061
6062	REAL(r_std ), DIMENSION(npts,nvm) :: ICmoy
6063	! Average intake capacity of the cattle [kg MS/animal/d]
6064	REAL(r_std ), DIMENSION(npts,nvm) :: DMImoy
6065	! Average dry matter intake of the cattle [kg MS/animal/d]
6066
6067	REAL(r_std ), DIMENSION(npts,nvm,2) :: temp
6068	! temporary variable
6069	INTEGER, INTENT(in) :: f_complementation
6070	! Flag to activate cow supplementation
6071
6072	INTEGER :: i=0
6073	INTEGER :: k=0 ! 1 : primipare/young, 2: multipare/mature
6074	INTEGER :: j
6075	DMIc=0.0
6076	DMIf=0.0
6077	DO j=2,nvm
6078	IF(f_complementation.EQ.1.OR.f_complementation.EQ.3) THEN
6079	!supplementation with forage only or with forage and concentrate
6080
6081	IF(f_complementation.EQ.3) THEN !supplementation with forage and concentrate
6082	DO i=1,npts
6083	DO k=1,2
6084	IF(nanimaltot(i,j).GT.0) THEN
6085	!DMIc(i,j)=QIc(i)*MPcow2(i,j)
6086	DMIc(i,j,k)=QIc(i,j,k)*MPwcow2(i,j,k)
6087	EDhf(i,j,k)=(DMIcowanimal(i,j,k)*NELherbage(i,j)/7.12+&
6088	Forage_quantity_period(i,j)EVf(i,j))/(DMIcowanimal(i,j,k)&
6089	FVh(i,j)+Forage_quantity_period(i,j)*FVf(i,j))
6090	A(i,j,k)=(0.0004MPwcow2(i,j,k)2)+(2.39(EDhf(i,j,k))**2)-&
6091	(0.0452MPwcow2(i,j,k)(EDhf(i,j,k)))
6092	Shfc(i,j,k)=0.11+(0.02DMIc(i,j,k))-(1.13(EDhf(i,j,k))**2)+&
6093	A(i,j,k)((DMIcowanimal(i,j,k)FVh(i,j)+Forage_quantity_period(i,j)*&
6094	FVf(i,j))/ICcow(i,j,k))
6095	DMIcowanimal(i,j,k)=DMIcowanimal(i,j,k)-SHfc(i,j,k)*DMIc(i,j,k)
6096	ELSE
6097	DMIcowanimal(i,j,k)=0.0
6098	ENDIF
6099	ENDDO
6100	ENDDO
6101	ENDIF
6102	DO i=1,npts
6103	DO k=1,2
6104	IF(nanimaltot(i,j).GT.0) THEN
6105	Shf(i,j,k)=((DMIcowanimal(i,j,k)FVh(i,j))/ICcow(i,j,k))&
6106	(2.2-1.2*(FVh(i,j)/FVf(i,j)))
6107	DMIcowanimal(i,j,k)=DMIcowanimal(i,j,k)-Shf(i,j,k)*&
6108	Forage_quantity_period(i,j)
6109	DMIf(i,j,k)=Forage_quantity_period(i,j)
6110	ELSE
6111	DMIcowanimal(i,j,k)=0.0
6112	ENDIF
6113	ENDDO
6114	ENDDO
6115
6116	ELSEIF(f_complementation.EQ.2) THEN !supplementation with concentrate only
6117	DO i=1,npts
6118
6119	DO k=1,2
6120	IF(nanimaltot(i,j).GT.0) THEN
6121	!DMIc(i,j)=QIc(i)*MPcow2(i,j)
6122	DMIc(i,j,k)=QIc(i,j,k)*MPwcow2(i,j,k)
6123	A(i,j,k)=(0.0004MPwcow2(i,j,k)2)+(2.39(NELherbage(i,j)/&
6124	(7.12FVh(i,j)))2)-(0.0452MPwcow2(i,j,k)(NELherbage(i,j)/(7.12FVh(i,j))))
6125	Shc1(i,j,k)=0.8+0.01*DMIc(i,j,k)
6126	shc2(i,j,k)=0.11+(0.02DMIc(i,j,k))-(1.13(NELherbage(i,j)/&
6127	(7.12FVh(i,j)))2)+A(i,j,k)((DMIcowanimal(i,j,k)*FVh(i,j))/ICcow(i,j,k))
6128	DMIcowanimal(i,j,k)=DMIcowanimal(i,j,k)-min(Shc1(i,j,k),Shc2(i,j,k))&
6129	*DMIc(i,j,k)
6130	ENDIF
6131	ENDDO
6132	ENDDO
6133
6134
6135	ELSEIF(f_complementation.eq.4) THEN !auto-supplementation
6136
6137	IF(type_animal.EQ.1) THEN !dairy supplementation with concentrate
6138	CALL auto_complementation_dairy(npts,dmicowanimal,fvh,iccow,NER,nelherbage, evf,Q_max_complement,DMIc,MPcow2_prec,&
6139	MPwcow2,NEI,NEM,NEIh,NEIf,NEIc,NEG,nanimaltot)
6140
6141	ELSEIF(type_animal.eq.2) THEN !suckler supplementation with forage
6142	CALL auto_complementation_suckler(npts,dmicowanimal,fvh,iccow,NER ,&
6143	nelherbage,evf,fvf,Q_max_complement,&
6144	DMIf,nanimaltot,intake_tolerance)
6145
6146	Forage_quantity_period(:,:)=DMIf(:,:,1)pyoung+DMIf(:,:,2)(1-pyoung)
6147	ENDIF
6148	ENDIF
6149	END DO
6150	WHERE(nanimaltot(:,:).EQ.0)
6151	DMIc(:,:,1)=0.0
6152	DMIc(:,:,2)=0.0
6153	DMIf(:,:,1)=0.0
6154	DMIf(:,:,2)=0.0
6155	ENDWHERE
6156
6157	! AIG 04/03/2010 Le calcul de l'ingéré par m2 ne prend par en compte la proportion
6158	! pyoung pour les génisses
6159
6160	IF(type_animal.EQ.4.OR.type_animal.EQ.5) THEN
6161	DMIcow(:,:,1) = DMIcowanimal(:,:,1) * nanimaltot(:,:)
6162	DMIcow(:,:,2) = 0.0
6163	ICcow(:,:,2) = 0.0
6164	ELSE
6165	DMIcow(:,:,1) = DMIcowanimal(:,:,1) * nanimaltot(:,:) *pyoung(:,:)
6166	DMIcow(:,:,2) = DMIcowanimal(:,:,2) * nanimaltot(:,:) *(1-pyoung(:,:))
6167	ENDIF
6168	DO j=2,nvm
6169	CALL Euler_X(npts,2, dt, DMIcow(:,j,:), DMIcowsum(:,j,:))
6170
6171	CALL Euler_X(npts,2, dt, DMIcowanimal(:,j,:), DMIcowanimalsum(:,j,:))
6172
6173	temp(:,j,1)=DMIcow(:,j,1)*(n(:,j)+fn(:,j))
6174	temp(:,j,2)=DMIcow(:,j,2)*(n(:,j)+fn(:,j))
6175
6176	CALL Euler_X(npts,2, dt, temp(:,j,:), DMIcowNsum(:,j,:))
6177
6178
6179	WHERE(nanimaltot(:,j).GT.0.AND.f_complementation.LT.4)
6180	forage_complementc(:,j)=0.60*((forage_quantity_period(:,j)+&
6181	DMIc(:,j,1))*pyoung(:,j) + (forage_quantity_period(:,j)+DMIc(:,j,2))&
6182	(1-pyoung(:,j)))nanimaltot(:,j)
6183	forage_complementn(:,j)=((fN_forage(:,j)*forage_quantity_period(:,j)+&
6184	fN_concentrate(:,j)DMIc(:,j,1))pyoung(:,j)+ &
6185	(fN_forage(:,j)*forage_quantity_period(:,j)+&
6186	fN_concentrate(:,j)DMIc(:,j,2))(1-pyoung(:,j)))*nanimaltot(:,j)
6187	ELSEWHERE(nanimaltot(:,j).GT.0.AND.f_complementation.EQ.4)
6188	forage_complementc(:,j)=0.60((DMIf(:,j,1)+DMIc(:,j,1))pyoung(:,j) +&
6189	(DMIF(:,j,2)+DMIc(:,j,2))(1-pyoung(:,j)))nanimaltot(:,j)
6190	forage_complementn(:,j)=((fN_forage(:,j)*DMIf(:,j,1)+&
6191	fN_concentrate(:,j)DMIc(:,j,1))pyoung(:,j) +&
6192	(fN_forage(:,j)DMIf(:,j,2)+fN_concentrate(:,j)&
6193	DMIc(:,j,2))(1-pyoung(:,j)))nanimaltot(:,j)
6194	ELSEWHERE
6195	forage_complementc(:,j)=0.0
6196	forage_complementn(:,j)=0.0
6197	ENDWHERE
6198
6199
6200	CALL Euler_funct (npts,dt,forage_complementc(:,j),forage_complementcsum(:,j))
6201	CALL Euler_funct (npts,dt,forage_complementn(:,j),forage_complementnsum(:,j))
6202	ENDDO
6203	ENDSUBROUTINE grazing_intake_complementation
6204
6205
6206
6207	!Routine permettant de calculer la complémentation automatique des vaches laitières
6208
6209	SUBROUTINE auto_complementation_dairy(npts,DMIcowanimal,FVh,ICcow,NER,NELherbage, EVc,&
6210	Q_max_complement,DMIc,MPcow2,MPwcow2,NEI,NEM,NEIh,&
6211	NEIf,NEIC,NEG,nanimaltot)
6212
6213	INTEGER, INTENT(in) :: npts
6214	! Number of spatial points (-)
6215	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: DMIcowanimal
6216	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
6217	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: FVh
6218	! Herbage Fill Value (UE)
6219	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: ICcow
6220	! Cow intake capacity of primiparous or multiparous cows(kg/animal/d)
6221	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NER
6222	! Net energy requirement (MJ)
6223	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: NELherbage
6224	! Energetic content of the herbage (MJ/kg)
6225	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: EVc
6226	! Energetic value of the forage (MJ/kg)
6227	REAL(r_std ) , INTENT(in) :: Q_max_complement
6228	! Maximum quantity of forage or concentrate to supplement animals when auto-supplementation (kg)
6229	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIc
6230	! Forage quantity calculated by the model (kg/animal/d)
6231	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPcow2
6232	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6233	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwcow2
6234	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6235	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: NEI
6236	! Net energy intake(MJ)
6237	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: NEM
6238	! Net energy requirements for maintenance (MJ)
6239	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: NEIh
6240	! Net Energy intake from ingested herbage(MJ)
6241	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: NEIf
6242	! Net Energy intake from ingested forage(MJ)
6243	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: NEIc
6244	! Net Energy intake from ingested concentrate(MJ)
6245	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEG
6246	! Net energy required for gestation
6247	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
6248	! Stocking rate (animal/m²)
6249
6250
6251	!local variables
6252	REAL(r_std ), DIMENSION(npts,nvm,2) :: Shc1,shc2,shc
6253	! Substitution rate of herbage by concentrate in the cow diet (-)
6254	REAL(r_std ), DIMENSION(npts,nvm,2) :: A
6255	! Intermediary variable
6256	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPpos_loc
6257	! Possible milk production (local) (Kg/UGB)
6258	REAL(r_std ), DIMENSION(npts,nvm,2) :: Qic
6259	! Quantité de concentré ingéré par Kg de lait
6260	REAL(r_std ), DIMENSION(npts,nvm) :: EDh
6261	! Substitution rate of herbage by concentrate in the cow diet (-)
6262	REAL(r_std ), DIMENSION(npts,nvm) :: temp
6263	! Intermediairy variable
6264	LOGICAL, DIMENSION(npts,nvm,2) :: fin
6265	! To stop the iterative algorithm
6266	REAL(r_std ), DIMENSION(npts,nvm) :: ICmoy
6267	! Average intake capacity of the cattle [kg MS/animal/d]
6268	REAL(r_std ), DIMENSION(npts,nvm) :: DMImoy
6269	! Average dry matter intake of the cattle [kg MS/animal/d]
6270	INTEGER , DIMENSION(npts,nvm) :: Loop_count
6271	! Counter for loop
6272
6273	temp(:,:)=0.0
6274	Loop_count=0.0
6275	DMIc(:,:,1)=0.5
6276	DMIc(:,:,2)=0.5
6277	fin=.FALSE.
6278
6279	print*, "MG auto"
6280
6281	WHERE(nanimaltot(:,:).GT.0.0) ! Animals at pasture
6282	ICmoy(:,:)=(ICcow(:,:,1)+ICcow(:,:,2))/2
6283	DMImoy(:,:)=(DMIcowanimal(:,:,1)+DMIcowanimal(:,:,2))/2
6284	!On ne complemente pas au dessus du pourcentage de l'ingere potentiel defini en entree
6285	WHERE((DMImoy(:,:)/ICmoy(:,:))*FVh(:,:)>intake_tolerance)
6286	DMIc(:,:,1)=0.0
6287	DMIc(:,:,2)=0.0
6288	fin(:,:,1)=.TRUE.
6289	fin(:,:,2)=.TRUE.
6290	ENDWHERE
6291
6292	ELSEWHERE ! Animals at barn
6293	DMIc(:,:,1)=0.0
6294	DMIc(:,:,2)=0.0
6295	fin(:,:,1)=.TRUE.
6296	fin(:,:,2)=.TRUE.
6297	ENDWHERE
6298
6299
6300
6301	DO WHILE(NOT(ALL(fin)))
6302	Loop_count=Loop_count+1
6303	EDh(:,:)=NELherbage(:,:)/(7.12*FVh(:,:))
6304	A(:,:,1)=(0.0004MPcow2(:,:,1)2)+(2.39EDh(:,:)**2)-&
6305	(0.0452MPwcow2(:,:,1)EDh(:,:))
6306	A(:,:,2)=(0.0004MPcow2(:,:,2)2)+(2.39EDh(:,:)**2)-&
6307	(0.0452MPwcow2(:,:,2)EDh(:,:))
6308	shc1(:,:,1)=0.8+0.01*DMIc(:,:,1)
6309	shc1(:,:,2)=0.8+0.01*DMIc(:,:,2)
6310	shc2(:,:,1)=0.11+(0.02DMIc(:,:,1))-(1.13EDh(:,:)**2)+&
6311	A(:,:,1)(DMIcowanimal(:,:,1)FVh/Iccow(:,:,1))
6312	shc2(:,:,2)=0.11+(0.02DMIc(:,:,2))-(1.13EDh(:,:)**2)+&
6313	A(:,:,2)(DMIcowanimal(:,:,2)FVh/Iccow(:,:,2))
6314
6315	shc(:,:,1)=min(shc1(:,:,1),shc2(:,:,1))
6316	shc(:,:,2)=min(shc1(:,:,2),shc2(:,:,2))
6317
6318	WHERE(.NOT.(fin(:,:,1)))
6319	DMIc(:,:,1)=(NER(:,:,1)-DMIcowanimal(:,:,1)*NELherbage(:,:))/&
6320	(7.12EVc(:,:)-shc(:,:,1)NELherbage(:,:))
6321	ENDWHERE
6322
6323	WHERE(.NOT.(fin(:,:,2)))
6324	DMIc(:,:,2)=(NER(:,:,2)-DMIcowanimal(:,:,2)*NELherbage(:,:))/&
6325	(7.12EVc(:,:)-shc(:,:,2)NELherbage(:,:))
6326	ENDWHERE
6327
6328	WHERE(((NER(:,:,1)-DMIcowanimal(:,:,1)*NELherbage(:,:)).LT.0.0).OR.&
6329	((7.12EVc(:,:)-shc(:,:,1)NELherbage(:,:)).LT.0.0))
6330	DMIc(:,:,1)=0.0
6331	ENDWHERE
6332
6333	WHERE(((NER(:,:,2)-DMIcowanimal(:,:,2)*NELherbage(:,:)).LT.0.0).OR.&
6334	((7.12EVc(:,:)-shc(:,:,2)NELherbage(:,:)).LT.0.0))
6335	DMIc(:,:,2)=0.0
6336	ENDWHERE
6337
6338	WHERE(DMIc.GE.Q_max_complement)
6339	fin=.TRUE.
6340	DMIc=Q_max_complement
6341	ENDWHERE
6342	!Faut-il considerer ici la production de lait reelle
6343	Qic(:,:,1)=DMIc(:,:,1)/MPcow2(:,:,1)
6344	Qic(:,:,2)=DMIc(:,:,2)/MPcow2(:,:,2)
6345
6346	CALL calcul_NEI_cow_d(npts,2,MPcow2,DMIcowanimal,NELherbage,&
6347	temp,temp,&
6348	EVc,Qic,NEI,NEM,NEIh,NEIf,NEIc)
6349
6350	MPpos_loc(:,:,1)=(NEI(:,:,1)-NEM(:,:,1)-NEG(:,:,1))/(0.44*7.12)
6351	MPpos_loc(:,:,2)=(NEI(:,:,2)-NEM(:,:,2)-NEG(:,:,2))/(0.44*7.12)
6352
6353	! AIG 04/07/2010
6354	! On arrete de complémenter les VL quand la PL possible devient supérieure à la PL potentielle
6355	!WHERE(MPwcow2.LE.MPcow2)
6356	!fin=.TRUE.
6357	!ENDWHERE
6358	! Je corrige:
6359	WHERE(MPpos_loc(:,:,1).GE.MPwcow2(:,:,1))
6360	fin(:,:,1)=.TRUE.
6361	ENDWHERE
6362
6363	WHERE(MPpos_loc(:,:,2).GE.MPwcow2(:,:,2))
6364	fin(:,:,2)=.TRUE.
6365	ENDWHERE
6366
6367	WHERE(Loop_count.GT.100)
6368	fin(:,:,1)=.TRUE.
6369	fin(:,:,2)=.TRUE.
6370	ENDWHERE
6371	ENDDO
6372
6373	! AIG 28/07/2010
6374	! Sauf erreur de ma part, il faut recalculer la quantite d'herbe (en sortie de la subroutine)
6375	! en lui soustrayant le concentre qui lui est substitue soit:
6376
6377	DMIcowanimal(:,:,1)=DMIcowanimal(:,:,1)-shc(:,:,1)*DMIc(:,:,1)
6378	DMIcowanimal(:,:,2)=DMIcowanimal(:,:,2)-shc(:,:,2)*DMIc(:,:,2)
6379
6380
6381	ENDSUBROUTINE auto_complementation_dairy
6382
6383	!Routine permettant de calculer la complémentation automatique des vaches allaitantes
6384
6385	SUBROUTINE auto_complementation_suckler(npts,DMIcowanimal,FVh,ICcow,NER,NELherbage, &
6386	EVf,FVf,Q_max_complement,DMIf,nanimaltot,intake_tolerance)
6387
6388	INTEGER, INTENT(in) :: npts
6389	! Number of spatial points (-)
6390	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: DMIcowanimal
6391	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
6392	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: FVh
6393	! Herbage Fill Value (UE)
6394	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: ICcow
6395	! Cow intake capacity of primiparous or multiparous cows(kg/animal/d)
6396	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NER
6397	! Net energy requirement (MJ)
6398	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: NELherbage
6399	! Energetic content of the herbage (MJ/kg)
6400	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: EVf
6401	! Energetic value of the forage (MJ/kg)
6402	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: FVf
6403	! Forage vill value (UE)
6404	REAL(r_std ) , INTENT(in) :: Q_max_complement
6405	! Maximum quantity of forage or concentrate to supplement animals when auto-supplementation (kg)
6406	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: DMIf
6407	! Forage quantity calculated by the model (kg/animal/d)
6408	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
6409	! Stocking rate (animal/m²)
6410	REAL(r_std ) , INTENT(in) :: intake_tolerance
6411	! intake tolerance threshold (-)
6412
6413	!local variables
6414	REAL(r_std ), DIMENSION(npts,nvm) :: Shf
6415	! Substitution rate of herbage by forage in the cow diet (-)
6416	REAL(r_std ), DIMENSION(npts,nvm) :: ICmoy
6417	! Average intake capacity of the cattle [Kg MS/UGB]
6418	REAL(r_std ), DIMENSION(npts,nvm) :: DMImoy
6419	! Average dry matter intake of tje cattle [Kg MS/UGB]
6420
6421
6422	WHERE(nanimaltot(:,:).GT.0.0)
6423	ICmoy(:,:)=(ICcow(:,:,1)+ICcow(:,:,2))/2
6424	DMImoy(:,:)=(DMIcowanimal(:,:,1)+DMIcowanimal(:,:,2))/2
6425
6426	! Substitution rate of herbage by forage
6427	!---------------------------------------
6428	! As DMI/IC ratio are the same beetwen young and mature cow, Shf should be calculated once
6429	Shf(:,:)= ((DMIcowanimal(:,:,1)FVh(:,:))/ICcow(:,:,1))&
6430	(2.2-1.2*FVh(:,:)/FVf(:,:))
6431
6432	DMIf(:,:,1)=(NER(:,:,1)-DMIcowanimal(:,:,1)*NELherbage(:,:))/&
6433	(7.12EVf(:,:)-SHf(:,:)NELherbage(:,:))
6434
6435	DMIf(:,:,2)=(NER(:,:,2)-DMIcowanimal(:,:,2)*NELherbage(:,:))/&
6436	(7.12EVf(:,:)-SHf(:,:)NELherbage(:,:))
6437
6438	! On ne complemente pas les animaux si l'herbe suffit a couvrir les besoins energetiques
6439	WHERE(DMIf(:,:,1).LT.0.0)
6440	DMIf(:,:,1)=0.0
6441	ENDWHERE
6442
6443	WHERE(DMIf(:,:,2).LT.0.0)
6444	DMIf(:,:,2)=0.0
6445	ENDWHERE
6446
6447	!On verifie qu'on ne depasse pas la capacite d'ingestion des animaux
6448	WHERE (((DMIcowanimal(:,:,1)-Shf(:,:)DMIf(:,:,1))FVh(:,:)+&
6449	DMIf(:,:,1)*FVf(:,:)).gt.ICcow(:,:,1))
6450	DMIf(:,:,1)=(iccow(:,:,1)-(DMIcowanimal(:,:,1)-&
6451	Shf(:,:)DMIf(:,:,1))FVh(:,:))/FVf(:,:)
6452	ENDWHERE
6453
6454	WHERE (((DMIcowanimal(:,:,2)-Shf(:,:)DMIf(:,:,2))FVh(:,:)+&
6455	DMIf(:,:,2)*FVf(:,:)).gt.ICcow(:,:,2))
6456	DMIf(:,:,2)=(iccow(:,:,2)-(DMIcowanimal(:,:,2)-&
6457	Shf(:,:)DMIf(:,:,2))FVh(:,:))/FVf(:,:)
6458	ENDWHERE
6459
6460	!On borne la quantité apportée au maximum defini en entree
6461	WHERE(DMIf(:,:,1).GT.Q_max_complement)
6462	DMIf(:,:,1)=Q_max_complement
6463	ENDWHERE
6464
6465	WHERE(DMIf(:,:,2).GT.Q_max_complement)
6466	DMIf(:,:,2)=Q_max_complement
6467	ENDWHERE
6468
6469	!On ne complemente pas au dessus du pourcentage de l'ingere potentiel defini en entree
6470	WHERE(((DMImoy(:,:)/ICmoy(:,:))*FVh(:,:)).GT.intake_tolerance)
6471	DMIf(:,:,1)=0.0
6472	DMIf(:,:,2)=0.0
6473	ENDWHERE
6474
6475	ELSEWHERE
6476	DMIf(:,:,1)=0.0
6477	DMIf(:,:,2)=0.0
6478	ENDWHERE
6479
6480	!Actual herbage ingestion
6481	DMIcowanimal(:,:,1)=DMIcowanimal(:,:,1)-Shf(:,:)*DMIf(:,:,1)
6482	DMIcowanimal(:,:,2)=DMIcowanimal(:,:,2)-Shf(:,:)*DMIf(:,:,2)
6483
6484	ENDSUBROUTINE
6485
6486	!----------------------------------------------
6487	! 3 - Milk_production
6488	!----------------------------------------------
6489	! the milk production is based on Wood equation
6490	!----------------------------------------------
6491	SUBROUTINE Milk_Animal_cow( &
6492	npts, dt ,&
6493	nanimaltot,tjulian,NEBcow ,&
6494	MPcow2,MPcow,MPwcow2 ,&
6495	MPcowC, MPcowN ,&
6496	MPcowCsum, MPcowNsum, milkanimalsum,milkKG)
6497
6498
6499	INTEGER, INTENT(in) :: npts
6500	! Number of spatial points (-)
6501	REAL(r_std ), INTENT(in) :: dt
6502	! Time step (d)
6503	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
6504	! Stocking density (animal m-2)
6505	INTEGER(i_std ), INTENT(in) :: tjulian
6506	! Julian day (d)
6507	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEBcow
6508	! Net energy Balance (young :1 , adult:2) (MJ)
6509	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcow2
6510	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6511	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcow
6512	! Daily milk production per m2 for primiparous or multiparous cows (kg/m2/d)
6513	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPwcow2
6514	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
6515	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowC
6516	! C in daily milk production per m2 for primiparous or multiparous cows (kgC/m2/d)
6517	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowN
6518	! N in daily milk production per m2 for primiparous or multiparous cows (kgN/m2/d)
6519	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowCsum
6520	! Cumulated C in milk production per m2 for primiparous or multiparous cows (kgC/m2)
6521	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowNsum
6522	! Cumulated N in milk production per m2 for primiparous or multiparous cows (kgN/m2)
6523	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(inout) :: milkanimalsum
6524	! Milk product per animal per years (L.(animal.years)-1)
6525	REAL(r_std ), DIMENSION(npts,nvm) :: milkKG
6526	! Daily actual milk production per animal for the whole cattle (kg/animal/d)
6527
6528	!20/03/2009 AIG & MG
6529	REAL(r_std ), DIMENSION(npts,nvm) :: nWeeklact
6530	! Lactation week (in weeks from calving)
6531	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPwcow2max
6532	! Daily potential milk production per animal for primiparous or multiparous cows at peak of lactation(kg/animal/d)
6533	REAL(r_std ), DIMENSION(npts,nvm) :: milkanimal_write
6534	REAL(r_std ), DIMENSION(npts,nvm) :: dsevrage
6535	! Julian day of the suckling calf period
6536
6537	INTEGER :: i,j
6538	! for loop
6539
6540
6541	MPwcow2max=MPwmax
6542	DO j=2,nvm
6543	DO i=1,npts
6544	! Week of lactation for cows
6545	IF(tjulian .GE. tcalving(i,j)) THEN
6546	nWeeklact(i,j) = CEILING((tjulian-REAL(tcalving(i,j))+1)/7)
6547	ELSE
6548	! si tjulian est inférieur à tcalving on considere le velage de l'annee precedente
6549	nWeeklact(i,j) = CEILING((tjulian-(REAL(tcalving(i,j))-365)+1)/7)
6550	END IF
6551
6552
6553	dsevrage(i,j)=tcalving(i,j)+tsevrage(i,j)
6554	IF (dsevrage(i,j) > 365) THEN
6555	dsevrage(i,j)=dsevrage(i,j)-365
6556	ENDIF
6557
6558	IF (dsevrage(i,j).LT.tcalving(i,j)) THEN
6559	! Maximum potential of lactation of a cow
6560	IF ((nWeeklact(i,j) .LE.43).AND.((tjulian.LT.dsevrage(i,j)).OR.&
6561	(tjulian.GT.tcalving(i,j)))) THEN
6562	MPwcow2(i,j,1) = MPwcow2max(i,j,1) * &
6563	( 0.885 * nWeeklact(i,j)*(0.2) EXP((-0.04) * nWeeklact(i,j)) )
6564	MPwcow2(i,j,2) = MPwcow2max(i,j,2) *&
6565	( 0.885 * nWeeklact(i,j)*(0.2) EXP((-0.04) * nWeeklact(i,j)) )
6566	ELSE
6567	MPcow2(i,j,1) = 0.0
6568	MPcow2(i,j,2) = 0.0
6569	ENDIF
6570	ELSE
6571	IF ((nWeeklact(i,j).LE.43).AND.((tjulian.GT.tcalving(i,j)).AND.(tjulian.LT.dsevrage(i,j)))) THEN
6572	MPwcow2(i,j,1) = MPwcow2max(i,j,1) * &
6573	( 0.885 * nWeeklact(i,j)*(0.2) EXP((-0.04) * nWeeklact(i,j)) )
6574	MPwcow2(i,j,2) = MPwcow2max(i,j,2) * &
6575	( 0.885 * nWeeklact(i,j)*(0.2) EXP((-0.04) * nWeeklact(i,j)) )
6576	ELSE
6577	MPwcow2(i,j,1) = 0.0
6578	MPwcow2(i,j,2) = 0.0
6579	ENDIF
6580	END IF
6581
6582	! Milk Production of a cow (kg milk/animal/d)
6583	! Après les 3 premiers mois de lactation la production laitière tient compte du bilan énergétique net NEB
6584	IF (nWeeklact(i,j) .LE. 12) THEN
6585	MPcow2(i,j,1) = MPwcow2(i,j,1)
6586	MPcow2(i,j,2) = MPwcow2(i,j,2)
6587	ELSE
6588	MPcow2(i,j,1) = MPwcow2(i,j,1) * ( 1 + 0.01 * NEBcow(i,j,1) )
6589	MPcow2(i,j,2) = MPwcow2(i,j,2) * ( 1 + 0.01 * NEBcow(i,j,2) )
6590	END IF
6591	ENDDO
6592	ENDDO
6593
6594
6595	milkKG=MPcow2(:,:,1)pyoung(:,:)+MPcow2(:,:,2)(1-pyoung(:,:))
6596
6597	if(ANY(milkKG(:,:).GT.50).OR. ANY(milkKG(:,:).LT.-50)) THEN
6598	print*, "bug"
6599	endif
6600
6601	WHERE (nanimaltot.EQ.0)
6602	milkKG=0
6603	MPcow2(:,:,1)=0
6604	MPcow2(:,:,2)=0
6605	ENDWHERE
6606
6607	! Milk production for all cows (kg milk/d)
6608	MPcow(:,:,1) = nanimaltot * MPcow2(:,:,1) * pyoung
6609	MPcow(:,:,2) = nanimaltot * MPcow2(:,:,2) * (1-pyoung)
6610
6611
6612	! Carbon in milk produced by cows (kg milk/d)
6613	MPcowC = 0.0588 * MPcow
6614
6615	! Nitrogen in milk produced by cows (kg milk/d)
6616	MPcowN = 0.00517 * MPcow
6617	DO j=2,nvm
6618	CALL Euler_X(npts,2, dt, MPcow(:,j,:) , MPcowsum(:,j,:))
6619	CALL Euler_X(npts,2, dt, MPcowC(:,j,:), MPcowCsum(:,j,:))
6620	CALL Euler_X(npts,2, dt, MPcowN(:,j,:), MPcowNsum(:,j,:))
6621	CALL Euler_X(npts,2, dt, MPcow2(:,j,:), MPcow2sum(:,j,:))
6622
6623
6624	milkanimal_write(:,j)=MilkKG(:,j)
6625
6626
6627	CALL Euler_funct (npts, dt, milkanimal_write(:,j), milkanimalsum(:,j))
6628	ENDDO
6629
6630	ENDSUBROUTINE Milk_animal_cow
6631
6632
6633
6634
6635	!----------------------------------------------
6636	! 4 - Balance energy Cow
6637	!----------------------------------------------
6638	! the energy balance for the cow to compute weight
6639	! gain or loss, and body condition score gain or loss
6640	!----------------------------------------------
6641
6642	SUBROUTINE balance_energy_cow(npts,dt,&
6643	DMIcowanimal,MPcow2,&
6644	Agecow, BCS,tjulian,wanimalcow,nanimaltot ,&
6645	NEB, NELherbage, EVf, Forage_quantity_period, &
6646	EVc, Qic, NEI, NEIh, NEIf, NEIc,&
6647	NEPgest, NEPlact, NEP, NEM, NER)
6648
6649	INTEGER, INTENT(in) :: npts
6650	! Number of spatial points (-)
6651	REAL(r_std ), INTENT(in) :: dt
6652	! Time step (d)
6653	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMIcowanimal
6654	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
6655	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: MPcow2
6656	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6657	INTEGER, INTENT(in) :: Agecow
6658	! 0:young, 1:adult
6659	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout):: BCS
6660	! Body Condition Score (for cow only /5)
6661	INTEGER(i_std ), INTENT(in) :: tjulian
6662	! Julian day (-)
6663	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout):: wanimalcow
6664	! Animal liveweight (kg/animal) (young:1, adult:2)
6665	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
6666	! Stocking rate (animal m-2)
6667	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEB
6668	! Net energy balance(MJ)
6669	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: NELherbage
6670	! Energetic content of the herbage (MJ/kg)
6671	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: EVf
6672	! Energy of the forage based (MJ/Kg)
6673	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Forage_quantity_period
6674	! Forage quantity (MJ/Kg)
6675	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: EVc
6676	! Energy of the concentrate (MJ/Kg)
6677	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Qic
6678	! Concentrate quantity per kg of milk or per kg of LW (MJ/Kg)
6679	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEI
6680	! Net energy intake from ingested herbage(MJ)
6681	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIh
6682	! Net energy intake from ingested herbage(MJ)
6683	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIf
6684	! Net energy intake from ingested forage(MJ)
6685	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIc
6686	! Net energy intake from ingested concentrate(MJ)
6687	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEPgest
6688	! Net energy for gestation (suckler cows)(MJ)
6689	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEPlact
6690	! Net energy for milk production(MJ)
6691	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEP
6692	! Net energy for production (MJ)
6693	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEM
6694	! Net energy for maintenance (MJ)
6695	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NER
6696	! Total net energy requirements (maintenance and production)(MJ)
6697
6698
6699
6700	!Local variable
6701	REAL(r_std ), DIMENSION(npts,nvm) :: NEBcow_calc
6702	! tempory variable to Gain or Loss computation
6703
6704
6705	INTEGER :: jourdepuisvelage
6706	! Calving date (-)
6707	INTEGER :: i,j
6708	! for loop
6709	REAL(r_std ) :: alpha
6710	!parametre for NEM computation
6711	REAL(r_std ) :: beta = 0.2
6712	!parametre for NEM computation
6713	REAL(r_std ) :: gamma
6714	!parametre for NEM computation
6715	REAL(r_std ) :: delta
6716	!parametre for NEM computation
6717
6718	!Certain calcul (notemment les paramétrage de variation du poids et de la BCS)
6719	!Dependent du signe de NEB, on est obligé de faire le calcul de façon sclaire
6720	!pour chaque valeur des vecteurs ce qui explique le DO... END DO.
6721	DO j=2,nvm
6722	DO i=1,npts
6723	IF (nanimaltot(i,j).ne.0) THEN
6724	!NEI compute (Net Energy intake)
6725	NEIh(i,j)= DMIcowanimal(i,j)* NELherbage(i,j)
6726	NEIf(i,j)= Forage_quantity_period(i,j)7.12EVf(i,j)
6727	NEIc(i,j)= Qic(i,j)* MPcow2(i,j)* 7.12*EVc(i,j)
6728	NEI(i,j)= NEIh(i,j)+ NEIf(i,j) + NEIc(i,j)
6729
6730	!NEP compute (net energy production (gestation and milk production)
6731	!NEPlact(i)=3.20*MPcow2(i)
6732	NEPlact(i,j)=0.447.12MPcow2(i,j)
6733
6734	jourdepuisvelage=tjulian-tcalving(i,j)
6735
6736	IF (jourdepuisvelage .lt. 0) THEN
6737	jourdepuisvelage=365+jourdepuisvelage
6738	ENDIF
6739
6740
6741	WHERE (gestation.eq.0)
6742	NEPgest=0
6743
6744	ELSEWHERE
6745	!NEPgest=26.3exp(-0.0184(365-jourdepuisvelage))
6746	NEPgest=3.707.12exp(-0.0184*(365-jourdepuisvelage))
6747	ENDwhere
6748
6749	NEP(i,j)=NEPlact(i,j)+NEPgest(i,j)
6750
6751	!NEM compute()
6752
6753
6754	IF (MPcow2(i,j).eq.0) THEN
6755	!alpha=0.263
6756	alpha=0.037*7.12
6757	ELSE
6758	!alpha=0.291
6759	alpha=0.041*7.12
6760	ENDIF
6761
6762
6763
6764
6765	!NEM(i)=((alpha+0.099(BCS(i)-2.5))wanimalcow(i)*(0.75)(1+beta))
6766	NEM(i,j)=((alpha+0.0147.12(BCS(i,j)-2.5))wanimalcow(i,j)(0.75)(1+beta))
6767
6768
6769	NEB(i,j)=NEI(i,j)-(NEM(i,j)+NEP(i,j))
6770
6771	NER(i,j)= NEM(i,j)+NEP(i,j)
6772
6773
6774
6775	!coefficient de reduction des gain et note d'etat
6776
6777	!Determination parameters according to the age of the cow (young or adult)
6778	! agecow = 0 for young cows and 1 for mature cows
6779	IF (agecow.eq.1) THEN
6780	gamma=0.032
6781	delta=0.0007
6782	ELSE
6783	gamma=0.044
6784	delta=0.0002
6785	EndIf
6786
6787
6788	If(NEB(i,j).ge.0) THEN
6789	NEBcow_calc(i,j)=NEB(i,j)*gamma
6790	ELSE
6791	NEBcow_calc(i,j)=(NEB(i,j)*gamma/0.8)
6792	ENDIF
6793	! Gain or Loss weigth accroding to NEB
6794	CALL Euler_funct (1, dt, NEBcow_calc(i,j), wanimalcow(i,j))
6795
6796	!wanimalcow between [300..1000]
6797	IF (wanimalcow(i,j)<300) THEN
6798	wanimalcow(i,j)=300
6799	ENDIF
6800
6801	IF (wanimalcow(i,j) > 1000) THEN
6802	wanimalcow(i,j)=1000
6803	ENDIF
6804
6805
6806
6807	If(NEB(i,j).ge.0) THEN
6808	NEBcow_calc(i,j)=NEB(i,j)*delta
6809	ELSE
6810	NEBcow_calc(i,j)=(NEB(i,j)*delta/0.8)
6811	ENDIF
6812
6813	! Gain or Loss body score condition acording to NEB
6814	CALL Euler_funct (1, dt, NEBcow_calc(i,j), BCS(i,j))
6815
6816	!BCS beetween [0..5]
6817	IF (BCS(i,j) < 0) THEN
6818	BCS(i,j)=0
6819	ENDIF
6820
6821	IF (BCS(i,j)>5) THEN
6822	BCS(i,j)=5
6823	ENDIF
6824
6825
6826	ENDIF
6827	END DO
6828	END DO
6829	WHERE (nanimaltot.EQ.0)
6830	BCS=0
6831	Wanimalcow=0
6832	ENDWHERE
6833	ENDSUBROUTINE balance_energy_cow
6834
6835
6836	SUBROUTINE balance_energy_calf(npts,dt ,&
6837	DMIcowcalf,MPcow2,nanimaltot ,&
6838	wanimalcalf, NELherbage,NEIherbage ,&
6839	NEImilk, NEI, NEM, NEG)
6840
6841	INTEGER, INTENT(in) :: npts
6842	! Number of spatial points (-)
6843	REAL(r_std ), INTENT(in) :: dt
6844	! Time step (d)
6845	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMIcowcalf
6846	! Calf dry matter intake (Kg/animal/d)
6847	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: MPcow2
6848	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6849	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
6850	! Stocking density (animal m-2)
6851	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout):: wanimalcalf
6852	! Calf liveweigth (kg/animal)
6853	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: NELherbage
6854	! Energetic content of the herbage (MJ/kg)
6855	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIherbage
6856	! Net energy intake from ingested herbage (MJ/Kg)
6857	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEImilk
6858	! Net Erengy of ngested milk(MJ/Kg)
6859	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEI
6860	! Net energy of global intake(MJ/Kg)
6861	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEM
6862	! Net energy metabolic(MJ/Kg)
6863	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEG
6864	! Net energy growth(MJ/Kg)
6865
6866	!Local variable
6867	REAL(r_std ) :: beta=0.2
6868	! Parameter for NEM computation
6869	REAL(r_std ), DIMENSION(npts,nvm) :: NEG_calc
6870	! For compute gain weigth
6871	INTEGER :: i,j
6872	! for loop
6873
6874
6875
6876	!Calcul de NEIforage
6877	NEIherbage=DMIcowcalf*NELherbage
6878
6879	!Calcul de NEImilk
6880	!NEImilk=2.27*MPcow2
6881	NEImilk=0.327.12MPcow2
6882
6883	!calcul de NEI : Net Energy Ingested
6884	NEI=NEIherbage+NEImilk
6885
6886	!NEM computation
6887	!NEM=0.291wanimalcalf(0.75)(1+beta)
6888	NEM=0.0417.12wanimalcalf*(0.75)(1+beta)
6889
6890	!Net energy for calf growth
6891	NEG=NEI-NEM
6892
6893	!Only gain, not loss weigth
6894	DO j=2,nvm
6895	DO i=1,npts
6896	IF (NEG(i,j) .le. 0.0) THEN
6897	NEG(i,j)=0.0
6898	ENDIF
6899	ENDDO
6900	ENDDO
6901	! On met la NEG à 0 quand le poids du veau est nul pour eviter la division par zero
6902
6903	WHERE (nanimaltot.NE.0.0.AND.calf.NE.0.AND.wanimalcalf.NE.0.0)
6904
6905	!NEG_calc=(NEG/(0.309((wanimalcalf)0.75)))*(1/1.4)
6906	NEG_calc=(NEG/(0.04357.12((wanimalcalf)0.75)))(1/1.4)
6907
6908	ELSEWHERE
6909	NEG_calc=0
6910	NEM=0
6911	NEI=0
6912	NEImilk=0
6913	NEIherbage=0
6914	NEG=0
6915	wanimalcalf=0.0
6916	ENDWHERE
6917
6918	DO j=2,nvm
6919
6920	!Gain calf weight according to NEG
6921	CALL Euler_funct(npts, dt, NEG_calc(:,j), wanimalcalf(:,j))
6922	ENDDO
6923	ENDSUBROUTINE balance_energy_calf
6924
6925	SUBROUTINE balance_energy_cow_d(npts,npta,dt,&
6926	MPcow2,MPwcow2,MPpos,&
6927	BCS,BCScow_prev, AGE_animal,&
6928	wanimalcow,nanimaltot)
6929
6930	INTEGER, INTENT(in) :: npts
6931	! Number of spatial points (-)
6932	INTEGER, INTENT(in) :: npta
6933	! 1 : primiparous cows 2 : multiparous cows
6934	REAL(r_std ), INTENT(in) :: dt
6935	! Time step (d)
6936	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPcow2
6937	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
6938	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPpos
6939	! Possible milk production of dairy cows according to the diet (kg/animal/d)
6940	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPwcow2
6941	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
6942	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(inout) :: BCS
6943	! Body Condition Score (for cow only /5)
6944	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(inout) :: BCScow_prev
6945	! Body Condition Score at previsou time step (for cow only /5)
6946	REAL(r_std ), DIMENSION(npts,nvm,npta),INTENT(in) :: AGE_animal
6947	! Animal age in case of simulation of dairy cows (months)
6948	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(inout) :: wanimalcow
6949	! Animal liveweight (kg/animal) (young:1, adult:2)
6950	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
6951	! Stocking density (animal/m2)
6952
6953
6954	!Local variable
6955	REAL(r_std ), DIMENSION(npts,nvm,npta) :: NEBcow_W
6956	! Daily variation of cow liveweight (kg/d)
6957	REAL(r_std ), DIMENSION(npts,nvm,npta) :: NEBcow_BCS
6958	! Daily variation of cow body condition score (/d)
6959
6960
6961	!-----------------------
6962	! Net Energy available for liveweight and BCS
6963	!-----------------------
6964
6965	WHERE(nanimaltot.NE.0) ! Animals are at pasture
6966	! Primiparous cows
6967	WHERE((MPwcow2(:,:,1)-MPpos(:,:,1)).LT.0)
6968	! Liveweight and body condition increase
6969	NEBcow_BCS(:,:,1)=(0.44/180)*(MPpos(:,:,1)-MPcow2(:,:,1))
6970	NEBcow_W(:,:,1)=(0.44/3.5)*(MPpos(:,:,1)-MPcow2(:,:,1))
6971	ELSEWHERE
6972	! Liveweight and body condition decrease
6973	NEBcow_BCS(:,:,1)=(0.44/240)*(MPpos(:,:,1)-MPcow2(:,:,1))
6974	NEBcow_W(:,:,1)=(0.44/4.5)*(MPpos(:,:,1)-MPcow2(:,:,1))
6975	ENDWHERE
6976	! Multiparous cows
6977	WHERE((MPwcow2(:,:,2)-MPpos(:,:,2)).LT.0)
6978	! Liveweight and body condition increase
6979	NEBcow_BCS(:,:,2)=(0.44/180)*(MPpos(:,:,2)-MPcow2(:,:,2))
6980	NEBcow_W(:,:,2)=(0.44/3.5)*(MPpos(:,:,2)-MPcow2(:,:,2))
6981	ELSEWHERE
6982	! Liveweight and body condition decrease
6983	NEBcow_BCS(:,:,2)=(0.44/240)*(MPpos(:,:,2)-MPcow2(:,:,2))
6984	NEBcow_W(:,:,2)=(0.44/3.5)*(MPpos(:,:,2)-MPcow2(:,:,2))
6985	ENDWHERE
6986
6987
6988	WHERE (BCS(:,:,1).LT.0)
6989	BCS(:,:,1)=0
6990	ELSEWHERE(BCS(:,:,1).GT.5)
6991	BCS(:,:,1)=5
6992	ENDWHERE
6993
6994	WHERE (BCS(:,:,2).LT.0)
6995	BCS(:,:,2)=0
6996	ELSEWHERE(BCS(:,:,2).GT.5)
6997	BCS(:,:,2)=5
6998	ENDWHERE
6999
7000	ELSEWHERE
7001	! Animals are at barn
7002	BCS(:,:,1)=0
7003	BCS(:,:,2)=0
7004	Wanimalcow(:,:,1)=0
7005	Wanimalcow(:,:,2)=0
7006	NEBcow_BCS(:,:,1)=0
7007	NEBcow_BCS(:,:,2)=0
7008	NEBcow_W(:,:,1)=0
7009	NEBcow_W(:,:,2)=0
7010	ENDWHERE
7011
7012	!Liveweight integration
7013
7014
7015	!We save the previous BCS
7016	BCScow_prev=BCS
7017
7018
7019	ENDSUBROUTINE balance_energy_cow_d
7020
7021
7022	SUBROUTINE balance_energy_heifer(&
7023	npts,dt,nanimaltot,DMIheifer,NELherbage,&
7024	EVf,Forage_quantity_period, wanimalcow,&
7025	NEI, NEIh, NEIf, type_animal)
7026
7027	INTEGER, INTENT(in) :: npts
7028	! Number of spatial points (-)
7029	INTEGER, INTENT(in) :: type_animal
7030	! 1: Dairy cows, 2: Suckler cows, 3: Old module, 4: Dairy heifers, 5 : Suckler heifers
7031	REAL(r_std ), INTENT(in) :: dt
7032	! Time step (d)
7033	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
7034	! StockRate of cattle
7035	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMIheifer
7036	! Dry Matter intake of a cow/calf (Kg)
7037	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: NELherbage
7038	! Energetic content of the herbage (MJ/kg)
7039	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: EVf
7040	! Energy of the forage based (MJ/Kg)
7041	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Forage_quantity_period
7042	! Forage quantity (MJ/Kg)
7043
7044	REAL(r_std ), DIMENSION(npts,nvm), INTENT(inout) :: wanimalcow
7045	! Animal liveweight (kg/animal) (young:1, adult:2)
7046	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEI
7047	! Energy of the forage based on SEBIEN model(MJ/Kg)
7048	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIh
7049	! Net Energy intake from ingested herbage(MJ)
7050	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NEIf
7051	! Net Energy intake from ingested forage(MJ)
7052
7053	REAL(r_std ), DIMENSION(npts,nvm) :: NEIheifer_W
7054	! temporary variable to Gain or Loss computation
7055	! These parameters come from INRA tables 2007p. + J. Agabriel UMR URH Theix
7056	REAL(r_std ), DIMENSION(npts,nvm) :: alpha
7057	! Coefficient for linear regression : NEI[UFL]/LW[kg]^0.75=alpha * LWG[kg/d]^1.4 + beta
7058	REAL(r_std ), DIMENSION(npts,nvm) :: beta
7059	! Coefficient for linear regression : NEI[UFL]/LW[kg]^0.75=alpha * LWG[kg/d]^1.4 + beta
7060	REAL(r_std ), DIMENSION(npts,nvm) :: denominateur
7061	! intermediary variable
7062	INTEGER :: j
7063
7064	IF(type_animal.EQ.4) THEN ! Dairy heifers
7065	alpha=0.0348
7066	beta =0.0446
7067	ELSE ! Suckler heifers (type_animal=5)
7068	alpha=0.0498
7069	beta =0.0269
7070	ENDIF
7071
7072	denominateur=7.12(wanimalcow)*0.75
7073
7074	! Net Energy intake
7075	WHERE((nanimaltot.NE.0).AND.(denominateur.GT.0))
7076	NEIh(:,:)= DMIheifer(:,:)*NELherbage
7077	NEIf(:,:)= Forage_quantity_period(:,:)7.12EVf(:,:)
7078	NEI(:,:)= NEIh(:,:) + NEIf(:,:)
7079	NEIheifer_W=(max(0.001,((NEI(:,:)/denominateur-beta)/alpha)))**0.71
7080	ELSEWHERE
7081	! no grazing period
7082	Wanimalcow(:,:)=0.
7083	NEI(:,:)=0.
7084	NEIheifer_W=0.
7085	ENDWHERE
7086	DO j=2,nvm
7087	CALL Euler_funct (1, dt, NEIheifer_W(:,j), wanimalcow(:,j))
7088	ENDDO
7089
7090	ENDSUBROUTINE balance_energy_heifer
7091
7092	!----------------------------------
7093	! 4 - Respiration & Methane loss
7094	!----------------------------------
7095
7096	! Methane emissions were previously calculated as a fixed proportion of the
7097	! ingested carbon (Minonzio, 1998);
7098	! Methan-Emissionen der schweizerischen Landwirtschaft
7099	! G Minonzio, A Grub, J Fuhrer - Schriftenreihe Umwelt, 1998
7100	! In reality, the main factors responsible for CH4 production are not only the amount
7101	! but also the quality of the diet (fibres). Cf. Vuichard Thesis
7102
7103	SUBROUTINE Respiration_Methane_cow(&
7104	npts,grazingc, &
7105	nanimaltot, DNDFI, Wanimal,&
7106	R_cow, CH4_cow)
7107
7108	! Declarations:
7109	INTEGER, INTENT(in) :: npts
7110	! Number of spatial points (-)
7111	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: grazingc
7112	! C flux associated to grazing (kg C m-2 d-1)
7113	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
7114	! Stocking density (animal m-2)
7115	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DNDFI
7116	! Amount of digestible neutral detergent fiber in the intake (kg d-1)
7117	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Wanimal
7118	! Animal life weight (kg)
7119	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: R_cow
7120	! Animal respiration (kg C / m²)
7121	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: CH4_cow
7122	! Enteric methane emission (Kg C / m²)
7123
7124	!implicit variables intent(in) :
7125	! - franimal : Fraction of grazingc respired (-)
7126	! - ch4toc : parameter for the calculation of enteric methane emission
7127
7128	! Animal respiration
7129	!----------------------------------
7130	! From grazingc, the fraction franimal is respired
7131	! franimal = 0.5 *!
7132
7133	R_cow = franimal*grazingc
7134
7135	! Enteric methane emission
7136	!----------------------------------
7137	! ach4 = 0.0002867 (kg CH4 (kg life weight)-1 d-1)
7138	! bch4 = 0.000045 (kg CH4 (kg life weight)-1 d-1)
7139	! ch4toc = 0.75 * ! parameter for the calculation of enteric methane emission
7140
7141	WHERE (nanimaltot .GT. 0.0)
7142
7143	WHERE((aCH4 + bCH4 * DNDFI) .GE. 0.0)
7144
7145	!(2) p88 equation (1)
7146	! Inversion de ach4 & bch4
7147
7148	CH4_cow = (ach4 + bch4 * DNDFI)wanimalch4toc*nanimaltot
7149
7150	ELSEWHERE
7151
7152	CH4_cow = 0.0
7153
7154	END WHERE
7155
7156	ELSEWHERE
7157
7158	CH4_cow = 0.0
7159
7160	END WHERE
7161
7162
7163	END SUBROUTINE Respiration_Methane_cow
7164
7165
7166	SUBROUTINE Respiration_Methane_cow_2(npts, npta, type_animal, OMD,NEIh,NEIf,NEIc,grazingc,nanimaltot,&
7167	panimaltot,R_cow,CH4,CH4animal, MPcow2, forage_complementc, f_complementation)
7168
7169	INTEGER, INTENT(in) :: npts
7170	! Number of spatial points (-)
7171	INTEGER, INTENT(in) :: npta
7172	! equals 2 when cow (young/primipare and mature/multipare) and 1 when calf
7173	INTEGER, INTENT(in) :: type_animal
7174	! 1: Dairy cows, 2: Suckler cows, 3: Old module, 4: Dairy heifers, 5 : Suckler heifers
7175	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: OMD
7176	! Digestible organic matter in the intake(kg/kg)
7177	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: NEIh
7178	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: NEIf
7179	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: NEIc
7180	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: grazingc
7181	! C flux associated to grazing (kg C m-2 d-1)
7182	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
7183
7184	! Stocking rate (animal m-2)
7185	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: panimaltot
7186	! proportion of primipare
7187	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: R_cow
7188	! Daily animal respiration (kg C m-2 d-1)
7189	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: CH4
7190
7191
7192	! Daily enteric methane production (kg C/m2/d);
7193	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: CH4animal
7194	! Daily enteric methane production for young or mature cows (kg C/m2/d);
7195	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPcow2
7196	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
7197	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(inout):: forage_complementc
7198	! C flux associated to complemtation with forage and concentrate (kg C m-2 d-1)
7199	INTEGER, INTENT(in) :: f_complementation
7200	! Flag to activate cow complementation
7201
7202
7203
7204	REAL(r_std ), DIMENSION(npts,nvm) :: dE
7205	! Energy digestibility (%)
7206	REAL(r_std ), DIMENSION(npts,nvm) :: Ymh
7207	! CH4 conversion factor, per cent of metabolizable energy in ingested herbage
7208	REAL(r_std ), DIMENSION(npts,nvm,npta) :: Ymfc
7209	! CH4 conversion factor, per cent of metabolizable energy in ingested forage+concentrate
7210	REAL(r_std ), DIMENSION(npts,nvm,npta) :: CH4h
7211	! Daily enteric methane production from ingested herbage (kg C animal-1 d-1)
7212	REAL(r_std ), DIMENSION(npts,nvm,npta) :: CH4fc
7213	! Daily enteric methane production from ingested forage and concentrate (kg C animal-1 d-1)
7214
7215	INTEGER :: i,j,k
7216
7217
7218	IF(type_animal.EQ.1) THEN !!! for dairy cows !!!
7219	! Tables INRA p. 173 Fourrages verts graminées et légumineuses
7220	! dE et OMD en %
7221	dE=0.957OMD100-0.068
7222	Ymh=-0.238*dE+27.67 ! herbage
7223	Ymfc(:,:,1)=12.5+0.17*(15-MPcow2(:,:,1)) ! forage (& concentrate)
7224	Ymfc(:,:,2)=12.5+0.17*(15-MPcow2(:,:,2)) ! forage (& concentrate)
7225	DO j=2,nvm
7226	DO i=1,npts
7227	DO k=1,npta
7228	IF( MPcow2(i,j,k).LT.15.0) THEN
7229	! Methane from ingested forage and concentrate(kg C/m2/d)
7230	CH4fc(i,j,k)=((8.25+0.07(NEIf(i,j,k)+NEIc(i,j,k))/k_CH4)/55.65)&
7231	ch4toc*nanimaltot(i,j)
7232	ELSE
7233	CH4fc(i,j,k)=(Ymfc(i,j,k)(NEIf(i,j,k)+NEIc(i,j,k))/(5565k_CH4))*&
7234	ch4toc*nanimaltot(i,j)
7235	ENDIF
7236	ENDDO
7237	ENDDO
7238	ENDDO
7239	ELSE !!! for suckler cows or heifers !!!
7240	Ymh = 12 ! herbage
7241	Ymfc(:,:,:)= 15 ! forage (& concentrate)
7242	! Methane from ingested forage and concentrate(kg C/m2/d)
7243	CH4fc(:,:,1)=Ymfc(:,:,1)(NEIf(:,:,1)+NEIc(:,:,1))/(5565k_CH4)*&
7244	ch4toc*nanimaltot
7245	CH4fc(:,:,2)=Ymfc(:,:,2)(NEIf(:,:,2)+NEIc(:,:,2))/(5565k_CH4)*&
7246	ch4toc*nanimaltot
7247	ENDIF
7248
7249	! Methane from ingested herbage (kg C/m2/d)
7250
7251	CH4h(:,:,1)=YmhNEIh(:,:,1)/(5565k_CH4)ch4tocnanimaltot
7252	CH4h(:,:,2)=YmhNEIh(:,:,2)/(5565k_CH4)ch4tocnanimaltot
7253
7254	! Methane from young or mature cows (kg C/m2/d)
7255
7256	IF (f_complementation>0) THEN ! Cows are supplemented
7257	CH4animal(:,:,1)=CH4h(:,:,1)+CH4fc(:,:,1)
7258	CH4animal(:,:,2)=CH4h(:,:,2)+CH4fc(:,:,2)
7259	ELSE ! Cows are only fed with grazed herbage
7260	CH4animal(:,:,1)=CH4h(:,:,1)
7261	CH4animal(:,:,2)=CH4h(:,:,2)
7262	CH4fc(:,:,1)=0.0
7263	CH4fc(:,:,2)=0.0
7264	forage_complementc=0.0
7265	ENDIF
7266
7267
7268	! Total methane (kg C/m2/d)
7269
7270	CH4(:,:)=(CH4h(:,:,1)+CH4fc(:,:,1))*panimaltot+(CH4h(:,:,2)+&
7271	CH4fc(:,:,2))*(1-panimaltot)
7272
7273	! Animal respiration(kg C/m2/d)
7274
7275	R_cow=franimal*(grazingc +forage_complementc)
7276
7277
7278	END SUBROUTINE
7279
7280
7281
7282
7283	SUBROUTINE Urine_Faeces_cow(&
7284	npts,grazingn, grazingc ,&
7285	forage_complementc, forage_complementn,&
7286	nanimaltot, urinen, faecesn,urinec, faecesc)
7287
7288	INTEGER, INTENT(in) :: npts
7289	! Number of spatial points (-)
7290	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: grazingn
7291	! N flux associated to grazing (kg N m-2 d-1)
7292	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: grazingc
7293	! C flux associated to grazing (kg C m-2 d-1)
7294	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: forage_complementc
7295	! C flux associated to forage anc complementation (kg C m-2 d-1)
7296	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: forage_complementn
7297	! N flux associated to forage anc complementation (kg C m-2 d-1)
7298
7299	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: nanimaltot
7300	! Stocking rate (animal m-2)
7301	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: urinen
7302	! urine N flux (kg N m-2 d-1)
7303	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: faecesn
7304	! faeces N lux (kg N m-2 d-1)
7305	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: urinec
7306	! urine C flux (kg C m-2 d-1)
7307	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: faecesc
7308	! faeces C flux (kg C m-2 d-1)
7309
7310	!implicit variable intent(in) :
7311	!- fnurine : Fraction of N in excreta not volatilised, that is in urineN (Menzi et al 1997) (-)
7312
7313	! Local variables
7314	REAL(r_std ), DIMENSION(npts,nvm) :: excretan
7315	! Total N excreta (kg N m-2 d-1)
7316
7317
7318	WHERE (nanimaltot(:,:).NE.0)
7319
7320	!urine and faeces
7321	!(thornley 1998)
7322
7323
7324	! Total N excreta
7325	!----------------------------------
7326	! is given by the difference between grazing N and the N converted into milk *!
7327
7328	excretan = grazingn + forage_complementn - milkn
7329
7330
7331	! urine N flux
7332	!----------------------------------
7333	! equation (4.4d) de "Grassland dynamics" Thornley
7334	! fnurine = 0.6 *!
7335
7336	urinen = fnurine*excretan
7337
7338	! faeces N flux
7339	!---------------------------------- *!
7340
7341	faecesn = (1.0 - fnurine)*excretan
7342
7343
7344	! yearly values
7345
7346	! c respired and in excreta
7347	! équation (4.4e) de "grassland dynamics" thornley
7348
7349
7350	! urine C flux
7351	!----------------------------------
7352	! 12/28:urea C:2N ratio *!
7353
7354	urinec = fnurineexcretan12.0/28.0
7355
7356
7357	! faeces C flux
7358	!----------------------------------
7359	! C in faeces is given by the difference between grazingC and the sum of all the
7360	! other output C fluxes *!
7361
7362	faecesc = &
7363	grazingc + & ! C flux associated to grazing
7364	forage_complementc - & ! C flux associated to forage anc complementation
7365	milkc - & ! Fraction of 0.00588 for C of milk production
7366	ranimal - & ! Animal respiration
7367	methane - & ! Enteric methane emission
7368	urinec ! urine C flux
7369	ELSE WHERE
7370	urinen(:,:)=0
7371	faecesn(:,:)=0
7372	urinec(:,:)=0
7373	faecesc(:,:)=0
7374	ENDWHERE
7375
7376
7377
7378	! yearly values
7379	END SUBROUTINE Urine_Faeces_cow
7380
7381
7382
7383
7384	SUBROUTINE Calcul_NEL_herbage(npts,OMD, NELherbage)
7385	INTEGER, INTENT(in) :: npts ! Number of spatial points (-)
7386	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: OMD ! Digestible organic matter in the intake(kg/kg)
7387	REAL(r_std ), DIMENSION(npts,nvm), INTENT(out) :: NELherbage ! Energetic content of the herbage (MJ/kg)
7388
7389	!NELherbage=11.2*OMD-1.83 ! Equation prenant en compte Fourrages verts et foin [Jouven et al.2008]
7390	NELherbage=10.78*OMD-1.69 ! Equation adaptée par R. Baumont pour prendre en compte l'ensemble des fourrages verts
7391
7392	ENDSUBROUTINE Calcul_NEL_herbage
7393
7394
7395
7396	SUBROUTINE histwrite_cow_Part1(npts,DMIyoung,DMImature,DMicalf,pyoung_in,OMD,MPcow2,NEBcow, NEIcow, nanimaltot,type_animal,&
7397	MPwCow2,MPpos, DMIc, DMIf)
7398	INTEGER, INTENT(in) :: npts
7399	! Number of spatial points (-)
7400	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMIyoung
7401	! Ingested dry matter for calf (Kg/d)
7402	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMImature
7403	! Ingested dry matter for calf (Kg/d)
7404	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: DMIcalf
7405	! Daily calf intake per m2 (Kg/d)
7406	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: pyoung_in
7407	! Ingested dry matter for calf (Kg/d)
7408	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: OMD
7409	! Digestible organic matter in the intake(kg/kg)
7410
7411	REAL(r_std ), DIMENSION(npts,nvm) :: BCScows
7412	! Average BCS of cattle
7413	REAL(r_std ), DIMENSION(npts,nvm) :: Weightcows
7414
7415	! Average weight of cattle
7416	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPcow2
7417	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
7418	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEBcow
7419	! Net energy Balance (young :1 , adult:2) (MJ)
7420	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEIcow
7421	! Net energy intake (MJ)
7422	REAL(r_std ), DIMENSION(npts,nvm) :: nanimaltot
7423	! Stocking density (animal/m2)
7424	INTEGER, INTENT(in) :: type_animal
7425	! 1 or 2 or 4 or 5= > new module animal
7426	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwcow2
7427	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
7428	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPpos
7429	! Possible milk production of dairy cows according to the diet (kg/animal/d)
7430	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: DMIc
7431	! Concentrate intake (kg/animal/d)
7432	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: DMIf
7433	! forage intake (kg/animal/d)
7434
7435	!Local variable
7436
7437	REAL(r_std ), DIMENSION(npts,nvm) :: Milk_animal
7438
7439
7440	CALL histwrite_p(hist_id_stomate, 'BCSyoung' ,itime , BCScow(:,:,1) ,npts*nvm, horipft_index)
7441	CALL histwrite_p(hist_id_stomate, 'BCSmature' ,itime , BCScow(:,:,2) ,npts*nvm, horipft_index)
7442	CALL histwrite_p(hist_id_stomate, 'Weightyoung' ,itime , wanimalcow(:,:,1) ,npts*nvm, horipft_index)
7443	CALL histwrite_p(hist_id_stomate, 'Weightmature' ,itime , wanimalcow(:,:,2) ,npts*nvm, horipft_index)
7444	CALL histwrite_p(hist_id_stomate, 'Weightcalf' ,itime , wanimalcalf ,npts*nvm, horipft_index)
7445	CALL histwrite_p(hist_id_stomate, 'MPyoung' ,itime , MPcow2(:,:,1) ,npts*nvm, horipft_index)
7446	CALL histwrite_p(hist_id_stomate, 'MPmature' ,itime , MPcow2(:,:,2) ,npts*nvm, horipft_index)
7447	CALL histwrite_p(hist_id_stomate, 'MPwyoung' ,itime , MPwcow2(:,:,1) ,npts*nvm, horipft_index)
7448	CALL histwrite_p(hist_id_stomate, 'MPwmature' ,itime , MPwcow2(:,:,2) ,npts*nvm, horipft_index)
7449	CALL histwrite_p(hist_id_stomate, 'MPposyoung' ,itime , MPpos(:,:,1) ,npts*nvm, horipft_index)
7450	CALL histwrite_p(hist_id_stomate, 'MPposmature' ,itime , MPpos(:,:,2) ,npts*nvm, horipft_index)
7451	CALL histwrite_p(hist_id_stomate, 'NEByoung' ,itime , NEBcow(:,:,1) ,npts*nvm, horipft_index)
7452	CALL histwrite_p(hist_id_stomate, 'NEBmature' ,itime , NEBcow(:,:,2) ,npts*nvm, horipft_index)
7453	CALL histwrite_p(hist_id_stomate, 'NEIyoung' ,itime , NEIcow(:,:,1) ,npts*nvm, horipft_index)
7454	CALL histwrite_p(hist_id_stomate, 'NEImature' ,itime , NEIcow(:,:,2) ,npts*nvm, horipft_index)
7455	CALL histwrite_p(hist_id_stomate, 'DMIcyoung' ,itime , DMIc(:,:,1) ,npts*nvm, horipft_index)
7456	CALL histwrite_p(hist_id_stomate, 'DMIcmature' ,itime , DMIc(:,:,2) ,npts*nvm, horipft_index)
7457	CALL histwrite_p(hist_id_stomate, 'DMIfyoung' ,itime , DMIf(:,:,1) ,npts*nvm, horipft_index)
7458	CALL histwrite_p(hist_id_stomate, 'DMIfmature' ,itime , DMIf(:,:,2) ,npts*nvm, horipft_index)
7459
7460	!condition car ces variables sont dejà ecrite dans la fonction milk animal pour l'ancien module
7461	IF((type_animal.NE.3).AND.(type_animal.NE.6)) THEN
7462	Milk_animal=MPcow2(:,:,1)pyoung+MPcow2(:,:,2)(1-pyoung)
7463
7464	CALL histwrite_p(hist_id_stomate, 'milk' ,itime , Milk_animalnanimaltot,nptsnvm, horipft_index )
7465	CALL histwrite_p(hist_id_stomate, 'milkanimal' ,itime , Milk_animal,npts*nvm, horipft_index )
7466	CALL histwrite_p(hist_id_stomate, 'milkanimalsum' ,itime , milkanimalsum ,npts*nvm, horipft_index )
7467	ENDIF
7468
7469	!Affichage de variables locales à Main_cow
7470	CALL histwrite_p(hist_id_stomate, 'DMIyoung' ,itime , DMIyoung ,npts*nvm, horipft_index )
7471	CALL histwrite_p(hist_id_stomate, 'DMImature' ,itime , DMImature ,npts*nvm, horipft_index )
7472	CALL histwrite_p(hist_id_stomate, 'DMIcalf' ,itime , DMIcalf ,npts*nvm, horipft_index )
7473	CALL histwrite_p(hist_id_stomate, 'OMD' ,itime , OMD ,npts*nvm, horipft_index )
7474
7475	!Affichage de variables locales à la routine
7476	BCScows=BCScow(:,:,1)pyoung_in + BCScow(:,:,2)(1-pyoung_in)
7477	Weightcows=wanimalcow(:,:,1)pyoung_in+wanimalcow(:,:,2)(1-pyoung_in)
7478
7479	CALL histwrite_p(hist_id_stomate, 'Weightcows' ,itime , Weightcows ,npts*nvm, horipft_index)
7480	CALL histwrite_p(hist_id_stomate, 'BCScows' ,itime , BCScows ,npts*nvm, horipft_index)
7481
7482	ENDSUBROUTINE histwrite_cow_Part1
7483
7484	SUBROUTINE histwrite_cow_Part2(npts,CH4young, CH4mature)
7485	INTEGER, INTENT(in) :: npts ! Number of spatial points (-)
7486	REAL(r_std ), DIMENSION(npts,nvm) :: CH4young !
7487	REAL(r_std ), DIMENSION(npts,nvm) :: CH4mature !
7488
7489	CALL histwrite_p(hist_id_stomate, 'CH4young' ,itime , CH4young ,npts*nvm, horipft_index)
7490	CALL histwrite_p(hist_id_stomate, 'CH4mature' ,itime , CH4mature ,npts*nvm, horipft_index)
7491	ENDSUBROUTINE histwrite_cow_Part2
7492
7493	!Cette fonction permet d'estimer le poids du veau a partir d'un certain age et d'un poids de naissance
7494	!cela sert dans le cas ou la mise a l'herbe des animaux est activé par l'autogestion alors que le veau n'est pas encore
7495	!sortie masi qeu le prochain velage n'a pas eu lieu.
7496	!Confert document module animal "silver peace" pour elaboration du modèle
7497	SUBROUTINE estime_weightcalf(age_calf, weight_init, liveweight_calf)
7498	REAL(r_std ), INTENT(in) :: age_calf ! Age of calf
7499	REAL(r_std ), INTENT(in) :: weight_init ! Initial weight of calf
7500	REAL(r_std ), INTENT(out) :: liveweight_calf ! weight of calf
7501
7502	REAL(r_std ) :: a1
7503	REAL(r_std ) :: a2
7504	REAL(r_std ) :: b1
7505	REAL(r_std ) :: b2
7506	REAL(r_std ) :: c1
7507
7508	a1=2.38668*1E-05
7509	a2=-0.002090876
7510	b1=-0.00752016
7511	b2=1.453736796
7512	c1=0.109332016
7513
7514	liveweight_calf=((a1weight_init+a2)age_calf**2)&
7515	+((b1weight_init+b2)age_calf)&
7516	+ (c1+1)*weight_init
7517	ENDSUBROUTINE estime_weightcalf
7518
7519	!Fonction permettant de verifier la cohérence du fichier management
7520	!Retour : 0 - Ok
7521	! 1 - Chevauchement de periode de paturage
7522	INTEGER function Verif_management(npts,nstocking,tanimal,danimal)
7523	INTEGER, INTENT(in) :: npts
7524	! Number of spatial points (-)
7525	INTEGER, INTENT(in) :: nstocking
7526	! Number of spatial points (-)
7527	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tanimal
7528	! Beginning of the grazing period h (1,..,nstocking) (d)
7529
7530	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(in) :: danimal
7531	! Lenght of the grazing period h (1,..,nstocking) (d)
7532	!Local
7533	INTEGER, DIMENSION(npts,nvm) :: cumule_periode
7534	INTEGER :: J
7535	INTEGER :: h
7536	INTEGER :: retour=0
7537
7538	!On verifie qu'il n'y a aucune periode de mise a l'here des animaux qui se chevauchent
7539
7540	!on parcours les 360 jours
7541	!On regarde si il y a cumule de periode, si oui STOP RUN
7542	DO J=1,365
7543	cumule_periode = 0
7544	h = 1
7545
7546	DO WHILE(h .LT. nstocking)
7547	WHERE((J .GE. tanimal(:,:,h)) .AND. &
7548	(J .LT. (tanimal(:,:,h) + danimal(:,:,h))))
7549
7550	cumule_periode = cumule_periode + 1
7551
7552	END WHERE
7553	h = h + 1
7554	END DO
7555	IF(ANY(cumule_periode.GE.2)) THEN
7556	retour=1
7557	ENDIF
7558	h = 1
7559	cumule_periode=0
7560	END DO
7561	Verif_management=retour
7562	end function Verif_management
7563
7564
7565
7566	!Cette fonction est appelée a chaque entrée en paturage afin de calculer
7567	!la perte d'etat max d'une vache laitière pour la période considérée
7568
7569	SUBROUTINE calcul_perte_etat(npts,tjulian,BCScow,MPwmax,tcalving,PEmax)
7570
7571	INTEGER, INTENT(in) :: npts
7572	! Number of spatial points (-)
7573	INTEGER(i_std ), INTENT(in) :: tjulian
7574	! Julian day
7575	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: BCScow
7576	! Body Condition Score (for cow only /5)
7577	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwmax
7578	! Maximum of theoretical milk production (kg/animal/d)
7579	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: tcalving
7580	! Calving date (d)
7581	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: PEmax
7582	! Perte d'etat maximale des vaches laitières sur la periode de paturage
7583
7584	REAL(r_std ), DIMENSION(npts,nvm) :: nWeeklact
7585	! Lactation week (in weeks from calving)
7586
7587	WHERE(tjulian .GE. tcalving)
7588	nWeeklact = CEILING((tjulian-REAL(tcalving))/7+1)
7589	ELSEWHERE
7590	! si tjulian est inférieur à tcalving on considere le velage de l'annee precedente
7591	nWeeklact = CEILING((tjulian-(REAL((tcalving)-365)))/7+1)
7592	ENDWHERE
7593
7594	! Dans les cas ou la definition des conditions d'entree en paturage sont en dehors du
7595	! domaine de validite de l'equation, PEmax peut etre positif
7596	! On borne dans ce cas la perte d'etat max a zero car celle ci doit être signee negativement
7597
7598
7599	PEmax(:,:,1)=0.52615+70.0042nWeekLact(:,:)-&
7600	0.01416MPwmax(:,:,1)-0.3644BCScow(:,:,1)
7601	PEmax(:,:,2)=0.66185+70.0042nWeekLact(:,:)-&
7602	0.01416MPwmax(:,:,2)-0.3644BCScow(:,:,2)
7603
7604	WHERE (PEmax(:,:,1).GT.0.0)
7605	PEmax(:,:,1)=0.0
7606	ENDWHERE
7607
7608	WHERE (PEmax(:,:,2).GT.0.0)
7609	PEmax(:,:,2)=0.0
7610	ENDWHERE
7611
7612	ENDSUBROUTINE calcul_perte_etat
7613
7614
7615
7616	! Fonction permettant de savoir si les animaux paturent au jour J
7617	! Retour : 1:si des animaux sont en paturage au jour J
7618	! 0:sinon
7619	SUBROUTINE in_management(npts,nstocking,tanimal,danimal,tjulian,retour)
7620	INTEGER, INTENT(in) :: npts
7621	! Number of spatial points (-)
7622	INTEGER, INTENT(in) :: nstocking
7623	! Number of spatial points (-)
7624	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tanimal
7625	! Beginning of the grazing period h (1,..,nstocking) (d)
7626	REAL(r_std ), DIMENSION(npts,nvm,nstocking), INTENT(in) :: danimal
7627	! Lenght of the grazing period h (1,..,nstocking) (d)
7628	INTEGER(i_std ), INTENT(in) :: tjulian
7629	! Julian day (-)
7630	INTEGER, DIMENSION(npts,nvm), INTENT(out) :: retour
7631	INTEGER :: h
7632	INTEGER, dimension(npts,nvm) :: cumule_periode
7633	cumule_periode = 0
7634	h = 1
7635	retour=0
7636	DO WHILE(h .LT. nstocking)
7637	WHERE((tjulian .GE. tanimal(:,:,h)) .AND. &
7638	(tjulian .LT. (tanimal(:,:,h) + danimal(:,:,h))))
7639
7640	cumule_periode = cumule_periode + 1
7641
7642	END WHERE
7643	h = h + 1
7644	END DO
7645	WHERE(cumule_periode.EQ.1)
7646	retour=1
7647	ENDWHERE
7648
7649	END SUBROUTINE in_management
7650
7651
7652
7653	!----------------------------------------
7654	! SUBROUTINES DU MODULE ANIMAL LAITIER
7655	!----------------------------------------
7656
7657	SUBROUTINE Calcul_NER_cow(npts,npta,wanimalcow,wcalfborn, Age_animal, nweekgest, MPwcow2,NER,NEGcow,NEMcow)
7658	INTEGER, INTENT(in) :: npts
7659	! Number of spatial points (-)
7660	INTEGER, INTENT(in) :: npta
7661	!
7662	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: wanimalcow
7663	! Animal liveweight (kg/animal) (young:1, adult:2)
7664	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: Wcalfborn
7665	! Calf liveweigth at birth (kg/animal)
7666	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: AGE_animal
7667	! Animal age in case of simulation of dairy cows (months)
7668	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Nweekgest
7669	! Gestation week (in weeks from mating)
7670	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: MPwcow2
7671	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
7672	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NER
7673	! Total net energy required (MJ)
7674	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEGcow
7675	! Net energy required for gestation (MJ)
7676	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEMcow
7677	! Net energy required for gestation (MJ)
7678	REAL(r_std ), DIMENSION(npts,nvm,npta) :: NEPlact ! Net energy required for milk prduction (MJ)
7679
7680
7681	!initialialisation
7682	!
7683	NER(:,:,1)=0
7684	NER(:,:,2)=0
7685
7686	!calcul de besoin d'energie pour la production de lait
7687	! AIG 04/07/2010 On calcule les besoins en énergie pour réaliser la production de lait POTENTIELLE
7688	! NEPlact(:,1)=0.447.12MPcow2(:,1)
7689	! NEPlact(:,2)=0.447.12MPcow2(:,2)
7690	NEPlact(:,:,2)=0.447.12MPwcow2(:,:,1)
7691	NEPlact(:,:,2)=0.447.12MPwcow2(:,:,2)
7692	!calcul de besoin pour la gestation
7693	WHERE (nweekgest.LE.40)
7694	NEGcow(:,:,1)=7.12(3.25-0.08Age_animal(:,:,1) + &
7695	0.00072wcalfborn(:,:)exp(0.116*nweekgest(:,:)))
7696	NEGcow(:,:,2)=7.12(3.25-0.08Age_animal(:,:,2) + &
7697	0.00072wcalfborn(:,:)exp(0.116*nweekgest(:,:)))
7698	ENDWHERE
7699
7700	!calcul des besoin pour l'entretiens
7701	NEMcow(:,:,1)=7.120.041(wanimalcow(:,:,1)*0.75)(1+0.2)
7702	NEMcow(:,:,2)=7.120.041(wanimalcow(:,:,2)*0.75)(1+0.2)
7703
7704	NER=NEPlact+NEGcow+NEMcow
7705	ENDSUBROUTINE Calcul_NER_cow
7706
7707
7708	!--------------------------
7709	! Net Energy requirements
7710	!--------------------------
7711	SUBROUTINE calcul_NEI_cow_d(npts,npta,MPcow2,DMIcowanimal,NELherbage,&
7712	EVf,Forage_quantity_period ,&
7713	EVc,Qic,NEI,NEM,NEIh,NEIf,NEIc)
7714
7715	INTEGER, INTENT(in) :: npts
7716	! Number of spatial points (-)
7717	INTEGER, INTENT(in) :: npta
7718	!
7719	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPcow2
7720	! Daily actual milk production per animal for primiparous or multiparous cows at previous time step (kg/animal/d)
7721	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: DMIcowanimal
7722	! Daily animal intake for primiparous or multiparous cows(kg/animal/d)
7723	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: NELherbage
7724	! Energetic content of the herbage (MJ/kg)
7725	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: EVf
7726	! Energy of the forage based (MJ/Kg)
7727	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: Forage_quantity_period
7728	! Forage quantity (MJ/Kg)
7729	REAL(r_std ), DIMENSION(npts,nvm), INTENT(in) :: EVc
7730	! Energy of the concentrate (MJ/Kg)
7731	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(in) :: Qic
7732	! Concentrate quantity per kg of milk or per kg of LW (MJ/Kg)
7733	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEI
7734	! Net energy intake(MJ/Kg)
7735	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEM
7736	! Net energy intake(MJ/Kg)
7737	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEIh
7738	! Net Energy intake from ingested herbage(MJ)
7739	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEIf
7740	! Net Energy intake from ingested forage(MJ)
7741	REAL(r_std ), DIMENSION(npts,nvm,npta), INTENT(out) :: NEIc
7742	! Net Energy intake from ingested concentrate(MJ)
7743
7744	! Net Energy intake
7745
7746	! Primiparous cows
7747
7748	NEIh(:,:,1)= DMIcowanimal(:,:,1)*NELherbage
7749	NEIf(:,:,1)= Forage_quantity_period(:,:)7.12EVf(:,:)
7750	NEIc(:,:,1)= Qic(:,:,1)MPcow2(:,:,1)EVc(:,:)
7751
7752	! Multiparous cows
7753	NEIh(:,:,2)= DMIcowanimal(:,:,2)*NELherbage
7754	NEIf(:,:,2)= Forage_quantity_period(:,:)7.12EVf(:,:)
7755	NEIc(:,:,2)= Qic(:,:,2)MPcow2(:,:,2)EVc(:,:)
7756
7757	NEI(:,:,1)=NEIh(:,:,1)+NEIf(:,:,1)+NEIc(:,:,1)
7758	NEI(:,:,2)=NEIh(:,:,2)+NEIf(:,:,2)+NEIc(:,:,2)
7759
7760	! Net energy for maintenance
7761
7762	NEM(:,:,1)=7.120.041(wanimalcow(:,:,1)*0.75)(1+0.2)
7763	NEM(:,:,2)=7.120.041(wanimalcow(:,:,2)*0.75)(1+0.2)
7764
7765	! Net energy for gestation
7766	! Attention la gestation ne dure que 9 mois (280j) donc on ne calcule les besoins de gestation
7767	! que pour nweekgest compris entre 0 et 40
7768
7769
7770	ENDSUBROUTINE Calcul_NEI_cow_d
7771
7772	!----------------------------------
7773	! Potential milk production (MPpot)
7774	!----------------------------------
7775
7776	SUBROUTINE Potentiel_dairy_d(npts,tjulian,nweekLact,nweekGest,MPwcow2max,MPwcow2)
7777
7778	INTEGER, INTENT(in) :: npts
7779	! Number of spatial points (-)
7780	INTEGER(i_std ), INTENT(in) :: tjulian
7781	! Julian day (d)
7782	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: nWeeklact
7783	! Lactation week (in weeks from calving)
7784	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: nWeekGest
7785	! Gestation week (in weeks from mating)
7786	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: MPwcow2max
7787	! Daily potential milk production per animal for primiparous or multiparous cows at peak of lactation(kg/animal/d)
7788	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPwcow2
7789	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
7790
7791	! Lactation and gestation weeks
7792	!------------------------------
7793
7794	WHERE(tjulian .GE. tcalving)
7795	nWeeklact = CEILING((tjulian-REAL(tcalving))/7+1)
7796	nWeekGest = CEILING((tjulian-80-REAL(tcalving))/7+1)
7797	ELSEWHERE
7798	! si tjulian est inférieur à tcalving on considere le velage de l'annee precedente
7799	nWeeklact = CEILING((tjulian-(REAL((tcalving)-365)))/7+1)
7800	nWeekGest = CEILING((tjulian-80-(REAL((tcalving)-365)))/7+1)
7801	ENDWHERE
7802
7803	WHERE(nWeekGest.LT.0)
7804	nweekGest=0
7805	ELSEWHERE(nWeekgest.GT.40)
7806	! On considere une gestation de 9 mois soit pas plus de 40 semaines soit 280j
7807	nweekgest=0
7808	ENDWHERE
7809
7810	MPwcow2(:,:,1)=MPwcow2max(:,:,1)(1.084-(0.7exp(-0.46*nWeeklact(:,:)))-&
7811	(0.009nWeeklact(:,:))-(0.69exp(-0.16*(45-nweekgest(:,:)))))
7812	MPwcow2(:,:,2)=MPwcow2max(:,:,2)(1.047-(0.69exp(-0.90*nWeeklact(:,:)))-&
7813	(0.0127nWeeklact(:,:))-(0.5exp(-0.12*(45-nweekgest(:,:)))))
7814
7815	ENDSUBROUTINE Potentiel_dairy_d
7816
7817
7818
7819	SUBROUTINE Milk_Animal_cow_d( &
7820	npts, dt ,&
7821	nanimaltot,tjulian ,&
7822	MPcow2,MPcow,MPwcow2 ,&
7823	MPcowC, MPcowN ,&
7824	MPcowCsum, MPcowNsum, milkanimalsum,milkKG,&
7825	NWeekLact, NWeekGest,PEmax,PEpos,deltaBCS ,&
7826	MPpos,NEIcow,NEMcow,NEGcow,MPcow2_prec ,&
7827	MPpot)
7828
7829	INTEGER, INTENT(in) :: npts
7830	! Number of spatial points (-)
7831	REAL(r_std ), INTENT(in) :: dt
7832	! Time step (d)
7833	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(in) :: nanimaltot
7834	! Stocking density (animal m-2)
7835	INTEGER(i_std ), INTENT(in) :: tjulian
7836	! Julian day (d)
7837	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcow2
7838	! Daily actual milk production per animal for primiparous or multiparous cows (kg/animal/d)
7839	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcow
7840	! Daily milk production per m2 for primiparous or multiparous cows (kg/m2/d)
7841	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPwcow2
7842	! Daily potential milk production per animal for primiparous or multiparous cows (kg/animal/d)
7843	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowC
7844	! C in daily milk production per m2 for primiparous or multiparous cows (kgC/m2/d)
7845	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowN
7846	! N in daily milk production per m2 for primiparous or multiparous cows (kgN/m2/d)
7847
7848	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowCsum
7849	! Cumulated C in milk production per m2 for primiparous or multiparous cows (kgC/m2)
7850	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPcowNsum
7851	! Cumulated N in milk production per m2 for primiparous or multiparous cows (kgN/m2)
7852	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(inout) :: milkanimalsum
7853	! Milk production per animal and per year (L.(animal.year)-1)
7854	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: nWeeklact
7855	! Lactation week (in weeks from calving)
7856
7857	REAL(r_std ), DIMENSION(npts,nvm) , INTENT(out) :: nWeekGest
7858	! Gestation week (in weeks from mating)
7859	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: PEmax
7860	! Perte d'etat maximale des vaches laitières sur la periode de paturage
7861	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: PEpos
7862	! Perte d'etat possible des vaches laitières au jour j
7863	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: deltaBCS
7864	! Body condition score variation between two consecutive time steps (-)
7865	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPpos
7866	! Possible milk production of dairy cows according to the diet (kg/animal/d)
7867	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEIcow
7868	! Total net energy intake (1:young, 2:adult) (MJ)
7869	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEMcow
7870	! Net energy for maintenance (young :1 , adult:2) (MJ)
7871	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(in) :: NEGcow
7872	! Net energy for gestation (dairy cows)(young :1 , adult:2) (MJ)
7873	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(inout) :: MPcow2_prec
7874	! Daily actual milk production per animal for primiparous or multiparous cows at previous time step (kg/animal/d)
7875	REAL(r_std ), DIMENSION(npts,nvm,2), INTENT(out) :: MPpot
7876	! Potential milk production (kg/d)
7877
7878	REAL(r_std ), DIMENSION(npts,nvm) :: milkKG
7879	! Daily actual milk production per animal for the whole cattle (kg/animal/d)
7880	REAL(r_std ), DIMENSION(npts,nvm,2) :: MR
7881	! Milk response (-)
7882	REAL(r_std ), DIMENSION(npts,nvm,2) :: RF
7883	! Remobilisation fraction (-)
7884	REAL(r_std ), DIMENSION(npts,nvm) :: Fremob
7885	! facteur de remobilisation (fonction de la lactation)
7886	REAL(r_std ), DIMENSION(npts,nvm,2) :: MPwcow2max
7887	! Daily potential milk production per animal for primiparous or multiparous cows at peak of lactation(kg/animal/d)
7888	REAL(r_std ), DIMENSION(npts,nvm) :: milkanimal_write
7889	! Milk production per animal and per day (kg animal-1 d-1)
7890	REAL(r_std ), DIMENSION(npts,nvm,2) :: min_NEB
7891	! minimum value of NEB for milk production calculation
7892	INTEGER :: i,k,j
7893	! For loop
7894
7895	MPwcow2max(:,:,1)=MPwmax(:,:,1)
7896	! potential milk production of primiparous cows (kg)
7897	MPwcow2max(:,:,2)=MPwmax(:,:,2)
7898	! potential milk production of multiparous cows (kg)
7899
7900	!Calcul de la production de lait possible
7901	! AIG June 2010 To avoid that possible milk production could be negative
7902	MPpos(:,:,1)=max(0.0,(NEIcow(:,:,1)-NEMcow(:,:,1)-NEGcow(:,:,1))/(0.44*7.12))
7903	MPpos(:,:,2)=max(0.0,(NEIcow(:,:,2)-NEMcow(:,:,2)-NEGcow(:,:,2))/(0.44*7.12))
7904
7905
7906	! Lactation and gestation weeks
7907	!------------------------------
7908
7909	WHERE(tjulian .GE. tcalving)
7910	nWeeklact = CEILING((tjulian-REAL(tcalving))/7+1)
7911	nWeekGest = CEILING((tjulian-80-REAL(tcalving))/7+1)
7912	ELSEWHERE
7913	! si tjulian est inférieur à tcalving on considere le velage de l'annee precedente
7914	nWeeklact = CEILING((tjulian-(REAL((tcalving)-365)))/7+1)
7915	nWeekGest = CEILING((tjulian-80-(REAL((tcalving)-365)))/7+1)
7916	ENDWHERE
7917
7918	WHERE(nWeekGest.LT.0)
7919	nweekGest=0
7920	ELSEWHERE(nWeekgest.GT.40)
7921	! On considere une gestation de 9 mois soit pas plus de 40 semaines soit 280j
7922	nweekgest=0
7923	ENDWHERE
7924
7925	!
7926
7927	WHERE(nWeeklact(:,:).GE.20)
7928	Fremob(:,:)=0.66(1-0.02(nWeekLact(:,:)-20))
7929	ELSEWHERE
7930	Fremob(:,:)=0.66
7931	ENDWHERE
7932
7933	! Potential milk production for young and mature cows (kg/animal)
7934	!----------------------------------------------------
7935	MPpot(:,:,1)=MPwcow2max(:,:,1)(1.084-(0.7exp(-0.46*nWeeklact))-&
7936	(0.009nWeeklact)-(0.69exp(-0.16*(45-nweekgest))))
7937	MPpot(:,:,2)=MPwcow2max(:,:,2)(1.047-(0.69exp(-0.90*nWeeklact))-&
7938	(0.0127nWeeklact)-(0.5exp(-0.12*(45-nweekgest))))
7939
7940	! Possible remobilisation of body reserves
7941	!---------------------------------------
7942	PEpos(:,:,1)=PEpos(:,:,1)-deltaBCS(:,:,1)
7943	PEpos(:,:,2)=PEpos(:,:,2)-deltaBCS(:,:,2)
7944
7945	DO k=1,2
7946	WHERE((MPpos(:,:,k)-MPpot(:,:,k).LT.0).AND.(PEmax(:,:,k).NE.0))
7947	RF(:,:,k)= PEpos(:,:,k)/PEmax(:,:,k)
7948	ELSEWHERE
7949	RF(:,:,k)=0
7950	ENDWHERE
7951	ENDDO
7952
7953	! Milk response (-)
7954	!---------------
7955
7956	MR(:,:,1)=Fremob(:,:)*RF(:,:,1)
7957	MR(:,:,2)=Fremob(:,:)*RF(:,:,2)
7958
7959
7960	! Observed milk production of dairy cows (Kg[milk]/animal/d)
7961	!-----------------------------------------------------------
7962	WHERE(nWeeklact .LE.43)
7963
7964	WHERE((MPpos(:,:,1)-MPpot(:,:,1)).LT.0.0)
7965	! AIG June 2010 to avoid that milk production could be negative
7966	!MPcow2(:,1)=min(MPpot(:,1),max(0.0,MPpos(:,1)-MR(:,1)*(MPpos(:,1)-MPpot(:,1))))
7967	MPcow2(:,:,1)=max(0.0,MPpos(:,:,1)-MR(:,:,1)*&
7968	(MPpos(:,:,1)-MPpot(:,:,1)))
7969	ELSEWHERE
7970	MPcow2(:,:,1)=MPpot(:,:,1)
7971	ENDWHERE
7972
7973
7974	WHERE((MPpos(:,:,2)-MPpot(:,:,2)).LT.0.0)
7975	! AIG June 2010 to avoid that milk production could be negative
7976	!MPcow2(:,2)=min(MPpot(:,2),max(0.0,MPpos(:,2)-MR(:,2)*(MPpos(:,2)-MPpot(:,2))))
7977	MPcow2(:,:,2)=max(0.0,MPpos(:,:,2)-MR(:,:,2)*&
7978	(MPpos(:,:,2)-MPpot(:,:,2)))
7979	ELSEWHERE
7980	MPcow2(:,:,2)=MPpot(:,:,2)
7981	ENDWHERE
7982
7983	ELSEWHERE
7984	MPwcow2(:,:,1)= 0.0
7985	MPwcow2(:,:,2)= 0.0
7986	MPcow2(:,:,1) = 0.0
7987	MPcow2(:,:,2) = 0.0
7988	MPpos(:,:,1) = 0.0
7989	MPpos(:,:,2) = 0.0
7990	ENDWHERE
7991
7992
7993	MPcow2_prec=MPcow2
7994
7995	milkKG=MPcow2(:,:,1)pyoung+MPcow2(:,:,2)(1-pyoung)
7996
7997
7998	WHERE (nanimaltot.EQ.0)
7999	milkKG=0.0
8000	MPcow2(:,:,1)=0.0
8001	MPcow2(:,:,2)=0.0
8002	MPpos(:,:,1)=0.0
8003	MPpos(:,:,2)=0.0
8004	ENDWHERE
8005
8006	! Daily milk production per m2 for primiparous or multiparous cows (kg/m2/d)
8007	!----------------------------------------------------------------
8008	MPcow(:,:,1) = nanimaltot * MPcow2(:,:,1) * pyoung
8009	MPcow(:,:,2) = nanimaltot * MPcow2(:,:,2) * (1-pyoung)
8010
8011
8012	! C in MPcow (kgC/m2/d)
8013	!----------------------
8014	MPcowC = 0.0588 * MPcow
8015
8016	! N in MPcow (kgN/m2/d)
8017	!----------------------
8018	MPcowN = 0.00517 * MPcow
8019	DO j=2,nvm
8020	CALL Euler_X(npts,2, dt, MPcow(:,j,:) , MPcowsum(:,j,:))
8021	CALL Euler_X(npts,2, dt, MPcowC(:,j,:), MPcowCsum(:,j,:))
8022	CALL Euler_X(npts,2, dt, MPcowN(:,j,:), MPcowNsum(:,j,:))
8023	CALL Euler_X(npts,2, dt, MPcow2(:,j,:), MPcow2sum(:,j,:))
8024
8025	! milk_write=MPcow(:,1)+MPcow(:,2)
8026	milkanimal_write(:,j)=MilkKG(:,j)
8027
8028
8029	CALL Euler_funct (npts, dt, milkanimal_write(:,j), milkanimalsum(:,j))
8030	ENDDO
8031	ENDSUBROUTINE Milk_animal_cow_d
8032
8033	END MODULE grassland_grazing

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

Download in other formats: