C     RENBR(PAKDIR/PACK MONTHLY BACKUP DIRECTORIES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS PROGRAM  READS  THE  FILES  PRODUCED  BY  BACKUP
C     CONTAINING THE DIRECTORIES OF THE HBS MONTHLY BACKUPS
C     OF  THE  PUBLIC  STRUCTURES,  AND  PRODUCES  A   MUCH
C     COMPACTED VERSION OF  THESE WHICH  CAN BE READ BY THE
C     FNDFIL PROGRAM.
C
      DIMENSION IBUFFR(132),JBUFFR(132),
     1LSTNAM(6),LSTEXT(3),NEWNAM(6),NEWEXT(3),
     2LSTOWN(30),LSTDSK(6),NEWOWN(30),NEWDSK(6),
     3NEWLNG(6),KBUFFR(132),LA5MTH(12),LTRMRK(8)
      DIMENSION IDIGIT(36),LTRDAY(50),KNTDAY(7),
     1LTRPER(19),KNTPER(4),LTRWEK(10),KNTWEK(10),
     2LBUFFR(6),LTRTYP(20),KNTTYP(3),MBUFFR(6)
      COMMON/FNDLOC/LOCFIL
      CHARACTER*20 LOCFIL
      DOUBLE PRECISION FILNAM,FILOUT
      DATA LTRMRK/1H',1H,,1H.,1H*,1H[,1H],1H:,1H /
      DATA LTRTYP/
     11HB,1HA,1HC,1HK,1HU,1HP,
     21HD,1HI,1HR,1HE,1HC,1HT,
     31HC,1HH,1HE,1HC,1HK,1HS,1HU,1HM/
      DATA KNTTYP/6,6,8/
      DATA LA5MTH/
     13HJAN,3HFEB,3HMAR,3HAPR,3HMAY,3HJUN,
     23HJUL,3HAUG,3HSEP,3HOCT,3HNOV,3HDEC/
      DATA MAXOUT/132/
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,
     11HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,
     21HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,
     31HU,1HV,1HW,1HX,1HY,1HZ/
      DATA LTRWEK/1HA,1HB,1HC,1HD,1HE,1H1,1H2,1H3,1H4,1H5/
      DATA KNTWEK/1,1,1,1,1,1,1,1,1,1/
      DATA LTRPER/
     11HD,1HA,1HY,
     21HW,1HE,1HE,1HK,
     31HM,1HO,1HN,1HT,1HH,
     41HP,1HR,1HI,1HV,1HA,1HT,1HE/
      DATA KNTPER/3,4,5,7/
      DATA LTRDAY/
     11HS,1HU,1HN,1HD,1HA,1HY,
     21HM,1HO,1HN,1HD,1HA,1HY,
     31HT,1HU,1HE,1HS,1HD,1HA,1HY,
     41HW,1HE,1HD,1HN,1HE,1HS,1HD,1HA,1HY,
     51HT,1HH,1HU,1HR,1HS,1HD,1HA,1HY,
     61HF,1HR,1HI,1HD,1HA,1HY,
     71HS,1HA,1HT,1HU,1HR,1HD,1HA,1HY/
      DATA KNTDAY/6,6,7,9,8,6,8/
      DATA IDSK,JDSK/20,21/
C
C     CANCEL OUT INITIAL DEVICE AND OWNER
      DO 1 I=1,30
    1 LSTOWN(I)=' '
      DO 2 I=1,6
    2 LSTDSK(I)=' '
      MAXFIL=0
C
C     ASK USER IF PROCESSING DAILY, WEEKLY OR MONTHLY FILES
C     OR A PRIVATE PACK DIRECTORY
      TYPE 3
    3 FORMAT(' PAKDIR'/' Compacts directories for FNDFIL')
    4 TYPE 5
    5 FORMAT(' Period (DAY, WEEK, MONTH) or PRIVATE pack? ',$)
      ACCEPT 9,IBUFFR
      LOWBFR=1
      MANY=0
      CALL DALOSS(1,12,LTRPER,1,4,
     1KNTPER,IBUFFR,132,LOWBFR,KIND,ITIME,LCNWRD,
     2LCNKNT,LCNBFR,MANY,LCNERR)
      IF(KIND.EQ.3)GO TO 6
      IF(KIND.EQ.4)GO TO 6
      GO TO 4
    6 ITIME=ITIME-2
      KNTTAP=0
      IF(ITIME.EQ.2)GO TO 27
      IF(ITIME.EQ.1)GO TO 19
      IF(ITIME.EQ.0)GO TO 15
C
C     ASK USER TO IDENTIFY DAY
    7 TYPE 8
    8 FORMAT(' Day (SUN, MON, etc.)? ',$)
      ACCEPT 9,IBUFFR
    9 FORMAT(132A1)
      LOWBFR=1
      MANY=0
      CALL DALOSS(1,50,LTRDAY,1,7,
     1KNTDAY,IBUFFR,132,LOWBFR,KIND,IDAY,LCNWRD,
     2LCNKNT,LCNBFR,MANY,LCNERR)
      IF(KIND.EQ.3)GO TO 10
      IF(KIND.NE.4)GO TO 7
   10 NAMOUT=4
      I=0
      J=0
   11 J=J+1
      IF(J.GE.IDAY)GO TO 12
      I=I+KNTDAY(J)
      GO TO 11
   12 DO 13 J=1,3
      I=I+1
   13 LBUFFR(J)=LTRDAY(I)
      ENCODE(10,14,FILOUT)LBUFFR(1),LBUFFR(2),LBUFFR(3)
   14 FORMAT(3A1,7H   .FND)
      GO TO 31
C
C     ASK USER TO IDENTIFY WEEK
   15 TYPE 16
   16 FORMAT(' Week (A, B, C, D, E)? ',$)
      ACCEPT 9,IBUFFR
      LOWBFR=1
      MANY=0
      CALL DALOSS(1,10,LTRWEK,1,10,
     1KNTWEK,IBUFFR,132,LOWBFR,KIND,IWEEK,LCNWRD,
     2LCNKNT,LCNBFR,MANY,LCNERR)
      IF(KIND.EQ.3)GO TO 17
      IF(KIND.NE.4)GO TO 15
   17 NAMOUT=4
      IF(IWEEK.GT.5)IWEEK=IWEEK-5
      LBUFFR(1)=1HW
      LBUFFR(2)=1HK
      LBUFFR(3)=LTRWEK(IWEEK)
      ENCODE(10,18,FILOUT)LTRWEK(IWEEK)
   18 FORMAT(4HWEEK,1A1,5H .FND)
      GO TO 31
C
C     ASK USER FOR NUMBER OF FIRST MONTHLY TAPE
   19 TYPE 20
   20 FORMAT(' First tape number (0 if automatic)? ',$)
      ACCEPT 21,KNTTAP
   21 FORMAT(I)
      IF(KNTTAP.GT.0)GO TO 26
      OPEN(UNIT=JDSK,FILE='PAKDIR.NXT',ACCESS='SEQIN',
     1DIRECTORY=LOCFIL,ERR=22)
      READ(JDSK,21,ERR=22),KNTTAP
      CLOSE(UNIT=JDSK,ERR=22)
      IF(KNTTAP.GT.0)GO TO 24
   22 TYPE 23
   23 FORMAT(' Cannot read first tape number from PAKDIR.NXT')
      GO TO 19
   24 ITIME=3
      TYPE 25,KNTTAP
   25 FORMAT(' First tape number will be',1I5)
   26 FILOUT='PAKDIR.FND'
      KNTTAP=KNTTAP-1
      NAMOUT=2
      LBUFFR(1)=1HM
      LBUFFR(2)=1HB
      GO TO 31
C     PRIVATE PACK DIRECTORY
   27 TYPE 28
   28 FORMAT(' Pack name? '$)
      ACCEPT 9,IBUFFR
      ENCODE(10,29,FILOUT)(IBUFFR(I),I=1,4)
   29 FORMAT(4A1,6H  .FND)
      DO 30 I=1,4
   30 LBUFFR(I)=IBUFFR(I)
      NAMOUT=4
   31 CONTINUE
C
C     GET FILE NAME
      OPEN(UNIT=JDSK,FILE=FILOUT,
     1ACCESS='SEQOUT',DIRECTORY=LOCFIL)
      IRECNT=0
   32 KNTFIL=-1
      IEOF=0
   33 TYPE 34
   34 FORMAT(' Author (BACKUP, DIRECT)? '$)
      ACCEPT 9,IBUFFR
      LOWBFR=1
      MANY=0
      CALL DALOSS(1,20,LTRTYP,1,3,
     1KNTTYP,IBUFFR,132,LOWBFR,KIND,IAUTHR,LCNWRD,
     2LCNKNT,LCNBFR,MANY,LCNERR)
      IF(KIND.EQ.1)GO TO 108
      IF(KIND.EQ.3)GO TO 35
      IF(KIND.NE.4)GO TO 33
   35 IAUTHR=IAUTHR-1
      IF(IAUTHR.LE.1)GO TO 37
      TYPE 36
   36 FORMAT(' Checksummed direct not yet supported')
      GO TO 33
   37 TYPE 38
   38 FORMAT(' File? ',$)
      ACCEPT 39,FILNAM
   39 FORMAT(1A10)
      OPEN(UNIT=IDSK,FILE=FILNAM,ACCESS='SEQIN',ERR=40)
      GO TO 42
   40 TYPE 41,FILNAM
   41 FORMAT(' Could not open file ',1A10)
      GO TO 32
C
C     CANCEL OUT LAST NAME AND EXTENSION AT START OF EACH FILE
   42 DO 43 I=1,6
   43 LSTNAM(I)=' '
      DO 44 I=1,3
   44 LSTEXT(I)=' '
      KNTERR=0
      GO TO 49
C
C     NEW OUTPUT TAPE
   45 IEOF=1
   46 IF(NOWOUT.GT.0)WRITE(JDSK,47)(KBUFFR(I),I=1,NOWOUT)
   47 FORMAT(132A1)
      IF(KNTFIL.GT.0)TYPE 48,MBUFFR,KNTFIL
   48 FORMAT(' Tape ',6A1,' contains',I6,' files')
      IF(KNTFIL.GT.0)MAXFIL=MAXFIL+KNTFIL
      IF(IEOF.NE.0)GO TO 32
      KNTTAP=KNTTAP+1
      KNTFIL=0
C
C     READ AND EXPAND NEW LINE FROM DIRECTORY FILE
   49 NOWOUT=0
   50 READ(IDSK,51,END=45)IBUFFR
   51 FORMAT(132A1)
      JUSED=0
      CALL DACOPY(0,8,IBUFFR,1,132,
     1132,JUSED,JBUFFR,NXTINI,NXTBGN,MAXPRT)
      CALL LINTYP(JBUFFR,IFFILE,IAUTHR)
      IF(IFFILE.LT.0)GO TO 46
      IF(IFFILE.EQ.0)GO TO 50
C
C     GET COMPONENTS OF FILE SPEC
      CALL CHOPUP(JBUFFR,NEWNAM,LNGNAM,NEWEXT,LNGEXT,
     1NEWDSK,NEWOWN,KREATE,NEWLNG,IAUTHR,KNTERR)
      IF(KREATE.LT.0)GO TO 50
      IF(IRECNT.LT.KREATE)IRECNT=KREATE
C
C     INSERT SEPARATING COMMA
   52 INIOUT=NOWOUT
      IF(NOWOUT.LE.0)GO TO 53
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H,
C
C     TEST IF OWNER OF FILE CHANGES
   53 NEEDED=0
      DO 54 INDEX=1,30
      IF(NEWOWN(INDEX).NE.1H )GO TO 56
   54 CONTINUE
      DO 55 INDEX=1,30
   55 NEWOWN(INDEX)=LSTOWN(INDEX)
      GO TO 71
   56 DO 57 INDEX=1,30
      IF(NEWOWN(INDEX).NE.LSTOWN(INDEX))GO TO 58
   57 CONTINUE
      GO TO 71
C
C     PUT OWNER INTO BUFFER
   58 NEEDED=1
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H[
      IBASIS=0
      IFCMA=0
      DO 70 IPART=1,5
      JBEGIN=IBASIS
      JEND=IBASIS+6
   59 JBEGIN=JBEGIN+1
      IF(JBEGIN.GT.JEND)GO TO 70
      IF(NEWOWN(JBEGIN).EQ.1H )GO TO 59
   60 IF(NEWOWN(JEND).NE.1H )GO TO 61
      JEND=JEND-1
      GO TO 60
   61 KOLUMN=IBASIS
      DO 62 INDEX=1,6
      KOLUMN=KOLUMN+1
      IF(NEWOWN(KOLUMN).NE.LSTOWN(KOLUMN))GO TO 63
   62 CONTINUE
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H*
      IFCMA=0
      GO TO 70
   63 IF(IFCMA.EQ.0)GO TO 64
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H,
   64 KOLUMN=IBASIS
      IBEGIN=0
      DO 69 INDEX=1,6
      KOLUMN=KOLUMN+1
      IF(KOLUMN.LT.JBEGIN)GO TO 69
      IF(KOLUMN.GT.JEND)GO TO 69
      KOMPAR=NEWOWN(KOLUMN)
      IF(IPART.GT.2)GO TO 65
      IF(KOMPAR.NE.1H0)GO TO 65
      IF(IBEGIN.EQ.0)GO TO 69
   65 DO 66 LOCMRK=1,8
      IF(KOMPAR.EQ.LTRMRK(LOCMRK))GO TO 67
   66 CONTINUE
      GO TO 68
   67 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H'
   68 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=KOMPAR
      IBEGIN=1
   69 CONTINUE
      IFCMA=1
   70 IBASIS=IBASIS+6
C
C     TEST IF DISK CHANGES
   71 DO 72 INDEX=1,6
      IF(NEWDSK(INDEX).NE.1H )GO TO 74
   72 CONTINUE
      DO 73 INDEX=1,6
   73 NEWDSK(INDEX)=LSTDSK(INDEX)
      GO TO 78
   74 DO 75 INDEX=1,6
      IF(NEWDSK(INDEX).NE.LSTDSK(INDEX))GO TO 76
   75 CONTINUE
      GO TO 78
   76 NEEDED=-1
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H:
      DO 77 INDEX=1,6
      IF(NEWDSK(INDEX).EQ.1H )GO TO 77
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=NEWDSK(INDEX)
   77 CONTINUE
C
C     INSERT CLOSING BRACKET IF ONLY OWNER CHANGES,
C     OR INSERT COMMA IF DISK CHANGES
   78 IF(NEEDED.EQ.0)GO TO 79
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      IF(NEEDED.GT.0)KBUFFR(NOWOUT)=1H]
      IF(NEEDED.LT.0)KBUFFR(NOWOUT)=1H,
C
C     INSERT CREATION DATE
   79 J36=KREATE/36
      K36=KREATE-(36*J36)
      I36=J36/36
      J36=J36-(36*I36)
      NOWOUT=NOWOUT+3
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT-2)=IDIGIT(I36+1)
      KBUFFR(NOWOUT-1)=IDIGIT(J36+1)
      KBUFFR(NOWOUT)=IDIGIT(K36+1)
