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

SETUP.FTN    	/TR:BLOCKS/WR


        C

        C

        C

        C

        C	SETUP - SETUP FOR COMPARE UTILITY

        C

        C

        C

        C	COPYRIGHT (C) 1976,1977,1978

        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. MORSE  13-OCT-76

        C

        C

        C

        C

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

SETUP.FTN    	/TR:BLOCKS/WR


         

        C

        C

        C  VARIABLES:

        C

        C	BARCH1--TEMPORARY CHANGE-BAR CHARACTER FROM COMPARE-FILE

        C	        SPECIFICATION

        C	BARCHR--CHANGE-BAR CHARACTER

        C	BARFIL--INDICATOR FOR FILE TO PRINT AS CHANGE-BAR OUTPUT,

        C		1 = INPUT, 2 = COMPARE, 3 = BOTH

        C	CDFLNG--LENGTH OF DEFAULT COMPARE FILE SPECIFICATION

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

        C	CNMLNG--LENGTH OF THE COMPARE FILE SPECIFICATION

        C	COLON--ASCII CHARACTER FOR COLON

        C	COMCHR--ASCII CHARACTERS FOR DELIMITING COMMENTS

        C	COMDEF--DEFAULT COMPARE FILE SPECIFICATION

        C	COMMA--ASCII CHARACTER FOR A COMMA

        C	COMNAM--COMPARE FILE SPECIFICATION

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

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

        C	CSWTCH--SWITCH VALUES ON COMPARE-FILE SPECIFICATION

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

        C	CURIND--INDICATOR TO REQUEST MOST RECENT FILE VERSION NUMBER

        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	INMLNG--LENGTH OF THE INPUT FILE SPECIFICATION

        C	INOUT--INDICATOR FOR TYPE OF LINE EDIT, 0 = INPUT, >0 = OUTPUT

        C	INPNAM--ASCII INPUT FILE SPECIFICATION

        C	IODET--FUNCTION VALUE TO DETACH THE TERMINAL

        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	ITTY--INDICATOR WHETHER OR NOT OUTPUT FILE IS A TERMINAL

        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	LFBRAC--ASCII CHARACTER FOR LEFT BRACKET

        C	LINNM1--TEMPORARY VALUE FOR LINNUM

        C	LINNUM--INDICATOR OF WHETHER OR NOT TO INCLUDE LINE NUMBERS ON

        C		CHANGE-BAR OUTPUT

        C	LINSIZ--NUMBER OF CHARACTERS IN THE OUTPUT LINE

        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	MNMLNG--LENGTH OF INPUT FILE NAME

        C	MPRINT--NUMBER OF MATCHED LINES TO PRINT IN MERGED LISTING

        C	MSTAT--INDICATOR FOR TYPE OF CLOSE TO PERFORM

        C	MLUN--CHANNEL FOR MAP FILE

        C	NOBYTE--DUMMY BYTE ARGUMENT

        C	NOINTG--DUMMY INTEGER ARGUMENT

        C	NSWVAL--ARRAY HOLDING VALUES TO TEST SWITCHES AGAINST

        C	NUMISW--NUMBER OF INPUT SWITCHES

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

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

SETUP.FTN    	/TR:BLOCKS/WR


        C		THE MAP TABLE

        C	NUMOSW--NUMBER OF OUTPUT SWITCHES

        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	OSTAT--STATUS OF TYPE OF CLOSE FOR OUTPUT FILE CHANNEL

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

        C	OUTDEF--DEFAULT OUTPUT FILE SPECIFICATION

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

        C	OUTNAM--OUTPUT FILE SPECIFICATION

        C	PERIOD--ASCII CHARACTER FOR PERIOD

        C	PROLNG--LENGTH OF PROMPT

        C	PROMPT--COMMAND LINE PROMPT CHARACTERS

        C	PRVIND--INDICATOR TO SEARCH FOR A PREVIOUS VERSION OF A FILE

        C	RECORD--I/O BUFFER

        C	RTBRAC--ASCII CHARACTER FOR RIGHT BRACKET

        C	SEMI--ASCII CHARACTER FOR SEMI-COLON

        C	SLASH--ASCII CHARACTER FOR A SLASH

        C	SWTABL--TABLE DEFINING SWITCHES

        C	VERLNG--LENGTH OF ASCII FILE VERSION NUMBER

        C	VERSON--ASCII FILE VERSION NUMBER

        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

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

SETUP.FTN    	/TR:BLOCKS/WR


         

0001    	SUBROUTINE SETUP

         

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,ODFLNG,CDFLNG,DEFLNG

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

0006    	INTEGER CTYPE,OTYPE,VERLNG,CURIND,PRVIND

0007    	INTEGER WINDOW,IDATA(6),BARFIL,COPIES

0008    	INTEGER DIRFLG

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

0010    	BYTE BARCHR,OUTMOD(3),BARCH1(4)

0011    	BYTE OCTAL,HEXAD,ASCI,FF,TAB,NSF

0012    	BYTE RECORD(512),COMREC(512)

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

0014    	BYTE OUTDEF(15),COMDEF(15),DEFTYP(4),VERSON(5),NOBYTE

