Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50553/fndfil.for
There are no other files named fndfil.for in the archive.
C RENBR(FNDFIL/SEARCH MONTHLY BACKUP TAPE DIRECTORIES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
DOUBLE PRECISION LTRDAT,DAYNAM(7),WEKNAM(5)
DIMENSION IWORD(36)
DIMENSION LOWER(12),JUNIT(7)
DIMENSION MCHNAM(100,6),MCHEXT(100,3),
1MCHDSK(25,6),IFPRVT(25),MCHNUM(30,3,6)
DIMENSION ITAPE(6),IUNIT(6),IPUN(30),KOMPCT(48)
DIMENSION IBUFFR(132),NEWNAM(6),NEWEXT(3),IDIGIT(36)
DIMENSION MONTHS(12)
COMMON/FNDLOC/LOCFIL
CHARACTER*20 LOCFIL
DOUBLE PRECISION FILNAM,OUTFIL
C
C INFORMATION FOR OPENING OUTPUT FILE
CHARACTER CHRNAM*10,CHRPPN*20,CHRDVC*6
C
C LMTDSK = MAXIMUM NUMBER OF DEVICE NAMES
C LMTNAM = MAXIMUM NUMBER OF FILE NAMES
C LMTNUM = MAXIMUM NUMBER OF DIRECTORIES
DATA LMTDSK,LMTNAM,LMTNUM/25,100,30/
C
C MINMTH = FIRST MONTH FOR WHICH HAVE DATA
C MINYER = RIGHT 2 DIGITS OF 1ST YEAR FOR WHICH HAVE DATA
C FOR YEAR 2000 AND BEYOND, ADD 100 TO RIGHT 2 DIGITS
DATA MINMTH,MINYER/8,72/
C
C MAXBFR = NUMBER OF CHARACTERS IN EACH INPUT LINE
DATA MAXBFR/132/
DATA DAYNAM/
1'SUN .FND',
2'MON .FND',
3'TUE .FND',
4'WED .FND',
5'THU .FND',
6'FRI .FND',
7'SAT .FND'/
DATA LMTDAY/7/
DATA WEKNAM/
1'WEEKA .FND',
2'WEEKB .FND',
3'WEEKC .FND',
4'WEEKD .FND',
5'WEEKE .FND'/
DATA LMTWEK/5/
DATA LOWER/3HJan,3HFeb,3HMar,3HApr,3HMay,3HJun,
13HJul,3HAug,3HSep,3HOct,3HNov,3HDec/
DATA IRIGHT/1H]/
DATA IWORD /1HJ,1Ha,1Hn,1HF,1He,1Hb,1HM,1Ha,1Hr,
11HA,1Hp,1Hr,1HM,1Ha,1Hy,1HJ,1Hu,1Hn,1HJ,1Hu,1Hl,
21HA,1Hu,1Hg,1HS,1He,1Hp,1HO,1Hc,1Ht,1HN,1Ho,1Hv,
31HD,1He,1Hc/
DATA MONTHS/3HJAN,3HFEB,3HMAR,3HAPR,3HMAY,3HJUN,
13HJUL,3HAUG,3HSEP,3HOCT,3HNOV,3HDEC/
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 IDSK,JDSK,KDSK,ITTY,JTTY/20,21,1,5,5/
C
C KNTRLC = 0, NOT PROCESSING COMMAND
C = 1, FINISHED WITH PROCESSING OF COMMAND
C = -1, PROCESSING COMMAND
DATA KNTRLC/0/
C
C FIND OUT WHO IS RUNNING THIS PROGRAM
CALL PPNU(LCLPRJ,LCLPRG)
C
C ALLOW ONLY COMPUTER SERVICES TO LIST FILES FOR ANYONE
NONDCS=0
IF(LCLPRG.GE."400)NONDCS=1
C
C DETERMINE CURRENT DATE TO USE AS SWITCH LIMIT
WRITE(JTTY,1)
1 FORMAT(' FNDFIL (09/84)')
CALL DATE(LTRDAT)
DECODE(9,2,LTRDAT)LTRMTH,MAXYER
2 FORMAT(3X,1A3,1X,1I2)
DO 3 I=1,12
IF(LTRMTH.NE.LOWER(I))GO TO 3
MAXMTH=I
GO TO 5
3 CONTINUE
WRITE(JTTY,4)LTRMTH
4 FORMAT(' Could not identify month ',1A3)
MAXMTH=12
5 IF(MAXYER.LT.64)MAXYER=MAXYER+100
C
C CHECK IF USER INTERRUPTED PROCESSING
IF(KNTRLC.LT.0)GO TO 7
WRITE(JTTY,6)
6 FORMAT(' Type /HELP for instructions')
IAGAIN=0
KNTRLC=0
GO TO 15
7 WRITE(JTTY,8)
8 FORMAT(' Type /REPEAT to repeat same list')
C
C RETURN FIRST 2 ENTRIES IN EACH NUMBER TO LEFT JUSTIFICATION
9 IAGAIN=1
KNTRLC=1
IF(KNTNUM.EQ.0)GO TO 14
DO 13 M=1,KNTNUM
DO 12 I=1,2
L=1
K=1
DO 10 J=1,6
IF(MCHNUM(M,I,K).EQ.1H )GO TO 10
MCHNUM(M,I,L)=MCHNUM(M,I,K)
L=L+1
10 K=K+1
11 IF(L.GT.6)GO TO 12
MCHNUM(M,I,L)=' '
L=L+1
GO TO 11
12 CONTINUE
13 CONTINUE
14 CONTINUE
C
C GET LIST OF DESIRED FILES
15 CALL MNYFIL(KDSK,ITTY,JTTY,LMTDSK,LMTNAM,
1 LMTNUM,MINMTH,MINYER,MAXMTH,MAXYER,KNTDSK,KNTNAM,
2 KNTNUM,MCHDSK,MCHNAM,MCHEXT,MCHNUM,IFFILE,
3 INIMTH,INIYER,LMTMTH,LMTYER,IFSKIM,NONDCS,LCLPRG,
4 IFDATE,IDSK,IAGAIN,IFPRVT,IEXPIR,
5 CHRNAM,CHRPPN,CHRDVC)
IF(IFDATE.NE.0)NOWMTH=LMTMTH
IF(IFDATE.NE.0)NOWYER=LMTYER
KNTRLC=-1
C
C RIGHT JUSTIFY FIRST 2 ENTRIES IN EACH NUMBER
IF(KNTNUM.EQ.0)GO TO 20
DO 19 M=1,KNTNUM
DO 18 I=1,2
L=6
K=6
DO 16 J=1,6
IF(MCHNUM(M,I,K).EQ.1H )GO TO 16
MCHNUM(M,I,L)=MCHNUM(M,I,K)
L=L-1
16 K=K-1
17 IF(L.LE.0)GO TO 18
MCHNUM(M,I,L)=' '
L=L-1
GO TO 17
18 CONTINUE
19 CONTINUE
20 CONTINUE
C
C COUNT NUMBER OF PUBLIC STRUCTURES SPECIFIED
KNTPUB=0
IF(KNTDSK.EQ.0)GO TO 22
DO 21 I=1,KNTDSK
IF(IFPRVT(I).EQ.0)KNTPUB=KNTPUB+1
21 CONTINUE
22 CONTINUE
C
C OPEN OUTPUT FILE IF NOT GOING TO TERMINAL
IF(IFFILE.EQ.0)GO TO 25
IF(IFFILE.EQ.1)OPEN(UNIT=JDSK,ACCESS='SEQOUT',ERR=23,
1 DEVICE=CHRDVC,FILE=CHRNAM)
IF(IFFILE.EQ.2)OPEN(UNIT=JDSK,ACCESS='SEQOUT',ERR=23,
1 DIRECTORY=CHRPPN,DEVICE=CHRDVC,FILE=CHRNAM)
GO TO 25
23 WRITE(JTTY,24)
24 FORMAT(
1' Cannot open output file.'/
2' Please retype entire command,'/
3' or type correct output specification followed by',
4' =/REPEAT'/
5' for same list.')
GO TO 9
25 CONTINUE
C
C ILOOP = 1, PRIVATE PACKS
C = 2, DAILY SKIM
C = 3, WEEKLY SKIM
C = 4, MONTHLY SAVES
MCHTTL=0
LNGTTL=0
KNTMSG=0
JLOOP=0
IFTELL=0
DO 132 ILOOP=1,4
GO TO(26,31,35,39),ILOOP
C
C TEST FOR PRIVATE PACK DIRECTORY
26 IPRVAT=0
27 IPRVAT=IPRVAT+1
IF(IPRVAT.GT.KNTDSK)GO TO 30
IF(IFPRVT(IPRVAT).EQ.0)GO TO 27
ENCODE(10,28,FILNAM)(MCHDSK(IPRVAT,I),I=1,6)
28 FORMAT(6A1,4H.FND)
IF(IFTELL.NE.ILOOP)WRITE(JTTY,29)
29 FORMAT(1X/' Searching private pack directories')
GO TO 47
30 IPRVAT=0
GO TO 127
C
C DEFINE LOOP LIMITS FOR DAILY SKIM TAPES
C FORCE SKIM IF SPECIFIC PUBLIC STRUCTURE BUT NO DATE
31 IF(IFSKIM.NE.0)GO TO 32
IF(IFDATE.NE.0)GO TO 132
IF(KNTDSK.EQ.0)GO TO 32
IF(KNTPUB.EQ.0)GO TO 132
32 NOWDAY=LMTDAY+1
33 NOWDAY=NOWDAY-1
IF(NOWDAY.LE.0)GO TO 127
IF(IFTELL.NE.ILOOP)WRITE(JTTY,34)
34 FORMAT(1X/
1' Searching daily skim tape directories')
FILNAM=DAYNAM(NOWDAY)
GO TO 47
C
C DEFINE LOOP LIMITS FOR WEEKLY SKIM TAPES
35 IF(IFSKIM.NE.0)GO TO 36
IF(IFDATE.NE.0)GO TO 132
IF(KNTDSK.EQ.0)GO TO 36
IF(KNTPUB.EQ.0)GO TO 132
36 NOWWEK=LMTWEK+1
37 NOWWEK=NOWWEK-1
IF(NOWWEK.LE.0)GO TO 127
IF(IFTELL.NE.ILOOP)WRITE(JTTY,38)
38 FORMAT(1X/
1' Searching weekly skim tape directories')
FILNAM=WEKNAM(NOWWEK)
GO TO 47
C
C DEFINE LOOP LIMITS FOR MONTHLY TAPES
39 IF(IFDATE.EQ.0)GO TO 132
NOWMTH=LMTMTH+1
NOWYER=LMTYER
40 NOWMTH=NOWMTH-1
IF(NOWMTH.GT.0)GO TO 41
NOWMTH=12
NOWYER=NOWYER-1
41 IF(NOWYER.GT.INIYER)GO TO 42
IF(NOWYER.LT.INIYER)GO TO 127
IF(NOWMTH.LT.INIMTH)GO TO 127
42 IF(IFTELL.NE.ILOOP)WRITE(JTTY,43)
43 FORMAT(1X/' Searching monthly full save directories')
NEWYER=NOWYER
IF(NEWYER.GE.100)NEWYER=NEWYER-100
C
C CHECK IF MONTHLY TAPE HAS BEEN RECYCLED
C RECYCL RETURNS IERASE=1 IF TAPE NO LONGER AVAILABLE
C RECYCL DOES NOT NEED TO BE CALLED IF ALL TAPES AVAILABLE
IERASE=0
CALL FNDNEW(MAXMTH,MAXYER,NOWMTH,NOWYER,IERASE)
IF(IEXPIR.NE.0)GO TO 44
IF(IERASE.NE.0)GO TO 124
44 CONTINUE
C
C CONSTRUCT NAME OF DIRECTORY OF MONTHLY SAVE TAPES
IF(NEWYER.LT.10)ENCODE(10,45,FILNAM)
1MONTHS(NOWMTH),NEWYER
45 FORMAT(1A3,1H0,1I1,'.FND')
IF(NEWYER.GE.10)ENCODE(10,46,FILNAM)
1MONTHS(NOWMTH),NEWYER
46 FORMAT(1A3,I2,'.FND')
C
C CHECK IF DIRECTORY FILE EXISTS
47 IF(JLOOP.EQ.ILOOP)GO TO 49
IFTELL=ILOOP
MCHLCL=0
LNGLCL=0
KNTMSG=KNTMSG+1
GO TO(49,48,48,49),ILOOP
48 JLOOP=ILOOP
49 OPEN(UNIT=IDSK,FILE=FILNAM,ACCESS='SEQIN',ERR=116,
1DIRECTORY=LOCFIL)
C
C GET NEXT ITEM FROM INPUT FILE BEING READ
50 READ(IDSK,51,END=119)IBUFFR
51 FORMAT(132A1)
IF(IBUFFR(1).EQ.1H])GO TO 105
LIMIT=0
52 LIMIT=LIMIT+1
IF(LIMIT.GT.MAXBFR)GO TO 50
KOMPAR=IBUFFR(LIMIT)
IF(KOMPAR.EQ.1H])GO TO 52
IF(KOMPAR.EQ.1H[)GO TO 81
IF(KOMPAR.EQ.1H,)GO TO 52
IF(KOMPAR.EQ.1H:)GO TO 100
INIBFR=LIMIT
GO TO 54
53 IF(LIMIT.GT.MAXBFR)GO TO 56
KOMPAR=IBUFFR(LIMIT)
54 IF(KOMPAR.EQ.1H )GO TO 56
IF(KOMPAR.EQ.1H')GO TO 55
IF(KOMPAR.EQ.1H,)GO TO 56
LIMIT=LIMIT+1
GO TO 53
55 LIMIT=LIMIT+2
GO TO 53
56 IF(LIMIT.LE.INIBFR)GO TO 50
LIMIT=LIMIT-1
INDEX=INIBFR+3
57 INDEX=INDEX+1
KOMPAR=IBUFFR(INDEX)
IF(KOMPAR.LT.1H0)GO TO 58
IF(KOMPAR.GT.1H9)GO TO 58
GO TO 57
C
C GET FILE NAME
58 IF(IBUFFR(INDEX).EQ.1H*)GO TO 61
LNGNAM=0
59 IF(INDEX.GT.LIMIT)GO TO 65
KOMPAR=IBUFFR(INDEX)
IF(KOMPAR.EQ.1H*)GO TO 66
IF(KOMPAR.EQ.1H.)GO TO 61
IF(KOMPAR.NE.1H')GO TO 60
INDEX=INDEX+1
KOMPAR=IBUFFR(INDEX)
60 LNGNAM=LNGNAM+1
NEWNAM(LNGNAM)=KOMPAR
INDEX=INDEX+1
IF(LNGNAM.LT.6)GO TO 59
GO TO 62
C
C GET EXTENSION
61 INDEX=INDEX+1
62 IF(IBUFFR(INDEX).EQ.1H*)GO TO 66
LNGEXT=0
63 IF(INDEX.GT.LIMIT)GO TO 66
KOMPAR=IBUFFR(INDEX)
IF(KOMPAR.NE.1H')GO TO 64
INDEX=INDEX+1
KOMPAR=IBUFFR(INDEX)
64 LNGEXT=LNGEXT+1
NEWEXT(LNGEXT)=KOMPAR
INDEX=INDEX+1
IF(LNGEXT.LT.3)GO TO 63
GO TO 66
65 LNGEXT=0
C
C FILL OUT REST OF NAME AND EXTENSION
66 IF(LNGNAM.GE.6)GO TO 67
LNGNAM=LNGNAM+1
NEWNAM(LNGNAM)=' '
GO TO 66
67 IF(LNGEXT.GE.3)GO TO 68
LNGEXT=LNGEXT+1
NEWEXT(LNGEXT)=' '
GO TO 67
C
C CHECK IF WE HAVE A MATCH
68 IF(IGNORE.NE.0)GO TO 52
IF(KNTNAM.LE.0)GO TO 72
NOWFIL=KNTNAM+1
69 NOWFIL=NOWFIL-1
IF(NOWFIL.LE.0)GO TO 52
DO 70 I=1,6
IF(MCHNAM(NOWFIL,I).EQ.1H?)GO TO 70
IF(NEWNAM(I).NE.MCHNAM(NOWFIL,I))GO TO 69
70 CONTINUE
DO 71 I=1,3
IF(MCHEXT(NOWFIL,I).EQ.1H?)GO TO 71
IF(NEWEXT(I).NE.MCHEXT(NOWFIL,I))GO TO 69
71 CONTINUE
C
C GET CREATION DATE
72 KREATE=0
DO 74 INDEX=1,3
KOMPAR=IBUFFR(INIBFR)
KREATE=36*KREATE
DO 73 I=1,36
IF(KOMPAR.NE.IDIGIT(I))GO TO 73
KREATE=KREATE+I-1
GO TO 74
73 CONTINUE
74 INIBFR=INIBFR+1
IMONTH=KREATE/31
IDAY=KREATE-(31*IMONTH)
IYEAR=IMONTH/12
IMONTH=IMONTH-(12*IYEAR)
IYEAR=IYEAR+64
IF(IYEAR.GE.100)IYEAR=IYEAR-100
IMONTH=IMONTH+1
IDAY=IDAY+1
C
C GET LENGTH
LENGTH=0
75 KOMPAR=IBUFFR(INIBFR)
INIBFR=INIBFR+1
DO 76 I=1,10
IF(KOMPAR.NE.IDIGIT(I))GO TO 76
LENGTH=10*LENGTH+I-1
GO TO 75
76 CONTINUE
MCHLCL=MCHLCL+1
LNGLCL=LNGLCL+LENGTH
MCHTTL=MCHTTL+1
LNGTTL=LNGTTL+LENGTH
C
C WRITE DESCRIPTION OF FILE TO TERMINAL OR TO FILE
IF(LENGTH.GT.99999)GO TO 78
IF(IFFILE.EQ.0)WRITE(JTTY,77)ITAPE,JUNIT,NEWNAM,NEWEXT,
1LENGTH,IDAY,MONTHS(IMONTH),IYEAR,
2(KOMPCT(I),I=1,MSTSHO),IRIGHT
IF(IFFILE.NE.0)WRITE(JDSK,77)ITAPE,JUNIT,NEWNAM,
1NEWEXT,LENGTH,IDAY,MONTHS(IMONTH),IYEAR,
2(KOMPCT(I),I=1,MSTSHO),IRIGHT
77 FORMAT(1X,6A1,1X,7A1,6A1,1H.,3A1,I5,I3,1H-,
1A3,1H-,I2,1X,1H[,100A1)
GO TO 80
C REPORT THOUSANDS OF BLOCKS IF FIELD WOULD OVERFLOW
78 LENGTH=LENGTH/1000
IF(IFFILE.EQ.0)WRITE(JTTY,79)ITAPE,JUNIT,NEWNAM,NEWEXT,
1LENGTH,IDAY,MONTHS(IMONTH),IYEAR,
2(KOMPCT(I),I=1,MSTSHO),IRIGHT
IF(IFFILE.NE.0)WRITE(JDSK,79)ITAPE,JUNIT,NEWNAM,
1NEWEXT,LENGTH,IDAY,MONTHS(IMONTH),IYEAR,
2(KOMPCT(I),I=1,MSTSHO),IRIGHT
79 FORMAT(1X,6A1,1X,7A1,6A1,1H.,3A1,I5,1HK,I2,1H-,
1A3,1H-,I2,1X,1H[,100A1)
80 GO TO 52
C
C GET PROJECT-USER NUMBER AND SFD NAMES IF ANY
81 INDEX=LIMIT
LIMIT=LIMIT+1
82 IF(LIMIT.GT.MAXBFR)GO TO 84
KOMPAR=IBUFFR(LIMIT)
IF(KOMPAR.EQ.1H')GO TO 83
IF(KOMPAR.EQ.1H )GO TO 84
IF(KOMPAR.EQ.1H])GO TO 84
IF(KOMPAR.EQ.1H:)GO TO 84
LIMIT=LIMIT+1
GO TO 82
83 LIMIT=LIMIT+2
GO TO 82
84 LIMIT=LIMIT-1
MSTSHO=0
KOLUMN=0
85 INDEX=INDEX+1
IF(INDEX.GT.LIMIT)GO TO 95
IF(IBUFFR(INDEX).EQ.1H])GO TO 95
IF(MSTSHO.LE.0)GO TO 86
MSTSHO=MSTSHO+1
KOMPCT(MSTSHO)=1H,
86 IF(IBUFFR(INDEX).NE.1H*)GO TO 88
IF(KOLUMN.GE.30)GO TO 85
DO 87 I=1,6
KOLUMN=KOLUMN+1
IF(IPUN(KOLUMN).EQ.1H )GO TO 87
MSTSHO=MSTSHO+1
KOMPCT(MSTSHO)=IPUN(KOLUMN)
87 CONTINUE
GO TO 85
88 LOCAL=0
89 IF(IBUFFR(INDEX).NE.1H')GO TO 90
IF(INDEX.LT.LIMIT)INDEX=INDEX+1
90 LOCAL=LOCAL+1
IF(LOCAL.GT.6)GO TO 91
IF(KOLUMN.GE.30)GO TO 91
KOLUMN=KOLUMN+1
IPUN(KOLUMN)=IBUFFR(INDEX)
MSTSHO=MSTSHO+1
KOMPCT(MSTSHO)=IBUFFR(INDEX)
91 INDEX=INDEX+1
IF(INDEX.GT.LIMIT)GO TO 93
IF(IBUFFR(INDEX).EQ.1H,)GO TO 93
IF(IBUFFR(INDEX).EQ.1H*)GO TO 92
IF(IBUFFR(INDEX).NE.1H])GO TO 89
92 INDEX=INDEX-1
93 IF(KOLUMN.GE.30)GO TO 85
94 IF(LOCAL.GE.6)GO TO 85
LOCAL=LOCAL+1
KOLUMN=KOLUMN+1
IPUN(KOLUMN)=' '
GO TO 94
95 IF(KOLUMN.GE.30)GO TO 96
KOLUMN=KOLUMN+1
IPUN(KOLUMN)=' '
GO TO 95
96 DO 99 I=1,2
L=6*I
K=L
DO 97 J=1,6
IF(IPUN(K).EQ.1H )GO TO 97
IPUN(L)=IPUN(K)
L=L-1
97 K=K-1
98 IF(L.LE.K)GO TO 99
IPUN(L)=' '
L=L-1
GO TO 98
99 CONTINUE
GO TO 107
C
C GET DEVICE NAME
100 DO 101 INDEX=1,6
101 IUNIT(INDEX)=' '
KOPY=0
102 LIMIT=LIMIT+1
IF(LIMIT.GT.MAXBFR)GO TO 103
KOMPAR=IBUFFR(LIMIT)
IF(KOMPAR.EQ.1H )GO TO 103
IF(KOMPAR.EQ.1H,)GO TO 103
KOPY=KOPY+1
IF(KOPY.LE.6)IUNIT(KOPY)=KOMPAR
GO TO 102
103 DO 104 INDEX=1,6
104 JUNIT(INDEX)=IUNIT(INDEX)
JUNIT(7)=' '
IF(KOPY.LE.6)JUNIT(KOPY+1)=':'
GO TO 107
C
C GET TAPE DESCRIPTION
105 DO 106 INDEX=1,6
106 ITAPE(INDEX)=IBUFFR(INDEX+1)
GO TO 50
C
C DETERMINE WHETHER THIS PROJECT-USER NUMBER
C SHOULD BE REJECTED
107 IF(KNTNUM.EQ.0)GO TO 111
DO 110 I=1,KNTNUM
L=1
DO 109 J=1,3
DO 108 K=1,6
IF(MCHNUM(I,J,K).EQ.1H?)GO TO 108
IF(MCHNUM(I,J,K).NE.IPUN(L))GO TO 110
108 L=L+1
109 CONTINUE
GO TO 111
110 CONTINUE
GO TO 114
111 IF(IPRVAT.NE.0)GO TO 115
IF(KNTPUB.EQ.0)GO TO 115
DO 113 I=1,KNTDSK
DO 112 J=1,6
IF(MCHDSK(I,J).EQ.1H?)GO TO 112
IF(MCHDSK(I,J).NE.IUNIT(J))GO TO 113
112 CONTINUE
GO TO 115
113 CONTINUE
C IGNORE THESE FILES
114 IGNORE=1
GO TO 52
C USE THESE FILES
115 IGNORE=0
GO TO 52
C
C FILE NOT FOUND
116 GO TO(126,126,126,117),ILOOP
117 K=(3*NOWMTH)
J=K-2
WRITE(JTTY,118)(IWORD(I),I=J,K),NEWYER
IF(IFFILE.NE.0)
1WRITE(JDSK,118)(IWORD(I),I=J,K),NEWYER
118 FORMAT(' Directory file is not available for ',3A1,1I3)
GO TO 124
C
C END OF FILE ENCOUNTERED
119 GO TO(120,126,126,122),ILOOP
120 WRITE(JTTY,121)MCHLCL,LNGLCL,(MCHDSK(IPRVAT,I),I=1,6)
IF(IFFILE.NE.0)WRITE(JDSK,121)MCHLCL,LNGLCL,
1(MCHDSK(IPRVAT,I),I=1,6)
121 FORMAT(1X,1I8,' Files/',1I8,
1' Blocks found on private pack ',6A1)
GO TO 126
122 K=(3*NOWMTH)
J=K-2
WRITE(JTTY,123)MCHLCL,LNGLCL,(IWORD(I),I=J,K),NEWYER
IF(IFFILE.NE.0)
1WRITE(JDSK,123)MCHLCL,LNGLCL,(IWORD(I),I=J,K),NEWYER
123 FORMAT(1X,1I8,' Files/',1I8,
1' Blocks found for ',3A1,1X,1I2)
124 IF(IERASE.EQ.0)GO TO 126
K=(3*NOWMTH)
J=K-2
WRITE(JTTY,125)(IWORD(I),I=J,K),NEWYER
IF(IFFILE.NE.0)
1WRITE(JDSK,125)(IWORD(I),I=J,K),NEWYER
125 FORMAT(' Backup tapes have been recycled for ',3A1,1I3)
GO TO 126
126 GO TO(27,33,37,40),ILOOP
C
C CURRENT TYPE OF SAVE TAPES COMPLETELY SEARCHED
127 GO TO(132,128,130,132),ILOOP
128 WRITE(JTTY,129)MCHLCL,LNGLCL
IF(IFFILE.NE.0)WRITE(JDSK,129)MCHLCL,LNGLCL
129 FORMAT(1X,1I8,' Files/',1I8,
1' Blocks found on daily skim tapes')
GO TO 132
130 WRITE(JTTY,131)MCHLCL,LNGLCL
IF(IFFILE.NE.0)WRITE(JDSK,131)MCHLCL,LNGLCL
131 FORMAT(1X,1I8,' Files/',1I8,
1' Blocks found on weekly skim tapes')
GO TO 132
C
C END OF LOOP
132 CONTINUE
C
C TYPE FINAL SUMMARY IF DONE
IF(KNTMSG.LE.1)GO TO 134
WRITE(JTTY,133)MCHTTL,LNGTTL
IF(IFFILE.NE.0)
1WRITE(JDSK,133)MCHTTL,LNGTTL
133 FORMAT(1X,1I8,' Files/',1I8,' Blocks total')
134 IF(IFFILE.EQ.0)GO TO 135
CLOSE(UNIT=JDSK)
135 GO TO 9
END
SUBROUTINE MNYFIL(KDSK ,ITTY ,JTTY ,LMTDSK,LMTNAM,
1 LMTNUM,MINMTH,MINYER,MAXMTH,MAXYER,KNTDSK,KNTNAM,
2 KNTNUM,MCHDSK,MCHNAM,MCHEXT,MCHNUM,IFFILE,
3 INIMTH,INIYER,LMTMTH,LMTYER,IFSKIM,NONDCS,LCLPRG,
4 IFDATE,IDSK ,IAGAIN,IFPRVT,IEXPIR,
5 CHRNAM,CHRPPN,CHRDVC)
C RENBR(/INTERPRET USER COMMAND TO FNDFIL)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
DIMENSION MCHDSK(LMTDSK,6),IFPRVT(LMTDSK),MCHNAM(LMTNAM,6),
1 MCHEXT(LMTNAM,3),MCHNUM(LMTNUM,3,6),
2 IBUFFR(132),NEWNAM(6),NEWEXT(3),INILTR(15),
3 KNTLTR(15),IWORD(39),LNGWRD(15),JBUFFR(132),
4 NEWNUM(3,6),LTRLOC(6),LTRDVC(6),LTROPT(107),KNTOPT(20),
5 LTRDGT(10),IASSMD(11),LTRPPN(20),LTRSHO(80),
6 LTRCCL(10),LTROUT(10),LTRDSK(6),LTRFIL(10)
COMMON/FNDLOC/LOCFIL
CHARACTER*20 LOCFIL
C
C INFORMATION FOR OPENING OUTPUT FILE
CHARACTER CHRNAM*10,CHRPPN*20,CHRDVC*6,FILNAM*10,
1CHRCNA*10,CHRCPP*20,CHRCDV*6
DATA MAXBFR,LMTSHO/132,80/
DATA IASSMD/1H,,1H*,1H],1H ,1Ha,1Hs,1Hs,1Hu,1Hm,1He,1Hd/
DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA ISTAR,IQUEST,IBLANK,ICOMMA,IDOT,LTRSLA,ILEFT,IRIGHT,ICOLON/
11H*,1H?,1H ,1H,,1H.,1H/,1H[,1H],1H:/
DATA LTRCCL/1HF,1HN,1HD,1HF,1HI,1HL,1H.,1HC,1HC,1HL/
DATA LTROUT/1HF,1HN,1HD,1HF,1HI,1HL,1H.,1HD,1HI,1HR/
DATA LTRDSK/1HD,1HS,1HK,1H ,1H ,1H /
C LTRTAB IS THE TAB CHARACTER. IT IS NOT SPECIFIED
C DIRECTLY HERE SINCE TEXT EDITOR CONVERTS IT TO SPACES
DATA LTRTAB/"045004020100/
DATA LTROPT/
11HJ,1HA,1HN,1HU,1HA,1HR,1HY,
21HF,1HE,1HB,1HR,1HU,1HA,1HR,1HY,
31HM,1HA,1HR,1HC,1HH,
41HA,1HP,1HR,1HI,1HL,
51HM,1HA,1HY,
61HJ,1HU,1HN,1HE,
71HJ,1HU,1HL,1HY,
81HA,1HU,1HG,1HU,1HS,1HT,
91HS,1HE,1HP,1HT,1HE,1HM,1HB,1HE,1HR,
11HO,1HC,1HT,1HO,1HB,1HE,1HR,
21HN,1HO,1HV,1HE,1HM,1HB,1HE,1HR,
31HD,1HE,1HC,1HE,1HM,1HB,1HE,1HR,
41HH,1HE,1HL,1HP, 1HL,1HI,1HS,1HT,
51HG,1HO, 1HS,1HK,1HI,1HM,
61HE,1HX,1HI,1HT, 1HR,1HE,1HP,1HE,1HA,1HT,
71HC,1HA,1HN,1HC,1HE,1HL, 1HO,1HL,1HD/
DATA KNTOPT/7,8,5,5,3,4,4,6,9,7,8,8,4,4,2,4,4,6,6,3/
DATA LNGOPT,NUMOPT/107,20/
DATA IWORD /1HJ,1HA,1HN,1HF,1HE,1HB,1HM,1HA,1HR,
11HA,1HP,1HR,1HM,1HA,1HY,1HJ,1HU,1HN,1HJ,1HU,1HL,
21HA,1HU,1HG,1HS,1HE,1HP,1HO,1HC,1HT,1HN,1HO,1HV,
31HD,1HE,1HC,1HH,1HL,1HG/
DATA LNGWRD/3,3,3,3,3,3,3,3,3,3,3,3,1,1,1/
INDRCT=0
C
C **********************************
C * *
C * SAVE PREVIOUS SPECIFICATIONS *
C * *
C **********************************
C
C EITHER AFTER LAST SEARCH, OR WHEN /CANCEL SWITCH ISSUED
1 MINDSK=LMTDSK+1
MINNAM=LMTNAM+1
MINNUM=LMTNUM+1
IF(IAGAIN.EQ.0)GO TO 14
IAGAIN=-1
C SAVE PREVIOUSLY SELECTED DISKS
2 IF(KNTDSK.EQ.0)GO TO 4
MINDSK=MINDSK-1
IFPRVT(MINDSK)=IFPRVT(KNTDSK)
DO 3 INDEX=1,6
MCHDSK(MINDSK,INDEX)=MCHDSK(KNTDSK,INDEX)
3 CONTINUE
KNTDSK=KNTDSK-1
GO TO 2
4 CONTINUE
C SAVE PREVIOUSLY SELECTED FILE NAMES
5 IF(KNTNAM.EQ.0)GO TO 8
MINNAM=MINNAM-1
DO 6 INDEX=1,6
MCHNAM(MINNAM,INDEX)=MCHNAM(KNTNAM,INDEX)
6 CONTINUE
DO 7 INDEX=1,3
MCHEXT(MINNAM,INDEX)=MCHEXT(KNTNAM,INDEX)
7 CONTINUE
KNTNAM=KNTNAM-1
GO TO 5
8 CONTINUE
C SAVE PREVIOUSLY SELECTED OWNERS
9 IF(KNTNUM.EQ.0)GO TO 12
MINNUM=MINNUM-1
DO 11 INDEX=1,3
DO 10 J=1,6
MCHNUM(MINNUM,INDEX,J)=MCHNUM(KNTNUM,INDEX,J)
10 CONTINUE
11 CONTINUE
KNTNUM=KNTNUM-1
GO TO 9
C SAVE DATE RANGE
12 IFDARS=IFDATE
IF(IFDATE.EQ.0)GO TO 13
INIMRS=INIMTH
INIYRS=INIYER
LMTMRS=LMTMTH
LMTYRS=LMTYER
13 IFSKRS=IFSKIM
IEXPRS=IEXPIR
14 CONTINUE
C
C ************************
C * *
C * INITIALIZE STORAGE *
C * *
C ************************
C
IFFILE=0
JFACNT=0
JFNAME=0
JFDEVC=0
IFSKIM=0
IEXPIR=0
IFDATE=0
KNTNAM=0
KNTDSK=0
KNTNUM=0
KALNUM=0
KALNAM=0
KALDSK=0
C
C ****************************
C * *
C * GET NEXT LINE OF INPUT *
C * *
C ****************************
C
GO TO 18
15 IF(INDRCT.EQ.0)GO TO 20
READ(KDSK,22,END=18)IBUFFR
GO TO 23
16 WRITE(JTTY,17)
17 FORMAT(37H File name or owner must be specified)
18 IF(INDRCT.NE.0)CLOSE(UNIT=KDSK)
19 INDRCT=0
20 WRITE(JTTY,21)
21 FORMAT(2H *,$)
READ(ITTY,22,END=27)IBUFFR
22 FORMAT(132A1)
23 LOWBFR=1
MANY=0
CALL DACASE(1,MAXBFR,IBUFFR)
DO 24 I=1,MAXBFR
IF(IBUFFR(I).EQ.LTRTAB)IBUFFR(I)=IBLANK
24 CONTINUE
C
C GET NEXT SET OF FILE SPECIFICATIONS FROM INPUT LINE
25 LSTBFR=LOWBFR
CALL DAFLAG(0,1,15,MAXBFR,IBUFFR,
1LOWBFR,MANY,KIND,INILTR,KNTLTR,MAXDSK,MAXNAM,
2MAXNUM,MAXFLG,KONTNT,MINPRT,MAXPRT)
GO TO(26,25,29,15,25,47,47,47),KIND
26 IF(INDRCT.NE.0)GO TO 15
IF(LSTBFR.NE.1)GO TO 15
27 WRITE(JTTY,28)
28 FORMAT(43H Type /HELP for help, /GO to perform search)
GO TO 15
C
C ****************************************************
C * *
C * EQUAL SIGN ISSUED RIGHT OF NAME OF OUTPUT FILE *
C * *
C ****************************************************
C
C DETERMINE WHETHER THERE IS AN OUTPUT FILE LEFT OF =
29 IF(JFNAME.NE.0)GO TO 31
IF(JFACNT.NE.0)GO TO 31
IF(JFDEVC.NE.0)GO TO 31
IF(IFFILE.NE.0)WRITE(JTTY,30)
30 FORMAT(' Results will be written onto terminal')
IFFILE=0
GO TO 25
31 IFFILE=1
KNTSHO=0
C
C STORE DIRECTORY FOR OUTPUT FILE
IF(KNTNUM.EQ.0)GO TO 34
IF(JFACNT.EQ.0)GO TO 34
KNTNUM=KNTNUM-1
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=ILEFT
DO 32 INDEX=1,20
IF(LTRPPN(INDEX).EQ.IBLANK)GO TO 32
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=LTRPPN(INDEX)
32 CONTINUE
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=IRIGHT
WRITE(CHRPPN,33)LTRPPN
33 FORMAT(20A1)
IFFILE=2
34 CONTINUE
C
C STORE DEVICE FOR OUTPUT FILE
IF(KNTDSK.EQ.0)GO TO 35
IF(JFDEVC.EQ.0)GO TO 35
KNTDSK=KNTDSK-1
GO TO 37
35 DO 36 INDEX=1,6
LTRLOC(INDEX)=LTRDSK(INDEX)
36 CONTINUE
37 DO 38 INDEX=1,6
IF(LTRLOC(INDEX).EQ.IBLANK)GO TO 38
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=LTRLOC(INDEX)
38 CONTINUE
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=ICOLON
WRITE(CHRDVC,39)LTRLOC
39 FORMAT(6A1)
C
C STORE NAME OF OUTPUT FILE
IF(JFNAME.EQ.0)GO TO 42
IF(KNTNAM.EQ.0)GO TO 42
KNTNAM=KNTNAM-1
DO 40 INDEX=1,10
IF(LTRFIL(INDEX).EQ.IDOT)GO TO 44
40 CONTINUE
DO 41 INDEX=1,10
IF(LTRFIL(INDEX).NE.IBLANK)GO TO 41
LTRFIL(INDEX)=IDOT
GO TO 44
41 CONTINUE
GO TO 44
42 DO 43 INDEX=1,10
LTRFIL(INDEX)=LTROUT(INDEX)
43 CONTINUE
44 DO 45 INDEX=1,10
IF(LTRFIL(INDEX).EQ.IBLANK)GO TO 45
KNTSHO=KNTSHO+1
LTRSHO(KNTSHO)=LTRFIL(INDEX)
45 CONTINUE
WRITE(CHRNAM,46)LTRFIL
C ENCODE(10,30,CHRNAM)LTRFIL
46 FORMAT(10A1)
JFACNT=0
JFNAME=0
JFDEVC=0
GO TO 25
C
C ***************************************
C * *
C * AT SIGN WITH NAME OF COMMAND FILE *
C * *
C ***************************************
C
C AT SIGN INDICATES COMMANDS ARE IN FILE
47 IF(KONTNT.LT.16)GO TO 66
JFACNT=0
JFNAME=0
JFDEVC=0
C
C GET NAME OF COMMAND FILE
NOWNAM=MAXDSK+1
IF(NOWNAM.GT.MAXNAM)GO TO 52
LENGTH=KNTLTR(MAXNAM)
IF(LENGTH.LT.0)LENGTH=-LENGTH+1
LENGTH=LENGTH+INILTR(MAXNAM)-INILTR(NOWNAM)
IF(LENGTH.EQ.0)GO TO 52
KOPY=INILTR(NOWNAM)
DO 48 INDEX=1,10
LTRFIL(INDEX)=IBLANK
IF(INDEX.LE.LENGTH)LTRFIL(INDEX)=IBUFFR(KOPY)
48 KOPY=KOPY+1
DO 49 INDEX=1,10
IF(LTRFIL(INDEX).EQ.IDOT)GO TO 51
49 CONTINUE
DO 50 INDEX=1,10
IF(LTRFIL(INDEX).NE.IBLANK)GO TO 50
LTRFIL(INDEX)=IDOT
GO TO 51
50 CONTINUE
51 GO TO 54
52 DO 53 INDEX=1,10
LTRFIL(INDEX)=LTRCCL(INDEX)
53 CONTINUE
54 IF(INDRCT.NE.0)CLOSE(UNIT=KDSK)
WRITE(CHRCNA,46)LTRFIL
C
C GET 6 LETTER DEVICE NAME FOR COMMAND FILE
NOWDSK=1
IF(NOWDSK.GT.MAXDSK)GO TO 57
LENGTH=KNTLTR(NOWDSK)
IF(LENGTH.LE.0)GO TO 57
KOPY=INILTR(NOWDSK)
DO 55 INDEX=1,6
LTRLOC(INDEX)=IBLANK
IF(INDEX.GT.LENGTH)GO TO 55
LTRLOC(INDEX)=IBUFFR(KOPY)
55 KOPY=KOPY+1
WRITE(CHRCDV,56)(LTRLOC(I),I=1,6)
56 FORMAT(6A1)
GO TO 58
57 CHRCDV='DSK '
58 CONTINUE
C
C GET DIRECTORY FOR COMMAND FILE
NOWNUM=MAXNAM+1
IF(NOWNUM.GT.MAXNUM)GO TO 63
LENGTH=KNTLTR(MAXNUM)
IF(LENGTH.LT.0)LENGTH=-LENGTH+1
LENGTH=LENGTH+INILTR(MAXNUM)-INILTR(NOWNUM)
KOPY=INILTR(NOWNUM)
J=0
IF(LENGTH.LE.0)GO TO 60
DO 59 INDEX=1,LENGTH
IF(IBUFFR(KOPY).EQ.IBLANK)GO TO 59
IF(J.GE.20)GO TO 59
J=J+1
LTRPPN(J)=IBUFFR(KOPY)
59 KOPY=KOPY+1
60 IF(J.GE.20)GO TO 61
J=J+1
LTRPPN(J)=IBLANK
GO TO 60
61 WRITE(CHRCPP,62)(LTRPPN(I),I=1,20)
62 FORMAT(20A1)
63 CONTINUE
C
C ATTEMPT TO OPEN COMMAND FILE
IF(MAXNUM.LE.MAXNAM)OPEN(UNIT=KDSK,ACCESS='SEQIN',ERR=64,
1 DEVICE=CHRCDV,FILE=CHRCNA)
IF(MAXNUM.GT.MAXNAM)OPEN(UNIT=KDSK,ACCESS='SEQIN',ERR=64,
1DIRECTORY=CHRCPP,DEVICE=CHRCDV,FILE=CHRCNA)
INDRCT=1
GO TO 15
64 WRITE(JTTY,65)CHRCNA
65 FORMAT(' Cannot read command file ',1A10)
GO TO 19
C
C ********************************
C * *
C * GENERAL FILE SPECIFICATION *
C * *
C ********************************
C
C RECORD TYPE OF FILE SPECIFICATION IN CASE = ISSUED
66 IF(MAXNUM.LE.0)GO TO 67
JFACNT=0
JFNAME=0
JFDEVC=0
IF(MAXDSK.GT.0)JFDEVC=1
IF(MAXNAM.GT.MAXDSK)JFNAME=1
IF(MAXNUM.GT.MAXNAM)JFACNT=1
67 CONTINUE
C
C ************
C * *
C * DEVICE *
C * *
C ************
C
C SAVE DEVICE NAME FOR USE IF = FOUND NEXT
NOWDSK=0
68 NOWDSK=NOWDSK+1
IF(NOWDSK.GT.MAXDSK)GO TO 85
DO 69 INDEX=1,6
LTRLOC(INDEX)=IBLANK
69 CONTINUE
LENGTH=KNTLTR(NOWDSK)
IF(LENGTH.LE.0)GO TO 71
IF(LENGTH.GT.6)LENGTH=6
KOPY=INILTR(NOWDSK)
DO 70 INDEX=1,LENGTH
LTRLOC(INDEX)=IBUFFR(KOPY)
KOPY=KOPY+1
70 CONTINUE
C
C SAVE DEVICE NAME FOR USE IN SEARCH
71 LENGTH=KNTLTR(NOWDSK)
IF(LENGTH.LE.0)GO TO 68
KOPY=INILTR(NOWDSK)
DO 73 INDEX=1,6
LTRDVC(INDEX)=IBLANK
IF(INDEX.GT.LENGTH)GO TO 72
IF(IBUFFR(KOPY).EQ.ISTAR)LENGTH=-1
LTRDVC(INDEX)=IBUFFR(KOPY)
72 IF(LENGTH.LE.0)LTRDVC(INDEX)=IQUEST
73 KOPY=KOPY+1
C
C REMOVE DEVICE NAME FROM LIST IF DUPLICATE
LOOKAT=0
74 LOOKAT=LOOKAT+1
IF(LOOKAT.GT.KNTDSK)GO TO 79
DO 75 INDEX=1,6
IF(MCHDSK(LOOKAT,INDEX).NE.LTRDVC(INDEX))GO TO 74
75 CONTINUE
L=0
DO 76 INDEX=1,6
IF(LTRDVC(INDEX).EQ.IBLANK)GO TO 76
L=L+1
JBUFFR(L)=LTRDVC(INDEX)
76 CONTINUE
WRITE(JTTY,98)(JBUFFR(I),I=1,L)
KNTDSK=KNTDSK-1
77 IF(LOOKAT.GT.KNTDSK)GO TO 68
IFPRVT(LOOKAT)=IFPRVT(LOOKAT+1)
DO 78 INDEX=1,6
78 MCHDSK(LOOKAT,INDEX)=MCHDSK(LOOKAT+1,INDEX)
LOOKAT=LOOKAT+1
GO TO 77
C
C ADD DEVICE NAME TO LIST IF NOT DUPLICATE
79 IF(KNTDSK.GE.LMTDSK)GO TO 83
KNTDSK=KNTDSK+1
IF(KNTDSK.GE.MINDSK)MINDSK=MINDSK+1
DO 80 INDEX=1,6
80 MCHDSK(KNTDSK,INDEX)=LTRDVC(INDEX)
WRITE(FILNAM,81)(LTRDVC(M),M=1,6)
C ENCODE(10,54,FILNAM)(LTRDVC(M),M=1,6)
81 FORMAT(6A1,4H.FND)
OPEN(UNIT=IDSK,FILE=FILNAM,ACCESS='SEQIN',ERR=82,
1DIRECTORY=LOCFIL)
CLOSE(UNIT=IDSK)
IFPRVT(KNTDSK)=1
GO TO 68
82 IFPRVT(KNTDSK)=0
GO TO 68
83 IF(KALDSK.EQ.0)WRITE(JTTY,84)LMTDSK
84 FORMAT(5H Over,1I4,
132H units specified, excess ignored)
KALDSK=1
85 CONTINUE
C
C ***************
C * *
C * FILE NAME *
C * *
C ***************
C
C GET 6 LETTER NAME AND 3 LETTER EXTENSION
C
C NAME.EXT GIVES NAME.EXT
C NAME OR NAME.* GIVES NAME.???
C NAME. GIVES NAME.BBB WHERE B IS BLANK
C . OR *. GIVES ??????.BBB
C * OR .* OR *.* GIVES ??????.???
C .EXT OR *.EXT GIVES ??????.EXT
C
C SAVE FILE NAME FOR USE IF = FOUND NEXT
IF(MAXNAM.LE.MAXDSK)GO TO 107
DO 86 INDEX=1,10
LTRFIL(INDEX)=IBLANK
86 CONTINUE
ININAM=MAXDSK+1
LENGTH=KNTLTR(MAXNAM)
IF(LENGTH.LT.0)LENGTH=-LENGTH+1
LENGTH=LENGTH+INILTR(MAXNAM)-INILTR(ININAM)
IF(LENGTH.LE.0)GO TO 88
IF(LENGTH.GT.10)LENGTH=10
KOPY=INILTR(ININAM)
J=0
DO 87 INDEX=1,LENGTH
IF(IBUFFR(KOPY).EQ.IBLANK)GO TO 87
J=J+1
LTRFIL(J)=IBUFFR(KOPY)
87 KOPY=KOPY+1
C
C SAVE COMPONENTS OF NAME FOR USE IN SEARCH
88 LENGTH=KNTLTR(ININAM)
IF(LENGTH.GT.0)KOPY=INILTR(ININAM)
DO 90 INDEX=1,6
NEWNAM(INDEX)=IBLANK
IF(INDEX.GT.LENGTH)GO TO 89
IF(IBUFFR(KOPY).EQ.ISTAR)LENGTH=-1
NEWNAM(INDEX)=IBUFFR(KOPY)
89 IF(LENGTH.LE.0)NEWNAM(INDEX)=IQUEST
90 KOPY=KOPY+1
LENGTH=-1
IF(MAXNAM.GT.ININAM)LENGTH=KNTLTR(ININAM+1)
IF(LENGTH.GT.0)KOPY=INILTR(ININAM+1)
DO 92 INDEX=1,3
NEWEXT(INDEX)=IBLANK
IF(INDEX.GT.LENGTH)GO TO 91
IF(IBUFFR(KOPY).EQ.ISTAR)LENGTH=-1
NEWEXT(INDEX)=IBUFFR(KOPY)
91 IF(LENGTH.LT.0)NEWEXT(INDEX)=IQUEST
92 KOPY=KOPY+1
C
C REMOVE NAME AND EXTENSION FROM LIST IF DUPLICATE
LOOKAT=0
93 LOOKAT=LOOKAT+1
IF(LOOKAT.GT.KNTNAM)GO TO 102
DO 94 INDEX=1,6
IF(MCHNAM(LOOKAT,INDEX).NE.NEWNAM(INDEX))GO TO 93
94 CONTINUE
DO 95 INDEX=1,3
IF(MCHEXT(LOOKAT,INDEX).NE.NEWEXT(INDEX))GO TO 93
95 CONTINUE
L=0
DO 96 INDEX=1,6
IF(NEWNAM(INDEX).EQ.IBLANK)GO TO 96
L=L+1
JBUFFR(L)=NEWNAM(INDEX)
96 CONTINUE
L=L+1
JBUFFR(L)=IDOT
DO 97 INDEX=1,3
IF(NEWEXT(INDEX).EQ.IBLANK)GO TO 97
L=L+1
JBUFFR(L)=NEWEXT(INDEX)
97 CONTINUE
WRITE(JTTY,98)(JBUFFR(I),I=1,L)
98 FORMAT(' Omit: ',132A1)
KNTNAM=KNTNAM-1
99 IF(LOOKAT.GT.KNTNAM)GO TO 107
DO 100 INDEX=1,6
100 MCHNAM(LOOKAT,INDEX)=MCHNAM(LOOKAT+1,INDEX)
DO 101 INDEX=1,3
101 MCHEXT(LOOKAT,INDEX)=MCHEXT(LOOKAT+1,INDEX)
LOOKAT=LOOKAT+1
GO TO 99
C
C ADD NAME AND EXTENSION TO LIST IF NOT DUPLICATE
102 IF(KNTNAM.GE.LMTNAM)GO TO 105
KNTNAM=KNTNAM+1
IF(KNTNAM.GE.MINNAM)MINNAM=MINNAM+1
DO 103 INDEX=1,6
103 MCHNAM(KNTNAM,INDEX)=NEWNAM(INDEX)
DO 104 INDEX=1,3
104 MCHEXT(KNTNAM,INDEX)=NEWEXT(INDEX)
GO TO 107
105 IF(KALNAM.EQ.0)WRITE(JTTY,106)LMTNAM
106 FORMAT(5H Over,1I4,
132H files specified, excess ignored)
KALNAM=1
107 CONTINUE
C
C ***************
C * *
C * DIRECTORY *
C * *
C ***************
C
C SAVE DIRECTORY FOR USE IF = FOUND NEXT
IF(MAXNUM.LE.MAXNAM)GO TO 135
DO 108 INDEX=1,20
LTRPPN(INDEX)=IBLANK
108 CONTINUE
NOWNUM=MAXNAM+1
LENGTH=KNTLTR(MAXNUM)
IF(LENGTH.LT.0)LENGTH=-LENGTH+1
LENGTH=LENGTH+INILTR(MAXNUM)-INILTR(NOWNUM)
IF(LENGTH.LE.0)GO TO 110
IF(LENGTH.GT.20)LENGTH=20
KOPY=INILTR(NOWNUM)
J=0
DO 109 INDEX=1,LENGTH
IF(IBUFFR(KOPY).EQ.IBLANK)GO TO 109
J=J+1
LTRPPN(J)=IBUFFR(KOPY)
109 KOPY=KOPY+1
110 CONTINUE
C
C SAVE DIRECTORY FOR USE IN SEARCH
DO 112 INDEX=1,3
DO 111 J=1,6
111 NEWNUM(INDEX,J)=IQUEST
112 CONTINUE
NOWNUM=MAXNAM
LOCAL=0
113 NOWNUM=NOWNUM+1
IF(NOWNUM.GT.MAXNUM)GO TO 116
LOCAL=LOCAL+1
IF(LOCAL.GT.3)GO TO 116
LENGTH=KNTLTR(NOWNUM)
IF(LENGTH.LT.0)LENGTH=-LENGTH-1
IF(LENGTH.EQ.0)GO TO 113
KOPY=INILTR(NOWNUM)
IF((LENGTH.EQ.1).AND.(IBUFFR(KOPY).EQ.ISTAR))GO TO 113
DO 115 INDEX=1,6
NEWNUM(LOCAL,INDEX)=IBLANK
IF(INDEX.GT.LENGTH)GO TO 114
IF(IBUFFR(KOPY).EQ.ISTAR)LENGTH=-1
NEWNUM(LOCAL,INDEX)=IBUFFR(KOPY)
114 IF(LENGTH.LE.0)NEWNUM(LOCAL,INDEX)=IQUEST
115 KOPY=KOPY+1
GO TO 113
C
C REQUIRE NON-DCS USERS SPECIFY THEIR OWN USER NUMBER
116 IF(NONDCS.EQ.0)GO TO 121
KOMPAR=0
DO 118 I=1,6
IF(NEWNUM(2,I).EQ.IBLANK)GO TO 118
DO 117 J=1,10
IF(NEWNUM(2,I).NE.LTRDGT(J))GO TO 117
KOMPAR=(8*KOMPAR)+J-1
GO TO 118
117 CONTINUE
GO TO 119
118 CONTINUE
IF(KOMPAR.EQ.LCLPRG)GO TO 121
119 WRITE(JTTY,120)
120 FORMAT(39H You can only search for your own files)
GO TO 135
C
C REMOVE OWNER FROM LIST IF DUPLICATE
121 LOOKAT=0
122 LOOKAT=LOOKAT+1
IF(LOOKAT.GT.KNTNUM)GO TO 130
DO 124 INDEX=1,3
DO 123 J=1,6
IF(MCHNUM(LOOKAT,INDEX,J).NE.NEWNUM(INDEX,J))GO TO 122
123 CONTINUE
124 CONTINUE
L=0
DO 126 INDEX=1,3
DO 125 J=1,6
IF(NEWNUM(INDEX,J).EQ.IBLANK)GO TO 125
L=L+1
JBUFFR(L)=NEWNUM(INDEX,J)
125 CONTINUE
L=L+1
126 JBUFFR(L)=ICOMMA
L=L-1
WRITE(JTTY,98)(JBUFFR(I),I=1,L)
KNTNUM=KNTNUM-1
127 IF(LOOKAT.GT.KNTNUM)GO TO 135
DO 129 INDEX=1,3
DO 128 J=1,6
128 MCHNUM(LOOKAT,INDEX,J)=MCHNUM(LOOKAT+1,INDEX,J)
129 CONTINUE
LOOKAT=LOOKAT+1
GO TO 127
C
C ADD OWNER TO LIST IF NOT DUPLICATE
130 IF(KNTNUM.GE.LMTNUM)GO TO 133
KNTNUM=KNTNUM+1
IF(KNTNUM.GE.MINNUM)MINNUM=MINNUM+1
DO 132 INDEX=1,3
DO 131 J=1,6
131 MCHNUM(KNTNUM,INDEX,J)=NEWNUM(INDEX,J)
132 CONTINUE
GO TO 135
133 IF(KALNUM.EQ.0)WRITE(JTTY,134)LMTNUM
134 FORMAT(5H Over,1I4,
133H owners specified, excess ignored)
KALNUM=1
135 CONTINUE
C
C **********
C * *
C * DATE *
C * *
C **********
C
C GET DATE LIMITS
NOWFLG=MAXNUM
IFDAY=0
136 NOWFLG=NOWFLG+1
IF(NOWFLG.GT.MAXFLG)GO TO 141
LENGTH=KNTLTR(NOWFLG)
IF(LENGTH.LT.0)LENGTH=-LENGTH-1
IF(LENGTH.LE.0)GO TO 136
KOPY=INILTR(NOWFLG)
LMTBFR=KOPY+LENGTH-1
137 CALL DAVERB(1,LNGOPT,LTROPT,1,NUMOPT,
1KNTOPT,IBUFFR,LMTBFR,KOPY,KIND,MATCH,LCNWRD,
2LCNKNT,LCNBFR)
GO TO(136,139,138,138,154),KIND
138 IF(MATCH.GE.13)GO TO 153
IF(IFDAY.NE.0)GO TO 154
IFDAY=1
NEWMTH=MATCH
139 CALL DAIHFT(0,0,0,IBUFFR,LMTBFR,
1KOPY,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE)
GO TO(136,154,140),KIND
140 IF(IFDAY.NE.1)GO TO 154
IF(IVALUE.LT.0)IVALUE=-IVALUE
IFDAY=2
NEWYER=IVALUE-(100*(IVALUE/100))
IF(NEWYER.LT.64)NEWYER=NEWYER+100
GO TO 137
141 IF(IFDAY.EQ.0)GO TO 25
IF(IFDAY.EQ.1)GO TO 154
IF(NEWYER.LT.MINYER)GO TO 148
IF(NEWYER.NE.MINYER)GO TO 142
IF(NEWMTH.LT.MINMTH)GO TO 148
142 IF(NEWYER.GT.MAXYER)GO TO 148
IF(NEWYER.NE.MAXYER)GO TO 143
IF(NEWMTH.GT.MAXMTH)GO TO 148
143 IF(IFDATE.EQ.0)GO TO 144
IF(NEWYER.LT.INIYER)GO TO 144
IF(NEWYER.GT.INIYER)GO TO 145
IF(NEWMTH.EQ.INIMTH)GO TO 150
IF(NEWMTH.GT.INIMTH)GO TO 145
144 INIMTH=NEWMTH
INIYER=NEWYER
IF(IFDATE.EQ.0)GO TO 146
145 IF(NEWYER.GT.LMTYER)GO TO 146
IF(NEWYER.LT.LMTYER)GO TO 147
IF(NEWMTH.EQ.LMTMTH)GO TO 152
IF(NEWMTH.LT.LMTMTH)GO TO 147
146 LMTMTH=NEWMTH
LMTYER=NEWYER
147 IFDATE=1
GO TO 25
148 I=MINYER
IF(I.GE.100)I=I-100
J=MAXYER
IF(J.GE.100)J=J-100
L=3*MINMTH
K=L-2
N=3*MAXMTH
M=N-2
WRITE(JTTY,149)(IWORD(II),II=K,L),I,
1(IWORD(II),II=M,N),J
149 FORMAT(24H Date must be in range /,
13A1,1H:,1I2,5H to /,3A1,1H:,1I2)
GO TO 25
C
C CANCEL DATE IF DUPLICATE
150 I=INIYER
IF(I.GE.100)I=I-100
L=3*INIMTH
K=L-2
WRITE(JTTY,151)(IWORD(II),II=K,L),I
151 FORMAT(' Omit: ',3A1,1H:,1I2)
IFDATE=0
IF(INIMTH.NE.LMTMTH)IFDATE=1
IF(INIYER.NE.LMTYER)IFDATE=1
INIMTH=LMTMTH
INIYER=LMTYER
GO TO 25
152 I=LMTYER
IF(I.GE.100)I=I-100
L=3*LMTMTH
K=L-2
WRITE(JTTY,151)(IWORD(II),II=K,L),I
IFDATE=0
IF(INIMTH.NE.LMTMTH)IFDATE=1
IF(INIYER.NE.LMTYER)IFDATE=1
LMTMTH=INIMTH
LMTYER=INIYER
GO TO 25
C
C **********************
C * *
C * SLASH AND SWITCH *
C * *
C **********************
C
C SWITCH ISSUED
153 MATCH=MATCH-12
IF(KOPY.LE.LMTBFR)GO TO 154
GO TO(156,198,226,162,233,166,157,164),MATCH
154 J=INILTR(MAXNUM+1)
WRITE(JTTY,155)(IBUFFR(I),I=J,LMTBFR)
155 FORMAT(16H Unknown switch ,80A1)
GO TO 25
C
C ISSUE HELP MESSAGE
156 CALL HELP(JTTY)
GO TO 25
C
C CANCEL PREVIOUS SPECIFICATIONS
157 IF(KNTDSK.NE.0)GO TO 159
IF(KNTNAM.NE.0)GO TO 159
IF(KNTNUM.NE.0)GO TO 159
IF(IFSKIM.NE.0)GO TO 159
IF(IFDATE.NE.0)GO TO 159
IF(IEXPIR.NE.0)GO TO 159
IF(IFFILE.NE.0)GO TO 159
WRITE(JTTY,158)
158 FORMAT(' No specifications have been given')
GO TO 25
159 IF(IFFILE.EQ.0)WRITE(JTTY,160)
160 FORMAT(' Cancelling all specifications given so far'/
1' /REPEAT can be typed to restore all of these')
IF(IFFILE.NE.0)WRITE(JTTY,161)
161 FORMAT(' Cancelling all specifications given so far'/
1' /REPEAT can be typed to restore all except output file')
IAGAIN=1
GO TO 1
C
C SET SKIM SWITCH
162 IFSKIM=1-IFSKIM
IF(IFSKIM.EQ.O)WRITE(JTTY,163)
163 FORMAT(11H Omit: SKIM)
GO TO 25
C
C SET OLD SWITCH
164 IEXPIR=1-IEXPIR
IF(IEXPIR.EQ.O)WRITE(JTTY,165)
165 FORMAT(10H Omit: OLD)
GO TO 25
C
C ***************************
C * *
C * /REPEAT SWITCH ISSUED *
C * *
C ***************************
C
C DECIDE IF THERE IS AN OLD LIST TO BE RESTORED
166 IF(IAGAIN.EQ.0)GO TO 196
IF(IAGAIN.GT.0)GO TO 194
IAGAIN=1
C
C RESTORE PREVIOUS LIST OF DISKS
167 IF(MINDSK.GT.LMTDSK)GO TO 173
IF(KNTDSK.EQ.0)GO TO 170
DO 169 NXTDSK=1,KNTDSK
DO 168 INDEX=1,6
IF(MCHDSK(NXTDSK,INDEX).NE.MCHDSK(MINDSK,INDEX))GO TO 169
168 CONTINUE
GO TO 172
169 CONTINUE
170 KNTDSK=KNTDSK+1
IFPRVT(KNTDSK)=IFPRVT(MINDSK)
DO 171 INDEX=1,6
MCHDSK(KNTDSK,INDEX)=MCHDSK(MINDSK,INDEX)
171 CONTINUE
172 MINDSK=MINDSK+1
GO TO 167
173 CONTINUE
C
C RESTORE PREVIOUS LIST OF OWNERS
174 IF(MINNUM.GT.LMTNUM)GO TO 182
IF(KNTNUM.EQ.0)GO TO 178
DO 177 NXTNUM=1,KNTNUM
DO 176 INDEX=1,3
DO 175 J=1,6
IF(MCHNUM(NXTNUM,INDEX,J).NE.MCHNUM(MINNUM,INDEX,J))GO TO 177
175 CONTINUE
176 CONTINUE
GO TO 181
177 CONTINUE
178 KNTNUM=KNTNUM+1
DO 180 INDEX=1,3
DO 179 J=1,6
MCHNUM(KNTNUM,INDEX,J)=MCHNUM(MINNUM,INDEX,J)
179 CONTINUE
180 CONTINUE
181 MINNUM=MINNUM+1
GO TO 174
182 CONTINUE
C
C RESTORE PREVIOUS LIST OF FILE NAMES
183 IF(MINNAM.GT.LMTNAM)GO TO 191
IF(KNTNAM.EQ.0)GO TO 187
DO 186 NXTNAM=1,KNTNAM
DO 184 INDEX=1,6
IF(MCHNAM(NXTNAM,INDEX).NE.MCHNAM(MINNAM,INDEX))GO TO 186
184 CONTINUE
DO 185 INDEX=1,3
IF(MCHEXT(NXTNAM,INDEX).NE.MCHEXT(MINNAM,INDEX))GO TO 186
185 CONTINUE
GO TO 190
186 CONTINUE
187 KNTNAM=KNTNAM+1
DO 188 INDEX=1,6
MCHNAM(KNTNAM,INDEX)=MCHNAM(MINNAM,INDEX)
188 CONTINUE
DO 189 INDEX=1,3
MCHEXT(KNTNAM,INDEX)=MCHEXT(MINNAM,INDEX)
189 CONTINUE
190 MINNAM=MINNAM+1
GO TO 183
C
C RESTORE PREVIOUS DATE RANGE
191 IF(IFDATE.NE.0)GO TO 192
IFDATE=IFDARS
IF(IFDATE.EQ.0)GO TO 192
INIMTH=INIMRS
INIYER=INIYRS
LMTMTH=LMTMRS
LMTYER=LMTYRS
C
C RESTORE SKIM OR OLD SWITCHES
192 IF(IFSKRS.NE.0)IFSKIM=1
IF(IEXPRS.NE.0)IEXPIR=1
C
C TELL USER THAT RESTORE IS COMPLETE
WRITE(JTTY,193)
193 FORMAT(' Repeating previously selected specifications')
GO TO 25
194 WRITE(JTTY,195)
195 FORMAT(' Cannot repeat specifications additional time')
GO TO 25
196 WRITE(JTTY,197)
197 FORMAT(' No specifications were given previously')
GO TO 25
C
C *************************
C * *
C * /LIST SWITCH ISSUED *
C * *
C *************************
C
C REPORT OUTPUT FILE
198 IF(IFFILE.EQ.0)GO TO 200
WRITE(JTTY,199)(LTRSHO(I),I=1,KNTSHO)
199 FORMAT(' To: ',80A1)
C
C REPORT DISK
200 IF(KNTDSK.LE.0)GO TO 206
DO 205 I=1,KNTDSK
L=0
DO 201 J=1,6
JBUFFR(J)=MCHDSK(I,J)
IF(JBUFFR(L).NE.IBLANK)L=J
201 CONTINUE
IF(IFPRVT(I).EQ.0)GO TO 203
WRITE(JTTY,202)(JBUFFR(M),M=1,6)
202 FORMAT(7H Disk: ,6A1,' (PRIVATE)')
GO TO 205
203 WRITE(JTTY,204)(JBUFFR(M),M=1,L)
204 FORMAT(7H Disk: ,100A1)
205 CONTINUE
C
C REPORT ACCOUNTS
206 IF(KNTNUM.LE.0)GO TO 211
DO 209 I=1,KNTNUM
L=0
DO 208 J=1,3
DO 207 K=1,6
IF(MCHNUM(I,J,K).EQ.IBLANK)GO TO 207
L=L+1
JBUFFR(L)=MCHNUM(I,J,K)
207 CONTINUE
L=L+1
208 JBUFFR(L)=ICOMMA
L=L-1
209 WRITE(JTTY,210)(JBUFFR(M),M=1,L)
210 FORMAT(7H Ownr: ,100A1)
C
C REPORT FILE NAMES
211 IF(KNTNAM.LE.0)GO TO 216
DO 214 I=1,KNTNAM
L=0
DO 212 J=1,6
IF(MCHNAM(I,J).EQ.IBLANK)GO TO 212
L=L+1
JBUFFR(L)=MCHNAM(I,J)
212 CONTINUE
L=L+1
JBUFFR(L)=IDOT
DO 213 J=1,3
IF(MCHEXT(I,J).EQ.IBLANK)GO TO 213
L=L+1
JBUFFR(L)=MCHEXT(I,J)
213 CONTINUE
214 WRITE(JTTY,215)(JBUFFR(M),M=1,L)
215 FORMAT(7H File: ,100A1)
C
C REPORT DATES
216 IF(IFDATE.EQ.0)GO TO 222
I=INIYER
IF(I.GE.100)I=I-100
J=LMTYER
IF(J.GE.100)J=J-100
L=3*INIMTH
K=L-2
N=3*LMTMTH
M=N-2
IF(INIMTH.NE.LMTMTH)GO TO 219
IF(INIYER.NE.LMTYER)GO TO 219
IF(IFSKIM.EQ.0)WRITE(JTTY,217)(IWORD(II),II=K,L),I
217 FORMAT(7H Date: ,3A1,1H:,1I2)
IF(IFSKIM.NE.0)WRITE(JTTY,218)(IWORD(II),II=K,L),I
218 FORMAT(7H Date: ,3A1,1H:,1I2,9H and SKIM)
GO TO 224
219 IF(IFSKIM.EQ.0)WRITE(JTTY,220)(IWORD(II),II=K,L),I,
1(IWORD(II),II=M,N),J
220 FORMAT(7H Date: ,3A1,1H:,1I2,4H to ,3A1,1H:,1I2)
IF(IFSKIM.NE.0)WRITE(JTTY,221)(IWORD(II),II=K,L),I,
1(IWORD(II),II=M,N),J
221 FORMAT(7H Date: ,3A1,1H:,1I2,4H to ,3A1,1H:,1I2,
19H and SKIM)
GO TO 224
222 IF(IFSKIM.NE.0)WRITE(JTTY,223)
223 FORMAT(11H Date: SKIM)
GO TO 224
C
C REPORT IF OLD SWITCH ISSUED
224 IF(IEXPIR.NE.0)WRITE(JTTY,225)
225 FORMAT(10H Show: OLD)
GO TO 25
C
C ****************************
C * *
C * RETURN TO MAIN PROGRAM *
C * *
C ****************************
C
C CHECK IF DEFAULTS MUST BE SUPPLIED
226 IF((KNTNAM+KNTNUM).EQ.0)GO TO 16
IF(NONDCS.EQ.0)GO TO 232
IF(KNTNUM.NE.0)GO TO 232
KNTNUM=1
DO 227 I=1,6
227 MCHNUM(1,1,I)=IQUEST
DO 228 I=1,6
228 MCHNUM(1,3,I)=IQUEST
I=6
J=LCLPRG
229 K=J
J=J/8
K=K-(8*J)
MCHNUM(1,2,I)=LTRDGT(K+1)
I=I-1
IF(J.GT.0)GO TO 229
K=6-I
DO 230 J=1,6
I=I+1
IF(I.LE.6)MCHNUM(1,2,J)=MCHNUM(1,2,I)
IF(I.GT.6)MCHNUM(1,2,J)=IBLANK
230 CONTINUE
WRITE(JTTY,231)(MCHNUM(1,2,I),I=1,K),IASSMD
231 FORMAT(1X,3H[*,,132A1)
C
C RETURN TO CALLING PROGRAM
232 RETURN
C
C EXIT COMMAND
233 STOP
END