C
C     INSERT LENGTH OF FILE
      DO 80 INDEX=1,6
      IF(NEWLNG(INDEX).EQ.1H )GO TO 80
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=NEWLNG(INDEX)
   80 CONTINUE
C
C     ADD NAME OF FILE TO LINE BEING WRITTEN
      DO 81 INDEX=1,6
      IF(NEWNAM(INDEX).NE.LSTNAM(INDEX))GO TO 82
   81 CONTINUE
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H*
      GO TO 88
   82 DO 87 INDEX=1,LNGNAM
      KOMPAR=NEWNAM(INDEX)
      DO 83 LOCMRK=1,8
      IF(KOMPAR.EQ.LTRMRK(LOCMRK))GO TO 85
   83 CONTINUE
      IF(INDEX.NE.1)GO TO 86
      DO 84 I=1,10
      IF(KOMPAR.EQ.IDIGIT(I))GO TO 85
   84 CONTINUE
      GO TO 86
   85 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H'
   86 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=NEWNAM(INDEX)
   87 CONTINUE
      IF(LNGNAM.GE.6)GO TO 88
      IFDOT=1
      GO TO 89
   88 IFDOT=0
C
C     ADD EXTENSION OF FILE TO LINE BEING WRITTEN
   89 IF(LNGEXT.LE.0)GO TO 97
      DO 90 INDEX=1,3
      IF(NEWEXT(INDEX).NE.LSTEXT(INDEX))GO TO 91
   90 CONTINUE
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H*
      GO TO 97
   91 IF(IFDOT.EQ.0)GO TO 92
      NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H.
   92 DO 96 INDEX=1,LNGEXT
      KOMPAR=NEWEXT(INDEX)
      DO 93 LOCMRK=1,8
      IF(KOMPAR.EQ.LTRMRK(LOCMRK))GO TO 94
   93 CONTINUE
      GO TO 95
   94 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
      KBUFFR(NOWOUT)=1H'
   95 NOWOUT=NOWOUT+1
      IF(NOWOUT.GT.MAXOUT)GO TO 107
   96 KBUFFR(NOWOUT)=KOMPAR
