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