eso-midas-testdata 17.02pl1.2-2build1 / usr / lib / eso-midas / 17FEB / test / fits / verifydio.prg

! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!.COPYRIGHT  (c) 1993-2009  European Southern Observatory
!.TYPE       Procedure
!.IDENT      verifydio.prg
!.AUTHOR     P.Grosbol,   ESO/IPG
!.PURPOSE    Test and verification of FITS I/O commands
!.ALGORITHM  Read in a set of reference FITS files, check
!            some data values in them, re-do it after a
!            INTAPE/OUTTAPE cycle.
!.USAGE      @@ verifydio
!.VERSION    1.0  1993-Sep-17 : Creation,  PJG
! 091029	last modif
! 
! ------------------------------------------------------------------
!
! Define local keywords for tests
define/local seconds/i/1/2 0,0? +lower
!
set/midas newfiles=?? >Null
if outputc(1:1) .eq. "F" return           !we're already using FITS env.
!
write/out +------------------------------------------+
write/out Start of procedure verifydio.prg
write/out +------------------------------------------+
!
seconds(1) = m$secs()
! 
if mid$sys(1:8) .eq. "Alpha/Li" .or. aux_mode(1) .eq. 1 then
   define/local  xxxCPU/i/1/1  1		!also for VMS
else
   define/local  xxxCPU/i/1/1  0
endif
define/local  ref/r/1/13  0.0 all
define/local  val/r/1/13  0.0 all 
write/key ftest/I/1/1 0
set/format ,e15.5			!set format for double data
!
! Reference values
!
ref(1)  = 1.273543E+2
val(1)  = 7.394488E+1
ref(2)  = 3.600000E+1
val(2)  = 2.107224E+1
ref(3)  = 1.856400E+4
val(3)  = 1.071779E+4
ref(4)  = 3.532000E+1
val(4)  = 1.129088E-1
ref(5)  = 0.000000
val(5)  = 9.560513E+1
ref(6)  = -3.560797E-8
val(6)  = 2.262827E+1
ref(7)  = 4.8446182E+02
val(7)  = -2.4352182E-02
ref(8)  = 2.10188154006588375E+19
val(8)  = -6.52064009369660060E-16
ref(9)  = -12300.1204232321033
val(9)  = 234567.89
ref(10) = 6.52064009369660060E-16
val(10) = -2.4352182E-02
ref(11) = 0.0
val(11) = 0.0
ref(12) = 0.0
val(12) = 0.0
ref(13) = 7.50000E+0
val(13) = 4.60991E+0
!
! Read standard FITS file in
!
if xxxCPU .eq. 1 then
   intape  1-6 zzz tst
   intape  9-13 zzz tst
else
   intape  1-13 zzz tst
endif
!
! Check frame  1:
!
statistics/ima  zzz0001 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(1)}  "Frame 1 mean"
@@ verifysc  {outputr(4)}  {val(1)}  "Frame 1 rms."
!
! Check frame  2:
!
statistics/ima  zzz0002 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(2)}  "Frame 2 mean"
@@ verifysc  {outputr(4)}  {val(2)}  "Frame 2 rms."
!
! Check frame  3:
!
statistics/ima  zzz0003 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(3)}  "Frame 3 mean"
@@ verifysc  {outputr(4)}  {val(3)}  "Frame 3 rms."
!
! Check frame  4:
!
statistics/ima  zzz0004 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(4)}  "Frame 4 mean"
@@ verifysc  {outputr(4)}  {val(4)}  "Frame 4 rms."
!
! Check frame  5:
!
statistics/ima  zzz0005 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(5)}  "Frame 5 mean"
@@ verifysc  {outputr(4)}  {val(5)}  "Frame 5 rms."
!
! Check frame  6:
!
statistics/ima  zzz0006 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(6)}  "Frame 6 mean"
@@ verifysc  {outputr(4)}  {val(6)}  "Frame 6 rms."
!
! Check frame  7:
!
if xxxCPU .eq. 1 then
   write/out "special data files zzz0007, zzz0008 omitted for Alpha-Linux..."
else
   @@ verifysc  {zzz0007[@24]}  {ref(7)}  "Frame 7 pixel 24"
   @@ verifysc  {zzz0007[@35]}  {val(7)}  "Frame 7 pixel 35"
   !
   ! Check frame  8:
   !
   @@ verifysc  {zzz0008[@24]}  {ref(8)}  "Frame 8 pixel 24"
   @@ verifysc  {zzz0008[@35]}  {val(8)}  "Frame 8 pixel 35"