C
C     WRITE OUT TAPE LABEL INTO OUTPUT FILE IF FIRST FILE
   97 IF(KNTFIL.GT.0)GO TO 102
      IF(KNTFIL.LT.0)KNTTAP=KNTTAP+1
      KNTFIL=0
      IF(ITIME.GT.0)GO TO 98
      IF(LSTDSK(4).NE.NEWDSK(4))KNTTAP=1
   98 DO 99 I=1,NAMOUT
      MBUFFR(I)=LBUFFR(I)
   99 CONTINUE
      IF(ITIME.LE.0)MBUFFR(4)=NEWDSK(4)
      LFTNAM=NAMOUT
      I=1
      IF(KNTTAP.GE.10)I=2
      IF(KNTTAP.GE.100)I=3
      IF(KNTTAP.GE.1000)I=4
      IF(KNTTAP.GE.10000)I=5
      IF(KNTTAP.GE.100000)I=6
      IF(LFTNAM.GT.(6-I))LFTNAM=6-I
      CALL DANUMB(1,KNTTAP,10,MBUFFR,LFTNAM,6,6)
      DO 100 I=1,6
  100 IF(MBUFFR(I).EQ.1H )MBUFFR(I)=1H0
      WRITE(JDSK,101)MBUFFR
  101 FORMAT(1H],132A1)