0015    	BYTE SEMI,COLON,PERIOD,RTBRAC,LFBRAC,BLANK,COMMA,SLASH

0016    	BYTE LFANGL,RTANGL

        C

        C	THESE TWO ARRAYS MUST BE DIMENSIONED ACCORDING TO THE LENGTH OF

        C	THE USER'S PROMPT AND THE NUMBER OF SWITCH CHARACTERS THAT HE 

        C	SPECIFIES.  (FOUR CHARACTERS/SWITCH--MAXIMUM OF 10 SWITCHES)

        C

0017    	BYTE PROMPT(5),SWTABL(75)

        C

        C

        C

        C	THIS DATA STATEMENT INITIALIZES THE PROMPT STRING AND ITS LENGTH.

        C

0018    	DATA PROMPT/10,'D','I','F','>'/PROLNG/5/

        C

        C

0019    	DATA DEFTYP/'.','D','I','F'/,DEFLNG/4/

0020    	DATA MAPNAM/'S','Y',':','M','A','P','.','D','I','F',0,0/

        C

        C	THE SWITCH TABLE SPECIFIES THE LEGITIMATE ASCII SWITCHES TO BE

        C	ACCEPTED AS PART OF A FILE SPECIFICATION.  WHEN THE FIRST SWITCH

        C	(SPECIFIED BY THE FIRST TWO ASCII CHARACTERS IN THE TABLE)

        C	IS SPECIFIED ON A FILE SPECIFICATION, BIT ZERO IS SET IN THE 

        C	RETURNED SWITCH VALUE.  THE SECOND CAUSES BIT ONE TO BE SET AND

        C	SO ON, UP TO A MAXIMUM OF TEN SWITCHES.  NUMSW SHOULD BE

        C	INITIALIZED TO THE NUMBER OF SWITCHES SPECIFIED IN THE SWITCH TABLE.

        C

        C

        C

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

SETUP.FTN    	/TR:BLOCKS/WR


0021    	DATA SWTABL/'M','W',1,'D',2,'S','P',1,'D',2,'O','M',3,'A',1

        	1,'A',1,'A',1,'M','S',1,'D',2,'S','L',0,'L','D',0

        	2,'M','D',1,'D',2,'M','X',1,'D',2,'W','D',1,'D',2,

        	3'C','B',2,'A',2,'D',2,'C','O',4,'A',2,'A',2,'A',2,'A',2,

        	4'F','F',0,'B','L',0,'M','B',0,'T','B',0/

0022    	DATA NUMISW/6/,NUMOSW/9/

        C

        C

0023    	DATA NSWVAL/1,2,4,8,16,32,64,128,256,512/

0024    	DATA ITYPE/0/,CTYPE/0/,OTYPE/1/,IRECSZ/512/

0025    	DATA CURIND/0/,BLANK/' '/,SLASH/47/

0026    	DATA COMMA,PERIOD,COLON,SEMI,RTBRAC,LFBRAC/',','.',':',';',']','['/

0027    	DATA LFANGL,RTANGL/'<','>'/

0028    	DATA OCTAL,HEXAD,ASCI,FF,TAB,NSF/'O','H','A',12,9,-26/

0029    	DATA NINCOR/30/,NUMLIN/100/,MAXBUF/7680/,IODET/O2000/

        C

        C

        C	FORMAT WARNINGS

        C

0030    251	FORMAT(' ',3A1,' -- WARNING--INVALID /MS SWITCH VALUE'

        	1,/' ',T16,'--DEFAULT OF 3 USED')

0031    261	FORMAT(' ',3A1,' -- WARNING--INVALID /CB SWITCH VALUE'

        	1/' ',T16,'--NO LINE NUMBERS WILL BE PRINTED')

0032    271	FORMAT(' ',3A1,' -- WARNING--INVALID /MW SWITCH VALUE'

        	1,/' ',T16,'--DEFAULT OF 15. USED')

0033    281	FORMAT(' ',3A1,' -- WARNING--INVALID /OM SWITCH VALUE'

        	1,/' ',T16,'--DEFAULT OF ASCII USED')

0034    291	FORMAT(' ',3A1,' -- WARNING--INVALID /WD SWITCH VALUE'

        	1,/' ',T16,'--DEFAULT LINE WIDTH USED')

0035    311	FORMAT(' ',3A1,' -- WARNING--INVALID /MD SWITCH VALUE'

        	1,/' ',T16,'--DEFAULT OF 1 USED')

0036    321	FORMAT(' ',3A1,' -- WARNING--INVALID /MX SWITCH VALUE'

        	1,/' ',T16,'--ALL DIFFERENCES WILL BE PRINTED')

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

SETUP.FTN    	/TR:BLOCKS/WR


         

        C

        C

        C	INITIALIZE ALL PARAMETERS.

        C

        C

0037    	INOUT=0

0038    	ISTAT=0

0039    	CSTAT=0

0040    	MSTAT=0

0041    	OSTAT=0

0042    	ONMLNG=0

0043    	MNMLNG=10

0044    	INMLNG=0

0045    	CNMLNG=0

