Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/update.f4
There are no other files named update.f4 in the archive.
C	WESTERN MICHIGAN UNIVERSITY
C	UPDATE.F4 (FILE NAME ON LIBRARY DECTAPE)
C	UPDATE, 3.4.2 (CALLING NAME, SUBLST. NO.)
C	RECORD INSERTIONS, MODIFICATIONS, DELETIONS, AND RETRIEVALS
C	THIS PROGRAM WAS ORIGINALLY PROGRAMMED BY B. GRANET.
C	 SUBSTANTIAL ADDITIONAL PROGRAMMING WAS INCORPORATED BY
C	 R.R. BARR III TO ALLOW FOR THE MAINTENANCE OF MULTIPLE
C	 FILES, MODIFICATION OF PARTS OF RECORDS, AND FIELD SPECIFICATIONS.
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	FORWMU PROGS. USED:  DEVICE, TTYPTY, PRINTS, DEVCHG, 
C	 EXIST, ALLCOR
C	APLIB PROGS. USED:  IOB, FORGEN
C	INTERRAL SUBR. USED:  NAMER, TREGEN, INMODE, RITIT,
C	 PRTREC, RESRET, REDRIT, DYN1, DYN2, DYN3, DYN4, DYN5, DYN6,
C	 DYN7, DYN9
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
      DIMENSION IFMT(112),JFMT(114)
	DIMENSION MODE(120),JLEN(120)
C	KSIZE IS THE SAME SIZE AS MAXIMUM # OF FIELDS.
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION NAME1(2),NAME2(2),BASE(1),NAME4(2)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1,NAME2
      DATA JFMT(1)/'(1X,'/,JFMT(114)/')'/
      DATA BLANK/'     '/
      IMPLICIT INTEGER (A-Z)
      DATA ONCE/0/
C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE - BATCH JOB
      CALL TTYPTY(ICODE)
      INP=1
      IRP=2
C     SET TO 1 IN RITIT SUBROUTINE(SW3)
      SW3=0
C     SET TO 1 BY 'OUTPT' AND 'LIST',RESET TO 0 BY 'NEW' AND 'INSER'(SW4)
C     ALSO RESET TO 0 BY DELET
      SW4=0
C---------------DEVCHG ASSOCIATES DSK, CDR, ETC. WITH LOGICAL 
C--------------- DEVICE NO.
	CALL DEVCHG('DSK',IRP)
      CALL DEVCHG('DSK',6)
      CALL DEVCHG('DSK',7)
      IF(ICODE.EQ.0)CALL DEVCHG('TTY',4)
      IF(ICODE.EQ.-1)CALL DEVCHG('DSK',4)
      IDLG=-1
      INT=5
      WRITE(IDLG,1)
1     FORMAT(1X, 'WMU'/1X, 'FILE UPDATING AND RECORD RETRIEVAL'/)
C	CALL USAGE('UPDAT')
4     WRITE(IDLG,2)
2     FORMAT(/' *',$)
      READ(INT,3)CHOICE
