Google
 

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