obl_tforcing.f90

#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