C
C     STORE THE NEW INFORMATION ABOUT THIS FILE
  102 DO 103 INDEX=1,30
  103 LSTOWN(INDEX)=NEWOWN(INDEX)
      DO 104 INDEX=1,6
  104 LSTDSK(INDEX)=NEWDSK(INDEX)
      DO 105 INDEX=1,6
  105 LSTNAM(INDEX)=NEWNAM(INDEX)
      DO 106 INDEX=1,3
  106 LSTEXT(INDEX)=NEWEXT(INDEX)
      KNTFIL=KNTFIL+1
      GO TO 50
C
C     OUTPUT LINE IF NEW DESCRIPTION WOULD OVERFLOW LINE
  107 IF(INIOUT.GT.0)WRITE(JDSK,47)(KBUFFR(I),I=1,INIOUT)
      NOWOUT=0
      GO TO 52
C
C     IF PUBLIC PACK, CHANGE NAME OF OUTPUT FILE TO BE BASED ON DATE
  108 IF(ITIME.LE.0)GO TO 119
      IF(ITIME.EQ.2)GO TO 119
      IYEAR=IRECNT/(12*31)
      IMONTH=(IRECNT/31)-(12*IYEAR)
      IDATE=IRECNT-(31*IMONTH)-(12*31*IYEAR)
      IYEAR=IYEAR+64
      IF(IYEAR.GE.100)IYEAR=IYEAR-100
      IMONTH=IMONTH+1
      IDATE=IDATE+1
      IF(IDATE.GT.15)GO TO 109
      IMONTH=IMONTH-1
      IF(IMONTH.GT.0)GO TO 109
      IMONTH=12
      IYEAR=IYEAR-1
  109 IF(IYEAR.LT.10)ENCODE(10,110,FILOUT)LA5MTH(IMONTH),IYEAR
      IF(IYEAR.GE.10)ENCODE(10,111,FILOUT)LA5MTH(IMONTH),IYEAR
  110 FORMAT(1A3,1H0,1I1,5H .FND)
  111 FORMAT(1A3,1I2,5H .FND)
      CLOSE(UNIT=JDSK,FILE=FILOUT,ERR=112)
      GO TO 114
  112 TYPE 113,FILOUT
  113 FORMAT(' File PAKDIR.FND cannot be renamed to ',1A10)
      FILOUT='PAKDIR.FND'
  114 IF(ITIME.NE.3)GO TO 120
      KNTTAP=KNTTAP+1
      OPEN(UNIT=JDSK,FILE='PAKDIR.NXT',ACCESS='SEQOUT',
     1DIRECTORY=LOCFIL,ERR=117)
      WRITE(JDSK,115,ERR=117)KNTTAP
  115 FORMAT(I10)
      CLOSE(UNIT=JDSK,ERR=117)
      TYPE 116,KNTTAP
  116 FORMAT(' Next montly save will begin with tape',1I5)
      GO TO 120
  117 TYPE 118
  118 FORMAT(' Cannot write next tape number in PAKDIR.NXT')
      GO TO 120
  119 CLOSE(UNIT=JDSK)
