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 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 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