0046    	OLUN=2

0047    	ILUN=1

0048    	CLUN=3

0049    	MLUN=7

0050    	NOINTG=0

0051    	PRVIND=-1

0052    	MTYPE=1

        C

        C	ASSIGN THE COMMAND LINE INPUT CHANNEL TO THE TERMINAL.

        C	NOTE:  CHANNEL FOUR SHOULD ONLY BE USED FOR COMMAND LINE I/O.

        C

0053    	CALL ASNLUN(4,'TI',0)

        C

        C	REQUEST A COMMAND LINE.

        C

0054    	CALL QIO(IODET,5)

0055    	CALL GETCML(RECORD,LENINP,PROMPT,PROLNG,IERR2)

0056    	IF (IERR2.LE.0) GOTO 9500

        C

        C	ANALYZE THE SYNTAX OF THE COMMAND LINE.

        C

0057    	CALL SYNTX(RECORD,LENINP,IERR2)

0058    	IF (IERR2.LT.0) GOTO 9510

        C

        C	INITIALIZE THE INPUT SWITCH VALUES.

        C

0059    	CALL BLDSWT(NUMISW,SWTABL(46),IERR2,BARCH1(3),LINNUM,COMCHR(1),

        	1COMCHR(3),COMCHR(5),COMCHR(7))

0060    	IF (IERR2.LT.0) GOTO 9550

        C

        C	REQUEST AN INPUT FILE SPECIFICATION.

        C

0061    	CALL SCANI(RECORD,LENINP,ISWTCH,INPNAM,INMLNG,NOBYTE,NOINTG,IERR2)

0062    	IF (IERR2.LT.0) GOTO 9530

        C

        C	CREATE AN OUTPUT DEFAULT FILENAME (I.E., USE THE INPUT FILENAME 

        C	AND THE TYPE 'DIF'.)

        C

0063    	DIRFLG=0

0064    	ODFLNG=1

0065    	DO 70 I=1,INMLNG

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

SETUP.FTN    	/TR:BLOCKS/WR


0066    	IF (INPNAM(I).EQ.COLON) GOTO 60

0067    	IF ((INPNAM(I).NE.LFBRAC) .AND. (INPNAM(I).NE.LFANGL)) GOTO 61

0068    	DIRFLG=1

0069    	GOTO 60

0070    61	IF ((INPNAM(I).NE.RTBRAC) .AND. (INPNAM(I).NE.RTANGL)) GOTO 62

0071    	DIRFLG=0

0072    	GOTO 60

0073    62	IF ((INPNAM(I).EQ.PERIOD) .AND. (DIRFLG.EQ.0)) GOTO 80

0074    	OUTDEF(ODFLNG)=INPNAM(I)

0075    	ODFLNG=ODFLNG + 1

0076    	GOTO 70

0077    60	ODFLNG=1

0078    70	CONTINUE

0079    80	DO 90 I=ODFLNG,ODFLNG+3

0080    90	OUTDEF(I)=DEFTYP(I-ODFLNG+1)

0081    	ODFLNG=ODFLNG + 3

        C

        C	INITIALIZE THE OUTPUT SWITCH VALUES.

        C

0082    	CALL BLDSWT(NUMOSW,SWTABL,IERR2,WINDOW,COPIES,OUTMOD(1),

        	1OUTMOD(2),OUTMOD(3),MATSIZ,MPRINT,MAXDIF,LINSIZ)

0083    	IF (IERR2.LT.0) GOTO 9555

        C

        C	REQUEST AN OUTPUT FILE SPECIFICATION.

        C

0084    	CALL SCANO(RECORD,LENINP,OSWTCH,OUTNAM,ONMLNG,OUTDEF,ODFLNG,IERR2)

0085    	IF (IERR2.LT.0) GOTO 9520

        C

        C	CREATE A COMPARE DEFAULT FILENAME (I.E., USE THE INPUT FILENAME 

        C	AND TYPE.)

        C

0086    	CDFLNG=0

0087    	DO 110 I=1,INMLNG

0088    	IF ((INPNAM(I).EQ.RTBRAC) .OR. (INPNAM(I).EQ.LFBRAC) .OR.

        	1   (INPNAM(I).EQ.COLON) .OR. (INPNAM(I).EQ.RTANGL) .OR.

        	2   (INPNAM(I).EQ.LFANGL)) GOTO 100

0089    	IF (INPNAM(I).EQ.SEMI) GOTO 120

0090    	CDFLNG=CDFLNG + 1

0091    	COMDEF(CDFLNG)=INPNAM(I)

0092    	GOTO 110

0093    100	CDFLNG=0

0094    110	CONTINUE

        C

        C	INITIALIZE THE COMPARE NSWVAL VALUES.

        C

0095    120	CALL BLDSWT(NUMISW,SWTABL(46),IERR2,BARCH1,LINNM1,COMCHR(9),

        	1COMCHR(11),COMCHR(13),COMCHR(15))

0096    	IF (IERR2.LT.0) GOTO 9550

        C

        C	REQUEST A COMPARE FILE SPECIFICATION.

        C