endif
!
! Check frame  9:
!
@@ verifysc  {zzz0009,:mass,@8}   {ref(9)}  "Table 9 :Mass @8"
@@ verifysc  {zzz0009,:dist,@53}  {val(9)}  "Table 9 :Dist @53"
!
! Check frame 10:
!
@@ verifysc  {zzz0010,:coor,@4}   {ref(10)}  "Table 10 :Coor @4"
@@ verifysc  {zzz0010,:complex,@6}  {val(10)}  "Table 10 :Complex @6"
!
! Check frame 13:
!
statistics/ima  zzz0013 ? ? ? SN
@@ verifysc  {outputr(3)}  {ref(13)}  "Frame 13 mean"
@@ verifysc  {outputr(4)}  {val(13)}  "Frame 13 rms."
!
! Write frames out again
!
create/icat zzzi zzz*.bdf
create/tcat zzzt zzz0009.tbl,zzz0010.tbl,zzz0011.tbl,zzz0012.tbl
add/tcat zzzt zzz0012a.tbl
!
! Write frames out with different options
!
!  Catalog option
!
outtape  zzzi  zzi NNN
outtape  zzzt  zzt NNN
!
!  Explicit
!
outtape  zzz0003.bdf  zzx0003.mt  NNN
!
! Read them back and check
!
if xxxCPU .eq. 1 then
   intape  12 zzi zzi N
   statistics/ima  zzi0012 ? ? ? SN
else
   intape  14 zzi zzi N
   statistics/ima  zzi0014 ? ? ? SN
endif
@@ verifysc  {outputr(3)}  {ref(13)}  "Frame 14 mean"
@@ verifysc  {outputr(4)}  {val(13)}  "Frame 14 rms."
!
intape 5 zzt zzt N
@@ verifysc  {zzt0005,:mass,@8}   {ref(9)}  "Table 9 :Mass @8"
@@ verifysc  {zzt0005,:dist,@53}  {val(9)}  "Table 9 :Dist @53"
! 
! check out INDISK/FITS for FITS extensions
! 
write/out > checking INDISK/FITS for FITS file with extensions
write/out > indisk/fits tst0012.mt
indisk/fits tst0012.mt
if outputi(10) .ne. 4 then
   write/out problems with INDISK/FITS of tst0012.mt ...
   return 1
endif
! 
crea/tcat klaus zzt*.mt origin
read/tcat klaus
write/out > indisk/fits klaus.cat lola* ? ? no
indisk/fits klaus.cat lola* ? ? no		!save always empty 1st headers
inputc = "{lola0010.tbl,tlabl005} "
if inputc(1:5) .ne. "Mass " then
   write/out problems with INDISK/FITS klaus.cat lola* ...
   return 1
endif
! 
! check out INDISK/MFITS
! 
@@ glueFITS {xxxCPU}			!build up big FITS file
! 
$rm -f toto0*.*
write/out > indisk/mfits tst0020.mt[1,quality,5-6,asciitable,10]
indisk/mfits tst0020.mt[1,quality,5-6,asciitable,10]
if outputc(1:6) .ne. "IABIE " then
   return 1
endif
if mid$info(4) .ne. 5 .or. {toto0010.bdf,naxis} .ne. 0 then
   return 1
endif
statistics/image toto0006 >Null
val(1) = outputr(3) - 127.3540
if m$abs(val) .gt. 0.0005 then
   return 1
endif
!
show/table toto0005
if outputi(1) .ne. 8 .or. outputi(2) .ne. 53 then
   return 1
endif
! 
! Report status
!
seconds(2) = m$secs()
mid$info(8) = seconds(2)-seconds(1)
!
if ftest(1) .eq. 0 then
   if aux_mode(1) .eq. 1 then		!VMS
      $ delete/noconf zz*.*.*
      $ delete/noconf toto0*.*.*
      $ delete/noconf lola0*.*.*
   else					!UNIX
      $ rm -f zz* toto0*.* lola0*.*
   endif
   !
   write/out +------------------------------------------+
   write/out procedure verifydio.prg:
   write/out Total time elapsed = {mid$info(8)} seconds.
   write/out All tests o.k. - you deserve a coffee now...
   write/out +------------------------------------------+
   return 0
!
else
   write/out FITS I/O test completed with ERROR - check LIST!!!
   return 1
endif