! Calculate long-term meteorological parameters from daily temperatures ! and precipitations (essentially for phenology) ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_season.f90,v 1.15 2010/04/06 16:06:34 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_season ! modules used: USE ioipsl USE stomate_constants USE constantes_veg IMPLICIT NONE ! private & public routines PRIVATE PUBLIC season,season_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE season_clear firstcall=.TRUE. END SUBROUTINE season_clear SUBROUTINE season (npts, dt, EndOfYear, veget, veget_max, & moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, & precip_daily, npp_daily, biomass, turnover_daily, gpp_daily, when_growthinit, & maxmoiavail_lastyear, maxmoiavail_thisyear, & minmoiavail_lastyear, minmoiavail_thisyear, & maxgppweek_lastyear, maxgppweek_thisyear, & gdd0_lastyear, gdd0_thisyear, & precip_lastyear, precip_thisyear, & lm_lastyearmax, lm_thisyearmax, & maxfpc_lastyear, maxfpc_thisyear, & moiavail_month, moiavail_week, t2m_longterm, tlong_ref, t2m_month, t2m_week, & tsoil_month, soilhum_month, & npp_longterm, turnover_longterm, gpp_week, & gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, time_lowgpp, & time_hum_min, hum_min_dormance, herbivores) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step in days REAL(r_std), INTENT(in) :: dt ! update yearly variables? LOGICAL, INTENT(in) :: EndOfYear ! coverage fraction of a PFT. Here: fraction of total ground. REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget ! "maximal" coverage fraction of a PFT (for LAI -> infinity) ! Here: fraction of total ground. REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max ! Daily moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily ! Daily 2 meter temperature (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily ! Daily soil temperature (K) REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_daily ! Daily soil humidity REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_daily ! Daily mean precipitation (mm/day) REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_daily ! daily net primary productivity (gC/m**2/day) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: npp_daily ! biomass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: biomass ! Turnover rates (gC/m**2/day) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: turnover_daily ! daily gross primary productivity (Here: gC/(m**2 of total ground)/day) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp_daily ! how many days ago was the beginning of the growing season REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit ! 0.2 modified fields ! last year's maximum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxmoiavail_lastyear ! this year's maximum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxmoiavail_thisyear ! last year's minimum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: minmoiavail_lastyear ! this year's minimum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: minmoiavail_thisyear ! last year's maximum weekly GPP REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxgppweek_lastyear ! this year's maximum weekly GPP REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxgppweek_thisyear ! last year's annual GDD0 REAL(r_std), DIMENSION(npts), INTENT(inout) :: gdd0_lastyear ! this year's annual GDD0 REAL(r_std), DIMENSION(npts), INTENT(inout) :: gdd0_thisyear ! last year's annual precipitation (mm/year) REAL(r_std), DIMENSION(npts), INTENT(inout) :: precip_lastyear ! this year's annual precipitation (mm/year) REAL(r_std), DIMENSION(npts), INTENT(inout) :: precip_thisyear ! last year's maximum leaf mass, for each PFT (gC/m**2) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax ! this year's maximum leaf mass, for each PFT (gC/m**2) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_thisyearmax ! last year's maximum fpc for each PFT, on ground REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxfpc_lastyear ! this year's maximum fpc for each PFT, on ground REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxfpc_thisyear ! "monthly" moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: moiavail_month ! "weekly" moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: moiavail_week ! "long term" 2-meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_longterm ! "long term" refernce 2-meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(inout) :: tlong_ref ! "monthly" 2-meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_month ! "weekly" 2-meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_week ! "monthly" soil temperatures (K) REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout) :: tsoil_month ! "monthly" soil humidity REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout) :: soilhum_month ! "long term" net primary productivity (gC/m**2/year) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm ! "long term" turnover rate (gC/m**2/year) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: turnover_longterm ! "weekly" GPP (gC/day/(m**2 covered) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gpp_week ! growing degree days, threshold -5 deg. C REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gdd_m5_dormance ! growing degree days since midwinter REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gdd_midwinter ! number of chilling days since leaves were lost REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ncd_dormance ! number of growing days REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ngd_minus5 ! duration of dormance (d) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: time_lowgpp ! time elapsed since strongest moisture availability (d) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: time_hum_min ! minimum moisture during dormance REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: hum_min_dormance ! 0.3 output (diagnostic) ! time constant of probability of a leaf to be eaten by a herbivore (days) REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: herbivores ! 0.4 local ! indices INTEGER(i_std) :: j ! rapport maximal GPP/GGP_max pour dormance REAL(r_std), PARAMETER :: gppfrac_dormance = 0.2 ! !NVADD ! minimum gpp considered as not "lowgpp" REAL(r_std), PARAMETER :: min_gpp_allowed = 0.3 ! tau (year) for "climatologic variables REAL(r_std), PARAMETER :: tau_climatology = 20 !ENDNVADD ! maximum ncd (d) (to avoid floating point underflows) REAL(r_std) :: ncd_max ! parameters for herbivore activity REAL(r_std), PARAMETER :: hvc1 = 0.019 REAL(r_std), PARAMETER :: hvc2 = 1.38 REAL(r_std), PARAMETER :: leaf_frac=.33 ! sum of natural fpcs REAL(r_std), DIMENSION(npts) :: sumfpc_nat ! weights REAL(r_std), DIMENSION(npts) :: weighttot ! natural long-term leaf NPP ( gC/m**2/year) REAL(r_std), DIMENSION(npts) :: nlflong_nat ! residence time of green tissue (years) REAL(r_std), DIMENSION(npts) :: green_age ! herbivore consumption (gC/m**2/day) REAL(r_std), DIMENSION(npts) :: consumption ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering season' ! ! 1 Initializations ! ncd_max = 3. * one_year IF ( firstcall ) THEN ! ! 1.1 messages ! IF ( bavard .GE. 1 ) THEN WRITE(numout,*) 'season: ' WRITE(numout,*) ' > rapport maximal GPP/GGP_max pour dormance: ',gppfrac_dormance WRITE(numout,*) ' > maximum possible ncd (d): ',ncd_max WRITE(numout,*) ' > herbivore consumption C (gC/m2/day) as a function of NPP (gC/m2/d):' WRITE(numout,*) ' C=',hvc1,' * NPP^',hvc2 WRITE(numout,*) ' > for herbivores, suppose that ',leaf_frac*100., & '% of NPP is allocated to leaves' ENDIF ! ! 1.2 Check whether longer-term meteorological parameters are initialized ! to zero ! ! 1.2.1 moisture availabilities ! 1.2.1.1 "monthly" !MM PAS PARALLELISE!! IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN ! in this case, set them it today's moisture availability WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' moisture availabilities.' moiavail_month(:,:) = moiavail_daily(:,:) ENDIF ! 1.2.1.2 "weekly" IF ( ABS( SUM( moiavail_week(:,2:nvm) ) ) .LT. min_stomate ) THEN ! in this case, set them it today's moisture availability WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities.' moiavail_week(:,:) = moiavail_daily(:,:) ENDIF ! 1.2.2 2-meter temperatures ! 1.2.2.1 "long term" IF ( ABS( SUM( t2m_longterm(:) ) ) .LT. min_stomate ) THEN ! in this case, set them to today's temperature WRITE(numout,*) 'Warning! We have to initialize the ''long term'' 2m temperatures.' t2m_longterm(:) = t2m_daily(:) ENDIF ! 1.2.2.2 "monthly" IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN ! in this case, set them to today's temperature WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.' t2m_month(:) = t2m_daily(:) ENDIF ! 1.2.2.3 "weekly" IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN ! in this case, set them to today's temperature WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' 2m temperatures.' t2m_week(:) = t2m_daily(:) ENDIF ! 1.2.3 "monthly" soil temperatures !MM PAS PARALLELISE!! IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN ! in this case, set them to today's temperature WRITE(numout,*) 'Warning!'// & ' We have to initialize the ''monthly'' soil temperatures.' tsoil_month(:,:) = tsoil_daily(:,:) ENDIF ! 1.2.4 "monthly" soil humidity IF ( ABS( SUM( soilhum_month(:,:) ) ) .LT. min_stomate ) THEN ! in this case, set them to today's humidity WRITE(numout,*) 'Warning!'// & ' We have to initialize the ''monthly'' soil humidity.' soilhum_month(:,:) = soilhum_daily(:,:) ENDIF ! 1.2.5 growing degree days, threshold -5 deg C IF ( ABS( SUM( gdd_m5_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Growing degree days (-5 deg) are initialized to ''undef''.' gdd_m5_dormance(:,:) = undef ENDIF ! 1.2.6 growing degree days since midwinter IF ( ABS( SUM( gdd_midwinter(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Growing degree days since midwinter' // & ' are initialized to ''undef''.' gdd_midwinter(:,:) = undef ENDIF ! 1.2.7 number of chilling days since leaves were lost IF ( ABS( SUM( ncd_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Number of chilling days is initialized to ''undef''.' ncd_dormance(:,:) = undef ENDIF ! 1.2.8 number of growing days, threshold -5 deg C IF ( ABS( SUM( ngd_minus5(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Number of growing days (-5 deg) is initialized to 0.' ENDIF ! 1.2.9 "long term" npp IF ( ABS( SUM( npp_longterm(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Long term NPP is initialized to 0.' ENDIF ! 1.2.10 "long term" turnover IF ( ABS( SUM( turnover_longterm(:,2:nvm,:) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Long term turnover is initialized to 0.' ENDIF ! 1.2.11 "weekly" GPP IF ( ABS( SUM( gpp_week(:,2:nvm) ) ) .LT. min_stomate ) THEN WRITE(numout,*) 'Warning! Weekly GPP is initialized to 0.' ENDIF ! 1.2.12 minimum moisture availabilities IF ( ABS( SUM( minmoiavail_thisyear(:,2:nvm) ) ) .LT. min_stomate ) THEN ! in this case, set them to a very high value WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// & 'moisture availabilities.' minmoiavail_thisyear(:,:) = large_value ENDIF ! ! 1.3 reset flag ! firstcall = .FALSE. ENDIF ! ! 2 moisture availabilities ! ! ! 2.1 "monthly" ! moiavail_month = ( moiavail_month * ( pheno_crit%tau_hum_month - dt ) + & moiavail_daily * dt ) / pheno_crit%tau_hum_month DO j = 2,nvm WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) ) moiavail_month(:,j) = zero ENDWHERE ENDDO ! ! 2.2 "weekly" ! moiavail_week = ( moiavail_week * ( pheno_crit%tau_hum_week - dt ) + & moiavail_daily * dt ) / pheno_crit%tau_hum_week DO j = 2,nvm WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) ) moiavail_week(:,j) = zero ENDWHERE ENDDO ! ! 3 2-meter temperatures ! ! ! 3.1 "long term" ! t2m_longterm = ( t2m_longterm * ( pheno_crit%tau_longterm - dt ) + & t2m_daily * dt ) / pheno_crit%tau_longterm WHERE ( ABS(t2m_longterm(:)) .LT. EPSILON(zero) ) t2m_longterm(:) = zero ENDWHERE CALL histwrite (hist_id_stomate, 'T2M_LONGTERM', itime, & t2m_longterm, npts, hori_index) ! ! 3.2 "long term reference" ! This temperature is used for recalculating PFT-specific parameters such as ! critical photosynthesis temperatures of critical GDDs for phenology. This ! means that if the reference temperature varies, the PFTs adapt to them. ! Therefore the reference temperature can vary only if the vegetation is not ! static. ! !!$ IF (control%ok_dgvm) THEN tlong_ref(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) ) !!$ ENDIF ! ! 3.3 "monthly" ! t2m_month = ( t2m_month * ( pheno_crit%tau_t2m_month - dt ) + & t2m_daily * dt ) / pheno_crit%tau_t2m_month WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) ) t2m_month(:) = zero ENDWHERE ! ! 3.4 "weekly" ! t2m_week = ( t2m_week * ( pheno_crit%tau_t2m_week - dt ) + & t2m_daily * dt ) / pheno_crit%tau_t2m_week WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) ) t2m_week(:) = zero ENDWHERE ! ! 4 ''monthly'' soil temperatures ! tsoil_month = ( tsoil_month * ( pheno_crit%tau_tsoil_month - dt ) + & tsoil_daily(:,:) * dt ) / pheno_crit%tau_tsoil_month WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) ) tsoil_month(:,:) = zero ENDWHERE ! ! 5 ''monthly'' soil humidity ! soilhum_month = ( soilhum_month * ( pheno_crit%tau_soilhum_month - dt ) + & soilhum_daily * dt ) / pheno_crit%tau_soilhum_month WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) ) soilhum_month(:,:) = zero ENDWHERE ! ! 6 dormance (d) ! when gpp is low, increase dormance time. Otherwise, set it to zero. ! NV: special case (3rd condition): plant is accumulating carbohydrates ! and does never use them. In this case, we allow the plant to ! detect a beginning of the growing season by declaring it dormant ! !NVMODIF DO j = 2,nvm WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. & ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. & ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. & ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) ) ! WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. & ! ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. & ! ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. & ! ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) ) time_lowgpp(:,j) = time_lowgpp(:,j) + dt ELSEWHERE time_lowgpp(:,j) = zero ENDWHERE ENDDO ! ! 7 growing degree days, threshold -5 deg C ! DO j = 2,nvm ! only for PFTs for which critical gdd is defined ! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef ! at the beginning of the growing season. IF ( ALL(pheno_crit%gdd(j,:) .NE. undef) ) THEN ! ! 7.1 set to zero if undef and no gpp ! WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( gdd_m5_dormance(:,j) .EQ. undef ) ) gdd_m5_dormance(:,j) = zero ENDWHERE ! ! 7.2 set to undef if there is gpp ! WHERE ( time_lowgpp(:,j) .EQ. zero ) gdd_m5_dormance(:,j) = undef ENDWHERE ! ! 7.3 normal update where gdd_m5_dormance is defined ! WHERE ( ( t2m_daily(:) .GT. (ZeroCelsius-5.) ) .AND. & ( gdd_m5_dormance(:,j) .NE. undef ) ) gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + & dt * ( t2m_daily(:) - (ZeroCelsius-5.) ) ENDWHERE WHERE ( gdd_m5_dormance(:,j) .NE. undef ) gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * & ( pheno_crit%tau_gdd - dt ) / pheno_crit%tau_gdd ENDWHERE ENDIF ENDDO DO j = 2,nvm WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) ) gdd_m5_dormance(:,j) = zero ENDWHERE ENDDO ! ! 8 growing degree days since midwinter ! DO j = 2,nvm ! only for PFTs for which ncdgdd_crittemp is defined IF ( pheno_crit%ncdgdd_temp(j) .NE. undef ) THEN ! ! 8.1 set to 0 if undef and if we detect "midwinter" ! WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. & ( t2m_month(:) .LT. t2m_week(:) ) .AND. & ( t2m_month(:) .LT. t2m_longterm(:) ) ) gdd_midwinter(:,j) = zero ENDWHERE ! ! 8.2 set to undef if we detect "midsummer" ! WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. & ( t2m_month(:) .GT. t2m_longterm(:) ) ) gdd_midwinter(:,j) = undef ENDWHERE ! ! 8.3 normal update ! WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. & ( t2m_daily(:) .GT. pheno_crit%ncdgdd_temp(j)+ZeroCelsius ) ) gdd_midwinter(:,j) = & gdd_midwinter(:,j) + & dt * ( t2m_daily(:) - ( pheno_crit%ncdgdd_temp(j)+ZeroCelsius ) ) ENDWHERE ENDIF ENDDO ! ! 9 number of chilling days since leaves were lost ! DO j = 2,nvm IF ( pheno_crit%ncdgdd_temp(j) .NE. undef ) THEN ! ! 9.1 set to zero if undef and no gpp ! WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( ncd_dormance(:,j) .EQ. undef ) ) ncd_dormance(:,j) = zero ENDWHERE ! ! 9.2 set to undef if there is gpp ! WHERE ( time_lowgpp(:,j) .EQ. zero ) ncd_dormance(:,j) = undef ENDWHERE ! ! 9.3 normal update where ncd_dormance is defined ! WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. & ( t2m_daily(:) .LE. pheno_crit%ncdgdd_temp(j)+ZeroCelsius ) ) ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max ) ENDWHERE ENDIF ENDDO ! ! 10 number of growing days, threshold -5 deg C ! DO j = 2,nvm ! ! 10.1 Where there is GPP, set ngd to 0 ! This means that we only take into account ngds when the leaves are off ! WHERE ( time_lowgpp(:,j) .LT. min_stomate ) ngd_minus5(:,j) = zero ENDWHERE ! ! 10.2 normal update ! WHERE ( t2m_daily(:) .GT. (ZeroCelsius-5.) ) ngd_minus5(:,j) = ngd_minus5(:,j) + dt ENDWHERE ngd_minus5(:,j) = ngd_minus5(:,j) * ( pheno_crit%tau_ngd - dt ) / pheno_crit%tau_ngd ENDDO DO j = 2,nvm WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) ) ngd_minus5(:,j) = zero ENDWHERE ENDDO ! ! 11 minimum humidity since dormance began and time elapsed since this minimum ! DO j = 2,nvm IF ( pheno_crit%hum_min_time(j) .NE. undef ) THEN ! ! 11.1 initialize if undef and no gpp ! WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. & ( ( time_hum_min(:,j) .EQ. undef ) .OR. ( hum_min_dormance(:,j) .EQ. undef ) ) ) time_hum_min(:,j) = zero hum_min_dormance(:,j) = moiavail_month(:,j) ENDWHERE ! ! 11.2 set to undef where there is gpp ! WHERE ( time_lowgpp(:,j) .EQ. zero ) time_hum_min(:,j) = undef hum_min_dormance(:,j) = undef ENDWHERE ! ! 11.3 normal update where time_hum_min and hum_min_dormance are defined ! ! 11.3.1 increase time counter WHERE ( ( time_hum_min(:,j) .NE. undef ) .AND. & ( hum_min_dormance(:,j) .NE. undef ) ) time_hum_min(:,j) = time_hum_min(:,j) + dt ENDWHERE ! 11.3.2 set time to zero if minimum is reached WHERE ( ( time_hum_min(:,j) .NE. undef ) .AND. & ( hum_min_dormance(:,j) .NE. undef ) .AND. & ( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) ) hum_min_dormance(:,j) = moiavail_month(:,j) time_hum_min(:,j) = zero ENDWHERE ENDIF ENDDO ! ! 12 "long term" NPP. npp_daily in gC/m**2/day, npp_longterm in gC/m**2/year. ! npp_longterm = ( npp_longterm * ( pheno_crit%tau_longterm - dt ) + & (npp_daily*one_year) * dt ) / & pheno_crit%tau_longterm DO j = 2,nvm WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) ) npp_longterm(:,j) = zero ENDWHERE ENDDO ! ! 13 "long term" turnover rates, in gC/m**2/year. ! turnover_longterm = ( turnover_longterm * ( pheno_crit%tau_longterm - dt ) + & (turnover_daily*one_year) * dt ) / & pheno_crit%tau_longterm DO j = 2,nvm WHERE ( ABS(turnover_longterm(:,j,:)) .LT. EPSILON(zero) ) turnover_longterm(:,j,:) = zero ENDWHERE ENDDO ! ! 14 "weekly" GPP, in gC/(m**2 covered)/day (!) ! i.e. divide daily gpp (in gC/m**2 of total ground/day) by vegetation fraction ! (m**2 covered/m**2 of total ground) ! WHERE ( veget_max .GT. zero ) gpp_week = ( gpp_week * ( pheno_crit%tau_gpp_week - dt ) + & gpp_daily * dt ) / pheno_crit%tau_gpp_week ELSEWHERE gpp_week = zero ENDWHERE DO j = 2,nvm WHERE ( ABS(gpp_week(:,j)) .LT. EPSILON(zero) ) gpp_week(:,j) = zero ENDWHERE ENDDO ! ! 15 maximum and minimum moisture availabilities ! WHERE ( moiavail_daily .GT. maxmoiavail_thisyear ) maxmoiavail_thisyear = moiavail_daily ENDWHERE WHERE ( moiavail_daily .LT. minmoiavail_thisyear ) minmoiavail_thisyear = moiavail_daily ENDWHERE ! ! 16 annual maximum weekly GPP ! WHERE ( gpp_week .GT. maxgppweek_thisyear ) maxgppweek_thisyear = gpp_week ENDWHERE ! ! 17 annual GDD0 ! WHERE ( t2m_daily .GT. ZeroCelsius ) gdd0_thisyear = gdd0_thisyear + dt * ( t2m_daily - ZeroCelsius ) ENDWHERE ! ! 18 annual precipitation ! precip_thisyear = precip_thisyear + dt * precip_daily ! ! 19 annual maximum leaf mass ! If STOMATE is not activated, this corresponds to the maximum possible ! LAI of the PFT ! IF ( control%ok_stomate ) THEN DO j = 2,nvm WHERE ( biomass(:,j,ileaf) .GT. lm_thisyearmax(:,j) ) lm_thisyearmax(:,j) = biomass(:,j,ileaf) ENDWHERE ENDDO ELSE DO j = 2,nvm lm_thisyearmax(:,j) = lai_max(j) / sla(j) ENDDO ENDIF ! ! 20 annual maximum fpc for each PFT ! "veget" is defined as fraction of total ground. Therefore, maxfpc_thisyear has ! the same unit. ! WHERE ( veget(:,:) .GT. maxfpc_thisyear(:,:) ) maxfpc_thisyear(:,:) = veget(:,:) ENDWHERE ! ! 21 Every year, replace last year's maximum and minimum moisture availability, ! annual GDD0, annual precipitation, annual max weekly GPP, and maximum leaf mass IF ( EndOfYear ) THEN ! ! 21.1 replace old values ! !NVMODIF maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology ! maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:) ! minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:) ! maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:) gdd0_lastyear(:) = gdd0_thisyear(:) precip_lastyear(:) = precip_thisyear(:) lm_lastyearmax(:,:) = lm_thisyearmax(:,:) maxfpc_lastyear(:,:) = maxfpc_thisyear(:,:) ! ! 21.2 reset new values ! maxmoiavail_thisyear(:,:) = zero minmoiavail_thisyear(:,:) = large_value maxgppweek_thisyear(:,:) = zero gdd0_thisyear(:) = zero precip_thisyear(:) = zero lm_thisyearmax(:,:) = zero maxfpc_thisyear(:,:) = zero ! ! 21.3 Special treatment for maxfpc. ! ! ! 21.3.1 Only take into account natural PFTs ! DO j = 2,nvm IF ( .NOT. natural(j) ) THEN maxfpc_lastyear(:,j) = zero ENDIF ENDDO ! 21.3.2 In Stomate, veget is defined as a fraction of ground, not as a fraction ! of total ground. maxfpc_lastyear will be compared to veget in lpj_light. ! Therefore, we have to transform maxfpc_lastyear. ! 21.3.3 The sum of the maxfpc_lastyear for natural PFT must not exceed fpc_crit (=.95). ! However, it can slightly exceed this value as not all PFTs reach their maximum ! fpc at the same time. Therefore, if sum(maxfpc_lastyear) for the natural PFTs ! exceeds fpc_crit, we scale the values of maxfpc_lastyear so that the sum is ! fpc_crit. ! calculate the sum of maxfpc_lastyear sumfpc_nat(:) = zero DO j = 2,nvm sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j) ENDDO ! scale so that the new sum is fpc_crit DO j = 2,nvm WHERE ( sumfpc_nat(:) .GT. fpc_crit ) maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:)) ENDWHERE ENDDO ENDIF ! EndOfYear ! ! 22 diagnose herbivore activity, determined through as probability for a leaf to be ! eaten in a day ! Follows McNaughton et al., Nat 341, 142-144, 1989. ! ! ! 22.1 first calculate mean long-term leaf NPP in grid box, mean residence ! time (years) of green tissue (i.e. tissue that will be eaten by ! herbivores) (crudely approximated: 6 months for seasonal and 2 years ! for evergreen) and mean length of growing season (6 months for ! seasonal and 1 year for evergreen). ! nlflong_nat(:) = zero weighttot(:) = zero green_age(:) = zero ! DO j = 2,nvm ! IF ( natural(j) ) THEN ! weighttot(:) = weighttot(:) + lm_lastyearmax(:,j) nlflong_nat(:) = nlflong_nat(:) + npp_longterm(:,j) * leaf_frac ! IF ( pheno_crit%pheno_model(j) .EQ. 'none' ) THEN green_age(:) = green_age(:) + 2. * lm_lastyearmax(:,j) ELSE green_age(:) = green_age(:) + .5 * lm_lastyearmax(:,j) ENDIF ! ENDIF ! ENDDO ! WHERE ( weighttot(:) .GT. zero ) green_age(:) = green_age(:) / weighttot(:) ELSEWHERE green_age(:) = un ENDWHERE ! ! 22.2 McNaughton et al. give herbivore consumption as a function of annual leaf NPP. ! The annual leaf NPP can give us an idea about the edible biomass: ! DO j = 2,nvm ! IF ( natural(j) ) THEN ! WHERE ( nlflong_nat(:) .GT. zero ) consumption(:) = hvc1 * nlflong_nat(:) ** hvc2 herbivores(:,j) = one_year * green_age(:) * nlflong_nat(:) / consumption(:) ELSEWHERE herbivores(:,j) = 100000. ENDWHERE ! ELSE ! herbivores(:,j) = 100000. ! ENDIF ! ENDDO herbivores(:,ibare_sechiba) = zero IF (bavard.GE.4) WRITE(numout,*) 'Leaving season' END SUBROUTINE season END MODULE stomate_season