0097    	CALL SCANI(RECORD,LENINP,CSWTCH,COMNAM,CNMLNG,COMDEF,CDFLNG,IERR2)

0098    	IF (IERR2.LT.0) GOTO 9540

0099    	CALL OPNFIL(INPNAM,INMLNG,ILUN,RECORD,IRECSZ,ITYPE,IERR2)

0100    	IF (IERR2.LE.0) GOTO 9570

        C

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

SETUP.FTN    	/TR:BLOCKS/WR


        C	FIND VERSION NUMBER OF INPUT FILE.

        C

0101    	DO 130 I=1,INMLNG

0102    130	IF (INPNAM(I).EQ.SEMI) GOTO 150

0103    	CALL GETVER(ILUN,VERSON,VERLNG,CURIND,IERR2)

0104    	IF (IERR2.LE.0) GOTO 9800

0105    	INPNAM(INMLNG+1)=SEMI

0106    	INMLNG=INMLNG+1

0107    	DO 140 I=INMLNG+1,INMLNG+VERLNG

0108    140	INPNAM(I)=VERSON(I-INMLNG)

0109    	INMLNG=INMLNG+VERLNG

0110    	INPNAM(INMLNG+1)=0

        C

        C	CHECK IF COMPARE FILENAME IS THE SAME AS THE INPUT FILENAME.

        C	IF IT IS OR IF A COMPARE VERSION IS ALREADY SPECIFIED, THE

        C	FILE IS READY TO BE OPENED.

        C

0111    150	DO 160 I=1,CNMLNG

0112    	IF (COMNAM(I).NE. INPNAM(I)) GOTO 180

0113    160	IF (COMNAM(I).EQ.SEMI) GOTO 180

0114    	IF (INPNAM(I) .NE. SEMI) GOTO 180

        C

        C	BOTH EQUAL, THEREFORE GET VERSION FOR COMPARE FILE

        C

0115    165	CALL GETVER(ILUN,VERSON,VERLNG,PRVIND,IERR2)

0116    	IF (IERR2.LE.0) GOTO 9800

0117    	COMNAM(CNMLNG+1)=SEMI

0118    	CNMLNG=CNMLNG+1

0119    	DO 170 I=CNMLNG+1,CNMLNG+VERLNG

0120    170	COMNAM(I)=VERSON(I-CNMLNG)

0121    	CNMLNG=CNMLNG+VERLNG

0122    	COMNAM(CNMLNG+1)=0

0123    180	CALL OPNFIL(COMNAM,CNMLNG,CLUN,COMREC,IRECSZ,CTYPE,IERR2)

        C

        C	CHECK FOR PREVIOUS VERSIONS IF VERSION #-1 IS NOT THERE.

        C

0124    	IF ((IERR2 .EQ. -5) .AND. (COMREC(1) .EQ. NSF)) GOTO 185

0125    	IF (IERR2.LE.0) GOTO 9590

0126    	GOTO 188

0127    185	DO 186 I=1,CNMLNG

0128    	IF (COMNAM(I).NE. INPNAM(I)) GOTO 9590

0129    186	IF (COMNAM(I).EQ.SEMI) GOTO 187

0130    187	IF (INPNAM(I) .NE. SEMI) GOTO 9590

0131    	PRVIND=PRVIND-1

0132    	CNMLNG=I-1

0133    	CLUN=3

0134    	GOTO 165

        C

        C

        C	GET VERSION OF COMPARE FILE IF NOT ALREADY SPECIFIED.

        C

0135    188	DO 190 I=1,CNMLNG

0136    190	IF (COMNAM(I).EQ.SEMI) GOTO 210

0137    	CALL GETVER(CLUN,VERSON,VERLNG,CURIND,IERR2)

0138    	IF (IERR2.LE.0) GOTO 9810

0139    	COMNAM(CNMLNG+1)=SEMI

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

SETUP.FTN    	/TR:BLOCKS/WR


0140    	CNMLNG=CNMLNG+1

0141    	DO 200 I=CNMLNG+1,CNMLNG+VERLNG

0142    200	COMNAM(I)=VERSON(I-CNMLNG)

0143    	CNMLNG=CNMLNG+VERLNG

0144    	COMNAM(CNMLNG+1)=0

        C

        C	OPEN OUTPUT FILE.

        C

0145    210	CALL ASNLUN(OLUN,'SY',0)

0146    	CALL OPNFIL(OUTNAM,ONMLNG,OLUN,RECORD,IRECSZ,OTYPE,IERR2)

0147    	IF (IERR2.LE.0) GOTO 9600

        C

        C	FIND LUN ATTRIBUTES:  IS IT A TERMINAL?, WHAT IS BUFFER SIZE?

        C

0148    	CALL GETLUN(OLUN,IDATA)

0149    	ITTY=IDATA(3)

0150    	IF ((OSWTCH .AND. NSWVAL(9)) .NE. NSWVAL(9)) GOTO 215

0151    	IF (LINSIZ .LE. 30)WRITE(5,291)(PROMPT(I),I=2,4)

0152    215	IF (LINSIZ .LE. 30)LINSIZ=131

