Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/infop/infop.for
There is 1 other file named infop.for in the archive. Click here to see a list.
C WESTERN MICHIGAN UNIVERSITY
C INFOP.F4 (FILENAME ON LIBRARY DECTAPE)
C INFOP, 3.1.1 (CALLING NAME, SUBLIST NO.)
C FILE MANAGEMENT
C THE MAIN PROGRAM, SUBROUTINES MAIN, ERR, INOUT, EDIT, COLLAT
C WERE PROGRAMMED BY B. GRANET. RUSS BARR PROGRAMMED MOST OF
C SUBR. SORTCO AND UNCOLL AND PART OF SUBR. COLLAT.
C SUBR. TRAN, GROUP, AND BOOL WERE GIVEN BY WAYNE STATE UNIV.
C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
C FORWMU PROGS. USED: TTYPTY, ALLCOR, DEVICE, DEVCHG,
C EXISTS, PRINTS, RENAMS, PROTEK
C APLIB PROGS. USED: GETFOR
C INTERNAL SUBR. USED: MAIN, TRAN, GROUP, BOOL, ERR,
C INTOUT, COLLAT, APENDT, IO, SORTCO, UNCOLL, EDIT
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION DATA(1),FMT1(96),FMT2(96)
INTEGER OPTION,ENDFOP,C1234,PROC1
DOUBLE PRECISION IFLNM,BLANK,INPUT,FILENA(100)
DATA BLANK/' '/,INPUT/'INPUT.DAT'/
CALL DEFINE FILE(5,0,NV,'FG.INP',0,0)
C---------------TTYPTY RETURNS 0--TTY JOB, MINUS ONE--BATCH JOB
CALL TTYPTY(ICODE)
INT=5
IDLG=-1
IRP=30
WRITE(IRP,146)
146 FORMAT(34X,'WMU'/28X,'FILE MANAGEMENT')
C CALL USAGE('INFOP ')
3009 ISW=0
YESNO=0
INVSW=0
WRITE(IDLG,4)
4 FORMAT(1X,'ENTER OPTION.'/)
12 READ(INT,10) OPTION
10 FORMAT(A5)
IF(OPTION.EQ.'ALLQ') GO TO 14
IF(OPTION.EQ.'TR/GR') GO TO 18
IF(OPTION.EQ.'EDIT') GO TO 23
IF(OPTION.EQ.'COLLA' ) GO TO 25
IF(OPTION.EQ.'UNCOLL') GO TO 29
IF(OPTION.EQ.'INVAL') GO TO 31
CALL ERR
GO TO 12
14 WRITE(IDLG,3001)
3001 FORMAT(' ','INDICATE YOUR METHOD OF GENERATING NEW FILES BY '/1X,
1'ENTERING 1 TO TRANSFORM AND/OR GROUP,'/1X,
2' 2 EDIT, '/1X,
3' 3 TO COLLATE, '/1X,
4' 4 TO SPLIT INPUT FILE INTO SUBFILES.'/)
6 READ(INT,3) PROC1
J1=0
GO TO (64,64,64,64),PROC1
CALL ERR
GO TO 6
64 WRITE(IDLG,92)
92 FORMAT(' ','INDICATE YOUR INTENTIONS AFTER THE CURRENT FILE HAS',
1' BEEN PROCESSED.'/1X,'ENTER 1 TO TERMINATE ,2 TO PROCESS A FILE
2 AGAIN.'/)
7 READ(INT,3) ENDFOP
GO TO (3020,3020),ENDFOP
CALL ERR
GO TO 7
3 FORMAT(I)
3020 GO TO (1015,1015,3000,30),PROC1
1015 INP=1
CALL IO(INP,IDEV,IDLG,INT,0,ICODE,ISW)
24 CALL INOUT(NOALFI,NOALFO,FMT1,FMT2)
IF(NOALFI.GE.NOALFO) GO TO 1
MAX=NOALFO+100
GO TO 2
1 MAX=NOALFI+100
2 CALL ALLCOR(MAX,IERR,I1,DATA)
IF(IERR.NE.0)STOP
GO TO (157,2999,2040),PROC1
2040 CALL EXIT
3000 CALL COLLAT(J1)
ENDFILE 21
GO TO 8
2030 ENDFILE 2
8 CALL RELEAS (1)
998 GO TO (2040,14 ),ENDFOP
157 CALL MAIN(DATA(I1),FMT1,FMT2,IFLNM,NOALFI,NOALFO,INVSW,C1234)
GO TO 2030
2999 CALL EDIT(DATA(I1),NOALFI,NOALFO,FMT1,FMT2)
GO TO 2030
18 ENDFOP=1
PROC1=1
IFLNM=INPUT
CALL DEFINE FILE(1,0,NV,IFLNM,0,0)
ISW=1
INP=1
GO TO 24
25 ENDFOP=1
PROC1=3
ISW=1
GO TO 3000
23 ENDFOP=1
PROC1=2
ISW=1
IFLNM=INPUT
CALL DEFINE FILE(1,0,NV,IFLNM,0,0)
INP=1
GO TO 24
29 ISW=1
IFLNM=INPUT
ENDFOP=1
30 CALL UNCOLL(IFLNM)
CALL RELEAS(1)
GO TO 998
31 ENDFOP=1
PROC1=1
IFLNM=INPUT
CALL DEFINE FILE(1,0,NV,IFLNM,0,0)
ISW=1
INP=1
INVSW=1
C1234=2
READ(INT,3) NOALFI
MAX=NOALFI+100
NOALFO=2
IF(ISW.EQ.0)WRITE(IDLG,91111)
91111 FORMAT(' FORMAT FOR INPUT?',/)
CALL GETFOR(IDLG,INT,FMT2,ISTD,96,4*ISW+1)
61 FORMAT(16A5)
FMT1(1)='(A5,F'
FMT1(2)='6.0) '
GO TO 2
END
C---------------DATA IS RETURNED. OTHER ARGS. ARE INPUT.
C--------------- MAX, DMISS, FILENA, YESNO ARE RETURNED THRU COMMON.
C--------------- IDLG, INT, IRP, ISW ARE INPUT THRU COMMON.
SUBROUTINE MAIN(DATA,FMT1,FMT2,IFLNM ,NOALFI,NOALFO,INVSW,C1234)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION DATA(1),CONST(100),FMT1(96),IDENT(16),COND1(100),
1COND2(100),COND3(100),IOPD(100),IOPR(100),FMT2(96),A(20,20),Z(12),
2NOCS(20)
INTEGER TTYPE(100),XI(100),XK(100),XN(100),C1234,ENDFOP,COND1,
1FILFRE
DOUBLE PRECISION IFLNM,INPUT,CHAR,FILENA(100)
COMMON /BLOCK1/ CHAR
DATA INPUT/'INPUT.DAT'/
DO 202 I=1,MAX
202 DATA(I)=0.0
Z(11)='0000,'
Z(12)=' '
J1=1
IF(INVSW.EQ.1) GO TO 72
IF(ISW.EQ.1) GO TO 11
2007 WRITE(IDLG,137)
137 FORMAT(1X,'WE NOW START GENERATING A FILE. INDICATE YOUR CHOICE
1 OF COMBINATION'/1X,' OF GROUPING AND TRANSFORMATION BY ENTERING'
2/1X, ' 1 TRANSFORM WITHOUT GROUPING,'/1X,' 2 GROUPING WITHOUT TRA
3NSFORMATION,'/1X,' 3 GROUPING BEFORE TRANSFORMATION,'/1X,
4' 4 GROUPING AFTER TRANSFORMATION.'/)
11 FILFRE=0
INPNUM=0
16 READ(INT,3) C1234
3 FORMAT(I)
61 IF(C1234.EQ.0) RETURN
IF(C1234.LT.1.OR.C1234.GT.4) GO TO 138
72 GO TO (995,36,995,995), C1234
138 CALL ERR
GO TO 16
C ***BEGINNING OF TRANSFORMATION INFORMATION LOOP****
995 L=1
IF(ISW.EQ.1) GO TO 35
WRITE(IDLG,32)
32 FORMAT(1X,'TYPE TRANSFORMATIONS.'/)
35 READ(INT,13) (Z(I),I=1,10)
IF(Z(1).EQ.'END') GO TO 106
DECODE(5,3,Z) TTYPE(L)
I1111=TTYPE(L)
GO TO (37,37,37,37,37,37,37,37,37,41,41,41,41,43,43,43,43,43,46,
1 66,43,41,67),I1111
145 CALL ERR
GO TO 35
37 DECODE(60,38,Z) XI(L),XK(L),INDEX,MOD
38 FORMAT( 2X,3I,A5)
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100.
1OR.XK(L).LT.1.OR.XK(L).GT.100) GO TO 145
45 IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 48
IF(MOD.EQ.'DELET') GO TO 49
GO TO 145
39 L=L+1
GO TO 35
51 XN(INDEX)=XI(L)
48 XK(INDEX)=XK(L)
112 XI(INDEX)=XI(L)
TTYPE(INDEX)=TTYPE(L)
GO TO 35
49 K=L-2
114 DO 50 I=INDEX,K
XI(I)=XI(I+1)
50 TTYPE(I)=TTYPE(I+1)
L=L-1
GO TO 35
41 DECODE(60,42,Z) XI(L),XK(L),XN(L),INDEX,MOD
42 FORMAT( 3X,4I,A5)
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100
1.OR.XK(L).LT.1.OR.XK(L).GT.100.OR.XN(L).LT.1.OR.XN(L).GT.100)
2 GO TO 145
IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 51
IF(MOD.EQ.'DELET') GO TO 52
GO TO 145
52 K=L-2
DO 53 I=INDEX,K
XK(I)=XK(I+1)
53 XN(I)=XN(I+1)
GO TO 114
43 DECODE(60,44,Z) XI(L),XK(L),CONST(L),INDEX,MOD
44 FORMAT(3X,2I,F,I,A5)
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100.
1OR.XK(L).LT.1.OR.XK(L).GT.100) GO TO 145
IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 54
IF(MOD.EQ.'DELET') GO TO 55
GO TO 145
54 CONST(INDEX)=CONST(L)
GO TO 48
55 K=L-2
DO 56 I=INDEX,K
XK(I)=XK(I+1)
56 CONST(I)=CONST(I+1)
GO TO 114
46 DECODE(60,47,Z) XI(L),CONST(L),INDEX,MOD
47 FORMAT( 3X,I,F,I,A5)
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100)
1 GO TO 145
IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 57
IF(MOD.EQ.'DELET') GO TO 60
GO TO 145
57 CONST(INDEX)=CONST(L)
GO TO 48
60 K=L-2
DO 62 I=INDEX,K
62 CONST(I)=CONST(I+1)
GO TO 114
66 DECODE(60,68,Z) XI(L),XK(L),CONST(L),NOCS(L),INDEX,MOD
68 FORMAT(3X,2I,F,2I,A5)
NOC1=NOCS(L)
READ(INT,81)(A(I,L),I=1,NOC1),INDEX,MOD
81 FORMAT(10F)
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100.
1OR.NOC1.LT.1.OR.NOC1.GT.20.OR.XK(L).LT.1.OR.XK(L).GT.100)
2 GO TO 145
IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 74
IF(MOD.EQ.'DELET') GO TO 75
GO TO 145
74 CONST(INDEX)=CONST(L)
NOCS(INDEX)=NOCS(L)
DO 83 I=1,NOC1
83 A(I,INDEX)=A(I,L)
GO TO 48
75 K=L-2
DO 78 I=INDEX,K
XK(I)=XK(I+1)
CONST(I)=CONST(I+1)
DO 78 J=1,NOC1
78 A(J,I)=A(J,I+1)
GO TO 114
67 DECODE(60,84,Z) XI(L),XK(L),XN(L),NOCS(L),INDEX,MOD
84 FORMAT(3X,5I,A5)
NOC2=NOCS(L)
READ(INT,81)(A(I,L),I=1,NOC2),INDEX,MOD
IF(TTYPE(L).LT.1.OR.TTYPE(L).GT.23.OR.XI(L).LT.1.OR.XI(L).GT.100.
1OR.XK(L).LT.1.OR.XK(L).GT.100.OR.XN(L).LT.1.OR.XN(L).GT.100.OR.
2NOC2.LT.1.OR.NOC2.GT.20 ) GO TO 145
IF(INDEX.EQ.0) GO TO 39
IF(MOD.EQ.'ALTER') GO TO 87
IF(MOD.EQ.'DELET') GO TO 90
GO TO 145
87 NOCS(INDEX)=NOCS(L)
DO 91 I=1,NOC2
91 A(I,INDEX)=A(I,L)
GO TO 51
90 K=L-2
DO 93 I=INDEX,K
XK(I)=XK(I+1)
XN(I)=XN(2+1)
NOCS(I)=NOCS(I+1)
DO 93 J=1,NOC2
93 A(J,I)=A(J,I+1)
GO TO 114
106 NT=L-1
GO TO (24,2040,36,36) ,C1234
36 L=1
IF(INVSW.EQ.1) GO TO 34
IF(ISW.EQ.1) GO TO 117
WRITE(IDLG,65)
65 FORMAT(1X,'ENTER CONDITIONS.'/)
117 READ(INT,13) (Z(I),I=1,10)
IF(Z(1).EQ.'END') GO TO 70
IF((Z(1).AND."774000000000).EQ.('C'.AND."774000000000))GO TO 123
DECODE(60,107,Z) CHARC,COND1(L),COND2(L),COND3(L),MOD,INDEX
107 FORMAT(A1,I,F,A2,A5,I1)
IF(COND1(L).GE.1.AND.COND1(L).LE.100.AND.(COND3(L).EQ.'LE'.OR.
1COND3(L).EQ.'GE'.OR.COND3(L).EQ.'LT'.OR.COND3(L).EQ.'NE'.OR.
2COND3(L).EQ.'GT'.OR.COND3(L).EQ.'EQ')) GO TO 124
DECODE(60,13,Z) SENDCO
200 CALL ERR
GO TO 117
124 IF(INDEX.EQ.0) GO TO 115
IF(MOD.EQ.'ALTER') GO TO 118
IF(MOD.EQ.'DELET') GO TO 121
CALL ERR
GO TO 117
123 DECODE(60,109,Z) CHARC,COND1(L),COND2(L),COND3(L)
109 FORMAT(A1,I,A5,A2)
IF(COND1(L).GE.1.AND.COND1(L).LE.MAX.AND.(COND3(L).EQ.'LE'.OR.
1COND3(L).EQ.'GE'.OR.COND3(L).EQ.'LT'.OR.COND3(L).EQ.'NE'.OR.
2COND3(L).EQ.'GT'.OR.COND3(L).EQ.'EQ')) GO TO 124
GO TO 200
115 L=L+1
GO TO 117
118 COND1(INDEX)=COND1(L)
COND2(INDEX)=COND2(L)
COND3(INDEX)=COND3(L)
120 L=L-1
GO TO 117
121 DO 122 I=INDEX,K
COND1(I)=COND1(I+1)
COND2(I)=COND2(I+1)
122 COND3(I)=COND3(I+1)
GO TO 120
70 NOCOND=L-1
L=1
IF(ISW.EQ.1) GO TO 127
126 WRITE(IDLG,77)
77 FORMAT(1X,'ENTER BOOLEAN EXPRESSION.'/)
127 READ(INT,79 ) IOPD(L),IOPR(L),INDEX,MOD
79 FORMAT(I,A3,I,A5)
IF(IOPD(L).GE.1.AND.IOPD(L).LE.100.AND.(IOPR(L).EQ.'AND'.OR.
1IOPR(L).EQ.'OR')) GO TO 130
IF(L.EQ.NOCOND.AND.IOPD(L).GE.1.AND.IOPD(L).LE.100.AND.IOPR(L).
1EQ.' ') GO TO 158
GO TO 128
158 READ(INT,13) SENDEX
IF(SENDEX.EQ.'END') GO TO 24
128 CALL ERR
GO TO 127
130 IF(INDEX.EQ.0) GO TO 131
IF(MOD.EQ.'ALTER') GO TO 132
IF(MOD.EQ.'DELET') GO TO 133
GO TO 128
131 L=L+1
GO TO 127
132 IOPD(INDEX)=IOPD(L)
IOPR(INDEX)=IOPR(L)
GO TO 127
133 K=L-2
DO 134 I=INDEX,K
IOPD(I)=IOPD(I+1)
134 IOPR(I)=IOPR(I+1)
L=L-1
GO TO 127
24 IF(ISW.EQ.1) GO TO 17
CALL IO(2,IDEV,IDLG,INT,1,ICODE,ISW)
WRITE(IDLG,5)
5 FORMAT(' ','ENTER IDENTIFICATION.'/)
READ(INT,13)IDENT
FILENA(J1)=CHAR
WRITE(2 ,13)IDENT
13 FORMAT(16A5)
GO TO (88,989,88,88),C1234
88 WRITE(IDLG,997)
997 FORMAT(1X,'IF YOU HAVE MISSING DATA,ENTER A SYMBOL FOR IT '/1X,
1'FOLLOWED BY COMMA AND A 1. OTHERWISE ONLY ENTER A RETURN.'/)
READ(INT,81 ) DMISS,YESNO
989 WRITE(IDLG,994)
994 FORMAT(1X,'DO YOU HAVE HEADER CARD TO BE BYPASSED? YES OR NO'/)
33 READ(INT,13) ANS
IF(ANS.NE.'YES'.AND.ANS.NE.'NO') GO TO 988
IF(ANS.NE.'YES') GO TO 63
READ(INP,13) IDENT
63 WRITE(IDLG,22)
22 FORMAT(' ','DATA BEING PROCESSED.'/)
58 READ(INP,FMT2,END=148,ERR=135)(DATA(L),L=1,NOALFI)
INPNUM=INPNUM+1
136 GO TO (2020,86,86,2020),C1234
135 DATA(MAX)=1
INPNUM=INPNUM+1
DATA(1)='CARD#'
DATA(2)=INPNUM
GO TO 136
2020 CALL TRAN(NT,TTYPE,XI,XK,XN,CONST,DATA,A,NOC1,NOC2)
GO TO (89,2040,89,86),C1234
86 CALL GROUP(DATA,NOCOND, IOPD,IOPR,COND1,COND2,COND3,GOOD)
IF(GOOD.EQ.0) GO TO 58
GO TO (2040,89,2020,89),C1234
89 WRITE(2 ,FMT1)(DATA(L),L=1,NOALFO)
FILFRE=FILFRE+1
DATA(MAX)=0
GO TO 58
148 ENDFILE 21
WRITE(IRP,2995)CHAR,FILFRE,IFLNM,INPNUM
2995 FORMAT(1X,'THE FILE CALLED ',A10,' HAS ',I5,' RECORDS.'/
1' THE FILE CALLED ',A10,' HAS ',I5, ' RECORDS.'/)
REWIND 1
J1=J1+1
IF(INVSW.EQ.1) GO TO 40
GO TO 71
2040 CALL EXIT
988 CALL ERR
GO TO 33
17 CALL IO(2,IDEV,IDLG,INT,1,ICODE,ISW)
DMISS=0
YESNO=0
GO TO 63
34 CHARC=' '
COND1(1)=MAX
COND2(1)=1
COND3(1)='EQ'
IOPD(1)=1
GO TO 17
40 C1234=0
GO TO 61
71 IF(ISW.EQ.1) RETURN
CALL INOUT(NOALFI,NOALFO,FMT1,FMT2)
IF(NOALFO.EQ.0)RETURN
IF(NOALFI.GE.NOALFO) GO TO 69
MAX=NOALFO+100
GO TO 80
69 MAX=NOALFI+100
80 CALL ALLCOR(MAX,IERR,I1,DATA)
IF(IERR.NE.0)STOP
GO TO 2007
END
C---------------ALL ARGS. ARE INPUT. IDLG, INT, IRP, DMISS ARE INPUT
C--------------- THRU COMMON.
SUBROUTINE TRAN(NT,TTYPE,XI,XK,XN,CONST,DATA,A,NOC1,NOC2)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION CONST(1),DATA(1),A(20,20)
INTEGER TTYPE(1),XI(1),XK(1),XN(1)
C ** TRANSFORMATIONS **
C 01. X(I) = X(K)
C 02. X(I) = COS(X(K))
C 03. X(I) = LOGXF(X(K)) LOGARITHM BASE 10
C 04. X(I)=ARCTAN(X(K))
C 05. X(I) = LOGF(X(K)) LOGARITHM BASE E
C 06. X(I) = EXPF(X(K)) EXPONENTIAL BASE E
C 07. X(I) = EXPXF(X(K)) EXPONENTIAL BASE 10
C 08. X(I)=ARCSIN(X(K))
C 09. X(I) = SIN(X(K))
C 10. X(I) =X(K) +X(N)
C 11. X(I) = X(K)*X(N)
C 12. X(I)=1 IF X(J) GE X(K); OTHERWISE X(I)=0.
C 13. X(I) = X(K)/X(N)
C 14. X(I) = X(K)**C
C 15. X(I) = X(K) + C
C 16. X(I) = X(K)*C
C 17. X(I)=1 IF X(K) GE C; OTHERWISE X(I)=0.
C 18. X(I)=C**X(K)
C 19. X(I)=C
C 20. IF X(K)=A1,OR A2,...,OR AM ,THEN X(I)=C;OTHERWISE
C X(I) IS UNCHANGED.
C 21. IF X(K) IS BLANK, THEN X(I)=C; OTHERWISE
C X(I) IS UNCHANGED.
C 22. IF X(K) IS BLANK,THEN X(I)=X(J); OTHERWISE
C X(I) IS UNCHANGED.
C 23. IF X(K)=A1,OR A2,...,OR AM,THEN X(I)=X(J);
C OTHERWISE X(I) IS UNCHANGED.
C PERFORM TRANSFORMATIONS
DO 510 J=1,NT
K=TTYPE(J)
K1= XI(J)
51 L= XK(J)
L1= XN(J)
C=CONST(J)
IF (YESNO)400,400,100
100 IF(DATA(L)-DMISS)300,509,300
300 IF(L1)400,400,350
350 IF(DATA(L1)-DMISS)400,509,400
400 GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
123) ,K
1 DATA(K1)=DATA(L)
GO TO 510
14 IF(DATA(L))201,205,206
201 L1=C
IF(L1-C)203,206,203
203 WRITE(IRP ,204),L
204 FORMAT(' ','THE VALUE OF VARIABLE',I3,'IS NEGATIVE,EXPONENT'/1X,
1'IS FRACTIONAL,AND YOU REQUESTED XK**C'/)
CALL DEVICE(INT)
GO TO 146
205 DATA(K1)=0.
GO TO 510
206 IF(L1*ALOG10(DATA(L)).GT.38.3045) GO TO 207
DATA(K1)=DATA(L)**C
GO TO 510
207 WRITE(IRP ,208),L
208 FORMAT(' ','X(K)**C FOR VARIABLE',I3,'IS TOO LARGE'/)
CALL DEVICE(INT)
GO TO 176
10 DATA(K1)=DATA(L)+DATA(L1)
GO TO 510
11 DATA(K1)=DATA(L)*DATA(L1)
GO TO 510
5 IF(DATA(L).GT.0.AND.DATA(L).LT.1.7E38) GO TO 55
WRITE(IRP ,501),L
501 FORMAT(' ','VALUE OF VARIABLE',I3,'IS TOO LARGE. IT SHOULD BE'/1X,
1'POSITIVE AND LESS THAN OR EQUAL TO 1.7E38.YOU ENTERED CODE 5.'/)
CALL DEVICE(INT)
GO TO 149
55 DATA(K1)=ALOG(DATA(L))
GO TO 510
6 IF(DATA(L).LE.88.02905) GO TO 65
WRITE(IRP ,601),L,DATA(L)
601 FORMAT(' ','THE VALUE OF VARIABLE',I3,'IS TOO LARGE.'/1X,
1'IT''S VALUE IS',E17.8,'. IT''S ABSOLUTE VALUE SHOULD BE LESS'/1X,
2'THAN OR EQUAL TO 88.02905. YOU ENTERED CODE 06.'/)
CALL DEVICE(INT)
GO TO 149
65 DATA(K1)=EXP(DATA(L))
15 DATA(K1)=DATA(L)+C
GO TO 510
16 DATA(K1)=DATA(L)*C
GO TO 510
9 IF(ABS(DATA(L)).LT.(2.0**18*3.1416))GO TO 95
WRITE(IRP ,73) L,DATA(L)
73 FORMAT(' ','VALUE OF VARIABLE',I3,'IS TOO LARGE TO BE A SINE'/1X,
1'ARGUMENT, IT''S VALUE IS',E17.8/)
CALL DEVICE(INT)
GO TO 149
95 DATA(K1)=SIN(DATA(L))
GO TO 510
2 IF(ABS(DATA(L)).LT.(2.0**18*3.1416))GO TO 105
WRITE(IRP ,74) L,DATA(L)
74 FORMAT(' ','VALUE OF VARIABLE',I3,'IS TOO LARGE TO BE A COS '/1X,
1'ARGUMENT, IT''S VALUE IS',E17.8/)
CALL DEVICE(INT)
GO TO 149
105 DATA(K1)=COS(DATA(L))
GO TO 510
3 IF(DATA(L).GT.0.AND.DATA(L).LT.1.7E38) GO TO 115
WRITE(IRP ,75)L
75 FORMAT(' ','VALUE OF VARIABLE',I3,'IS TOO LARGE. IT SHOULD BE'/1X,
1'POSITIVE AND LESS THAN OR EQUAL1.7E38. YOU ENTERED CODE 11.'/)
CALL DEVICE(INT)
GO TO 149
GO TO 510
115 DATA(K1)=ALOG10(DATA(L))
GO TO 510
7 IF(DATA(L).LT.38.3045) GO TO 1205
WRITE(IRP ,1206) L,DATA(L)
1206 FORMAT(' ','VALUE OF VARIABLE',I3,'IS TOO LARGE,IT''S '/1X,
1'VALUE IS',E17.8,'IT''S ABSOLUTE VALUE MUST BE LESS THAN OR '/1X,
2'EQUAL 38.3045. YOU ENTERED CODE 12.'/)
CALL DEVICE(INT)
GO TO 167
1205 DATA(K1)=10**(DATA(L))
13 IF(DATA(L1).EQ.0.) GO TO 1305
WRITE(IRP ,1306) L,L1,L1
1306 FORMAT(' ','SOMEONE GAVE INSTRUCTIONS TO DIVIDE VARIABLE',I3,/1X,
1'BY VARIABLE',I3,'AND VARIABLE',I3,'IS ZERO'/)
CALL DEVICE(INT)
GO TO 170
1305 DATA(K1)=DATA(L)/DATA(L1)
GO TO 510
8 IF(DATA(L).GE.-1.0.AND.DATA(L).LE.1.0) GO TO 1405
WRITE(IRP ,1406) L
1406 FORMAT(' ','VALUE OF VARIABLE ',I3,'IS EITHER LESS THAN -1'/1X,
1'OR GREATER THAN +1.0 ;THEREFORE IT IS OUTSIDE OF RANGE '/1X,
2'OF ALLOWED ARGUMENTS. YOU ENTERED CODE 14.'/)
CALL DEVICE(INT)
GO TO 173
1405 DATA(K1)=ASIN(DATA(L))
GO TO 510
17 IF(DATA(L).GE.C) GO TO 511
DATA(K1)=0.0
GO TO 510
511 DATA(K1)=1.0
GO TO 510
12 IF(DATA(L).GE.DATA(L1)) GO TO 512
DATA(K1)=0.0
GO TO 510
512 DATA(K1)=1.0
GO TO 510
4 DATA(K1)=ATAN(DATA(L))
GO TO 510
18 IF(DATA(L)*ALOG10(C).LT.38.3045) GO TO 1805
WRITE(IRP ,1806) L
1806 FORMAT(' ','C TO THE POWER OF VARIABLE',I3,'IS LARGER THAN'/1X,
2'1.7E38;THEREFORE TOO LARGE FOR PDP-10.YOU ENTERED CODE 18.'/)
CALL DEVICE(INT)
GO TO 176
1805 DATA(K1)=C**DATA(L)
GO TO 510
19 DATA(K1)=C
GO TO 510
20 DO 513I=1,NOC1
IF(DATA(L).EQ.A(I,L)) GO TO 514
513 CONTINUE
GO TO 510
514 DATA(K1)=C
GO TO 510
21 IF(DATA(L).EQ.' ') GO TO 515
GO TO 510
515 DATA(K1)=C
GO TO 510
22 IF(DATA(L).EQ.' ') GO TO 516
GO TO 510
516 DATA(K1)=DATA(L1)
GO TO 510
23 DO 517 I=1,NOC2
IF(DATA(L).EQ.A(I,L)) GO TO 518
517 CONTINUE
GO TO 510
518 DATA(K1)=DATA(L1)
GO TO 510
509 DATA(K1)=DMISS
GO TO 510
146 WRITE(IDLG,147) L
147 FORMAT(' ','ENTER POSITIVE VALUE FOR VARIABLE ',I3/)
2041 READ(INT,160) DATA(L)
160 FORMAT(F)
GO TO 400
149 WRITE(IDLG,150) L
150 FORMAT(' ','ENTER SMALL ENOUGH VALUE FOR VARIABLE',I3,'.'/)
GO TO 2041
167 WRITE(IDLG,168) L
168 FORMAT(' ','ENTER SMALL ENOUGH ABSOLUTE VALUE FOR VARIABLE',I3/)
GO TO 2041
170 WRITE(IDLG,171) L1
171 FORMAT(' ','ENTER NON-ZERO VALUE FOR VARIABLE',I3,'.'/)
GO TO 2041
173 WRITE(IDLG,174) L
174 FORMAT(' ','ENTER AN ACCEPTABLE VALUE FOR VARIABLE',I3/)
GO TO 2041
176 WRITE(IDLG,177) L
177 FORMAT(1X,'ENTER VALUE FOR VARIABLE ',I3,' FOLLOWED BY VALUE'/1X,
1'FOR C SEPARATED BY COMMA SO THAT EXPONENTIATION IS LESS THAN '/1X
2' 1.7E38. BOTH MUST BE ENTERED EVEN IF ONE IS DUPLICATION OF '/1X,
3'WHAT YOU HAD.'/)
2040 READ(INT,178) DATA(L),C
178 FORMAT(2F)
GO TO 400
510 CONTINUE
RETURN
END
C---------------GOOD IS RETURNED. OTHER ARGS. ARE INPUT
C--------------- IRP IS INPUT THRU COMMON.
SUBROUTINE GROUP(DATA,NOCOND,IOPD,IOPR,C1,C2,C3,GOOD)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION DATA(1),C2(1),IOPD(1),IOPR(1),RESULT(50),C3(1)
INTEGER C1(1)
C
GOOD=0
C
2 DO 3 I=1,NOCOND
RESULT(I)=0.
IVAR=C1(I)
C
IF(C3(I).EQ.'LT') GO TO 101
IF(C3(I).EQ.'LE') GO TO 102
IF(C3(I).EQ.'GT') GO TO 103
IF(C3(I).EQ.'GE') GO TO 104
IF(C3(I).EQ.'EQ') GO TO 105
IF(C3(I).EQ.'NE') GO TO 106
C
WRITE(IRP ,201) I
201 FORMAT(' ','INVALID SYMBOL IN CONDITION',I3,'WITHIN GROUP SUB'/1X,
1'ROUTINE.'/)
CALL EXIT
101 IF(DATA(IVAR).LT.C2(I)) RESULT(I)=1.
GO TO 3
102 IF(DATA(IVAR).LE.C2(I)) RESULT(I)=1.
GO TO 3
103 IF(DATA(IVAR).GT.C2(I)) RESULT(I)=1.
GO TO 3
104 IF(DATA(IVAR).GE.C2(I)) RESULT(I)=1.
GO TO 3
105 IF(DATA(IVAR).EQ.C2(I)) RESULT(I)=1.
GO TO 3
106 IF(DATA(IVAR).NE.C2(I)) RESULT(I)=1.
C
3 CONTINUE
CALL BOOL(RESULT,GOOD,IOPD,IOPR,NOCOND)
RETURN
END
C---------------T IS RETURNED. OTHER ARGS. ARE INPUT.
C---------------IRP IS INPUT THRU COMMON.
SUBROUTINE BOOL(R,T,IOPD,IOPR,NOCOND)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION R(1),IOPD(1),IOPR(1)
C
JSUB=IOPD(1)
T=R(JSUB)
IF(NOCOND.LT.2) RETURN
DO 1 I=2,NOCOND
JSUB=IOPD(I)
IF(IOPR(I-1).EQ.'AND') T=T*R(JSUB)
IF(IOPR(I-1).EQ.'OR') T=T+R(JSUB)
IF(IOPR(I-1).NE.'AND'.AND.IOPR(I-1).NE.'OR') GO TO 2
1 CONTINUE
RETURN
2 ICOMPL=I-1
WRITE(IRP ,3)ICOMPL
3 FORMAT(' ','INVALID SYMBOL FOR OPERATOR NUMBERED',I3,'WITHIN'/1X,
1'SUBROUTINE BOOL'/)
CALL EXIT
END
C---------------IDLG, INT ARE INPUT THRU COMMON.
SUBROUTINE ERR
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
1 WRITE(IDLG,2)
2 FORMAT(1X,'YOUR RESPONSE VIOLATED A LIMITATION. TRY AGAIN.'/)
CALL DEVICE(INT)
RETURN
END
C---------------ALL ARGS. ARE RETURNED. IDLG,
C--------------- INT, ISW ARE INPUT THRU COMMON
SUBROUTINE INOUT(NOALFI,NOALFO,FMT1,FMT2)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION FMT1(1),FMT2(1)
IF(ISW.EQ.1) GO TO 35
98 WRITE(IDLG,100)
100 FORMAT(1X,'INDICATE NO. OF INPUT AND OUTPUT VARIABLES SEPARATED',
1' BY A COMMA.'/1X,' ENTER ''END'' TO STOP GENERATION OF FILES.'/)
35 READ(INT,25) NOALFI,NOALFO
25 FORMAT(4I)
IF(NOALFO.EQ.0)RETURN
IF(ISW.EQ.0)WRITE(IDLG,91111)
91111 FORMAT(' FORMAT FOR INPUT?',/)
CALL GETFOR(IDLG,INT,FMT2,ISTD,96,4*ISW+1)
IF(ISW.EQ.0)WRITE(IDLG,91112)
91112 FORMAT(' FORMAT FOR OUTPUT?',/)
CALL GETFOR(IDLG,INT,FMT1,ISTD,96,4*ISW+2)
RETURN
END
C---------------DATA IS RETURNED. OTHER ARGS. ARE INPUT. FMT1 IS
C--------------- MODIFIED. IDLG, INT, IRP, INP, ISW ARE
C--------------- INPUT THRU COMMON.
SUBROUTINE EDIT(DATA,NOALFI,NOALFO,FMT1,FMT2)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION DATA(1),IDENT(16),FMT1(96),FMT2(96)
DOUBLE PRECISION EDFIL
COMMON /BLOCK1/ EDFIL
IF(ISW.EQ.1) GO TO 1
WRITE(IDLG,3002)
3002 FORMAT(' ','ENTER IDENTIFICATION FOR EDITED FILE.'/)
READ(INT,13)IDENT
NOFREC=0
1 CALL IO(2,IDEV,IDLG,INT,1,ICODE,ISW)
13 FORMAT(16A5)
IF(ISW.EQ.1) GO TO 105
DO 993 I=1,16
IF(IDENT(I).NE.' ') GO TO 992
993 CONTINUE
GO TO 105
992 WRITE(2 ,13) IDENT
105 READ(INP,FMT2,END=2048)(DATA (I),I=1,NOALFI)
WRITE(2 ,FMT1)(DATA (I), I=1,NOALFO)
NOFREC=NOFREC+1
GO TO 105
2048 WRITE (IRP ,2044) NOFREC,EDFIL
2044 FORMAT(1X,'THERE ARE ',I5,' RECORDS IN FILE CALLED ',A10,'.'/)
IF(ISW.EQ.1) RETURN
WRITE(IDLG,2045)
2045 FORMAT(1X,'ENTER NUMBER OF RECORDS WITH MISSING DATA TO BE'/1X,
1'ADDED TO YOUR FILE. IF NONE ENTER 0.'/)
READ(INT,3) NOREC
3 FORMAT(I)
IF(NOREC.EQ.0)RETURN
IF(ISW.EQ.0)WRITE(IDLG,91112)
91112 FORMAT(' FORMAT FOR OUTPUT?',/)
CALL GETFOR(IDLG,INT,FMT1,ISTD,96,4*ISW+2)
DO 2049 I=1,NOREC
2049 WRITE(2 ,FMT1)
RETURN
END
C---------------NF IS INPUT. IDLG, INT, ISW ARE
C--------------- INPUT THRU COMMON.
SUBROUTINE COLLAT(NF)
DIMENSION NCDSFI(100),NCOFIL(100),IDENT(16),FILNAM(100)
DOUBLE PRECISION FILENA(100)
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
IF(ISW.EQ.1) GO TO 1
WRITE(IDLG,3010)
3010 FORMAT(1X,'ENTER NO. OF FILES TO BE COLLATED.'/)
1 READ(INT,116 ) NFCO
116 FORMAT(2I)
DO 6 I=6,MIN0(15,NFCO+5)
6 CALL DEVCHG('DSK',I)
IF(ISW.EQ.1) GO TO 7
IF(NFCO.EQ.0) GO TO 2041
WRITE(IDLG,2043)
2043 FORMAT(1X,'ENTER FILE NAMES,ONE PER LINE. FIVE CHARACTERS OR',
1' LESS PER FILE NAME.'/)
5 DO 3014 I=1,NFCO
3014 READ(INT,13 ) FILNAM(I)
13 FORMAT(16A5)
IF(ISW.EQ.1) GO TO 2
IF(NFCO.NE.0) GO TO 999
2041 NFCO=NF
999 WRITE(IDLG,3005)
3005 FORMAT(1X,'ON EACH LINE ENTER SEQUENCE NO. OF FILE TO BE '/1X,
1'COLLATED FOLLOWED BY COMMA AND NO. OF CARDS TO BE COLLATED.'/)
2 READ(INT,116 ) (NCOFIL(I),NCDSFI(I),I=1,NFCO )
IF(ISW.EQ.1) GO TO 4
WRITE(IDLG,3015)
3015 FORMAT(1X,'ENTER NAME TO BE ASSIGNED TO MERGED FILE.'/)
READ(INT,13 ) MERFIL
3 CALL SORTCO(FILNAM,NFCO,NCOFIL,MERFIL,NCDSFI,IDENT)
WRITE(IRP ,3007) MERFIL
3007 FORMAT(1X,'FILE ',A5,'.DAT HAS BEEN COMPLETED.'/)
RETURN
4 MERFIL='OUTPT'
CALL OFILE(21,MERFIL)
GO TO 3
7 ISEQ=1
GO TO 5
END
C---------------IFLNM IS INPUT AND IS ALSO MODIFIED.
SUBROUTINE APENDT(IFLNM)
C SUBROUTINE TO APPEND A DOT TO A FILE NAME FOR FOROTS.
C 23 DEC 74 - RRB.
DOUBLE PRECISION IFLNM
DIMENSION J(10)
DATA IDOT,IBNK/'.',' '/
DECODE(10,1000,IFLNM) J
1000 FORMAT(10A1)
DO 1002 K=10,1,-1
1002 IF(J(K).NE.' ')GO TO 1004
GO TO 1008
1004 DO 1006 L=K,1,-1
1006 IF(J(L).EQ.'.')GO TO 1008
K=MIN0(K,6)
ENCODE(10,1000,IFLNM) (J(L),L=1,K),IDOT,(IBNK,L=K+2,10)
1008 RETURN
END
C---------------IDV RETURNED. OTHER ARGS ARE INPUT.
C---------------INAME RETURNED THRU COMMON /BLOCK1/
SUBROUTINE IO(IDEV,IDV,NOUTD,INP,IORO,ICODE,ISW)
C
C FOROTS COMPATABLE AND 'HELP' - 23 DEC 74 - RRB
C
C THIS IS A SUBROUTINE TO ACCEPT A STRING OF CHARACTERS
C WHICH SPECIFY INPUT AND OUTPUT DEVICES
C
C ARGUMENTS ARE:
C IDEV - FORTRAN DEVICE NUMBER
C IDV - MNEMONIC FOR THE DEVICE TO BE ASSOCIATED WITH
C THE FORTRAN DEVICE NUMBER
C NOUTD- DIALOGUE OUTPUT DEVICE NUMBER
C INP - DIALOGUE INPUT DEVICE NUMBER
C IORO - 0=INPUT
C 1=OUTPUT
C ICODE- 0= TTY JOB
C -1= PSEUDO-TELETYPE JOB
C
C ROUTINES CALLED BY IO ARE:
C PRINTS - FORTRAN LIBRARY
C DEVCHG - FORTRAN LIBRARY
C EXISTS - NGLIB
C TTYPTY - NGLIB
C
DOUBLE PRECISION JNAME
DIMENSION IN(50),B(10),NAM(2)
COMMON /BLOCK1/ INAME(2)
EQUIVALENCE (INAME,JNAME)
IF(ISW.EQ.1) GO TO 265
1 IF(IORO.EQ.0)WRITE(NOUTD,310)
310 FORMAT(' INPUT? (TYPE HELP IF NEEDED)--',$)
300 IF(IORO.EQ.1)WRITE(NOUTD,311)
311 FORMAT(' OUTPUT? (TYPE HELP IF NEEDED)--',$)
READ(INP,10)IN
10 FORMAT(50A1)
IF(IN(1).EQ.'F'.AND.IN(2).EQ.'I'.AND.IN(3).EQ.'N')GO TO 201
IF(IN(1).EQ.'S'.AND.IN(2).EQ.'A'.AND.IN(3).EQ.'M')GO TO 212
IF(IN(1).EQ.'H'.AND.IN(2).EQ.'E'.AND.IN(3).EQ.'L'.AND.
1IN(4).EQ.'P'.AND.IN(5).EQ.' '.AND.IN(6).EQ.' '.AND.
2IN(7).EQ.' ')GO TO (500,600),IORO+1
GO TO 266
265 IN(1)='D'
IN(2)='S'
IN(3)='K'
IN(4)=':'
DO 267 I=5,14
267 IN(I)=' '
266 CALL RELEAS(IDEV)
NEVER=0
ICOLN=0
ILBR=0
ISL=0
IPROJ=0
IPROG=0
INAME(1)=' '
INAME(2)=' '
IDV=' '
K=0
12 K=K+1
IF(K.GT.50)GO TO 15
IF(IN(K).EQ.':')GO TO 13
IF(IN(K).EQ."555004020100)GO TO 14
IF(IN(K).EQ.'/')GO TO 23
GO TO 12
13 ICOLN=K+4
DO 20 I=50,K+4,-1
20 IN(I)=IN(I-4)
DO 27 I=0,3
27 IN(K+I)=' '
K=K+4
GO TO 12
14 ILBR=K+9
DO 21 I=50,K+9,-1
21 IN(I)=IN(I-9)
DO 22 I=K,K+8
22 IN(I)=' '
K=K+9
GO TO 12
23 ISL=K
GO TO 12
15 IF(ILBR.EQ.0)GO TO 31
30 ENCODE(12,40,B)(IN(I),I=ILBR+1,ILBR+12)
40 FORMAT(12A1)
DECODE(12,41,B) IPROJ,IPROG
41 FORMAT(2O)
31 ENCODE(10,42,INAME)(IN(I),I=ICOLN+1,ICOLN+10)
42 FORMAT(10A1)
IF(ICOLN.EQ.0)GO TO 101
100 ENCODE(5,44,IDV)(IN(I),I=1,5)
44 FORMAT(5A1)
101 IF(ISL.EQ.0)GO TO 24
ENCODE(5,44,B)(IN(I),I=ISL+1,ISL+5)
DECODE(5,46,B)NCOPYS
46 FORMAT(I)
24 IF(IDV.NE.' ')GO TO 124
IF(INAME(1).EQ.' ')GO TO 28
IDV='DSK'
GO TO 124
28 IF(ICODE.EQ.-1)GO TO 125
IDV='TTY'
GO TO 124
125 IF(IORO.EQ.0)IDV='CDR'
IF(IORO.EQ.1)IDV='LPT'
124 CALL DEVCHG(IDV,IDEV)
D TYPE 9998,IDV,IDEV
D9998 FORMAT(1X,A5,I6)
IF(IDV.EQ.'DSK')GO TO 102
IF(IDV.EQ.'LPT')GO TO 104
IF(IDV.LE."422510134500.AND.IDV.GE."422510130100)GO TO 102
RETURN
104 INAME(1)='OUTAA'
INAME(2)='A.AAA'
IPR=1
LPT=IDEV
CALL DEVCHG('DSK',IDEV)
105 CALL EXISTS(IDEV,INAME,MRK)
IF(MRK.EQ.1)GO TO 211
INAME(2)=INAME(2)+2
GO TO 105
211 NAM(1)=INAME(1)
NAM(2)=INAME(2)
102 IF(INAME(1).NE.' ')GO TO 302
IF(IORO.EQ.0)INAME(1)='INPUT'
IF(IORO.EQ.1)INAME(1)='OUTPT'
INAME(2)='.DAT'
302 IF(IORO.EQ.1)GO TO 303
CALL EXISTS(IDEV,INAME,MRK,IPROJ,IPROG)
IF(MRK.EQ.0)GO TO 303
WRITE(NOUTD,305)
305 FORMAT(' FILE DOES NOT EXIST'/)
IF(ICODE.EQ.-1)CALL EXIT
GO TO 1
303 CALL APENDT(JNAME)
CALL DEFINE FILE(IDEV,0,NEVER,JNAME,IPROJ,IPROG)
D TYPE 9999,IDEV,INAME,IPROJ,IPROG
D9999 FORMAT(I3,2X,2A5,O12,2X,O12)
RETURN
201 IF(IPR.EQ.1)CALL RELEAS(LPT)
IF(IPR.EQ.1)CALL PRINTS(NAM,1,1,NCOPYS)
CALL EXIT
212 REWIND IDEV
RETURN
500 WRITE(NOUTD,501)
501 FORMAT('-THIS ANSWER DEFINES WHERE THE PROGRAM IS TO FIND THE
1 INPUT DATA. IT'/' USUALLY CONSISTS OF A DEVICE, POSSIBLY A
2 FILENAME WITH OR WITHOUT AN'/' EXTENSION, AND A PROJECT-
3PROGRAMMER NUMBER.'//' POSSIBLE DEVICES ARE:'//6X,'DEVICES',3X,
4 'DESCRIPTION'/6X,7('-'),3X,11('-')/6X,'TTY:',6X,'TERMINAL'/
5 6X,'DSK:',6X,'DISK (FILENAME AND EXTENSION, PROJECT-PROGRAMMER
6 NUMBER'/22X,'MAY BE USED)'/6X,'CDR:',6X,'CARD READER (THIS
7 DEVICE IS NOT APPLICABLE ON TERMINAL'/30X,'JOBS)'/6X,'DTA#:',5X,
8 'DECTAPE UNIT (USER''S DECTAPE SHOULD ALREADY BE MOUNTED)'/6X,
9 'MTA#:',5X,'MAGTAPE UNIT (USER''S MAGTAPE SHOULD ALREADY BE
1 MOUNTED'/30X,'AND POSITIONED)'///' DEFAULTS:'//' (1) IF NO INPUT
2 DEVICE IS SPECIFIED BUT A FILENAME IS GIVEN, THE'/6X,'DEFAULT
3 DEVICE WILL BE DSK:'//' (2) IF A DEVICE WHICH REQUIRES A
4 FILENAME AND EXTENSION IS SPECIFIED,'/6X,'BUT NO FILENAME IS
5 GIVEN, THE DEFAULT NAME WILL BE INPUT.DAT'//' (3) IF NO RESPONSE
6 IS GIVEN, I.E. A CARRIAGE RETURN <CR> IS ENTERED,'/6X,'THE
7 DEFAULT DEVICE IS TTY: ON JOBS RUN FROM TERMINALS; AND'/28X,'CDR:
8 ON BATCH JOBS'//' (4) IF DSK: IS SPECIFIED AS THE INPUT DEVICE
9 AND NO PROJECT-PROGRAMMER'/6X,'NUMBER IS GIVEN, THE USER''S
1 PROJECT-PROGRAMMER NUMBER WILL BE'/6X,'ASSUMED.'///)
WRITE(NOUTD,502) L1,L2
502 FORMAT(' EXAMPLES: DATA.DAT'/14X,'TEST.DAT',A1,'420,420',A1/
1 14X,'MTA0:'/14X,'DTA2:FILE1'//' NOTE: THE FOLLOWING RESPONSES
2 ARE VALID AFTER THE FIRST "INPUT?"'//' (1) SAME COMMAND. IF THE
3 DATA FILE TO BE USED IS THE SAME AS THE'/6X,'PRECEEDING ONE, THE
5 USER MAY SIMPLY ENTER "SAME"'//' (2) FINISH COMMAND. THE USER
6 MUST ENTER "FINISH" TO EXIT FROM THE'/6X,'PROGRAM. THIS ENSURES
7 THAT OUTPUT ASSIGNED TO LPT: WILL BE'/6X,'PRINTED. FAILURE TO
8 USE THE "FINISH" COMMAND MAY RESULT IN'/6X,'LOSING THE ENTIRE
9 OUTPUT FILE.'//' (3) A ^Z (CONTROL Z) WILL RESULT IN THE SAME
1 ACTION AS THE "FINISH"'/6X,'COMMAND.'///)
503 CALL RELEAS (NOUTD)
GO TO (1,300),IORO+1
600 WRITE(NOUTD,601)
601 FORMAT('-THE ANSWER DEFINES WHERE THE OUTPUT FROM THE PROGRAM
1 IS TO BE PLACED.'/' IT USUALLY CONSISTS OF A DEVICE AND POSSIBLY
2 A FILENAME WITH OR WITH-'/' OUT AN EXTENSION.'//' POSSIBLE
3 DEVICES ARE:'//6X,'DEVICE',3X,'DESCRIPTION'/6X,6('-'),3X,
4 11('-')/6X,'TTY:',5X,'TERMINAL'/6X,'DSK:',5X,'DISK (FILENAME
5 AND EXTENSION MAY BE USED)'/6X,'LPT:',5X,'LINEPRINTER (MULTIPLE
6 COPIES MAY BE REQUESTED BY USE OF'/29X,'THE "/COPIES" COMMAND)'/
7 6X,'DTA#:',4X,'DECTAPE UNIT (USER''S DECTAPE SHOULD ALREADY
8 BE MOUNTED;'/29X,'FILENAME AND EXTENSION MAY BE USED.)'/
9 6X,'MTA#:',4X,'MAGTAPE UNIT (USER''S MAGTAPE SHOULD ALREADY
1 BE MOUNTED'/29X,'AND POSITIONED)'///' DEFAULTS:'//' (1) IF NO
2 OUTPUT DEVICE IS SPECIFIED BUT A FILENAME IS GIVEN, THE'/6X,
3 'DEFAULT DEVICE WILL BE DSK:'//' (2) IF A DEVICE WHICH REQUIRES
4 A FILENAME AND EXTENSION IS SPECIFIED,'/6X,'BUT NO FILENAME IS
5 GIVEN, THE DEFAULT NAME WILL BE OUTPT.DAT'//' (3) IF NO RESPONSE
6 IS GIVEN, I.E. A CARRIAGE RETURN <CR> IS ENTERED,'/6X,'THE
7 DEFAULT DEVICE IS TTY: ON JOBS RUN FROM TERMINALS; AND'/28X,'LPT:
8 ON BATCH JOBS'//' (4) IF LPT: IS LISTED AS THE OUTPUT DEVICE,
9 THE NUMBER OF COPIES WILL'/6X,'DEFAULT TO 1.'///
1 ' EXAMPLES: LPT:/2'/14X,'RPT.DAT'/14X,'DTA0:NAME.DAT'///)
GO TO 503
END
C---------------IDENT IS RETURNED. NCOFIL APPARENTLY NOT USED.
C--------------- OTHER ARGS. ARE INPUT. IDLG, INT, IRP,
C--------------- ISW ARE INPUT THRU COMMON.
SUBROUTINE SORTCO(FILNAM,NFCO,NCOFIL,MERFIL,NCDSFI,IDENT)
DOUBLE PRECISION FILEDP
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION FILENA(1),IDENT(16),NCOFIL(1),FILNAM(100),NCDSFI(1)
DIMENSION MFIL(2)
IF(ISW.EQ.1) GO TO 9
WRITE(IDLG,3999)
3999 FORMAT(' ','ENTER IDENTIFICATION TO BE OUTPUTTED WITH MERGED ',
1'FILE.'/)
READ(INT,2) IDENT
2 FORMAT(16A5)
CALL OFILE(21,MERFIL)
DO 7 I=1,16
IF(IDENT(I).NE.' ') GO TO 8
7 CONTINUE
GO TO 5
8 WRITE(21,2 ) IDENT
5 WRITE(IDLG,3)
3 FORMAT(1X,'DO INPUT FILES HAVE HEADERS TO BE KEPT OUT OF MERGED ',
1'FILE?'/)
READ(INT,2) ANS
IF(ANS.EQ.'YES'.OR.ANS.EQ.'NO') GO TO 9
CALL DEVICE(INT)
GO TO 5
9 KM=0
ITEMP=0
JTEMP=0
KK=0
SW=0
CALL DEVCHG('DSK',3)
10 CALL OFILE(21,'TEMP2')
IF(ITEMP.EQ.0)GO TO 11
CALL IFILE(3,'TEMP3')
KM=0
11 DO 14 I=6,MIN0(15,NFCO-KK+5)
FILEDP=FILNAM(KK+I-5)
CALL APENDT(FILEDP)
14 CALL IFILE(I,FILEDP)
15 KL=KK
IF(SW.EQ.0)GO TO 24
12 DO 13 K=1,ITEMP
READ(3,2,END=18)IDENT
13 WRITE(21,2)IDENT
24 DO 16 I=6,MIN0(15,NFCO-KK+5)
KL=KL+1
K1=NCDSFI(KL)
IF(KM.EQ.0)JTEMP=JTEMP+K1
IF(ISW.EQ.1.OR.SW.EQ.1)GO TO 23
IF(ANS.NE.'YES')GO TO 23
READ(I,2)IDENT
23 DO 17 K=1,K1
READ(I,2,END=20)IDENT
WRITE(21,2)IDENT
17 CONTINUE
16 CONTINUE
KM=1
GO TO 15
20 KX=KL
18 CALL RELEAS(21)
CALL RENAMS(21 ,5,'TEMP2.DAT','TEMP3.DAT',"155)
SW=1
ITEMP=JTEMP
KK= MIN0(KK+10,NFCO)
IF(KK.GE.NFCO)GO TO 19
GO TO 10
19 CALL RELEAS(3)
MFIL(1)=MERFIL
MFIL(2)='.DAT'
CALL RELEAS(21)
CALL RENAMS(21,5,'TEMP3.DAT',MFIL,"155)
21 WRITE(IRP,22)FILNAM(KX)
22 FORMAT(1X,'NO MORE RECORDS ON FILE CALLED ',A5,'.'/)
RETURN
END
C---------------IFLNM IS RETURNED. FILENA IS RETURNED
C--------------- THRU COMMON. IDLG, INT, ISW ARE INPUT THRU COMMON.
SUBROUTINE UNCOLL(IFLNM)
DOUBLE PRECISION FILEDP
DOUBLE PRECISION IFLNM,INPUT
DATA INPUT /'INPUT.DAT'/
COMMON IDLG,INT,IRP,INP,YESNO,ISW,MAX,DMISS,FILENA
DIMENSION FILENA(100),NCDSOF(100),IDENT(16)
ICOUNT=0
IF(ISW.EQ.1) GO TO 16
WRITE(IDLG,11)
11 FORMAT(1X,'WHAT IS NAME OF INPUT FILE ON DISK?'/)
13 READ(INT,12),IFLNM
12 FORMAT(A10)
16 CALL APENDT(IFLNM)
CALL DEFINE FILE(1,0,NV,IFLNM,0,0)
IF(ISW.EQ.1) GO TO 6
WRITE(IDLG,7)
7 FORMAT(1X,'ENTER NO. OF OUTPUT FILES AND INTEGERS WHICH INDICATE
1HOW '/1X,' MANY RECORDS GO INTO EACH OF OUTPUT FILES?'/)
6 READ(INT,8) NOF,(NCDSOF(I),I=1,NOF)
8 FORMAT(21I)
IF(ISW.EQ.1) GO TO 14
WRITE(IDLG,9)
9 FORMAT(1X,'ENTER NAMES OF OUTPUT FILES AT RATE OF ONE PER LINE.'/)
14 DO 18 I=1,NOF
18 READ(INT,10)FILENA(I)
10 FORMAT(A5)
DO 19 I=6,MIN0(15,NOF+5)
19 CALL DEVCHG('DSK',I)
JOUT=21
KK=0
GO TO 1
20 CALL IFILE(1,'TEMP1')
1 DO 3 I=6,MIN0(15,NOF+5-KK)
FILEDP=FILENA(KK+I-5)
CALL APENDT(FILEDP)
3 CALL OFILE(I,FILEDP)
IF(NOF-KK.GT.10)CALL OFILE(JOUT,'TEMP2')
5 KL=KK
DO 17 I=6,MIN0(15,NOF+5-KK)
KL=KL+1
K1=NCDSOF(KL)
DO 17 K=1,K1
READ(1,2,END=4)IDENT
ICOUNT=ICOUNT+1
17 WRITE(I,2)IDENT
IF(NOF-KK.LE.10)GO TO 5
DO 21 J=KL+1,NOF
K2=NCDSOF(J)
DO 22 JA=1,K2
READ(1,2,END=4)IDENT
22 WRITE(JOUT,2)IDENT
21 CONTINUE
GO TO 5
4 DO 23 I=6,MIN0(15,NOF+5)
CALL RELEAS(I)
23 CALL PROTEK("155,FILENA(I))
CALL RELEAS(1)
CALL RELEAS(JOUT)
KK=MIN0(KK+10,NOF)
IF(KK.GE.NOF)GO TO 24
CALL RENAMS(JOUT,5,'TEMP2.DAT','TEMP1.DAT',"155)
GO TO 20
2 FORMAT(16A5)
24 WRITE(IDLG,15)IFLNM,ICOUNT
15 FORMAT(1X,'THE FILE CALLED ',A10,' HAS ',I5,' RECORDS.'/)
RETURN
END