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