| 1 | !! **************************************************************** |
|---|
| 2 | !> Calculation of the emergence. Authors : C. Durr and G. Richard. |
|---|
| 3 | !> - Programmation: N. Brisson. |
|---|
| 4 | !> - last modification 20/02/07 : l'humectation de la graine se fait en fonction d'un potentiel : humecgraine en MPa. |
|---|
| 5 | !> - Stics book paragraphe 2.2.2, page 21-27 |
|---|
| 6 | !! |
|---|
| 7 | !> In STICS, the emergence phase is broken down into three subphases: seed imbibition, followed by germination and lastly, shoot elongation. |
|---|
| 8 | !! The soil physical conditions influence not only the duration of emergence but also the number of emerged plants, in particular in dry conditions or when |
|---|
| 9 | !! there is a surface crust. |
|---|
| 10 | !> - Moistening : |
|---|
| 11 | !! Seed moistening can be regarded as a passive process starting at a species-dependent water potential prevailing in the seed bed (potgermi in MPa). |
|---|
| 12 | !! The relationship from Clapp and Hornberger (1978), parameterized by the characteristic soil water contents of field capacity and wilting point, was used |
|---|
| 13 | !! to convert potgermi into water content (in function "humpotsol", described in the module Divers_develop.f90). Once the seed is moistened, it has a limited |
|---|
| 14 | !! number of days of autotrophy (nbjgrauto) due to its reserves. This number has a species-dependent component (nbjgerlim) but also a thermal one, since |
|---|
| 15 | !! it is thought that at low temperature (i.e the average soil temperature in the seed bed, from the beginning of moistening), respiration processes and |
|---|
| 16 | !! the consumption of reserves are slower (the minimum at high temperature is propjgermin x nbjgermin). When the temperature is lower than the |
|---|
| 17 | !! germination base temperature, tgmin, then the day number is maximal (nbjgerlim). |
|---|
| 18 | !> - Germination : |
|---|
| 19 | !! Germination is achieved when the growing degree-days from planting in the seed bed (somger) reaches a given threshold (stpltger), with a condition as to |
|---|
| 20 | !! the dryness of the soil. Soil moisture in the seedbed influences germination through the "humirac" function (described in the module Divers.f90). |
|---|
| 21 | !! If the seedbed dries out, it may delay germination significantly. This does not impair grain viability as long as the grain has not already imbibed water. |
|---|
| 22 | !! If however the soil water content has been high enough to allow grain moistening, grain viability is reduced. To account for this effect, we relied on |
|---|
| 23 | !! Bradfords (1990, 2002) work showing that too long a time for germination after moistening reduces the germination rate if the number of days of |
|---|
| 24 | !! moistening (nbjhumec) is higher than a plant- and temperature-dependent threshold duration (nbjgrauto). It is assumed that germination occurs |
|---|
| 25 | !! (IGER being the germination day) but at a reduced plant density (ratio between density of germinated plants, densiteger, to sowing density, densitesem) |
|---|
| 26 | !! proportional to the thermal time deficit. |
|---|
| 27 | !> - Subsoil plantlet growth : |
|---|
| 28 | !! Germination initiates the growth of the root and then of the shoot. The growth rate of the shoot is assumed to be a logistic function of soil degree-days |
|---|
| 29 | !! that may slow down with unsuitable soil moisture (humirac). Emergence occurs when elongation (elong) is greater than sowing depth (profsem). |
|---|
| 30 | !> - Influence of soil crusting on emergence : |
|---|
| 31 | !! The density reduction law is specific to the crusting phenomenon but analogous to the other constraint law (water content and temperature-dependent) |
|---|
| 32 | !! with a minimum threshold corresponding to the vigueurbat parameter : if vigueurbat is greater than 0, which means that when the soil is crusted a |
|---|
| 33 | !! proportion of plants succeed in emerging, the crusting coeflev function is less effective than the water content and temperature-dependent coeflev function. |
|---|
| 34 | !! The combination of both relationships is made dynamically by calculating the daily derivatives of both laws: if the current day is a "battance=0" day |
|---|
| 35 | !! (battance is calculated in the module Stics_Battance.f90) the density reduction is done according to the crusting coeflev law. |
|---|
| 36 | !> |
|---|
| 37 | !! For woody plants which have perennial dormancy, ILEV stage corresponds to the budbreak stage (for this calculation hourly temperatures are reconstituted |
|---|
| 38 | !! in the module Stics_Debour.f90). |
|---|
| 39 | !------------------------------ |
|---|
| 40 | subroutine levee(n, tsol, hsol, nlevobs, & ! INPUTS |
|---|
| 41 | densiteger,densite,coeflev,densitelev,zrac, & ! INOUT |
|---|
| 42 | somelong,somger,nlev,nger, humectation,nbjhumec,somtemphumec,somcour, & ! INOUT |
|---|
| 43 | in_cycle, f_crop_recycle, nplt) ! INOUT |
|---|
| 44 | |
|---|
| 45 | USE Stics |
|---|
| 46 | USE Besoins_en_froid |
|---|
| 47 | USE Divers_water |
|---|
| 48 | !USE Messages |
|---|
| 49 | |
|---|
| 50 | |
|---|
| 51 | |
|---|
| 52 | implicit none |
|---|
| 53 | |
|---|
| 54 | |
|---|
| 55 | ! 0.1 INPUT |
|---|
| 56 | |
|---|
| 57 | |
|---|
| 58 | integer, intent(IN) :: n |
|---|
| 59 | real, intent(IN), dimension(3) :: tsol !> // soil temperature with resolution of 1 cm, the dimension is 3, we consider the sowing depth and his upper and lower neighbours // degree C |
|---|
| 60 | real, intent(IN), dimension(3) :: hsol !> // soil moisture with resolution of 1 cm, the dimension is 3, we consider the sowing depth and his upper and lower neighbours // |
|---|
| 61 | integer, intent(IN) :: nlevobs |
|---|
| 62 | integer, intent(IN) :: nplt |
|---|
| 63 | |
|---|
| 64 | |
|---|
| 65 | |
|---|
| 66 | !integer, intent(IN) :: P_codeperenne !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 |
|---|
| 67 | !integer, intent(IN) :: P_codebfroid !> // PARAMETER // option of calculation of chilling requirements // code 1/2 // PARPLT // 0 |
|---|
| 68 | !integer, intent(IN) :: P_codegdhdeb !> // PARAMETER // option of calculation of the bud break date in hourly or daily growing degrees // code 1/2 // PARPLT // 0 |
|---|
| 69 | !integer, intent(IN) :: P_codetemp !> // PARAMETER // option calculation mode of heat time for the plant : with air temperature (1) or crop temperature (2) // code 1/2 // PARPLT // 0 |
|---|
| 70 | !integer, intent(IN) :: P_codegermin !> // PARAMETER // option of simulation of a germination phase or a delay at the beginning of the crop (1) or direct starting (2) // code 1/2 // PARPLT // 0 |
|---|
| 71 | !integer, intent(IN) :: P_codefente !> // PARAMETER // option allowing an additional water compartment for the swelling soils: yes (1), no (0) // code 0/1 // PARSOL // 0 |
|---|
| 72 | !integer, intent(IN) :: P_codepluiepoquet !> // PARAMETER // option to replace rainfall by irrigation at poquet depth in the case of poquet sowing // code 1/2 // PARAMV6 // 0 |
|---|
| 73 | !integer, intent(IN) :: P_codehypo !> // PARAMETER // option of simulation of a phase of hypocotyl growth (1) or planting of plantlets (2) // code 1/2 // PARPLT // 0 |
|---|
| 74 | !integer, intent(IN) :: P_nbjgerlim !> // PARAMETER // Threshold number of day after grain imbibition without germination lack // days // PARPLT // 1 |
|---|
| 75 | !real, intent(IN) :: tmin !> // OUTPUT // Minimum active temperature of air // degree C |
|---|
| 76 | !real, intent(IN) :: tmin_demain |
|---|
| 77 | !real, intent(IN) :: tmax !> // OUTPUT // Maximum active temperature of air // degree C |
|---|
| 78 | !integer, intent(IN) :: n |
|---|
| 79 | !integer, intent(IN) :: nrec |
|---|
| 80 | !integer, intent(IN) :: P_nlevlim1 !> // PARAMETER // number of days after germination decreasing the emerged plants if emergence has not occur // days // PARPLT // 1 |
|---|
| 81 | !integer, intent(IN) :: P_nlevlim2 !> // PARAMETER // number of days after germination after which the emerged plants are null // days // PARPLT // 1 |
|---|
| 82 | !real, intent(IN) :: P_tdmindeb !> // PARAMETER // minimal thermal threshold for hourly calculation of phasic duration between dormancy and bud breaks // degree C // PARPLT // 1 |
|---|
| 83 | !real, intent(IN) :: P_tdmaxdeb !> // PARAMETER // maximal thermal threshold for hourly calculation of phasic duration between dormancy and bud breaks // degree C // PARPLT // 1 |
|---|
| 84 | !real, intent(IN) :: rfvi !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1 |
|---|
| 85 | !real, intent(IN) :: rfpi !> // OUTPUT // Slowing effect of the photoperiod on plant development // 0-1 |
|---|
| 86 | !real, intent(IN) :: P_profsem !> // PARAMETER // Sowing depth // cm // PARTEC // 1 |
|---|
| 87 | !real, intent(IN) :: P_stdordebour !> // PARAMETER // phasic duration between the dormancy break and the bud break // degree.days // PARPLT // 1 |
|---|
| 88 | !real, intent(IN) :: P_tgmin !> // PARAMETER // Minimum threshold temperature used in emergence stage // degree C // PARPLT // 1 |
|---|
| 89 | !real, intent(IN) :: P_stpltger !> // PARAMETER // Sum of development allowing germination // degree.days // PARPLT // 1 |
|---|
| 90 | !real, intent(IN) :: P_sensrsec !> // PARAMETER // root sensitivity to drought (1=insensitive) // SD // PARPLT // 1 |
|---|
| 91 | !real, intent(IN) :: P_psihucc !> // PARAMETER // soil potential corresponding to field capacity // Mpa // PARAM // 1 |
|---|
| 92 | !real, intent(IN) :: P_psihumin !> // PARAMETER // soil potential corresponding to wilting point // Mpa // PARAM // 1 |
|---|
| 93 | !real, intent(IN) :: P_potgermi !> // PARAMETER // humidity threshold from which seed humectation occurs, expressed in soil water potential // Mpa // PARPLT // 1 |
|---|
| 94 | !real, intent(IN) :: P_tdmax !> // PARAMETER // Maximum threshold temperature for development // degree C // PARPLT // 1 |
|---|
| 95 | !real, intent(IN) :: P_propjgermin !> // PARAMETER // minimal proportion of the duration P_nbjgerlim when the temperature is higher than the temperature threshold P_Tdmax // % // PARPLT // 1 |
|---|
| 96 | !real, intent(IN) :: P_densitesem !> // PARAMETER // Sowing density // plants.m-2 // PARTEC // 1 |
|---|
| 97 | !real, intent(IN) :: pluiesemis |
|---|
| 98 | !real, intent(IN) :: P_pluiebat !> // PARAMETER // minimal rain quantity for the crust occurrence // mm day-1 // PARSOL // 1 |
|---|
| 99 | !real, intent(IN) :: P_mulchbat !> // PARAMETER // mulch depth from which a crust occurs // cm // PARSOL // 1 |
|---|
| 100 | !real, intent(IN) :: xmlch1 !> // OUTPUT // Thickness of mulch created by evaporation from the soil // cm |
|---|
| 101 | !real, intent(IN) :: P_vigueurbat !> // PARAMETER // indicator of plant vigor allowing to emerge through the crust // between 0 and 1 // PARPLT // 1 |
|---|
| 102 | !real, intent(IN) :: P_celong !> // PARAMETER // parameter of the subsoil plantlet elongation curve // SD // PARPLT // 1 |
|---|
| 103 | !real, intent(IN) :: P_belong !> // PARAMETER // parameter of the curve of coleoptile elongation // degree.days -1 // PARPLT // 1 |
|---|
| 104 | !real, intent(IN) :: P_elmax !> // PARAMETER // Maximum elongation of the coleoptile in darkness condition // cm // PARPLT // 1 |
|---|
| 105 | !integer, intent(IN) :: nbCouches |
|---|
| 106 | !real, intent(IN) :: tsol(0:nbCouches) |
|---|
| 107 | !real, intent(IN) :: hur(nbCouches) |
|---|
| 108 | !real, intent(IN) :: humin(nbCouches) |
|---|
| 109 | !real, intent(IN) :: hucc(nbCouches) |
|---|
| 110 | !real, intent(IN) :: trr !> // OUTPUT // Rainfall // mm.day-1 |
|---|
| 111 | !real, intent(IN) :: dacouche(0:nbCouches) |
|---|
| 112 | |
|---|
| 113 | |
|---|
| 114 | |
|---|
| 115 | ! 0.2 INOUT |
|---|
| 116 | |
|---|
| 117 | !real, intent(INOUT) :: udevair !> // OUTPUT // Effective temperature for the development, computed with TAIR // degree.days |
|---|
| 118 | !real, intent(INOUT) :: udevcult !> // OUTPUT // Effective temperature for the development, computed with TCULT // degree.days |
|---|
| 119 | !real, intent(INOUT) :: upvt !> // OUTPUT // Daily development unit // degree.days |
|---|
| 120 | real, intent(INOUT) :: densiteger |
|---|
| 121 | real, intent(INOUT) :: densite !> // OUTPUT // Actual sowing density // plants.m-2 |
|---|
| 122 | real, intent(INOUT) :: coeflev |
|---|
| 123 | real, intent(INOUT) :: densitelev |
|---|
| 124 | real, intent(INOUT) :: zrac !> // OUTPUT // Depth reached by root system // cm |
|---|
| 125 | real, intent(INOUT) :: somelong |
|---|
| 126 | real, intent(INOUT) :: somger |
|---|
| 127 | integer, intent(INOUT) :: nlev |
|---|
| 128 | integer, intent(INOUT) :: nger |
|---|
| 129 | logical, intent(INOUT) :: humectation |
|---|
| 130 | integer, intent(INOUT) :: nbjhumec |
|---|
| 131 | real, intent(INOUT) :: somtemphumec |
|---|
| 132 | real, intent(INOUT) :: somcour !> // OUTPUT // Cumulated units of development between two stages // degree.days |
|---|
| 133 | logical, intent(INOUT) :: in_cycle !> in this subroutine, we also judge whether or not we should stop the crop cycle due to no emergence, if the coeflev is becoming zero, then the in_cycle should be setted as FALSE, indicating exiting this cycle |
|---|
| 134 | |
|---|
| 135 | logical, intent(INOUT) :: f_crop_recycle !> if the crop can not emerge, then the in_cycle should be setted as FALSE, indicating exiting this cycle, and recycle crop |
|---|
| 136 | |
|---|
| 137 | |
|---|
| 138 | ! 0.4 local variables |
|---|
| 139 | |
|---|
| 140 | !integer :: i !> |
|---|
| 141 | !integer :: isem !> |
|---|
| 142 | !integer :: isembas !> |
|---|
| 143 | !integer :: isemhaut |
|---|
| 144 | !! NB le 19/01/08 |
|---|
| 145 | !real :: hn !> |
|---|
| 146 | !real :: hx !> |
|---|
| 147 | |
|---|
| 148 | real :: udevlev |
|---|
| 149 | real :: temphumec |
|---|
| 150 | real :: levbat |
|---|
| 151 | real :: nbjgrauto |
|---|
| 152 | integer :: icompte |
|---|
| 153 | real :: elong !> |
|---|
| 154 | real :: humsol !> |
|---|
| 155 | |
|---|
| 156 | |
|---|
| 157 | |
|---|
| 158 | |
|---|
| 159 | !: FUNCTIONS |
|---|
| 160 | ! real :: humirac ! module Divers |
|---|
| 161 | ! real :: battance |
|---|
| 162 | ! real :: humpotsol |
|---|
| 163 | |
|---|
| 164 | |
|---|
| 165 | |
|---|
| 166 | ! 25/04/2012 DR et IGC le retour ..., pb si on force la levee pour la vigne on passe dans le caluvle de la germination et on met une densité à 0 |
|---|
| 167 | ! en gros il faut decomposer le test en 2 lignes |
|---|
| 168 | ! if (P_codeperenne == 2 .and. P_codebfroid == 3 .and. nlevobs == 999) then |
|---|
| 169 | |
|---|
| 170 | ! for perennial crop which are suffering P_codebroid |
|---|
| 171 | if (P_codeperenne == 2 .and. P_codebfroid == 3 ) then |
|---|
| 172 | !if(nlevobs == 999)then |
|---|
| 173 | !!: PB - 15/12/2008: Pour bien faire, je pense qu'on pourrait facilement déporter le calcul des udev et upvt pour debour dans develop. |
|---|
| 174 | !!- Ca allégerait l'écriture de levee et ça serait sans doute tout autant logique. |
|---|
| 175 | ! if (P_codegdhdeb == 2) call debour(P_codegdhdeb,P_codetemp,tmax,tmin,tmin_demain,P_tdmindeb,P_tdmaxdeb,rfvi,rfpi, & |
|---|
| 176 | ! upvt,udevair,udevcult) |
|---|
| 177 | ! somelong = somelong + upvt |
|---|
| 178 | ! ! write(70,*) '2.',somelong,upvt |
|---|
| 179 | ! if (somelong > P_stdordebour) then |
|---|
| 180 | ! nlev = n |
|---|
| 181 | ! somelong = 0. |
|---|
| 182 | ! ! DR 05/08/08 si on est à debourrement on initialise qnplante à P_qnplante0 , |
|---|
| 183 | ! ! apres essai y'a pb ca plante au bout de 12 ans à voir avec nadine |
|---|
| 184 | ! ! qnplante(ipl,1,n-1) = P_qnplante0 |
|---|
| 185 | ! endif |
|---|
| 186 | ! return |
|---|
| 187 | !else |
|---|
| 188 | return |
|---|
| 189 | !endif |
|---|
| 190 | endif |
|---|
| 191 | |
|---|
| 192 | ! print *, 'in levee, the tsoil is', tsol(:) |
|---|
| 193 | |
|---|
| 194 | !: La germination |
|---|
| 195 | !- calcul de la germination màªme si nlev observé pour le démarrage de la vernalisation |
|---|
| 196 | !isem = int(P_profsem) |
|---|
| 197 | udevlev = tsol(2) - P_tgmin ! there are 3 layers for tsol, the second layer means the sowing depth |
|---|
| 198 | if (udevlev <= 0.0) udevlev = 0.0 |
|---|
| 199 | |
|---|
| 200 | ! write(*,*) 'nplt, udevlev, nger', nplt, udevlev, nger |
|---|
| 201 | |
|---|
| 202 | !: Rajout domi - 15/09/97: |
|---|
| 203 | !- Test sur isem-1 et isem+1 pour qu'ils restent dans l'intervalle [1,200] |
|---|
| 204 | !- Calcul de la germination si P_codegermin = 1 |
|---|
| 205 | !- domi - 14/12/00 - on passe la profondeur de sol de 200 à 1000 |
|---|
| 206 | !- TODO: Remplacer le 1000 par nbCouches |
|---|
| 207 | |
|---|
| 208 | !isembas = isem-1 |
|---|
| 209 | !isemhaut = isem+1 |
|---|
| 210 | !if (isembas < 1) isembas = 1 |
|---|
| 211 | !if (isembas > 1000) isembas = 1000 |
|---|
| 212 | !if (isemhaut < 1) isemhaut = 1 |
|---|
| 213 | !if (isemhaut > 1000) isemhaut = 1000 |
|---|
| 214 | if (P_codegermin == 1) then |
|---|
| 215 | !humsol = (hur(isem) + hur(isemhaut) + hur(isembas)) / 3 |
|---|
| 216 | humsol = (hsol(2) + hsol(1) + hsol(3)) / 3.0 ! although the code is not elegant but it is clear |
|---|
| 217 | |
|---|
| 218 | !hn = (humin(isem) + humin(isemhaut) + humin(isembas)) / 3 |
|---|
| 219 | !hx = (hucc(isem) + hucc(isemhaut) + hucc(isembas)) / 3 |
|---|
| 220 | |
|---|
| 221 | ! print *, 'tsol and humsol in levee is', tsol(2), humsol |
|---|
| 222 | |
|---|
| 223 | somger = somger + (udevlev * F_humirac(humsol)) |
|---|
| 224 | ! write(*,*) 'udevlev * F_humirac(humsol)', udevlev * F_humirac(humsol) |
|---|
| 225 | ! write(*,*) 'somger ', somger |
|---|
| 226 | |
|---|
| 227 | if (somger >= P_stpltger .and. nger == 0) then |
|---|
| 228 | nger = n |
|---|
| 229 | somelong = somger - P_stpltger |
|---|
| 230 | zrac = P_profsem |
|---|
| 231 | endif |
|---|
| 232 | |
|---|
| 233 | ! print *, 'in levee, the somger and somlong is,', somger, somelong |
|---|
| 234 | |
|---|
| 235 | ! NB le 18/08/07 : si levée observée et germination postérieure à la levée alors forçage germination |
|---|
| 236 | |
|---|
| 237 | ! we do not use the forced emergence data |
|---|
| 238 | |
|---|
| 239 | !if (nlevobs /= 999) then |
|---|
| 240 | ! if (nger > 0 .and. nlevobs < nger) then |
|---|
| 241 | ! nger = nlevobs |
|---|
| 242 | ! endif |
|---|
| 243 | !endif |
|---|
| 244 | |
|---|
| 245 | !: NB le 11/04/05 introduction manques à la germination |
|---|
| 246 | !- Sophie Lebonvallet |
|---|
| 247 | !- humectation de la graine |
|---|
| 248 | !- initialisation de humectation,nbjhumec |
|---|
| 249 | |
|---|
| 250 | |
|---|
| 251 | if (somger < P_stpltger .and. nger == 0) then |
|---|
| 252 | !whether or not the humidity is larger than the potential soil humidity |
|---|
| 253 | !if (humsol >= humpotsol(P_psihucc,P_psihumin,hn,hx,dacouche(isem),P_potgermi,P_codefente)) then |
|---|
| 254 | if (humsol >= 1) then |
|---|
| 255 | if (.not. humectation ) humectation = .TRUE. |
|---|
| 256 | endif |
|---|
| 257 | if (humectation) then |
|---|
| 258 | nbjhumec = nbjhumec+1 ! accumulated days for humectation |
|---|
| 259 | somtemphumec = tsol(2) + somtemphumec |
|---|
| 260 | temphumec = somtemphumec / nbjhumec |
|---|
| 261 | ! on calcule le nombre de jours limite d'autotrophie de la graine en fonction de la température |
|---|
| 262 | nbjgrauto = (P_propjgermin - 1.0) / (P_tdmax - P_tgmin) * temphumec + 1 + (1.0 - P_propjgermin) * P_tgmin / & |
|---|
| 263 | (P_tdmax - P_tgmin) |
|---|
| 264 | if (temphumec < P_tgmin) nbjgrauto = 1.0 |
|---|
| 265 | if (temphumec > P_tdmax) nbjgrauto = P_propjgermin |
|---|
| 266 | else |
|---|
| 267 | somtemphumec = 0. |
|---|
| 268 | nbjgrauto = 1.0 |
|---|
| 269 | endif |
|---|
| 270 | nbjgrauto = nbjgrauto*P_nbjgerlim |
|---|
| 271 | if (nbjhumec >= nbjgrauto) then |
|---|
| 272 | nger = n |
|---|
| 273 | densiteger = P_densitesem * somger / P_stpltger |
|---|
| 274 | ! ajout de test NB le 09/08/05 |
|---|
| 275 | if (densiteger > P_densitesem) densiteger = P_densitesem |
|---|
| 276 | else |
|---|
| 277 | densiteger = P_densitesem |
|---|
| 278 | endif |
|---|
| 279 | endif |
|---|
| 280 | ! DR 06/02/07 on a pas acces à la densité à germination pour sophie |
|---|
| 281 | ! pour l'instant je l'affecte dans densite mais c'est à voir avce nad |
|---|
| 282 | densite = densiteger |
|---|
| 283 | else |
|---|
| 284 | nger = n |
|---|
| 285 | zrac = P_profsem |
|---|
| 286 | endif |
|---|
| 287 | |
|---|
| 288 | |
|---|
| 289 | |
|---|
| 290 | ! introduction battance NB le 12/05/05 |
|---|
| 291 | ! bug nrec > nrec (NB 19/01/08) |
|---|
| 292 | !levbat = battance(n,nplt,nrec,P_codeperenne,pluiesemis,trr,P_pluiebat,P_mulchbat,xmlch1,elong,P_profsem) |
|---|
| 293 | ! Nb le 19/01/08 : pas de battance avec le semis en poquet |
|---|
| 294 | !--if (P_vigueurbat == 1.0) levbat = 1.0 |
|---|
| 295 | |
|---|
| 296 | |
|---|
| 297 | ! in this version, we do not consider the levbat effects on germination |
|---|
| 298 | if (P_vigueurbat == 1.0 .or. P_codepluiepoquet == 1) levbat = 1.0 |
|---|
| 299 | |
|---|
| 300 | |
|---|
| 301 | !: élongation |
|---|
| 302 | !- NB - 17/08/07 : il faut pouvoir calculer la densité levée quel que soit |
|---|
| 303 | !- nlev obs ou cal |
|---|
| 304 | |
|---|
| 305 | if (nlevobs == 999) then |
|---|
| 306 | if (nger > 0 .and. nlev == 0) then |
|---|
| 307 | if (P_codehypo == 2) then |
|---|
| 308 | nlev = n |
|---|
| 309 | else |
|---|
| 310 | ! From the codes of this part, it calculates the average soil moisture in specific layers. It also calculates the Hn and Hx. |
|---|
| 311 | ! but in this version, we just use the soil moisture at sowing depth to replace it. ---xcw |
|---|
| 312 | |
|---|
| 313 | !humsol = 0. |
|---|
| 314 | !hn = 0. |
|---|
| 315 | !hx = 0. |
|---|
| 316 | ! NB le 19/01/08 compteur pour moyenne correcte |
|---|
| 317 | !icompte = 0 |
|---|
| 318 | !do i = isembas,max(int(zrac),isemhaut) |
|---|
| 319 | ! humsol = humsol + hur(i) |
|---|
| 320 | ! hn = hn + humin(i) |
|---|
| 321 | ! hx = hx + hucc(i) |
|---|
| 322 | ! icompte = icompte + 1 |
|---|
| 323 | !end do |
|---|
| 324 | !humsol = humsol / icompte |
|---|
| 325 | |
|---|
| 326 | ! we just show that the humsol is same to the average soil moisture of the 3 layers around sowing depth |
|---|
| 327 | humsol = humsol |
|---|
| 328 | !hn = hn / icompte |
|---|
| 329 | !hx = hx / icompte |
|---|
| 330 | |
|---|
| 331 | ! introduction battance NB le 12/05/05 |
|---|
| 332 | somelong = somelong + (udevlev * levbat * F_humirac(humsol)) |
|---|
| 333 | elong = P_elmax * (1 - exp(-(P_belong * somelong)**P_celong)) |
|---|
| 334 | |
|---|
| 335 | ! print *, 'in levee, the elong is,', elong |
|---|
| 336 | ! write(*,*) 'elong,',elong |
|---|
| 337 | |
|---|
| 338 | if (elong >= P_profsem) nlev = n |
|---|
| 339 | endif |
|---|
| 340 | endif |
|---|
| 341 | endif |
|---|
| 342 | |
|---|
| 343 | ! print *, 'in levee before calculating coeflev, P_nlevlim1 P_nlevlim2, levbat, coeflev are', P_nlevlim1, P_nlevlim2, levbat, coeflev |
|---|
| 344 | |
|---|
| 345 | !: Diminution de la densité levée en fonction du délai germination-levée |
|---|
| 346 | !- paramàštres à mettre dans *.plt 18/12/01 |
|---|
| 347 | |
|---|
| 348 | ! FOR WINTER WHEAT, THE GROWING SEASON CAN COVER TWO YEAS, SO IN THE NEXT YEAR WE SHOULD NOT |
|---|
| 349 | ! REPLACE THE COEFLEV AS 1.0. |
|---|
| 350 | ! WE ALSO SET A CONDITION THAT IF THE COEFLEV IS NEGATIVE, WE SET IT AS 0. |
|---|
| 351 | |
|---|
| 352 | |
|---|
| 353 | if ( nger > 0 ) then |
|---|
| 354 | if ( nger > nplt ) then !especially for crops covering two years, here in the current year the crop germinated |
|---|
| 355 | if (((n - nger) < P_nlevlim1) .AND. ((n - nger) >= 0 )) then ! |
|---|
| 356 | coeflev = 1.0 |
|---|
| 357 | else |
|---|
| 358 | if ( P_nlevlim1 < P_nlevlim2 ) then |
|---|
| 359 | if ( levbat == 1. ) then |
|---|
| 360 | if ( n - nger >= 0 ) then |
|---|
| 361 | coeflev = coeflev + (1. / float((P_nlevlim1 - P_nlevlim2))) |
|---|
| 362 | else ! for winter wheat, it emerges in the following spring |
|---|
| 363 | coeflev = coeflev + (1. / float((P_nlevlim1 - P_nlevlim2))) * 1.06 ! largely reduction of coeflev |
|---|
| 364 | endif |
|---|
| 365 | ! IF THE COEFLEV IS BECOMING NEGATIVE, WE SHOULD SET IT AS 0. |
|---|
| 366 | if ( coeflev <= 0.0 ) then |
|---|
| 367 | coeflev = 0.0 |
|---|
| 368 | in_cycle = .FALSE. |
|---|
| 369 | f_crop_recycle = .TRUE. |
|---|
| 370 | endif |
|---|
| 371 | else |
|---|
| 372 | coeflev = coeflev + (1. - P_vigueurbat) /float( (P_nlevlim1-P_nlevlim2)) |
|---|
| 373 | ! THE SAME AS ABOVE, IF THE COEFLEV IS BECOMING NEGATIVE, WE SHOULD SET IT AS ZERO |
|---|
| 374 | if ( coeflev <= 0.0 ) then |
|---|
| 375 | coeflev = 0.0 |
|---|
| 376 | in_cycle = .FALSE. |
|---|
| 377 | f_crop_recycle = .TRUE. |
|---|
| 378 | endif |
|---|
| 379 | |
|---|
| 380 | endif |
|---|
| 381 | else |
|---|
| 382 | if ( levbat == 1. ) then |
|---|
| 383 | coeflev = 0.0 |
|---|
| 384 | |
|---|
| 385 | !: ML 11/12/07 y'avait un bug: on ne peut pas avoir coeflev = P_vigueurbat apràšs P_nlevlim2 |
|---|
| 386 | !- si à la fois la battance et les conditions d'humidité et de température ont |
|---|
| 387 | !- freiné la levée |
|---|
| 388 | !--else |
|---|
| 389 | !-- coeflev = P_vigueurbat |
|---|
| 390 | endif |
|---|
| 391 | endif |
|---|
| 392 | endif |
|---|
| 393 | else ! especially for crops covering two years, for one-year crop it will not occur. for spring germination, the effective densite should be largely reduced |
|---|
| 394 | coeflev = 1.0 + (1. / float((P_nlevlim1 - P_nlevlim2))) * ( (365-nplt-P_nlevlim1) + n*1.06 ) ! calculation of the coeflev until crop emerges in spring |
|---|
| 395 | if ( coeflev <= 0.0 ) then |
|---|
| 396 | coeflev = 0.0 |
|---|
| 397 | in_cycle = .FALSE. |
|---|
| 398 | f_crop_recycle = .TRUE. |
|---|
| 399 | endif |
|---|
| 400 | endif |
|---|
| 401 | endif |
|---|
| 402 | |
|---|
| 403 | ! print *, 'in levee the densiteger, coeflev is', densiteger, coeflev |
|---|
| 404 | |
|---|
| 405 | |
|---|
| 406 | !: Réduction de densité |
|---|
| 407 | !- introduction de l'effet battance le 13/05/05 |
|---|
| 408 | !- modif NB le 18/08/07 |
|---|
| 409 | if (n == nlev .or. n == nlevobs) then |
|---|
| 410 | densitelev = densiteger * coeflev |
|---|
| 411 | densite = densitelev |
|---|
| 412 | if (densite <= 0.) then |
|---|
| 413 | !call EnvoyerMsgHistorique(400) |
|---|
| 414 | !: ML le 21/09/04 lorsque la densite de levee est nulle, on n arrete |
|---|
| 415 | !- pas la simulation (equivaut a un sol nu) |
|---|
| 416 | !--stop |
|---|
| 417 | !- domi 16/05/06 j'essaie de mettre la densite à zéro |
|---|
| 418 | densite = 0.0 |
|---|
| 419 | endif |
|---|
| 420 | |
|---|
| 421 | endif |
|---|
| 422 | |
|---|
| 423 | !: 29/01/04 - bug pour affichage pheno dans bilan: |
|---|
| 424 | !- somcour etait mal affecte (NB et ML) |
|---|
| 425 | if (n >= nger .and. nger > 0) then |
|---|
| 426 | somcour = P_stpltger + somelong |
|---|
| 427 | else |
|---|
| 428 | somcour = somger |
|---|
| 429 | endif |
|---|
| 430 | |
|---|
| 431 | return |
|---|
| 432 | end subroutine levee |
|---|
