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

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

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