Context Navigation

grassland_grazing.f90 @ 7108

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

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

Context Navigation

source: branches/publications/ORCHIDEE-MICT-OP-r6850/src_stomate/grassland_grazing.f90 @ 7108

Download in other formats: