m_env.f90 (16074)

Go to the documentation of this file.

!> @file m_env.f90
!! The FishMet Model: Definitions for the environment.
 
! ------------------------------------------------------------------------------
! Copyright notice:
!   Copyright (c) 2015-2024 Sergey Budaev & Ivar Rønnestad
! FishMet model code is distributed according to GNU AGPL v3, see LICENSE.md
! ------------------------------------------------------------------------------
 
 
!> Module defining the environment
module environ
 
  use realcalc
  use commondata
 
  implicit none
 
  !> Defines the food item
  type, public :: food_item
    !> The mass of a single food item
    real(srp) :: mass
    contains
      !> Initialise a single food item.
      !! See environ::food_item_init().
      procedure, public :: init => food_item_init
      !> Copy one food item characteristic(s) to another item.
      !! See environ::food_item_copy_assign_to().
      procedure, public :: copy => food_item_copy_assign_to
      !> Schedule the provision of the food items.
      !! See environ::food_item_schedule_feed().
      procedure, public :: schedule => food_item_schedule_feed
 
  end type food_item
 
  contains
 
  !> Initialise the food item with its parameters
  elemental subroutine food_item_init(this, mass)
 
    class(food_item), intent(inout) :: this
    real(srp), optional, intent(in) :: mass
 
    if (present(mass)) then
      this%mass = mass
    else
      this%mass = missing
    end if
 
  end subroutine food_item_init
 
  !> Copy `what_to_copy` object to `this` (target) object.
  !! @note    The code is actually equivalent to
  !!          `this%mass = food_item_in%mass` , but if the base class
  !!          includes several components (e.g. energetic value), an explicit
  !!          `copy` method is beneficial.
  !! @warning Note that making this an assignment overload (`assignment(=)`)
  !!          is dangerous as it will then apply to any higher-order
  !!          hierarchy objects. These will therefore not copy all data
  !!          components on normal `=` assignment, resulting in cryptic
  !!          errors.
  elemental subroutine food_item_copy_assign_to(this, what_to_copy)
    class(food_item), intent(inout) :: this
    class(food_item), intent(in)    :: what_to_copy
 
    this%mass = what_to_copy%mass
 
  end subroutine food_item_copy_assign_to
 
  !> Schedule the provision of food items depending on the time step.
  !! It returns a pointer to the food item class object if food is given or
  !! null pointer otherwise.
  !! @note The function cannot be pure due to pointer assignment (C1283).
  impure function food_item_schedule_feed( this, time_step, is_provided )     &
                                                          result( food_given )
    !> Any derivative of the ::food_item object
    class(food_item), intent(in), target :: this
    !> Optional time step, if not provided the global
    !! commondata::global_time_step is used
    integer(LONG), optional, intent(in) :: time_step
    !> Optional output indicator that shows if the food item is provided.
    logical, optional, intent(out) :: is_provided
 
    class(food_item), pointer :: food_given
 
    integer(LONG) :: time_step_loc
 
    nullify(food_given)
 
    if (present(time_step)) then
      time_step_loc = time_step
    else
      time_step_loc = global_time_step
    end if
 
    !> TODO: The rule for scheduling the food items is here
    food_intrvl: if ( global_interval_food_pattern(time_step_loc) ) then
 
      !! @note that each food item is given every `60/Global_Food_Input_Rate`
      !!       seconds.
      rate: if ( mod(time_step_loc,rate2int(global_food_input_rate))==0 ) then
        if(present(is_provided)) is_provided = .true.
        food_given => this
      else rate
        if (present(is_provided)) is_provided = .false.
        food_given => null()
      end if rate
 
    else food_intrvl
 
      if (present(is_provided)) is_provided = .false.
      food_given => null()
 
    end if food_intrvl
 
  end function food_item_schedule_feed
 
  !> Initialise and set up the global food provisioning pattern array
  !! commondata::global_interval_food_pattern given the day:night pattern
  !! commondata::global_hours_daytime_feeding. Note that feeding can occur
  !! only during the daytime.
  impure subroutine food_provisioning_pattern_init( max_steps )
    integer(LONG), intent(in) :: max_steps
 
    integer(LONG) :: i
 
    logical, allocatable, dimension(:) :: is_day_now, is_offset
 
    if (.not. allocated(global_interval_food_pattern) ) then
      allocate( global_interval_food_pattern(max_steps) )
    else
      deallocate (global_interval_food_pattern )
      allocate( global_interval_food_pattern(max_steps) )
    end if
 
    allocate(is_day_now(max_steps))
    allocate(is_offset(max_steps))
 
    do i = 1, max_steps
      is_offset(i) = schedule_2_int(i, global_run_model_feed_offset*minute,   &
                                  24*hour-global_run_model_feed_offset*minute )
 
      is_day_now(i) = is_day(i)   ! is_day is calculated by ::is_day() function
 
      if ( is_day_now(i) .and. .not. is_offset(i) ) then
        global_interval_food_pattern(i) =                                     &
            schedule_2_int( max(1,i-global_run_model_feed_offset*minute),     &
                              global_interval_food_param(1) * minute,         &
                              global_interval_food_param(2) * minute )
      else
        global_interval_food_pattern(i) = .false.
      end if
    end do
 
  end subroutine food_provisioning_pattern_init
 
  !> Read the food provisioning pattern from a CSV file. This allows to get
  !! any arbitrary pattern of food input.
  !! The input CSV file encodes data by *minute*.  There, *1* or any other
  !! non-zero value means that food is provided during the minute interval,
  !! *0* means that food is not provided. The file can describe by-minute
  !! pattern for 24 h or more  if `is_single` is `TRUE`. The pattern is
  !! then propagated for all 24 h periods described by the `max_steps`
  !! parameter.
  impure subroutine food_provisioning_get_file( max_steps, csv_file, column,   &
                                                                    is_single )
    use csv_io , only: csv_matrix_read
    !> Maximum number of the time steps of the model, normally
    !! commondata::global_run_model_hours().
    integer(LONG), intent(in) :: max_steps
    !> Input file name
    character(len=*), intent(in) :: csv_file
    !> Optional column number in the CSV data file. Default is column 1.
    integer, optional, intent(in) :: column
    !> Optional parameter flag that determines if the feeding schedule
    !! pattern from the data file `csv_file` is applied only once for the
    !! first 24 h period (TRUE) or propagated to each 24 h period (FALSE).
    !! The default value is FALSE
    logical, optional, intent(in) :: is_single
 
    real(srp),  allocatable, dimension(:,:) :: raw_data_csv, raw_data_csv_get
    logical, allocatable, dimension(:) :: pattern_sec
 
    ! logical food provision pattern in minutes for 24 h data
    ! Note: must be converted and propagated to seconds
    logical, allocatable, dimension(:) :: pattern_min
 
    logical :: is_success, is_single_loc
    integer :: column_loc
 
    integer(LONG) :: i, j, k, l, fill_n
 
    ! Number of seconds in a day, 24h x 60 min x 60 sec
    integer(LONG), parameter :: day_sec = 24 * hour
 
    ! Number of minutes in hour = 60
    integer, parameter :: minutes_hour = 60
 
    integer(LONG) :: get_rows, get_cols, max_rows
 
    if ( present(is_single) ) then
      is_single_loc = is_single
    else
      is_single_loc = .false.
    end if
 
    raw_data_csv_get = csv_matrix_read( csv_file, csv_file_status=is_success, &
                                    missing_code=0.0_srp )
 
    get_rows = size(raw_data_csv_get,1)
    get_cols = size(raw_data_csv_get,2)
 
    if (is_single_loc) then
      max_rows = get_rows
    else
      max_rows = min(get_rows, day_sec)
    end if
 
    if (present(column)) then
      column_loc = min( column, size(raw_data_csv_get,2) )
    else
      column_loc = 1
    end if
 
    ! An adjusted data matrix is obtained with the row length equal
    ! to the maximum number of seconds per day. Then data from the raw
    ! CSV input matrix is copied to the adjusted data matrix,
    ! Note that all extra datain the adjusted matrix is commondata::missing
    ! while the timing column is 0, i.e. no feed provided.
    if (is_single_loc) then
      allocate(raw_data_csv(get_rows, get_cols))
    else
      allocate(raw_data_csv(day_sec, get_cols))
    end if
 
    raw_data_csv = missing
    raw_data_csv(:,column_loc) = 0.0_srp
    raw_data_csv(1:max_rows,:) = raw_data_csv_get(1:max_rows,:)
    deallocate(raw_data_csv_get)
 
    if (.not. allocated(global_interval_food_pattern) ) then
      allocate( global_interval_food_pattern(max_steps) )
    else
      deallocate (global_interval_food_pattern )
      allocate( global_interval_food_pattern(max_steps) )
    end if
 
    allocate(pattern_sec(max_steps))
    allocate ( pattern_min( 24 * minutes_hour ) )
 
    global_interval_food_pattern = .false.
    pattern_sec = .false.
    pattern_min = .false.
 
    fill_n = size(raw_data_csv,1)
 
    if (is_single_loc) then
      l = 0
      do i = 1, min(fill_n, max_steps/minute)
        if (raw_data_csv(i,column_loc) /= 0.0_srp ) then
          do k=1, minute
            l = l + 1
            pattern_sec(l) = .true.
          end do
        else
          do k=1, minute
            l = l + 1
          end do
        end if
      end do
      global_interval_food_pattern =  pattern_sec
    else
      do i=1, min( size(raw_data_csv, 1), size(pattern_min) )
        if ( raw_data_csv(i,column_loc) == 0.0_srp ) then
          pattern_min(i) = .false.
        else
          pattern_min(i) = .true.
        end if
      end do
      j = 1 ! sec to MINUTES_HOUR = 60
      k = 1 ! min to size(pattern_min)
      do i = 1, max_steps
        global_interval_food_pattern(i) = pattern_min(k)
        if ( j >= minutes_hour ) then
          k = k + 1 ! next minute
          j = 0
        end if
        if ( k > size(pattern_min) ) then
          k = 1
        end if
        j = j + 1
      end do
    end if
 
  end subroutine food_provisioning_get_file
 
  !> Read the food provisioning pattern from a CSV file in raw format by s.
  !! This allows to get any arbitrary pattern of food input. Unlike the
  !! ::food_provisioning_get_file() subroutine, this procedure accepts the
  !! food provisioning data in the raw format equal to the model time step
  !! i.e. s (second). There, *1* or any other non-zero value means that food
  !! is provided during the time step while *0* means that food is not
  !! provided. The file can any duration within or exceeding 24 h period. Any
  !! data over 24 h are accepted only if `is_single` is `TRUE`.
  impure subroutine food_provisioning_get_raw( max_steps, csv_file, column,   &
                                                                    is_single )
    use csv_io , only: csv_matrix_read
    !> Maximum number of the time steps of the model, normally
    !! commondata::global_run_model_hours().
    integer(LONG), intent(in) :: max_steps
    !> Input file name
    character(len=*), intent(in) :: csv_file
    !> Optional column number in the CSV data file. Default is column 1.
    integer, optional, intent(in) :: column
    !> Optional parameter flag that determines if the feeding schedule
    !! pattern from the data file `csv_file` is applied only once for the
    !! first 24 h period (TRUE) or propagated to each 24 h period (FALSE).
    !! The default value is FALSE
    logical, optional, intent(in) :: is_single
 
    real(srp),  allocatable, dimension(:,:) :: raw_data_csv, raw_data_csv_get
    logical, allocatable, dimension(:) :: pattern_sec
 
    logical :: is_success, is_single_loc
    integer :: column_loc
 
    integer(LONG) :: i, j, fill_n
 
    ! Number of seconds in a day, 24h x 60 min x 60 sec
    integer(LONG), parameter :: day_sec = 24 * hour
 
    integer(LONG) :: get_rows, get_cols, max_rows
 
    if ( present(is_single) ) then
      is_single_loc = is_single
    else
      is_single_loc = .false.
    end if
 
    raw_data_csv_get = csv_matrix_read( csv_file, csv_file_status=is_success, &
                                    missing_code=0.0_srp )
 
    get_rows = size(raw_data_csv_get,1)
    get_cols = size(raw_data_csv_get,2)
 
    if (is_single_loc) then
      max_rows = get_rows
    else
      max_rows = min(get_rows, day_sec)
    end if
 
    if (present(column)) then
      column_loc = min( column, size(raw_data_csv_get,2) )
    else
      column_loc = 1
    end if
 
    ! An adjusted data matrix is obtained with the row length equal
    ! to the maximum number of seconds per day. Then data from the raw
    ! CSV input matrix is copied to the adjusted data matrix,
    ! Note that all extra datain the adjusted matrix is commondata::missing
    ! while the timing column is 0, i.e. no feed provided.
    if (is_single_loc) then
      allocate(raw_data_csv(get_rows, get_cols))
    else
      allocate(raw_data_csv(day_sec, get_cols))
    end if
 
    raw_data_csv = missing
    raw_data_csv(:,column_loc) = 0.0_srp
    raw_data_csv(1:max_rows,:) = raw_data_csv_get(1:max_rows,:)
    deallocate(raw_data_csv_get)
 
    if (.not. allocated(global_interval_food_pattern) ) then
      allocate( global_interval_food_pattern(max_steps) )
    else
      deallocate (global_interval_food_pattern )
      allocate( global_interval_food_pattern(max_steps) )
    end if
 
    allocate(pattern_sec(max_steps))
 
    global_interval_food_pattern = .false.
    pattern_sec = .false.
 
    fill_n = min(size(raw_data_csv,1), max_steps)
 
    if (is_single_loc) then
      do i = 1, fill_n
        if (raw_data_csv(i,column_loc) /= 0.0_srp ) then
          pattern_sec(i) = .true.
        end if
      end do
    else
      j=0
      do i=1, max_steps
        j = j + 1
        if (j > day_sec) j = 1
        if (raw_data_csv(j,column_loc) /= 0.0_srp ) then
          pattern_sec(i) = .true.
        end if
      end do
    end if
 
    global_interval_food_pattern =  pattern_sec
 
  end subroutine food_provisioning_get_raw
 
  !> Schedule two intervals  N1 = food given, steps, N2 = gap, steps
  !! @verbatim
  !!   N1     N2       N1     N2
  !! +----+----------+----+----------+  ...
  !!                        ^check_n
  !! @endverbatim
  elemental function schedule_2_int(check_n, int1, int2) result ( is_in_n1 )
    !> Value to be checked, normally **raw time steps**
    integer(LONG), intent(in) :: check_n
    !> The length of the interval when the food is provided, **raw steps**
    !> @warning If intervals are set in min, multiply argument by
    !!          commondata::minute
    integer, intent(in) :: int1
    !> The length of the interval when the food id not provided, **raw steps**
    !> @warning If intervals are set in min, multiply argument by
    !!          commondata::minute
    integer, intent(in) :: int2
    !> Returns TRUE if `check_n` is within the `int1` interval,
    !! otherwise FALSE.
    logical :: is_in_n1
 
    integer :: mod_n
 
    mod_n = mod( check_n, (int1+int2) )
 
    if ( mod_n < int1 ) then
      is_in_n1 = .true.
    else
      is_in_n1 = .false.
    end if
 
  end function schedule_2_int
 
  !> Determine if the time step corresponds to day (returns true) or night
  !! (returns false).
  !! @note that it is a wrapper to ::schedule_2_int().
  elemental function is_day(time_step) result (is_day_now)
    !> Optional time step, if absent determine is it day or night for
    !! commondata::global_time_step
    integer(LONG), intent(in), optional :: time_step
    logical :: is_day_now
 
    integer(LONG) :: time_step_loc
 
    if (present(time_step)) then
      time_step_loc = time_step
    else
      time_step_loc = global_time_step
    end if
 
    ! Adjustment for day_starts_hour:
    !
    ! @verbatim
    !
    !      H=5
    ! +-----*----------+        +----------------+        +----
    ! |       D        |   N    |       D        |   N    |
    ! +                +--------+                +--------+
    !
    !      H=5-day_starts_hour
    !     +*---------------+        +----------------+
    !     |       D        |   N    |       D        |   N
    ! ----+                +--------+                +--------+
    !  ^
    !  day_starts_hour
    !
    ! @endverbatim
    if (time_step_loc <= global_day_starts_hour * hour ) then
      is_day_now = .false.
    else
      is_day_now = schedule_2_int( time_step_loc - global_day_starts_hour * hour,    &
                                   global_hours_daytime_feeding * hour,       &
                                   (24 - global_hours_daytime_feeding) * hour )
    end if
 
  end function is_day
 
 
end module environ