source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Recolte.f90 @ 6940

Last change on this file since 6940 was 6940, checked in by jinfeng.chang, 4 years ago

add missing files for ORCHIDEE-GMv3.2
File size: 10.5 KB
Line 
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
24implicit 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  real,    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
283return
284end subroutine recolte
Note: See TracBrowser for help on using the repository browser.