FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 1   

COMPAR.FTN   	/TR:BLOCKS/WR


        C

        C

        C	COMPAR - COMPARE THE FILES

        C

        C

        C	COPYRIGHT (C) 1976

        C	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

        C

        C	THIS SOFTWARE IS FURNISHED UNDER  A LICENSE FOR USE ONLY  ON  A

        C	SINGLE COMPUTER SYSTEM AND MAY BE  COPIED ONLY WITH  THE INCLU-

        C	SION OF  THE  ABOVE  COPYRIGHT NOTICE.  THIS SOFTWARE,  OR  ANY

        C	OTHER COPIES THEREOF, MAY NOT BE  PROVIDED  OR  OTHERWISE  MADE

        C	AVAILABLE TO ANY OTHER PERSON EXCEPT  FOR  USE  ON  SUCH SYSTEM

        C	AND TO  ONE WHO AGREES  TO  THESE LICENSE  TERMS.  TITLE TO AND

        C	OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.

        C

        C	THE INFORMATION IN THIS SOFTWARE  IS  SUBJECT TO CHANGE WITHOUT

        C	NOTICE AND SHOULD NOT BE CONSTRUED  AS  A COMMITMENT BY DIGITAL

        C	EQUIPMENT CORPORATION.

        C

        C	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS

        C	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

        C	COPYRIGHT (C) 1976

        C	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

        C

        C

        C

        C	K.D. MORSE  23-NOV-76

        C

        C

        C	THIS ROUTINE COMPARES THE INPUT-FILE AND THE COMPARE-FILE,

        C	CREATING A MAP FILE.

        C

        C

        C

        C  MODIFICATIONS:

        C

        C NO		DATE		PROGRAMMER		PURPOSE

        C --		----		----------		-------

        C

        C

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 2   

COMPAR.FTN   	/TR:BLOCKS/WR


         

        C

        C  VARIABLES:

        C

        C	CLUN--LOGICAL UNIT NUMBER FOR OPENING COMPARE FILE CHANNEL

        C	CMAT--ARRAY TO HOLD RECORD NUMBERS WHILE TESTING FOR A MATCH

        C	CMRK1--RECORD NUMBER OF THE COMPARE FILE RECORD FOLLOWING THE

        C		 LAST COMPARE RECORD MATCHED

        C	CMRK2--RECORD NUMBER OF THE FIRST COMPARE FILE RECORD OF 

        C		THE SET BEING TESTED FOR A MATCH

        C	CNMLNG--LENGTH OF THE COMPARE FILE SPECIFICATION

        C	COMCHR--ASCII CHARACTER FOR DELIMITING COMMENTS

        C	COMNAM--COMPARE FILE SPECIFICATION

        C	COMREC--I/O BUFFER FOR COMPARE FILE RECORDS

        C	CRECNM--CURRENT COMPARE FILE RECORD NUMBER

        C	CSTAT--INDICATOR OF TYPE OF CLOSE FOR COMPARE FILE LUN

        C	CSUB--RECORD NUMBER OF THE COMPARE RECORD BEING CURRENTLY EXAMINED

        C	CTYPE--TYPE OF OPEN FOR COMPARE FILE (0=INPUT, 1=OUTPUT)

        C	IDIF--COUNTER FOR NUMBER OF UNMATCHED INPUT FILE RECORDS

        C	IERR1--ERROR INDICATOR FROM FORTRAN ROUTINES

        C	IERR2--ERROR INDICATOR FROM MACRO ROUTINES

        C	ILUN--LOGICAL UNIT NUMBER FOR OPENING INPUT FILE CHANNEL

        C	IMAT--ARRAY TO HOLD RECORD NUMBERS WHILE TESTING FOR A MATCH

        C	IMRK1--RECORD NUMBER OF THE INPUT FILE RECORD FOLLOWING

        C		THE LAST RECORD MATCHED

        C	INMLNG--LENGTH OF THE INPUT FILE SPECIFICATION

        C	INPNAM--ASCII INPUT FILE SPECIFICATION

        C	IRECNM--CURRENT INPUT FILE RECORD NUMBER

        C	IRECSZ--NUMBER OF CHARACTERS IN AN I/O BUFFER

        C	ISTAT--INDICATOR OF TYPE OF CLOSE FOR INPUT FILE CHANNEL

        C	ISUB--RECORD NUMBER OF THE INPUT RECORD BEING CURRECNTLY EXAMINED

        C	ISWTCH--VALUE OF SWITCHES SPECIFIED WITH INPUT FILE SPECIFICATION

        C	ITRIED--NUMBER OF RECORDS SEARCHED TO MATCH CURRENT INPUT RECORD

        C	ITYPE--TYPE OF OPEN FOR INPUT FILE (0=INPUT, 1=OUTPUT)

        C	LENCOM--LENGTH OF COMPARE FILE RECORD

        C	LENINP--LENGTH OF INPUT FILE RECORD

        C	LENXTC--LENGTH OF COMPARE FILE RECORD IN A MATCH COMPARE

        C	LENXTI--LENGTH OF INPUT FILE RECORD IN A MATCH COMPARE

        C	LSTCOM--RECORD NUMBER OF LAST COMPARE FILE RECORD

        C	LSTINP--RECORD NUMBER OF THE LAST INPUT FILE RECORD

        C	LSTMAT--LAST RECORD MATCHED BETWEEN THE TWO FILES

        C	MAP--MAPPING TABLE OF COMPARE FILE RECORDS ONTO INPUT FILE

        C		RECORDS, AND INPUT FILE RECORDS ONTO COMPARE FILE RECORDS

        C	MAPEND--RECORD NUMBER OF LAST RECORD THAT CAN BE MAPPED IN

        C		THE MAP TABLE

        C	MAPNAM--NAME OF MAP FILE

        C	MAPTOP--RECORD NUMBER OF THE FIRST RECORD THAT CAN BE MAPPED IN

        C		THE MAP TABLE

        C	MATCHD--NUMBER OF RECORDS IN THE CURRENT SEQUENTIAL MATCH

        C	MATSIZ--NUMBER OF RECORDS TO A MATCH

        C	MAXDIF--MAXIMUM NUMBER OF UNMATCHED INPUT FILE RECORDS TO FIND

        C	MLUN--MAP FILE LUN

        C	MNMLNG--LENGTH OF MAP FILE NAME

        C	NSWVAL--ARRAY HOLDING VALUES TO TEST SWITCHES AGAINST

        C	NUMLIN--MAXIMUM NUMBER OF RECORDS PER FILE THAT CAN BE HELD IN

        C		THE MAP TABLE

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 3   

