! @(#)compFITS.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:20
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
! 
! Midas application procedure compFITS.prg 
! K. Banse ESO - Garching  000726, 020225
! 
! to compare primary headers of FITS files
! 
! execute as: @a compFITS flag file1 file2
! 
!         flag = IMAGE, TABLE, FITS or DIFFERENCES,dflag
! 
!         if flag = D
! 	    dflag = xy, x = 0/1 ignore/not ignore empty lines
! 	    		y = 0/1 if no/yes special descriptors in file2
! 
!	    file1 = name of ASCII file holding already the differences of the
!                   FITS headers of two FITS images/tables
! 
!	    if y of dflag = 1, 
!	            file2 = list of descr.s which may differ and are ignored
! 
!         else
!	    file1, file2 = image, table, FITS file names (if flag = I, T, F)
! 
!  returns  0, if equal	
!           1, if not equal
!          -1, if file open errror
! 
! e.g. @a compFITS F lola.mt cuca.mt
! 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
! 
define/param p1 image c "Enter flag (IMAGE/TABLE):"
define/local diffy/c/1/2 00
set/format i2				!needed later on for M$PARSE()
! 
if p1(1:1) .eq. "D" then
   define/param p2 middif.dat c "Enter ASCII file name with differences:"
   define/local diffname/c/1/80 {p2}
   inputi = m$index(p1,",") + 1
   if inputi .gt. 2 then
      inputi(2) = inputi + 1
      diffy(1:2) = p1({inputi(1)}:{inputi(2)})
   endif
!
else
   define/local diffname/c/1/80 middif.dat
   $\rm -f middat1.dat middat2.dat
   if p1(1:1) .eq. "F" then
      define/param p2 ? C "Enter first FITS file:"
      define/param p3 ? C "Enter second FITS file:"
      intape/fits 1 midd {p2} fnn >middat1.dat
      intape/fits 1 midd {p3} fnn >middat2.dat
   !
   else
      if p1(1:1) .eq. "I" then
         define/param p2 ? image "Enter first Midas image:"
         define/param p3 ? image "Enter second Midas image:"
      else if p1(1:1) .eq. "T" then
         define/param p2 ? table "Enter first Midas table:"
         define/param p3 ? table "Enter second Midas table:"
      else
         write/out invalid input flag...
         return -2
      endif
      !
      write/out converting {p2} and {p3} to FITS format ...
      outdisk/fits {p2} middf1.fits >Null
      intape/fits 1 midd middf1.fits fnn >middat1.dat
      outdisk/fits {p3} middf2.fits >Null
      intape/fits 1 midd middf2.fits fnn >middat2.dat
   endif
   ! 
   write/out comparing the primary header of these FITS files ...
   if aux_mode .lt. 2 then
      write/out Sorry, this procedure has not been updated for VMS yet ...
      return -1
   else
      $diff middat1.dat middat2.dat > {diffname}
   endif
endif
! 
define/local fc/i/1/2 0,0
open/file {diffname} read fc
if fc(1) .lt. 0 then
   write/out Problems in opening ASCII file "{diffname}"
   return -1
endif
! 
if diffy(2:2) .eq. "1" then
   define/local dcount/i/1/1 0
   dcount = m$parse(p3,"lola")
   if dcount .gt. 0 then
      do inputi = 1 dcount
         define/local compar{inputi}/c/1/9 " " all
         write/keyw compar{inputi}/c/1/8 {lola{inputi}}
         compar{inputi}(9:9) = "="
      enddo
   else
      diffy(2:2) = "0"
   endif
endif
! 
read_loop:
write/key inputc/c/1/20 " " all
read/file {fc(1)} inputc 20
if fc(2) .lt. 0 then
   close/file {fc(1)}
   write/out FITS headers are `equal'...
   return 0
endif
! 
! only DATE and FILENAME should be different, nothing else...
! 
if inputc(1:1) .ne. "<" .and. inputc(1:1) .ne. ">" then
   goto read_loop
endif
! 
if inputc(3:7) .eq. "DATE " goto read_loop
if inputc(3:11) .eq. "FILENAME=" goto read_loop
! 
if diffy(1:1) .eq. "0" then			!ignore blank lines
   if inputc(3:3) .eq. " " goto read_loop
endif
if diffy(2:2) .eq. "1" then			!ignore blank lines
   do inputi = 1 dcount
      if inputc(3:10) .eq. compar{inputi}(1:8) goto read_loop
   enddo
endif
! 
! some other differences found...
write/out line: \"{inputc(1:20)}\" "        "  is bad...
close/file {fc(1)}
return 1