program cmb implicit integer(a-z) byte mcrbuf(80), file1(40), file2(40), cmdbuf(76) dimension cbuf1(256), cbuf2(256) data filun1 / 2 / data filun2 / 3 / equivalence (cmdbuf, mcrbuf(5)) c c get the mcr command buffer c if cnt > 0, getmcr succeeded and cnt is command length c call getmcr(mcrbuf, cnt) c c see if interactive by seeing if c a command line was returned. c c if no command line passed, c get it interactively from the user. c else throw away program name from command line. c verbos = 1 10 continue if (cnt .lt. 4) then type 1000 1000 format('$CMB>') read (5, 1010, end=990) cnt,cmdbuf 1010 format(q, 76a1) if (cnt .lt. 0) go to 10 else cnt = cnt - 4 end if indx = 1 if (cmdbuf(indx) .eq. '-') then if (cmdbuf(indx+1) .eq. 'M' .or. * cmdbuf(indx+1) .eq. 'm') then verbos = 0 indx = indx + 3 endif else if (cmdbuf(indx) .eq. '?') then go to 810 endif c c Fetch file #1 while searching for equal sign; c if none found - syntax error. c i = 1 do 20 indx = indx, cnt if (cmdbuf(indx) .eq. '=') go to 30 file1(i) = cmdbuf(indx) i = i + 1 20 continue go to 800 30 continue indx = indx + 1 i = 1 do 40 indx = indx, cnt file2(i) = cmdbuf(indx) i = i + 1 40 continue if (verbos .eq. 1) then write (5, 999) file1, file2 999 format(1x,'Comparing ',40a1,' to ',40a1) endif if (i .eq. 1) go to 800 open (unit=filun1, status='old', err=790, file=file1, * access='sequential', form='unformatted', * recordtype='fixed', * blocksize=2048, * readonly, shared) call bugmsg ('File 1 open successful.') open (unit=filun2, status='old', err=790, file=file2, * access='sequential', form='unformatted', * recordtype='fixed', * blocksize=2048, * readonly, shared) call bugmsg ('File 2 open successful.') exstat = 0 block = 1 do 150 r=1,4000 read (filun1, end=200, err=770) cbuf1 read (filun2, end=210, err=780) cbuf2 block = block + 1 do 100 i=1,256 if (cbuf1(i) .ne. cbuf2(i)) then exstat = exstat + 1 call bugmsg('Miscompare block, f1, f2 = ', * block, cbuf1(i), cbuf2(i)) if (exstat .gt. 2000) go to 900 endif 100 continue 150 continue C C No EOF encountered after 4000 blocks. C exstat = -4 go to 900 C C File #1 EOF encountered; C make sure File #2 is at EOF. C 200 continue if (exstat .ne. 0) go to 900 read (filun2, end=900, err=780) cbuf2 C C Length mismatch. C 210 continue if (exstat .eq. 0) exstat = -2 go to 900 C C File read error. C 770 continue call bugmsg ('*** File 1 read error. ***') go to 790 780 continue call bugmsg ('*** File 2 read error. ***') C C Open error for either file. C 790 continue exstat = -1 go to 900 800 continue type * type *,' Invalid command line, format:' 810 continue type * type *,' CMB [-M] FILE1.DAT=FILE2.DAT' type *,' optional -M disables any messages.' type *,' exit status returned as follows:' type *,' -4 = No EOF after 4000 blocks' type *,' -3 = Command line syntax error' type *,' -2 = file length mismatch' type *,' -1 = file open or read error' type *,' 1 = files compared successfully' type *,' >1 = number or miscompares(+1) up to 2000' type * exstat = -3 go to 990 C C Close both files and exit. C 900 continue close (unit=filun1) close (unit=filun2) 990 continue if (exstat .eq. 0) then exstat = 1 else if (exstat .gt. 0) then exstat = exstat + 1 endif call bugmsg ('Exit status = ', exstat) if (verbos .ne. 0) then if (exstat .eq. 1) then write (5, 1050) 1050 format(1x,'Files compared successfully.') else if (exstat .gt. 1) then write (5, 1060) exstat-1 1060 format(1x,'*** Number of miscompares = ',I6) endif endif call exst(exstat) end