program getann c this program reads the binary- direct access annual compustat tape c and also the index and provides an interactive way to get data off c of the file 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 character*1 answer c***************************************************************** write(*,*) 'An interactive way to access compustat data' 10 write(*,*) 'Enter the file id number' write(*,*) 'first digit is 1=pst 2=fcotc 3 = merged research' write(*,*) 'second digit is 0=current 1=backdata 2=waybackdata' write(*,*) 'for example 10 is pst current data' read(*,'(i2)') fid if(fid.lt.10.or.fid.gt.32)goto 10 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 11 is pst backdata. 30 is merged research current data call cstopen(fid) call readidx(ncomps) 30 write(*,*) 'input cusip number or type stop to stop' read(*,'(a6)') incus if(incus.eq.'stop')goto 900 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) write(*,*) 'found cusip ',cnum, ' with company name ',coname write(*,*) 'At most 20 years of data are available. The index' write(*,*) 'year and the actual years and fyr end are:' write(*,*) write(*,'(a5,20(1x,i2))') 'Index',(i,i=1,20) write(*,'(a4,1x,20(1x,i2))') 'Year',(yeara(i),i=1,20) write(*,'(a3,2x,20(1x,i2))') 'FYR',(fyr(i),i=1,20) write(*,*) 'a FYR of 0 means there is no data for that year' write(*,*) 40 write(*,*) 'Input the data item you want and the index year' write(*,*) 'separated by a comma. Data <= 350 year <=20 ' write(*,*) 'or zeros to pick another cusip' 45 read(*,*) idata,iyr if(idata.eq.0) goto 30 if(idata.le.0.or.idata.gt.350.or.iyr.le.0.or.iyr.gt.20)goto 40 write(*,998) 'Item',idata,'Year',yeara(iyr), 'data', * data(idata,iyr) 998 format(a4,1x,i3,1x,a4,1x,i2,1x,a4,1x,f10.3) goto 45 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