Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/update/update.for
There is 1 other file named update.for in the archive. Click here to see a list.
00100 C WESTERN MICHIGAN UNIVERSITY
00200 C UPDATE.F4 (FILE NAME ON LIBRARY DECTAPE)
00300 C UPDATE, 3.4.2 (CALLING NAME, SUBLST. NO.)
00400 C RECORD INSERTIONS, MODIFICATIONS, DELETIONS, AND RETRIEVALS
00500 C THIS PROGRAM WAS ORIGINALLY PROGRAMMED BY B. GRANET.
00600 C SUBSTANTIAL ADDITIONAL PROGRAMMING WAS INCORPORATED BY
00700 C R.R. BARR III TO ALLOW FOR THE MAINTENANCE OF MULTIPLE
00800 C FILES, MODIFICATION OF PARTS OF RECORDS, AND FIELD SPECIFICATIONS.
00900 C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
01000 C FORWMU PROGS. USED: DEVICE, TTYPTY, PRINTS, DEVCHG,
01100 C EXIST, ALLCOR
01200 C APLIB PROGS. USED: IOB, FORGEN
01300 C INTERRAL SUBR. USED: NAMER, TREGEN, INMODE, RITIT,
01400 C PRTREC, RESRET, REDRIT, DYN1, DYN2, DYN3, DYN4, DYN5, DYN6,
01500 C DYN7, DYN9
01600 C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
01700 C
01750 IMPLICIT INTEGER (A-Z)
01800 DIMENSION IFMT(112),JFMT(114)
01900 DIMENSION MODE(120),JLEN(120)
02000 C KSIZE IS THE SAME SIZE AS MAXIMUM # OF FIELDS.
02100 EQUIVALENCE(IFMT(1),JFMT(2))
02200 DIMENSION NAME1(2),NAME2(2),BASE(1),NAME4(2)
02300 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
02400 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
02500 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
02600 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
02700 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
02800 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1,NAME2
02900 DATA JFMT(1)/'(1X,'/,JFMT(114)/')'/
03000 DATA BLANK/' '/
03200 DATA ONCE/0/
03300 C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE - BATCH JOB
03400 CALL TTYPTY(ICODE)
03500 INP=1
03600 IRP=2
03700 C SET TO 1 IN RITIT SUBROUTINE(SW3)
03800 SW3=0
03900 C SET TO 1 BY 'OUTPT' AND 'LIST',RESET TO 0 BY 'NEW' AND 'INSER'(SW4)
04000 C ALSO RESET TO 0 BY DELET
04100 SW4=0
04200 C---------------DEVCHG ASSOCIATES DSK, CDR, ETC. WITH LOGICAL
04300 C--------------- DEVICE NO.
04400 CALL DEVCHG('DSK',IRP)
04500 CALL DEVCHG('DSK',6)
04600 CALL DEVCHG('DSK',7)
04700 IF(ICODE.EQ.0)CALL DEVCHG('TTY',4)
04800 IF(ICODE.EQ.-1)CALL DEVCHG('DSK',4)
04900 IDLG=-1
05000 INT=5
05100 WRITE(IDLG,1)
05200 1 FORMAT(1X, 'WMU'/1X, 'FILE UPDATING AND RECORD RETRIEVAL'/)
05300 C CALL USAGE('UPDAT')
05400 4 WRITE(IDLG,2)
05500 2 FORMAT(/' *',$)
05600 READ(INT,3)CHOICE
05700 3 FORMAT(A5)
05800 IF(CHOICE.EQ.'NEW'.OR.CHOICE.EQ.'EXIT'.OR.CHOICE.EQ.'INSER'.OR.
05900 1CHOICE.EQ.'MODIF'.OR.CHOICE.EQ.'DELET'.OR.CHOICE.EQ.'PTREC'.OR.
06000 2CHOICE.EQ.'OUTPT'.OR.((CHOICE.AND."777777777400).OR."100).EQ.
06100 3'LIST')GO TO 17
06200 GO TO 70
06300 17 IF(CHOICE.NE.'NEW'.AND.CHOICE.NE.'EXIT')GO TO 6
06400 80 IF(CHOICE.EQ.'INSER')GO TO 52
06500 IF(CHOICE.EQ.'MODIF')GO TO 77
06600 IF(CHOICE.EQ.'DELET') GO TO 41
06700 IF(CHOICE.EQ.'NEW') GO TO 5
06800 IF(((CHOICE.AND."777777777400).OR."100).EQ.'LIST')GO TO 8
06900 IF(CHOICE.EQ.'PTREC') GO TO 9
07000 IF(CHOICE.EQ.'EXIT')GO TO 42
07100 IF(CHOICE.EQ.'OUTPT')GO TO 62
07200 70 WRITE(IDLG,40)
07300 40 FORMAT(' UNDEFINED OPTION-TRY AGAIN.'/)
07400 C---------------TERMINATE PROGRAM IF INT=5 IS NOT TERMINAL
07500 CALL DEVICE(INT)
07600 GO TO 4
07700 C 'NEW' PATH
07800 5 IF(ONCE.EQ.0) GO TO 84
07900 CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
08000 84 ONCE=1
08100 INSCTR=0
08200 DELFRE=0
08300 SW3=0
08400 SW4=0
08500 TRESIZ=0
08600 WRITE(IDLG,85)
08700 85 FORMAT(1X,'WHICH FIELD IS THE KEY?'/)
08800 READ(INT,86)KEYNO
08900 86 FORMAT(I)
09000 DO 87 I=1,19
09100 87 MODE(I)='A'
09200 MODE(KEYNO)='I'
09300 MSIZE=0
09400 CALL FORGEN(IFMT,112,MODE,JLEN,MSIZE,0,ISTD,IERR)
09500 IF(IERR.EQ.-1)CALL EXIT
09600 IF(IERR.EQ.1)CALL EXIT
09700 JX(0)=0
09800 JX(1)=0
09900 DO 88 I=2,MSIZE
10000 88 JX(I)=JX(I-1)+(JLEN(I-1)+4)/5
10100 NOVAR=JX(MSIZE)+(JLEN(MSIZE)+4)/5
10200 C---------------0 MEANS INPUT? PRINTS. IDLG, INT, INP, IRP, IDEVI,
10300 C--------------- IDEVO, ICODE ARE INPUT THRU COMMON /IOBLK/
10400 CALL IOB(0)
10500 CALL RELEAS(6)
10600 NORECS=0
10700 IF(IDEVI.NE.'TTY')GO TO 26
10800 WRITE(IDLG,91)
10900 91 FORMAT(1X,'ENTER RECORDS.'/)
11000 26 READ(INP,IFMT,END=27)(DATA(L),L=1,NOVAR)
11100 IF(IDEVI.EQ.'TTY')WRITE(6)(DATA(L),L=1,NOVAR)
11200 NORECS=NORECS+1
11300 GO TO 26
11400 27 WRITE(IDLG,21)NORECS
11500 21 FORMAT(1X,'THE NO. OF RECORDS IN MASTER FILE IS ',I6,'.'/)
11600 IF (NORECS.EQ.0)CALL EXIT
11700 REWIND INP
11800 REWIND 6
11900 TRESIZ=NORECS
12000 IF((1.AND.NORECS).EQ.0)TRESIZ=NORECS+1
12100 NPLUS=TRESIZ
12200 NORCS=NORECS
12300 IF((1.AND.NORECS).EQ.0)NORCS=NORECS+1
12400 MAX=4*(NORCS+200)
12500 CALL ALLCOR(MAX,IERR,I1,BASE)
12600 IF(IERR.NE.0)GO TO 82
12700 I0=NORCS+200
12800 I2=I1+I0
12900 I3=I2+I0
13000 I4=I3+I0
13100 CALL TREGEN(BASE(I1),BASE(I2),BASE(I3))
13200 IF(IDEVI.NE.'TTY')GO TO 90
13300 93 WRITE(IDLG,89)
13400 89 FORMAT(1X,'ENTER NAME FOR NEW MASTER FILE.'/)
13500 READ(INT,11)NAME3
13600 90 CALL DYN1(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
13700 GO TO 4
13800 C 'INSER' PATH
13900 52 CH123=1
14000 ONCE=1
14100 28 CALL DYN2(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
14200 SW4=0
14300 IF(SW3.EQ.1)GO TO 66
14400 GO TO 4
14500 C 'DELET' PATH
14600 41 CH123=2
14700 ONCE=1
14800 57 CALL DYN5(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
14900 SW4=0
15000 GO TO 4
15100 C 'LISTN' PATH
15200 8 CALL DYN7(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
15300 GO TO 4
15400 C 'EXIT' PATH
15500 42 IF(TRESIZ.EQ.0)GO TO 79
15600 CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
15700 CALL EXIT
15800 C 'PTREC' PATH
15900 9 CH123=3
16000 61 CALL DYN9(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
16100 GO TO 4
16200 C 'OUTPT' PATH
16300 62 CALL DYN6(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
16400 GO TO 4
16500 66 CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
16600 NAME2(2)='.NEW'
16700 CALL DEFINE FILE(7,0,NV,JNAME2,0,0,109)
16800 CALL DEFINE FILE(6,0,NV,JNAME1 ,0,0)
16900 DO 65 I=1,TRESIZ
17000 READ(6 )(DATA(K),K=1,NOVAR)
17100 65 WRITE(7 ,IFMT)(DATA(K),K=1,NOVAR)
17200 CALL RELEAS(6)
17300 CALL RELEAS(7 )
17400 CALL EXIT
17500 C (SW5.EQ.0.AND.CHOICE.NE.'NEW') PATH
17600 69 CALL DEFINE FILE(6,0,NV,JNAME2 ,0,0)
17700 READ(6 )NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
17800 1,MSIZE
17900 READ(6)(JX(I),I=0,120)
18000 NORCS=NORECS
18100 IF((1.AND.NORECS).EQ.0)NORCS=NORECS+1
18200 CALL ALLCOR(MAX,IERR,I1,BASE)
18300 I0=NORCS+200
18400 I2=I1+I0
18500 I3=I2+I0
18600 I4=I3+I0
18700 IF(CHOICE.NE.'INSER')GO TO 76
18800 NPLUS=TRESIZ
18900 76 IF(IERR.NE.0)GO TO 82
19000 SW5=1
19100 CALL DYN3(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
19200 C FIND NEXT PATH
19300 GO TO 80
19400 C 'MODIF' PATH
19500 77 CH123=4
19600 78 CALL DYN2(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
19700 GO TO 4
19800 79 WRITE(IDLG,81)
19900 81 FORMAT(1X,'CANNOT USE ''EXIT'' AS FIRST OPTION.'/)
20000 CALL DEVICE(INT)
20100 GO TO 4
20200 82 WRITE(IDLG,83)
20300 83 FORMAT(1X,'TOO MANY RECORDS'/)
20400 CALL DEVICE(INT)
20500 GO TO 4
20600 6 WRITE(IDLG,10)
20700 10 FORMAT(1X,'WHICH MASTER FILE?'/)
20800 NPLUS=TRESIZ
20900 READ(INT,11)NAME4
21000 CALL NAMER(NAME4)
21100 11 FORMAT(A5,A1)
21200 IF((NAME2(1).EQ.NAME5(1)).AND.(NAME2(2).EQ.NAME5(2)))
21300 1GO TO 80
21400 IF(ONCE.EQ.1)CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
21500 NAME5(1)=NAME2(1)
21600 NAME5(2)=NAME2(2)
21700 ONCE=0
21800 CALL EXIST(NAME1,IERR)
21900 IF(IERR.EQ.-1)GO TO 12
22000 IF(IERR.NE.0)GO TO 15
22100 CALL EXIST(NAME2,IERR)
22200 IF(IERR.NE.0)GO TO 18
22300 GO TO 69
22400 15 WRITE(IDLG,16) NAME1(1),NAME1(2)
22500 20 CALL DEVICE(INT)
22600 GO TO 6
22700 12 WRITE(IDLG,13)
22800 13 FORMAT(1X,'NAME IS INVALID. TRY AGAIN.'/)
22900 CALL DEVICE(INT)
23000 GO TO 6
23100 18 WRITE (IDLG,16)NAME2(1),NAME2(2)
23200 16 FORMAT(1X,'FILE ',2A5, ' DOES NOT EXIST.'/)
23300 GO TO 6
23400 END
23500 SUBROUTINE NAMER(NAME4)
23550 IMPLICIT INTEGER(A-Z)
23600 DIMENSION JFMT(114)
23700 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
23800 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
23900 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
24000 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
24100 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
24200 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
24400 DIMENSION RAN(8),PTK(8),NAME(6),NAME4(2)
24500 DATA DOT,RAN,PTK/'.','R','A','N',5*' ','P','T','K',5*' '/
24600 DECODE(6,100,NAME4(1)) (NAME(I),I=1,6)
24700 100 FORMAT(10A1)
24800 I=1
24900 DO 110 K=2,6
25000 IF(NAME(K).EQ.' '.OR.NAME(K).EQ.'.')GO TO 120
25100 110 I=I+1
25200 120 ENCODE(10,100,NAME1(1)) (NAME(J),J=1,I),DOT,(RAN(J),J=1,9-I)
25300 ENCODE(10,100,NAME2(1)) (NAME(J),J=1,I),DOT,(PTK(J),J=1,9-I)
25400 RETURN
25500 END
25600 SUBROUTINE TREGEN(LEFTSI,RITSID,SEQUEN)
25650 IMPLICIT INTEGER (A-Z)
25700 DIMENSION IFMT(112),JFMT(114)
25800 EQUIVALENCE(IFMT(1),JFMT(2))
25900 DIMENSION LEFTSI(1),RITSID(1),SEQUEN(1)
26000 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
26100 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
26200 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
26300 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
26400 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
26500 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
26700 TEMP1=NORECS/2+1
26800 SUB=TEMP1
26900 MEDIAN=TEMP1
27000 ADVANC=0
27100 DO 3 I=1,NORECS+200
27200 LEFTSI(I)=0
27300 3 RITSID(I)=0
27400 5 SUB5=SUB/2
27500 SUB5AD=ADVANC+SUB5
27600 SUBADV=SUB+ADVANC
27700 LEFTSI(SUBADV)=SUB5AD
27800 SEQUEN(SUB5AD)=SUBADV
27900 IF(SUB5.EQ.1)GO TO 4
28000 SUB=SUB5
28100 GO TO 5
28200 4 IF(SUB5AD.EQ.MEDIAN)GO TO 6
28300 RANGE=SEQUEN(SUB5AD)-SUB5AD
28400 IF(RANGE.EQ.1)GO TO 7
28500 IF(RANGE.EQ.2)GO TO 8
28600 IF(RANGE.EQ.3)GO TO 9
28700 RANGE=RANGE/2
28800 MIDDLE=SUB5AD+RANGE
28900 RITSID(SUB5AD)=MIDDLE
29000 SEQUEN(MIDDLE)=SEQUEN(SUB5AD)
29100 ADVANC=SUB5AD
29200 SUB=RANGE
29300 GO TO 5
29400 8 MIDDLE=SUB5AD+1
29500 RITSID(SUB5AD)=MIDDLE
29600 GO TO 7
29700 9 MIDDLE=SUB5AD+1
29800 RITSID(SUB5AD)=MIDDLE
29900 TEMP1=MIDDLE+1
30000 RITSID(MIDDLE)=TEMP1
30100 7 SUB5AD=SEQUEN(SUB5AD)
30200 GO TO 4
30300 6 TEMP1=2*MEDIAN-LEFTSI(MEDIAN)
30400 RITSID(MEDIAN)=TEMP1
30500 MEDRED=MEDIAN-1
30600 10 IF(LEFTSI(MEDRED).EQ.0.AND.RITSID(MEDRED).EQ.0)GO TO 11
30700 TEMP1=2*MEDIAN-LEFTSI(MEDRED)
30800 IF(TEMP1.EQ.(2*MEDIAN))GO TO 12
30900 TEMP2=2*MEDIAN-MEDRED
31000 RITSID(TEMP2)=TEMP1
31100 12 TEMP1=2*MEDIAN-RITSID(MEDRED)
31200 IF(TEMP1.EQ.(2*MEDIAN))GO TO 11
31300 TEMP2=2*MEDIAN-MEDRED
31400 LEFTSI(TEMP2)=TEMP1
31500 11 MEDRED=MEDRED-1
31600 IF(MEDRED.EQ.0)RETURN
31700 GO TO 10
31800 END
31900 SUBROUTINE INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
31950 IMPLICIT INTEGER (A-Z)
32000 DIMENSION IFMT(112),JFMT(114)
32100 EQUIVALENCE(IFMT(1),JFMT(2))
32200 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
32300 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
32400 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
32500 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
32600 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
32700 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
32800 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
33000 IF((1.AND.NORECS).NE.0)GO TO 80
33100 N=NORECS+1
33200 IF(NEWINF.GT.RECKEY(MEDIAN-1))GO TO 2
33300 GO TO 5
33400 80 N=NORECS
33500 8 IF(NEWINF.LE.RECKEY(SEARCH))GO TO 1
33600 GO TO 2
33700 1 IF(NEWINF.EQ.RECKEY(SEARCH))GO TO 16
33800 5 TEMP1=LEFTSI(SEARCH)
33900 I=1
34000 6 TEMP2=SEARCH
34100 SEARCH=TEMP1
34200 Z=TEMP1-TEMP2
34300 GO TO 4
34400 16 IF(DELMRK(SEARCH).NE.'D')GO TO 46
34500 GO TO (50,52,56,3,3),CH123
34600 50 DELMRK(SEARCH)=BLANK
34700 GO TO 34
34800 2 TEMP1=RITSID(SEARCH)
34900 I=2
35000 GO TO 6
35100 4 IF(Z.EQ.1.OR.Z.EQ.-1.OR.TEMP1.GT.N.OR.TEMP2.GT.N.OR.TEMP1.EQ.0)
35200 1GO TO 7
35300 GO TO 8
35400 7 IF(TEMP1.EQ.0)GO TO 63
35500 IF((Z.EQ.-1).OR.(TEMP1.GT.N.AND.TEMP2.GT.N.AND.I.EQ.1))GO TO 9
35600 GO TO 10
35700 9 IF(NEWINF.LE.RECKEY(SEARCH))GO TO 14
35800 20 GO TO (69,59,61,70,70),CH123
35900 69 NPLUS=NPLUS+1
36000 LEFTSI(NPLUS)=TEMP1
36100 65 LEFTSI(TEMP2)=NPLUS
36200 GO TO 23
36300 63 IF(I.EQ.1)GO TO 64
36400 GO TO (72,59,61,70,70),CH123
36500 72 NPLUS=NPLUS+1
36600 GO TO 27
36700 64 GO TO (73,59,61,70,70),CH123
36800 73 NPLUS=NPLUS+1
36900 GO TO 65
37000 10 IF(Z.NE.1)GO TO 12
37100 IF(NEWINF.LT.RECKEY(SEARCH))GO TO 13
37200 14 IF(NEWINF.NE.RECKEY(SEARCH))GO TO 12
37300 GO TO 16
37400 13 GO TO (74,59,61,70,70),CH123
37500 74 NPLUS=NPLUS+1
37600 RITSID(NPLUS)=TEMP1
37700 27 RITSID(TEMP2)=NPLUS
37800 23 SEARCH=NPLUS
37900 34 INSCTR=INSCTR+1
38000 43 CALL RITIT(RECKEY)
38100 RETURN
38200 12 IF(I.EQ.1)GO TO 15
38300 IF(RITSID(TEMP1).EQ.0)GO TO 17
38400 22 IF(NEWINF.LE.RECKEY(SEARCH))GO TO 18
38500 IF(I.NE.1)GO TO 19
38600 GO TO 20
38700 15 IF(LEFTSI(TEMP1).EQ.0)GO TO 67
38800 GO TO 22
38900 17 GO TO (75,59,61,70,70),CH123
39000 75 NPLUS=+NPLUS+1
39100 RITSID(NPLUS)=RITSID(TEMP1)
39200 RITSID(TEMP1)=NPLUS
39300 GO TO 23
39400 18 IF(NEWINF.NE.RECKEY(SEARCH))GO TO 24
39500 GO TO 16
39600 24 IF(I.EQ.1)GO TO 25
39700 GO TO (76,59,61,70,70),CH123
39800 76 NPLUS=NPLUS+1
39900 RITSID(NPLUS)=SEARCH
40000 GO TO 27
40100 25 SEARCH=LEFTSI(TEMP1)
40200 GO TO 26
40300 21 GO TO (77,59,61,70,70),CH123
40400 77 NPLUS=NPLUS+1
40500 LEFTSI(NPLUS)=LEFTSI(TEMP1)
40600 LEFTSI(TEMP1)=NPLUS
40700 GO TO 23
40800 26 IF(NEWINF.LE.RECKEY(SEARCH))GO TO 28
40900 GO TO 29
41000 28 IF(NEWINF.NE.RECKEY(SEARCH))GO TO 30
41100 GO TO 16
41200 29 IF(I.EQ.1)GO TO 21
41300 GO TO 17
41400 30 IF(I.EQ.1)GO TO 31
41500 GO TO 32
41600 31 IF(LEFTSI(SEARCH).EQ.0)GO TO 33
41700 TEMP1=SEARCH
41800 SEARCH=LEFTSI(SEARCH)
41900 GO TO 26
42000 33 GO TO (78,59,61,70,70),CH123
42100 78 NPLUS=NPLUS+1
42200 LEFTSI(SEARCH)=NPLUS
42300 GO TO 23
42400 32 IF(RITSID(SEARCH).EQ.0)GO TO 35
42500 TEMP1=SEARCH
42600 SEARCH=RITSID(SEARCH)
42700 GO TO 26
42800 35 GO TO (79,59,61,70,70),CH123
42900 79 NPLUS=NPLUS+1
43000 RITSID(SEARCH)=NPLUS
43100 GO TO 23
43200 19 SEARCH=RITSID(TEMP1)
43300 40 IF(NEWINF.LE.RECKEY(SEARCH))GO TO 36
43400 GO TO 37
43500 36 IF(NEWINF.NE.RECKEY(SEARCH))GO TO 38
43600 GO TO 16
43700 38 GO TO (81,59,61,70,70)CH123
43800 81 NPLUS=NPLUS+1
43900 RITSID(NPLUS)=SEARCH
44000 RITSID(TEMP1)=NPLUS
44100 GO TO 23
44200 37 IF(RITSID(SEARCH).NE.0)GO TO 39
44300 GO TO 35
44400 39 TEMP1=SEARCH
44500 SEARCH=RITSID(SEARCH)
44600 GO TO 40
44700 46 GO TO (68,58,55,43,101),CH123
44800 52 CALL DEFINE FILE(4 ,0,NV,'MESFIL.',0,0,109)
44900 WRITE(4 ,54)NEWINF
45000 54 FORMAT(' YOU ATTEMPTED TO DELETE A RECORD PREVIOUSLY DELETED.'/,
45100 1' THE KEY IS ',I10,' .'/)
45200 101 RETURN
45300 55 CALL PRTREC
45400 RETURN
45500 56 CALL DEFINE FILE(4 ,0,NV,'MESFIL.',0,0,109)
45600 WRITE(4 ,57)NEWINF
45700 57 FORMAT(' YOU ATTEMPTED TO PRINT A RECORD PREVIOUSLY DELETED.'/,
45800 1' THE KEY IS ',I10,' .'/)
45900 RETURN
46000 58 DELMRK(SEARCH)='D'
46100 DELFRE=DELFRE+1
46200 RETURN
46300 59 CALL DEFINE FILE(4 ,0,NV,'MESFIL.',0,0,109)
46400 WRITE(4 ,60)NEWINF
46500 60 FORMAT(' YOU ATTEMPTED TO DELETE A RECORD WHICH DOES NOT EXIST.'/,
46600 1' THE KEY IS ',I10,' .'/)
46700 RETURN
46800 61 CALL DEFINE FILE(4 ,0,NV,'MESFIL.',0,0,109)
46900 WRITE(4 ,62)NEWINF
47000 62 FORMAT(' YOU ATTEMPTED TO PRINT A RECORD WHICH DOES NOT EXIST.'/,
47100 1' THE KEY IS ',I10,' .'/)
47200 RETURN
47300 67 IF(NEWINF.LE.RECKEY(TEMP1))GO TO 21
47400 GO TO 20
47500 3 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
47600 WRITE(4,11)NEWINF
47700 11 FORMAT(' YOU ATTEMPTED TO MODIFY A RECORD PREVIOUSLY DELETED.'/,
47800 1' THE KEY IS ',I10,' ,'/)
47900 RETURN
48000 68 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
48100 WRITE(4,82)NEWINF
48200 82 FORMAT(' YOU ATTEMPTED TO INSERT WITH A KEY WHICH ALREADY EXISTS.
48300 1'/,1X,' THE KEY IS ',I10,' .'/)
48400 RETURN
48500 70 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
48600 WRITE(4,71)NEWINF
48700 71 FORMAT(' YOU ATTEMPTED TO MODIFY WITH A KEY WHICH DOES NOT EXIST.
48800 1 '/1X,'THE KEY IS ',I10,' .'/)
48900 SW3=1
49000 RETURN
49100 END
49200 SUBROUTINE RITIT(RECKEY)
49250 IMPLICIT INTEGER (A-Z)
49300 DIMENSION IFMT(112),JFMT(114)
49400 EQUIVALENCE(IFMT(1),JFMT(2))
49500 DIMENSION RECKEY(1)
49600 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
49700 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
49800 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
49900 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
50000 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
50100 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
50300 Z=INSCTR+NORECS
50400 IF(Z.GT.3500 )GO TO 2
50500 IF(INSCTR.LE.200)GO TO 1
50600 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
50700 WRITE(4,3)NEWINF,Z
50800 3 FORMAT(1X,'THE MAX. NO. OF RECORD INSERTIONS HAS BEEN REACHED.'/
50900 11X,'START OVER BY ENTERING THE "NEW" OPTION. THE FIRST RECORD '/1X
51000 2,'NOT INSERTED HAS KEY ',I10,' .'/1X,'THE TOTAL NO. OF RECORDS ',
51100 3'IN YOUR FILE IS ',I5,' .'/)
51200 SW3=1
51300 RETURN
51400 1 WRITE(7 #SEARCH) (DATA(I),I=1,NOVAR)
51500 RECKEY(SEARCH)=NEWINF
51600 RETURN
51700 2 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
51800 WRITE(4,4)
51900 4 FORMAT(1X,'YOUR FILE CONTAINS MAX. NO. OF RECORDS(3500 ) ',
52000 1'ALLOWED BY THIS PROGRAM.'/1X,'THE FIRST RECORD NOT INSERTED ',
52100 2'HAS KEY ',I10,' .'/)
52200 SW3=1
52300 RETURN
52400 END
52500 SUBROUTINE PRTREC
52550 IMPLICIT INTEGER (A-Z)
52600 DIMENSION IFMT(112),JFMT(114)
52700 EQUIVALENCE(IFMT(1),JFMT(2))
52800 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
52900 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
53000 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
53100 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
53200 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
53300 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
53500 READ(6 #SEARCH) (DATA(I),I=1,NOVAR)
53600 IF(IDEVO.EQ.'LPT'.OR.IDEVO.EQ.'TTY')GO TO 1
53700 WRITE(IRP,IFMT)(DATA(I),I=1,NOVAR)
53800 2 RETURN
53900 1 WRITE(IRP,JFMT)(DATA(I),I=1,NOVAR)
54000 GO TO 2
54100 END
54200 SUBROUTINE RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
54250 IMPLICIT INTEGER (A-Z)
54300 DIMENSION IFMT(112),JFMT(114)
54400 EQUIVALENCE(IFMT(1),JFMT(2))
54500 DIMENSION LEFTSI(1),RITSID(1),SASEAR(1),DELMRK(1)
54600 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
54700 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
54800 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
54900 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
55000 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
55100 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
55300 CALL DEFINE FILE(6,NOVAR,NV,JNAME1,0,0)
55400 NONODS=NORECS
55500 IF((1.AND.NORECS).EQ.0)NONODS=NORECS+1
55600 1 NPLU =NONODS+INSCTR-DELFRE
55700 SEARCH=1
55800 LIFO=1
55900 I=1
56000 COUNTR=0
56100 IF(LEFTSI(1).LE.NONODS)GO TO 2
56200 LIFO=1
56300 GO TO 4
56400 2 I=2
56500 SEARCH=0
56600 GO TO 3
56700 4 IF(I.EQ.1)GO TO 5
56800 SW1=1
56900 GO TO 6
57000 5 SASEAR(LIFO)=SEARCH
57100 IF(LEFTSI(SEARCH).LE.NONODS)GO TO 14
57200 LIFO=LIFO+1
57300 SEARCH=LEFTSI(SEARCH)
57400 GO TO 4
57500 6 TEMP2=SEARCH
57600 10 SEARCH=RITSID(SEARCH)
57700 IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
57800 IF(COUNTR.EQ.NPLU )RETURN
57900 IF(RITSID(SEARCH).LT.NONODS.AND.RITSID(SEARCH).NE.0)GO TO 8
58000 11 IF(RITSID(SEARCH).NE.0)GO TO 10
58100 IF(SW1.GT.1)GO TO 9
58200 SEARCH=TEMP2
58300 GO TO 3
58400 9 SEARCH=TEMP1
58500 GO TO 3
58600 8 SW1=SW1+1
58700 TEMP1=RITSID(SEARCH)
58800 GO TO 10
58900 3 SEARCH=SEARCH+1
59000 IF(LEFTSI(SEARCH).LT.NONODS)GO TO 13
59100 I=1
59200 LIFO=1
59300 GO TO 5
59400 13 IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
59500 IF(COUNTR.EQ.NPLU )RETURN
59600 GO TO 12
59700 12 IF(I.EQ.1)GO TO 15
59800 GO TO 16
59900 14 IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
60000 IF(COUNTR.EQ.NPLU )RETURN
60100 IF(LIFO.EQ.1)GO TO 17
60200 LIFO=LIFO-1
60300 SEARCH=SASEAR(LIFO)
60400 IF(LEFTSI(SEARCH).LE.NONODS)GO TO 19
60500 GO TO 14
60600 17 IF(I.EQ.1)GO TO 18
60700 I=1
60800 GO TO 15
60900 18 I=2
61000 GO TO 16
61100 19 IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
61200 IF(COUNTR.EQ.NPLU )RETURN
61300 SEARCH=SEARCH+1
61400 GO TO 12
61500 15 IF(LEFTSI(SEARCH).LE.NONODS)GO TO 20
61600 LIFO=1
61700 GO TO 4
61800 16 IF(RITSID(SEARCH).LE.NONODS)GO TO 20
61900 LIFO=1
62000 GO TO 4
62100 20 IF(I.EQ.2)GO TO 3
62200 I=2
62300 GO TO 16
62400 END
62500 SUBROUTINE REDRIT
62550 IMPLICIT INTEGER (A-Z)
62600 DIMENSION IFMT(112),JFMT(114)
62700 EQUIVALENCE(IFMT(1),JFMT(2))
62800 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
62900 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
63000 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
63100 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
63200 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
63300 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
63500 COUNTR=COUNTR+1
63600 IF((1.AND.NORECS).NE.0)GO TO 1
63700 IF(SEARCH.EQ.MEDIAN)GO TO 2
63800 1 READ(6 #SEARCH) (DATA(I),I=1,NOVAR)
63900 IF(IDEVO.EQ.'LPT'.OR.IDEVO.EQ.'TTY')GO TO 3
64000 WRITE(IRP,IFMT)(DATA(I),I=1,NOVAR)
64100 2 RETURN
64200 3 WRITE(IRP,JFMT)(DATA(I),I=1,NOVAR)
64300 RETURN
64400 END
64500 C CALLED BY 'NEW' PATH(DYN1)
64600 SUBROUTINE DYN1(LEFTSI,RITSID,RECKEY,DELMRK)
64650 IMPLICIT INTEGER(A-Z)
64700 DIMENSION IFMT(112),JFMT(114)
64800 EQUIVALENCE(IFMT(1),JFMT(2))
64900 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
65000 DIMENSION KNAM(10),NAME4(2)
65100 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
65200 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
65300 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
65400 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
65500 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
65600 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
65800 NAME4(1)=NAME3(1)
65900 NAME4(2)=NAME3(2)
66000 13 FORMAT(A5,A1)
66100 17 CALL NAMER(NAME4)
66200 CALL EXIST(NAME1,IERR)
66300 IF(IERR.EQ.-1)GO TO 14
66400 IF(IERR.NE.0)GO TO 10
66500 CALL DEVICE(INT)
66600 WRITE(IDLG,11)
66700 11 FORMAT(1X,'THIS MASTER FILE NAME ALREADY EXISTS.USE ANOTHER NAME.'
66800 1/)
66900 16 WRITE(IDLG,12)
67000 12 FORMAT(1X,'WHICH MASTER FILE NAME WOULD YOU LIKE?'/)
67100 READ(INT,13)NAME4
67200 GO TO 17
67300 14 WRITE(IDLG,15)
67400 15 FORMAT(1X,'INVALID NAME-TRY AGAIN.'/)
67500 GO TO 16
67600 10 TEMP=0
67700 NAME5(1)=NAME2(1)
67800 NAME5(2)=NAME2(2)
67900 CALL DEFINE FILE(7,0,NV,JNAME1,0,0,109)
68000 IF((1.AND.NORECS).EQ.0)GO TO 19
68100 DO 18 I=1,TRESIZ
68200 IF(IDEVI.NE.'TTY')GO TO 40
68300 READ(6)(DATA(K),K=1,NOVAR)
68400 GO TO 35
68500 40 READ(INP,IFMT)(DATA(K),K=1,NOVAR)
68600 35 IF(DATA(KEYNO).LE.0)GO TO 26
68700 IF(DATA(KEYNO)-TEMP)27,28,32
68800 32 RECKEY(I)=DATA(KEYNO)
68900 TEMP=DATA(KEYNO)
69000 18 WRITE(7 )(DATA(J),J=1,NOVAR)
69100 GO TO 25
69200 19 DO 20 I=1,MEDIAN-1
69300 IF(IDEVI.NE.'TTY')GO TO 36
69400 READ(6)(DATA(J),J=1,NOVAR)
69500 GO TO 37
69600 36 READ(INP,IFMT)(DATA(J),J=1,NOVAR)
69700 37 IF(DATA(KEYNO).LE.0)GO TO 26
69800 IF(DATA(KEYNO)-TEMP)27,28,33
69900 33 RECKEY(I)=DATA(KEYNO)
70000 TEMP=DATA(KEYNO)
70100 20 WRITE(7 )(DATA(J),J=1,NOVAR)
70200 WRITE(7 )(DATA(J),J=1,NOVAR)
70300 DO 23 I=MEDIAN+1,TRESIZ
70400 IF(IDEVI.NE.'TTY')GO TO 38
70500 READ(6)(DATA(J),J=1,NOVAR)
70600 GO TO 39
70700 38 READ(INP,IFMT)(DATA(J),J=1,NOVAR)
70800 39 IF(DATA(KEYNO).LE.0)GO TO 26
70900 IF(DATA(KEYNO)-TEMP)27,28,34
71000 34 RECKEY(I)=DATA(KEYNO)
71100 TEMP=DATA(KEYNO)
71200 23 WRITE(7)(DATA(J),J=1,NOVAR)
71300 25 DO 24 I=1,TRESIZ+200
71400 24 DELMRK(I)=BLANK
71500 CALL RELEAS(INP)
71600 CALL RELEAS(7 )
71700 RETURN
71800 26 WRITE(IDLG,29)DATA(KEYNO)
71900 29 FORMAT(1X,I10,' IS INVALID KEY.'/)
72000 CALL EXIT
72100 27 WRITE(IDLG,30)DATA(KEYNO)
72200 30 FORMAT(1X,I10,' IS A KEY OUT OF SEQUENCE.'/)
72300 CALL EXIT
72400 28 WRITE(IDLG,31)DATA(KEYNO)
72500 31 FORMAT(1X,I10,' IS A KEY WITH A DUPLICATE.'/)
72600 END
72700 C CALLED BY 'INSER' AND 'MODIF' PATHS(DYN2)
72800 SUBROUTINE DYN2(LEFTSI,RITSID,RECKEY,DELMRK)
72850 IMPLICIT INTEGER(A-Z)
72900 DIMENSION IFMT(112),JFMT(114),VALUE(16)
73000 EQUIVALENCE(IFMT(1),JFMT(2))
73100 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
73200 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
73300 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
73400 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
73500 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
73600 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
73700 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
73900 IF(SW4.EQ.1)GO TO 1
74000 6 CALL DEFINE FILE(7,NOVAR,NV,JNAME1,0,0)
74100 CALL IOB(0)
74200 8 IF(CH123.EQ.4)GO TO 14
74300 29 IF(IDEVI.EQ.'TTY')WRITE(IDLG,7)
74400 7 FORMAT(' #',$)
74500 READ(INP,IFMT,END=50,ERR=9)(DATA(I),I=1,NOVAR)
74600 SEARCH=MEDIAN
74700 NEWINF=DATA(KEYNO)
74800 IF(NEWINF.EQ.0)GO TO 4
74900 CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
75000 IF(SW3.EQ.1)RETURN
75100 GO TO 29
75200 50 CALL RELEAS(7 )
75300 CALL RELEAS(INP)
75400 IF(CH123.NE.1)GO TO 21
75500 TRESIZ=NPLUS
75600 21 RETURN
75700 1 CALL DEFINE FILE(6,0,NV,JNAME2,0,0)
75800 READ(6)(DUMMY,I=1,121)
75900 READ(6)(DUMMY,I=1,121)
76000 X=TRESIZ/60
76100 DO 3 I=1,X
76200 3 READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
76300 IF(X *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
76400 1TRESIZ)
76500 CALL RELEAS(6 )
76600 GO TO 6
76700 4 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
76800 WRITE(4,5)
76900 5 FORMAT(1X,'KEY IS ZERO AND NOT ALLOWED.'/)
77000 GO TO 8
77100 9 WRITE(IDLG,10)
77200 10 FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
77300 GO TO 8
77400 14 WRITE(IDLG,12)
77500 12 FORMAT(1X,'ENTER KEY AND NO. OF FIELDS TO BE CHANGED.'/1X,
77600 1'0 IF WHOLE RECORD IS CHANGED.'/)
77700 READ(INP,13,END=50)KEY,VARNO
77800 13 FORMAT(3I)
77900 SEARCH=MEDIAN
78000 NEWINF=KEY
78100 IF(NEWINF.EQ.0)GO TO 4
78200 CH123=5
78300 CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
78400 IF(SW3.EQ.1)GO TO 22
78500 CALL DEFINE FILE(6,NOVAR,NV,JNAME1,0,0)
78600 READ(6#SEARCH)(DATA(I),I=1,NOVAR)
78700 CALL RELEAS(6)
78800 IF(VARNO.EQ.0)GO TO 53
78900 20 WRITE(IDLG,19)
79000 19 FORMAT(1X,'ENTER FIELD NUMBER FOLLOWED BY COMMA AND VALUE.'/)
79100 DO 15 J=1,VARNO
79200 23 IF(IDEVI.EQ.'TTY')WRITE(IDLG,7)
79300 READ(INP,16,END=51)FIELD,VALUE
79400 IF(FIELD.LE.0.OR.FIELD.GT.MSIZE)GO TO 17
79500 IF(FIELD.EQ.KEYNO)GO TO 17
79600 IFULLS=JX(FIELD)-JX(FIELD-1)
79700 DO 52 K=1,IFULLS
79800 52 DATA(JX(FIELD)+K)=VALUE(K)
79900 15 CONTINUE
80000 51 CALL RITIT(RECKEY)
80100 CH123=4
80200 GO TO 14
80300 17 WRITE(IDLG,18)
80400 18 FORMAT(1X,'?YOU ENTERED AN INVALID FIELD NO.'/)
80500 GO TO 23
80600 16 FORMAT(I,16A5)
80700 22 SW3=0
80800 GO TO 14
80900 53 WRITE(IDLG,54)
81000 54 FORMAT(1X,'ENTER RECORD.'/)
81100 READ(INP,IFMT)(DATA(I),I=1,NOVAR)
81200 IF(DATA(KEYNO).EQ.KEY)GO TO 51
81300 55 CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
81400 WRITE(4,56)
81500 56 FORMAT(1X,'INVALID KEY FIELD N0.'/)
81600 CALL RELEAS(4)
81700 GO TO 14
81800 END
81900 C CALLED BY (SW5.EQ.0.AND.CHOICE.NE.'NEW') PATH(DYN3)
82000 SUBROUTINE DYN3(LEFTSI,RITSID,RECKEY,DELMRK)
82050 IMPLICIT INTEGER (A-Z)
82100 DIMENSION IFMT(112),JFMT(114)
82200 EQUIVALENCE(IFMT(1),JFMT(2))
82300 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
82400 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
82500 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
82600 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
82700 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
82800 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
82900 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
83100 X=TRESIZ/60
83200 DO 67 I=1,X
83300 67 READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
83400 IF(X *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
83500 1TRESIZ)
83600 DO 1 I=1,X
83700 1 READ(6)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
83800 IF(X *60.NE.TRESIZ)READ(6)(LEFTSI(J),RITSID(J) ,J=X*60+1,
83900 1TRESIZ)
84000 CALL RELEAS(6 )
84100 RETURN
84200 END
84300 C CALLED BY 'EXIT' PATH(DYN4)
84400 SUBROUTINE DYN4(LEFTSI,RITSID,RECKEY,DELMRK)
84450 IMPLICIT INTEGER(A-Z)
84500 DIMENSION IFMT(112),JFMT(114)
84600 EQUIVALENCE(IFMT(1),JFMT(2))
84700 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
84800 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
84900 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
85000 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
85100 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
85200 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
85300 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
85500 IF(SW4.EQ.1)GO TO 1
85600 CALL DEFINE FILE(7,0,NV,JNAME5 ,0,0,109)
85700 WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
85800 1,MSIZE
85900 WRITE(7)(JX(I),I=0,120)
86000 X=TRESIZ/60
86100 DO 48 I=1,X
86200 48 WRITE(7)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
86300 IF(X *60.NE.TRESIZ)WRITE(7)(RECKEY(J),DELMRK(J),J=X*60+1,
86400 1TRESIZ)
86500 DO 2 I=1,X
86600 2 WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
86700 IF(X *60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),J=X*60+1,
86800 1TRESIZ)
86900 CALL RELEAS(7)
87000 1 CALL RELEAS(4)
87100 RETURN
87200 END
87300 C CALLED BY 'DELET' PATH(DYN5)
87400 SUBROUTINE DYN5(LEFTSI,RITSID,RECKEY,DELMRK)
87450 IMPLICIT INTEGER(A-Z)
87500 DIMENSION IFMT(112),JFMT(114)
87600 EQUIVALENCE(IFMT(1),JFMT(2))
87700 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
87800 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
87900 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
88000 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
88100 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
88200 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
88300 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
88500 IF(SW4.EQ.1)GO TO 1
88600 6 CALL IOB(0)
88700 64 IF(IDEVI.NE.'TTY')GO TO 5
88800 9 WRITE(IDLG,4)
88900 4 FORMAT(/' #',$)
89000 5 READ (INP,7,END=59,ERR=2)NEWINF
89100 7 FORMAT(I)
89200 SEARCH=MEDIAN
89300 CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
89400 GO TO 64
89500 59 CALL RELEAS(INP)
89600 RETURN
89700 1 CALL DEFINE FILE(6,0,NV,JNAME2 ,0,0)
89800 READ(6)(DUMMY,I=1,121)
89900 READ(6)(DUMMY,I=1,121)
90000 X=TRESIZ/60
90100 DO 3 I=1,X
90200 3 READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
90300 IF(X *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
90400 1TRESIZ)
90500 CALL RELEAS(6)
90600 GO TO 6
90700 2 WRITE(IDLG,8)
90800 8 FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
90900 GO TO 9
91000 END
91100 C CALLED BY 'OUTPT' PATH(DYN6)
91200 SUBROUTINE DYN6(LEFTSI,RITSID,SASEAR,DELMRK)
91250 IMPLICIT INTEGER(A-Z)
91300 DIMENSION IFMT(112),JFMT(114)
91400 EQUIVALENCE(IFMT(1),JFMT(2))
91500 DIMENSION LEFTSI(1),RITSID(1),DELMRK(1),SASEAR(1)
91600 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
91700 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
91800 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
91900 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
92000 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
92100 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
92300 IF(SW4.EQ.1)GO TO 1
92400 CALL DEFINE FILE(7,0,NV,JNAME2 ,0,0,109)
92500 WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
92600 1,MSIZE
92700 WRITE(7)(JX(I),I=0,120)
92800 X=TRESIZ/60
92900 DO 48 I=1,X
93000 48 WRITE(7)(SASEAR(J),DELMRK(J),J=(I-1)*60+1,I*60)
93100 IF(X *60.NE.TRESIZ)WRITE(7)(SASEAR(J),DELMRK(J),J=X*60+1,
93200 1TRESIZ)
93300 DO 2 I=1,TRESIZ/60
93400 2 WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
93500 X=TRESIZ/60
93600 IF((TRESIZ/60)*60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),J=X*60+1,
93700 1TRESIZ)
93800 CALL RELEAS(7)
93900 SW4=1
94000 1 CALL IOB(1)
94100 CALL RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
94200 CALL RELEAS(IRP)
94300 CALL RELEAS(6)
94400 CALL DEVCHG('DSK',2)
94500 RETURN
94600 END
94700 C CALLED BY 'LISTN' PATH(DYN7)
94800 SUBROUTINE DYN7(LEFTSI,RITSID,SASEAR,DELMRK)
94850 IMPLICIT INTEGER(A-Z)
94900 DIMENSION IFMT(112),JFMT(114)
95000 EQUIVALENCE(IFMT(1),JFMT(2))
95100 DIMENSION LEFTSI(1),RITSID(1),DELMRK(1),SASEAR(1)
95200 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
95300 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
95400 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
95500 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
95600 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
95700 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
95900 IF(SW4.EQ.1)GO TO 1
96000 CALL DEFINE FILE(7,0,NV,JNAME2 ,0,0,109)
96100 WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
96200 1,MSIZE
96300 WRITE(7)(JX(I),I=0,120)
96400 X=TRESIZ/60
96500 DO 48 I=1,X
96600 48 WRITE(7)(SASEAR(J),DELMRK(J),J=(I-1)*60+1,I*60)
96700 IF(X *60.NE.TRESIZ)WRITE(7)(SASEAR(J),DELMRK(J),
96800 1J=X*60+1,TRESIZ)
96900 DO 2 I=1,X
97000 2 WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
97100 IF(X *60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),
97200 1J=X*60+1,TRESIZ)
97300 CALL RELEAS(7)
97400 SW4=1
97500 1 CALL DEVCHG('DSK',IRP)
97600 CALL DEFINE FILE(IRP ,0 ,NV,'NFS.',0,0)
97700 CALL RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
97800 A="377 .AND.CHOICE
97900 B=(A/2)-"60
98000 CALL RELEAS(IRP)
98100 CALL RELEAS(6)
98200 CALL PRINTS('NFS',2,0,B)
98300 RETURN
98400 END
98500 C CALLED BY 'PTREC' PATH(DYN9)
98600 SUBROUTINE DYN9(LEFTSI,RITSID,RECKEY,DELMRK)
98650 IMPLICIT INTEGER(A-Z)
98700 DIMENSION IFMT(112),JFMT(114)
98800 EQUIVALENCE(IFMT(1),JFMT(2))
98900 DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
99000 DOUBLE PRECISION JNAME1,JNAME2,JNAME5
99100 EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
99200 COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
99300 COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR, SEARCH,
99400 1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
99500 2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
99700 IF(SW4.EQ.1)GO TO 1
99800 4 CALL DEFINE FILE(6 ,NOVAR ,NV,JNAME1 ,0,0)
99900 CALL IOB(1)
00100 CALL IOB(0)
00200 65 IF(IDEVI.NE.'TTY')GO TO 2
00300 9 WRITE(IDLG,5)
00400 5 FORMAT(/' #',$)
00500 2 READ(INP,7,END=63,ERR=6)NEWINF
00600 7 FORMAT(I)
00700 SEARCH=MEDIAN
00800 CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
00900 GO TO 65
01000 63 CALL RELEAS(6)
01100 CALL RELEAS(IRP)
01200 CALL RELEAS(INP)
01300 RETURN
01400 1 CALL DEFINE FILE(6,0,NV,JNAME2 ,0,0)
01500 READ(6)(DUMMY,I=1,121)
01600 READ(6)(DUMMY,I=1,121)
01700 X=TRESIZ/60
01800 DO 3 I=1,X
01900 3 READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
02000 IF(X *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
02100 1TRESIZ)
02200 CALL RELEAS(6)
02300 GO TO 4
02400 6 WRITE(IDLG,8)
02500 8 FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
02600 GO TO 9
02700 END