1 | !----------------------------------------------------------------------- |
---|
2 | ! modif le 27/06/01 |
---|
3 | ! NB le 01/05 |
---|
4 | ! détemination de la date de récolte |
---|
5 | ! calcul de la date de récolte |
---|
6 | ! plusieurs critères pour la récolte |
---|
7 | ! 1- la maturité physiologique (P_codrecolte = 1) |
---|
8 | ! 2- la teneur en eau (P_codrecolte = 2) |
---|
9 | ! 3- la teneur en sucre (P_codrecolte = 3) |
---|
10 | ! 4- la teneur en protéine (P_codrecolte = 4) |
---|
11 | ! 5- la teneur en huile (P_codrecolte = 5) |
---|
12 | !----------------------------------------------------------------------- |
---|
13 | ! addressing the harvest |
---|
14 | |
---|
15 | |
---|
16 | subroutine recolte(n,ndrp,gslen, drylen, lai, & ! IN |
---|
17 | nmat, nrec, & ! INOUT |
---|
18 | stmatrec,group) ! OUT |
---|
19 | |
---|
20 | USE Stics |
---|
21 | USE constantes |
---|
22 | !USE Messages |
---|
23 | |
---|
24 | implicit none |
---|
25 | |
---|
26 | ! DECLARATION |
---|
27 | |
---|
28 | ! 0.1 INPUT |
---|
29 | integer, intent(IN) :: n |
---|
30 | integer, intent(IN) :: ndrp |
---|
31 | integer, intent(IN) :: gslen |
---|
32 | |
---|
33 | |
---|
34 | real, intent(IN) :: lai !> // PARAMETER // minimal sugar rate at harvest // g sucre g-1 MF // PARTEC // 1 |
---|
35 | |
---|
36 | |
---|
37 | !integer, intent(IN) :: P_codrecolte !> // PARAMETER // harvest mode : all the plant (1) or just the fruits (2) // code 1/2 // PARTEC // 0 |
---|
38 | !integer, intent(IN) :: nmat |
---|
39 | !integer, intent(IN) :: P_variete !> // PARAMETER // variety number in the technical file // SD // PARTEC // 1 |
---|
40 | !integer, intent(IN) :: P_nbcueille !> // PARAMETER // number of fruit harvestings // code 1/2 // PARTEC // 0 |
---|
41 | !real, intent(IN) :: h2orec !> // OUTPUT // Water content of harvested organs // % |
---|
42 | !real, intent(IN) :: P_sucrerec !> // PARAMETER // minimal sugar rate at harvest // g sucre g-1 MF // PARTEC // 1 |
---|
43 | !real, intent(IN) :: P_CNgrainrec !> // PARAMETER // minimal grain nitrogen content for harvest // 0-1 // PARTEC // 1 |
---|
44 | !real, intent(IN) :: P_huilerec !> // PARAMETER // minimal oil content allowed for harvest // g huile g-1 MF // PARTEC // 1 |
---|
45 | !real, intent(IN) :: sucre !> // OUTPUT // Sugar content of fresh harvested organs // % (of fresh weight) |
---|
46 | !real, intent(IN) :: huile !> // OUTPUT // Oil content of fresh harvested organs // % (of fresh weight) |
---|
47 | !real, intent(IN) :: teaugrain |
---|
48 | !real, intent(IN) :: P_h2ofrvert !> // PARAMETER // water content of fruits before the beginning of hydrous evolution (DEBDESHYD) // g water g-1 MF // PARPLT // 1 |
---|
49 | !integer, intent(IN) :: P_codeaumin !> // PARAMETER // harvest as a function of grain/fruit water content // code 1/2 // PARTEC // 0 |
---|
50 | !real, intent(IN) :: P_h2ograinmin !> // PARAMETER // minimal water content allowed at harvest // g eau g-1 MF // PARTEC // 1 |
---|
51 | !real, intent(IN) :: P_deshydbase !> // PARAMETER // phenological rate of evolution of fruit water content (>0 or <0) // g water.g MF-1.degree C-1 // PARPLT // 1 |
---|
52 | !real, intent(IN) :: somcourdrp |
---|
53 | !real, intent(IN) :: P_stdrpmat !> // PARAMETER // Sum of development units between the stages DRP and MAT // degree.days // PARPLT // 1 |
---|
54 | !real, intent(IN) :: P_h2ograinmax !> // PARAMETER // maximal water content allowed at harvest // g water g-1 MF // PARTEC // 1 |
---|
55 | !real, intent(IN) :: CNgrain !> // OUTPUT // Nitrogen concentration of grains // % |
---|
56 | !integer, intent(IN) :: P_cadencerec !> // PARAMETER // number of days between two harvests // day // PARTEC // 1 |
---|
57 | |
---|
58 | ! 0.2 INOUT |
---|
59 | |
---|
60 | integer, intent(INOUT) :: nrec |
---|
61 | integer, intent(INOUT) :: drylen |
---|
62 | integer, intent(INOUT) :: nmat |
---|
63 | |
---|
64 | !integer, intent(INOUT) :: jdepuisrec |
---|
65 | !real, intent(INOUT) :: pdsfruit !> // OUTPUT // Weight of fruits in box 3 // g m-2 |
---|
66 | !real, intent(INOUT) :: nfruit !> // OUTPUT // Number of fruits in box 5 // nb fruits |
---|
67 | !integer, intent(INOUT) :: nbrecolte |
---|
68 | |
---|
69 | ! 0.3 OUT |
---|
70 | |
---|
71 | real, intent(OUT) :: stmatrec |
---|
72 | integer, intent(OUT) :: group |
---|
73 | |
---|
74 | !integer, intent(OUT) :: nrecint |
---|
75 | !real, intent(OUT) :: rdtint |
---|
76 | !real, intent(OUT) :: teauint |
---|
77 | !real, intent(OUT) :: nbfrint |
---|
78 | |
---|
79 | |
---|
80 | ! 0.4 LOCAL VARIABLES |
---|
81 | !real :: huiledecis !> |
---|
82 | !real :: sucredecis !> |
---|
83 | !real :: teaudecis |
---|
84 | |
---|
85 | |
---|
86 | !: NB - le 27/08 - pas de passage avant ndrp |
---|
87 | !: first, we check the growing season length, whether or not exceed the threshold, maxgs = 300. |
---|
88 | |
---|
89 | ! print *, 'in recolte, the lai is', lai |
---|
90 | if ( gslen < P_maxgs ) then |
---|
91 | if (ndrp == 0 .or. n == ndrp) return |
---|
92 | |
---|
93 | if ( lai > 0.) then ! when grain filling starting and lai > 0 |
---|
94 | ! the first option, based on the physiological maturation |
---|
95 | ! at first, we used this option, because we do not consider the nitrogen, water, sugar processes in the grain. |
---|
96 | if (P_codrecolte == 1) then |
---|
97 | ! NB - le 08/05/02 - ajout du test nrec |
---|
98 | ! print *, 'in recolte, the drylen is ', drylen |
---|
99 | if (drylen < matrec) then ! drying process start only since mature |
---|
100 | nrec = 0 |
---|
101 | else |
---|
102 | nrec = n |
---|
103 | stmatrec = 0. |
---|
104 | group = P_variete |
---|
105 | endif |
---|
106 | endif |
---|
107 | if (P_codrecolte == 2) then |
---|
108 | ! NB - le 08/05/02 - ajout du test nrec |
---|
109 | if (drylen < matrec) then |
---|
110 | nrec = 0 |
---|
111 | else |
---|
112 | nrec = n |
---|
113 | stmatrec = 0. |
---|
114 | group = P_variete |
---|
115 | endif |
---|
116 | endif |
---|
117 | else ! ndrp != 0 and lai <= 0, that mean there is no lai aboveground, vegetation should stop here |
---|
118 | if (nmat == 0) then |
---|
119 | nmat = n |
---|
120 | else |
---|
121 | ; |
---|
122 | endif |
---|
123 | |
---|
124 | if (drylen <= 0) then |
---|
125 | drylen = drylen + 1 |
---|
126 | else |
---|
127 | drylen = drylen |
---|
128 | endif |
---|
129 | if (drylen < matrec) then |
---|
130 | nrec = 0 |
---|
131 | else |
---|
132 | nrec = n |
---|
133 | stmatrec = 0. |
---|
134 | group = P_variete |
---|
135 | endif |
---|
136 | ! print *,'in recolte, do we do here with lai <=0' |
---|
137 | ! print *, 'in recolte, the drylen is', drylen |
---|
138 | endif |
---|
139 | else ! when reaching the maxgs, we forced stop the crop growth |
---|
140 | nmat = n |
---|
141 | nrec = n |
---|
142 | stmatrec = 0. |
---|
143 | group = P_variete |
---|
144 | endif |
---|
145 | |
---|
146 | |
---|
147 | !!: on récolte lorsque la teneur en eau atteint un seuil |
---|
148 | !!- ajout d'un test dans condition (teaugrain /= P_h2ofrvert) |
---|
149 | !!- Nb - 28/09: |
---|
150 | !!- Teneur en eau,huile,sucre différentes si une ou plusieurs récoltes |
---|
151 | |
---|
152 | |
---|
153 | !!: P_nbcueille = 1 |
---|
154 | !if (P_nbcueille == 1) then |
---|
155 | |
---|
156 | ! teaudecis = h2orec |
---|
157 | ! sucredecis = sucre |
---|
158 | ! huiledecis = huile |
---|
159 | |
---|
160 | ! if (P_codrecolte == 2) then |
---|
161 | ! if (nmat > 0 .or. teaudecis /= P_h2ofrvert) then |
---|
162 | ! if (P_codeaumin == 1 .and. teaudecis >= P_h2ograinmin .and. nrec == 0) then |
---|
163 | ! if (P_deshydbase >= 0.) then |
---|
164 | ! call EnvoyerMsgHistorique(401) |
---|
165 | ! stop |
---|
166 | ! endif |
---|
167 | ! nrec = n |
---|
168 | ! stmatrec = somcourdrp - P_stdrpmat |
---|
169 | ! group = P_variete |
---|
170 | ! endif |
---|
171 | ! if (P_codeaumin == 2 .and. teaudecis <= P_h2ograinmax .and. nrec == 0) then |
---|
172 | ! if (P_deshydbase <= 0.) then |
---|
173 | ! call EnvoyerMsgHistorique(402) |
---|
174 | ! stop |
---|
175 | ! endif |
---|
176 | ! nrec = n |
---|
177 | ! stmatrec = somcourdrp - P_stdrpmat |
---|
178 | ! group = P_variete |
---|
179 | ! endif |
---|
180 | ! endif |
---|
181 | ! endif |
---|
182 | |
---|
183 | ! ! on récolte lorsque la teneur en sucre atteint un seuil |
---|
184 | ! if (P_codrecolte == 3) then |
---|
185 | ! if (nmat > 0 .or. teaudecis /= P_h2ofrvert) then |
---|
186 | ! if (sucredecis >= P_sucrerec .and. nrec == 0) then |
---|
187 | ! nrec = n |
---|
188 | ! stmatrec = somcourdrp - P_stdrpmat |
---|
189 | ! group = P_variete |
---|
190 | ! endif |
---|
191 | ! endif |
---|
192 | ! endif |
---|
193 | |
---|
194 | ! ! on récolte lorsque la teneur en azote atteint un seuil |
---|
195 | ! if (P_codrecolte == 4) then |
---|
196 | ! if (nmat > 0) then |
---|
197 | ! if (CNgrain/100. >= P_CNgrainrec .and. nrec == 0) then |
---|
198 | ! nrec = n |
---|
199 | ! stmatrec = somcourdrp - P_stdrpmat |
---|
200 | ! group = P_variete |
---|
201 | ! endif |
---|
202 | ! endif |
---|
203 | ! endif |
---|
204 | |
---|
205 | ! ! on récolte lorsque la teneur en huile atteint un seuil |
---|
206 | ! if (P_codrecolte == 5) then |
---|
207 | ! if (nmat > 0 .or. teaudecis /= P_h2ofrvert)then |
---|
208 | ! if (huiledecis >= P_huilerec .and. nrec == 0) then |
---|
209 | ! nrec = n |
---|
210 | ! stmatrec = somcourdrp - P_stdrpmat |
---|
211 | ! group = P_variete |
---|
212 | ! endif |
---|
213 | ! endif |
---|
214 | ! endif |
---|
215 | |
---|
216 | !endif ! fin P_nbcueille = 1 |
---|
217 | |
---|
218 | |
---|
219 | !!: P_nbcueille = 2 |
---|
220 | !! -- if (P_nbcueille == 2.and.nrec > 0) then |
---|
221 | !if (P_nbcueille == 2) then |
---|
222 | |
---|
223 | ! teaudecis = teaugrain |
---|
224 | ! !--pas utilisé-- sucredecis = sucreder |
---|
225 | ! !--pas utilisé-- huiledecis = huileder |
---|
226 | |
---|
227 | ! jdepuisrec = jdepuisrec+1 |
---|
228 | ! if ((n == nrec .or. jdepuisrec >= P_cadencerec) .and. pdsfruit > 0.) then |
---|
229 | ! nrecint = n |
---|
230 | ! dr! 22/12/2010 on passé le tableau entier de rdint |
---|
231 | ! rdtint = pdsfruit |
---|
232 | ! ! rdtint(1,nbrecolte) = pdsfruit |
---|
233 | ! ! write(*,*)'***** dans stics_recolte',rdtint,pdsfruit |
---|
234 | ! nbfrint = nfruit |
---|
235 | ! teauint = teaudecis |
---|
236 | ! dr! 22/12/2010 on passé le tableau entier de rdint |
---|
237 | ! pdsfruit = pdsfruit - rdtint |
---|
238 | ! nfruit = nfruit - nbfrint |
---|
239 | |
---|
240 | ! ! NB - le 08/05/02 - réaffectation de nrec ( = n) |
---|
241 | ! nrec = nrecint |
---|
242 | ! nbrecolte = nbrecolte + 1 |
---|
243 | ! jdepuisrec = 0 |
---|
244 | ! ! write(*,*)'**fin recolte',nbrecolte,pdsfruit |
---|
245 | ! endif |
---|
246 | !endif |
---|
247 | |
---|
248 | |
---|
249 | |
---|
250 | |
---|
251 | !!: NB - le 02/07/02 |
---|
252 | !!- domi et marie - 10/10/03 |
---|
253 | !!- deplacé au debut de develop car dans le cas de P_codeperenne = 1 et P_codcueille = 1 on ne passe plus |
---|
254 | !!- dans recolte à partir de n = nrec |
---|
255 | !!- voir avec Nadine si on le vire ici |
---|
256 | !-- ! if (P_codeperenne == 1) then |
---|
257 | !-- ! if (P_codcueille == 1) then |
---|
258 | !-- ! if (n == nrec+1) then |
---|
259 | !-- ! masec = 0.0 |
---|
260 | !-- ! zrac = 0.0 |
---|
261 | !-- ! mafrais(:) = 0.0 |
---|
262 | !-- ! pdsfruitfrais(:) = 0.0 |
---|
263 | ! ! domi - 22/10/03 |
---|
264 | !-- ! hauteur(:) = 0. |
---|
265 | ! ! PB - 03/05/2004 - remise à zéro des variables de fixation |
---|
266 | !-- ! demande(:) = 0. |
---|
267 | ! ! DR 13/01/06 remise à zero sinon mafrais ne revient pas nul |
---|
268 | !-- ! mafraisfeuille(:) = 0. |
---|
269 | !-- ! mafraistige(:) = 0. |
---|
270 | !-- ! mafraisres(:) = 0. |
---|
271 | !-- ! mafraisrec(:) = 0. |
---|
272 | !-- ! endif |
---|
273 | !-- ! endif |
---|
274 | !-- ! endif |
---|
275 | |
---|
276 | ! --! if (P_nbcueille == 1.and.n == nrec) then |
---|
277 | ! --! do 50 i = 1,P_nboite |
---|
278 | ! --! pdsfruit(i) = 0.0 |
---|
279 | ! --! nfruit(ens,i) = 0.0 |
---|
280 | ! --!50 continue |
---|
281 | ! --! endif |
---|
282 | |
---|
283 | return |
---|
284 | end subroutine recolte |
---|