source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_phenology.f90 @ 304

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

Clean some stomate modules : delete z_soil in stomate and lai as an input argument in stomate_phenology (and stomate_lpj)
File size: 34.8 KB
Line 
1! Phenology
2!
3! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_phenology.f90,v 1.11 2010/04/06 16:06:34 ssipsl Exp $
4! IPSL (2006)
5!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
6!
7MODULE stomate_phenology
8
9  ! modules used:
10
11  USE ioipsl
12  USE stomate_data
13  USE constantes
14  USE pft_parameters
15
16  IMPLICIT NONE
17
18  ! private & public routines
19
20  PRIVATE
21  PUBLIC phenology,phenology_clear
22
23  ! first call
24  LOGICAL, SAVE                                              :: firstcall = .TRUE.
25  LOGICAL, SAVE                                              :: firstcall_hum = .TRUE.
26  LOGICAL, SAVE                                              :: firstcall_moi = .TRUE.
27  LOGICAL, SAVE                                              :: firstcall_humgdd = .TRUE.
28  LOGICAL, SAVE                                              :: firstcall_moigdd = .TRUE.
29
30CONTAINS
31
32  SUBROUTINE phenology_clear
33    firstcall=.TRUE.
34    firstcall_hum=.TRUE.
35    firstcall_moi = .TRUE.
36    firstcall_humgdd = .TRUE.
37    firstcall_moigdd = .TRUE.
38  END SUBROUTINE phenology_clear
39
40  SUBROUTINE phenology (npts, dt, PFTpresent, &
41       veget_max, &
42       tlong_ref, t2m_month, t2m_week, gpp, &
43       maxmoiavail_lastyear, minmoiavail_lastyear, &
44       moiavail_month, moiavail_week, &
45       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
46       senescence, time_lowgpp, time_hum_min, &
47       biomass, leaf_frac, leaf_age, &
48       when_growthinit, co2_to_bm)
49
50    !
51    ! 0 declarations
52    !
53
54    ! 0.1 input
55
56    ! Domain size
57    INTEGER(i_std), INTENT(in)                                        :: npts
58    ! time step in days
59    REAL(r_std), INTENT(in)                                     :: dt
60    ! PFT exists
61    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent
62    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
63    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
64    ! "long term" 2 meter reference temperatures (K)
65    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: tlong_ref
66    ! "monthly" 2-meter temperatures (K)
67    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m_month
68    ! "weekly" 2-meter temperatures (K)
69    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m_week
70    ! daily gross primary productivity (gC/(m**2 of ground)/day)
71    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gpp
72    ! last year's maximum moisture availability
73    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear
74    ! last year's minimum moisture availability
75    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear
76    ! "monthly" moisture availability
77    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month
78    ! "weekly" moisture availability
79    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week
80    ! growing degree days, threshold -5 deg C
81    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_m5_dormance
82    ! growing degree days, since midwinter
83    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)               :: gdd_midwinter
84    ! number of chilling days since leaves were lost
85    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ncd_dormance
86    ! number of growing days, threshold -5 deg C
87    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ngd_minus5
88    ! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
89    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: senescence
90    ! duration of dormance (d)
91    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: time_lowgpp
92    ! time elapsed since strongest moisture availability (d)
93    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: time_hum_min
94
95    ! 0.2 modified fields
96
97    ! biomass (gC/(m**2 of ground))
98    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)     :: biomass
99    ! fraction of leaves in leaf age class
100    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac
101    ! leaf age (days)
102    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age
103    ! how many days ago was the beginning of the growing season
104    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit
105    ! co2 taken up (gC/(m**2 of total ground)/day)
106    !NV passge 2D
107    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                 :: co2_to_bm
108
109    ! 0.3 output
110
111    ! 0.4 local
112
113    ! are we allowed to decalre the beginning of the growing season?
114    LOGICAL, DIMENSION(npts,nvm)                              :: allow_initpheno
115    ! biomass we would like to have
116    REAL(r_std), DIMENSION(npts)                                :: bm_wanted
117    ! biomass we use (from carbohydrate reserve or from atmosphere)
118    REAL(r_std), DIMENSION(npts)                                :: bm_use
119    ! minimum leaf mass (gC/(m**2 of ground))
120    REAL(r_std), DIMENSION(npts)                                :: lm_min
121    ! does the leaf age distribution have to be reset?
122    LOGICAL(r_std), DIMENSION(npts)                             :: age_reset
123    ! indices
124    INTEGER(i_std)                                              :: i,j,m
125    ! signal to start putting leaves on
126    LOGICAL, DIMENSION(npts,nvm)                              :: begin_leaves
127
128    REAL(r_std), DIMENSION(npts,nvm)                          :: histvar
129
130    ! =========================================================================
131
132    IF (bavard.GE.3) WRITE(numout,*) 'Entering phenology'
133
134    !
135    ! 1 first call
136    !
137
138    IF ( firstcall ) THEN
139
140       WRITE(numout,*) 'phenology:'
141
142       WRITE(numout,*) '   > take carbon from atmosphere if carbohydrate' // &
143            ' reserve too small: ', always_init
144
145       WRITE(numout,*) '   > minimum time since last beginning of a growing' // &
146            ' season (d): ', min_growthinit_time
147
148       firstcall = .FALSE.
149
150    ENDIF
151
152    !
153    ! 2 various things
154    !
155
156    !
157    ! 2.1 allow detection of the beginning of the growing season if dormance was
158    !     long enough and last beginning of growing season was a sufficiently
159    !     long time ago
160    !
161
162    allow_initpheno(:,ibare_sechiba) = .FALSE. 
163    DO j = 2,nvm
164
165       WHERE ( ( time_lowgpp(:,j) .GE. lowgpp_time(j) ) .AND. &
166            ( when_growthinit(:,j) .GT. min_growthinit_time )          )
167          allow_initpheno(:,j) = .TRUE.
168       ELSEWHERE
169          allow_initpheno(:,j) = .FALSE.
170       ENDWHERE
171
172    ENDDO
173
174    WHERE(allow_initpheno)
175       histvar=un
176    ELSEWHERE
177       histvar=zero
178    ENDWHERE
179    CALL histwrite (hist_id_stomate, 'ALLOW_INITPHENO', itime, histvar, npts*nvm, horipft_index)
180
181    !
182    ! 2.2 increase counter: how many days ago was the beginning of the growing season
183    !     Needed for allocation
184    !
185
186    when_growthinit(:,:) = when_growthinit(:,:) + dt
187
188    !
189    ! 3 Check biometeorological conditions
190    !
191
192    ! default: phenology does not start
193    begin_leaves(:,:) = .FALSE.
194
195    ! different kinds of phenology
196   
197    ! used in all the differents models of phenology DS 17112010
198    t_always = ZeroCelsius + t_always_add
199
200    DO j = 2,nvm
201
202       SELECT CASE ( pheno_model(j) )
203
204       CASE ( 'hum' )
205
206          CALL pheno_hum (npts, j, PFTpresent, allow_initpheno, &
207               moiavail_month, moiavail_week, &
208               maxmoiavail_lastyear, minmoiavail_lastyear, &
209               begin_leaves)
210
211       CASE ( 'moi' )
212
213          CALL pheno_moi (npts, j, PFTpresent, allow_initpheno, &
214               time_hum_min, &
215               moiavail_month, moiavail_week, &
216               begin_leaves)
217
218
219       CASE ( 'ncdgdd' )
220
221          CALL pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
222               ncd_dormance, gdd_midwinter, &
223               t2m_month, t2m_week, begin_leaves)
224
225       CASE ( 'ngd' )
226
227          CALL pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd_minus5, &
228               t2m_month, t2m_week, begin_leaves)
229
230       CASE ( 'humgdd' )
231
232          CALL pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
233               maxmoiavail_lastyear, minmoiavail_lastyear, &
234               tlong_ref, t2m_month, t2m_week, &
235               moiavail_week, moiavail_month, &
236               begin_leaves)
237
238       CASE ( 'moigdd' )
239
240          CALL pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
241               time_hum_min, &
242               tlong_ref, t2m_month, t2m_week, &
243               moiavail_week, moiavail_month, &
244               begin_leaves)
245
246       CASE ( 'none' )
247
248          ! no action
249
250       CASE default
251
252          WRITE(numout,*) 'phenology: don''t know how to treat this PFT.'
253          WRITE(numout,*) '  number:',j
254          WRITE(numout,*) '  phenology model: ',pheno_model(j)
255          STOP
256
257       END SELECT
258
259    ENDDO
260
261    WHERE(begin_leaves)
262       histvar=un
263    ELSEWHERE
264       histvar=zero
265    ENDWHERE
266    CALL histwrite (hist_id_stomate, 'BEGIN_LEAVES', itime, histvar, npts*nvm, horipft_index)
267
268    !
269    ! 4 leaves start to grow if meteorological conditions are favourable and if
270    !   leaf regrowth is allowed (cf also turnover)
271    !
272
273    DO j = 2,nvm
274
275       age_reset(:) = .FALSE.
276
277       DO i = 1, npts
278
279          IF ( begin_leaves(i,j) ) THEN
280
281             lm_min(i) = lai_initmin(j) / sla(j)
282
283             ! do we have to put a minimum biomass into the leaves?
284
285             IF ( biomass(i,j,ileaf) .LT. lm_min(i) ) THEN
286
287                !
288                ! 4.1 determine how much biomass we can use
289                !
290
291                bm_wanted(i) = 2. * lm_min(i)
292
293                ! eventually take the missing carbon from the atmosphere and
294                ! put it into carbohydrate reserve
295
296                IF ( always_init .AND. ( biomass(i,j,icarbres) .LT. bm_wanted(i) ) ) THEN
297                   !NV passage 2D
298                   co2_to_bm(i,j) = co2_to_bm(i,j) + ( bm_wanted(i) - biomass(i,j,icarbres) ) / dt
299
300                   biomass(i,j,icarbres) = bm_wanted(i)
301
302                ENDIF
303
304                bm_use(i) = MIN( biomass(i,j,icarbres), bm_wanted(i) )
305
306                !
307                ! 4.2 dispatch that biomass on leaves and roots
308                !
309
310                biomass(i,j,ileaf) = biomass(i,j,ileaf) + bm_use(i) / 2.
311
312                biomass(i,j,iroot) = biomass(i,j,iroot) + bm_use(i) / 2.
313
314                !
315                ! 4.3 decrease reservoir biomass
316                !
317
318                biomass(i,j,icarbres) = biomass(i,j,icarbres) - bm_use(i)
319
320                !
321                ! 4.4 decide whether we have to reset then leaf age distribution
322                !     (done later for better vectorization)
323                !
324
325                age_reset(i) = .TRUE.
326
327             ENDIF  ! leaf mass is very low
328
329             !
330             ! 4.5 reset counter: start of the growing season
331             !
332
333             when_growthinit(i,j) = 0.0
334
335          ENDIF    ! start of the growing season
336
337       ENDDO      ! loop over grid points
338
339       !
340       ! 4.6 reset leaf age distribution where necessary
341       !     simply say that everything is in the youngest age class
342       !
343
344       ! 4.6.1 fractions
345
346       WHERE ( age_reset(:) )
347          leaf_frac(:,j,1) = un
348       ENDWHERE
349       DO m = 2, nleafages
350          WHERE ( age_reset(:) )
351             leaf_frac(:,j,m) = zero
352          ENDWHERE
353       ENDDO
354
355       ! 4.6.2 ages
356
357       DO m = 1, nleafages
358          WHERE ( age_reset(:) )
359             leaf_age(:,j,m) = zero
360          ENDWHERE
361       ENDDO
362
363    ENDDO        ! loop over PFTs
364
365
366    IF (bavard.GE.4) WRITE(numout,*) 'Leaving phenology'
367
368  END SUBROUTINE phenology
369
370  !
371  ! ==============================================================================
372  ! Phenology: begins if "weekly" soil humidity starts to exceed a certain threshold
373  !            value. This value depends on last year's max and min humidity ...
374  !            Always initiate growing season if soil moisture exceeds a certain threshold.
375  !
376
377  SUBROUTINE pheno_hum (npts, j, PFTpresent, allow_initpheno, &
378       moiavail_month, moiavail_week, &
379       maxmoiavail_lastyear, minmoiavail_lastyear, &
380       begin_leaves)
381
382    !
383    ! 0 declarations
384    !
385
386    ! 0.1 input
387
388    ! Domain size
389    INTEGER(i_std), INTENT(in)                                     :: npts
390    ! PFT index
391    INTEGER(i_std), INTENT(in)                               :: j
392    ! PFT exists
393    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
394    ! are we allowed to decalre the beginning of the growing season?
395    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
396    ! "monthly" moisture availability
397    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_month
398    ! "weekly" moisture availability
399    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_week
400    ! last year's maximum moisture availability
401    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: maxmoiavail_lastyear
402    ! last year's minimum moisture availability
403    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: minmoiavail_lastyear
404
405    ! 0.2 output
406
407    ! signal to start putting leaves on
408    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
409
410    ! 0.3 local
411
412    REAL(r_std)                                              :: moiavail_always
413    ! first call
414    REAL(r_std), DIMENSION(npts)                             :: availability_crit
415    ! index
416    INTEGER(i_std)                                           :: i
417
418    ! =========================================================================
419
420    IF (bavard.GE.3) WRITE(numout,*) 'Entering hum'
421
422    !
423    ! Initializations
424    !
425
426    !
427    ! 1.1 messages
428    !
429
430    IF ( firstcall_hum ) THEN
431
432       WRITE(numout,*) 'pheno_hum:'
433       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
434       WRITE(numout,*) '         trees:', moiavail_always_tree
435       WRITE(numout,*) '         grasses:', moiavail_always_grass
436
437       firstcall_hum = .FALSE.
438
439    ENDIF
440
441    !
442    ! 1.2 initialize output
443    !
444
445    begin_leaves(:,j) = .FALSE.
446
447    !
448    ! 1.3 check the prescribed critical value
449    !
450
451    IF ( hum_frac(j) .EQ. undef ) THEN
452
453       WRITE(numout,*) 'hum: hum_frac is undefined for PFT',j
454       WRITE(numout,*) 'We stop.'
455       STOP
456
457    ENDIF
458
459    !
460    ! 1.4 critical moisture availability above which we always detect the beginning of the
461    !     growing season.
462    !
463
464    IF ( tree(j) ) THEN
465       moiavail_always = moiavail_always_tree
466    ELSE
467       moiavail_always = moiavail_always_grass
468    ENDIF
469
470    !
471    ! 2 PFT has to be there and start of growing season must be allowed
472    !
473
474    DO i = 1, npts
475
476       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
477
478          ! critical availability: depends on last year's max and min.
479
480          availability_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
481               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
482
483          ! the favorable season starts if the "monthly" moisture availability is still quite
484          ! low, but the "weekly" availability is already higher (as it reacts faster).
485          ! If monthly moisture availability is high enough, also initiate growing season if
486          ! this has not happened yet.
487
488          IF ( ( ( moiavail_week(i,j)  .GE. availability_crit(i) ) .AND. &
489               ( moiavail_month(i,j) .LT. moiavail_week(i,j) )   ) .OR. &
490               ( moiavail_month(i,j) .GE. moiavail_always )                ) THEN
491             begin_leaves(i,j) = .TRUE.
492          ENDIF
493
494       ENDIF        ! PFT there and start of growing season allowed
495
496    ENDDO
497
498    IF (bavard.GE.4) WRITE(numout,*) 'Leaving hum'
499
500  END SUBROUTINE pheno_hum
501
502  !
503  ! ==============================================================================
504  ! Phenology: begins if moisture minium was a sufficiently long time ago.
505  !            Additionally, "weekly" soil humidity must be higher that "monthly" soil
506  !            humidity.
507  !
508
509  SUBROUTINE pheno_moi (npts, j, PFTpresent, allow_initpheno, &
510       time_hum_min, &
511       moiavail_month, moiavail_week, &
512       begin_leaves)
513
514    !
515    ! 0 declarations
516    !
517
518    ! 0.1 input
519
520    ! Domain size
521    INTEGER(i_std), INTENT(in)                                     :: npts
522    ! PFT index
523    INTEGER(i_std), INTENT(in)                               :: j
524    ! PFT exists
525    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
526    ! are we allowed to decalre the beginning of the growing season?
527    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
528    ! time elapsed since strongest moisture availability (d)
529    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: time_hum_min
530    ! "monthly" moisture availability
531    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_month
532    ! "weekly" moisture availability
533    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_week
534
535    ! 0.2 output
536
537    ! signal to start putting leaves on
538    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
539
540    ! 0.3 local
541
542    ! moisture availability above which moisture tendency doesn't matter
543    REAL(r_std)                                              :: moiavail_always
544    ! index
545    INTEGER(i_std)                                           :: i
546
547    ! =========================================================================
548
549    IF (bavard.GE.3) WRITE(numout,*) 'Entering moi'
550
551    !
552    ! Initializations
553    !
554
555    !
556    ! 1.1 messages
557    !
558
559    IF ( firstcall_moi ) THEN
560
561       WRITE(numout,*) 'pheno_moi:'
562       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
563       WRITE(numout,*) '         trees:', moiavail_always_tree
564       WRITE(numout,*) '         grasses:', moiavail_always_grass
565
566       firstcall_moi = .FALSE.
567
568    ENDIF
569
570    !
571    ! 1.2 initialize output
572    !
573
574    begin_leaves(:,j) = .FALSE.
575
576    !
577    ! 1.3 check the prescribed critical value
578    !
579
580    IF ( hum_min_time(j) .EQ. undef ) THEN
581
582       WRITE(numout,*) 'moi: hum_min_time is undefined for PFT',j
583       WRITE(numout,*) 'We stop.'
584       STOP
585
586    ENDIF
587
588    !
589    ! 1.4 critical moisture availability above which we always detect the beginning of the
590    !     growing season.
591    !
592
593    IF ( tree(j) ) THEN
594       moiavail_always = moiavail_always_tree
595    ELSE
596       moiavail_always = moiavail_always_grass
597    ENDIF
598
599    !
600    ! 2 PFT has to be there and start of growing season must be allowed
601    !
602
603    DO i = 1, npts
604
605       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
606
607          ! the favorable season starts if the moisture minimum was a sufficiently long
608          ! time ago and if the "monthly" moisture availability is lower than the "weekly"
609          ! availability (this means that soil moisture is increasing).
610          ! If monthly moisture availability is high enough, also initiate growing season if
611          ! this has not happened yet.
612
613          IF  ( ( ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) .AND. &
614               ( time_hum_min(i,j) .GT. hum_min_time(j) )    ) .OR. &
615               ( moiavail_month(i,j) .GE. moiavail_always )                     ) THEN
616             begin_leaves(i,j) = .TRUE.
617          ENDIF
618
619       ENDIF        ! PFT there and start of growing season allowed
620
621    ENDDO
622
623    IF (bavard.GE.4) WRITE(numout,*) 'Leaving moi'
624
625  END SUBROUTINE pheno_moi
626
627  !
628  ! ==============================================================================
629  ! Phenology: leaves are put on if gdd exceeds a critical value.
630  !            Additionally, there has to be at least some moisture.
631  !            Set gdd to undef if beginning of the growing season detected.
632  !
633
634  SUBROUTINE pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd, &
635       maxmoiavail_lastyear, minmoiavail_lastyear, &
636       tlong_ref, t2m_month, t2m_week, &
637       moiavail_week, moiavail_month, &
638       begin_leaves)
639
640    !
641    ! 0 declarations
642    !
643
644    ! 0.1 input
645
646    ! Domain size
647    INTEGER(i_std), INTENT(in)                                     :: npts
648    ! PFT index
649    INTEGER(i_std), INTENT(in)                               :: j
650    ! PFT exists
651    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
652    ! are we allowed to decalre the beginning of the growing season?
653    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
654    ! growing degree days, calculated since leaves have fallen
655    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: gdd
656    ! last year's maximum moisture availability
657    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: maxmoiavail_lastyear
658    ! last year's minimum moisture availability
659    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: minmoiavail_lastyear
660    ! "long term" 2 meter temperatures (K)
661    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: tlong_ref
662    ! "monthly" 2-meter temperatures (K)
663    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month
664    ! "weekly" 2-meter temperatures (K)
665    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week
666    ! "weekly" moisture availability
667    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_week
668    ! "monthly" moisture availability
669    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_month
670
671    ! 0.2 output
672
673    ! signal to start putting leaves on
674    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
675
676    ! 0.3 local
677
678    ! moisture availability above which moisture tendency doesn't matter
679    REAL(r_std)                                              :: moiavail_always
680    ! critical moisture availability
681    REAL(r_std), DIMENSION(npts)                             :: moiavail_crit
682    ! long term temperature, C
683    REAL(r_std), DIMENSION(npts)                             :: tl
684    ! critical GDD
685    REAL(r_std), DIMENSION(npts)                             :: gdd_crit
686    ! index
687    INTEGER(i_std)                                           :: i
688
689    ! =========================================================================
690
691    IF (bavard.GE.3) WRITE(numout,*) 'Entering humgdd'
692
693    !
694    ! 1 Initializations
695    !
696
697    !
698    ! 1.1 messages
699    !
700
701    IF ( firstcall_humgdd ) THEN
702
703       WRITE(numout,*) 'pheno_humgdd:'
704       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
705       WRITE(numout,*) '         trees:', moiavail_always_tree
706       WRITE(numout,*) '         grasses:', moiavail_always_grass
707       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter: ', &
708            t_always
709
710       firstcall_humgdd = .FALSE.
711
712    ENDIF
713
714    !
715    ! 1.2 initialize output
716    !
717
718    begin_leaves(:,j) = .FALSE.
719
720    !
721    ! 1.3 check the prescribed critical values
722    !
723
724    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
725
726       WRITE(numout,*) 'humgdd:pheno_gdd_crit is undefined for PFT',j
727       WRITE(numout,*) 'We stop.'
728       STOP
729
730    ENDIF
731
732    IF ( hum_frac(j) .EQ. undef ) THEN
733
734       WRITE(numout,*) 'humgdd: hum_frac is undefined for PFT',j
735       WRITE(numout,*) 'We stop.'
736       STOP
737
738    ENDIF
739
740    !
741    ! 1.4 critical moisture availability above which we always detect the beginning of the
742    !     growing season.
743    !
744
745    IF ( tree(j) ) THEN
746       moiavail_always = moiavail_always_tree
747    ELSE
748       moiavail_always = moiavail_always_grass
749    ENDIF
750
751    !
752    ! 2 PFT has to be there, start of growing season must be allowed,
753    !   and gdd has to be defined
754    !
755
756    DO i = 1, npts
757
758       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
759            ( gdd(i,j) .NE. undef )                           ) THEN
760
761          ! is critical gdd reached and is temperature increasing?
762          ! be sure that at least some humidity
763
764          moiavail_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
765               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
766
767          tl(i) = tlong_ref(i) - ZeroCelsius
768          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
769               tl(i)*tl(i)*pheno_gdd_crit(j,3)
770
771          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
772               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
773               ( t2m_month(i) .GT. t_always )          ) .AND. &
774               ( ( ( moiavail_week(i,j)  .GE. moiavail_crit(i) ) .AND. &
775               ( moiavail_month(i,j) .LT. moiavail_crit(i) )        ) .OR. &
776               ( moiavail_month(i,j) .GE. moiavail_always )                   ) )  THEN
777             begin_leaves(i,j) = .TRUE.
778          ENDIF
779
780       ENDIF        ! PFT there and start of growing season allowed
781
782    ENDDO
783
784    IF (bavard.GE.4) WRITE(numout,*) 'Leaving humgdd'
785
786  END SUBROUTINE pheno_humgdd
787
788  !
789  ! ==============================================================================
790  ! Phenology: leaves are put on if gdd exceeds a critical value.
791  !            Additionally, a certain time must have elapsed since the moisture minimum.
792  !            Set gdd to undef if beginning of the growing season detected.
793  !
794
795  SUBROUTINE pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd, &
796       time_hum_min, &
797       tlong_ref, t2m_month, t2m_week, &
798       moiavail_week, moiavail_month, &
799       begin_leaves)
800
801    !
802    ! 0 declarations
803    !
804
805    ! 0.1 input
806
807    ! Domain size
808    INTEGER(i_std), INTENT(in)                                     :: npts
809    ! PFT index
810    INTEGER(i_std), INTENT(in)                               :: j
811    ! PFT exists
812    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
813    ! are we allowed to decalre the beginning of the growing season?
814    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
815    ! growing degree days, calculated since leaves have fallen
816    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: gdd
817    ! time elapsed since strongest moisture availability (d)
818    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: time_hum_min
819    ! "long term" 2 meter temperatures (K)
820    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: tlong_ref
821    ! "monthly" 2-meter temperatures (K)
822    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month
823    ! "weekly" 2-meter temperatures (K)
824    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week
825    ! "weekly" moisture availability
826    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_week
827    ! "monthly" moisture availability
828    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: moiavail_month
829
830    ! 0.2 output
831
832    ! signal to start putting leaves on
833    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
834
835    ! 0.3 local
836
837    ! moisture availability above which moisture tendency doesn't matter
838    REAL(r_std)                                              :: moiavail_always
839    ! long term temperature, C
840    REAL(r_std), DIMENSION(npts)                             :: tl
841    ! critical GDD
842    REAL(r_std), DIMENSION(npts)                             :: gdd_crit
843    ! index
844    INTEGER(i_std)                                           :: i
845
846    ! =========================================================================
847
848    IF (bavard.GE.3) WRITE(numout,*) 'Entering moigdd'
849
850    !
851    ! 1 Initializations
852    !
853
854    !
855    ! 1.1 messages
856    !
857
858    IF ( firstcall_moigdd ) THEN
859
860       WRITE(numout,*) 'pheno_moigdd:'
861       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
862       WRITE(numout,*) '         trees:', moiavail_always_tree
863       WRITE(numout,*) '         grasses:', moiavail_always_grass
864       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter: ', &
865            t_always
866
867       firstcall_moigdd = .FALSE.
868
869    ENDIF
870
871    !
872    ! 1.2 initialize output
873    !
874
875    begin_leaves(:,j) = .FALSE.
876
877    !
878    ! 1.3 check the prescribed critical values
879    !
880
881    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
882
883       WRITE(numout,*) 'moigdd: pheno_gdd_crit is undefined for PFT',j
884       WRITE(numout,*) 'We stop.'
885       STOP
886
887    ENDIF
888
889    IF ( hum_min_time(j) .EQ. undef ) THEN
890
891       WRITE(numout,*) 'moigdd: hum_min_time is undefined for PFT',j
892       WRITE(numout,*) 'We stop.'
893       STOP
894
895    ENDIF
896
897    !
898    ! 1.4 critical moisture availability above which we always detect the beginning of the
899    !     growing season.
900    !
901
902    IF ( tree(j) ) THEN
903       moiavail_always = moiavail_always_tree
904    ELSE
905       moiavail_always = moiavail_always_grass
906    ENDIF
907
908    !
909    ! 2 PFT has to be there, start of growing season must be allowed,
910    !   and gdd has to be defined
911    !
912
913    DO i = 1, npts
914
915       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
916            ( gdd(i,j) .NE. undef )                           ) THEN
917
918          ! is critical gdd reached and is temperature increasing?
919          ! has enough time gone by since moisture minimum and is moisture increasing?
920
921          tl(i) = tlong_ref(i) - ZeroCelsius
922          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
923               tl(i)*tl(i)*pheno_gdd_crit(j,3)
924
925          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
926               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
927               ( t2m_month(i) .GT. t_always )          ) .AND. &
928               ( ( ( time_hum_min(i,j) .GT. hum_min_time(j) ) .AND. &
929               ( moiavail_week(i,j) .GT. moiavail_month(i,j) )            ) .OR. &
930               ( moiavail_month(i,j) .GE. moiavail_always )                         ) )  THEN
931             begin_leaves(i,j) = .TRUE.
932          ENDIF
933
934       ENDIF        ! PFT there and start of growing season allowed
935
936    ENDDO
937
938    IF (bavard.GE.4) WRITE(numout,*) 'Leaving moigdd'
939
940  END SUBROUTINE pheno_moigdd
941
942
943  !
944  ! ==============================================================================
945  ! Phenology: leaves are put on if a certain relationship between ncd since leaves were
946  !            lost (number of chilling days) and gdd since midwinter (growing degree
947  !            days) is fulfilled
948  !
949
950  SUBROUTINE pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
951       ncd_dormance, gdd_midwinter, &
952       t2m_month, t2m_week, begin_leaves)
953
954    !
955    ! 0 declarations
956    !
957
958    ! 0.1 input
959
960    ! Domain size
961    INTEGER(i_std), INTENT(in)                                     :: npts
962    ! PFT index
963    INTEGER(i_std), INTENT(in)                               :: j
964    ! PFT exists
965    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
966    ! are we allowed to declare the beginning of the growing season?
967    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
968    ! number of chilling days since leaves were lost
969    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: ncd_dormance
970    ! growing degree days since midwinter
971    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_midwinter
972    ! "monthly" 2-meter temperatures (K)
973    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month
974    ! "weekly" 2-meter temperatures (K)
975    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week
976
977    ! 0.2 output
978
979    ! signal to start putting leaves on
980    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
981
982    ! 0.3 local
983
984    ! index
985    INTEGER(i_std)                                           :: i
986    ! critical gdd
987    REAL(r_std)                                              :: gdd_min
988
989    ! =========================================================================
990
991    IF (bavard.GE.3) WRITE(numout,*) 'Entering ncdgdd'
992
993    !
994    ! 1 Initializations
995    !
996
997    !
998    ! 1.1 initialize output
999    !
1000
1001    begin_leaves(:,j) = .FALSE.
1002
1003    !
1004    ! 1.2 check the prescribed critical values
1005    !
1006
1007    IF ( ncdgdd_temp(j) .EQ. undef ) THEN
1008
1009       WRITE(numout,*) 'ncdgdd: ncdgdd_temp is undefined for PFT',j
1010       WRITE(numout,*) 'We stop.'
1011       STOP
1012
1013    ENDIF
1014
1015    !
1016    ! 2 PFT has to be there and start of growing season must be allowed
1017    !
1018
1019    DO i = 1, npts
1020
1021       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
1022            ( gdd_midwinter(i,j) .NE. undef ) .AND. &
1023            ( ncd_dormance(i,j) .NE. undef )                  ) THEN
1024
1025          ! critical gdd
1026
1027          gdd_min = ( gddncd_ref / exp(gddncd_curve*ncd_dormance(i,j)) - gddncd_offset )
1028
1029          ! has the critical gdd been reached and are temperatures increasing?
1030
1031          IF ( ( gdd_midwinter(i,j) .GE. gdd_min ) .AND. &
1032               ( t2m_week(i) .GT. t2m_month(i) ) ) THEN
1033             begin_leaves(i,j) = .TRUE.
1034             gdd_midwinter(i,j)=undef
1035          ENDIF
1036
1037       ENDIF        ! PFT there and start of growing season allowed
1038
1039    ENDDO
1040
1041    IF (bavard.GE.4) WRITE(numout,*) 'Leaving ncdgdd'
1042
1043  END SUBROUTINE pheno_ncdgdd
1044
1045  !
1046  ! ==============================================================================
1047  ! Phenology: leaves are put on if ngd (number of growing days, defined as
1048  !            days with t>-5 deg C) exceeds a critical value.
1049  !
1050
1051  SUBROUTINE pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd, &
1052       t2m_month, t2m_week, begin_leaves)
1053
1054    !
1055    ! 0 declarations
1056    !
1057
1058    ! 0.1 input
1059
1060    ! Domain size
1061    INTEGER(i_std), INTENT(in)                                     :: npts
1062    ! PFT index
1063    INTEGER(i_std), INTENT(in)                               :: j
1064    ! PFT exists
1065    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent
1066    ! are we allowed to declare the beginning of the growing season?
1067    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: allow_initpheno
1068    ! growing degree days
1069    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: ngd
1070    ! "monthly" 2-meter temperatures (K)
1071    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month
1072    ! "weekly" 2-meter temperatures (K)
1073    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week
1074
1075    ! 0.2 output
1076
1077    ! signal to start putting leaves on
1078    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves
1079
1080    ! 0.3 local
1081
1082    ! index
1083    INTEGER(i_std)                                           :: i
1084
1085    ! =========================================================================
1086
1087    IF (bavard.GE.3) WRITE(numout,*) 'Entering ngd'
1088
1089    !
1090    ! Initializations
1091    !
1092
1093    !
1094    ! 1.1 initialize output
1095    !
1096
1097    begin_leaves(:,j) = .FALSE.
1098
1099    !
1100    ! 1.2 check the prescribed critical value
1101    !
1102
1103    IF ( ngd_crit(j) .EQ. undef ) THEN
1104
1105       WRITE(numout,*) 'ngd: ngd_crit is undefined for PFT',j
1106       WRITE(numout,*) 'We stop.'
1107       STOP
1108
1109    ENDIF
1110
1111    !
1112    ! 2 PFT has to be there and start of growing season must be allowed
1113    !
1114
1115    DO i = 1, npts
1116
1117       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
1118
1119          ! is critical ngd reached and are temperatures increasing?
1120
1121          IF ( ( ngd(i,j) .GE. ngd_crit(j) ) .AND. &
1122               ( t2m_week(i) .GT. t2m_month(i) )        ) THEN
1123             begin_leaves(i,j) = .TRUE.
1124          ENDIF
1125
1126       ENDIF        ! PFT there and start of growing season allowed
1127
1128    ENDDO
1129
1130    IF (bavard.GE.4) WRITE(numout,*) 'Leaving ngd'
1131
1132  END SUBROUTINE pheno_ngd
1133
1134END MODULE stomate_phenology
Note: See TracBrowser for help on using the repository browser.