3     FORMAT(A5)
      IF(CHOICE.EQ.'NEW'.OR.CHOICE.EQ.'EXIT'.OR.CHOICE.EQ.'INSER'.OR.
     1CHOICE.EQ.'MODIF'.OR.CHOICE.EQ.'DELET'.OR.CHOICE.EQ.'PTREC'.OR.
     2CHOICE.EQ.'OUTPT'.OR.((CHOICE.AND."777777777400).OR."100).EQ.
     3'LIST')GO TO 17
      GO TO 70
17    IF(CHOICE.NE.'NEW'.AND.CHOICE.NE.'EXIT')GO TO 6
80    IF(CHOICE.EQ.'INSER')GO TO 52
      IF(CHOICE.EQ.'MODIF')GO TO 77
      IF(CHOICE.EQ.'DELET') GO TO 41
      IF(CHOICE.EQ.'NEW') GO TO 5
      IF(((CHOICE.AND."777777777400).OR."100).EQ.'LIST')GO TO 8
      IF(CHOICE.EQ.'PTREC') GO TO 9
      IF(CHOICE.EQ.'EXIT')GO TO 42
      IF(CHOICE.EQ.'OUTPT')GO TO 62
70    WRITE(IDLG,40)
40    FORMAT(' UNDEFINED OPTION-TRY AGAIN.'/)
C---------------TERMINATE PROGRAM IF INT=5 IS NOT TERMINAL
      CALL DEVICE(INT)
      GO TO 4
C     'NEW' PATH
5     IF(ONCE.EQ.0) GO TO 84
      CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
84    ONCE=1
      INSCTR=0
      DELFRE=0
      SW3=0
      SW4=0
      TRESIZ=0
	WRITE(IDLG,85)
85	FORMAT(1X,'WHICH FIELD IS THE KEY?'/)
	READ(INT,86)KEYNO
86	FORMAT(I)
	DO 87 I=1,19
87	MODE(I)='A'
	MODE(KEYNO)='I'
	MSIZE=0
	CALL FORGEN(IFMT,112,MODE,JLEN,MSIZE,0,ISTD,IERR)
	IF(IERR.EQ.-1)CALL EXIT
	IF(IERR.EQ.1)CALL EXIT
	JX(0)=0
	JX(1)=0
	DO 88 I=2,MSIZE
88	JX(I)=JX(I-1)+(JLEN(I-1)+4)/5
	NOVAR=JX(MSIZE)+(JLEN(MSIZE)+4)/5
C---------------0 MEANS INPUT? PRINTS.  IDLG, INT, INP, IRP, IDEVI,
C--------------- IDEVO, ICODE ARE INPUT THRU COMMON /IOBLK/
      CALL IOB(0)
	CALL RELEAS(6)
	NORECS=0
	IF(IDEVI.NE.'TTY')GO TO 26
	WRITE(IDLG,91)
91	FORMAT(1X,'ENTER RECORDS.'/)
26    READ(INP,IFMT,END=27)(DATA(L),L=1,NOVAR)
	IF(IDEVI.EQ.'TTY')WRITE(6)(DATA(L),L=1,NOVAR)
      NORECS=NORECS+1
      GO TO 26
27	WRITE(IDLG,21)NORECS
21	FORMAT(1X,'THE NO. OF RECORDS IN MASTER FILE IS ',I6,'.'/)
	IF (NORECS.EQ.0)CALL EXIT
      REWIND INP
	REWIND 6
      TRESIZ=NORECS
      IF((1.AND.NORECS).EQ.0)TRESIZ=NORECS+1
      NPLUS=TRESIZ
      NORCS=NORECS
      IF((1.AND.NORECS).EQ.0)NORCS=NORECS+1
      MAX=4*(NORCS+200)
      CALL ALLCOR(MAX,IERR,I1,BASE)
      IF(IERR.NE.0)GO TO 82
      I0=NORCS+200
        I2=I1+I0
      I3=I2+I0
      I4=I3+I0
      CALL TREGEN(BASE(I1),BASE(I2),BASE(I3))
	IF(IDEVI.NE.'TTY')GO TO 90
93	WRITE(IDLG,89)
89	FORMAT(1X,'ENTER NAME FOR NEW MASTER FILE.'/)
	READ(INT,11)NAME3
90      CALL DYN1(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      GO TO 4
C     'INSER' PATH
52    CH123=1
      ONCE=1
28    CALL DYN2(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      SW4=0
      IF(SW3.EQ.1)GO TO 66
      GO TO 4
C     'DELET' PATH
41    CH123=2
      ONCE=1
57    CALL DYN5(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      SW4=0
      GO TO 4
C     'LISTN' PATH
8     CALL DYN7(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      GO TO 4
C     'EXIT' PATH
42    IF(TRESIZ.EQ.0)GO TO 79
      CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      CALL EXIT
C     'PTREC' PATH
9     CH123=3
61    CALL DYN9(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      GO TO 4
C     'OUTPT' PATH
62    CALL DYN6(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      GO TO 4
66    CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      NAME2(2)='.NEW'
      CALL DEFINE FILE(7,0,NV,JNAME2,0,0,109)
      CALL DEFINE FILE(6,0,NV,JNAME1      ,0,0)
      DO 65 I=1,TRESIZ
      READ(6  )(DATA(K),K=1,NOVAR)
65    WRITE(7  ,IFMT)(DATA(K),K=1,NOVAR)
      CALL RELEAS(6)
      CALL RELEAS(7  )
      CALL EXIT
C     (SW5.EQ.0.AND.CHOICE.NE.'NEW') PATH
69    CALL DEFINE FILE(6,0,NV,JNAME2      ,0,0)
      READ(6   )NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
	1,MSIZE
	READ(6)(JX(I),I=0,120)
      NORCS=NORECS
      IF((1.AND.NORECS).EQ.0)NORCS=NORECS+1
      CALL ALLCOR(MAX,IERR,I1,BASE)
      I0=NORCS+200
      I2=I1+I0
      I3=I2+I0
      I4=I3+I0
      IF(CHOICE.NE.'INSER')GO TO 76
      NPLUS=TRESIZ
76    IF(IERR.NE.0)GO TO 82
      SW5=1
      CALL DYN3(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
C     FIND NEXT PATH
      GO TO 80
C     'MODIF' PATH
77    CH123=4
78    CALL DYN2(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
      GO TO 4
79    WRITE(IDLG,81)
81    FORMAT(1X,'CANNOT USE ''EXIT'' AS FIRST OPTION.'/)
      CALL DEVICE(INT)
      GO TO 4
82    WRITE(IDLG,83)
83    FORMAT(1X,'TOO MANY RECORDS'/)
      CALL DEVICE(INT)
      GO TO 4
6     WRITE(IDLG,10)
10    FORMAT(1X,'WHICH MASTER FILE?'/)
      NPLUS=TRESIZ
	READ(INT,11)NAME4
	CALL NAMER(NAME4)
11    FORMAT(A5,A1)
	IF((NAME2(1).EQ.NAME5(1)).AND.(NAME2(2).EQ.NAME5(2)))
     1GO TO 80
      IF(ONCE.EQ.1)CALL DYN4(BASE(I1),BASE(I2),BASE(I3),BASE(I4))
	NAME5(1)=NAME2(1)
	NAME5(2)=NAME2(2)
      ONCE=0
      CALL EXIST(NAME1,IERR)
	IF(IERR.EQ.-1)GO TO 12
      IF(IERR.NE.0)GO TO 15
      CALL EXIST(NAME2,IERR)
      IF(IERR.NE.0)GO TO 18
      GO TO 69
15    WRITE(IDLG,16) NAME1(1),NAME1(2)
20    CALL DEVICE(INT)
      GO TO 6
12    WRITE(IDLG,13)
13    FORMAT(1X,'NAME IS INVALID. TRY AGAIN.'/)
      CALL DEVICE(INT)
      GO TO 6
18    WRITE (IDLG,16)NAME2(1),NAME2(2)
16    FORMAT(1X,'FILE ',2A5, ' DOES NOT EXIST.'/)
      GO TO 6
      END
	SUBROUTINE NAMER(NAME4)
	DIMENSION JFMT(114)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
	COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,    SEARCH,
	1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
	2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
	IMPLICIT INTEGER(A-Z)
	DIMENSION RAN(8),PTK(8),NAME(6),NAME4(2)
	DATA DOT,RAN,PTK/'.','R','A','N',5*' ','P','T','K',5*' '/
	DECODE(6,100,NAME4(1)),(NAME(I),I=1,6)
100	FORMAT(10A1)
	I=1
	DO 110 K=2,6
	IF(NAME(K).EQ.' '.OR.NAME(K).EQ.'.')GO TO 120
110	I=I+1
120	ENCODE(10,100,NAME1(1)),(NAME(J),J=1,I),DOT,(RAN(J),J=1,9-I)
	ENCODE(10,100,NAME2(1)),(NAME(J),J=1,I),DOT,(PTK(J),J=1,9-I)
	RETURN
	END
      SUBROUTINE TREGEN(LEFTSI,RITSID,SEQUEN)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),SEQUEN(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      TEMP1=NORECS/2+1
      SUB=TEMP1
      MEDIAN=TEMP1
      ADVANC=0
      DO 3 I=1,NORECS+200
      LEFTSI(I)=0
3     RITSID(I)=0
5     SUB5=SUB/2
      SUB5AD=ADVANC+SUB5
      SUBADV=SUB+ADVANC
      LEFTSI(SUBADV)=SUB5AD
      SEQUEN(SUB5AD)=SUBADV
      IF(SUB5.EQ.1)GO TO 4
      SUB=SUB5
      GO TO 5
4     IF(SUB5AD.EQ.MEDIAN)GO TO 6
      RANGE=SEQUEN(SUB5AD)-SUB5AD
      IF(RANGE.EQ.1)GO TO 7
      IF(RANGE.EQ.2)GO TO 8
      IF(RANGE.EQ.3)GO TO 9
      RANGE=RANGE/2
      MIDDLE=SUB5AD+RANGE
      RITSID(SUB5AD)=MIDDLE
      SEQUEN(MIDDLE)=SEQUEN(SUB5AD)
      ADVANC=SUB5AD
      SUB=RANGE
      GO TO 5
8     MIDDLE=SUB5AD+1
      RITSID(SUB5AD)=MIDDLE
      GO TO 7
9     MIDDLE=SUB5AD+1
      RITSID(SUB5AD)=MIDDLE
      TEMP1=MIDDLE+1
      RITSID(MIDDLE)=TEMP1
7     SUB5AD=SEQUEN(SUB5AD)
      GO TO 4
6     TEMP1=2*MEDIAN-LEFTSI(MEDIAN)
      RITSID(MEDIAN)=TEMP1
      MEDRED=MEDIAN-1
10    IF(LEFTSI(MEDRED).EQ.0.AND.RITSID(MEDRED).EQ.0)GO TO 11
      TEMP1=2*MEDIAN-LEFTSI(MEDRED)
      IF(TEMP1.EQ.(2*MEDIAN))GO TO 12
      TEMP2=2*MEDIAN-MEDRED
      RITSID(TEMP2)=TEMP1
12    TEMP1=2*MEDIAN-RITSID(MEDRED)
      IF(TEMP1.EQ.(2*MEDIAN))GO TO 11
      TEMP2=2*MEDIAN-MEDRED
      LEFTSI(TEMP2)=TEMP1
11    MEDRED=MEDRED-1
      IF(MEDRED.EQ.0)RETURN
      GO TO 10
      END
      SUBROUTINE INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      IF((1.AND.NORECS).NE.0)GO TO 80
      N=NORECS+1
      IF(NEWINF.GT.RECKEY(MEDIAN-1))GO TO 2
      GO TO 5
80    N=NORECS
8     IF(NEWINF.LE.RECKEY(SEARCH))GO TO 1
      GO TO 2
1     IF(NEWINF.EQ.RECKEY(SEARCH))GO TO 16
5     TEMP1=LEFTSI(SEARCH)
      I=1
6     TEMP2=SEARCH
      SEARCH=TEMP1
      Z=TEMP1-TEMP2
      GO TO 4
16    IF(DELMRK(SEARCH).NE.'D')GO TO 46
      GO TO (50,52,56,3,3),CH123
50    DELMRK(SEARCH)=BLANK
	GO TO 34
2     TEMP1=RITSID(SEARCH)
      I=2
      GO TO 6
4     IF(Z.EQ.1.OR.Z.EQ.-1.OR.TEMP1.GT.N.OR.TEMP2.GT.N.OR.TEMP1.EQ.0)
     1GO TO 7
      GO TO 8
7     IF(TEMP1.EQ.0)GO TO 63
      IF((Z.EQ.-1).OR.(TEMP1.GT.N.AND.TEMP2.GT.N.AND.I.EQ.1))GO TO 9
      GO TO 10
9     IF(NEWINF.LE.RECKEY(SEARCH))GO TO 14
20    GO TO (69,59,61,70,70),CH123
69    NPLUS=NPLUS+1
      LEFTSI(NPLUS)=TEMP1
65    LEFTSI(TEMP2)=NPLUS
	GO TO 23
63    IF(I.EQ.1)GO TO 64
      GO TO (72,59,61,70,70),CH123
72    NPLUS=NPLUS+1
      GO TO 27
64    GO TO (73,59,61,70,70),CH123
73    NPLUS=NPLUS+1
      GO TO 65
10    IF(Z.NE.1)GO TO 12
      IF(NEWINF.LT.RECKEY(SEARCH))GO TO 13
14    IF(NEWINF.NE.RECKEY(SEARCH))GO TO 12
      GO TO 16
13    GO TO (74,59,61,70,70),CH123
74    NPLUS=NPLUS+1
      RITSID(NPLUS)=TEMP1
27    RITSID(TEMP2)=NPLUS
23    SEARCH=NPLUS
34    INSCTR=INSCTR+1
43      CALL RITIT(RECKEY)
      RETURN
12    IF(I.EQ.1)GO TO 15
      IF(RITSID(TEMP1).EQ.0)GO TO 17
22    IF(NEWINF.LE.RECKEY(SEARCH))GO TO 18
      IF(I.NE.1)GO TO 19
      GO TO 20
15    IF(LEFTSI(TEMP1).EQ.0)GO TO 67
      GO TO 22
17    GO TO (75,59,61,70,70),CH123
75    NPLUS=+NPLUS+1
      RITSID(NPLUS)=RITSID(TEMP1)
      RITSID(TEMP1)=NPLUS
      GO TO 23
18    IF(NEWINF.NE.RECKEY(SEARCH))GO TO 24
      GO TO 16
24    IF(I.EQ.1)GO TO 25
      GO TO (76,59,61,70,70),CH123
76    NPLUS=NPLUS+1
      RITSID(NPLUS)=SEARCH
      GO TO 27
25    SEARCH=LEFTSI(TEMP1)
      GO TO 26
21    GO TO (77,59,61,70,70),CH123
77    NPLUS=NPLUS+1
      LEFTSI(NPLUS)=LEFTSI(TEMP1)
      LEFTSI(TEMP1)=NPLUS
      GO TO 23
26    IF(NEWINF.LE.RECKEY(SEARCH))GO TO 28
      GO TO 29
28    IF(NEWINF.NE.RECKEY(SEARCH))GO TO 30
      GO TO 16
29    IF(I.EQ.1)GO TO 21
      GO TO 17
30    IF(I.EQ.1)GO TO 31
      GO TO 32
31    IF(LEFTSI(SEARCH).EQ.0)GO TO 33
      TEMP1=SEARCH
      SEARCH=LEFTSI(SEARCH)
      GO TO 26
33    GO TO (78,59,61,70,70),CH123
78    NPLUS=NPLUS+1
      LEFTSI(SEARCH)=NPLUS
	GO TO 23
32    IF(RITSID(SEARCH).EQ.0)GO TO 35
      TEMP1=SEARCH
      SEARCH=RITSID(SEARCH)
      GO TO 26
35    GO TO (79,59,61,70,70),CH123
79    NPLUS=NPLUS+1
      RITSID(SEARCH)=NPLUS
	GO TO 23
19    SEARCH=RITSID(TEMP1)
40    IF(NEWINF.LE.RECKEY(SEARCH))GO TO 36
      GO TO 37
36    IF(NEWINF.NE.RECKEY(SEARCH))GO TO 38
      GO TO 16
38    GO TO (81,59,61,70,70)CH123
81    NPLUS=NPLUS+1
      RITSID(NPLUS)=SEARCH
      RITSID(TEMP1)=NPLUS
      GO TO 23
37    IF(RITSID(SEARCH).NE.0)GO TO 39
      GO TO 35
39    TEMP1=SEARCH
      SEARCH=RITSID(SEARCH)
      GO TO 40
46    GO TO (68,58,55,43,101),CH123
52    CALL DEFINE FILE(4  ,0,NV,'MESFIL.',0,0,109)
      WRITE(4  ,54)NEWINF
54    FORMAT(' YOU ATTEMPTED TO DELETE A RECORD PREVIOUSLY DELETED.'/,
     1' THE KEY IS ',I10,' .'/)
101      RETURN
55    CALL PRTREC
      RETURN
56    CALL DEFINE FILE(4  ,0,NV,'MESFIL.',0,0,109)
      WRITE(4  ,57)NEWINF
57    FORMAT(' YOU ATTEMPTED TO PRINT  A RECORD PREVIOUSLY DELETED.'/,
     1' THE KEY IS ',I10,' .'/)
      RETURN
58    DELMRK(SEARCH)='D'
      DELFRE=DELFRE+1
      RETURN
59    CALL DEFINE FILE(4  ,0,NV,'MESFIL.',0,0,109)
      WRITE(4  ,60)NEWINF
60    FORMAT(' YOU ATTEMPTED TO DELETE A RECORD WHICH DOES NOT EXIST.'/,
     1' THE KEY IS ',I10,' .'/)
      RETURN
61    CALL DEFINE FILE(4  ,0,NV,'MESFIL.',0,0,109)
      WRITE(4  ,62)NEWINF
62    FORMAT(' YOU ATTEMPTED TO PRINT A RECORD WHICH DOES NOT EXIST.'/,
     1' THE KEY IS ',I10,' .'/)
      RETURN
67    IF(NEWINF.LE.RECKEY(TEMP1))GO TO 21
      GO TO 20
3     CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,11)NEWINF
11    FORMAT(' YOU ATTEMPTED TO MODIFY A RECORD PREVIOUSLY DELETED.'/,
     1' THE KEY IS ',I10,' ,'/)
      RETURN
68    CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,82)NEWINF
82    FORMAT(' YOU ATTEMPTED TO INSERT WITH A KEY WHICH ALREADY EXISTS.
     1'/,1X,' THE KEY IS ',I10,' .'/)
      RETURN
70    CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,71)NEWINF
71    FORMAT(' YOU ATTEMPTED TO MODIFY WITH A KEY WHICH DOES NOT EXIST.
     1 '/1X,'THE KEY IS ',I10,' .'/)
      SW3=1
      RETURN
      END
      SUBROUTINE RITIT(RECKEY)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION RECKEY(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      Z=INSCTR+NORECS
      IF(Z.GT.3500 )GO TO 2
      IF(INSCTR.LE.200)GO TO 1
      CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,3)NEWINF,Z
3     FORMAT(1X,'THE MAX. NO. OF RECORD INSERTIONS HAS BEEN REACHED.'/
     11X,'START OVER BY ENTERING THE "NEW" OPTION. THE FIRST RECORD '/1X
     2,'NOT INSERTED HAS KEY ',I10,' .'/1X,'THE TOTAL NO. OF RECORDS ',
     3'IN YOUR FILE IS ',I5,' .'/)
      SW3=1
      RETURN
1     WRITE(7  #SEARCH)     (DATA(I),I=1,NOVAR)
      RECKEY(SEARCH)=NEWINF
      RETURN
2     CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,4)
4     FORMAT(1X,'YOUR FILE CONTAINS MAX. NO. OF RECORDS(3500 ) ',
     1'ALLOWED BY THIS PROGRAM.'/1X,'THE FIRST RECORD NOT INSERTED ',
     2'HAS KEY ',I10,' .'/)
      SW3=1
      RETURN
      END
      SUBROUTINE PRTREC
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      READ(6  #SEARCH)     (DATA(I),I=1,NOVAR)
      IF(IDEVO.EQ.'LPT'.OR.IDEVO.EQ.'TTY')GO TO 1
      WRITE(IRP,IFMT)(DATA(I),I=1,NOVAR)
2     RETURN
1     WRITE(IRP,JFMT)(DATA(I),I=1,NOVAR)
      GO TO 2
      END
      SUBROUTINE RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),SASEAR(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER (A-Z)
      CALL DEFINE FILE(6,NOVAR,NV,JNAME1,0,0)
      NONODS=NORECS
      IF((1.AND.NORECS).EQ.0)NONODS=NORECS+1
1     NPLU =NONODS+INSCTR-DELFRE
      SEARCH=1
      LIFO=1
      I=1
      COUNTR=0
      IF(LEFTSI(1).LE.NONODS)GO TO 2
      LIFO=1
      GO TO 4
2     I=2
      SEARCH=0
      GO TO 3
4     IF(I.EQ.1)GO TO 5
      SW1=1
      GO TO 6
5     SASEAR(LIFO)=SEARCH
      IF(LEFTSI(SEARCH).LE.NONODS)GO TO 14
      LIFO=LIFO+1
      SEARCH=LEFTSI(SEARCH)
      GO TO 4
6     TEMP2=SEARCH
10      SEARCH=RITSID(SEARCH)
      IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
      IF(COUNTR.EQ.NPLU )RETURN
      IF(RITSID(SEARCH).LT.NONODS.AND.RITSID(SEARCH).NE.0)GO TO 8
11    IF(RITSID(SEARCH).NE.0)GO TO 10
      IF(SW1.GT.1)GO TO 9
      SEARCH=TEMP2
      GO TO 3
9     SEARCH=TEMP1
      GO TO 3
8     SW1=SW1+1
      TEMP1=RITSID(SEARCH)
      GO TO 10
3     SEARCH=SEARCH+1
      IF(LEFTSI(SEARCH).LT.NONODS)GO TO 13
      I=1
      LIFO=1
      GO TO 5
13    IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
      IF(COUNTR.EQ.NPLU )RETURN
      GO TO 12
12    IF(I.EQ.1)GO TO 15
      GO TO 16
14    IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
      IF(COUNTR.EQ.NPLU )RETURN
      IF(LIFO.EQ.1)GO TO 17
      LIFO=LIFO-1
      SEARCH=SASEAR(LIFO)
      IF(LEFTSI(SEARCH).LE.NONODS)GO TO 19
      GO TO 14
17    IF(I.EQ.1)GO TO 18
      I=1
      GO TO 15
18    I=2
      GO TO 16
19    IF(DELMRK(SEARCH).NE.'D')CALL REDRIT
      IF(COUNTR.EQ.NPLU )RETURN
      SEARCH=SEARCH+1
      GO TO 12
15    IF(LEFTSI(SEARCH).LE.NONODS)GO TO 20
      LIFO=1
      GO TO 4
16    IF(RITSID(SEARCH).LE.NONODS)GO TO 20
      LIFO=1
      GO TO 4
20    IF(I.EQ.2)GO TO 3
      I=2
      GO TO 16
      END
      SUBROUTINE REDRIT
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      COUNTR=COUNTR+1
      IF((1.AND.NORECS).NE.0)GO TO 1
      IF(SEARCH.EQ.MEDIAN)GO TO 2
1     READ(6  #SEARCH)     (DATA(I),I=1,NOVAR)
      IF(IDEVO.EQ.'LPT'.OR.IDEVO.EQ.'TTY')GO TO 3
      WRITE(IRP,IFMT)(DATA(I),I=1,NOVAR)
2     RETURN
3     WRITE(IRP,JFMT)(DATA(I),I=1,NOVAR)
      RETURN
      END
C     CALLED BY 'NEW' PATH(DYN1)
      SUBROUTINE DYN1(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
      DIMENSION KNAM(10),NAME4(2)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
	NAME4(1)=NAME3(1)
	NAME4(2)=NAME3(2)
13	FORMAT(A5,A1)
17	CALL NAMER(NAME4)
      CALL EXIST(NAME1,IERR)
	IF(IERR.EQ.-1)GO TO 14
      IF(IERR.NE.0)GO TO 10
      CALL DEVICE(INT)
      WRITE(IDLG,11)
11    FORMAT(1X,'THIS MASTER FILE NAME ALREADY EXISTS.USE ANOTHER NAME.'
     1/)
16    WRITE(IDLG,12)
12    FORMAT(1X,'WHICH MASTER FILE NAME WOULD YOU LIKE?'/)
	READ(INT,13)NAME4
      GO TO 17
14    WRITE(IDLG,15)
15    FORMAT(1X,'INVALID NAME-TRY AGAIN.'/)
      GO TO 16
10      TEMP=0
	NAME5(1)=NAME2(1)
	NAME5(2)=NAME2(2)
      CALL DEFINE FILE(7,0,NV,JNAME1,0,0,109)
      IF((1.AND.NORECS).EQ.0)GO TO 19
      DO 18 I=1,TRESIZ
	IF(IDEVI.NE.'TTY')GO TO 40
	READ(6)(DATA(K),K=1,NOVAR)
	GO TO 35
40      READ(INP,IFMT)(DATA(K),K=1,NOVAR)
35      IF(DATA(KEYNO).LE.0)GO TO 26
      IF(DATA(KEYNO)-TEMP)27,28,32
32    RECKEY(I)=DATA(KEYNO)
	TEMP=DATA(KEYNO)
18    WRITE(7  )(DATA(J),J=1,NOVAR)
      GO TO 25
19    DO 20 I=1,MEDIAN-1
	IF(IDEVI.NE.'TTY')GO TO 36
	READ(6)(DATA(J),J=1,NOVAR)
	GO TO 37
36      READ(INP,IFMT)(DATA(J),J=1,NOVAR)
37      IF(DATA(KEYNO).LE.0)GO TO 26
      IF(DATA(KEYNO)-TEMP)27,28,33
33    RECKEY(I)=DATA(KEYNO)
	TEMP=DATA(KEYNO)
20    WRITE(7  )(DATA(J),J=1,NOVAR)
      WRITE(7  )(DATA(J),J=1,NOVAR)
      DO 23 I=MEDIAN+1,TRESIZ
	IF(IDEVI.NE.'TTY')GO TO 38
	READ(6)(DATA(J),J=1,NOVAR)
	GO TO 39
38      READ(INP,IFMT)(DATA(J),J=1,NOVAR)
39      IF(DATA(KEYNO).LE.0)GO TO 26
      IF(DATA(KEYNO)-TEMP)27,28,34
34    RECKEY(I)=DATA(KEYNO)
	TEMP=DATA(KEYNO)
23    WRITE(7)(DATA(J),J=1,NOVAR)
25    DO 24 I=1,TRESIZ+200
24    DELMRK(I)=BLANK
      CALL RELEAS(INP)
      CALL RELEAS(7  )
      RETURN
26    WRITE(IDLG,29)DATA(KEYNO)
29    FORMAT(1X,I10,' IS INVALID KEY.'/)
      CALL EXIT
27    WRITE(IDLG,30)DATA(KEYNO)
30    FORMAT(1X,I10,' IS A KEY OUT OF SEQUENCE.'/)
      CALL EXIT
28    WRITE(IDLG,31)DATA(KEYNO)
31    FORMAT(1X,I10,' IS A KEY WITH A DUPLICATE.'/)
      END
C     CALLED BY 'INSER' AND 'MODIF' PATHS(DYN2)
      SUBROUTINE DYN2(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114),VALUE(16)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
6     CALL DEFINE FILE(7,NOVAR,NV,JNAME1,0,0)
      CALL IOB(0)
8     IF(CH123.EQ.4)GO TO 14
29    IF(IDEVI.EQ.'TTY')WRITE(IDLG,7)
7     FORMAT(' #',$)
      READ(INP,IFMT,END=50,ERR=9)(DATA(I),I=1,NOVAR)
      SEARCH=MEDIAN
      NEWINF=DATA(KEYNO)
      IF(NEWINF.EQ.0)GO TO 4
      CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
      IF(SW3.EQ.1)RETURN
      GO TO 29
50    CALL RELEAS(7  )
      CALL RELEAS(INP)
      IF(CH123.NE.1)GO TO 21
      TRESIZ=NPLUS
21    RETURN
1     CALL DEFINE FILE(6,0,NV,JNAME2,0,0)
      READ(6)(DUMMY,I=1,121)
	READ(6)(DUMMY,I=1,121)
      X=TRESIZ/60
      DO 3 I=1,X
3     READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      CALL RELEAS(6  )
      GO TO 6
4     CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
      WRITE(4,5)
5     FORMAT(1X,'KEY IS ZERO AND NOT ALLOWED.'/)
      GO TO 8
9     WRITE(IDLG,10)
10    FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
      GO TO 8
14    WRITE(IDLG,12)
12    FORMAT(1X,'ENTER KEY AND NO. OF FIELDS TO BE CHANGED.'/1X,
     1'0 IF WHOLE RECORD IS CHANGED.'/)
      READ(INP,13,END=50)KEY,VARNO
13    FORMAT(3I)
      SEARCH=MEDIAN
      NEWINF=KEY
      IF(NEWINF.EQ.0)GO TO 4
      CH123=5
      CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
      IF(SW3.EQ.1)GO TO 22
      CALL DEFINE FILE(6,NOVAR,NV,JNAME1,0,0)
      READ(6#SEARCH)(DATA(I),I=1,NOVAR)
      CALL RELEAS(6)
      IF(VARNO.EQ.0)GO TO 53
20    WRITE(IDLG,19)
19    FORMAT(1X,'ENTER FIELD NUMBER FOLLOWED BY COMMA AND VALUE.'/)
	DO 15 J=1,VARNO
23	IF(IDEVI.EQ.'TTY')WRITE(IDLG,7)
	READ(INP,16,END=51)FIELD,VALUE
	IF(FIELD.LE.0.OR.FIELD.GT.MSIZE)GO TO 17
	IF(FIELD.EQ.KEYNO)GO TO 17
	IFULLS=JX(FIELD)-JX(FIELD-1)
	DO 52 K=1,IFULLS
52	DATA(JX(FIELD)+K)=VALUE(K)
15	CONTINUE
51    CALL RITIT(RECKEY)
      CH123=4
      GO TO 14
17    WRITE(IDLG,18)
18    FORMAT(1X,'?YOU ENTERED AN INVALID FIELD NO.'/)
      GO TO 23
16    FORMAT(I,16A5)
22    SW3=0
      GO TO 14
53	WRITE(IDLG,54)
54	FORMAT(1X,'ENTER RECORD.'/)
	READ(INP,IFMT)(DATA(I),I=1,NOVAR)
	IF(DATA(KEYNO).EQ.KEY)GO TO 51
55	CALL DEFINE FILE(4,0,NV,'MESFIL.',0,0,109)
	WRITE(4,56)
56	FORMAT(1X,'INVALID KEY FIELD N0.'/)
	CALL 	RELEAS(4)
	GO TO 14
      END
C     CALLED BY (SW5.EQ.0.AND.CHOICE.NE.'NEW') PATH(DYN3)
      SUBROUTINE DYN3(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV
      IMPLICIT INTEGER (A-Z)
      X=TRESIZ/60
      DO 67 I=1,X
67    READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      DO 1 I=1,X
1     READ(6)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)READ(6)(LEFTSI(J),RITSID(J) ,J=X*60+1,
     1TRESIZ)
      CALL RELEAS(6  )
      RETURN
      END
C     CALLED BY 'EXIT' PATH(DYN4)
      SUBROUTINE DYN4(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
      CALL DEFINE FILE(7,0,NV,JNAME5      ,0,0,109)
      WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
	1,MSIZE
	WRITE(7)(JX(I),I=0,120)
      X=TRESIZ/60
      DO 48 I=1,X
48    WRITE(7)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)WRITE(7)(RECKEY(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      DO 2 I=1,X
2     WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),J=X*60+1,
     1TRESIZ)
      CALL RELEAS(7)
1     CALL RELEAS(4)
      RETURN
      END
C     CALLED BY 'DELET' PATH(DYN5)
      SUBROUTINE DYN5(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
6     CALL IOB(0)
64    IF(IDEVI.NE.'TTY')GO TO 5
9     WRITE(IDLG,4)
4     FORMAT(/' #',$)
5     READ (INP,7,END=59,ERR=2)NEWINF
7     FORMAT(I)
      SEARCH=MEDIAN
      CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
      GO TO 64
59    CALL RELEAS(INP)
      RETURN
1     CALL DEFINE FILE(6,0,NV,JNAME2      ,0,0)
      READ(6)(DUMMY,I=1,121)
	READ(6)(DUMMY,I=1,121)
      X=TRESIZ/60
      DO 3 I=1,X
3     READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      CALL RELEAS(6)
      GO TO 6
2     WRITE(IDLG,8)
8     FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
      GO TO 9
      END
C     CALLED BY 'OUTPT' PATH(DYN6)
      SUBROUTINE DYN6(LEFTSI,RITSID,SASEAR,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),DELMRK(1),SASEAR(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
      CALL DEFINE FILE(7,0,NV,JNAME2      ,0,0,109)
      WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
	1,MSIZE
	WRITE(7)(JX(I),I=0,120)
      X=TRESIZ/60
      DO 48 I=1,X
48    WRITE(7)(SASEAR(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)WRITE(7)(SASEAR(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      DO 2 I=1,TRESIZ/60
2     WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
      X=TRESIZ/60
      IF((TRESIZ/60)*60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),J=X*60+1,
     1TRESIZ)
      CALL RELEAS(7)
      SW4=1
1     CALL IOB(1)
      CALL RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
      CALL RELEAS(IRP)
      CALL RELEAS(6)
      CALL DEVCHG('DSK',2)
      RETURN
      END
C     CALLED BY 'LISTN' PATH(DYN7)
      SUBROUTINE DYN7(LEFTSI,RITSID,SASEAR,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),DELMRK(1),SASEAR(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
      CALL DEFINE FILE(7,0,NV,JNAME2      ,0,0,109)
      WRITE(7)NORECS,TRESIZ,MEDIAN,KEYNO,INSCTR,DELFRE,MAX,NOVAR,IFMT
	1,MSIZE
	WRITE(7)(JX(I),I=0,120)
      X=TRESIZ/60
      DO 48 I=1,X
48    WRITE(7)(SASEAR(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)WRITE(7)(SASEAR(J),DELMRK(J),
     1J=X*60+1,TRESIZ)
      DO 2 I=1,X
2     WRITE(7)(LEFTSI(J),RITSID(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)WRITE(7)(LEFTSI(J),RITSID(J),
     1J=X*60+1,TRESIZ)
      CALL RELEAS(7)
      SW4=1
1	CALL DEVCHG('DSK',IRP)
      CALL DEFINE FILE(IRP  ,0     ,NV,'NFS.',0,0)
      CALL RESRET(LEFTSI,RITSID,SASEAR,DELMRK)
      A="377         .AND.CHOICE
      B=(A/2)-"60
      CALL RELEAS(IRP)
      CALL RELEAS(6)
      CALL PRINTS('NFS',2,0,B)
      RETURN
      END
C     CALLED BY 'PTREC' PATH(DYN9)
      SUBROUTINE DYN9(LEFTSI,RITSID,RECKEY,DELMRK)
      DIMENSION IFMT(112),JFMT(114)
      EQUIVALENCE(IFMT(1),JFMT(2))
      DIMENSION LEFTSI(1),RITSID(1),RECKEY(1),DELMRK(1)
	DOUBLE PRECISION JNAME1,JNAME2,JNAME5
	EQUIVALENCE(NAME1,JNAME1),(NAME2,JNAME2),(NAME5,JNAME5)
	COMMON/IOBLK/IDLG,INT,INP,IRP,IDEVI,IDEVO,ICODE,IBNK,NAME3(2)
      COMMON MSIZE,NAME5(2),NORECS,TRESIZ,MEDIAN,KEYNO,NOVAR,   SEARCH,
     1NPLUS,NEWINF,JX(0/120),INSCTR,DELFRE,COUNTR,CH123,
     2MAX,DATA(198),JFMT,BLANK,CHOICE,SW4,SW3,ODEV,NAME1(2),NAME2(2)
      IMPLICIT INTEGER(A-Z)
      IF(SW4.EQ.1)GO TO 1
4     CALL DEFINE FILE(6  ,NOVAR ,NV,JNAME1      ,0,0)
      CALL IOB(1)
      CALL IOB(0)
65    IF(IDEVI.NE.'TTY')GO TO 2
9     WRITE(IDLG,5)
5     FORMAT(/' #',$)
2     READ(INP,7,END=63,ERR=6)NEWINF
7     FORMAT(I)
      SEARCH=MEDIAN
      CALL INMODE(LEFTSI,RITSID,RECKEY,DELMRK)
      GO TO 65
63    CALL RELEAS(6)
      CALL RELEAS(IRP)
      CALL RELEAS(INP)
      RETURN
1     CALL DEFINE FILE(6,0,NV,JNAME2      ,0,0)
      READ(6)(DUMMY,I=1,121)
	READ(6)(DUMMY,I=1,121)
      X=TRESIZ/60
      DO 3 I=1,X
3     READ(6)(RECKEY(J),DELMRK(J),J=(I-1)*60+1,I*60)
      IF(X          *60.NE.TRESIZ)READ(6) (RECKEY(J),DELMRK(J),J=X*60+1,
     1TRESIZ)
      CALL RELEAS(6)
      GO TO 4
6     WRITE(IDLG,8)
8     FORMAT(1X,'?INVALID CHARACTER IN YOUR RESPONSE. TRY AGAIN.'/)
      GO TO 9
      END