m_runtime.f90 (16564)

Go to the documentation of this file.

!> @file m_runtime.f90
!! The FishMet Model: Parameter input and output, model scheduling.
 
! ------------------------------------------------------------------------------
! Copyright notice:
!   Copyright (c) 2015-2024 Sergey Budaev & Ivar Rønnestad
! FishMet model code is distributed according to GNU AGPL v3, see LICENSE.md
! ------------------------------------------------------------------------------
 
! Notes:
!         This module is for general scheduling of the model, parameters
!         inpuit and output
 
!> Module that defines the runtime behaviour of the model
module runtime
 
  use realcalc
  use commondata
  use parsetext
  use base_strings, only : lowercase, parse
  use simulate
  use the_fish
  use, intrinsic :: iso_fortran_env, only : error_unit
 
  implicit none
 
  contains
 
  !> This procedure performs basic initialisation of the system:
  !!  - read environment variables determining global behaviour of the model
  !!  - call ::read_parameters_file() to get global model parameters from the
  !!    configuration file
  !! .
  impure subroutine system_init
    use stubs, only : print_help_switches
 
    character(len=LABEL_LEN) :: t_string
 
    integer :: i, n_args
    character(LABEL_LEN), dimension(:), allocatable :: cmd_args
 
    !> ### Command line parameters and environment variables ###
    !> The behaviour of the model program can be controlled using command line
    !! parameters and environment variables.
    !    Get the number of command line arguments, they will be placed
    !    into the `cmd_args array`.
    n_args = command_argument_count()
    allocate(cmd_args(n_args))
 
    !    Parse command line arguments.
    do i=1, n_args
      call get_command_argument(number = i, value = cmd_args(i))
      cmd_args(i) = lowercase(cmd_args(i))
    end do
 
    !> #### Help screen ####
    !> Help screen: if the program is executed with one of these command line
    !! parameters `-h --help -help /h /help`, a short screen help is
    !! printed on the terminal and the program halts.
    if ( any(cmd_args=="-h") .or.                                             &
         any(cmd_args=="--help") .or.                                         &
         any(cmd_args=="-help") .or.                                          &
         any(cmd_args=="/h") .or.                                             &
         any(cmd_args=="/help") )  then
      call print_help_switches()
      stop
    end if
 
    !> #### Set the output mode ####
    !> There are two output modes: normal and "quiet," in the later case
    !! only requested information is written to the screen, no accessory
    !! information is written.
    if ( any(cmd_args=="-q") .or. any(cmd_args=="--quiet") .or.               &
         any(cmd_args=="/q") .or. any(cmd_args=="/quiet") ) then
      verbose = .false.
    else
      verbose = .true.
    end if
 
    !> #### Parameters file ####
    !! The main parameter file is kept in commondata::global_param_file_name
    !! and is defined by the environment variable `FFA_MODEL_PARAMETER_FILE`.
    call get_environment_variable( name="FFA_MODEL_PARAMETER_FILE",           &
                                   value=t_string)
    if ( len_trim(t_string)==0 ) then
      global_param_file_name = param_file_name_def
    else
      global_param_file_name = t_string
    end if
 
 
    !> The environment variable  `FFA_MODEL_OUTPUT_DEST` can set the output
    !! destination directory in addition to the `output_dest` parameter in the
    !! model configuration file. The value set by the environment variable
    !! takes priority over the configuration file.
    call get_environment_variable( name="FFA_MODEL_OUTPUT_DEST",              &
                                   value=t_string)
    if ( len_trim(t_string)==0 ) then
      global_output_dest = output_dest_dir
    else
      global_output_dest = t_string
    end if
 
    !> - Read global parameters from the configuration file defined in
    !!   commondata::param_file_name_def.
    !! .
    call read_parameters()
 
  end subroutine system_init
 
  !> This subroutine starts and schedules the model
  impure subroutine system_run_main()
    use stubs, only : cmd_iface_process_commands
    use csv_io, only : get_free_funit
 
    logical :: is_exit_program
 
    integer :: stats_file_unit, file_error_status
    logical :: is_model_stats_save_header_done, file_exists
 
    !> - Print param,eters
    write(*,"(a)") model_parameters_txt()
 
    !> - Run the model
    call test_run()
 
    !> - Print basic output stats
    write(*,"(a)") model_output_stats_txt()
 
    call output_arrays_save_csv( output_arrays_csv_file // ".csv" )
    call output_arrays_save_rate_data_csv( output_rate_data_csv_file // ".csv")
 
    !> - Save model stats row
    is_model_stats_save_header_done = .false.
 
    inquire( file=global_stats_output_file, exist=file_exists )
    if (file_exists) then
      is_model_stats_save_header_done = .true.
    end if
 
    if (is_model_stats_save_header_done) then
      if (verbose) write(*,*) "NOTE: File ", trim(global_stats_output_file),  &
                                            " exists, data will be appended."
      ! not saved header yet, equivalent to `append stats` command
      stats_file_unit = get_free_funit()
      open(stats_file_unit, file=global_stats_output_file,                    &
            status="old", position="append", action="write",                  &
            iostat=file_error_status)
      if (file_error_status /= 0) then
        write(error_unit,*)                                                   &
          ">>> ERROR: file write error! Use `output statistics` " //          &
          "command first, check free space or permissions."
      else
        write(stats_file_unit,"(a)") model_output_stats_row_csv()
      end if
      close(stats_file_unit)
    else
      ! new file started, equivalent `output stats` command
      stats_file_unit = get_free_funit()
      open(stats_file_unit, file=global_stats_output_file,                    &
                status="replace", action="write", iostat=file_error_status)
      if (file_error_status /= 0) then
        write(error_unit,*)                                                   &
          ">>> ERROR: file write error! Use `output statistics` " //          &
          "command first, check free space or permissions."
      else
        write(stats_file_unit,"(a)")                                          &
                        model_output_stats_row_csv(show_header=.true.)
      end if
      close(stats_file_unit)
    end if
 
  end subroutine system_run_main
 
  !> The subroutine **read_parameters** reads global parameters
  !! defined in the commondata module from configuration file
  !! commondata::param_file_name_def.
  impure subroutine read_parameters()
    use csv_io, only : get_free_funit, fs_unlink
 
    integer, parameter :: param_funit = 254   ! File unit for config file
    type(pto) :: cf                           ! PARSETEXT file handle object
    logical :: config_file_exist, config_param_is_missing
    logical :: iface_is_gui, is_scale_relative
    integer :: iin, f_unit_tmp, iostat_f_tmp
    character(len=:), allocatable :: tmp_parse
    character(len=*), parameter :: f_name_tmp = ".tmpfile"
 
    ! a temporary copy of Global_Transport_Pattern_T for analysis
    real(srp), allocatable, dimension(:):: get_transport_pattern_t
 
    ! .......................................................................
    ! Check if the configuration file exists, if not, exit with error.
    inquire( file=trim(global_param_file_name), exist=config_file_exist )
    if (.not. config_file_exist ) then
      call exit_with_error( "Configuration file '" //                         &
                    trim(global_param_file_name) // "' cannot be found." )
    end if
 
    ! .......................................................................
    ! Open and parse the input configuration file
    call ptparse(cf, trim(global_param_file_name), param_funit)
 
    ! Read the parameters
    ! ### All following are model parameters
 
    global_run_model_hours = ptread_i(cf, 'run_model_hours', unknown)
 
    global_day_starts_hour = ptread_i(cf, 'day_starts_hour', 0)
 
    global_run_model_feed_offset = ptread_i(cf, 'feed_start_offset', 0)
 
    global_hours_daytime_feeding = ptread_i(cf, 'daytime_hours', unknown)
 
    global_baseline_activity_day =                                            &
                              ptread_r(cf, 'baseline_activity_day', missing)
 
    global_baseline_activity_night =                                          &
                              ptread_r(cf, 'baseline_activity_night', missing)
 
    global_body_mass = ptread_r(cf, 'body_mass', missing)
 
    global_stomach_mass = ptread_r(cf,'stomach_capacity', missing)
 
    global_midgut_mass = ptread_r(cf,'midgut_capacity', missing)
 
    global_absorption_ratio = ptread_r(cf,'absorption_ratio', missing)
 
    global_ingestion_delay_min = ptread_i(cf, 'ingestion_delay', unknown)
 
    global_water_uptake = ptread_r(cf,'water_uptake', missing)
 
    global_water_uptake_a = ptread_r(cf,'water_uptake_a', missing)
 
    global_water_uptake_r = ptread_r(cf,'water_uptake_r', missing)
 
    global_digestion_delay_min = ptread_i(cf, 'digestion_delay', unknown)
 
    global_maximum_duration_midgut_min=ptread_i(cf, 'midgut_maxdur', unknown)
 
    global_appetite_fish_night = ptread_r(cf, "appetite_night", missing)
 
    global_appetite_stomach_threshold =                                       &
                            ptread_r(cf,'appetite_threshold_stomach', missing)
 
    global_appetite_logist_a = ptread_r(cf,'appetite_factor_a', missing)
 
    global_appetite_logist_r = ptread_r(cf,'appetite_factor_r', missing)
 
    global_appetite_activity_factor =                                         &
                              ptread_r(cf,'activity_appetite_factor', 0.3_srp)
 
    global_ue_ze_factor = ptread_r(cf, 'branchial_energy_factor', missing)
 
    global_ue_ze_ammonia_excretion =                                          &
                              ptread_r(cf, 'branchial_ammonia_rate', missing)
 
    if ( global_ue_ze_factor == missing .and.                                 &
         global_ue_ze_ammonia_excretion > 0.0_srp ) then
      global_is_ue_ze_fixed_rate = .true.
      if (is_debug .and. verbose) write(*,"(a,f6.4,a)")                       &
                    "NOTE: branchial and urinal energy loss is fixed rate: ", &
                    global_ue_ze_ammonia_excretion, " mu mol/g/h"
    else if ( global_ue_ze_factor == missing .and.                            &
              global_ue_ze_ammonia_excretion == missing ) then
      global_ue_ze_factor = 0.0_srp
      global_is_ue_ze_fixed_rate   = .false.
      if (is_debug .and. verbose)                                             &
          write(*,*) "NOTE: branchial and urinal energy loss zero"
    else
      if (global_ue_ze_factor < 0.0_srp) global_ue_ze_factor = 0.0_srp
      global_is_ue_ze_fixed_rate   = .false.
    end if
 
    global_sda_absorp_rate_max =                                              &
                ptread_r(cf, 'sda_absorption_rate_max', 0.0_srp )
 
    global_sda_factor_max  = ptread_r(cf, 'sda_energy_factor_max', 0.0_srp)
 
    ! Get Global_Transport_Pattern_T and autodetect time scale, s or h
    get_transport_pattern_t = ptread_rvec( cf, 'transport_pattern_t' )
 
    ! Check if the time scale of the stomach transfer pattern vector is
    ! provided in hours or in raw data sec. The main parameter
    ! commondata::global_transport_pattern_t is in sec.
    check_scale: if ( get_transport_pattern_t(2) > 120.0_srp ) then
      ! - large number is provided, means the parameter vector is given
      !   in raw seconds.
      global_transport_pattern_t = nint(get_transport_pattern_t)
      if (is_debug .and. verbose)                                             &
                write(*,*) "NOTE: transport_pattern_t in raw sec"
    else check_scale
      ! - small numbers (<120 = 2 min) means the parameter array is
      !   given in hours
      global_transport_pattern_t = nint(get_transport_pattern_t*hour)
      if (is_debug  .and. verbose)                                            &
                write(error_unit,"(a)") "NOTE: transport_pattern_t in hours"
    end if check_scale
 
    global_transport_pattern_r = ptread_rvec( cf, 'transport_pattern_r' )
 
    if (size(global_transport_pattern_t)/=size(global_transport_pattern_r))   &
      call exit_with_error( "transport_pattern_t, transport_pattern_r" //     &
                  " must have same dimensions", no_exit=.false. )
 
    global_transport_dim = size(global_transport_pattern_t)
 
    global_transport_baseline_temperature =                                   &
                            ptread_r(cf,'transport_pattern_base_temp', missing)
 
    global_transport_baseline_fish_mass =                                     &
                            ptread_r(cf,'transport_pattern_base_mass', missing)
 
    global_mid_gut_mm_r_max = ptread_r(cf,'midgut_michaelis_r_max', missing)
 
    global_mid_gut_mm_k_m = ptread_r(cf,'midgut_michaelis_k', missing)
 
    global_energy_appetite_rate = ptread_r(cf,"appetite_energy_rate",40.0_srp)
 
    global_energy_appetite_shift = ptread_r(cf,"appetite_energy_shift",0.2_srp)
 
    global_oxygen_grid_x_temp = ptread_rvec( cf, 'smr_oxygen_temp',           &
                                             trout_oxygen_grid_x_temp)
 
    global_oxygen_grid_y_o2std = ptread_rvec( cf, 'smr_oxygen_o2',            &
                                              trout_oxygen_grid_y_o2std)
 
    if (size(global_oxygen_grid_x_temp)/=size(global_oxygen_grid_y_o2std))    &
      call exit_with_error( "smr_oxygen_temp, smr_oxygen_o2" //               &
                  " must have same dimensions", no_exit=.false. )
 
    global_food_item_mass = ptread_r(cf,'food_item_mass', missing)
 
    global_food_gross_energy = ptread_r(cf,'feed_gross_energy', missing)
 
    global_temperature = ptread_r(cf, 'temperature', missing)
 
    global_temp_factor_midgut_t = ptread_rvec(cf,'midgut_temp_fact_t',        &
                                                [1.0_srp, 10.0_srp, 25.0_srp])
 
    global_temp_factor_midgut_m = ptread_rvec(cf,'midgut_temp_fact_m',        &
                                                [1.0_srp, 1.0_srp, 1.0_srp])
 
    global_food_input_rate = ptread_r(cf,'food_input_rate', missing)
 
    global_stomach_midgut_mass_is_automatic = ptread_l( cf,                   &
                                        'stomach_midgut_automatic', .false. )
 
    global_interval_food_param = ptread_ivec( cf, 'food_provision_pattern' )
 
    global_food_pattern_file = ptread_s( cf, "food_provision_file_name",  "")
 
    global_food_pattern_file_is_propagate = ptread_l( cf,                     &
                                        'food_provision_file_repeat', .true. )
 
    global_food_pattern_file_is_steps = ptread_l( cf,                     &
                                      'food_provisioning_file_by_s', .false. )
 
    global_rate_interval = ptread_i(cf, 'rate_interval', 10)
 
    global_stats_output_file = ptread_s( cf, "stats_output_file",             &
                                                        def_stats_output_file)
 
    global_output_stats_is_long = ptread_l(cf, "stats_output_long", .true.)
 
    global_stomach_emptying_matrix_file =                                     &
                                ptread_s(cf, "stomach_emptying_matrix", "")
    if ( trim(global_stomach_emptying_matrix_file) == "") then
      global_stomach_emptying_pattern = stomach_emptying_def_default()
      if (is_debug .and. verbose) write(error_unit,"(a)")                     &
        "WARNING: stomach emptying grid matrix is not set, use default:" //   &
        crlf // stomach_emptying_txt()
    else
      inquire( file=trim(global_stomach_emptying_matrix_file),                &
                                                    exist=config_file_exist )
      if (.not. config_file_exist ) then
        write(error_unit,"(a)") "WARNING: stomach emptying grid file " //     &
                     trim(global_stomach_emptying_matrix_file) // " not found"
        write(error_unit,"(a)") "         use default matrix"
        global_stomach_emptying_matrix_file = ""
        global_stomach_emptying_pattern = stomach_emptying_def_default()
      else
        global_stomach_emptying_pattern =                                     &
          get_stomach_emptying_matrix_csv(global_stomach_emptying_matrix_file)
        if (size(global_stomach_emptying_pattern%emptying_time)<=9) then
          write(error_unit,"(a)") "WARNING: stomach emptying grid file: " //  &
                        trim(global_stomach_emptying_matrix_file)
          write(error_unit,"(a)")                                             &
                         "         does not seem to contain correct data, "// &
                        "use default matrix"
          global_stomach_emptying_pattern = stomach_emptying_def_default()
          global_stomach_emptying_matrix_file = ""
        end if
 
      end if
    end if
 
    global_stress_factor_hour = ptread_rvec(cf,                               &
                                "stress_grid_hour", [missing, missing])
    global_stress_fact_suppress = ptread_rvec(cf,                             &
                                "stress_grid_fact", [missing, missing])
 
    global_stress_intervention_is_minutes = ptread_l(cf,"stress_is_min",.true.)
 
    global_stress_cost_smr = ptread_r(cf, "stress_metabolic_cost", missing)
 
    global_stress_activity_decr = ptread_r(cf, "stress_inactivity", missing)
 
    if ( size(global_stress_factor_hour) /=                                   &
         size(global_stress_fact_suppress) )  then
      global_stress_factor_hour = [missing, missing]
      global_stress_fact_suppress = [missing, missing]
      write(error_unit,"(a)")                                                 &
                    "WARNING: Stress grid arrays 'stress_grid_hour' and"
      write(error_unit,"(a)")                                                 &
                    "         'stress_grid_fact' non-conformant, " //  &
                    "stress disabled"
    end if
 
    ! Get Global_Stress_Intervention_Time from the parameter file in correct
    ! units. Note that Global_Stress_Intervention_Is_Minutes (stress_is_min)
    ! can appear in the parameter file before or after stress because the file
    ! is parsed after it is fully read
    get_stress_array: block
      integer(LONG), allocatable, dimension(:) :: stress_timing_in
      stress_timing_in = ptread_ivec(cf, "stress", [unknown])
      if ( any(stress_timing_in==unknown .or. any(stress_timing_in<0)) ) then
        global_stress_intervention_time = [unknown]
      else
        if (global_stress_intervention_is_minutes) then
          global_stress_intervention_time = stress_timing_in * minute
        else
          global_stress_intervention_time = stress_timing_in
        end if
      end if
    end block get_stress_array
 
    ! Destination output directory commondata::global_output_dest is set from
    ! the configuration file only if it is not already set to some non-default
    ! value from the environment variable `FFA_MODEL_OUTPUT_DEST`
    ! (see system_init()).
    if ( global_output_dest == output_dest_dir ) then
      global_output_dest = ptread_s( cf, "output_dest", output_dest_dir )
    end if
 
    ! Check the above set output directory is writeable
    check_write_dir: if (global_output_dest /= output_dest_dir) then
      f_unit_tmp = get_free_funit()
      open( unit=f_unit_tmp, file=trim(global_output_dest) // f_name_tmp,     &
            status='replace', iostat=iostat_f_tmp )
      if (iostat_f_tmp /= 0) then
        if (is_debug .and. verbose) write(error_unit,"(a)")                   &
              "WARNING: destination directory " // trim(global_output_dest) //&
              " is NOT writeable, reset to default."
        global_output_dest = output_dest_dir
      end if
      close(f_unit_tmp)
      call fs_unlink(trim(global_output_dest) // f_name_tmp)
    end if check_write_dir
 
    call ptkill(cf)
 
    ! .......................................................................
    ! Check the configuration data, the file must always provide all
    ! data, missing values are not allowed
 
    config_param_is_missing = .false.
 
    if (global_baseline_activity_day == missing) then
      call exit_with_error("baseline_activity_day is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if (global_baseline_activity_night == missing) then
      call exit_with_error("baseline_activity_night is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if (global_body_mass == missing) then
      call exit_with_error("body_mass is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if ( global_stomach_mass == missing .OR.                                  &
         global_stomach_midgut_mass_is_automatic ) then
      global_stomach_mass = salmon_stomach_capacity(global_body_mass)
      if (is_debug .and. verbose) write(error_unit, "(a,f9.3)")               &
        "WARNING: FILE_PARAMETERS: stomach_capacity from body_mass:",         &
        global_stomach_mass
    end if
 
    if ( global_midgut_mass == missing .or.                                   &
         global_stomach_midgut_mass_is_automatic ) then
      global_midgut_mass = salmon_midgut_capacity(global_body_mass)
      if (is_debug .and. verbose) write(error_unit, "(a,f9.3)")               &
        "WARNING: FILE_PARAMETERS: midgut_capacity from body_mass:",          &
        global_midgut_mass
    end if
 
    if (global_ingestion_delay_min == unknown) then
      call exit_with_error("ingestion_delay is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if (global_water_uptake == missing) then
      call exit_with_error("water_uptake is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if ( all(global_transport_pattern_t == unknown) ) then
      call exit_with_error("transport_pattern_t is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if ( all(global_transport_pattern_r == missing) ) then
      call exit_with_error("transport_pattern_r is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if ( all(global_oxygen_grid_x_temp == unknown) ) then
      global_oxygen_grid_x_temp  = trout_oxygen_grid_x_temp
      call exit_with_error("smr_oxygen_temp is MISSING", no_exit=.true.)
    end if
 
    if ( all(global_oxygen_grid_y_o2std == unknown) ) then
      global_oxygen_grid_y_o2std = trout_oxygen_grid_y_o2std
      call exit_with_error("smr_oxygen_o2 is MISSING", no_exit=.true.)
    end if
 
    if (global_food_item_mass == missing) then
      call exit_with_error("food_item_mass is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if (global_temperature == missing) then
      call exit_with_error("temperature is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    if (global_food_input_rate == missing) then
      call exit_with_error("food_input_rate is MISSING", no_exit=.true.)
      config_param_is_missing = .true.
    end if
 
    ! Final check if any of the above configuration parameters was not set
    ! correctly, if so, halt with error
    if (config_param_is_missing)                                              &
      call exit_with_error( "Bad configuration file: " //                     &
                            trim(global_param_file_name) )
 
  end subroutine read_parameters
 
  !> A wrapper subroutine that will produce error message and halt
  impure subroutine exit_with_error(message, no_exit)
    use stubs, only : exit_with_error_cmd
 
    !> The error message that is printed to the standard error device or
    !! appear as a warning window depending on the interface type.
    character(len=*), intent(in) :: message
    !> Optional parameter that dictates NOT to stop the program and just
    !! print the error message. This may be useful if the program must
    !! check a series of conditions and then exit at the last one.
    logical, optional, intent(in) :: no_exit
 
    ! Local copy of optional parameter
    logical :: no_exit_loc
 
    if (present(no_exit)) then
      no_exit_loc = no_exit
    else
      no_exit_loc = .false.
    end if
 
    call exit_with_error_cmd(message, no_exit_loc)
 
  end subroutine exit_with_error
 
  !-----------------------------------------------------------------------------
  !> Parse and cut revision **number** in form of string from the whole SVN
  !! revision string. SVN revision number can therefore be included into the
  !! model outputs and output file names. This is convenient because the model
  !! version is identified by a single SVN revision number.
  !! @returns  revision number from Subversion.
  !! @warning `STRINGS` module uses unsafe coding prone to bugs, e.g.
  !!           does not clearly state dummy parameters intent and doesn't
  !!           work correctly with `parameter`s.
  function parse_svn_version ( svn_version_string ) result (sversion)
    !> The standard revision string as defined by the `$Revision: XXX $`
    !! keyword from Subversion.
    character(*), intent(in) :: svn_version_string
    character(len=:), allocatable :: sversion ! @returns revision number.
 
    ! @note Have to copy `svn_version_string` to this local variable as
    !       `PARSE` is broken when used with fixed parameters (no `intent`).
    character(len=len(svn_version_string)) :: svn_string_copy
    ! Delimiters for substrings.
    character(len=3) :: delims = " :$"
    ! String parts after parsing and cutting. Are 3 parts enough?
    character(len=len(svn_version_string)), dimension(3) :: sargs
    integer :: n_args
 
    !> ### Implementation notes ###
    !> Subversion has a useful feature: various keywords can be inserted and
    !! automatically updated in the source code under revision control, e.g.
    !! revision number, date, user etc. The character string parameter constant
    !! `commondata::svn_version_string` keeps the Subversion revision tag.
    !! This subroutine parses the tag striping all other characters out.
    svn_string_copy = svn_version_string
    call parse(svn_string_copy, delims, sargs, n_args)
    sversion = trim(sargs(n_args))      ! Version number is the last part.
 
  end function parse_svn_version
 
  !> Check if the stomach pattern matrix agrees with the stomach emptying
  !! partameter matrix, i.e. the difference is less than one hour.
  elemental function check_stomach_transport_emptying_agree() result (is_agree)
    logical :: is_agree
 
    real(srp) :: check_calc, check_last_param
    ! Absolute difference must be within this value
    real(srp), parameter :: hour_diff_max = 1.0_srp
 
    check_calc =                                                              &
        real( stomach_emptying_time(global_body_mass, global_temperature), srp)
    check_last_param =                                                        &
        real(global_transport_pattern_t(size(global_transport_pattern_t)),srp)
 
    if (abs(check_calc / hour - check_last_param / hour) < hour_diff_max) then
       is_agree = .true.
    else
       is_agree = .false.
    end if
 
  end function check_stomach_transport_emptying_agree
 
 
end module runtime