COMPAR.FTN   	/TR:BLOCKS/WR


        C	NXTCOM--I/O BUFFER FOR COMPARE FILE RECORDS WITHIN A MATCH

        C	NXTCRC--NEXT COMPARE RECORD NUMBER

        C	NXTIRC--NEXT INPUT RECORD NUMBER

        C	NXTREC--I/O BUFFER FOR INPUT FILE RECORDS CONSTITUTING A MATCH

        C	ODFLNG--LENGTH OF THE DEFAULT OUTPUT FILENAME

        C	OLUN--LOGICAL UNIT NUMBER FOR OPENING OUTPUT FILE CHANNEL

        C	ONMLNG--LENGTH OF THE OUTPUT FILE SPECIFICATION

        C	OPNLNG--LENGTH OF ASCII STRING "OPEN"

        C	OSTAT--STATUS OF TYPE OF CLOSE FOR OUTPUT FILE CHANNEL

        C	OSWTCH--VALUE OF SWITCHES SPECIFIED WITH OUTPUT FILE SPECIFICATION

        C	OUTMOD--MODE OF OUTPUT REQUESTED, I.E., ASCII, OCTAL, OR HEXADECIMAL

        C	OUTNAM--OUTPUT FILE SPECIFICATION

        C	RECORD--I/O BUFFER

        C	WINDOW--NUMBER OF RECORDS IN A MATCH WINDOW, I.E., THE NUMBER OF

        C		COMPARE FILE RECORDS TO SEARCH TRYING TO MATCH ONE RECORD

        C

        C

        C

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 4   

COMPAR.FTN   	/TR:BLOCKS/WR


         

0001    	SUBROUTINE COMPAR

         

         

0002    	COMMON MAP(100,2),NUMLIN,MAPTOP(2),LSTMAP(2),MLUN,IHOLD(30,2),

        	1NINCOR,IFREE(2),IFIRST(2),LAST(2),MAXBUF,BUFR,ISWTCH,

        	2COMCHR,NSWVAL(10),LSTMAT(2),IRECSZ,MRKPNT(4,2),

        	3INOUT,MAPEND(2),LINSIZ,MAPNAM,MNMLNG,MTYPE,MSTAT

        	4,IERR1,IERR2,IKIND,OLUN,MAPMRK(3,2),MPRINT,BARCHR

        C

        C

0003    	COMMON /INIT/  BARFIL,CDFLNG,CLUN,CNMLNG,COMREC,COMNAM,

        	1COPIES,CSTAT,CTYPE,ILUN,INMLNG,INPNAM,ISTAT,ITTY,ITYPE,

        	2LENCOM,LENINP,MATSIZ,NUMISW,NUMOSW,ONMLNG,OSTAT,OSWTCH,

        	3MAXDIF,LINNUM,

        	4OTYPE,OUTMOD,OUTNAM,PROMPT,RECORD,VERLNG,WINDOW,SWTABL,VERSON

         

