program crcit
	character*1 crc(2)
	byte buffer(512)
	character*512 cbuffer
	equivalence (buffer,cbuffer)
	character*80 fname
5	write (*,1)
1	format(1x,'File to check:',$)
	read (*,2) fname
	if (fname(1:1).eq.' ') go to 999
2	format(a80)
	open(unit=1,status='old',access='direct',file=fname,recl=128)
	iblk=1
	jinit=0
10	read(1,rec=iblk,err=90) buffer
	call icrc(crc,cbuffer,512,jinit,-1)
	jinit=-1
	iblk=iblk+1
	go to 10
90	write(*,91) crc(2),crc(1),fname
	close(1)
91	format(1x,2z2,1x,a70)
	go to 5
999	continue
	end

	function icrc(crc,bufptr,len,jinit,jrev)
	implicit none
	integer icrc,jinit,jrev,len
	character*1 bufptr(*),crc(2)

	integer ich,init,ireg,j,icrctb(0:256),it(0:15),icrc1,ib1,ib2,ib3
	character*1 creg(4),rchr(0:255)
	save icrctb,rchr,init,it,ib1,ib2,ib3
	equivalence (creg,ireg)
	data it/0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15/, init /0/

	if (init.eq.0) then
	  init=1
	  ireg=256*(256*ichar('3')+ichar('2'))+ichar('1')
	  do j=1,4
	    if (creg(j).eq.'1') ib1=j
	    if (creg(j).eq.'2') ib2=j
	    if (creg(j).eq.'3') ib3=j
	  end do
	  do j=0,255
	    ireg=j*256
	    icrctb(j)=icrc1(creg,char(0),ib1,ib2,ib3)
	    ich=it(mod(j,16))*16+it(j/16)
	    rchr(j)=char(ich)
	  end do
	end if
	if (jinit.ge.0) then
	  crc(1)=char(jinit)
	  crc(2)=char(jinit)
	else if (jrev.lt.0) then
	  ich=ichar(crc(1))
	  crc(1)=rchr(ichar(crc(2)))
	  crc(2)=rchr(ich)
	end if
	do j=1,len
	  ich=ichar(bufptr(j))
	  if(jrev.lt.0) ich=ichar(rchr(ich))
	  ireg=icrctb(ieor(ich,ichar(crc(2))))
	  crc(2)=char(ieor(ichar(creg(ib2)),ichar(crc(1))))
	  crc(1)=creg(ib1)
	end do
	if (jrev.ge.0) then
	  creg(ib1)=crc(1)
	  creg(ib2)=crc(2)
	else
	  creg(ib2)=rchr(ichar(crc(1)))
	  creg(ib1)=rchr(ichar(crc(2)))
	  crc(1)=creg(ib1)
	  crc(2)=creg(ib2)
	end if
	icrc=ireg
	return
	end

	function icrc1(crc,onech,ib1,ib2,ib3)
	implicit none
	integer icrc1,ib1,ib2,ib3
	integer i,ichr,ireg
	character*1 onech,crc(4),creg(4)
	equivalence (creg,ireg)
	ireg=0
	creg(ib1)=crc(ib1)
	creg(ib2)=char(ieor(ichar(crc(ib2)),ichar(onech)))
	do i=1,8
	  ichr=ichar(creg(ib2))
	  ireg=ireg+ireg
	  creg(ib3)=char(0)
	  if(ichr.gt.127) ireg=ieor(ireg,4129)
	end do
	icrc1=ireg
	return
	end