0153    	IF (((ITTY .AND. NSWVAL(1)) .EQ. NSWVAL(1)) .AND.

        	1((OSWTCH .AND. NSWVAL(9)) .NE. NSWVAL(9)))LINSIZ=IDATA(6)

0154    	IF ((ITTY .AND. NSWVAL(1)) .EQ. NSWVAL(1)) GOTO 240

        C

        C	FIND VERSION NUMBER OF OUTPUT FILE.

        C

0155    	DO 220 I=1,ONMLNG

0156    220	IF (OUTNAM(I).EQ.SEMI) GOTO 240

0157    	CALL GETVER(OLUN,VERSON,VERLNG,CURIND,IERR2)

        C

        C	THE FOLLOWING LINE HAS BEEN CHANGED FROM REPORTING AN ERROR MESSAGE

        C	TO IGNORING THE ERROR BECAUSE:

        C		1) VMS DOES NOT RECOGNIZE LP: AS A RECORD-DEVICE

        C		2) THE OUTPUT FILE WILL HAVE A VERSION NUMBER OF ZERO

        C		   (WHICH IS REPORTED AS AN ERROR BY GETVER)

        C

        C	IF (IERR2.LE.0) GOTO 9820

        C

0158    	IF (IERR2.LE.0) GOTO 245

0159    	OUTNAM(ONMLNG+1)=SEMI

0160    	ONMLNG=ONMLNG+1

0161    	DO 230 I=ONMLNG+1,ONMLNG+VERLNG

0162    230	OUTNAM(I)=VERSON(I-ONMLNG)

0163    	ONMLNG=ONMLNG+VERLNG

0164    	OUTNAM(ONMLNG+1)=0

        C

        C	RE-OPEN OUTPUT FILE VIA FORTRAN TO USE FORMATTED WRITES.

        C

0165    240	OSTAT=1

0166    	GOTO 246

0167    245	OSTAT=0

0168    246	CALL CLSFIL(OLUN,OSTAT,IERR2)

0169    	IF (IERR2.LE.0) GOTO 9660

0170    	OSTAT=0

0171    	OPEN(UNIT=OLUN,NAME=OUTNAM,ERR=9600,TYPE='NEW')

0172    	GOTO 500

        C

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

SETUP.FTN    	/TR:BLOCKS/WR


        C	IS CHANGE BAR OUTPUT REQUESTED?

        C

0173    500	BARFIL=0

0174    	IF ((CSWTCH .AND. NSWVAL(1)) .EQ. NSWVAL(1)) BARFIL=BARFIL+2

0175    	IF ((ISWTCH .AND. NSWVAL(1)) .EQ. NSWVAL(1)) BARFIL=BARFIL+1

0176    	ISWTCH=ISWTCH .OR. CSWTCH

0177    	IF ((LINNUM .NE. 0) .AND. (LINNUM .NE. 1))

        	1GOTO 400

0178    	IF ((LINNM1 .NE. 0) .AND. (LINNM1 .NE. 1))

        	1GOTO 400

0179    	IF (LINNM1 .GT. LINNUM) LINNUM=LINNM1

0180    	GOTO 510

0181    400	WRITE(5,261)(PROMPT(I),I=2,4)

0182    	LINNUM=0

        C

        C	SET UP CHANGE-BAR CHARACTER.

        C

0183    510	IF (BARFIL .EQ. 0) GOTO 515 

0184    	DO 511 N=1,4,2

0185    	IF ((BARCH1(N) .EQ. 'S') .AND. (BARCH1(N+1) .EQ. 'E'))

        	1 BARCH1(N)=SEMI

0186    	IF ((BARCH1(N) .EQ. 'S') .AND. (BARCH1(N+1) .EQ. 'L'))

        	1 BARCH1(N)=SLASH

0187    	IF ((BARCH1(N) .EQ. 'R') .AND. (BARCH1(N+1) .EQ. 'B'))

        	1 BARCH1(N)=RTBRAC

0188    	IF ((BARCH1(N) .EQ. 'L') .AND. (BARCH1(N+1) .EQ. 'B'))

        	1 BARCH1(N)=LFBRAC

0189    	IF ((BARCH1(N) .EQ. 'C') .AND. (BARCH1(N+1) .EQ. 'M'))

        	1 BARCH1(N)=COMMA

0190    	IF ((BARCH1(N) .EQ. 'S') .AND. (BARCH1(N+1) .EQ. 'P'))

        	1BARCH1(N)=BLANK

0191    	IF ((BARCH1(N) .EQ. 'H') .AND. (BARCH1(N+1) .EQ. 'T'))

        	1BARCH1(N)=TAB

0192    	IF ((BARCH1(N) .EQ. 'F') .AND. (BARCH1(N+1) .EQ. 'F'))

        	1BARCH1(N)=FF

0193    511	IF ((BARCH1(N) .EQ. 'C') .AND. (BARCH1(N+1) .EQ. 'L'))

        	1 BARCH1(N)=COLON

0194    	BARCHR=BARCH1(1)

0195    	IF (BARCH1(3) .NE. 0) BARCHR=BARCH1(3)

0196    	IF (BARCHR .EQ. 0) BARCHR='!'

        C

        C	CHECK FOR WINDOW SIZE.

        C

0197    515	IF (WINDOW .GE. 5) GOTO 501

0198    	WINDOW=15

0199    	IF ((OSWTCH .AND. NSWVAL(1)) .EQ. NSWVAL(1)) 

        	1WRITE(5,271)(PROMPT(I),I=2,4)

        C

        C	SET UP OUTPUT MODE CODES:

        C		1 = ASCII

        C		2 = OCTAL

        C		3 = HEXADECIMAL

        C

        C	MAKE ASCII THE DEFAULT.

        C

0200    501	DO 520 I=1,3

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

SETUP.FTN    	/TR:BLOCKS/WR


0201    	IF (OUTMOD(I) .EQ. ASCI) OUTMOD(I)=1

0202    	IF (OUTMOD(I) .EQ. OCTAL) OUTMOD(I)=2

0203    	IF (OUTMOD(I) .EQ. HEXAD) OUTMOD(I)=3

0204    	IF ((OUTMOD(I) .GE. 0) .AND. (OUTMOD(I) .LE. 3)) GOTO 520

0205    	WRITE(5,281)(PROMPT(J),J=2,4)

0206    	OUTMOD(I)=0

0207    520	CONTINUE

0208    	IF ((OUTMOD(1) .EQ. 0) .AND. (OUTMOD(2) .EQ. 0) .AND.

        	1 (OUTMOD(3) .EQ. 0)) OUTMOD(1)=1

        C

        C	SET UP NUMBER OF LINES CONSTITUTING A MATCH.

        C

0209    	IF (MATSIZ.GE.1 .AND. MATSIZ.LE.20) GOTO 502

0210    	MATSIZ=3

0211    	IF ((OSWTCH .AND. NSWVAL(4)) .EQ. NSWVAL(4))

        	1WRITE(5,251)(PROMPT(I),I=2,4)

        C

        C	SET UP COMMENT DELIMITERS.

        C

0212    502	IF ((ISWTCH .AND. NSWVAL(2)) .NE. NSWVAL(2)) GOTO 507 

0213    	DO 503 N=1,16,2

0214    	IF ((COMCHR(N) .EQ. 'S') .AND. (COMCHR(N+1) .EQ. 'E'))

        	1 COMCHR(N)=SEMI

0215    	IF ((COMCHR(N) .EQ. 'S') .AND. (COMCHR(N+1) .EQ. 'L'))

        	1 COMCHR(N)=SLASH

0216    	IF ((COMCHR(N) .EQ. 'R') .AND. (COMCHR(N+1) .EQ. 'B'))

        	1 COMCHR(N)=RTBRAC

0217    	IF ((COMCHR(N) .EQ. 'L') .AND. (COMCHR(N+1) .EQ. 'B'))

        	1 COMCHR(N)=LFBRAC

0218    	IF ((COMCHR(N) .EQ. 'C') .AND. (COMCHR(N+1) .EQ. 'M'))

        	1 COMCHR(N)=COMMA

0219    	IF ((COMCHR(N) .EQ. 'S') .AND. (COMCHR(N+1) .EQ. 'P'))

        	1COMCHR(N)=BLANK

0220    	IF ((COMCHR(N) .EQ. 'H') .AND. (COMCHR(N+1) .EQ. 'T'))

        	1COMCHR(N)=TAB

0221    	IF ((COMCHR(N) .EQ. 'F') .AND. (COMCHR(N+1) .EQ. 'F'))

        	1COMCHR(N)=FF

0222    503	IF ((COMCHR(N) .EQ. 'C') .AND. (COMCHR(N+1) .EQ. 'L'))

        	1 COMCHR(N)=COLON

0223    	DO 507 I=1,8,2

0224    	IF (COMCHR(I) .NE. 0) GOTO 507

0225    	DO 506 J=9,16,2

0226    	IF (COMCHR(J) .EQ. 0) GOTO 506

0227    	DO 504 K=1,8,2

0228    504	IF (COMCHR(J) .EQ. COMCHR(K)) GOTO 505

0229    	COMCHR(I)=COMCHR(J)

0230    	COMCHR(J)=0

0231    	GOTO 507

0232    505	COMCHR(J)=0

0233    506	CONTINUE

0234    507	CONTINUE

0235    	IF ((COMCHR(1) .NE. 0) .OR. (COMCHR(3) .NE. 0) .OR.

        	1 (COMCHR(5) .NE. 0) .OR. (COMCHR(7) .NE. 0)) GOTO 530

        C

        C	SET UP DEFAULT COMMENT DELIMITERS IF NONE ARE SPECIFIED.

        C

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

SETUP.FTN    	/TR:BLOCKS/WR


0236    	DO 521 I=1,INMLNG

0237    521	IF (INPNAM(I) .EQ. PERIOD) GOTO 522

0238    522	I=I+1

0239    	IF ((INPNAM(I) .NE. 'B') .OR. (INPNAM(I+1) .NE. '3') .OR.

        	1(INPNAM(I+2) .NE. '2')) GOTO 524

0240    523	COMCHR(1)='!'

0241    	GOTO 530

0242    524	IF ((INPNAM(I) .NE. 'F') .OR. (INPNAM(I+1) .NE. 'O') .OR.

        	1(INPNAM(I+2) .NE. 'R')) GOTO 525

0243    	COMCHR(3)='C'

0244    	COMCHR(5)='D'

0245    	GOTO 523

0246    525	IF (INPNAM(I) .NE. 'C') GOTO 529

0247    	IF ((INPNAM(I+1) .NE. 'M') .OR. (INPNAM(I+2) .NE. 'D')) GOTO 527

0248    526	COMCHR(3)=SEMI

0249    	GOTO 523

0250    527	IF ((INPNAM(I+1) .NE. 'O') .OR. (INPNAM(I+2) .NE. 'B')) GOTO 528

0251    	COMCHR(1)='*'

0252    	GOTO 530

0253    528	IF ((INPNAM(I+1) .NE. 'O') .OR. (INPNAM(I+2) .NE. 'M')) GOTO 529

0254    	COMCHR(1)='!'

0255    	GOTO 530

0256    529	COMCHR(1)=SEMI

        C

        C	ARE MERGED DIFFERENCES REQUESTED?

        C

0257    530	IF (MPRINT .EQ. 0) GOTO 531

0258    	IF ((MPRINT .LE. 10) .AND. (MPRINT .GT. 0)) GOTO 550

0259    	WRITE(5,311)(PROMPT(I),I=2,4)

0260    531	MPRINT=1

        C

        C	CHECK INPUT VALUES FOR /MX.

        C

0261    550	IF ((OSWTCH .AND. NSWVAL(8)) .NE. NSWVAL(8)) GOTO 5070

0262    	IF (MAXDIF .GT. 0) GOTO 5070

0263    	WRITE(5,321)(PROMPT(I),I=2,4)

0264    	MAXDIF=0

0265    5070	RETURN

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

SETUP.FTN    	/TR:BLOCKS/WR


         

        C

        C

        C	FILE COMPARE ERRORS

        C

        C

        C

        C

        C	MACRO ROUTINE ERRORS

        C

        C

        C

        C	GETCML ERRORS

        C

0266    9500	IERR1=-1

0267    	GOTO 1000

        C

        C

        C	SYNTX ERRORS

        C

        C

0268    9510	IERR1=-2

0269    	GOTO 1000

        C

        C

        C	SCANO/SCANI ERRORS

        C

        C

        C	OUTPUT ERROR

        C

0270    9520	IERR1=-4

0271    	GOTO 1000

        C

        C	INPUT ERROR

        C

0272    9530	IERR1=-3

0273    	GOTO 1000

        C

        C	COMPARE ERROR

        C

0274    9540	IERR1=-5

0275    	GOTO 1000

        C

        C

        C	NSWVAL TABLE ERROR

        C

        C

        C	FOR INPUT FILES

        C

0276    9550	IERR1=-9

0277    	GOTO 1000

        C

        C	FOR OUTPUT FILES

        C

0278    9555	IERR1=-11

0279    	GOTO 1000

FORTRAN IV-PLUS V02-51D		02:44:23    22-AUG-78		PAGE 14  

SETUP.FTN    	/TR:BLOCKS/WR


        C

        C

        C	OPEN FILE ERRORS

        C

        C

        C

        C	FOR INPUT FILE

        C

0280    9570	IERR1=-12

0281    	GOTO 1000

        C

        C	FOR COMPARE FILE

        C

0282    9590	IERR1=-20

0283    	GOTO 1000

        C

        C	FOR OUTPUT FILE

        C

0284    9600	IERR1=-16

0285    	GOTO 1000

        C

        C

        C	CLOSE ERRORS

        C

        C

        C	ON OUTPUT FILE

        C

0286    9660	IERR1=-17

0287    	GOTO 1000

        C

        C

        C

        C	MARK/POINT ERRORS

        C

        C	FOR INPUT FILE

        C

0288    9770	IERR1=-15

0289    	GOTO 1000

        C

        C	FOR COMPARE FILE

        C

0290    9780	IERR1=-23

0291    	GOTO 1000

        C

        C	VERSION ERRORS

        C

0292    9800	IERR1=-6

0293    	GOTO 1000

0294    9810	IERR1=-7

0295    	GOTO 1000

0296    9820	IERR1=-8

0297    	GOTO 1000

0298    1000	RETURN

0299    	END

FORTRAN IV-PLUS V02-51D		02:44:23    22-AUG-78		PAGE 15  

SETUP.FTN    	/TR:BLOCKS/WR


PROGRAM SECTIONS



NUMBER	 NAME	    SIZE		ATTRIBUTES



  1	$CODE1	006550  1716		RW,I,CON,LCL

  2	$PDATA	000024    10		RW,D,CON,LCL

  3	$IDATA	001502   417		RW,D,CON,LCL

  4	$VARS	000140    48		RW,D,CON,LCL

  5	$TEMPS	000006     3		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   



 SETUP	      1-000000