C
C     INFORM USER OF WHAT HAS BEEN DONE BY THIS PROGRAM
  120 IF(KNTFIL.GT.0)TYPE 48,MBUFFR,KNTFIL
      TYPE 121,MAXFIL
  121 FORMAT(1X,I6,' total files')
      TYPE 122,FILOUT
  122 FORMAT(' Output file is ',1A10)
      STOP
      END
      SUBROUTINE LINTYP(JBUFFR,IFFILE,IAUTHR)
C     RENBR(/IDENTIFY TYPE OF LINE IN INPUT DIRECTORY)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE DETERMINES IF LINE CONTAINS A FILE
C     SPECIFICATION BY TESTING FOR THE < AND > AROUND THE
C     PROTECTION CODE AND FOR THE MINUS SIGNS IN THE DATE
C     FIELD.  LINES WHICH START NEW TAPES ARE ALSO
C     IDENTIFIED.
C
C     IFFILE = -1, RETURNED IF STARTING NEW TAPE
C            = 0, RETURNED IF NOT A FILE SPEC
C            = 1, RETURNED IF IS A FILE SPEC
C
      COMMON/FNDFMT/LOCBAC(10),LOCDIR(10)
      DIMENSION JBUFFR(132),LTRCON(24),LTRBGN(17),LTRTHR(16)