0004    	INTEGER CNMLNG,ONMLNG,CDFLNG

0005    	INTEGER OSWTCH,CSWTCH,PROLNG,CLUN,OLUN,OSTAT,CSTAT

0006    	INTEGER CTYPE,OTYPE,VERLNG

0007    	INTEGER CRECNM,CSUB,WINDOW

0008    	INTEGER CMRK1,CMRK2,IMRK1,BARFIL

0009    	INTEGER COPIES,IMAT(20),CMAT(20)

0010    	INTEGER MOUT(101)

0011    	BYTE BUFR(7680,2),COMCHR(16)

0012    	BYTE BARCHR,OUTMOD(3)

0013    	BYTE RECORD(512),COMREC(512),NXTREC(512),NXTCOM(512)

0014    	BYTE OUTNAM(42),INPNAM(42),COMNAM(42),MAPNAM(12)

0015    	BYTE VERSON(5),NOBYTE

0016    	BYTE PROMPT(5),SWTABL(75)

         

         

0017    281	FORMAT(<NUMLIN+1>I5)

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 5   

COMPAR.FTN   	/TR:BLOCKS/WR


         

        C

        C	NOW INITIALIZE POINTERS TO RECORDS.

        C

0018    	IDIF=0

0019    	LSTINP=0

0020    	LSTCOM=0

0021    	IRECNM=0

0022    	CRECNM=0

0023    	MATCHD=0

0024    	CALL INIT

0025    	MAPEND(1)=NUMLIN

0026    	MAPEND(2)=NUMLIN

        C

        C	FILL THE BUFFERS WITH INPUT AND COMPARE FILE RECORDS.

        C

0027    	CALL FILBUF(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,ITYPE)

0028    	IF (IERR1 .LT. 0) GOTO 10000

0029    	CALL FILBUF(CLUN,COMREC,LENCOM,CSTAT,COMNAM,CNMLNG,CTYPE)

0030    	IF (IERR1 .LT. 0) GOTO 10000

        C

        C	OPEN A TEMPORARY FILE TO HOLD MAPPING VALUES.

        C

0031    	CALL OPNFIL(MAPNAM,MNMLNG,MLUN,RECORD,IRECSZ,MTYPE,IERR2)

0032    	IF (IERR2 .LE. 0) GOTO 9050

0033    	MTYPE=0

0034    	GOTO 600

        C

        C	SUCCESSIVE RECORDS DID NOT MATCH.  NO FULL MATCH HERE.

        C

0035    520	CRECNM=CMRK2

0036    	MATCHD=0

0037    	IF (CRECNM .EQ. 0) GOTO 800

0038    	GOTO 650

0039    525	IERR1=1

0040    	CRECNM=CMRK1

0041    	IF (CRECNM .EQ. 0) GOTO 800

        C

        C	RECORDS DID NOT MATCH.  RESET COUNTER OF CURRENT NUMBER OF MATCHES.

        C

0042    530	MATCHD=0

0043    	CRECNM=CRECNM+1

0044    	GOTO 650

        C

        C	MORE THAN A FULL MATCH.  JUST SET TABLES AND READ NEXT LINES.

        C

0045    540	CALL MAPREC(ILUN,IRECNM,CRECNM)

0046    	IF (IERR1 .LT. 0) GOTO 10000

0047    	CALL MAPREC(CLUN,CRECNM,IRECNM)

0048    	IF (IERR1 .LT. 0) GOTO 10000

        C

        C	START SEARCHING FOR A MATCH FOR AN INPUT RECORD.

        C

0049    600	LSTMAT(2)=CRECNM

0050    	ITRIED=0

0051    	GOTO 610

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 6   

COMPAR.FTN   	/TR:BLOCKS/WR


0052    605	CALL MAPREC(ILUN,IRECNM,-1)

0053    	IF (IERR1 .LT. 0) GOTO 10000

0054    610	LSTMAT(1)=IRECNM

0055    	IRECNM=IRECNM+1

0056    620	CALL GETLIN(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,

        	1ITYPE,IRECNM)

0057    	IF (IRECNM .EQ. 0) GOTO 900

0058    	LSTINP=IRECNM

0059    	IF (IERR1 .LT. 0) GOTO 10000

0060    	IMRK1=IRECNM+1

