! @(#)packdsc.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:28 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure packdsc.prg
!  K. Banse     960913, 990118
!
!  use as @a packdsc frame [verify_flag]
!  with   frame = name of Midas file where you want to pack the descriptors,
!	          i.e. reclaim space from deleted descriptors
!	  verify_flag = yes/no, do/don't verify that all descriptors are
!		  copied, defaulted to NO
! 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/param p1 ? ima "Enter frame: "
define/param p2 NO ? "Enter verify_flag (YES/NO):"
! 
create/image M9x9 1,10 ? nodata		!build descr only frame
show/descr {p1} * >M9x9.data
copy/dd {p1} * M9x9 			!copy all descr of input
! 
if aux_mode(1) .lt. 2 then		!VMS
   define/local end/c/1/2 ".*"
else
   define/local end/c/1/2 "  "
endif
!
if p2(1:1) .eq. "Y" then
   show/descr M9x9 * >M9x9.datb
   $sort M9x9.datb > M9x9.datbs 		!we need to sort first
   $sort M9x9.data > M9x9.datas 
   $diff M9x9.datas M9x9.datbs > M9x9.datc
!
   define/local fc/i/1/3 0,0,0
   define/local reco/c/1/20 " " all
   open/file M9x9.datc READ fc
   if fc(1) .lt. 0 then
      write/out "could not open temp file `M9x9.datc'" -
      "=> no descr. comparison possible..."
      return/exit
   endif
! 
   do fc(3) = 1 4
      read/file {fc(1)} reco 20
   enddo
! 
   read/file {fc(1)} reco 20		!there should be no 5. line... !
   if fc(2) .ne. -1 then
      write/out "We have problems with descriptor copy!"
      write/out "Check descriptors in frame M9x9.bdf by hand against" -
                "the descriptors of {p1}..."
      close/file {fc(1)}
      -delete M9x9.dat*{end}
      return/exit
   endif
! 
   close/file {fc(1)}
endif
-delete M9x9.dat*{end}			!get rid of M9x9.data files
! 
delete/descr {p1} *                     !reinitialize descr's of input
copy/dd M9x9 * {p1}                     !and copy back
delete/image M9x9 no			!get rid of temp image