Context Navigation

Stics_Develop.f90 @ 7421

Last change on this file since 7421 was 5089, checked in by albert.jornet, 6 years ago
Fix: missing OpenMP threadprivate declarations ( LMDZ+MICT ) Fix: group variable (stics module) was defined as real but passed as an integer Fix: masec variable (stics module) it was modified but passed as input argument only
File size: 45.4 KB

Line
1	!> Routine develop2
2	!>
3	!! Description :
4	!< (routine qui prend des arguments simples)
5
6	! DR 23/07/2012 latitude est pas itilisé car on passe la photoperiode qui est suffisante
7	!subroutine develop2(phoi,tmax,tmin,tmin_demain,trr,P_codeh2oact,P_codeinitprec,P_codeinnact,codeulaivernal,P_psihucc, &
8	! P_psihumin, P_codcueille,P_codefauche,P_densitesem,P_profsem,P_variete,P_ampfroid,P_belong,P_celong, &
9	! P_codebfroid,P_codedormance,P_codegdh, P_codegdhdeb,P_codegermin,P_codehypo,P_codeperenne,P_codephot, &
10	! P_codeplante,P_coderetflo,P_codetemp,coeflev,cu_min,cu_veille, densite,densiteger,densitelev,P_elmax, &
11	! innlai,P_julvernal,P_jvc,P_jvcmini,P_nbjgerlim,ndrpobs,P_nlevlim1,P_nlevlim2,nlevobs,nplt,onarretesomcourdrp,&
12	! P_phobase,P_phosat,P_potgermi,P_propjgermin,P_q10,P_sensiphot,P_sensrsec,somelong,somger,P_stdordebour, &
13	! P_stpltger,P_stressdev,P_tcxstop,P_tdmax,P_tdmaxdeb,P_tdmin,P_tdmindeb,P_tfroid,P_tgmin,turfac,P_vigueurbat, &
14	! P_codefente,P_mulchbat,P_pluiebat,P_culturean,nbCouches,dacouche,hucc,humin,hur,jjul,n,nbjanrec,nbjsemis, &
15	! numcult,tairveille,tcult,tsol,xmlch1,P_codepluiepoquet,P_codetempfauche,humectation,nbjhumec,pluiesemis, &
16	! somtemphumec,P_codeindetermin,P_codelaitr,P_codlainet,P_dureefruit,namfobs,P_nbcueille,nfloobs, &
17	! nlanobs, nlaxobs,nmatobs,nrecobs,nsenobs,P_stdrpnou,upobs,P_codemontaison,sioncoupe, &
18	! caljvc,cu,demande,etatvernal,hauteur,mafrais,mafraisfeuille,mafraisrec,mafraisres,mafraistige,masec,namf, &
19	! ndebdorm,ndrp,nfindorm,nflo,nger,nlan,nlev,nrec,nrecbutoir,pdsfruitfrais,rfpi,rfvi,somcour,somcourdrp, &
20	! somcourfauche,somcourutp,somtemp,stpltlev,tdevelop,udevair,udevcult,upvt,utp,zrac,maxwth,group,ndebdes, &
21	! nfruit,nlax,nmat,nnou,nsen,R_stamflax,R_stdrpdes,R_stdrpmat,stdrpsen,R_stflodrp,R_stlaxsen,R_stlevamf, &
22	! R_stlevdrp,stlevflo,stmatrec,R_stsenlan,upvtutil, P_codrecolte,h2orec,P_sucrerec,P_CNgrainrec,P_huilerec, &
23	! sucre,huile,teaugrain,P_h2ofrvert,P_codeaumin, P_h2ograinmin,P_h2ograinmax,P_deshydbase, &
24	! CNgrain,P_cadencerec, jdepuisrec,pdsfruit,nbrecolte,nrecint,rdtint,teauint,nbfrint,onestan2,somcourmont, &
25	! nmontaison,stpltger)
26
27	! Here, we modify the develop2 processes.
28
29	subroutine develop2(n, in_cycle, nplt, tair, gdh_daily, turfac, phoi, onarretesomcourdrp, stempdiag_cm_daily, shumdiag_cm_day, lai, & !> INPUTS
30	nlevobs, namfobs, nfloobs, nlanobs, nlaxobs, nmatobs, nrecobs, nsenobs, ndrpobs, nrecbutoir, & !> INPUTS
31	masec, namf, ndrp, nflo, nger, nlan, nlev, nrec, etatvernal, caljvc, & !> INOUT
32	upvt, utp, somcour, somcourdrp, somcourfauche, somcourutp, somtemp, zrac, & !> INOUT
33	coeflev, somelong, somger, humectation, nbjhumec, somtemphumec, densite, densitelev, nlax, nmat, nsen, stlevflo, ndebdes, & !> INOUT
34	R_stlevamf, R_stamflax, R_stsenlan, R_stlaxsen, R_stlevdrp, R_stflodrp, R_stdrpmat, R_stdrpdes, densiteger, & !> INOUT
35	udevair, udevcult, & !> INOUT
36	rfvi, rfpi, tdevelop, stpltger, upvtutil, stmatrec, group, tcult, stpltlev, & !>INOUT
37	f_crop_recycle, gslen, drylen)
38
39
40	USE Divers_develop
41	USE Besoins_en_froid
42	USE Stics
43	USE constantes
44	!USE Messages
45
46	implicit none
47
48	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
49	! declaration of variables
50
51	! 0.1 input
52
53
54	integer, intent(IN) :: n
55	logical, intent(inout) :: in_cycle
56	integer, intent(IN) :: nplt
57	real, intent(IN) :: tair !> / Mean air temperature of the day // degree C
58	real, intent(IN) :: gdh_daily !> // daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
59	real, intent(IN) :: turfac
60	real, intent(IN) :: phoi !> // OUTPUT // Photoperiod // hours
61	logical, intent(IN) :: onarretesomcourdrp
62	real, intent(IN), dimension(3) :: stempdiag_cm_daily !> / soil temperature at 1 cm resolution for the sowing depth and neighbour layers // Degree C
63	real, intent(IN), dimension(3) :: shumdiag_cm_day !> /soil moisture at 1 cm resolution for the sowing depth and neighbour layers // unit m3 m-3 with values ranging 0-1
64	real, intent(IN) :: lai !> leaf area index
65	integer, intent(IN) :: nlevobs
66	integer, intent(IN) :: namfobs
67	integer, intent(IN) :: nfloobs
68	integer, intent(IN) :: nlanobs
69	integer, intent(IN) :: nlaxobs
70	integer, intent(IN) :: nmatobs
71	integer, intent(IN) :: nrecobs
72	integer, intent(IN) :: nsenobs
73	integer, intent(IN) :: ndrpobs
74	integer, intent(IN) :: nrecbutoir !// the harvest date imposed, actually, if we simulate the harvest automatically, we do not use it. So, we initialize it as 999.
75
76	! 0.2 inout
77
78	real, intent(INOUT) :: masec
79
80	integer, intent(INOUT) :: namf
81	integer, intent(INOUT) :: ndrp
82	integer, intent(INOUT) :: nflo
83	integer, intent(INOUT) :: nger
84	integer, intent(INOUT) :: nlan
85	integer, intent(INOUT) :: nlev
86	integer, intent(INOUT) :: nrec
87	logical, intent(INOUT) :: etatvernal
88	real, intent(INOUT) :: caljvc
89	real, intent(INOUT) :: upvt !> // OUTPUT // Daily development unit // degree.days
90	real, intent(INOUT) :: utp
91	real, intent(INOUT) :: somcour !> // OUTPUT // Cumulated units of development between two stages // degree.days
92	real, intent(INOUT) :: somcourdrp
93	real, intent(INOUT) :: somcourfauche
94	real, intent(INOUT) :: somcourutp
95	real, intent(INOUT) :: somtemp !> // OUTPUT // Sum of temperatures // degree C.j
96	real, intent(INOUT) :: zrac !> // OUTPUT // Depth reached by root system // cm
97	real, intent(INOUT) :: coeflev
98	real, intent(INOUT) :: somelong
99	real, intent(INOUT) :: somger
100	logical, intent(INOUT) :: humectation
101	integer, intent(INOUT) :: nbjhumec
102	real, intent(INOUT) :: somtemphumec
103	real, intent(INOUT) :: densite !> actual sowing density // plants m-2
104	real, intent(INOUT) :: densitelev
105	integer, intent(INOUT) :: nlax
106	integer, intent(INOUT) :: nmat
107	integer, intent(INOUT) :: nsen
108	real, intent(INOUT) :: stlevflo
109	integer, intent(INOUT) :: ndebdes
110	real, intent(INOUT) :: R_stlevamf
111	real, intent(INOUT) :: R_stamflax
112	real, intent(INOUT) :: R_stsenlan
113	real, intent(INOUT) :: R_stlaxsen
114	real, intent(INOUT) :: R_stlevdrp
115	real, intent(INOUT) :: R_stflodrp
116	real, intent(INOUT) :: R_stdrpmat
117	real, intent(INOUT) :: R_stdrpdes
118	real, intent(INOUT) :: densiteger
119	real, intent(INOUT) :: udevair !> // OUTPUT // Effective temperature for the development, computed with TAIR // degree.days
120	real, intent(INOUT) :: udevcult !> // OUTPUT // Effective temperature for the development, computed with TCULT // degree.days
121
122	logical, intent(inout) :: f_crop_recycle ! > in levee subroutine, we judge whether or not the crop emerges, if not, the in_cycle shoule be false, and crop recycle
123	integer, intent(INOUT) :: gslen
124	integer, intent(INOUT) :: drylen
125
126
127
128
129	! 0.3 out
130
131	! DEVELOP
132
133	real, intent(OUT) :: rfvi !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
134	real, intent(OUT) :: rfpi !> // OUTPUT // Slowing effect of the photoperiod on plant development // 0-1
135	real, intent(OUT) :: tdevelop
136	real, intent(OUT) :: stpltger
137	real, intent(OUT) :: upvtutil
138	real, intent(OUT) :: stmatrec
139	real, intent(OUT) :: group
140	real, intent(OUT) :: tcult !> / Mean crop temperature of the day // degree C
141	real, intent(OUT) :: stpltlev
142
143	! 0.4 local Variables
144	real :: tdev
145
146
147
148
149	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
150	! 1. CONDITIONAL STATEMENT AND INITIALIZATION
151
152	!: Pour les annuelles => pas de développement avant le semis
153	!- DR - 03/05/06
154	!- dans le cas de repousse du semis par decisionsemis on ne commence pas les cumul d'unite
155
156
157	if (P_codeperenne == 1 .and. ((n /= nplt) .and. (in_cycle == .FALSE.))) then
158	return
159	else
160
161	in_cycle = .TRUE. ! enter the cycle
162
163	!! FIRST STEP: WE ACCOUNT THE GROWING LENGTH
164
165	gslen = gslen + 1
166
167
168	!: On remet à zéro les masses sèches, masses fraiches, masses des fruits, la hauteur de la plante, les variables de fixation (et le zrac ?)
169	!: Marie et Domi - 10/10/03 - bug signalé par Emmanuelle Sauboua
170	!- N'était jamais testé dans 'recolte'
171
172	! comments:
173	! reinitialization of some variables, which are related to harvest
174	! P_codcueille: way how to harvest
175	! 1. We do not use the process of stics to address biomass production;
176	! 2. we also do not consider the root dynamics at this moment
177
178
179	if (P_codeperenne == 1 .and. P_codcueille == 1) then ! P_codcueille: way how to harvest, 1, whole plant, 2, only fruits
180	if (n == nrec+1) then
181	masec = 0.
182	zrac = 0.
183	!mafrais(:) = 0.
184	!pdsfruitfrais(:) = 0.
185	!hauteur(:) = 0. ! DR - 22/10/03
186	!demande(:) = 0. ! PB - 03/05/2004 - remise à zéro des variables de fixation
187	!!: DR - 13/01/06 - remise à zero sinon mafrais ne revient pas nul
188	!mafraisfeuille(:) = 0.
189	!mafraistige(:) = 0.
190	!mafraisres(:) = 0.
191	!mafraisrec(:) = 0.
192	endif
193	!: Pour les cultures annuelles (P_codeperenne=1) moissonnées (P_codcueille=1) : pas de développement après la récolte.
194	if (n > nrec .and. nlan > 0 .and. nrec > 0) return ! exit this subroutine
195	endif
196
197	!: PB - 11/03/2005 - On remet pdsfruitfrais à zéro après la récolte.
198	!: PB - 07/08/2009 - Attention, qd n=1 et nrec=0, cette condition peut être vraie alors qu'on est pas après la récolte.
199	! TODO: Ajouter un test sur nrec est nul ?
200	!if (P_codeperenne == 2 .and. P_codcueille == 2 .and. n == (nrec+1) .and. P_codeinitprec == 2) then
201	! pdsfruitfrais(:) = 0.
202	!endif
203
204	! TODO : GERER LE CAS DES CULTURES ANNUELLES A RECOLTES MULTIPLES
205
206
207
208	!2 . CALCULATION OF EFFECT TEMPERATURE (calcul udevair/udevcult)
209	! -------------------------------------------
210
211	!: daily temperature
212	!- NB - 07/07/06: Application du seuil thermique négatif P_TCXSTOP au développement
213
214	tcult = tair ! here, we do not use the crop temperature, later if we use the tcult, this sentence shoul dbe commented.
215
216
217	if (P_codegdh == 1) then !
218	udevair = calcul_UDev(tair)
219	udevcult = calcul_UDev(tcult)
220	endif
221
222	! print *, 'udevair and udevcult in develop is', udevair, udevcult
223
224	!: hourly temperature
225	if (P_codegdh == 2) then
226
227	!: Pour l'instant que températures air autorisées
228	if (P_codetemp == 2) then
229	!call EnvoyerMsgHistorique(49)
230	stop
231	endif
232
233	!: 1) Reconstitution des températures horaires.
234	!- Pour l'instant on n'autorise uniquement le cas par températures air.
235	!thor = calcul_TemperaturesHoraires(tmin,tmin_demain,tmax)
236
237	!: 2) calculation gdh
238	! using hourly temperature, only available for air temperature.
239	! see stomate.f90
240
241	udevair = gdh_daily ! the GDH calculated according to halfhourly temperature is implemented in stomate.f90
242	!udevair = calcul_GDH(thor,P_tdmin,P_tdmax)
243	udevcult = udevair
244
245	endif
246
247
248
249	! NB - le 01/09/06:
250	! effet retard du stress hydrique en phase végétative appliqué directement
251	! sur les udevair (ou udevcult) de façon à ce qu'il agisse sur le développement
252	! P_phénologique et également sur la durée de vie.
253	! modif pour Sophie pour permettre action de P_stressdev pendant tout le cycle et
254	! en n'utilisant qu'un seul des deux stress
255	! DR et ML et La Soso - 15/08/07 - y'avait un bug introduit par sophie et on sait
256	! pas qui. On passait la tout le temps meme quand P_coderetflo=2
257	! if (P_coderetflo == 1.and.P_codeinnact == 1 .or. P_codeh2oact == 1)
258
259	! considering the water and/or nitrogen limiting effects--xcw
260	! at this moment, we do not consider the Nitrogen processes, nitrogen limitation factor innlai is seted as parameter with a value of 1
261	! the calculation of turfac is done in stress subroutine
262
263	if (P_coderetflo == 1 .and. (P_codeinnact == 1 .or. P_codeh2oact == 1)) then
264	if (P_codeplante == 'qui' .or. ndrp == 0) then
265	if (P_codetemp == 2) then
266	udevcult = udevcult * (P_stressdev * min(turfac,P_innlai) + 1 - P_stressdev)
267	else
268	udevair = udevair * (P_stressdev * min(turfac,P_innlai) + 1 - P_stressdev)
269	endif
270	endif
271	endif
272
273
274
275	! 3. EFFECTS OF VERNALIZATION (calcul de rfvi)
276	! ---------------------------------
277	if (P_codebfroid == 1) rfvi = 1.0
278
279	!: Calcul de l'effet vernalisation a partir de la germination
280	!- ou en cours de culture après la date P_julvernal
281	!- calculs données intermédiaires
282	if (P_codebfroid == 2) then
283	!: set the optional temperature for tdev
284	if (P_codetemp == 2) then
285	tdev = tcult
286	else
287	tdev = tair
288	endif
289
290	! calculation of rfvi, actually, we only use the subroutine vernalization to calculate the rfvi
291	! Considering vernalization when germination
292
293	call Stics_Develop_bfroid2(nger, &
294	tdev, &
295	rfvi, &
296	etatvernal, &
297	caljvc)
298
299	! call Stics_Develop_bfroid2(jjul,n,P_tfroid,P_ampfroid,P_julvernal,P_jvc,P_jvcmini,P_codeperenne, &
300	! nger,namf,numcult,nbjsemis,tdev,P_codemontaison,P_culturean, &
301	! P_codeinitprec,nbjanrec, &
302	! nrecbutoir,rfvi,maxwth,etatvernal,caljvc,onestan2)
303	endif
304	! print *, 'in develop the rfvi is,', rfvi
305
306
307	! COMMENTS: P_codebfroid == 3 is only effective for perennial crops;
308	! at this moment, we do not address such crops-----xcwu
309
310	! if (P_codebfroid == 3) then
311	! call Stics_Develop_bfroid3(P_codedormance,cu_min,cu_veille,n,P_jvc,P_q10,tmin,tmax,thor, &
312	! etatvernal,cu,rfvi,ndebdorm,nfindorm,nlev)
313	! endif
314
315
316	! 4. EFFECTS OF PHOTOPERIOD (calcul of rfpi)
317	! -----------------------------
318	if (P_codephot == 1) then
319	!numdate = MOD(jjul,nbjsemis+1)
320	!numdate = jjul
321	!if (jjul > nbjsemis) numdate = jjul - nbjsemis
322
323	!call photpd(P_latitude,numdate,daylen,phoi)
324
325	!if (ndrp /= 0 .or. n > ndrpobs) then
326	if (ndrp /= 0) then
327	rfpi = 1.0
328	else if (P_codebfroid /= 3 .and. (nlev == 0 .or. n < nlev)) then ! pour les ligneux, photopériode active à partir de la fin de dormance
329	rfpi = 1.0
330	!else if (P_codebfroid == 3 .and. nfindorm == 0) then
331	! rfpi = 1.0
332	else
333	! TODO: on remplace l'appel à photpd par ses résultats. photpd n'est appelé qu'une fois par pas de temps
334	rfpi = cRFPI(phoi)
335	endif
336	else
337	rfpi = 1.0
338	endif
339
340	! print *, 'in develop the rfpi is,', rfpi
341
342	! 5. UNIT OF DEVELOPPEMENT (calcul de upvt)
343	! ---------------------------------------------------
344	if (P_codetemp == 2) then
345	! DR 17/08/06 si on est sur une perenne et qu'une dormance a deja ete faite
346	! on ne fait plus jouer la vernalisation sur le calcul des stades
347	! implicitement n'est utilisé que si on est en enchainement
348
349
350	! the calculation of upvt is done
351	if (P_codedormance == 3 .and. nlev > 0) then
352	upvt = udevcult * rfpi
353	else
354	upvt = udevcult * rfpi * rfvi
355	endif
356
357	! option codelaisansvernal la vernalisation ne joue pas sur la ulai
358	if (codeulaivernal == 0) utp = udevcult * rfpi
359	else
360	! DR 17/08/06 si on est sur une perenne et qu'une dormance a deja ete faite
361	! on ne fait plus jouer la vernalisation sur le calcul des stades
362	! implicitement n'est utilisé que si on est en enchainement
363	! NB le 21/08/07 bug
364	if (P_codebfroid == 3 .and. P_codedormance == 3 .and. nlev > 0) then
365	upvt = udevair * rfpi
366	else
367	upvt = udevair * rfpi * rfvi
368	endif
369
370	if (codeulaivernal == 0) utp = udevair * rfpi
371	endif
372
373
374	!: calculation of the cumulated units of development between two stages
375	somcour = somcour + upvt
376
377	! print *, 'somcour and upvt in development is', somcour, upvt
378
379	!: somcourdrp = cumul d'unité entre deux stades reproducteurs
380	!- à partir de la levee
381	if (nlev > 0) somcourdrp = somcourdrp + upvt
382
383	! dr 13/01/06: dans le cas de la prairie on ne cumule plus d'upvt si on coupe apres amf
384	! dr 17/11/05: si on coupe apres amf et avant drp on ne pourra plus faire d'epi
385	! donc on arrete le developpement des stades reproducteurs
386	if (P_codefauche == 1 .and. onarretesomcourdrp) then ! P_codefauche cut mode for forage crop, cut (1) or not (2)
387	if (namf /= 0 .and. (ndrp == 0 .or. nflo == 0)) then
388	somcourdrp = somcourdrp - upvt
389	endif
390	endif
391
392	if (codeulaivernal == 0) then
393	somcourutp = somcourutp + utp
394	endif
395
396
397	!: calcul d'une somme de températures même
398	!- pour les plantes vernalo-photo-sensibles
399	!- pour les calculs de sénescence et de nombre de feuilles
400	!-
401	!- NB le 08/05 on remplace la somme des températures pour
402	!- la sénescence par un P_Q10 pour que le vieillissement soit effectif meme
403	!- en conditions froides
404	if (P_codetemp == 2) then
405	tdevelop = 2.0 ** (udevcult / 10.)
406	else
407	tdevelop = 2.0 ** (udevair / 10.)
408	endif
409
410	somtemp = somtemp + tdevelop
411	if (P_codetempfauche == 1) then
412	somcourfauche = somcourfauche + upvt
413	else
414	somcourfauche = somcourfauche + udevair
415	endif
416
417	! print *, 'somcour and tdevelop, somtemp in develop is:', somcour, tdevelop, somtemp
418
419
420	! 6. CALCULATION OF THE STATUS
421	! -----------------
422	!
423
424	! This part is for perennial grassland----xcwu
425
426	!! DR et ML et SYL 16/06/09
427	!! calcul de la date de montaison et du jour d'entree en
428	!! vernalisation de la prairie perenne
429	! if (P_codemontaison == 1)then
430	!! ####
431	!! entrée en vernalisation des fourrages (pérenne)
432	!! NB le 07/03/08
433	! if (P_codebfroid == 2 .and. P_codeperenne == 2) then
434	! somcourmont = somcourmont + upvt
435	! ! PB - 03/08/2010 - je remplace jul par jjul qui correspond à n+P_iwater-1
436	! if (jjul+((onestan2-1)*nbjsemis) == P_julvernal) then
437	! somcourmont = 0.0
438	! endif
439	!! ** stade début montaison : après vernalisation
440	!! unique cycle reproducteur de l'année
441	! if (somcourmont >= R_stlevamf .and. jjul+((onestan2-1)*nbjsemis) > P_julvernal)then
442	! nmontaison = n
443	! namf = n
444	!! DR et ML et SYL 16/06/09 - on supprime nvernal qui ne sert à rien
445	!! -- nvernal=0
446	! somcourmont=0.0
447	! onestan2 = 1
448	! endif
449	!
450	!! si la coupe intervient après le stade montaison alors on remet
451	!! le stade à 0
452	! if (sioncoupe) nmontaison=0
453	! endif
454	!! ####
455	! endif
456	!! DR et ML et SYL 16/06/09 FIN
457
458	!: 6.1 STATUS OF GERMINATION AND EMERGENCE
459	!: levee
460	!: in this subroutine, we know when the crop germinates and emerges. We allowed the winter wheat emerges in the following spring within a reasonable period.
461	!: However, if the crop can not emerge within this period, we stop the crop growth (in_cycle) and go into another cropping season (f_crop_recycle).
462
463	! write(,) 'Pstade0: ', P_stade0
464	if (TRIM(P_stade0) == 'snu') then
465	if (nlev == 0) &
466	call levee(n,stempdiag_cm_daily, shumdiag_cm_day, nlevobs, & ! INPUTS
467	densiteger,densite,coeflev,densitelev,zrac, & ! INOUT
468	somelong,somger,nlev,nger, humectation,nbjhumec,somtemphumec,somcour, &
469	in_cycle, f_crop_recycle, nplt) ! INOUT
470	elseif (TRIM(P_stade0) == 'lev') then
471	if (nlev==0) then
472	nger = n
473	nlev = n
474	! nger = 0
475	coeflev = 1
476	densiteger = P_densitesem
477	densitelev = densiteger*coeflev
478	zrac = P_profsem
479	densite = densitelev
480	endif
481	else
482	write(,) 'Pstade0 ', P_stade0, ' not recognized'
483	endif
484
485	! DR 18/07/2012 je rajoute la germination
486	if (n == nger) then
487	stpltger = somcour
488	! on affecte le cumul de température entre le semis et la levée
489	! DR 18/07/2012 pour la germination on affiche juste somcour sans le reinitialiser
490	! somcour = 0.0 ! on remet à zéro le cumul de température courant.
491	! if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
492	! if (P_codefauche == 2) somcourfauche = 0.0
493	! if (codeulaivernal == 0) somcourutp = 0.0
494	endif
495
496
497	if (nlevobs == 999) then ! pas d'observation pour la levée
498	if (n == nlev) then ! si on est le jour de la levée
499	stpltlev = somcour ! on affecte le cumul de température entre le semis et la levée
500	somcour = 0.0 ! on remet à zéro le cumul de température courant.
501	if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
502	if (P_codefauche == 2) somcourfauche = 0.0
503	if (codeulaivernal == 0) somcourutp = 0.0
504	endif
505	!else ! levée observée, this means that we used the forced LAI, but at this moment we do not use this option
506	! if (n == nlevobs) then ! si on est le jour de la levée observée
507	! nlev = nlevobs ! on force nlev
508	! if (nger <= 0) nger = nlev ! si la germination n'a pas encore été affectée, on la force au jour de la levée
509	! ! réajustement du parcours de dl
510	! stpltlev = somcour ! on affecte le cumul de température entre le semis et la levée
511	! somcour = 0.0 ! on remet à zéro le cumul de température courant.'
512	! if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
513	! if (P_codefauche == 2) somcourfauche = 0.0
514	! if (codeulaivernal == 0) somcourutp = 0.0
515	! endif
516	endif
517
518
519
520	! 6.2 STATUS OF VEGETATIVE STAGES
521
522	!: stade amf
523	if (namfobs == 999) then
524	if (somcour >= R_stlevamf .and. namf == 0 .and. nlev > 0) then
525	namf = n
526	R_stlevamf = somcour
527	somcour = 0.0
528	if (codeulaivernal == 0) somcourutp = 0.0
529	endif
530	!else
531	! if (n == namfobs) then
532	! namf = namfobs
533	! ! réajustement du parcours de dl
534	! R_stlevamf = somcour
535	! somcour=0.0
536	! if (codeulaivernal == 0) somcourutp = 0.0
537	! if (namf < nlev .or. nlev == 0) then
538	! call EnvoyerMsgHistorique(46)
539	! stop
540	! endif
541	! endif
542	endif
543
544	!: stade end of leaf onset
545	if (nlaxobs == 999) then
546	if (somcour >= R_stamflax .and. nlax == 0 .and. namf > 0) then
547	nlax = n
548	R_stamflax = somcour
549	somcour = 0.0
550	if (codeulaivernal == 0) somcourutp = 0.0
551	endif
552	!else
553	! if (n == nlaxobs) then
554	! nlax = nlaxobs
555	! ! réajustement du parcours de dl
556	! R_stamflax = somcour
557	! somcour = 0.0
558	! if (codeulaivernal == 0) somcourutp = 0.0
559	! if (nlax < namf .or. namf == 0) then
560	! call EnvoyerMsgHistorique(41)
561	! stop
562	! endif
563	! endif
564	endif
565
566
567	!: stade sen
568	!- uniquement si P_codlainet=1
569	if (P_codlainet == 1) then
570	if (nsenobs == 999) then
571	if (somcour >= R_stlaxsen .and. nsen == 0 .and. nlax > 0) then
572	nsen = n
573	R_stlaxsen = somcour
574	somcour = 0.0
575	if (codeulaivernal == 0) somcourutp = 0.0
576	endif
577	!else
578	! if (n == nsenobs) then
579	! ! réajustement du parcours de dl
580	! stdrpsen = somcour
581	! nsen = nsenobs
582	! if (nsen < nlax .or. nlax == 0) then
583	! call EnvoyerMsgHistorique(42)
584	! stop
585	! endif
586	! somcour = 0.0
587	! if (codeulaivernal == 0) somcourutp = 0.0
588	! endif
589	endif
590	endif
591
592	!: version 4.0 suppression du stade fir
593
594
595	!: stade lan
596	!- NB - le 22/04 - si colainet=2 plus de stade lan
597	if (P_codelaitr == 1 .and. P_codlainet == 1 .or. P_codelaitr == 2) then
598	if (nlanobs == 999) then
599	if (somcour >= R_stsenlan .and. nlan == 0 .and. nsen > 0) then
600	nlan = n
601	R_stsenlan = somcour
602	somcour = 0.0
603	if (codeulaivernal == 0)somcourutp = 0.0
604	endif
605	!else
606	! if (n == nlanobs) then
607	! ! réajustement du parcours de dl
608	! R_stsenlan = somcour
609	! nlan = nlanobs
610	! somcour = 0.0
611	! if (codeulaivernal == 0) somcourutp = 0.0
612	! if (nlan < nsen .or. nsen == 0) then
613	! call EnvoyerMsgHistorique(43)
614	! stop
615	! endif
616	! endif
617	endif
618	endif
619
620
621	!: STADES REPRODUCTEURS
622
623	!: stade flo
624	if (nfloobs == 999) then
625	if (somcourdrp >= stlevflo .and. nflo == 0) then
626	nflo = n
627	stlevflo = somcourdrp
628	!- - somcourdrp = 0.0 ! domi 04/04/01 pb canne on supprime la remise à zero
629	endif
630	!else
631	! if (n == nfloobs) then
632	! nflo = nfloobs
633	! ! réajustement du parcours de dl
634	! stlevflo = somcourdrp
635	! ! DR et ML 21/01/08 on teste le pb des sommes de temp foireuses
636	!- !- somcourdrp = 0.0
637	! endif
638	endif
639
640
641	!: stade drp
642	if (ndrpobs == 999) then
643	if (somcourdrp >= R_stlevdrp .and. ndrp == 0) then
644	ndrp = n
645	! NB le 29/3
646	! R_stlevdrp=somcourdrp
647	! domi 04/04/01 on fait un essai
648	! DR et ML 21/01/08:
649	! SUITE AUX PBS DE calcul des sommes de temp dans le bilan
650	! lorsque on force flo ou drp => 2 modifs on enleve la remise à zero de somcourdrp si
651	! flo est observe (je me demande bien pourquoi on faisait ca)
652	! et R_stflodrp =somcourdrp-stlevflo
653	!- - R_stflodrp=somcourdrp
654	R_stflodrp = somcourdrp - stlevflo
655	somcourdrp = 0.0
656	!- - if (ndrp = = nflo .or. nflo == 0) then
657	!- - call EnvoyerMsgHistorique(47)
658	!- - stop
659	!- - endif
660	endif
661	!else
662	! if (n == ndrpobs) then
663	! ndrp = ndrpobs
664	! ! réajustement du parcours de dl
665	! ! NB le 29/3
666	! !-- R_stlevdrp = somcourdrp
667	! ! domi 04/04/01 essai y'a un pb dans les sommes flo
668	! !-- R_stflodrp = somcourdrp
669	! !-- R_stflodrp = somcourdrp
670	! R_stflodrp = somcourdrp-stlevflo
671	! somcourdrp = 0.0
672	! if (ndrp < nflo .or. nflo == 0) then
673	! call EnvoyerMsgHistorique(47)
674	! stop
675	! endif
676	! endif
677	endif
678
679	! !: stade fin de nouaison pour la mise en place des fruits
680	! if (P_codeindetermin == 2) then
681	! if (somcourdrp >= P_stdrpnou .and. nnou == 0 .and. ndrp > 0) nnou = n
682	! endif
683
684	!: stade mat
685	if (nmatobs == 999) then
686	if (P_codeindetermin == 1) then ! determinate crop
687	if (somcourdrp >= R_stdrpmat .and. nmat == 0 .and. ndrp > 0) then
688	nmat = n
689	R_stdrpmat = somcourdrp
690	! grain drying start
691	drylen = drylen + 1
692	! print *, 'in develop, for nmat do we go here, drylen is', drylen
693	endif
694	!else
695	! ! pour les indéterminées la maturité finale correspond à l'ensemble des P_nboite-1 vides
696	! ! Nb le 01/05 si P_nbcueille = 1
697	! ! si P_nbcueille = 2 : la maturité correspond au début de remplissage de la dernière boite
698	! if (P_nbcueille == 1) then
699	!- - ! if (nbfruit == 0.0 .and. nmat == 0 .and.
700	! ! 12/07/06 DR et IGC nous avons changé la condition de calcul de la date
701	! ! de maturité. Avant il calculait celle-ci en fonction du nombre de grains.
702	! ! Maintenant, on calcule en focntion de la durée de fruits.
703	! if (somcourdrp > P_dureefruit .and. nmat == 0 .and. n > ndrp .and. ndrp > 0) then
704	! nmat = n
705	! R_stdrpmat = somcourdrp
706	! endif
707	! else
708	! if (nfruit > 0.0 .and. nmat == 0 .and. n > ndrp .and. ndrp > 0) then
709	! nmat = n
710	! R_stdrpmat = somcourdrp
711	! endif
712	! endif
713	endif
714	!else
715	! if (n == nmatobs) then
716	! nmat = nmatobs
717	! ! réajustement du parcours de dl
718	! R_stdrpmat = somcourdrp
719	! if (nmat < ndrp .or. ndrp == 0) then
720	! call EnvoyerMsgHistorique(44,ndrp)
721	! stop
722	! endif
723	! endif
724	endif
725
726	if (drylen > 0) then
727	! print *, 'in develop, the n and nmat is', n, nmat
728	if (n > nmat) then
729	drylen = drylen + 1
730	! print *, 'in develop, the drylen is increasing', drylen
731	endif
732	endif
733
734
735	! print *, 'in develop, the somcour and somcourdrp is:', somcour, somcourdrp
736
737
738	!: stade rec
739	if (nrecobs == 999) then !not forced
740	! détemination de la date de récolte par la teneur en eau des grains à partir de la maturité
741	!- - if (teaugrain == h2ograin .and. nrec == 0) then
742	!- - nrec = n
743	!- - stmatrec = somcourdrp-R_stdrpmat
744	!- - group = gpreco
745	!- - write(,) 'rec',n,somcour,stmatrec,upvt
746	!- - endif
747
748	!: Récolte
749	!- PB - 18/01/2005 - pas de récolte qd culture fauchée.
750	if (P_codefauche /= 1) & ! option of cut modes for forage crops: yes (1); and no (2)
751	call recolte(n,ndrp, gslen, drylen, lai, & ! INPUT
752	nmat, nrec, & ! INOUT
753	stmatrec,group) ! OUT
754
755	endif
756
757
758	!: Affectation des bonnes valeurs d'unités de développement
759	!- utilisées pour le calcul du LAI
760	upvtutil = upvt
761	!if (nlevobs /= 999 .and. n <= nlevobs) then
762	! upvtutil = upobs
763	!endif
764
765	!if (namfobs /= 999 .and. n <= namfobs .and. n > nlev) then
766	! upvtutil = upobs
767	!endif
768
769	!if (nlaxobs /= 999 .and. n <= nlaxobs .and. n > namf) then
770	! upvtutil = upobs
771	!endif
772
773	!if (nsenobs /= 999 .and. n <= nsenobs .and. n > nlax) then
774	! upvtutil = upobs
775	!endif
776
777	!if (nlanobs /= 999 .and. n <= nlanobs .and. n > nsen) then
778	! upvtutil = upobs
779	!endif
780
781	if (nlevobs == 999 .and. nlev == 0) then
782	upvtutil = upvt
783	endif
784
785	if (namfobs == 999 .and. nlev > 0 .and. namf == 0) then
786	upvtutil = upvt
787	endif
788
789	if (nlaxobs == 999 .and. namf > 0 .and. nlax == 0) then
790	upvtutil = upvt
791	endif
792
793	if (nsenobs == 999 .and. nlax > 0 .and. nsen == 0) then
794	upvtutil = upvt
795	endif
796
797	if (nlanobs == 999 .and. nsen > 0 .and. nlan == 0) then
798	upvtutil = upvt
799	endif
800
801
802	! 26/09/06 pour inaki on sort le test ici nrecbutoir ne sert qu'a declencher la recolte
803	! inaki teste et on voit
804	! if (n == nrecbutoir) then
805	! if (nrec == 0) then
806	! group = -1
807	! nrec = nrecbutoir
808	! endif
809	! endif
810
811	! ** Determination du groupe de precocite et effet de la date butoir
812	! DR 06/01/06 ajout du test sur P_culturean = 1 pour les perennes sur une portion de leur cycle
813	if (n >= nrecbutoir .and. (P_codeperenne /= 2 .or. P_codeinitprec /= 2 .or. P_culturean == 1)) then
814	! NB et IG le 23/09/06 suppression du test pour les cultures sur plusieurs années
815	! if (n == nrecbutoir) then
816	if (nrec == 0) then
817	group = -1
818	nrec = nrecbutoir
819	endif
820	if (nlev == 0) nlev = nrecbutoir
821	if (nlev > 0 .and. namf == 0) then
822	namf = nrecbutoir
823	R_stlevamf = somcour
824	somcour = 0.0
825	endif
826	if (namf > 0 .and. nlax == 0) then
827	nlax = nrecbutoir
828	R_stamflax = somcour
829	somcour = 0.0
830	endif
831	if (nlax > 0 .and. nsen == 0) then
832	nsen = nrecbutoir
833	R_stlaxsen = somcour
834	somcour = 0.0
835	endif
836	if (nsen > 0 .and. nlan == 0) then
837	nlan = nrecbutoir
838	R_stsenlan = somcour
839	somcour = 0.0
840	endif
841	! ** NB le 26/03 (floraison)
842	if (nflo == 0) then
843	nflo = nrecbutoir
844	stlevflo = somcourdrp
845	somcourdrp = 0.0
846	endif
847	if (ndrp == 0) then
848	ndrp = nrecbutoir
849	R_stlevdrp = somcourdrp
850	somcourdrp = 0.0
851	endif
852	! NB le 25/08/04 traitement debdes en cas de recolte butoir
853	if (ndebdes == 0) then
854	ndebdes = nrecbutoir
855	R_stdrpdes = somcourdrp
856	endif
857	!
858	if (ndrp > 0 .and. nmat == 0) then
859	nmat = nrecbutoir
860	! NB le 25/08/04 réactivation ligne suivante
861	R_stdrpmat = somcourdrp
862	endif
863	endif
864
865	endif
866	return
867	end subroutine develop2
868
869	!======================================================================================!
870	!======================================================================================!
871	!======================================================================================!
872
873	!> Routine de calcul des besoins en froid pour le P_codebfroid = 2
874	!>
875	!! Description : subroutine calculating the cold needed
876	!<
877	subroutine Stics_Develop_bfroid2(nger, & ! IN
878	tdev, & ! IN
879	rfvi, & ! OUT
880	etatvernal, & ! INOUT
881	caljvc) ! INOUT
882
883	USE Besoins_en_froid
884	USE Stics
885	!USE Messages
886
887	implicit none
888
889	!: ARGUMENTS
890
891
892	! 0.1 INPUT
893	!integer, intent(IN) :: jjul
894	!integer, intent(IN) :: n
895	!real, intent(IN) :: P_tfroid !> // PARAMETER // optimal temperature for vernalisation // degree C // PARPLT // 1
896	!real, intent(IN) :: P_ampfroid !> // PARAMETER // semi thermal amplitude thermique for vernalising effect // degree C // PARPLT // 1
897	!real, intent(IN) :: P_julvernal !> // PARAMETER // julian day (between 1 and 365) accounting for the beginning of vernalisation for perennial crops // julian day // PARPLT // 1
898	!real, intent(IN) :: P_jvc !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1
899	!real, intent(IN) :: P_jvcmini !> // PARAMETER // Minimum number of vernalising days // day // PARPLT // 1
900	!integer, intent(IN) :: P_codeperenne !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0
901	integer, intent(IN) :: nger
902	!integer, intent(IN) :: namf
903	!integer, intent(IN) :: numcult ! number of years of simulation, number of crop seasons, one-year crop, or two-year crop
904	!integer, intent(IN) :: nbjsemis ! days number in the sowing year, it is the ith day in the sowing year
905	real, intent(IN) :: tdev ! temperature
906	!integer, intent(IN) :: P_codemontaison !> // PARAMETER // code to stop the reserve limitation from the stem elongation // code 1/2 // PARAMV6 // 0
907	!integer, intent(IN) :: P_culturean !> // PARAMETER // crop status 1 = over 1 calendar year ,other than 1 = on two calendar years (winter crop in northern hemisphere) // code 0/1 //
908	!integer, intent(IN) :: P_codeinitprec !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0
909	!integer, intent(IN) :: nbjanrec ! days number in the harvest year, if the harvest year is different from the sowing year
910
911	! 0.2 INOUT
912	!integer, intent(INOUT) :: maxwth ! maximum days for the simulation, 365 or 366 which is determined by the leap or not. But here, we do not consider the leap year, so it is 365
913	logical, intent(INOUT) :: etatvernal ! is it not sensitive to vernalization? false: sensitive, ture, non-sensitive
914	real, intent(INOUT) :: caljvc
915	!integer, intent(INOUT) :: onestan2
916
917	! 0.3 OUT
918	!integer, intent(OUT) :: nrecbutoir
919	real, intent(OUT) :: rfvi !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
920
921
922
923	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
924	!>
925	!> this part is especially for perennial grass----xcwu
926	! DR et ML et SYL 16/06/09
927	! prise en cpte de la montaison pour les prairies
928	! if (P_codemontaison == 1) then !
929	!! ####
930	!! SYL modif le 11/03/08
931	!! NB le 07/03/08
932	! jul = jjul
933	! if (jul == nbjsemis) then
934	! onestan2 = 2
935	! endif
936	!! DR et ML et SYL 16/06/09 Fin
937	! else
938	! jul = MOD(jjul,nbjsemis) ! jul = jjul modulo nbjsemis
939	! endif
940	!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
941
942
943	!!: entrée en vernalisation des herbacées pérennes au jour P_julvernal
944	!if ( etatvernal .and. jul == P_julvernal .and. P_jvc > P_jvcmini .and. P_codeperenne == 2) then
945	! etatvernal = .FALSE.
946	!endif
947
948	if (.not.etatvernal) then
949
950	!: On active P_julvernal pour les annuelles, qui joue lorqu'il se situe après la germination.
951	!- NB et ML - 25/02/04 : à tester sur RGI CIPAN
952	!- ML - 21/04/04 : on interdit de démarrer au stade 'dor' et d'avoir jul < P_julvernal pour les cultures perennes
953	if ( nger /= 0 ) then
954
955	! This part is only for perennial grassland
956	!! DR et ML et SYL 16/06/09
957	!! prise en cpte de la montaison des prairies
958	!! ####
959	! if (P_codemontaison == 1)then
960	! numcult_ver = onestan2
961	! else
962	! numcult_ver = numcult
963	! endif
964
965	!if (jul+((numcult_ver-1)*nbjsemis) >= P_julvernal) then
966	!--if (jul+((numcult-1)*nbjsemis) >= P_julvernal) then
967
968	!: ML - 28/05/04 : on interdit de démarrer au stade lev et
969	!- d'avoir jul > P_julvernal le jour de la levée (début de vernalisation) pour les cultures perennes
970
971
972
973	! for annual crop we calculate the vernalization---xcw
974	if (P_codeperenne == 1) then
975	call Vernalisation(tdev, rfvi, caljvc, etatvernal)
976	else
977	!if (n == namf .and. jul > P_julvernal .and. jul <= (P_julvernal+P_jvcmini)) then
978	! call EnvoyerMsgHistorique(32)
979	stop
980	! endif
981	!if (n > namf) then
982	!DR 20/07/2012 pas besoin de jjul
983	! call Vernalisation(tdev,P_jvc,P_jvcmini,P_codeperenne,P_culturean,P_codeinitprec,nbjanrec,P_tfroid,P_ampfroid, &
984	! jjul,n, rfvi,nrecbutoir,maxwth,caljvc,etatvernal)
985	! n, rfvi,nrecbutoir,maxwth,caljvc,etatvernal)
986	!endif
987	endif
988	!else ! < P_julvernal
989	! if (P_codeperenne == 1) then
990	! rfvi = 1.0
991	! else
992	! !call EnvoyerMsgHistorique(50)
993	! stop
994	! endif
995	!endif
996
997	else ! not germination yet
998	rfvi = 1.0
999	endif
1000	else ! not sensitive to vernalization
1001	rfvi = 1.0
1002	endif
1003
1004	return
1005	end subroutine Stics_Develop_bfroid2
1006
1007	!======================================================================================!
1008	!======================================================================================!
1009	!======================================================================================!
1010
1011
1012	!> Routine de calcul des besoins en froid pour le P_codebfroid = 3
1013	!> It is only effective for perennial crops, such as vineyard
1014	!! Description :
1015	!<
1016	!subroutine Stics_Develop_bfroid3(cu_min,cu_veille,n,tmin,tmax,thor, &
1017	! etatvernal,cu,rfvi,ndebdorm,nfindorm,nlev)
1018	!
1019	!USE Besoins_en_froid
1020	!
1021	!implicit none
1022	!
1023	!! integer, intent(IN) :: P_codedormance !> // PARAMETER // option of calculation of dormancy and chilling requirement // code 1/2 // PARPLT // 0
1024	! real, intent(IN) :: cu_min
1025	! real, intent(IN) :: cu_veille
1026	! integer, intent(IN) :: n
1027	!! real, intent(IN) :: P_jvc !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1
1028	!! real, intent(IN) :: P_q10 !> // PARAMETER // P_Q10 used for the dormancy break calculation // SD // PARPLT // 1
1029	! real, intent(IN) :: tmin !> // OUTPUT // Minimum active temperature of air // degree C
1030	! real, intent(IN) :: tmax !> // OUTPUT // Maximum active temperature of air // degree C
1031	! real, intent(IN) :: thor(24)
1032	!
1033	! logical, intent(INOUT) :: etatvernal
1034	! real, intent(INOUT) :: cu
1035	! real, intent(OUT) :: rfvi !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
1036	! integer, intent(INOUT) :: ndebdorm
1037	! integer, intent(INOUT) :: nfindorm
1038	! integer, intent(INOUT) :: nlev
1039	!
1040	!
1041	!
1042	! if (.not.etatvernal) then
1043	! !: Calcul des cu (chill units ?)
1044	! select case(P_codedormance)
1045	! case(1,2)
1046	! call Dormancy_Richardson(thor,n,cu_min,cu_veille,ndebdorm,cu)
1047	! case(3)
1048	! call Dormancy_Bidabe(n,ndebdorm,P_q10,tmin,tmax,cu_veille,cu)
1049	! end select
1050	!
1051	!
1052	! if (P_codedormance >= 2) then
1053	!
1054	! !: Cas des calculs de Richardson ou Bidabe
1055	! if (cu > P_jvc) then
1056	! rfvi = 1.0
1057	! !: 17/03/08 : maintenant on garde nfindorm0 si nfin s'est passe annee d'avant
1058	! !--if (nfindorm == 0) nfindorm=n
1059	! nfindorm = n
1060	! etatvernal = .TRUE.
1061	!
1062	! !: DR - 20/11/06 : On est un peu perplexe , on etait sur d'avoir testé tous les cas.
1063	! !- Quand on arrive en fin de dormance, si on ne met pas nlev=0 on ne calcule plus les sommes
1064	! !- d'action chaude de richardson. La date de levée a été stockée dans ilevs
1065	! nlev = 0
1066	! else
1067	! rfvi = 0.0
1068	! end if
1069	!
1070	! else
1071	!
1072	! !: Cas de forçage de la levée de dormance
1073	! if (n < nfindorm) then
1074	! rfvi = 0.0
1075	! else
1076	! rfvi = 1.0
1077	! etatvernal = .TRUE.
1078	! end if
1079	!
1080	! end if
1081	!
1082	! else
1083	!
1084	! !: ML - le 18/10/05 : Cas de la dormance calculee avec Bidabe: on demarre la dormance à ndebdorm
1085	! if (P_codedormance == 3 .and. n == ndebdorm) then
1086	! etatvernal = .FALSE.
1087	! rfvi = 0.0
1088	! else
1089	! rfvi = 1.0
1090	! endif
1091	!
1092	! endif
1093	!
1094	!
1095	!return
1096	!end subroutine Stics_Develop_bfroid3

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

Context Navigation

source: branches/publications/ORCHIDEE-MICT-OP-r6850/src_sticslai/Stics_Develop.f90 @ 7421

Download in other formats: