module obl_init !< @brief initial conditions module ! -------------------------------------------------------------------------------- ! modules used ! -------------------------------------------------------------------------------- #ifdef USE_CONFIG_PARSER use iso_c_binding, only: C_NULL_CHAR use config_parser #endif use obl_grid use obl_math ! directives list ! -------------------------------------------------------------------------------- implicit none private ! public interface ! -------------------------------------------------------------------------------- public :: set_const_profile, set_linear_profile, set_external_profile public :: set_config_profile ! -------------------------------------------------------------------------------- contains ! -------------------------------------------------------------------------------- subroutine set_const_profile(F, Fsurf, grid) !< @brief set constant profile ! ---------------------------------------------------------------------------- type (gridDataType), intent(in) :: grid real, dimension(grid%cz), intent(out) :: F real, intent(in) :: Fsurf ! -------------------------------------------------------------------------------- F(1:grid%cz) = Fsurf end subroutine ! -------------------------------------------------------------------------------- subroutine set_linear_profile(F, Fsurf, Fgrad, grid) !< @brief set constant profile ! ---------------------------------------------------------------------------- type (gridDataType), intent(in) :: grid real, dimension(grid%cz), intent(out) :: F real, intent(in) :: Fsurf, Fgrad integer :: k ! -------------------------------------------------------------------------------- do k = 1, grid%cz F(k) = Fsurf + Fgrad * (grid%z(k) - (grid%zpos + grid%height)) end do end subroutine ! -------------------------------------------------------------------------------- subroutine set_external_profile(F, filename, grid) !< @brief set constant profile ! ---------------------------------------------------------------------------- type (gridDataType), intent(in) :: grid real, dimension(grid%cz), intent(out) :: F integer :: num character(*), intent(in) :: filename integer :: io, status real :: val1, val2 real, allocatable :: depth(:), Fvalue(:) real :: d integer :: i, k ! -------------------------------------------------------------------------------- ! --- 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(depth(num), Fvalue(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, *) depth(i), Fvalue(i) enddo close(io) do k = 1, grid%cz d = grid%zpos + grid%height - grid%z(k) call c_interp_linear(F(k), d, Fvalue, depth, num) end do if (num > 0) then deallocate(depth, Fvalue) endif end subroutine ! -------------------------------------------------------------------------------- subroutine set_config_profile(F, tag, grid, ierr) !< @brief set constant profile ! ---------------------------------------------------------------------------- type (gridDataType), intent(in) :: grid real, dimension(grid%cz), intent(out) :: F integer, intent(out) :: ierr character(len = *), intent(in) :: tag character, allocatable :: config_field(:) integer :: status real :: Fsurf, Fgrad ! -------------------------------------------------------------------------------- ierr = 0 ! = OK #ifdef USE_CONFIG_PARSER 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)//".surface_value"//C_NULL_CHAR, Fsurf, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call set_const_profile(F, Fsurf, grid) else if (trim(char_array2str(config_field)) == 'linear') then call c_config_get_float(trim(tag)//".surface_value"//C_NULL_CHAR, Fsurf, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call c_config_get_float(trim(tag)//".grad_z"//C_NULL_CHAR, Fgrad, status) if (status == 0) then ierr = 1 ! signal ERROR return end if call set_linear_profile(F, Fsurf, Fgrad, grid) 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_profile(F, char_array2str(config_field), grid) else write(*, *) ' FAILURE! > unknown initial conditions mode: ', trim(char_array2str(config_field)) ierr = 1 ! signal ERROR return endif #else !> unable to define without config ierr = 1 #endif end subroutine end module