check_inputs Subroutine

private pure subroutine check_inputs(me, x, y, z, q, r, s, ierr)

Check the validity of the inputs to the initialize routines. Prints warning message if there is an error, and also sets ierr (/=0 if there were any errors).

Supports up to 6D: x,y,z,q,r,s

History

  • Jacob Williams, 2/24/2015 : Created this routine.
  • Jacob Williams, 2/23/2016 : modified for linear interp module.

Type Bound

linear_interp_class

Arguments

Type IntentOptional Attributes Name
class(linear_interp_class), intent(in) :: me
real(kind=wp), intent(in), optional, dimension(:) :: x

x abscissa vector
real(kind=wp), intent(in), optional, dimension(:) :: y

y abscissa vector
real(kind=wp), intent(in), optional, dimension(:) :: z

z abscissa vector
real(kind=wp), intent(in), optional, dimension(:) :: q

q abscissa vector
real(kind=wp), intent(in), optional, dimension(:) :: r

r abscissa vector
real(kind=wp), intent(in), optional, dimension(:) :: s

s abscissa vector
integer, intent(out) :: ierr

0 : no problems, 1 : x is not strictly increasing, 2 : y is not strictly increasing, 3 : z is not strictly increasing, 4 : q is not strictly increasing, 5 : r is not strictly increasing, 6 : s is not strictly increasing, 100 : cannot use linear interpolation for only one point.

Called by

proc~~check_inputs~~CalledByGraph proc~check_inputs linear_interpolation_module::linear_interp_class%check_inputs proc~initialize_1d linear_interpolation_module::linear_interp_1d%initialize_1d proc~initialize_1d->proc~check_inputs proc~initialize_2d linear_interpolation_module::linear_interp_2d%initialize_2d proc~initialize_2d->proc~check_inputs proc~initialize_3d linear_interpolation_module::linear_interp_3d%initialize_3d proc~initialize_3d->proc~check_inputs proc~initialize_4d linear_interpolation_module::linear_interp_4d%initialize_4d proc~initialize_4d->proc~check_inputs proc~initialize_5d linear_interpolation_module::linear_interp_5d%initialize_5d proc~initialize_5d->proc~check_inputs proc~initialize_6d linear_interpolation_module::linear_interp_6d%initialize_6d proc~initialize_6d->proc~check_inputs

Source Code

    pure subroutine check_inputs(me,x,y,z,q,r,s,ierr)

    implicit none

    class(linear_interp_class),intent(in)      :: me
    real(wp),dimension(:),intent(in),optional  :: x     !! `x` abscissa vector
    real(wp),dimension(:),intent(in),optional  :: y     !! `y` abscissa vector
    real(wp),dimension(:),intent(in),optional  :: z     !! `z` abscissa vector
    real(wp),dimension(:),intent(in),optional  :: q     !! `q` abscissa vector
    real(wp),dimension(:),intent(in),optional  :: r     !! `r` abscissa vector
    real(wp),dimension(:),intent(in),optional  :: s     !! `s` abscissa vector
    integer,intent(out)                        :: ierr  !! `0`   : no problems,
                                                        !! `1`   : `x` is not strictly increasing,
                                                        !! `2`   : `y` is not strictly increasing,
                                                        !! `3`   : `z` is not strictly increasing,
                                                        !! `4`   : `q` is not strictly increasing,
                                                        !! `5`   : `r` is not strictly increasing,
                                                        !! `6`   : `s` is not strictly increasing,
                                                        !! `100` : cannot use linear interpolation for only one point.

    ierr = 0  ! initialize

    if (present(x)) call check(x,1,ierr); if (ierr/=0) return
    if (present(y)) call check(y,2,ierr); if (ierr/=0) return
    if (present(z)) call check(z,3,ierr); if (ierr/=0) return
    if (present(q)) call check(q,4,ierr); if (ierr/=0) return
    if (present(r)) call check(r,5,ierr); if (ierr/=0) return
    if (present(s)) call check(s,6,ierr); if (ierr/=0) return

    if (ierr == 0) then
        select type (me)
        class is (nearest_interp_1d)
        class is (nearest_interp_2d)
        class is (nearest_interp_3d)
        class is (nearest_interp_4d)
        class is (nearest_interp_5d)
        class is (nearest_interp_6d)
        class default
            ! need at least two points for linear interpolation:
            if (size(x)==1) ierr = 100
        end select
    end if

    contains
!*****************************************************************************************

        pure subroutine check(v,error_code,ierr)

        implicit none

        real(wp),dimension(:),intent(in) :: v          !! abcissae vector
        integer,intent(in)               :: error_code !! error code for check
        integer,intent(inout)            :: ierr       !! will be set to `error_code` if there is a problem

        integer :: i  !! counter
        integer :: n  !! size of the input `v` array

        n = size(v)
        do i=2,n
            if (v(i) <= v(i-1)) then
                ierr = error_code
                exit
            end if
        end do

        end subroutine check

    end subroutine check_inputs