c     *******************************************************
c     *                 PROGRAM RETRIEVE                    *
c     *  Graeme Oldham - August 1994                        *
c     *  Extracts a batch of interferograms from the        *
c     *  reduced data set                                   *
c     *******************************************************
c
      program retrieve
      real ifgval(500),specval(25000),ivl,start
      real a3,a4,a5,a6,a7,a8
      real s1,s2,s3,s4,s5,s6
c
      integer a1,a2,b3,b4
      integer ifgnum,ifgpts,specpts,zpd,flag
      integer num,ifg(100),det
c      character*3 fnme
c
c      open(3,file='list',status='unknown')
      write(*,'(///,5x,a)') 'PROGRAM RETRIEVE' 
      num=1
      do 10 k=1,num
         write(*,'(x,a,i3,a)')'Input ifgram. number (',k,')'
         read(*,*) ifg(k)
 10   continue
      write(*,'(x,a)') 'Processing...............'
       open(1,file='all.det',status='old')
      flag=0                   ! Checks whether file is open
      flag1=0                  ! Checks if all files are written
c
      do 100 i=1,1000
      read(1,*,END=200) a1,a2,ifgnum       ! ifgnum is interferogram #
      read(1,*) ifgpts,a3,a4,zpd           ! ifgpts=no. of points 
      read(1,*) (ifgval(n),n=1,ifgpts)     ! zpd=zpd position
      read(1,*) a5                         ! ifgval is value of ifgram 
      read(1,*) a6                         ! at point no. n
      read(1,*) a7
      read(1,*) a8
      read(1,*) b3,b4,ifgnum
      write(*,'(x,a,i3)') '#=',ifgnum
c      write(3,'(x,a,i3)') '#',ifgnum
      read(1,*) specpts,start,ivl,zpd      ! # pts, start wavenumber,
c                                          ! interval,zpd position
      read(1,*) (specval(m),m=1,specpts)   ! specval is value of
      read(1,*) s1                         ! spectrum at point m
      read(1,*) s2
      read(1,*) s3
      read(1,*) s4
      read(1,*) s5
      read(1,*) s6
      do 50 j=1,num
          if (ifg(j).eq.ifgnum) then
             flag1=flag1+1
             if (flag.eq.0) 
     :        open(2,file='interferogram.dat',status='unknown')
             write(*,'(x,a,i4)') 'Written interferogram no.=',ifgnum
             do n=1,ifgpts
             write(2,*) ifgval(n) 
             end do
             close(2)
             open(2,file='spectrum.dat',status='unknown')
             do m=1,specpts
             write(2,*) specval(m) 
             end do
             close(2)
             flag=1
          endif
          if (flag1.eq.num) goto 200
 50   continue
 100  continue
 200  close(2)
      close(1)
c      close(3)
      write(*,'(x,a)') 'Finished!'
 210   end  
