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

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

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