program getann
c   this program reads the binary- direct access annual compustat tape
c   and also the index.  It allows access to companies by cusip number

c  ******************************************************************
c  don't change any of this!!
      integer dnum,cic,rec,file,zlist,fyr(20),yeara(20),xrel,stk,dup,
     *  ucode(20),state,county,finc,source(20)
      character*6 cnum,lcnum,cnumid,cuslst(10000)
      character*28 coname,iname,dumnam
      character*8 smbl
      character*2 aftnt(70,20),csspin,sdbt,sdbtim,subdbt
      character*1 cpspin,csspii
      character*3 cpaper
      character*10 ein
      real*4 data(350,20)
      integer irec,ioff,i,j,fileid,cutoff,ncomps,prev,ncount,create,
     *  index(10000)
      character*80 items(350)
c**********common statement declarations*********
      common /csrch/ cuslst
      common /isrch/ index,ncomps
      common /numdata/dnum,cic,rec,file,zlist,fyr,yeara,xrel,stk,dup,
     *  ucode,state,county,finc,source,data
      common /chrdata/cnum,lcnum,cnumid,coname,iname,dumnam,smbl,aftnt,
     *  csspin,sdbt,sdbtim,subdbt,cspin,csspii,cpaper,ein
      common /citems/items
c*****************************************************************
c  put in your own dimension statments here

      character*6 incus
      integer fid

c*****************************************************************

c  open the appropriate file--use 10 11 12 20 21 22 30 31 32 
c  first digit is 1=pst 2=fcotc 3=merged research
c  second digit is 0=current 1=backdata 2=waybackdata
c  so for example fid = 11 is pst backdata.  30 is merged research 
c  current data
      fid=10
      call cstopen(fid)
      call readidx(ncomps)

      open(11,file='name of file with cusip numbers')
  30  read(11,'(a6)',end=900) incus

c  use this to lookup the record for a particular cusip
c  lookup returns a -1 if it doesn't find the cusip
      irec=lookup(incus)
      if(irec.le.0) then
       write(*,*) incus, ' not found.  Check verify cusip.'
       goto 30
      endif
c  now get that record
      call readdat(irec)
c **************************************************
c  insert your processing code here for each record


c **************************************************
      goto 30
  900 stop
      end      
   

      function lookup(cusip)
      integer lookup,idxunit,datunit
      character*6 cusip,cuslst(10000)
      dimension index(10000)
      common /csrch/ cuslst
      common /isrch/ index,ncomps
c  this function returns the record number for the cusip entered
      call ssrch(ncomps,cusip,cuslst,1,indx)
      if(indx.le.0) then
        write(*,*) cusip, ' not found'
        lookup = -1
        return
      endif
      lookup = index(indx)
      return
      end

      subroutine readidx
c  this reads the index and returns the number of companies
      integer lookup,idxunit,datunit
      character*6 cusip,cuslst(10000)
      dimension index(10000)
      common /csrch/ cuslst
      common /isrch/ index,ncomps
      ncomps=1
  10  read(91,'(a6,1x,i5)',end=900)cuslst(ncomps),index(ncomps)
      ncomps=ncomps+1      
      goto 10
  900 ncomps=ncomps-1
      write(*,*) ncomps, ' companies in dataset.'
      return
      end

      subroutine readdat(irec)
      integer dnum,cic,rec,file,zlist,fyr(20),yeara(20),xrel,stk,dup,
     *  ucode(20),state,county,finc,source(20)
      character*6 cnum,lcnum,cnumid
      character*28 coname,iname,dumnam
      character*8 smbl
      character*2 aftnt(70,20),csspin,sdbt,sdbtim,subdbt
      character*1 cpspin,csspii
      character*3 cpaper
      character*10 ein
      real*4 data(350,20)
      integer irec,ioff,i,j,fileid,cutoff,ncomps,prev,ncount,create
      common /numdata/dnum,cic,rec,file,zlist,fyr,yeara,xrel,stk,dup,
     *  ucode,state,county,finc,source,data
      common /chrdata/cnum,lcnum,cnumid,coname,iname,dumnam,smbl,aftnt,
     *  csspin,sdbt,sdbtim,subdbt,cspin,csspii,cpaper,ein
c read binary direct
        read(90,rec=irec)dnum,cnum,cic,file,zlist,
     *  coname,iname,smbl,
     *  fyr,yeara,xrel,stk,dup,ucode,state,county,finc,
     *  source,cpspin,csspin,csspii,sdbt,sdbtim,subdbt,
     *  cpaper,ein,aftnt,data
      return
      end


      subroutine cstopen(fid)
      integer fid
c  this opens the appropriate files as units 10 and 11
      if(fid.eq.10) then
      open(unit=90,file='/usr/compustat/pst_ann.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/pst_ann.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'pst_ann files opened'
      return
      endif

      if(fid.eq.11) then
      open(unit=90,file='/usr/compustat/pst_ann_back.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/pst_ann_back.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'pst_ann_back files opened'
      return
      endif

      if(fid.eq.12) then
      open(unit=90,file='/usr/compustat/pst_ann_wback.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/pst_ann_wback.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'pst_ann_wback files opened'
      return
      endif

      if(fid.eq.20) then
      open(unit=90,file='/usr/compustat/fcotc_ann.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/fcotc_ann.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'fcotc_ann files opened'
      return
      endif

      if(fid.eq.21) then
      open(unit=90,file='/usr/compustat/fcotc_ann_back.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/fcotc_ann_back.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'fcotc_ann_back files opened'
      return
      endif

      if(fid.eq.22) then
      open(unit=90,file='/usr/compustat/fcotc_ann_wback.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/fcotc_ann_wback.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'fcotc_ann_wback files opened'
      return
      endif

      if(fid.eq.30) then
      open(unit=90,file='/usr/compustat/mrged_ann_res.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/mrged_ann_res.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'mrged_ann_res files opened'
      return
      endif

      if(fid.eq.31) then
      open(unit=90,file='/usr/compustat/mrged_ann_res_back.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/mrged_ann_res_back.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'mrged_ann_res_back files opened'
      return
      endif

      if(fid.eq.32) then
      open(unit=90,file='/usr/compustat/mrged_ann_res_wback.bin',
     *  status='old',
     *  form='unformatted',access='direct',recl=31253)
      open(unit=91,file='/usr/compustat/mrged_ann_res_wback.idx',
     *  status='old',
     *  form='formatted',access='sequential')
      write(*,*) 'mrged_ann_res_wback files opened'
      return
      endif

      write(*,*) fid, ' is an invalid file selection.'
      write(*,*) 'select one of 10 11 12 20 21 22 30 31 32'
      return 
      end