Context Navigation

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

Last change on this file since 6737 was 3932, checked in by albert.jornet, 8 years ago

Merge: from revisions [3923:3931/perso/jinfeng.chan/MICT_JC]. GRM update. Done by Jinfeng

This modifications include:

adding PASTURE flag to prescribe pasture PFTs as done for non-natural (cropland) when activating DGVM
small bug fix in GRM grazing module

File size: 335.2 KB

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

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

Download in other formats: