Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0169/mrgadr.for
There is 1 other file named mrgadr.for in the archive. Click here to see a list.
C RENBR(MRGADR/MERGES AT SIGN ADDRESS FILES SORTED BY ZIP)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C STORAGE OF THE ADDRESS READ FROM THE VARIOUS INPUT FILES
C LTRSTR = ARRAY STORING CHARACTERS OF ALL OF THE ADDRESSES
C NEXT TO BE CONSIDERED FROM EACH INPUT FILE
C LNGLIN = ARRAY STORING THE LINE LENGTHS OF EACH LINE IN
C ALL OF THE ADDRESSES IN THE LTRSTR ARRAY
C LNGADR = NUMBER OF LINES IN EACH ADDRESS
C LOCLTR = LOCATION IN LTRSTR ARRAY AT WHICH ADDRESS STARTS
C KNDADR = -1, END OF FILE READ
C = 0, NOTHING YET READ OR ADDRESS WRITTEN TO OUTPUT
C = 1, SOMETHING STORED IN LTRSTR ARRAY FOR ADDRESS
C NUMLFT = VALUE OF LEFT 5 DIGITS OF ZIP CODE
C NUMRIT = VALUE OF RIGHT 4 DIGITS OF ZIP CODE
C IDISK = UNIT NUMBER FROM WHICH ADDRESS IS READ
C LOCLIN = LOCATION IN LNGLIN ARRAY AT WHICH LINE LINES START
DIMENSION LTRSTR(5000),LNGLIN(400),LNGADR(20),LOCLTR(20),
1KNDADR(20),NUMLFT(20),NUMRIT(20),IDISK(20),LOCLIN(20)
C
C STORAGE OF START OF SUBSEQUENT ADDRESSES WHILE PROCESS CURRENT
C ADDRESSES FROM INPUT FILES
C LOC1ST = LOCATION IN LTR1ST ARRAY AT WHICH FIRST LINE OF A NEW
C ADDRESS READ WHEN NOT NEEDED IS STORED
C LNG1ST = NUMBERS OF CHARACTERS IN THE LINES STORED IN LTR1ST
C ARRAY
C LTR1ST = ARRAY USED TO STORE THE START OF A SUBSEQUENT ADDRESS
DIMENSION LOC1ST(20),LNG1ST(20),LTR1ST(1000)
C
C VARIOUS OTHER ARRAYS
C LTRBFR = INPUT BUFFER FOR CHARACTERS
C LTRDGT = DIGITS ZERO THROUGH NINE
DIMENSION LTRBFR(80),LTRDGT(10)
C
DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA LTRSPA,LTRNUM,LTRZZZ,LTRATS,LTRMIN/
1 1H ,1H#,1HZ,1H@,1H-/
C
C UNIT FILES FOR TERMINAL, OUTPUT AND VARIOUS INPUT FILES
C ITTY = THE UNIT NUMBER FOR WRITING TO TERMINAL
C JTTY = THE UNIT NUMBER FOR READING FROM TERMINAL
C KDISK = THE OUTPUT FILE
C IDISK = THE VARIOUS INPUT FILES
DATA ITTY,JTTY,KDISK/5,5,1/
DATA IDISK/20,21,22,23,24, 0, 0, 0, 0, 0,
1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
C
C DIMENSIONS OF VARIOUS ARRAYS
C LMTBFR = NUMBER OF CHARACTERS READ FROM INPUT FILE
C LMTSTR = MAXIMUM NUMBER OF CHARACTERS IN ALL STORED ADDRESS
C LMTFIL = MAXIMUM NUMBER OF INPUT FILES
C LMTLIN = MAXIMUM NUMBER OF LINES IN ALL STORED ADDRESSES
C LMT1ST = MAXIMUM NUMBER OF CHARACTERS IN STORED FIRST LINES
DATA LMTBFR,LMTSTR,LMTFIL,LMTLIN,LMT1ST/
1 80,5000,5,400,1000/
C
C TELL USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)LMTFIL
1 FORMAT(' MRGADR (05/83)'/
1' Merges up to',1I3,' at sign notation address file',
2's previously sorted by zip code')
C
C GET NAME OF OUTPUT FILE AND OPEN IT
2 WRITE(ITTY,3)
3 FORMAT(' New composite file? ',$)
ISTORE=1
IWRITE=1
CALL FILOPN(ISTORE,KDISK ,ITTY ,JTTY ,IWRITE,
1IFOPEN)
IF(IFOPEN.LT.0)GO TO 2
IF(IFOPEN.GT.0)GO TO 5
WRITE(ITTY,4)
4 FORMAT(' File name must be specified')
GO TO 2
5 CONTINUE
C
C OPEN INPUT FILES
KNTFIL=0
DO 9 IFILE=1,LMTFIL
6 WRITE(ITTY,7)IFILE
7 FORMAT(' Original file',1I2,' (press RETURN again ',
1'if no more)? ',$)
KNTFIL=KNTFIL+1
JDISK=IDISK(KNTFIL)
ISTORE=KNTFIL+1
IWRITE=0
CALL FILOPN(ISTORE,JDISK ,ITTY ,JTTY ,IWRITE,
1IFOPEN)
IF(IFOPEN.LT.0)GO TO 8
IF(IFOPEN.EQ.0)GO TO 10
GO TO 9
8 KNTFIL=KNTFIL-1
GO TO 6
9 CONTINUE
GO TO 11
10 KNTFIL=KNTFIL-1
11 CONTINUE
C
C SET INTIAL VALUES
IF(KNTFIL.LE.0)GO TO 49
DO 12 NOWFIL=1,KNTFIL
KNDADR(NOWFIL)=0
LNG1ST(NOWFIL)=0
LNGADR(NOWFIL)=0
12 CONTINUE
KNTLIN=0
KNTLTR=0
KNT1ST=0
KNTLBL=0
C
C FIND FILE NEEDING TO BE READ NEXT
NOWFIL=0
13 NOWFIL=NOWFIL+1
IF(NOWFIL.GT.KNTFIL)GO TO 35
14 IF(KNDADR(NOWFIL).NE.0)GO TO 13
JDISK=IDISK(NOWFIL)
C
C RESTORE PREVIOUSLY READ FIRST LINE IF ANY
IF(LNG1ST(NOWFIL).EQ.0)GO TO 19
J=LOC1ST(NOWFIL)
MAXBFR=LNG1ST(NOWFIL)
DO 15 I=1,MAXBFR
J=J+1
LTRBFR(I)=LTR1ST(J)
15 CONTINUE
J=LOC1ST(NOWFIL)
K=J+MAXBFR
LNG1ST(NOWFIL)=0
KNT1ST=KNT1ST-MAXBFR
16 IF(J.GE.KNT1ST)GO TO 17
J=J+1
K=K+1
LTR1ST(J)=LTR1ST(K)
GO TO 16
17 CONTINUE
INILTR=LOC1ST(NOWFIL)
DO 18 I=1,KNTFIL
IF(LNG1ST(I).EQ.0)GO TO 18
IF(LOC1ST(I).GT.INILTR)LOC1ST(I)=LOC1ST(I)-MAXBFR
18 CONTINUE
GO TO 26
C
C READ LINE FROM INPUT FILE
19 READ(JDISK,20,END=23)LTRBFR
20 FORMAT(80A1)
IF(LTRBFR(1).NE.LTRATS)GO TO 19
MAXBFR=LMTBFR
21 IF(MAXBFR.LE.0)GO TO 19
IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 22
MAXBFR=MAXBFR-1
GO TO 21
C
C CHECK FOR NEW ADDRESS START OR END-OF-FILE
22 IF(LTRBFR(2).EQ.LTRNUM)GO TO 24
IF(LTRBFR(2).EQ.LTRATS)GO TO 23
GO TO 26
C
C MARK EITHER PHYSICAL OR LOGICAL END OF FILE
23 KNDADR(NOWFIL)=-1
ISTORE=NOWFIL+1
CALL FILEND(ISTORE,JDISK)
GO TO 13
C
C LINE STARTS NEW ADDRESS
24 IF(KNDADR(NOWFIL).EQ.0)GO TO 26
IF((KNT1ST+MAXBFR).GT.LMT1ST)GO TO 51
LOC1ST(NOWFIL)=KNT1ST
LNG1ST(NOWFIL)=MAXBFR
DO 25 I=1,MAXBFR
KNT1ST=KNT1ST+1
LTR1ST(KNT1ST)=LTRBFR(I)
25 CONTINUE
GO TO 13
C
C STORE INFORMATION ABOUT START OF ADDRESS
26 IF(KNTLIN.GE.LMTLIN)GO TO 53
IF((KNTLTR+MAXBFR).GT.LMTSTR)GO TO 55
IF(KNDADR(NOWFIL).NE.0)GO TO 27
KNDADR(NOWFIL)=1
NUMLFT(NOWFIL)=0
NUMRIT(NOWFIL)=0
LNGADR(NOWFIL)=0
LOCLTR(NOWFIL)=KNTLTR
LOCLIN(NOWFIL)=KNTLIN
C
C STORE THE NEW LINE
27 KNTLIN=KNTLIN+1
LNGADR(NOWFIL)=LNGADR(NOWFIL)+1
LNGLIN(KNTLIN)=MAXBFR
DO 28 I=1,MAXBFR
KNTLTR=KNTLTR+1
LTRSTR(KNTLTR)=LTRBFR(I)
28 CONTINUE
C
C EVALUATE ZIP CODE IF LINE STARTS WITH AT SIGN, THEN LETTER Z
IF(LTRBFR(2).NE.LTRZZZ)GO TO 19
IZIP=0
JZIP=0
INDEX=2
IPART=0
C IPART = 0, BEFORE ZIP CODE
C IPART = -1, IN LEFT PART OF ZIP CODE
C IPART = 1, IN RIGHT PART OF ZIP CODE
29 IF(INDEX.GE.MAXBFR)GO TO 34
INDEX=INDEX+1
LTRNOW=LTRBFR(INDEX)
IF(LTRNOW.EQ.LTRSPA)GO TO 32
IF(LTRNOW.EQ.LTRMIN)GO TO 33
DO 31 I=1,10
IF(LTRNOW.NE.LTRDGT(I))GO TO 31
IF(IPART.GT.0)GO TO 30
IPART=-1
IZIP=(10*IZIP)+I-1
GO TO 29
30 JZIP=(10*JZIP)+I-1
GO TO 29
31 CONTINUE
GO TO 34
32 IF(IPART.NE.0)GO TO 34
GO TO 29
33 IF(IPART.GT.0)GO TO 34
IPART=1
GO TO 29
34 NUMLFT(NOWFIL)=IZIP
NUMRIT(NOWFIL)=JZIP
GO TO 19
C
C FIND THE LOWEST ZIP AND OUTPUT IT
35 LOWFIL=0
36 IF(LOWFIL.GE.KNTFIL)GO TO 46
LOWFIL=LOWFIL+1
IF(LNGADR(LOWFIL).EQ.0)GO TO 36
37 NOWFIL=LOWFIL
MINLFT=NUMLFT(LOWFIL)
MINRIT=NUMRIT(LOWFIL)
38 IF(LOWFIL.GE.KNTFIL)GO TO 39
LOWFIL=LOWFIL+1
IF(LNGADR(LOWFIL).EQ.0)GO TO 38
IF(MINLFT.LT.NUMLFT(LOWFIL))GO TO 38
IF(MINLFT.GT.NUMLFT(LOWFIL))GO TO 37
IF(MINRIT.LE.NUMRIT(LOWFIL))GO TO 38
GO TO 37
C
C WRITE ADDRESS WITH LOWEST ZIP CODE TO OUTPUT FILE
39 MAXLIN=LNGADR(NOWFIL)
INILIN=LOCLIN(NOWFIL)
MAXLTR=LOCLTR(NOWFIL)
LCLLTR=0
KNTLBL=KNTLBL+1
DO 40 NOWLIN=1,MAXLIN
INILIN=INILIN+1
INILTR=MAXLTR+1
MAXLTR=MAXLTR+LNGLIN(INILIN)
LCLLTR=LCLLTR+LNGLIN(INILIN)
WRITE(KDISK,20)(LTRSTR(I),I=INILTR,MAXLTR)
40 CONTINUE
LCLLIN=LNGADR(NOWFIL)
C
C REMOVE ADDRESS WITH LOWEST ZIP CODE FROM STORAGE
C REMOVE LETTERS OF CURRENT ADDRESS
J=LOCLTR(NOWFIL)
K=J+LCLLTR
KNTLTR=KNTLTR-LCLLTR
41 IF(J.GE.KNTLTR)GO TO 42
J=J+1
K=K+1
LTRSTR(J)=LTRSTR(K)
GO TO 41
42 CONTINUE
C REMOVE LINE LENGTHS FOR CURRENT ADDRESS
J=LOCLIN(NOWFIL)
K=J+LCLLIN
KNTLIN=KNTLIN-LCLLIN
43 IF(J.GE.KNTLIN)GO TO 44
J=J+1
K=K+1
LNGLIN(J)=LNGLIN(K)
GO TO 43
44 CONTINUE
C ADJUST LOCATIONS OF OTHER LINES
INILIN=LOCLIN(NOWFIL)
INILTR=LOCLTR(NOWFIL)
LNGADR(NOWFIL)=0
DO 45 I=1,KNTFIL
IF(LNGADR(I).EQ.0)GO TO 45
IF(LOCLIN(I).GT.INILIN)LOCLIN(I)=LOCLIN(I)-LCLLIN
IF(LOCLTR(I).GT.INILTR)LOCLTR(I)=LOCLTR(I)-LCLLTR
45 CONTINUE
C REMOVE CURRENT LINE
IF(KNDADR(NOWFIL).LT.0)GO TO 35
KNDADR(NOWFIL)=0
GO TO 14
C
C CLOSING MESSAGES
46 WRITE(KDISK,47)
47 FORMAT('@@END-OF-FILE')
ISTORE=1
CALL FILEND(ISTORE,KDISK)
WRITE(ITTY,48)KNTLBL
48 FORMAT(' Total number of addresses copied:',1I8)
GO TO 59
49 WRITE(ITTY,50)
50 FORMAT(' No input files specified')
GO TO 59
51 WRITE(ITTY,52)
52 FORMAT(
1' INCREASE SIZE OF ARRAYS USED TO STORE FIRST LINES')
GO TO 57
53 WRITE(ITTY,54)
54 FORMAT(
1' INCREASE SIZE OF ARRAY USED TO STORE LINE LENGTHS')
GO TO 57
55 WRITE(ITTY,56)
56 FORMAT(
1' INCREASE SIZE OF ARRAY USED TO STORE CHARACTERS OF ADDRESS')
57 WRITE(ITTY,58)
58 FORMAT(' AND THEN RUN THIS PROGRAM AGAIN')
59 WRITE(ITTY,60)
60 FORMAT(1X)
STOP
END