validation.f90

Go to the documentation of this file.

module validation

  use ids_types, only: ids_real, ids_int, ids_int_invalid, ids_real_invalid, ids_is_valid, ids_string_length

  implicit none

  interface is_valid
     module procedure &
          valid_int_0d, &
          valid_int_1d, &
          valid_int_2d, &
          valid_int_3d, &
          valid_real_0d, &
          valid_real_1d, &
          valid_real_2d, &
          valid_real_3d, &
          valid_real_4d, &
          valid_real_5d
  end interface is_valid

  interface is_valid_pointer
     module procedure &
          valid_int_0d_pointer, &
          valid_int_1d_pointer, &
          valid_int_2d_pointer, &
          valid_int_3d_pointer, &
          valid_real_0d_pointer, &
          valid_real_1d_pointer, &
          valid_real_2d_pointer, &
          valid_real_3d_pointer, &
          valid_real_4d_pointer, &
          valid_real_5d_pointer
  end interface is_valid_pointer

  interface is_valid_allocatable
     module procedure &
          valid_int_0d_allocatable, &
          valid_int_1d_allocatable, &
          valid_int_2d_allocatable, &
          valid_int_3d_allocatable, &
          valid_real_0d_allocatable, &
          valid_real_1d_allocatable, &
          valid_real_2d_allocatable, &
          valid_real_3d_allocatable, &
          valid_real_4d_allocatable, &
          valid_real_5d_allocatable
  end interface is_valid_allocatable

  private

  public is_valid
  public is_valid_pointer
  public is_valid_allocatable

  real(ids_real), parameter :: ids_int_huge  = huge(1_ids_int)
  real(ids_real), parameter :: ids_real_huge = huge(1.0_ids_real)

contains

  !===============================================================
  ! Scalars
  !===============================================================

  function valid_int_0d(val) result(out)
    logical :: out
    integer(ids_int) :: val
    out = ids_is_valid( val ) .and. (abs(val) < ids_real_huge) .and. (val==val)
  end function valid_int_0d

  function valid_real_0d(val) result(out)
    logical :: out
    real(ids_real) :: val
    out = ids_is_valid( val ) .and. (abs(val) < ids_real_huge) .and. (val==val)
  end function valid_real_0d

  !===============================================================
  ! Arrays, integer
  !===============================================================

   function valid_int_1d(arr) result(out)
    logical :: out
    integer(ids_int), intent(in) :: arr(:)
    integer(ids_int) :: val
    val = minval(arr)
    out = valid_int_0d( val )
  end function valid_int_1d

  function valid_int_2d(arr) result(out)
    logical :: out
    integer(ids_int), intent(in) :: arr(:,:)
    integer(ids_int) :: val
    val = minval(arr)
    out = valid_int_0d( val )
  end function valid_int_2d

  function valid_int_3d(arr) result(out)
    logical :: out
    integer(ids_int), intent(in) :: arr(:,:,:)
    integer(ids_int) :: val
    val = minval(arr)
    out = valid_int_0d( val )
  end function valid_int_3d

  !===============================================================
  ! Arrays, real
  !===============================================================

  function valid_real_1d(arr)  result(out)
    logical :: out
    real(ids_real), intent(in) :: arr(:)
    real(ids_real) :: val
    val = minval(arr)
    out = valid_real_0d( val )
  end function valid_real_1d

  function valid_real_2d(arr)  result(out)
    logical :: out
    real(ids_real), intent(in) :: arr(:,:)
    real(ids_real) :: val
    val = minval(arr)
    out = valid_real_0d( val )
  end function valid_real_2d

  function valid_real_3d(arr)  result(out)
    logical :: out
    real(ids_real), intent(in) :: arr(:,:,:)
    real(ids_real) :: val
    val = minval(arr)
    out = valid_real_0d( val )
  end function valid_real_3d

  function valid_real_4d(arr)  result(out)
    logical :: out
    real(ids_real), intent(in) :: arr(:,:,:,:)
    real(ids_real) :: val
    val = minval(arr)
    out = valid_real_0d( val )
  end function valid_real_4d

  function valid_real_5d(arr)  result(out)
    logical :: out
    real(ids_real), intent(in) :: arr(:,:,:,:,:)
    real(ids_real) :: val
    val = minval(arr)
    out = valid_real_0d( val )
  end function valid_real_5d

  !===============================================================
  ! Pointers, integers
  !===============================================================

  function valid_int_0d_pointer(arr) result(out)
    integer(ids_int), pointer :: arr
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_0d_pointer

  function valid_int_1d_pointer(arr) result(out)
    integer(ids_int), pointer :: arr(:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_1d_pointer

  function valid_int_2d_pointer(arr) result(out)
    integer(ids_int), pointer :: arr(:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_2d_pointer

  function valid_int_3d_pointer(arr) result(out)
    integer(ids_int), pointer :: arr(:,:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_3d_pointer

  !===============================================================
  ! Pointers, real
  !===============================================================

  function valid_real_0d_pointer(arr) result(out)
    real(ids_real), pointer :: arr
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_0d_pointer

  function valid_real_1d_pointer(arr) result(out)
    real(ids_real), pointer :: arr(:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_1d_pointer

  function valid_real_2d_pointer(arr) result(out)
    real(ids_real), pointer :: arr(:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_2d_pointer

  function valid_real_3d_pointer(arr) result(out)
    real(ids_real), pointer :: arr(:,:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_3d_pointer

  function valid_real_4d_pointer(arr) result(out)
    real(ids_real), pointer :: arr(:,:,:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_4d_pointer

  function valid_real_5d_pointer(arr) result(out)
    real(ids_real), pointer :: arr(:,:,:,:,:)
    logical :: out
    if (.not. associated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_5d_pointer


  !===============================================================
  ! Allocatables, integers
  !===============================================================

  function valid_int_0d_allocatable(arr) result(out)
    integer(ids_int), allocatable :: arr
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_0d_allocatable

  function valid_int_1d_allocatable(arr) result(out)
    integer(ids_int), allocatable :: arr(:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_1d_allocatable

  function valid_int_2d_allocatable(arr) result(out)
    integer(ids_int), allocatable :: arr(:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_2d_allocatable

  function valid_int_3d_allocatable(arr) result(out)
    integer(ids_int), allocatable :: arr(:,:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_int_3d_allocatable

  !===============================================================
  ! Allocatables, real
  !===============================================================

  function valid_real_0d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_0d_allocatable

  function valid_real_1d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr(:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_1d_allocatable

  function valid_real_2d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr(:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_2d_allocatable

  function valid_real_3d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr(:,:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_3d_allocatable

  function valid_real_4d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr(:,:,:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_4d_allocatable

  function valid_real_5d_allocatable(arr) result(out)
    real(ids_real), allocatable :: arr(:,:,:,:,:)
    logical :: out
    if (.not. allocated(arr)) then
       out = .false.
       return
    end if
    out = is_valid(arr)
  end function valid_real_5d_allocatable

end module validation