source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_data.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 11 years ago

Import first version of ORCHIDEE_EXT

File size: 18.3 KB
Line 
1! defines PFT parameters
2! the geographical coordinates might be used for defining some additional parameters
3! (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.)
4!
5! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_data.f90,v 1.12 2009/06/24 10:53:17 ssipsl Exp $
6! IPSL (2006)
7!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9MODULE stomate_data
10
11  ! modules used:
12
13  USE constantes
14  USE pft_parameters
15  USE defprec
16 
17
18  IMPLICIT NONE
19
20  ! bare soil in Sechiba
21  INTEGER(i_std),PARAMETER :: ibare_sechiba = 1
22  !-
23  ! 0 = no, 4 = full online diagnostics
24  INTEGER(i_std),SAVE :: bavard=1
25
26
27  ! Move to
28  ! Horizontal indices
29  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index
30  ! Horizonatal + PFT indices
31  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index
32  !-
33  ! Land cover change
34  ! Horizontal + P10 indices
35  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index
36  ! Horizontal + P100 indices
37  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index 
38  ! Horizontal + P11 indices
39  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index
40  ! Horizontal + P101 indices
41  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index 
42  !-
43  ! time step
44  INTEGER(i_std),SAVE :: itime
45  ! STOMATE history file ID
46  INTEGER(i_std),SAVE :: hist_id_stomate
47  ! STOMATE history file ID for IPCC output
48  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC
49  ! STOMATE restart file ID
50  INTEGER(i_std),SAVE :: rest_id_stomate
51
52  ! critical value for being adapted (1-1/e)
53  REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler )
54  ! critical value for being regenerative (1/e)
55  REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler
56
57
58  ! private & public routines
59
60  PUBLIC data
61
62CONTAINS
63
64  SUBROUTINE data (npts, lalo)
65
66    !
67    ! 0 declarations
68    !
69
70    ! 0.1 input
71
72    ! Domain size
73    INTEGER(i_std), INTENT(in)                               :: npts
74    ! Geographical coordinates (latitude,longitude)
75    REAL(r_std),DIMENSION (npts,2), INTENT (in)        :: lalo
76
77    ! 0.2 local variables
78
79    ! Index
80    INTEGER(i_std)                                    :: j
81    ! alpha's : ?
82    REAL(r_std)                                        :: alpha
83    ! stem diameter
84    REAL(r_std)                                        :: dia
85    ! Sapling CSA
86    REAL(r_std)                                        :: csa_sap
87
88    ! =========================================================================
89
90    IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics'
91
92    DO j = 2,nvm
93
94       IF ( bavard .GE. 1 ) WRITE(numout,'(a,i3,a,a)') '    > PFT#',j,': ', PFT_name(j)
95
96       !
97       ! 1 tree?
98       !
99
100       IF ( leaf_tab(j) .LE. 2 ) THEN
101          tree(j) = .TRUE.
102       ELSE
103          tree(j) = .FALSE.
104       ENDIF
105
106       IF ( bavard .GE. 1 ) WRITE(numout,*) '       tree: ', tree(j)
107
108       !
109       ! 2 flamability
110       !
111
112       IF ( bavard .GE. 1 ) WRITE(numout,*) '       litter flamability:', flam(j)
113
114       !
115       ! 3 fire resistance
116       !
117
118       IF ( bavard .GE. 1 ) WRITE(numout,*) '       fire resistance:', resist(j)
119
120       !
121       ! 4 specific leaf area per mass carbon = 2 * sla / dry mass
122       !
123
124       ! SZ: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
125       ! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
126       ! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
127       ! sla=exp(5.615-0.46*ln(leaflon in months))
128       ! Oct 2010 : replaced by values given by N.Viovy
129
130       IF ( bavard .GE. 1 ) WRITE(numout,*) '       specific leaf area (m**2/gC):', sla(j) !, 12./leaflife(j)
131
132       !
133       ! 5 sapling characteristics
134       !
135
136       IF ( tree(j) ) THEN
137
138          ! 5.1 trees
139
140          alpha = alpha_tree
141
142          bm_sapl(j,ileaf) = &
143               ( (bm_sapl_leaf(1)*pipe_tune1 * ( mass_ratio_heart_sap *bm_sapl_leaf(2)*sla(j)/(pi*pipe_k1))**bm_sapl_leaf(3) ) / sla(j) ) ** bm_sapl_leaf(4)
144
145          IF ( pheno_type(j) .NE. 1 ) THEN
146             ! not evergreen
147             bm_sapl(j,icarbres) = bm_sapl_carbres * bm_sapl(j,ileaf)
148          ELSE
149             bm_sapl(j,icarbres) = 0.0
150          ENDIF
151
152          csa_sap = bm_sapl(j,ileaf) / ( pipe_k1 / sla(j) )
153
154          dia = (mass_ratio_heart_sap * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
155
156          bm_sapl(j,isapabove) = &
157               bm_sapl_sapabove * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
158          bm_sapl(j,isapbelow) = bm_sapl(j,isapabove)
159
160          bm_sapl(j,iheartabove) = bm_sapl_heartabove * bm_sapl(j,isapabove)
161          bm_sapl(j,iheartbelow) = bm_sapl_heartbelow * bm_sapl(j,isapbelow)
162
163       ELSE
164
165          ! 5.2 grasses
166
167          alpha = alpha_grass
168
169          IF ( natural(j) ) THEN
170             bm_sapl(j,ileaf) = init_sapl_mass_leaf_nat / sla(j)
171          ELSE
172             bm_sapl(j,ileaf) = init_sapl_mass_leaf_agri / sla(j)
173          ENDIF
174
175          bm_sapl(j,icarbres) = init_sapl_mass_carbres *bm_sapl(j,ileaf)
176
177          bm_sapl(j,isapabove) = 0.
178          bm_sapl(j,isapbelow) = 0.
179
180          bm_sapl(j,iheartabove) = 0.
181          bm_sapl(j,iheartbelow) = 0.
182
183       ENDIF
184
185       bm_sapl(j,iroot) = init_sapl_mass_carbres * (1./alpha) * bm_sapl(j,ileaf)
186
187       bm_sapl(j,ifruit) = init_sapl_mass_fruit  * bm_sapl(j,ileaf)
188
189       IF ( bavard .GE. 1 ) THEN
190          WRITE(numout,*) '       sapling biomass (gC):'
191          WRITE(numout,*) '         leaves:',bm_sapl(j,ileaf)
192          WRITE(numout,*) '         sap above ground:',bm_sapl(j,isapabove)
193          WRITE(numout,*) '         sap below ground:',bm_sapl(j,isapbelow)
194          WRITE(numout,*) '         heartwood above ground:',bm_sapl(j,iheartabove)
195          WRITE(numout,*) '         heartwood below ground:',bm_sapl(j,iheartbelow)
196          WRITE(numout,*) '         roots:',bm_sapl(j,iroot)
197          WRITE(numout,*) '         fruits:',bm_sapl(j,ifruit)
198          WRITE(numout,*) '         carbohydrate reserve:',bm_sapl(j,icarbres)
199       ENDIF
200
201       !
202       ! 6 migration speed (m/year)
203       !
204
205       IF ( tree(j) ) THEN
206
207          migrate(j) = migrate_tree
208
209       ELSE
210
211          ! can be any value as grasses are, per definitionem, everywhere (big leaf).
212          migrate(j) = migrate_grass
213
214       ENDIF
215
216       IF ( bavard .GE. 1 ) WRITE(numout,*) '       migration speed (m/year):', migrate(j)
217
218       !
219       ! 7 critical stem diameter: beyond this diameter, the crown area no longer
220       !     increases
221       !
222
223       IF ( tree(j) ) THEN
224
225          maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2*pipe_tune3)/(maxdia_coeff(1)**pipe_tune3)) ) &
226               ** ( 1. / ( pipe_tune3 - 1. ) ) ) * maxdia_coeff(2)
227          cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
228
229       ELSE
230
231          maxdia(j) = undef
232          cn_sapl(j)=1
233
234       ENDIF
235
236       IF ( bavard .GE. 1 ) WRITE(numout,*) '       critical stem diameter (m):', maxdia(j)
237
238       !
239       ! 8 Coldest tolerable temperature
240       !
241
242       IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
243          tmin_crit(j) = tmin_crit(j) + ZeroCelsius
244       ELSE
245          tmin_crit(j) = undef
246       ENDIF
247
248       IF ( bavard .GE. 1 ) &
249            WRITE(numout,*) '       coldest tolerable temperature (K):', tmin_crit(j)
250
251       !
252       ! 9 Maximum temperature of the coldest month: need to be below this temperature
253       !      for a certain time to regrow leaves next spring
254       !
255
256       IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
257          tcm_crit(j) = tcm_crit(j) + ZeroCelsius
258       ELSE
259          tcm_crit(j) = undef
260       ENDIF
261
262       IF ( bavard .GE. 1 ) &
263            WRITE(numout,*) '       vernalization temperature (K):', tcm_crit(j)
264
265       !
266       ! 10 critical values for phenology
267       !
268
269       ! 10.1 model used
270
271       IF ( bavard .GE. 1 ) &
272            WRITE(numout,*) '       phenology model used: ',pheno_model(j)
273
274       ! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
275       !        or whatever), depends on how this is used in stomate_phenology.
276
277
278       IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
279          WRITE(numout,*) '         critical GDD is a function of long term T (C):'
280          WRITE(numout,*) '          ',pheno_gdd_crit(j,1), &
281               ' + T *',pheno_gdd_crit(j,2), &
282               ' + T^2 *',pheno_gdd_crit(j,3)
283       ENDIF
284
285       ! consistency check
286
287       IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
288            ( pheno_model(j) .EQ. 'humgdd' )       ) .AND. &
289            ( ANY(pheno_gdd_crit(j,:) .EQ. undef) )                      ) THEN
290         STOP 'problem with phenology parameters, critical GDD.'
291       ENDIF
292
293       ! 10.3 number of growing days
294
295       IF ( ( bavard .GE. 1 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
296            WRITE(numout,*) '         critical NGD:', ngd_crit(j)
297
298       ! 10.4 critical temperature for ncd vs. gdd function in phenology
299
300       IF ( ( bavard .GE. 1 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
301            WRITE(numout,*) '         critical temperature for NCD vs. GDD (C):', &
302            ncdgdd_temp(j)
303
304       ! 10.5 humidity fractions
305
306       IF ( ( bavard .GE. 1 ) .AND. ( hum_frac(j) .NE. undef ) ) &
307            WRITE(numout,*) '         critical humidity fraction:', hum_frac(j)
308
309       ! 10.6 minimum time during which there was no photosynthesis
310
311       IF ( ( bavard .GE. 1 ) .AND. ( lowgpp_time(j) .NE. undef ) ) &
312            WRITE(numout,*) '         minimum dormance duration (d):',lowgpp_time(j)
313
314       ! 10.7 minimum time elapsed since moisture minimum (d)
315
316       IF ( ( bavard .GE. 1 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
317            WRITE(numout,*) '         time to wait after moisture min (d):', hum_min_time(j)
318
319       !
320       ! 11 critical values for senescence
321       !
322
323       ! 11.1 type of senescence
324
325
326       IF ( bavard .GE. 1 ) &
327            WRITE(numout,*) '       type of senescence: ',senescence_type(j)
328
329       ! 11.2 critical temperature for senescence
330
331       IF ( ( bavard .GE. 1 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
332          WRITE(numout,*) '         critical temperature for senescence (C) is'
333          WRITE(numout,*) '          a function of long term T (C):'
334          WRITE(numout,*) '          ',senescence_temp(j,1), &
335               ' + T *',senescence_temp(j,2), &
336               ' + T^2 *',senescence_temp(j,3)
337       ENDIF
338
339       ! consistency check
340
341       IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
342            ( senescence_type(j) .EQ. 'mixed' )      ) .AND. &
343            ( ANY(senescence_temp(j,:) .EQ. undef ) )           ) THEN
344          STOP 'problem with senescence parameters, temperature.'
345       ENDIF
346
347       ! 11.3 critical relative moisture availability for senescence
348
349       IF ( ( bavard .GE. 1 ) .AND. ( senescence_hum(j) .NE. undef ) ) &
350            WRITE(numout,*) '         max. critical relative moisture availability for senescence:', &
351            senescence_hum(j)
352
353       ! consistency check
354
355       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
356            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
357            ( senescence_hum(j) .EQ. undef )                   ) THEN
358          STOP 'problem with senescence parameters, humidity.'
359       ENDIF
360
361       ! 14.3 relative moisture availability above which there is no moisture-related
362       !      senescence
363
364       IF ( ( bavard .GE. 1 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) &
365            WRITE(numout,*) '         relative moisture availability above which there is'
366       WRITE(numout,*) '             no moisture-related senescence:', &
367            nosenescence_hum(j)
368
369       ! consistency check
370
371       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
372            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
373            ( nosenescence_hum(j) .EQ. undef )                   ) THEN
374          STOP 'problem with senescence parameters, humidity.'
375       ENDIF
376
377       !
378       ! 12 sapwood -> heartwood conversion time
379       !
380
381       IF ( bavard .GE. 1 ) &
382            WRITE(numout,*) '       sapwood -> heartwood conversion time (d):', tau_sap(j)
383
384       !
385       ! 13 fruit lifetime
386       !
387
388       IF ( bavard .GE. 1 ) WRITE(numout,*) '       fruit lifetime (d):', tau_fruit(j)
389
390       !
391       ! 14 length of leaf death
392       !      For evergreen trees, this variable determines the lifetime of the leaves.
393       !      Note that it is different from the value given in leaflife_tab.
394       !
395
396       IF ( bavard .GE. 1 ) &
397            WRITE(numout,*) '       length of leaf death (d):', leaffall(j)
398
399       !
400       ! 15 maximum lifetime of leaves
401       !
402
403       IF ( ( bavard .GE. 1 ) .AND. ( leafagecrit(j) .NE. undef ) ) &
404            WRITE(numout,*) '       critical leaf age (d):', leafagecrit(j)
405
406       !
407       ! 16 time constant for leaf age discretisation (d)
408       !
409
410       leaf_timecst(j) = leafagecrit(j) / REAL( nleafages,r_std )
411
412       IF ( bavard .GE. 1 ) &
413            WRITE(numout,*) '       time constant for leaf age discretisation (d):', &
414            leaf_timecst(j)
415
416       !
417       ! 17 minimum lai, initial
418       !
419
420       IF ( tree(j) ) THEN
421          lai_initmin(j) = 0.3
422       ELSE
423          lai_initmin(j) = 0.1
424       ENDIF
425
426       IF ( bavard .GE. 1 ) &
427            WRITE(numout,*) '       initial LAI:', lai_initmin(j)
428
429       !
430       ! 19 maximum LAI
431       !
432
433       IF ( bavard .GE. 1 ) &
434            WRITE(numout,*) '       critical LAI above which no leaf allocation:', lai_max(j)
435
436       !
437       ! 20 fraction of primary leaf and root allocation put into reserve
438       !
439
440       IF ( bavard .GE. 1 ) &
441            WRITE(numout,*) '       reserve allocation factor:', ecureuil(j)
442
443       !
444       ! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
445       !
446
447       IF ( bavard .GE. 1 ) THEN
448
449          WRITE(numout,*) '       maintenance respiration coefficient (g/g/day) at 0 deg C:'
450          WRITE(numout,*) '         . leaves: ',coeff_maint_zero(j,ileaf)
451          WRITE(numout,*) '         . sapwood above ground: ',coeff_maint_zero(j,isapabove)
452          WRITE(numout,*) '         . sapwood below ground: ',coeff_maint_zero(j,isapbelow)
453          WRITE(numout,*) '         . heartwood above ground: ',coeff_maint_zero(j,iheartabove)
454          WRITE(numout,*) '         . heartwood below ground: ',coeff_maint_zero(j,iheartbelow)
455          WRITE(numout,*) '         . roots: ',coeff_maint_zero(j,iroot)
456          WRITE(numout,*) '         . fruits: ',coeff_maint_zero(j,ifruit)
457          WRITE(numout,*) '         . carbohydrate reserve: ',coeff_maint_zero(j,icarbres)
458
459       ENDIF
460
461       !
462       ! 22 parameter for temperature sensitivity of maintenance respiration
463       !
464
465       IF ( bavard .GE. 1 ) &
466            WRITE(numout,*) '       temperature sensitivity of maintenance respiration (1/K) is'
467       WRITE(numout,*) '          a function of long term T (C):'
468       WRITE(numout,*) '          ',maint_resp_slope(j,1),' + T *',maint_resp_slope(j,2), &
469            ' + T^2 *',maint_resp_slope(j,3)
470
471       !
472       ! 23 natural ?
473       !
474
475       IF ( bavard .GE. 1 ) &
476            WRITE(numout,*) '       Natural:', natural(j)
477
478       !
479       ! 24 Vcmax et Vjmax
480       !
481
482       IF ( bavard .GE. 1 ) &
483            WRITE(numout,*) '       Maximum rate of carboxylation:', vcmax_opt(j)
484
485       IF ( bavard .GE. 1 ) &
486            WRITE(numout,*) '       Maximum rate of RUbp regeneration:', vjmax_opt(j)
487
488       !
489       ! 25 constants for photosynthesis temperatures
490       !
491
492
493       IF ( bavard .GE. 1 ) THEN
494          WRITE(numout,*) '       min. temperature for photosynthesis as a function of long term T (C):'
495          WRITE(numout,*) '          ',tphoto_min_c(j), &
496               ' + T*',tphoto_min_b(j), &
497               ' + T^2*',tphoto_min_a(j)
498          WRITE(numout,*) '       opt. temperature for photosynthesis as a function of long term T (C):'
499          WRITE(numout,*) '          ',tphoto_opt_c(j), &
500               ' + T*',tphoto_opt_b(j), &
501               ' + T^2*',tphoto_opt_a(j)
502          WRITE(numout,*) '       max. temperature for photosynthesis as a function of long term T (C):'
503          WRITE(numout,*) '          ',tphoto_max_c(j), &
504               ' + T*',tphoto_max_b(j), &
505               ' + T^2*',tphoto_max_a(j)
506
507
508          !
509          ! 26 Properties
510          !
511
512          WRITE(numout,*) '       Slope of the gs/A relation:', gsslope(j)
513          WRITE(numout,*) '       Intercept of the gs/A relation:', gsoffset(j)
514          WRITE(numout,*) '       C4 photosynthesis:', is_c4(j)
515          WRITE(numout,*) '       Depth constant for root profile (m):', 1./humcste(j)
516
517       ENDIF
518
519       !
520       ! 27 extinction coefficient of the Monsi&Seaki (53) relationship
521       !
522
523
524       IF ( bavard .GE. 1 ) THEN
525          WRITE(numout,*) '       extinction coefficient:', ext_coeff(j)
526       ENDIF
527
528       !
529       ! 28 check coherence between tree definitions
530       !      this is not absolutely necessary (just security)
531       !
532
533       IF ( tree(j) .NEQV. is_tree(j) ) THEN
534          STOP 'Definition of tree/not tree not coherent'
535       ENDIF
536
537    ENDDO
538
539    !
540    ! 29 time scales for phenology and other processes (in days)
541    !
542
543    tau_longterm = coeff_tau_longterm * one_year
544
545    IF ( bavard .GE. 1 ) THEN
546
547       WRITE(numout,*) '   > time scale for ''monthly'' moisture availability (d):', &
548            tau_hum_month
549       WRITE(numout,*) '   > time scale for ''weekly'' moisture availability (d):', &
550           tau_hum_week
551       WRITE(numout,*) '   > time scale for ''monthly'' 2 meter temperature (d):', &
552            tau_t2m_month
553       WRITE(numout,*) '   > time scale for ''weekly'' 2 meter temperature (d):', &
554            tau_t2m_week
555       WRITE(numout,*) '   > time scale for ''weekly'' GPP (d):', &
556            tau_gpp_week
557       WRITE(numout,*) '   > time scale for ''monthly'' soil temperature (d):', &
558            tau_tsoil_month
559       WRITE(numout,*) '   > time scale for ''monthly'' soil humidity (d):', &
560            tau_soilhum_month
561       WRITE(numout,*) '   > time scale for vigour calculations (y):', &
562            tau_longterm / one_year
563
564    ENDIF
565
566    !
567    ! 30 fraction of allocatable biomass which is lost as growth respiration
568    !
569
570    IF ( bavard .GE. 1 ) &
571         WRITE(numout,*) '   > growth respiration fraction:', frac_growthresp
572
573    IF (bavard.GE.4) WRITE(numout,*) 'Leaving data'
574
575  END SUBROUTINE data
576
577END MODULE stomate_data
Note: See TracBrowser for help on using the repository browser.