Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - 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