C
C     LINE BEFORE FIRST TAPE IN DIRECTORY WRITTEN BY BACKUP
      DATA LTRBGN/
     11HS,1Ht,1Ha,1Hr,1Ht,1H ,1Ho,1Hf,1H ,1Hs,
     21Ha,1Hv,1He,1H ,1Hs,1He,1Ht/
C
C     LINE BEFORE CONTINUATION TAPE IN DIRECTORY WRITTEN BY BACKUP
      DATA LTRCON/
     11HC,1Ho,1Hn,1Ht,1Hi,1Hn,1Hu,1Ha,1Ht,1Hi,
     21Ho,1Hn,1H ,1Ho,1Hf,1H ,1Hs,1Ha,1Hv,1He,
     31H ,1Hs,1He,1Ht/
C
C     LINE BEFORE EACH TAPE IN DIRECTORY WRITTEN BY DIRECT
      DATA LTRTHR/
     11H ,1H ,1H ,1HR,1He,1Ha,1Hd,1H ,1HD,1He,
     21Hn,1Hs,1Hi,1Ht,1Hy,1H:/
C
C     BRANCH TO CODE FOR PROGRAM WHICH WROTE DIRECTORY
      IF(IAUTHR.NE.0)GO TO 5
C
C     TEST FOR START OF TAPE IF BACKUP MADE DIRECTORIES
C     LOCLES = LOCATION OF LESS THAN SIGN IN FILE SPEC
C     LOCGRT = LOCATION OF GREATER THAN SIGN IN FILE SPEC
C     LOC1ST = LOCATION OF FIRST MINUS SIGN IN DATE
C     LOC2ND = LOCATION OF SECOND MINUS SIGN IN DATE
      LOCLES=LOCBAC(7)
      LOCGRT=LOCBAC(8)
      LOC1ST=LOCBAC(9)
      LOC2ND=LOCBAC(10)
      DO 1 I=1,24
      IF(JBUFFR(I).NE.LTRCON(I))GO TO 2
    1 CONTINUE
      IFFILE=-1
      GO TO 8
    2 INDEX=0
    3 INDEX=INDEX+1
      IF(INDEX.GT.(132-17))GO TO 7
      JNDEX=INDEX
      DO 4 I=1,17
      IF(JBUFFR(JNDEX).NE.LTRBGN(I))GO TO 3
    4 JNDEX=JNDEX+1
      IFFILE=-1
      GO TO 8
C
C     TEST FOR START OF TAPE IF DIRECT/MID USED
    5 LOCLES=LOCDIR(7)
      LOCGRT=LOCDIR(8)
      LOC1ST=LOCDIR(9)
      LOC2ND=LOCDIR(10)
      DO 6 I=1,16
      IF(JBUFFR(I).NE.LTRTHR(I))GO TO 7
    6 CONTINUE
      IFFILE=-1
      GO TO 8
