Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/infop.f4
There are no other files named infop.f4 in the archive.
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