#include "obl_def.fi" module obl_tforcing !< @brief obl time dependent forcing def. ! -------------------------------------------------------------------------------- ! modules used ! -------------------------------------------------------------------------------- #ifdef USE_CONFIG_PARSER use iso_c_binding, only: C_NULL_CHAR use config_parser #endif ! directives list implicit none private ! public interface ! -------------------------------------------------------------------------------- public :: set_const_tforcing, set_external_tforcing, set_generic_tforcing public :: set_config_tforcing public :: get_value_tforcing public :: normalize_time_tforcing public :: deallocate_tforcing ! -------------------------------------------------------------------------------- !> @brief time forcing datatype type, public :: timeForcingDataType real, allocatable :: time(:) !< time array [s] real, allocatable :: fvalue(:) !< value array [*] integer :: num = 0 !< number of time marks end type contains ! -------------------------------------------------------------------------------- subroutine set_const_tforcing(tforcing, fconst) !> @brief setting const forcing ! ---------------------------------------------------------------------------- type (timeForcingDataType), intent(out) :: tforcing real, intent(in) :: fconst real, dimension(1) :: tval, fval ! ---------------------------------------------------------------------------- tval(1) = 0.0 fval(1) = fconst call set_generic_tforcing(tforcing, tval, fval, 1) end subroutine set_const_tforcing ! -------------------------------------------------------------------------------- subroutine set_external_tforcing(tforcing, filename) !> @brief setting forcing using file data ! ---------------------------------------------------------------------------- type (timeForcingDataType), intent(out) :: tforcing character(*), intent(in) :: filename integer :: num real, allocatable :: tval(:), fval(:) integer :: i integer :: io, status real :: val1, val2 ! ---------------------------------------------------------------------------- ! --- define number of lines in file open(newunit = io, file = filename, iostat = status, status ='old') if (status /= 0) then write(*, *) ' FAILURE! > unable to open file: ', trim(filename) return end if num = 0 status = 0 do while (status.eq.0) read (io, *, iostat = status) val1, val2 num = num + 1 enddo num = num - 1 close(io) if (num > 0) then allocate(tval(num), fval(num)) endif ! --- read input data open(newunit = io, file = filename, iostat = status, status = 'old') if (status /= 0) then write(*, *) ' FAILURE! > unable to open file: ', trim(filename) return end if do i = 1, num read(io, *) tval(i), fval(i) enddo close(io) if (num > 0) then call set_generic_tforcing(tforcing, tval, fval, num) deallocate(tval, fval) endif end subroutine set_external_tforcing ! -------------------------------------------------------------------------------- subroutine set_generic_tforcing(tforcing, tval, fval, num) !> @brief generic forcing setup ! ---------------------------------------------------------------------------- type (timeForcingDataType), intent(inout) :: tforcing integer, intent(in) :: num real, dimension(num), intent(in) :: tval, fval ! ---------------------------------------------------------------------------- !> removing if defined call deallocate_tforcing(tforcing) tforcing%num = num if (num > 0) then allocate(tforcing%time(num), tforcing%fvalue(num)) tforcing%time(:) = tval(1:num) tforcing%fvalue(:) = fval(1:num) endif end subroutine set_generic_tforcing ! -------------------------------------------------------------------------------- subroutine set_config_tforcing(tforcing, tag, ierr) !> @brief generic forcing setup ! ---------------------------------------------------------------------------- use obl_math, only : char_array2str type (timeForcingDataType), intent(inout) :: tforcing integer, intent(out) :: ierr character(len = *), intent(in) :: tag real :: fvalue character, allocatable :: config_field(:) integer :: status ! ---------------------------------------------------------------------------- ierr = 0 ! = OK call deallocate_tforcing(tforcing) #ifdef USE_CONFIG_PARSER call c_config_is_varname(trim(tag)//".mode"//C_NULL_CHAR, status) if (status /= 0) then call c_config_get_string(trim(tag)//".mode"//C_NULL_CHAR, config_field, status) if (status == 0) then ierr = 1 ! signal ERROR return end if if (trim(char_array2str(config_field)) == 'const') then call c_config_get_float(trim(tag)//".value"//C_NULL_CHAR, fvalue, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call set_const_tforcing(tforcing, fvalue) else if (trim(char_array2str(config_field)) == 'ascii') then call c_config_get_string(trim(tag)//".filename"//C_NULL_CHAR, config_field, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call set_external_tforcing(tforcing, char_array2str(config_field)) else write(*, *) ' FAILURE! > unknown forcing mode: ', trim(char_array2str(config_field)) ierr = 1 ! signal ERROR return endif else call c_config_is_varname(trim(tag)//C_NULL_CHAR, status) if (status /= 0) then call c_config_get_float(trim(tag)//C_NULL_CHAR, fvalue, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call set_const_tforcing(tforcing, fvalue) endif endif if (allocated(config_field)) deallocate(config_field) #endif end subroutine set_config_tforcing ! -------------------------------------------------------------------------------- subroutine get_value_tforcing(res, t, tforcing) !> @brief get value at time = t ! ---------------------------------------------------------------------------- use obl_math, only: c_interp_linear type (timeForcingDataType), intent(in) :: tforcing real, intent(in) :: t real, intent(out) :: res ! ---------------------------------------------------------------------------- call c_interp_linear(res, t, tforcing%fvalue, tforcing%time, tforcing%num) end subroutine get_value_tforcing ! -------------------------------------------------------------------------------- subroutine normalize_time_tforcing(tforcing, coeff) !> @brief normalize time *= coeff ! ---------------------------------------------------------------------------- type (timeForcingDataType), intent(inout) :: tforcing real, intent(in) :: coeff integer :: i ! ---------------------------------------------------------------------------- do i = 1, tforcing%num tforcing%time(i) = tforcing%time(i) * coeff end do end subroutine normalize_time_tforcing ! -------------------------------------------------------------------------------- subroutine deallocate_tforcing(tforcing) !> @brief free time forcing data ! ---------------------------------------------------------------------------- type (timeForcingDataType), intent(inout) :: tforcing ! ---------------------------------------------------------------------------- if (tforcing%num > 0) then deallocate(tforcing%time) deallocate(tforcing%fvalue) end if tforcing%num = 0 end subroutine deallocate_tforcing end module