C
C     TEST FOR LINE CONTAINING FILE DESCRIPTION
    7 IFFILE=0
      IF(JBUFFR(LOCLES).NE.1H<)GO TO 8
      IF(JBUFFR(LOCGRT).NE.1H>)GO TO 8
      IF(JBUFFR(LOC1ST).NE.1H-)GO TO 8
      IF(JBUFFR(LOC2ND).NE.1H-)GO TO 8
      IFFILE=1
    8 RETURN
      END
      SUBROUTINE CHOPUP(JBUFFR,NEWNAM,LNGNAM,NEWEXT,LNGEXT,
     1NEWLOC,NEWOWN,KREATE,NEWLNG,IAUTHR,KNTERR)
C     RENBR(/CHOP UP LINE IN DIRECTORY INTO PARTS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     JBUFFR = INPUT CHARACTER STRING, RETURNED UNCHANGED
C     NEWNAM = RETURNED WITH FILE NAME
C     LNGNAM = RETURNED WITH NUMBER OF CHARACTERS IN FILE NAME
C     NEWEXT = RETURNED WITH FILE EXTENSION
C     LNGEXT = RETURNED WITH NUMBER OF CHARACTERS IN EXTENSION
C     NEWLOC = RETURNED WITH CHARACTERS OF DEVICE NAME
C     NEWOWN = RETURNED WITH PATH.  EACH COMPONENT OF PATH IS
C              LEFT JUSTIFIED IN 6 CHARACTERS WITH BLANK FILL.
C              NEITHER BRACKETS NOR COMMAS ARE INCLUDED.
C     KREATE = RETURNED WITH CREATION DATE AS NUMBER OF DAYS
C              SINCE 1-JAN-64, ASSUMING 31 DAY MONTHS
C     NEWLNG = RETURNED WITH CHARACTERS OF FILE LENGTH
C              WITH BLANK FILL
C
      COMMON/FNDFMT/LOCBAC(10),LOCDIR(10)
      DIMENSION JBUFFR(132),NEWNAM(6),NEWEXT(3),
     1NEWLNG(6),NEWDAT(9),NEWLOC(6),NEWOWN(30),LTRMTH(36),
     2LWRMTH(36),LTRDGT(10)
C     UPPER CASE FIRST 3 LETTERS OF EACH MONTH NAME
      DATA LTRMTH/
     1 1HJ,1HA,1HN,    1HF,1HE,1HB,    1HM,1HA,1HR,
     2 1HA,1HP,1HR,    1HM,1HA,1HY,    1HJ,1HU,1HN,
     3 1HJ,1HU,1HL,    1HA,1HU,1HG,    1HS,1HE,1HP,
     4 1HO,1HC,1HT,    1HN,1HO,1HV,    1HD,1HE,1HC/
C     LOWER CASE FIRST 3 LETTERS OF EACH MONTH NAME
      DATA LWRMTH/
     1 1Hj,1Ha,1Hn,    1Hf,1He,1Hb,    1Hm,1Ha,1Hr,
     2 1Ha,1Hp,1Hr,    1Hm,1Ha,1Hy,    1Hj,1Hu,1Hn,
     3 1Hj,1Hu,1Hl,    1Ha,1Hu,1Hg,    1Hs,1He,1Hp,
     4 1Ho,1Hc,1Ht,    1Hn,1Ho,1Hv,    1Hd,1He,1Hc/
C     DIGITS 0 THROUGH 9
      DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
      IF(IAUTHR.NE.0)GO TO 1
C
C     DEFINE FIELD LOCATIONS IF BACKUP MADE DIRECTORIES
      ININAM=LOCBAC(1)
      INIEXT=LOCBAC(2)
      INILNG=LOCBAC(3)
      INIDAT=LOCBAC(4)
      INILOC=LOCBAC(5)
      INIOWN=LOCBAC(6)
      GO TO 2
C
C     DEFINE FIELD LOCATIONS IF DIRECT MADE DIRECTORIES
    1 ININAM=LOCDIR(1)
      INIEXT=LOCDIR(2)
      INILNG=LOCDIR(3)
      INIDAT=LOCDIR(4)
      INILOC=LOCDIR(5)
      INIOWN=LOCDIR(6)
C
C     GET FILE NAME
    2 KOLUMN=ININAM
      LNGNAM=0
      DO 3 KOPY=1,6
      NEWNAM(KOPY)=JBUFFR(KOLUMN)
      IF(JBUFFR(KOLUMN).NE.1H )LNGNAM=KOPY
    3 KOLUMN=KOLUMN+1
C
C     GET FILE EXTENSION
      KOLUMN=INIEXT
      LNGEXT=0
      DO 4 KOPY=1,3
      NEWEXT(KOPY)=JBUFFR(KOLUMN)
      IF(JBUFFR(KOLUMN).NE.1H )LNGEXT=KOPY
    4 KOLUMN=KOLUMN+1
C
C     GET FILE LENGTH
      KOLUMN=INILNG
      DO 5 KOPY=1,6
      NEWLNG(KOPY)=JBUFFR(KOLUMN)
    5 KOLUMN=KOLUMN+1
C
C     GET FILE CREATION DATE
      KOLUMN=INIDAT
      DO 6 KOPY=1,9
      NEWDAT(KOPY)=JBUFFR(KOLUMN)
    6 KOLUMN=KOLUMN+1
C
C     GET FILE LOCATION
      NXTCLM=INILOC
      KOLUMN=INILOC-1
    7 IF(NXTCLM.GT.132)GO TO 8
      IF(JBUFFR(NXTCLM).EQ.1H:)GO TO 8
      IF(JBUFFR(NXTCLM).EQ.1H )KOLUMN=NXTCLM
      NXTCLM=NXTCLM+1
      GO TO 7
    8 DO 10 KOPY=1,6
      KOLUMN=KOLUMN+1
      IF(KOLUMN.GE.NXTCLM)GO TO 9
      NEWLOC(KOPY)=JBUFFR(KOLUMN)
      GO TO 10
    9 NEWLOC(KOPY)=' '
   10 CONTINUE
C
C     GET FILE OWNER
      KOLUMN=INIOWN
      NXTCLM=0
   11 IF(JBUFFR(KOLUMN).EQ.1H[)GO TO 12
      KOLUMN=KOLUMN+1
      IF(KOLUMN.LE.132)GO TO 11
   12 KOLUMN=KOLUMN+1
      DO 16 KOPY=1,30
   13 IF(KOPY.LE.NXTCLM)GO TO 15
      IF(KOLUMN.GT.132)GO TO 15
      IF(JBUFFR(KOLUMN).EQ.1H])GO TO 15
      IF(JBUFFR(KOLUMN).NE.1H,)GO TO 14
      KOLUMN=KOLUMN+1
      NXTCLM=NXTCLM+6
      GO TO 13
   14 NEWOWN(KOPY)=JBUFFR(KOLUMN)
      KOLUMN=KOLUMN+1
      GO TO 16
   15 NEWOWN(KOPY)=' '
   16 CONTINUE
C
C     EVALUATE DAY
      IDATE=0
      DO 18 I=1,2
      LTRNOW=NEWDAT(I)
      DO 17 J=1,10
      IF(LTRNOW.NE.LTRDGT(J))GO TO 17
      IDATE=(10*IDATE)+J-1
      GO TO 18
   17 CONTINUE
   18 CONTINUE
C
C     EVALUATE YEAR
      IYEAR=0
      DO 20 I=8,9
      LTRNOW=NEWDAT(I)
      DO 19 J=1,10
      IF(LTRNOW.NE.LTRDGT(J))GO TO 19
      IYEAR=(10*IYEAR)+J-1
      GO TO 20
   19 CONTINUE
   20 CONTINUE
C
C     EVALUATE 3 LETTER MONTH ABBREVIATION
      IMONTH=0
      JMONTH=0
   21 IMONTH=IMONTH+1
      IF(IMONTH.GT.12)GO TO 23
      I=3
      J=JMONTH
      JMONTH=JMONTH+3
   22 IF(J.GE.JMONTH)GO TO 25
      I=I+1
      J=J+1
      IF(NEWDAT(I).EQ.LTRMTH(J))GO TO 22
      IF(NEWDAT(I).EQ.LWRMTH(J))GO TO 22
      GO TO 21
C
C     ERROR IN INPUT LINE
   23 KREATE=-1
      IF(KNTERR.EQ.0)TYPE 24
   24 FORMAT(' *** Input file contains errors ***')
      KNTERR=KNTERR+1
      GO TO 26
C
C     CONVERT TO 1 JAN 64 AS BASE
   25 IYEAR=IYEAR-64
      IF(IYEAR.LT.0)IYEAR=IYEAR+100
      KREATE=(12*31*IYEAR)+(31*(IMONTH-1))+(IDATE-1)
C
C     RETURN TO CALLING PROGRAM
   26 RETURN
      END

