program idpick

c Program reads in two files, the first a single-column file of
c object ID numbers (idFile) and the second a multi-column file
c of object data (objFile). One of the columns of objFile (column
c idCol) contains object ID numbers which are used to sort through
c the object list. Only those objects with IDs in the ID input file
c are written to output (outFile); the rest are discarded.
c
c ** Program assumes both input files are sorted into ascending order
c on the basis of ID number. **
c
c Name of the summary input file is 'idpick.in'.
c
c DHJ 10/9/97


c **********************************************************************
c *** N.B.: *** Must change format statement in fortran line 80      *** 
c ************* to accommodate number of flux slices, manually !!    ***
c **********************************************************************



c Max number of columns in objFile and outFile = 30
c Max number of objects in outFile = 10000



      implicit none
      character*50 idFile, objFile, outFile
      integer col, row, idRow, objRow, numID, numObj, outRow
      integer idCol, numCol
      real currID, input(30), output(10000,30)




      open(unit=1, file='idpick.in', status='old')

      read(1,*,end=10,err=10) idFile
      read(1,*,end=10,err=10) numID
      read(1,*,end=10,err=10) objFile
      read(1,*,end=10,err=10) numObj
      read(1,*,end=10,err=10) numCol
      read(1,*,end=10,err=10) idCol
      read(1,*,end=10,err=10) outFile


      write (6,*) '  '
      write (6,*) 'File of ID numbers (input): ',idFile
      write (6,*) 'Number of IDs: ',numID
      write (6,*) 'File of Object data (input): ',objFile
      write (6,*) 'Number of objects: ',numObj
      write (6,*) 'Number of object columns: ',numCol
      write (6,*) 'Object column containing IDs: ',idCol
      write (6,*) 'Trimmed object file (output): ',outFile


 10    continue



c --------------------------------------------------------------------
c     Initialising input/output arrays:
c --------------------------------------------------------------------

      write (6,*) ' '
      write (6,*) 'Initialising arrays...'

      do col=1,numCol
	input(col)=0.0
      enddo

      do row=1,numObj
	do col=1,numCol
		output(row,col)=0.0
	enddo	
      enddo




c --------------------------------------------------------------------
c     Main Loop: reading input files and checking entries:
c --------------------------------------------------------------------


      write (6,*) 'Reading/sorting data...'
      write (6,*) ' '

      open(unit=11, file=idFile, status='old')
      open(unit=14, file=objFile, status='old')


	idRow = 1
	objRow = 1
	outRow = 1

	do while ((idRow.le.numID).and.(objRow.le.numObj))

		read(11,*,end=20,err=20) currID
20		continue

		read(14,*,end=30,err=30) (input(col),col=1,numCol)
30		continue


		do while (currID.ne.(input(idCol)))
			
		   read(14,*,end=40,err=40) (input(col),col=1,numCol)
40		   continue
		   objRow = objRow+1
		enddo

c		--- once program makes it to this point, an ID match
c		--- must have been made; hence copy input to output

		do col=1,numCol
		   output(outRow,col) = input(col)
		enddo
		
		outRow  = outRow+1
		objRow = objRow+1
		idRow=idRow+1
	enddo


	outRow = outRow-1

	write (6,*) 'Number of IDs tried: ',numID
	write (6,*) 'Number found: ',outRow

 
c --------------------------------------------------------------------
c     Writing output file:
c --------------------------------------------------------------------

      write (6,*) '   '
      write (6,*) 'Writing to output...'


      open(unit=13, file=outFile, status='unknown')
      do row=1,outRow
		write (13,80) (output(row,col),col=1,numCol)
      enddo
c --- proper catalogue (full version, all columns)

80    format (f5.0, f8.2, f8.2, f6.1, f12.8, f7.3, f8.2, f12.3, f9.3,
     $f6.2, f14.0, f6.0, f8.4, 7(f12.3))


      write (6,*) 'Done.'
      write (6,*) ' '



      stop
      end


c ===========================================================================