VARIABLES



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



 ASCI	L*1   4-000040	 BARCHR	L*1   6-037220	 BARFIL	I*2   7-000000	 BLANK	L*1   4-000114	 CDFLNG	I*2   7-000002

 CLUN	I*2   7-000004	 CNMLNG	I*2   7-000006	 COLON	L*1   4-000110	 COMMA	L*1   4-000115	 COPIES	I*2   7-001062

 CSTAT	I*2   7-001064	 CSWTCH	I*2   4-000004	 CTYPE	I*2   7-001066	 CURIND	I*2   4-000010	 DEFLNG	I*2   4-000002

 DIRFLG	I*2   4-000030	 FF	L*1   4-000041	 HEXAD	L*1   4-000037	 I	I*2   4-000126	 IERR1	I*2   6-037172

 IERR2	I*2   6-037174	 IKIND	I*2   6-037176	 ILUN	I*2   7-001070	 INMLNG	I*2   7-001072	 INOUT	I*2   6-037140

 IODET	I*2   4-000122	 IRECSZ	I*2   6-037116	 ISTAT	I*2   7-001146	 ISWTCH	I*2   6-037044	 ITTY	I*2   7-001150

 ITYPE	I*2   7-001152	 J	I*2   4-000134	 K	I*2   4-000136	 LENCOM	I*2   7-001154	 LENINP	I*2   7-001156

 LFANGL	L*1   4-000117	 LFBRAC	L*1   4-000113	 LINNM1	I*2   4-000130	 LINNUM	I*2   7-001176	 LINSIZ	I*2   6-037146

 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	 N	I*2   4-000132	 NINCOR	I*2   6-001024

 NOBYTE	L*1   4-000106	 NOINTG	I*2   4-000124	 NSF	L*1   4-000043	 NUMISW	I*2   7-001162	 NUMLIN	I*2   6-000620

 NUMOSW	I*2   7-001164	 OCTAL	L*1   4-000036	 ODFLNG	I*2   4-000000	 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	 PERIOD	L*1   4-000111	 PROLNG	I*2   4-000006

 PRVIND	I*2   4-000012	 RTANGL	L*1   4-000120	 RTBRAC	L*1   4-000112	 SEMI	L*1   4-000107	 SLASH	L*1   4-000116

 TAB	L*1   4-000042	 VERLNG	I*2   7-002264	 WINDOW	I*2   7-002266





ARRAYS



 NAME   TYPE  ADDRESS	    SIZE 	DIMENSIONS



 BARCH1	L*1   4-000032	000004     2	(4)

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

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

 COMDEF	L*1   4-000063	000017     7	(15)

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

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

 DEFTYP	L*1   4-000102	000004     2	(4)

 IDATA	I*2   4-000014	000014     6	(6)

 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)

FORTRAN IV-PLUS V02-51D		02:44:23    22-AUG-78		PAGE 16  

SETUP.FTN    	/TR:BLOCKS/WR


 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)

 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)

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

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

 OUTDEF	L*1   4-000044	000017     7	(15)

 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 	



 60	 1-000520	 61	 1-000410	 62	 1-000450	 70	 1-000534	 80	 1-000556

 90	    **   	 100	 1-001054	 110	 1-001066	 120	 1-001110	 130	    **   

 140	    **   	 150	 1-001422	 160	    **   	 165	 1-001524	 170	    **   

 180	 1-001670	 185	 1-001746	 186	    **   	 187	 1-002040	 188	 1-002112

 190	    **   	 200	    **   	 210	 1-002322	 215	 1-002520	 220	    **   

 230	    **   	 240	 1-003022	 245	 1-003040	 246	 1-003052	 251'	 3-000000

 261'	 3-000110	 271'	 3-000236	 281'	 3-000350	 291'	 3-000464	 311'	 3-000602

 321'	 3-000712	 400	 1-003272	 500	 1-003126	 501	 1-004124	 502	 1-004526

 503	    **   	 504	    **   	 505	 1-005262	 506	 1-005300	 507	 1-005324

 510	 1-003364	 511	    **   	 515	 1-004000	 520	 1-004326	 521	    **   

 522	 1-005450	 523	 1-005520	 524	 1-005536	 525	 1-005620	 526	    **   

 527	 1-005674	 528	 1-005740	 529	 1-006004	 530	 1-006020	 531	 1-006124

 550	 1-006140	 1000	 1-006546	 5070	 1-006262	 9500	 1-006264	 9510	 1-006300

 9520	 1-006316	 9530	 1-006334	 9540	 1-006352	 9550	 1-006370	 9555	 1-006406

 9570	 1-006424	 9590	 1-006442	 9600	 1-006460	 9660	 1-006476	 9770	    **   

 9780	    **   	 9800	 1-006514	 9810	 1-006532	 9820	    **   





FUNCTIONS AND SUBROUTINES REFERENCED



 ASNLUN	 BLDSWT	 CLSFIL	 GETCML	 GETLUN	 GETVER	 OPEN$	 OPNFIL	 QIO	 SCANI	 SCANO	 SYNTX





TOTAL SPACE ALLOCATED = 052276 10847



NO FPP INSTRUCTIONS GENERATED



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

