check_inputs Subroutine

private subroutine check_inputs(routine, iflag, nx, ny, nz, nq, nr, ns, kx, ky, kz, kq, kr, ks, x, y, z, q, r, s, tx, ty, tz, tq, tr, ts, status_ok)

Check the validity of the inputs to the “ink” routines. Prints warning message if there is an error, and also sets iflag and status_ok.

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

Notes

The code is new, but the logic is based on the original logic in the CMLIB routines db2ink and db3ink.

History

  • Jacob Williams, 2/24/2015 : Created this routine.

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: routine
integer, intent(inout) :: iflag
integer, intent(in), optional :: nx
integer, intent(in), optional :: ny
integer, intent(in), optional :: nz
integer, intent(in), optional :: nq
integer, intent(in), optional :: nr
integer, intent(in), optional :: ns
integer, intent(in), optional :: kx
integer, intent(in), optional :: ky
integer, intent(in), optional :: kz
integer, intent(in), optional :: kq
integer, intent(in), optional :: kr
integer, intent(in), optional :: ks
real(kind=wp), intent(in), optional, dimension(:) :: x
real(kind=wp), intent(in), optional, dimension(:) :: y
real(kind=wp), intent(in), optional, dimension(:) :: z
real(kind=wp), intent(in), optional, dimension(:) :: q
real(kind=wp), intent(in), optional, dimension(:) :: r
real(kind=wp), intent(in), optional, dimension(:) :: s
real(kind=wp), intent(in), optional, dimension(:) :: tx
real(kind=wp), intent(in), optional, dimension(:) :: ty
real(kind=wp), intent(in), optional, dimension(:) :: tz
real(kind=wp), intent(in), optional, dimension(:) :: tq
real(kind=wp), intent(in), optional, dimension(:) :: tr
real(kind=wp), intent(in), optional, dimension(:) :: ts
logical, intent(out) :: status_ok

Called by

proc~~check_inputs~~CalledByGraph proc~check_inputs check_inputs proc~db1ink db1ink proc~db1ink->proc~check_inputs proc~db2ink db2ink proc~db2ink->proc~check_inputs proc~interp_surf interp_surf proc~interp_surf->proc~db2ink program~test_bspline test_bspline program~test_bspline->proc~interp_surf

Source Code

    subroutine check_inputs(routine,&
                            iflag,&
                            nx,ny,nz,nq,nr,ns,&
                            kx,ky,kz,kq,kr,ks,&
                            x,y,z,q,r,s,&
                            tx,ty,tz,tq,tr,ts,&
                            status_ok)

    implicit none

    character(len=*),intent(in)                :: routine
    integer,intent(inout)                      :: iflag
    integer,intent(in),optional                :: nx,ny,nz,nq,nr,ns
    integer,intent(in),optional                :: kx,ky,kz,kq,kr,ks
    real(wp),dimension(:),intent(in),optional  :: x,y,z,q,r,s
    real(wp),dimension(:),intent(in),optional  :: tx,ty,tz,tq,tr,ts
    logical,intent(out)                        :: status_ok

    logical :: error

    status_ok = .false.

    if ((iflag < 0) .or. (iflag > 1)) then

        write(error_unit,'(A,1X,I5)') &
            trim(routine)//' - iflag is out of range: ',iflag
        iflag = 2

    else

        call check('x',nx,kx,x,tx,[3,4,5,6],    error); if (error) return
        call check('y',ny,ky,y,ty,[7,8,9,10],   error); if (error) return
        call check('z',nz,kz,z,tz,[11,12,13,14],error); if (error) return
        call check('q',nq,kq,q,tq,[15,16,17,18],error); if (error) return
        call check('r',nr,kr,r,tr,[19,20,21,22],error); if (error) return
        call check('s',ns,ks,s,ts,[23,24,25,26],error); if (error) return

        status_ok = .true.

    endif

    contains

        subroutine check(s,n,k,x,t,ierrs,error)  !check t,x,n,k for validity

        implicit none

        character(len=1),intent(in),optional       :: s     !! coordinate string: 'x','y','z','q','r','s'
        integer,intent(in),optional                :: n     !! size of x
        integer,intent(in),optional                :: k     !! order
        real(wp),dimension(:),intent(in),optional  :: x     !! abcissae vector
        real(wp),dimension(:),intent(in),optional  :: t     !! knot vector size(n+k)
        integer,dimension(:),intent(in)            :: ierrs !! int error codes for n,k,x,t checks
        logical,intent(out)                        :: error !! true if there was an error

        if (present(n)) then
            call check_n('n'//s,n,ierrs(1),error); if (error) return
            if (present(k)) then
                call check_k('k'//s,k,n,ierrs(2),error); if (error) return
            endif
            if (present(x)) then
                call check_x(s,n,x,ierrs(3),error); if (error) return
            endif
            if (iflag /= 0) then
                if (present(k) .and. present(t)) then
                    call check_t('t'//s,n,k,t,ierrs(4),error); if (error) return
                endif
            endif
        endif

        endsubroutine check

        subroutine check_n(s,n,ierr,error)

        implicit none

        character(len=*),intent(in) :: s
        integer,intent(in)          :: n
        integer,intent(in)          :: ierr
        logical,intent(out)         :: error

        if (n < 3) then
            write(error_unit,'(A,1X,I5)') &
                trim(routine)//' - '//trim(s)//' is out of range: ',n
            iflag = ierr
            error = .true.
        else
            error = .false.
        endif

        endsubroutine check_n

        subroutine check_k(s,k,n,ierr,error)

        implicit none

        character(len=*),intent(in) :: s
        integer,intent(in)          :: k
        integer,intent(in)          :: n
        integer,intent(in)          :: ierr
        logical,intent(out)         :: error

        if ((k < 2) .or. (k >= n)) then
            write(error_unit,'(A,1X,I5)') &
                trim(routine)//' - '//trim(s)//' is out of range: ',k
            iflag = ierr
            error = .true.
        else
            error = .false.
        endif

        endsubroutine check_k

        subroutine check_x(s,n,x,ierr,error)

        implicit none

        character(len=*),intent(in)       :: s
        integer,intent(in)                :: n
        real(wp),dimension(:),intent(in)  :: x
        integer,intent(in)                :: ierr
        logical,intent(out)               :: error

        integer :: i

        error = .true.
        do i=2,n
            if (x(i) <= x(i-1)) then
                iflag = ierr
                write(error_unit,'(A)') trim(routine)//' - '//trim(s)//&
                            ' array must be strictly increasing'
                return
            endif
        enddo
        error = .false.

        endsubroutine check_x

        subroutine check_t(s,n,k,t,ierr,error)

        implicit none

        character(len=*),intent(in)       :: s
        integer,intent(in)                :: n
        integer,intent(in)                :: k
        real(wp),dimension(:),intent(in)  :: t
        integer,intent(in)                :: ierr
        logical,intent(out)               :: error

        integer :: i

        error = .true.
        do i=2,n + k
            if (t(i) < t(i-1))  then
                  iflag = ierr
                write(error_unit,'(A)') trim(routine)//' - '//trim(s)//&
                            ' array must be non-decreasing'
                return
            endif
        enddo
        error = .false.

        endsubroutine check_t

    endsubroutine check_inputs