! @(#)sancheck.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:12:29
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure sancheck.prg  to check the sanity of an image
! K. Banse	940916, 980312
! execute via 
! @a sancheck frame [flag]
! 
!    with  frame = name of image frame
!          flag = N(ormal) for fast check
!               = X(tended) for complete check of image data as well
!
!    keyword MID$INFO(1) = 0   if all o.k.
!                        = -1  if inconsistent descriptors
!                        = 1   if invalid pixel values
! 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/param p1 ? IMA "Enter image: "
define/param p2 N C   "Enter flag, N(ormal) or X(tended):"
!
define/local frame/c/1/60 {p1}
set/format i1
! 
define/local sdim/i/1/3 1,1,1
define/local ly/i/1/1 1
define/local lz/i/1/1 1
define/local naxis/i/1/1 {{frame},naxis}
define/local size/i/1/1 {{frame},npix(1)}
define/local rr/r/1/3 0.,0.,0.
!
mid$info(1) = -1				!set to error...
read/descr {frame} * f >Null
! 
rr(1) = m$value({p1},LHCUTS(3))
rr(2) = m$value({p1},LHCUTS(4))
statist/image {p1} >Null
rr(3) = m$abs((outputr(1)-rr(1)))
if rr(3) .gt. 10.e-6 then
   write/out -
   "Warning: LHCUTS(3) ({rr(1)}) != Minimum value of {p1} ({outputr(1)})"
   goto bad
endif
rr(3) = m$abs((outputr(2)-rr(2)))
if rr(3) .gt. 10.e-6 then
   write/out -
      "Warning: LHCUTS(4) ({rr(2)}) != Maximum value of {p1}" ({outputr(1)})
bad:
   write/descr {p1} lhcuts/r/3/2 {rr(1)},{rr(2)}  !set LHCUTS back to original
   return
endif
! 
if p2(1:1) .ne. "X" then
   mid$info(1) = 0
   return
endif
! 
! we read all the data of the imagefile in ASCII format + check for NaN or Inf
! 
define/local fc/i/1/2 0,0
define/local nan/i/1/1 0
define/local pixcnt/i/1/1 0
!
sdim(1) = m$value({frame},npix(1))
if naxis .eq. 1 then
   define/local label/c/1/8 dim1
elseif naxis .eq. 2 then
   sdim(2) = m$value({frame},npix(2))
   define/local label/c/1/8 dim2
   display/long
elseif naxis .eq. 3 then
   sdim(2) = m$value({frame},npix(2))
   sdim(3) = m$value({frame},npix(3))
   define/local label/c/1/8 dim3
   display/long
else 
   write/out NAXIS of {frame} = {naxis} - not supported...
   return/exit
endif
goto {label}
! 
dim1:
read/image {frame} <,{size} >data.NaN
goto file_open
! 
dim2:
read/image {frame} <,@{ly},{size} >data.NaN
goto file_open
! 
dim3:
read/image {frame} <,@{ly},@{lz},{size} >data.NaN
goto file_open
! 
file_open:
open/file data.NaN READ fc
if fc(1) .lt. 1 then
   write/out Could not open ASCII file data.NaN
   return/exit
endif
! 
read/file {fc(1)} inputc		!skip first 2 lines
read/file {fc(1)} inputc
pixcnt = 1
! 
read_loop:
write/key inputc/c/1/8 " " all
read/file {fc(1)} inputc
if fc(2) .gt. 0 then
   nan = m$index(inputc,"NaN")
   if nan .gt. 0 then
      inputc = "NaN "
      goto NaN_found
   endif
   nan = m$index(inputc,"Inf")
   if nan .gt. 0 then
      inputc = "Inf "
      goto NaN_found
   endif
! 
   pixcnt = pixcnt+5			!5 values per line
   goto read_loop
else
   close/file {fc(1)}
endif
! 
ly = ly + 1
if ly .le. sdim(2) goto {label}
if naxis .eq. 3 then
   ly = 1
   lz = lz + 1
   if lz .le. sdim(3) goto {label}
endif
! 
mid$info(1) = 0
goto end_of_it
! 
NaN_found:
if naxis .eq. 1 then
   read/image {frame} @{pixcnt},20
else if naxis .eq. 2 then
   read/image {frame} @{pixcnt},@{ly},20
else
   read/image {frame} @{pixcnt},@{ly},@{lz},20
endif
write/out This is the first occurrence of {inputc}, there may be more...
! 
close/file {fc(1)}
mid$info(1) = 1
! 
end_of_it:
-delete data.NaN