growing_season.F90

Go to the documentation of this file.

module growing_season
 
  use iso_c_binding
  use constants_and_conversions, only : true, false, asint, ftinyval
  use datetime, only                  : mmdd2doy
  use exceptions
  use parameters, only                : params
  use simulation_datetime, only       : sim_dt
  use fstring
  use fstring_list, only               : fstring_list_t
  implicit none
 
  private
 
  public :: growing_season_initialize
  public :: growing_season_update
 
  integer (c_int), allocatable :: ilandusecodes(:)
  real (c_float), allocatable  :: first_day_of_growing_season(:)
  real (c_float), allocatable  :: last_day_of_growing_season(:)
  real (c_float), allocatable  :: gdd_first_day_of_growing_season(:)
  real (c_float), allocatable  :: killing_frost_temp_last_day_of_growing_season(:)
 
  character( len=2 ), parameter     :: date_delims = "/-"
  real (c_float), parameter    :: nodata_value = -9999._c_float
 
contains
 
  subroutine growing_season_initialize( )
 
    ! [ LOCALS ]
    integer (c_int)              :: inumberoflanduses
    logical (c_bool)             :: larelengthsequal
    character (len=:), allocatable    :: stemp
    type (fstring_list_t)              :: sl_temp_list
    type (fstring_list_t)              :: sl_growing_season_begin
    type (fstring_list_t)              :: sl_growing_season_end
    character (len=32)                :: str_buffer
    real (c_float), allocatable  :: temp_values(:)
    integer (c_int)              :: indx
    integer (c_int)              :: status
    integer (c_int)              :: count_gdd_start
    integer (c_int)              :: count_killing_frost_end
    integer (c_int)              :: count_grow_start
    integer (c_int)              :: count_grow_end
 
    !> Determine how many landuse codes are present
    stemp = "LU_Code"
    call params%get_parameters( skey=stemp,                                            &
                                ivalues=ilandusecodes )
 
    inumberoflanduses = count( ilandusecodes >= 0 )
 
    !> retrieve first day of growing season
    call sl_temp_list%clear()
    call sl_temp_list%append("First_day_of_growing_season")
    call sl_temp_list%append("First_DOY_growing_season")
    call sl_temp_list%append("Growing_season_start")
    call sl_temp_list%append("Growing_season_begin")
 
    call params%get_parameters( slkeys=sl_temp_list,                                  &
                                slvalues=sl_growing_season_begin,                     &
                                lfatal=false )
 
    !> process first day of growing season. retrieved as a list of strings;
    !! must convert the strings from mm/dd to DOY
    allocate( first_day_of_growing_season( inumberoflanduses ), stat=status )
    call assert( status==0, "Problem allocating memory.", __file__, __line__ )
 
    if ( sl_growing_season_begin%count == inumberoflanduses                &
         .and. sl_growing_season_begin%count_matching("<NA>") == 0 ) then
 
      do indx = 1, sl_growing_season_begin%count
        str_buffer = sl_growing_season_begin%get( indx )
 
        if ( scan( str_buffer, date_delims ) > 0 ) then
          first_day_of_growing_season( indx ) = mmdd2doy( str_buffer, "FIRST_DAY_OF_GROWING_SEASON" )
        else
          first_day_of_growing_season( indx ) = asint( str_buffer )
        endif
      enddo
 
    else
 
      first_day_of_growing_season = nodata_value
 
    endif
 
    !> retrieve last day of growing season
    call sl_temp_list%clear()
    call sl_temp_list%append("Last_day_of_growing_season")
    call sl_temp_list%append("Last_DOY_growing_season")
    call sl_temp_list%append("Growing_season_end")
    call sl_temp_list%append("Growing_season_stop")
 
    call params%get_parameters( slkeys=sl_temp_list,                                  &
                                slvalues=sl_growing_season_end,                       &
                                lfatal=false)
 
    !> process last day of growing season. retrieved as a list of strings;
    !! must convert the strings from mm/dd to DOY
    allocate( last_day_of_growing_season( inumberoflanduses ), stat=status )
    call assert( status==0, "Problem allocating memory.", __file__, __line__ )
 
    if ( sl_growing_season_end%count == inumberoflanduses                  &
         .and. sl_growing_season_end%count_matching("<NA>") == 0 ) then
 
      do indx = 1, sl_growing_season_end%count
        str_buffer = sl_growing_season_end%get( indx )
        if ( scan( str_buffer, date_delims ) > 0 ) then
          last_day_of_growing_season( indx ) = mmdd2doy( str_buffer, "LAST_DAY_OF_GROWING_SEASON" )
        else
          last_day_of_growing_season( indx ) = asint( str_buffer )
        endif
      enddo
 
    else
 
      last_day_of_growing_season = nodata_value
 
    endif
 
    !> GDD for first day of growing season
    call sl_temp_list%clear()
    call sl_temp_list%append("GDD_first_day_of_growing_season")
    call sl_temp_list%append("GDD_start_of_growing_season")
    call sl_temp_list%append("GDD_growing_season_start")
 
    call params%get_parameters( slkeys=sl_temp_list,          &
                                fvalues=temp_values,          &
                                lfatal=false )
 
    larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
    if ( larelengthsequal ) then
 
      call move_alloc( temp_values, gdd_first_day_of_growing_season )
 
    else
 
      call warn( smessage="The number of landuses does not match the number of GDD values "  &
                        //"specified for defining the beginning of the growing season.",     &
                 smodule=__file__, iline=__line__, lfatal=false )
 
      allocate( gdd_first_day_of_growing_season( ubound( ilandusecodes, 1) ), stat=status )
      call assert( status==0, "Problem allocating memory.", __file__, __line__)
 
      gdd_first_day_of_growing_season = nodata_value
 
    endif
 
    !> Air temperature defining last day of growing season
    call sl_temp_list%clear()
    call sl_temp_list%append("Killing_frost_temperature")
    call sl_temp_list%append("Air_temperature_end_of_growing_season")
    call sl_temp_list%append("Air_temperature_growing_season_end")
 
    call params%get_parameters( slkeys=sl_temp_list,          &
                                fvalues=temp_values,          &
                                lfatal=false )
 
    larelengthsequal = ( ubound(temp_values,1) == ubound(ilandusecodes,1) )
 
    if ( larelengthsequal ) then
 
      call move_alloc( temp_values, killing_frost_temp_last_day_of_growing_season )
 
    else
 
      call warn( smessage="The number of landuses does not match the number of killing frost values "  &
                        //"specified to define the end of the growing season.",                        &
                 smodule=__file__, iline=__line__, lfatal=false )
 
      allocate( killing_frost_temp_last_day_of_growing_season( ubound( ilandusecodes, 1) ), stat=status )
      call assert( status==0, "Problem allocating memory.", __file__, __line__)
 
      killing_frost_temp_last_day_of_growing_season = nodata_value
 
    endif
 
    count_gdd_start = count( gdd_first_day_of_growing_season > nodata_value )
    count_killing_frost_end = count( killing_frost_temp_last_day_of_growing_season > nodata_value )
    count_grow_start = count( first_day_of_growing_season > nodata_value )
    count_grow_end = count( last_day_of_growing_season > nodata_value )
 
    if ( (count_gdd_start == 0) .and. (count_killing_frost_end == 0)            &
      .and. (count_grow_start == 0) .and. (count_grow_end == 0) )               &
      call warn( smessage="A pair of values (GDD or DOY) must be given to "     &
        //"define the start and end of the growing season for each landuse"     &
        //" present in the lookup table.", lfatal=true)
 
    if ( count_gdd_start /= count_killing_frost_end )                                     &
      call warn( smessage="Unequal numbers of values given for defining the "             &
        //"start (GDD_first_day_of_growing_season) and end (Killing_frost_temperature) "  &
        //"of the growing season.", smodule=__file__, iline=__line__, lfatal=true )
 
    if ( count_grow_start /= count_grow_end )                                             &
      call warn( smessage="Unequal numbers of values given for defining the "             &
        //"start (Growing_season_start) and end (Growing_season_end) of the "             &
        //"growing season.", smodule=__file__, iline=__line__, lfatal=true )
 
    if ( ( (count_gdd_start + count_grow_start) /= ubound( ilandusecodes, 1) )  &
      .and. ( (count_gdd_start + count_grow_start) > 0 ) )                      &
      call warn( smessage="Two growing season start definitions "               &
        //"(GDD_first_day_of_growing_season and Growing_season_start) are "     &
        //"provided for one or more land uses. Only one of these values "       &
        //"should be non-zero for each entry the lookup table.",                &
        smodule=__file__, iline=__line__, lfatal=true )
 
    if ( ( (count_killing_frost_end + count_grow_end) /= ubound( ilandusecodes, 1) )  &
         .and. ( (count_killing_frost_end + count_grow_end) > 0) )                    &
      call warn( smessage="Two growing season ending definitions "                    &
        //"(Killing_frost_temperature and Growing_season_end) are "                   &
        //"provided for one or more land uses. Only one of these values "             &
        //"should be non-zero for each entry the lookup table.",                      &
        smodule=__file__, iline=__line__, lfatal=true )
 
  end subroutine growing_season_initialize
 
!--------------------------------------------------------------------------------------------------
 
  elemental subroutine growing_season_update( landuse_index,                   &
                                              GDD,                             &
                                              mean_air_temp,                   &
                                              it_is_growing_season )
 
    integer (c_int), intent(in)      :: landuse_index
    real (c_float), intent(in)       :: gdd
    real (c_float), intent(in)       :: mean_air_temp
    logical (c_bool), intent(inout)  :: it_is_growing_season
 
    ! first growing season day > last if we are growing a winter crop, winter wheat for example
    if ( first_day_of_growing_season(landuse_index) > last_day_of_growing_season(landuse_index) ) then
 
      if ( it_is_growing_season ) then
 
        if ( killing_frost_temp_last_day_of_growing_season( landuse_index ) > nodata_value ) then
 
          if ( mean_air_temp <= killing_frost_temp_last_day_of_growing_season( landuse_index ) ) &
                 it_is_growing_season = false
 
        elseif (    sim_dt%iDOY > last_day_of_growing_season( landuse_index )  ) then
                 it_is_growing_season = false
        endif
 
      else  ! not growing season; should it be?
 
        if ( gdd_first_day_of_growing_season( landuse_index ) > nodata_value ) then
 
          if ( gdd >= gdd_first_day_of_growing_season( landuse_index ) ) &
               it_is_growing_season = true
        elseif ( ( sim_dt%iDOY <= last_day_of_growing_season( landuse_index ) )          &
            .or. ( sim_dt%iDOY >= first_day_of_growing_season( landuse_index ) ) )  then
               it_is_growing_season = true
        endif
 
      endif
 
    else    ! normal situation where FIRST day of growing season < LAST day of growing season
 
      if ( it_is_growing_season ) then
 
        if ( killing_frost_temp_last_day_of_growing_season( landuse_index ) > nodata_value ) then
 
          if ( mean_air_temp <= killing_frost_temp_last_day_of_growing_season( landuse_index ) ) &
               it_is_growing_season = false
 
        elseif (    sim_dt%iDOY > last_day_of_growing_season( landuse_index ) )  then
               it_is_growing_season = false
        endif
 
      else  ! not growing season; should it be?
 
        if ( gdd_first_day_of_growing_season( landuse_index ) > nodata_value ) then
 
          if ( gdd >= gdd_first_day_of_growing_season( landuse_index ) )              &
               it_is_growing_season = true
        else
 
          if (    sim_dt%iDOY <= last_day_of_growing_season( landuse_index )          &
            .and. sim_dt%iDOY >= first_day_of_growing_season( landuse_index )  )      &
               it_is_growing_season = true
 
        endif
 
      endif
 
    endif
 
  end subroutine growing_season_update
 
end module growing_season