program compusta
c  this program accesses the quarterly ascii tapes sequentially

c  DON'T CHANGE ANY OF THESE DIMENSION STATEMENTS
      integer dnum,cic,rec,file,zlist,xrel,stk,dup,
     *  state,county
      integer incorp,candxc,perdes(18,48),fic
      character*6 cnum,lcnum
      character*28 coname,iname
      character*8 smbl
      character*2 qftnt(8,48),aftnt(60,48)
      character*10 ein
      real*4 data(232,48)
      integer irec,ioff,i,j,fileid,cutoff,ncomps,prev,ncount,create
c  insert any dimension statements you need here.


c  files are located in /usr/compustat and all have extension .ascii
c  their names are
c  cdn_qtr.ascii                mrged_qtr_res_wback.ascii
c  fcotc_qtr.ascii              mrged_qtr_res_wwback.ascii
c  fcotc_qtr_back.ascii         pst_qtr.ascii
c  fcotc_qtr_wback.ascii        pst_qtr_back.ascii
c  fcotc_qtr_wwback.ascii       pst_qtr_wback.ascii
c  mrged_qtr_res.ascii          pst_qtr_wwback.ascii
c  mrged_qtr_res_back.ascii

c  there are 48 quarters of data on each tape, so you need to figure
c  out which tape you need. 
      open(unit=10,
     *  file='/usr/compustat/pst_qtr.ascii',
     *  status='old',form='formatted',recl=9184)
      ncount=0


c  *****************************************************
c  DON'T CHANGE ANY OF THIS STUFF!
c  read header
      read(10,989) fileid,cutoff,create,ncomps,prev
  989 format(496x,i2,i6,i6,4x,i5,i6,8659x)
      write(*,*) ncomps,fileid,cutoff,create,prev
c  I think the first 3 records are header--but only the first record of
c  these has data
      read(10,'(9184x)')
      read(10,'(9184x)')
c  read records 1 through 12--or 48 quarters of data
  30  do 10 irec=1,12
c  since each record has 4 quarters, ioff is the quarter offset
      ioff=(irec-1)*4+1
      read(10,990,end=900) dnum,cnum,cic,rec,file,dup,coname,iname,
     *  ein,stk,smbl,zlist,xrel,fic,incorp,state,county,candxc,
     *  ((perdes(i,j),i=1,18),j=ioff,ioff+3),
     *  ((qftnt(i,j),i=1,8),j=ioff,ioff+3),
     *  ((data(i,j),i=1,232),j=ioff,ioff+3),
     *  ((aftnt(i,j),i=1,60),j=ioff,ioff+3)
c      write(*,*) cnum,' ',lcnum,' ',rec, ' ', irec
      if(cnum.eq.'000000')goto 900
      if(rec.eq.1) lcnum=cnum
      if(lcnum.ne.cnum.or.rec.ne.irec)then
        write(*,*)'warning will smith! cnum has changed in', 
     *  rec,irec,lcnum,cnum
        goto 900
      endif
      if(irec.eq.12)ncount=ncount+1
 990    format(i4,a6,i3,2x,3i2,2a28,a10,i1,a8,i2,i4,3i2,i3,i2,63x,
     *  4(i2,i1,2i2,2i1,i4,3i2,i3,2i2,i4,i5,i1,2i2,24x),
     *  4(8a2),
     *  4(f8.3,f10.3,5f8.3,f10.3,f8.3,f10.3,4f8.3,f10.3,f8.3,f10.6,
     *    f10.3,4f8.3,f10.3,f8.3,
     *    2f10.3,3f8.3,4f10.3,3f8.3,f10.3,3f8.3,5f10.3,3f8.3,
     *    3f10.3,2f8.3,f10.3,3f8.3,5f10.3,6f8.3,f10.3,3f8.3,f10.3,
     *    2f10.3,5f8.3,f10.3,3f8.3,f10.3,5f8.3,f10.3,3f8.3,
     *    5f8.3,f10.6,3f8.3,f10.3,2f8.3,2f10.3,f8.3,5f10.3,
     *    2f8.3,4f10.3,3f10.4,47f10.3,8f8.3,54f8.3),
     *    4(60a2))
c  for aftnt and data the items cycle fastest, then years, first data is oldest
  10  continue
c **********************************************************


c  done reading for one firm.  Insert processing code here







c  done processing data.  will go to next firm
c  ********************************************************
      goto 30
 900  write(*,*) 'ncount=',ncount,'ncomps=',ncomps
      stop
      end