source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/reprac_calc.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!> Purpose of this subroutine: addressing the shoot/root partitioning <!
3!> Author: Xiuchen Wu                                                 <!
4!> Date  : 31/07/2013                                                 <!
5
6
7subroutine reprac_calc(n, nsen, nlax, nflo, nmat, nrec, nplt, in_cycle, nger, tcult, nlev, &      ! IN
8                     zrac, repracmax, repracmin, kreprac, somtemprac, urac, reprac, nstoprac, &     ! inout
9                  P_stoprac, P_codeperenne, P_codehypo, P_codegermin,P_zracplantule, P_profsem, P_codtrophrac,  &
10                  P_repracpermax, P_repracpermin, P_krepracperm, P_repracseumax, P_repracseumin, P_krepracseu,  &
11                  P_codetemprac, P_tcmin, P_tcmax, P_codedyntalle, P_tcxstop, P_stlevamf, P_stamflax)     ! parameter
12
13! USE Stics
14
15! DECLARATION PART
16!
17! 0.0  INPUT 
18! 
19
20integer, intent(IN)                :: n
21integer, intent(IN)                :: nsen
22integer, intent(IN)                :: nlax
23integer, intent(IN)                :: nflo
24integer, intent(IN)                :: nmat
25integer, intent(IN)                :: nrec
26integer, intent(IN)                :: nplt
27logical, intent(IN)                :: in_cycle
28integer, intent(IN)                :: nger
29real,    intent(IN)                :: tcult
30integer, intent(IN)                :: nlev
31character, intent(in)              :: P_stoprac !//parameter, stage when root stop growth
32integer, intent(in)                :: P_codeperenne   ! // parameter
33integer, intent(in)                :: P_codehypo   ! // parameter
34
35integer, intent(in)                :: P_codegermin   ! // parameter
36real,    intent(in)                :: P_zracplantule ! // parameter
37real,    intent(in)                :: P_profsem      ! // parameter
38integer, intent(in)                :: P_codtrophrac   ! // parameter
39
40real,    intent(in)                :: P_repracpermax     ! // parameter
41real,    intent(in)                :: P_repracpermin      ! // parameter
42real,    intent(in)                :: P_krepracperm      ! // parameter
43
44real,    intent(in)                :: P_repracseumax     ! // parameter
45real,    intent(in)                :: P_repracseumin      ! // parameter
46real,    intent(in)                :: P_krepracseu      ! // parameter
47
48integer, intent(in)                :: P_codetemprac   ! // parameter
49real,    intent(in)                :: P_tcmin      ! // parameter
50real,    intent(in)                :: P_tcmax      ! // parameter
51integer, intent(in)                :: P_codedyntalle   ! // parameter
52real,    intent(in)                :: P_tcxstop      ! // parameter
53
54real,    intent(in)                :: P_stlevamf      ! // parameter
55real,    intent(in)                :: P_stamflax     ! // parameter
56
57
58
59!
60! 1.0  INOUT
61
62real,    intent(INOUT)             :: zrac
63real,    intent(INOUT)             :: repracmax
64real,    intent(INOUT)             :: repracmin
65real,    intent(INOUT)             :: kreprac
66real,    intent(INOUT)             :: somtemprac
67real,    intent(INOUT)             :: urac
68real,    intent(INOUT)             :: reprac
69integer, intent(INOUT)             :: nstoprac
70
71
72
73! 2.0  OUT
74
75! 3.0  LOCAL
76
77real :: znonli
78real :: dtj
79
80
81! zrac should be initialized as 0
82! when nger ~= 0, meaning that the germination occurs, we assign the zrac as P_profsem
83
84
85     !>> FIRST
86     ! we determine the nstoprac, this variable is dependent on P_stoprac
87
88     if (P_stoprac == 'sen' .or. P_stoprac == 'SEN') nstoprac = nsen
89     if (P_stoprac == 'lax' .or. P_stoprac == 'LAX') nstoprac = nlax
90     if (P_stoprac == 'flo' .or. P_stoprac == 'FLO') nstoprac = nflo
91     if (P_stoprac == 'mat' .or. P_stoprac == 'MAT') nstoprac = nmat
92     if (P_stoprac == 'rec' .or. P_stoprac == 'REC') nstoprac = nrec
93
94
95     !>> SECOND
96     ! adjustment of the root depth accoring to the stages
97     ! but note that in this version, we do not calculate the growth of root
98
99     if (P_codeperenne == 1 .and. (n >= nplt .or. in_cycle == .true.)) then ! annual crop and in the growing cycle
100       if (P_codehypo == 2 .and. P_codegermin == 1) then
101         znonli = P_zracplantule + P_profsem
102         zrac = znonli
103         !return
104       else
105         znonli = P_profsem
106         zrac = znonli
107         !return
108       endif
109     else
110       znonli = 0.
111       zrac = znonli
112     endif
113     ! now we adjust the zrac
114
115     
116     !>> THIRD
117     ! we get the three parameters for calculating the REPRAC variable
118     ! There are three cases:
119     ! 1. codtrophrac is 1
120     ! 2. codtrophrac is 2
121     ! 3. codtrophrac is 3
122
123     if (P_codtrophrac == 1) then
124       repracmax = P_repracpermax
125       repracmin = P_repracpermin
126       kreprac   = P_krepracperm
127     endif
128     if (P_codtrophrac == 2) then
129       repracmax = P_repracseumax
130       repracmin = P_repracseumin
131       kreprac   = P_krepracseu
132     endif
133     if (P_codtrophrac == 3) then
134       repracmax = 0.
135       repracmin = 0.
136       kreprac   = 0.
137     endif
138
139 
140     !>> FOURTH
141     ! if the germination did not occur, we do not need the shoot/root partitioning calculation, so the reprac keeps the initialization value
142     if (nger == 0) return
143   
144
145     
146     !>> FIFTH
147     ! we calculate the reprac
148
149
150     !if (n >= nger .and. nger > 0 .and. zrac > 0.) then
151     if (in_cycle == .true. .and. nger > 0 .and. zrac > 0) then ! if in growing cycle, and already germinate and depth of root front is larger than 0
152       if (P_codetemprac == 1) then ! using the crop temperature
153         dtj = max(tcult - P_tcmin, 0.)
154         dtj = min(dtj, P_tcmax - P_tcmin)
155
156       ! DR et ML et SYL 15/06/09
157       ! ************************
158       ! introduction de la fin des modifications de Sylvain (nadine et FR)
159       ! dans le cadre du projet PERMED
160         if (P_codedyntalle == 1) then
161       ! ####
162       ! NB le 06/03/2008 introduction de l'effet négatif des températures élevées
163       ! sur les fonctions racinaires qui utilisent "dtj"
164           if (tcult > P_tcmax .and. P_tcxstop < 100) then
165             dtj = (P_tcmax-P_tcmin)/(-P_tcxstop+P_tcmax)*(tcult-P_tcxstop)
166             dtj = max(dtj,0.)
167           endif
168         endif
169       ! ####
170
171       !else ! using the soil temperature
172       !  dtj(n) = max(tsol(int(zrac)) - P_tgmin, 0.)
173       !  dtj(n) = min(dtj(n) ,P_tcmax - P_tgmin)
174
175       !! ####
176       !! NB le 06/03/2008 introduction de l'effet négatif des températures élevées
177       !! sur les fonctions racinaires qui utilisent "dtj"
178       !  if(P_codedyntalle == 1)then
179       !    if (tsol(int(zrac)) > P_tcmax .and. P_tcxstop < 100) then
180       !      dtj(n) = (P_tcmax-P_tcmin)/(-P_tcxstop+P_tcmax)*(tsol(int(zrac))-P_tcxstop)
181       !      dtj(n) = max(dtj(n),0.)
182       !    endif
183       !  endif
184       !! ####
185
186       endif
187     else
188       dtj = 0.
189     endif
190
191      ! addressing the cumulated effective temperature of root
192
193
194      somtemprac = somtemprac + dtj
195      if (n == nlev) somtemprac = 0.
196      if (nstoprac == 0) then
197        !: Définition d'une unité de dl racinaire urac
198        !- somme de degré.jours racine
199        urac = min(1. + (2. * somtemprac / (P_stlevamf + P_stamflax)), 3.)
200        if (nlev == 0) urac = 1.
201        !: la longueur totale de racine émise par jour (rlj)
202        !- suit une logistique de façon similaire au LAI
203        !- NB - le 28/10/01:
204        !- 07/02/08: on integre ENFIN les modifs de Samuel (vive lui)
205        !- essai de rendre nouvrac continu pour Samuel
206        !- 20/02/07:
207        !--if (int(zrac)-int(zrac-deltaz) <= int(deltaz)) then
208        !--  multlvfront = int(deltaz)
209        !--else
210        !--  multlvfront = int(deltaz)+1
211        !--endif
212        !--if (nlev == 0) multlvfront = max0(1,multlvfront)
213        !--nouvrac = P_lvfront*multlvfront
214        ! nouvrac = P_lvfront*deltaz
215
216        !: Introduction de l'indice de stress de densité racinaire idzrac / NB - le 06/06
217        !efanoxd = 1.-(1.-idzrac)*P_sensanox
218
219        !: NB - 10/03/02:
220        !- Calcul du facteur densité efdensite actif à partir de P_laicomp
221        !- Calcul de l'effet densité sur la mise en place du LAI pour les stics-plante
222        !efdensite = 1.
223        !if (urac >= 1.) then
224        !  if (lai_veille < P_laicomp) then
225        !    efdensite = 1.
226        !  else
227        !    !: domi - 02/07/2002: pb si GEL total densite = 0 et pb de log(0)
228        !    if (densite == 0) then
229        !      efdensite = 0.
230        !    else
231        !      efdensite = min(exp(P_adens * (log(densite / P_bdens))), 1.)
232        !    endif
233        !  endif
234        !else
235        !  efdensite = min(exp(P_adens * (log(densite / P_bdens))),1.)
236        !endif
237
238        !rlj = (P_draclong / (1. + exp(5.5 * (P_vlaimax - urac))) * efdensite * densite *dtj(n) * efanoxd) + (nouvrac * 1.e4)
239
240        !: De la germination à la levée, il n'y a qu'une croissance du front racinaire
241        !- Nb - le 17/02/2003: suppression de coderac
242        if (P_codtrophrac /= 3) then
243          !: Option trophique
244          ! *- par calcul d'une fonction de répartition reprac = souterrain/total
245          ! *- la longueur de racine au niveau du front est soustraite de la
246          ! *- longueur produite
247          ! ** ML le 25/05/2007 - les paramÚtres initiaux repracmin, repracmax et kreprac
248          ! *- ont changé de noms dans le fichier plante: P_repracpermin, P_repracpermax et P_krepracperm
249          ! *- si la liaison trophique est permanente (P_codtrophrac = 1) et
250          ! *- P_repracseumin, P_repracseumax et P_krepracseu si la liaison est par seuils (P_codtrophrac = 2)
251!!!          if (P_codtrophrac == 1) then
252!!!            repracmax = P_repracpermax
253!!!            repracmin = P_repracpermin
254!!!            kreprac = P_krepracperm
255!!!          endif
256!!!
257!!!          if (P_codtrophrac == 2) then
258!!!            repracmax = P_repracseumax
259!!!            repracmin = P_repracseumin
260!!!            kreprac = P_krepracseu
261!!!          endif
262
263          reprac = (repracmax-repracmin) * (exp(-kreprac * (urac - 1.))) + repracmin
264
265          !: PB - 06/01/2005: On multiplie par P_longsperac plutot que diviser (modifs Nadine du 30/12/2004)
266          !rlj1 = reprac/(1.-reprac) * P_longsperac * 1.e2 * dltams
267
268          !if (rlj1 < nouvrac * 1.e4) nouvrac = rlj1 * 1.e-4
269          !if (P_codtrophrac == 1) then
270          !  rlj = rlj1
271          !else
272          !  if (rlj >= rlj1) rlj = rlj1
273          !endif
274        endif
275
276        !if (nlev == 0) rlj = nouvrac*1.e4
277
278      !else
279      !  rlj = 0.
280      endif
281     
282     
283      ! Here we get the reprac, which is an important variable addressing the above/below ground biomass partitioning.   
284      ! we end our subroutine
285
286end subroutine reprac_calc
Note: See TracBrowser for help on using the repository browser.