0061    	IF (((ISWTCH .AND. NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((RECORD(1) .EQ. COMCHR(1)) .OR. (RECORD(1) .EQ. COMCHR(3))

        	2 .OR. (RECORD(1) .EQ. COMCHR(5))

        	3 .OR. (RECORD(1) .EQ. COMCHR(7)))) GOTO 605	!++06 MUL. COMCHRS

0062    	IF (((ISWTCH .AND. NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENINP .EQ. 0)) GOTO 605

        C

        C	MARK COMPARE FILE HERE AS THIS IS FIRST RECORD OF THIS SEARCH.

        C

0063    640	CRECNM=CRECNM+1

0064    	CMRK1=CRECNM

0065    	IF (CRECNM.EQ.0) GOTO 660

0066    	GOTO 650

0067    645	CALL MAPREC(CLUN,CRECNM,-1)

0068    	IF (IERR1 .LT. 0) GOTO 10000

0069    649	CRECNM=CRECNM+1

0070    650	CALL GETLIN(CLUN,COMREC,LENCOM,CSTAT,COMNAM,CNMLNG,

        	1CTYPE,CRECNM)

0071    	IF (CRECNM.EQ.0) GOTO 660

0072    	LSTCOM=CRECNM

0073    	IF (IERR1 .LT. 0) GOTO 10000

        C

        C	CHECK IF DIF HAS SEARCHED A COMPLETE WINDOW'S WORTH OF

        C	RECORDS.  IF SO, GET NEXT INPUT-FILE RECORD.

        C

0074    	IF (ITRIED .GT. WINDOW) GOTO 660

0075    	IF (MAP(CRECNM-MAPTOP(2)+1,2) .LT. 0) GOTO 649

0076    	IF (((ISWTCH.AND.NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((COMREC(1) .EQ. COMCHR(1)) .OR. (COMREC(1) .EQ. COMCHR(3))

        	2 .OR. (COMREC(1) .EQ. COMCHR(5))

        	3 .OR. (COMREC(1) .EQ. COMCHR(7)))) GOTO 645

0077    	IF (((ISWTCH.AND.NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENCOM .EQ. 0)) GOTO 645

0078    	ITRIED=ITRIED+1

0079    	GOTO 690

        C

        C	EOF OF COMPARE FILE.  REOPEN FILE TO LAST MATCH.

        C

0080    660	CRECNM=CMRK1

0081    	IF (CRECNM.EQ.0) GOTO 800

0082    	ITRIED=0

        C

        C	STARTING HERE FOR NEXT COMPARE.

        C

0083    	GOTO 670

0084    665	CALL MAPREC(CLUN,CRECNM,-1)

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 7   

COMPAR.FTN   	/TR:BLOCKS/WR


0085    	IF (IERR1 .LT.0) GOTO 10000

0086    669	CRECNM=CRECNM+1

0087    670	CALL GETLIN(CLUN,COMREC,LENCOM,CSTAT,COMNAM,CNMLNG,

        	1CTYPE,CRECNM)

0088    	IF (CRECNM .EQ. 0) GOTO 800

0089    	LSTCOM=CRECNM

0090    	IF (IERR1 .LT. 0) GOTO 10000

0091    	IF (MAP(CRECNM-MAPTOP(2)+1,2) .LT. 0) GOTO 669

0092    	IF (((ISWTCH.AND.NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((COMREC(1) .EQ. COMCHR(1)) .OR. (COMREC(1) .EQ. COMCHR(3))

        	2 .OR. (COMREC(1) .EQ. COMCHR(5))

        	3 .OR. (COMREC(1) .EQ. COMCHR(7)))) GOTO 665	!++06 MUL. COMCHRS

0093    	IF (((ISWTCH.AND.NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENCOM .EQ. 0)) GOTO 665

0094    	ITRIED=ITRIED+1

0095    	GOTO 680

        C

        C	NOT EOF AGAIN, SO STILL HAVE UNMATCHED COMPARE RECORDS.

        C	GET NEXT INPUT RECORD AS LAST HAD NO MATCH.

        C

0096    675	CALL MAPREC(ILUN,IRECNM,-1)

0097    	IF (IERR1 .LT. 0) GOTO 10000

0098    680	LSTMAT(1)=IRECNM

0099    	IRECNM=IRECNM+1

        C

        C	CHECK IF DIF FOUND THE MAXIMUM UNMATCHED INPUT RECORDS ALLOWED.

        C

0100    	IDIF=IDIF+1

0101    	IF ((MAXDIF .GT. 0) .AND. (IDIF .GE. MAXDIF)) GOTO 1000

0102    	CALL GETLIN(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,

        	1ITYPE,IRECNM)

0103    	IF (IRECNM .EQ. 0) GOTO 900

0104    	LSTINP=IRECNM

0105    	IF (IERR1 .LT. 0) GOTO 10000

0106    	IF (((ISWTCH .AND. NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((RECORD(1) .EQ. COMCHR(1)) .OR. (RECORD(1) .EQ. COMCHR(3))

        	2 .OR. (RECORD(1) .EQ. COMCHR(5))

        	3 .OR. (RECORD(1) .EQ. COMCHR(7)))) GOTO 675	!++06 MUL. COMCHRS

0107    	IF (((ISWTCH .AND. NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENINP .EQ. 0)) GOTO 675

0108    	IMRK1=IRECNM+1

0109    690	CMRK2=CRECNM+1

        C

        C	LOOP TO MATCH INPUT FILE TO COMPARE FILE.

        C

0110    710	IF (LENINP.NE.LENCOM) GOTO 530

0111    	IF (LENINP .EQ. 0) GOTO 723

0112    	DO 720 I=1,LENINP

0113    720	IF (RECORD(I) .NE. COMREC(I)) GOTO 530

        C

        C	ONE RECORD MATCHED.  CHECK REST OF LINES CONSTITUTING A MATCH.

        C

0114    723	MATCHD=MATCHD+1

0115    	IF (MATCHD.GT.MATSIZ) GOTO 540

0116    	IMAT(MATSIZ)=IRECNM

0117    	CMAT(MATSIZ)=CRECNM

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 8   

COMPAR.FTN   	/TR:BLOCKS/WR


0118    	CSUB=CRECNM

0119    	ISUB=IRECNM

0120    	DO 760 J=1,MATSIZ-1

0121    	GOTO 730

0122    725	ISUB=ISUB+1

0123    730	NXTIRC=ISUB+J

0124    	CALL GETLIN(ILUN,NXTREC,LENXTI,ISTAT,INPNAM,INMLNG,

        	1ITYPE,NXTIRC)

0125    	IF (NXTIRC .EQ. 0) GOTO 900

0126    	LSTINP=NXTIRC

0127    	IF (IERR1 .EQ. -14) GOTO 9695

0128    	IF (IERR1 .LT. 0) GOTO 10000

0129    	IF (((ISWTCH .AND. NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((NXTREC(1) .EQ. COMCHR(1)) .OR. (NXTREC(1) .EQ. COMCHR(3))

        	2 .OR. (NXTREC(1) .EQ. COMCHR(5))

        	3 .OR. (NXTREC(1) .EQ. COMCHR(7)))) GOTO 725	!++06 MUL. COMCHRS

0130    	IF (((ISWTCH .AND. NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENXTI .EQ. 0)) GOTO 725

0131    	GOTO 740

0132    735	CSUB=CSUB+1

0133    740	NXTCRC=CSUB+J

0134    	CALL GETLIN(CLUN,NXTCOM,LENXTC,CSTAT,COMNAM,CNMLNG,

        	1CTYPE,NXTCRC)

0135    	IF (NXTCRC.EQ.0) GOTO 525

0136    	LSTCOM=NXTCRC

0137    	IF (IERR1 .EQ. -22) GOTO 9735

0138    	IF (IERR1 .LT. 0) GOTO 10000

0139    	IF (((ISWTCH.AND.NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((NXTCOM(1) .EQ. COMCHR(1)) .OR. (NXTCOM(1) .EQ. COMCHR(3))

        	2 .OR. (NXTCOM(1) .EQ. COMCHR(5))

        	3 .OR. (NXTCOM(1) .EQ. COMCHR(7)))) GOTO 735	!++06 MUL. COMCHRS

0140    	IF (((ISWTCH.AND.NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENXTC .EQ. 0)) GOTO 735

0141    	IF (LENXTI.NE.LENXTC) GOTO 520

0142    	IF (LENXTI.EQ.0) GOTO 755

0143    	DO 750 I=1,LENXTI

0144    750	IF (NXTREC(I).NE.NXTCOM(I)) GOTO 520

0145    755	MATCHD=MATCHD+1

0146    	IMAT(MATSIZ-J)=ISUB+J

0147    	CMAT(MATSIZ-J)=CSUB+J

0148    760	CONTINUE

        C

        C	GOT A MATCH.  SET MAP TABLES.

        C

0149    	DO 790 I=IMAT(MATSIZ),IMAT(1)

0150    	DO 770 J=MATSIZ,1,-1

0151    770	IF (I .EQ. IMAT(J)) GOTO 780

0152    	CALL MAPREC(ILUN,I,-1)

0153    	IF (IERR1 .LT. 0) GOTO 10000

0154    	GOTO 790

0155    780	CALL MAPREC(ILUN,IMAT(J),CMAT(J))

0156    	IF (IERR1 .LT. 0) GOTO 10000

0157    	CALL MAPREC(CLUN,CMAT(J),IMAT(J))

0158    	IF (IERR1 .LT. 0) GOTO 10000

0159    790	CONTINUE

0160    	DO 795 I=CMAT(MATSIZ),CMAT(1)

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 9   

COMPAR.FTN   	/TR:BLOCKS/WR


0161    	IF (MAP(I-MAPTOP(2)+1,2) .LT. 0) GOTO 795

0162    	DO 794 J=MATSIZ,1,-1

0163    794	IF (I .EQ. CMAT(J)) GOTO 795

0164    	CALL MAPREC(CLUN,I,-1)

0165    	IF (IERR1 .LT. 0) GOTO 10000

0166    795	CONTINUE

0167    	IRECNM=IMAT(1)

0168    	CRECNM=CMAT(1)

0169    	GOTO 600

        C

        C	THE COMPARE FILE ENDED.

        C	REMOVE ALL COMMENT, BLANK, AND FORMFEED RECORDS FROM REST OF

        C	INPUT FILE IF COMPARISON OF THEM IS NOT DESIRED.

        C

0170    800	IRECNM=IRECNM+1

0171    	CALL GETLIN(ILUN,RECORD,LENINP,ISTAT,INPNAM,INMLNG,

        	1ITYPE,IRECNM)

0172    	IF (IRECNM .EQ. 0) GOTO 1000

0173    	LSTINP=IRECNM

0174    	LSTMAT(1)=IRECNM

0175    	IF (IERR1 .LT. 0) GOTO 10000

0176    	IF (((ISWTCH .AND. NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((RECORD(1) .EQ. COMCHR(1)) .OR. (RECORD(1) .EQ. COMCHR(3))

        	2 .OR. (RECORD(1) .EQ. COMCHR(5))

        	3 .OR. (RECORD(1) .EQ. COMCHR(7)))) GOTO 810	!++06 MUL. COMCHRS

0177    	IF (((ISWTCH .AND. NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENINP .EQ. 0)) GOTO 810

0178    	GOTO 800

0179    810	CALL MAPREC(ILUN,IRECNM,-1)

0180    	IF (IERR1 .LT. 0) GOTO 10000

0181    	GOTO 800

        C

        C	THE INPUT FILE ENDED.

        C	REMOVE ALL COMMENT, BLANK, AND FORMFEED RECORDS FROM REST OF

        C	COMPARE FILE IF COMPARISON OF THEM IS NOT DESIRED.

        C

0182    900	CRECNM=CRECNM+1

0183    	CALL GETLIN(CLUN,COMREC,LENCOM,CSTAT,COMNAM,CNMLNG,

        	1CTYPE,CRECNM)

0184    	IF (CRECNM .EQ. 0) GOTO 1000

0185    	LSTCOM=CRECNM

0186    	LSTMAT(2)=CRECNM

0187    	IF (IERR1 .LT. 0) GOTO 10000

0188    	IF (((ISWTCH.AND.NSWVAL(2)) .EQ. NSWVAL(2)) .AND.

        	1((COMREC(1) .EQ. COMCHR(1)) .OR. (COMREC(1) .EQ. COMCHR(3))

        	2 .OR. (COMREC(1) .EQ. COMCHR(5))

        	3 .OR. (COMREC(1) .EQ. COMCHR(7)))) GOTO 910	!++06 MUL. COMCHRS

0189    	IF (((ISWTCH.AND.NSWVAL(4)) .EQ. NSWVAL(4)) .AND.

        	1(LENCOM .EQ. 0)) GOTO 910

0190    	GOTO 900

0191    910	CALL MAPREC(CLUN,CRECNM,-1)

0192    	IF (IERR1 .LT. 0) GOTO 10000

0193    	GOTO 900

        C

        C	MAP PAST THE LAST RECORD IN THE FILE TO FORCE THE OUTPUT OF ALL

        C	BUT THE LAST SET OF VALUES IN THE MAP TABLE.  THEN OUTPUT THE

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 10  

COMPAR.FTN   	/TR:BLOCKS/WR


        C	LAST TABLE OF DATA.  CLOSE ALL FILES EXCEPT THE OUTPUT FILE.

        C

0194    1000	CALL MAPREC(ILUN,LSTINP+1,-2)

0195    	IF (IERR1 .LT. 0) GOTO 1005

0196    	CALL MAPREC(CLUN,LSTCOM+1,-2)

0197    	IF (IERR1 .LT. 0) GOTO 1005

0198    	LSTMAP(1)=LSTMAP(1)-1

0199    	LSTMAP(2)=LSTMAP(2)-1

0200    1005	CALL CLSFIL(CLUN,CSTAT,IERR2)

0201    	IF (IERR2.LE.0) GOTO 9650

0202    	CALL CLSFIL(ILUN,ISTAT,IERR2)

0203    	IF (IERR2.LE.0) GOTO 9630

0204    	DO 1020 I=1,2

0205    	IF (LSTMAP(I)-MAPTOP(I)+1 .LE. 0) GOTO 1020

0206    	LENGTH=1+LSTMAP(I)-MAPTOP(I)

0207    	MOUT(1)=I

0208    	DO 1010 J=1,LENGTH

0209    1010	MOUT(J+1)=MAP(J,I)

0210    	LENGTH=2*(LENGTH+1)

0211    	CALL PUTREC(MLUN,MOUT,IRECSZ,LENGTH,IERR2)

0212    	IF (IERR2 .LE. 0) GOTO 10000

0213    1020	CONTINUE

0214    	CALL CLSFIL(MLUN,MSTAT,IERR2)

0215    	IF (IERR2 .LE. 0) GOTO 9070

0216    	RETURN

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 11  

COMPAR.FTN   	/TR:BLOCKS/WR


         

        C

        C

        C	FILE COMPARE ERRORS

        C

        C

        C

0217    9050	IERR1=-24

0218    	GOTO 10000

0219    9060	IERR1=-26

0220    	GOTO 10000

0221    9070	IERR1=-25

0222    	GOTO 10000

        C

        C

        C

        C	MACRO ROUTINE ERRORS

        C

        C

        C

        C	CLOSE ERRORS

        C

        C

        C

        C	ON INPUT FILE

        C

0223    9630	IERR1=-13

0224    	GOTO 10000

        C

        C	ON COMPARE FILE

        C

0225    9650	IERR1=-21

0226    	GOTO 10000

        C

        C

        C

        C	READ/WRITE ERRORS

        C

        C

        C	ON INPUT FILE

        C

0227    9695	RECORD(1)=NXTREC(1)

0228    	LENINP=LENXTI

0229    	GOTO 10000

        C

        C	ON COMPARE FILE

        C

0230    9735	COMREC(1)=NXTREC(1)

0231    	LENCOM=LENXTC

0232    	GOTO 10000

0233    10000	RETURN

0234    	END

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 12  

COMPAR.FTN   	/TR:BLOCKS/WR


PROGRAM SECTIONS



NUMBER	 NAME	    SIZE		ATTRIBUTES



  1	$CODE1	004676  1247		RW,I,CON,LCL

  2	$PDATA	000010     4		RW,D,CON,LCL

  3	$IDATA	000356   119		RW,D,CON,LCL

  4	$VARS	002506   675		RW,D,CON,LCL

  5	$TEMPS	000010     4		RW,D,CON,LCL

  6	.$$$$.	037222  8009		RW,D,OVR,GBL

  7	INIT	002410   644		RW,D,OVR,GBL





ENTRY POINTS



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 COMPAR	      1-000000





VARIABLES



 NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS    NAME   TYPE  ADDRESS   



 BARCHR	L*1   6-037220	 BARFIL	I*2   7-000000	 CDFLNG	I*2   7-000002	 CLUN	I*2   7-000004	 CMRK1	I*2   4-000010

 CMRK2	I*2   4-000012	 CNMLNG	I*2   7-000006	 COPIES	I*2   7-001062	 CRECNM	I*2   4-000004	 CSTAT	I*2   7-001064

 CSUB	I*2   4-000006	 CSWTCH	I*2   4-000000	 CTYPE	I*2   7-001066	 I	I*2   4-002466	 IDIF	I*2   4-002452

 IERR1	I*2   6-037172	 IERR2	I*2   6-037174	 IKIND	I*2   6-037176	 ILUN	I*2   7-001070	 IMRK1	I*2   4-000014

 INMLNG	I*2   7-001072	 INOUT	I*2   6-037140	 IRECNM	I*2   4-002460	 IRECSZ	I*2   6-037116	 ISTAT	I*2   7-001146

 ISUB	I*2   4-002470	 ISWTCH	I*2   6-037044	 ITRIED	I*2   4-002464	 ITTY	I*2   7-001150	 ITYPE	I*2   7-001152

 J	I*2   4-002472	 LENCOM	I*2   7-001154	 LENGTH	I*2   4-002504	 LENINP	I*2   7-001156	 LENXTC	I*2   4-002502

 LENXTI	I*2   4-002476	 LINNUM	I*2   7-001176	 LINSIZ	I*2   6-037146	 LSTCOM	I*2   4-002456	 LSTINP	I*2   4-002454

 MATCHD	I*2   4-002462	 MATSIZ	I*2   7-001160	 MAXBUF	I*2   6-001042	 MAXDIF	I*2   7-001174	 MLUN	I*2   6-000632

 MNMLNG	I*2   6-037164	 MPRINT	I*2   6-037216	 MSTAT	I*2   6-037170	 MTYPE	I*2   6-037166	 NINCOR	I*2   6-001024

 NOBYTE	L*1   4-002450	 NUMISW	I*2   7-001162	 NUMLIN	I*2   6-000620	 NUMOSW	I*2   7-001164	 NXTCRC	I*2   4-002500

 NXTIRC	I*2   4-002474	 OLUN	I*2   6-037200	 ONMLNG	I*2   7-001166	 OSTAT	I*2   7-001170	 OSWTCH	I*2   7-001172

 OTYPE	I*2   7-001200	 PROLNG	I*2   4-000002	 VERLNG	I*2   7-002264	 WINDOW	I*2   7-002266





ARRAYS



 NAME   TYPE  ADDRESS	    SIZE 	DIMENSIONS



 BUFR	L*1   6-001044	036000  7680	(7680,2)

 CMAT	I*2   4-000066	000050    20	(20)

 COMCHR	L*1   6-037046	000020     8	(16)

 COMNAM	L*1   7-001010	000052    21	(42)

 COMREC	L*1   7-000010	001000   256	(512)

 IFIRST	I*2   6-001032	000004     2	(2)

 IFREE	I*2   6-001026	000004     2	(2)

 IHOLD	I*2   6-000634	000170    60	(30,2)

 IMAT	I*2   4-000016	000050    20	(20)

 INPNAM	L*1   7-001074	000052    21	(42)

 LAST	I*2   6-001036	000004     2	(2)

 LSTMAP	I*2   6-000626	000004     2	(2)

 LSTMAT	I*2   6-037112	000004     2	(2)

FORTRAN IV-PLUS V02-51D		02:36:51    22-AUG-78		PAGE 13  

COMPAR.FTN   	/TR:BLOCKS/WR


 MAP	I*2   6-000000	000620   200	(100,2)

 MAPEND	I*2   6-037142	000004     2	(2)

 MAPMRK	I*2   6-037202	000014     6	(3,2)

 MAPNAM	L*1   6-037150	000014     6	(12)

 MAPTOP	I*2   6-000622	000004     2	(2)

 MOUT	I*2   4-000136	000312   101	(101)

 MRKPNT	I*2   6-037120	000020     8	(4,2)

 NSWVAL	I*2   6-037066	000024    10	(10)

 NXTCOM	L*1   4-001450	001000   256	(512)

 NXTREC	L*1   4-000450	001000   256	(512)

 OUTMOD	L*1   7-001202	000003     1	(3)

 OUTNAM	L*1   7-001205	000052    21	(42)

 PROMPT	L*1   7-001257	000005     2	(5)

 RECORD	L*1   7-001264	001000   256	(512)

 SWTABL	L*1   7-002270	000113    37	(75)

 VERSON	L*1   7-002403	000005     2	(5)





LABELS



 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	 LABEL   ADDRESS 	



 281'	    **   	 520	 1-000172	 525	 1-000230	 530	 1-000260	 540	 1-000302

 600	 1-000354	 605	 1-000376	 610	 1-000426	 620	    **   	 640	    **   

 645	 1-000646	 649	 1-000676	 650	 1-000710	 660	 1-001122	 665	 1-001152

 669	 1-001202	 670	 1-001214	 675	 1-001420	 680	 1-001450	 690	 1-001700

 710	    **   	 720	    **   	 723	 1-002012	 725	 1-002126	 730	 1-002140

 735	 1-002354	 740	 1-002366	 750	    **   	 755	 1-002672	 760	    **   

 770	    **   	 780	 1-003110	 790	 1-003250	 794	    **   	 795	 1-003432

 800	 1-003474	 810	 1-003666	 900	 1-003720	 910	 1-004106	 1000	 1-004140

 1005	 1-004242	 1010	    **   	 1020	 1-004464	 9050	 1-004526	 9060	    **   

 9070	 1-004544	 9630	 1-004562	 9650	 1-004600	 9695	 1-004616	 9735	 1-004642

 10000	 1-004664





FUNCTIONS AND SUBROUTINES REFERENCED



 CLSFIL	 FILBUF	 GETLIN	 INIT	 MAPREC	 OPNFIL	 PUTREC





TOTAL SPACE ALLOCATED = 051634 10702



NO FPP INSTRUCTIONS GENERATED



OBJ$:COMPAR,LIS$:COMPAR/-SP=SRC$:COMPAR

