Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,51 @@
+      FUNCTION icrc(crc,bufptr,len,jinit,jrev)
+      INTEGER icrc,jinit,jrev,len
+      CHARACTER*1 bufptr(*),crc(2)
+CU    USES icrc1
+      INTEGER ich,init,ireg,j,icrctb(0:255),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 11 j=1,4
+          if (creg(j).eq.'1') ib1=j
+          if (creg(j).eq.'2') ib2=j
+          if (creg(j).eq.'3') ib3=j
+11      continue
+        do 12 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)
+12      continue
+      endif
+      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)
+      endif
+      do 13 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)
+13    continue
+      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)
+      endif
+      icrc=ireg
+      return
+      END