SUBROUTINE GETNAM(FILS,DEV,FILNAM,NUM) IMPLICIT INTEGER (A-Z) DIMENSION FILS(15),IWORK(3),IBLANK(5) DIMENSION SLOT(29) DATA SLOT(1),SLOT(5),SLOT(20)/3*1/ COMMON /WHEW/DEVISE(29) DATA BLANK/5H /,DEVISE/3HDSK,3HCDR,3HLPT,3HCTY,3HTTY, 13HPTR,3HPTP,3HTTY,4HDTA1,4HDTA2,4HDTA3,4HDTA4,4HDTA5,4HDTA6, 24HDTA7,4HMTA0,4HMTA1,4HMTA2,3HTTY,4HDSK0,4HDSK1,4HDSK2, 34HDSK3,4HDSK4,4HDEV1,4HDEV2,4HDEV3,4HDEV4,4HDEV5/ C DATA HERE/0/,COLON/1H:/,PERIOD/1H./ C IF(HERE.EQ.1)GO TO 1 HERE=1 CALL DEVCHG('TTY',8) CALL DEVCHG('TTY',19) IBLANK(1)=BLANK IBLANK(2)=(BLANK).AND."3777777777 IBLANK(3)=(BLANK).AND."17777776 IBLANK(4)=BLANK.AND."77776 IBLANK(5)=BLANK.AND."376 1 IWORK(1)=BLANK IWORK(2)=BLANK D TYPE999,DEV,FILNAM,SLOT,(IJ,IJ=1,29) 999 FORMAT(1X,A4,A5,/,1X,29I2,/,1X,29I2) K=1 L=0 J=1 DO 10 I=1,15 IF(FILS(I).EQ.BLANK)GO TO 20 IF (FILS(I).EQ.COLON) GO TO 30 GO TO (100,200,300,400,500)J 100 IWORK(K)=(FILS(I).AND."774000000000) J=2 GO TO 10 200 IWORK(K)=IWORK(K).OR.((FILS(I)/128).AND."3760000000) J=3 GO TO 10 300 IWORK(K)=IWORK(K).OR.((FILS(I)/16384).AND."17700000) J=4 GO TO 10 400 IWORK(K)=IWORK(K).OR.(((FILS(I)/16384)/128).AND."77400) J=5 GO TO 10 500 IWORK(K)=IWORK(K).OR.(((FILS(I)/16384)/16384).AND."376) J=1 K=2 GO TO 10 20 IF(IWORK(1).EQ.BLANK)GO TO 11 IF (I.EQ.1) GO TO 11 IWORK(K)=IWORK(K).OR.IBLANK(J) FILNAM=IWORK(1) GO TO 11 30 IF (IWORK(1).EQ.BLANK) GO TO 10 IF(K.EQ.1) GO TO 31 IWORK(1)=IWORK(1).AND.(.NOT."376) J=5 GO TO 31 31 IWORK(1)=IWORK(1).OR.IBLANK(J) C CHECK DEV FOR LEGALITY +FIND OLD SLOT DO 2 IX=1,29 IF(DEV.EQ.DEVISE(IX))GO TO 361 2 CONTINUE GO TO 361 361 IF(SLOT(IX).EQ.0.AND.DEV.EQ.'TTY')GO TO 2 C CHECKNEW DEVICE FOR LEGALITY + FIND SLOT OF NEW DEVICE 3 DO 32 II=1,29 IF(IWORK(1).EQ.DEVISE(II)) GO TO 6 32 CONTINUE 36 WRITE (30,34) 34 FORMAT(' ?BAD DEVICE NAME',/) GO TO 41 C SLOT FOR NEW OR SAME DEVICE 6 IF(SLOT(II).EQ.0.OR.IX.EQ.II)GO TO 5 IF(IWORK(1).EQ.'TTY'.AND.(II.EQ.5.OR.II.EQ.8))GO TO 32 GO TO 39 C SET UP NEW SLOT 5 SLOT(IX)=0 SLOT(II)=1 GO TO 33 39 WRITE(30,37)IWORK(1) 37 FORMAT(' ?',A4,': MAY BE USED FOR ONLY ONE I/O FUNCTION',/) 41 WRITE(30,40)DEV,FILNAM 40 FORMAT(' OLD WAS ',A4,':',A5,' REPLACE WITH ',$) ACCEPT 38,FILS 38 FORMAT(15A1) GO TO 1 33 DEV=IWORK(1) NUM=II IWORK(1)=BLANK IWORK(2)=BLANK K=1 J=1 GO TO 10 10 CONTINUE 11 CONTINUE D TYPE 999,DEV,FILNAM,SLOT,(IJ,IJ=1,29) RETURN END FUNCTION FINPUT(MODE,IERR) C TEST9 (IN COMMON)=COLUMN POINTER=COL C WHENEVER COL=-1, FINPUT WILL ECHO CURRENT RECORD TO THE TTY, C AND READ A REPLACEMENT RECORD FROM THE TTY C (THIS FACILITY IS FOR ERROR INDICATION TO THE USER) C WHENEVER COL=0, FINPUT WILL READ A NEW RECORD FROM THE TTY C AFTER COL HAS BEEN PROCESSED, THE MODE PARAMETER IS CHECKED- C MODE=-1 TO CHECK IF THERE ARE ANY UNPROCESSED ELEMENTS C REMAINING UN THE CURRENT RECORD. C IF THERE ARE NO MORE ELEMENTS - FINPUT=0.0 C IF THERE ARE SOME ELEMENTS - FINPUT=1.0 C IN EITHER CASE - COL=0 C MODE=0 TO CHECK FOR A NUMERIC VALUE AS THE NEXT ELEMENT C MODE=+1 TO CHECK FOR AN ALPHANUMERIC CHARACTER STRING AS THE C NEXT ELEMENT (ONLY THE FIRST CHARACTER IS RETAINED) C IN EITHER OF THE LATTER TWO CASES - C IF THERE IS ANOTHER (OK) ELEMENT - IERR=0 C FINPUT=[VALUE] C IF THERE ARE NO MORE ELEMENTS - IERR =-1 C COL=0 C FINPUT=0.0 (NUMERIC) C OR BLANK (ALPHA) C IF THERE IS ANOTHER ELEMENT OF C THE WRONG TYPE - IERR=+1 C COL=0 C FINPUT=0.0 (NUMERIC) C OR BLANK (ALPHA) C NOTE THAT THE ABOVE SCHEME (WITH COL), IF PROPERLY UTILIZED, C WILL RESULT IN COL=0 AND A NEW RECORD BEING READ AUTOMATICALLY, C AT THE APPROPRIATE TIMES - IT IS ONLY NECESSARY TO INITIALIZE C COL (TEST9) = 0. C NUMERIC ELEMENTS ARE DELIMITED BY BLANKS,COMMAS,$,OR MODE CHANGE C ALPHANUMERIC ELEMENTS ARE DELIMITED BY BLANKS, COMMAS, AND $ C $ IS THE RECORD TERMINATOR C FINPUT OPERATES ON 72-CHARACTER INPUT RECORDS C NUMERIC ELEMENTS MAY BE INTEGER, FIXED POINT, OR FLOATING POINT C BE CAREFUL ABOUT E AND G (E FORMAT OR ALPHA CAN BE CONFUSING) C INTEGER COL, TEST2 LOGICAL DIGD,DIGE,ESW,NUMER,POINT DIMENSION DATUM(72),DIGIT(10),DVAL(10) COMMON REALS(395),INTS(547) EQUIVALENCE (INTS(526),TEST2),(INTS(533),COL) DATA BLANK/1H / DATA COMMA/1H,/ DATA DMINUS/1H-/ DATA DOLLAR/1H$/ DATA DPLUS/1H+/ DATA DPOINT/1H./ DATA E/1HE/ DATA G/1HG/ DATA DIGIT(1)/1H0/ DATA DIGIT(2)/1H1/ DATA DIGIT(3)/1H2/ DATA DIGIT(4)/1H3/ DATA DIGIT(5)/1H4/ DATA DIGIT(6)/1H5/ DATA DIGIT(7)/1H6/ DATA DIGIT(8)/1H7/ DATA DIGIT(9)/1H8/ DATA DIGIT(10)/1H9/ DATA DVAL(1)/0.0/ DATA DVAL(2)/1.0/ DATA DVAL(3)/2.0/ DATA DVAL(4)/3.0/ DATA DVAL(5)/4.0/ DATA DVAL(6)/5.0/ DATA DVAL(7)/6.0/ DATA DVAL(8)/7.0/ DATA DVAL(9)/8.0/ DATA DVAL(10)/9.0/ C C BEGIN COL CHECK IF (COL) 10,30,60 C ECHO CURRENT RECORD TO, AND READ NEW RECORD FROM, THE TELETYPE 10 IF (TEST2.NE.5) WRITE(30,20) (DATUM(I),I=1,40) 20 FORMAT(1H ,40A1,4H****) READ(5,40) DATUM GO TO 50 C READ NEW RECORDS FROM TEST2 30 READ(TEST2,40,END=380) DATUM 40 FORMAT(72A1) C INITIALIZE COLUMN POINTER 50 COL=1 C GENERAL INITIALIZATION 60 IF (MODE) 70,70,80 70 FINPUT=0.0 GO TO 90 80 FINPUT=BLANK C CHECK IF ANY ELEMENTS 90 IF (COL.GT.72) GO TO 100 IF (DATUM(COL).NE.DOLLAR) GO TO 110 C NO ELEMENTS REMAINING 100 IERR=-1 GO TO 400 C THERE IS SOME ELEMENTS 110 IF (MODE) 120,130,130 C CALLER DOES NOT WANT ANY MORE 120 FINPUT=1.0 GO TO 400 C IT IS OK TO HAVE AN ELEMENT C IGNORE LEADING BLANKS 130 DO 140 COL=COL,72 IF (DATUM(COL).NE.BLANK) GO TO 150 140 CONTINUE C REACHED END-OF-RECORD - NULL ELEMENT GO TO 380 C FOUND A NON-BLANK CHARACTER - CHECK IF NULL ELEMENT 150 CHAR=DATUM(COL) IF (CHAR.EQ.COMMA) GO TO 370 IF (CHAR.EQ.DOLLAR) GO TO 380 C THE ELEMENT IS NOT NULL IF (MODE) 230,200,160 C TREAT IT AS AN ALPHANUMERIC CHARACTER STRING 160 DO 170 I=1,10 IF (CHAR.EQ.DIGIT(I)) GO TO 230 170 CONTINUE C IT IS NOT A DIGIT - SAVE FIRST CHARACTER FINPUT=CHAR C MOVE PAST REMAINDER OF THE ALPHANUMERIC STRING 180 COL=COL+1 IF (COL.GT.72) GO TO 380 CHAR=DATUM(COL) IF (CHAR.EQ.DOLLAR) GO TO 380 IF (CHAR.EQ.COMMA) GO TO 370 IF (CHAR.EQ.BLANK) GO TO 360 GO TO 180 C TREAT IT AS NUMERIC C GENERAL NUMERIC INITIALIZATION 200 NUMER=.FALSE. ISIGND=0 DIGD=.FALSE. POINT=.FALSE. DECIM=0.0 ESW=.FALSE. IEXPO=0 C CHARACTER SEARCH 210 DO 220 I=1,10 IF (CHAR.EQ.DIGIT(I)) GO TO 240 220 CONTINUE IF (CHAR.EQ.DPLUS) GO TO 280 IF (CHAR.EQ.DMINUS) GO TO 290 IF (CHAR.EQ.DPOINT) GO TO 320 IF (CHAR.EQ.E.OR.CHAR.EQ.G) GO TO 330 C NON-NUMERIC TYPE CHARACTER IF (NUMER) GO TO 390 C THIS ELEMENT IS OF THE WRONG TYPE - INDICATE ERROR 230 IERR=1 GO TO 400 C DIGIT 240 IF (ESW) GO TO 250 C UPDATE FIXED POINT PART IF (POINT) IEXPO=IEXPO-1 DIGD=.TRUE. R=DVAL(I) IF (ISIGND.EQ.(-1)) R=-R DECIM=10.0*DECIM+R GO TO 350 C UPDATE EXPONENT PART 250 I=I-1 IF (ISIGNE.EQ.(-1)) I=-I IEXPO=10*IEXPO+I IF (DIGD) GO TO 350 C FIXED POINT PART WAS AT MOST A SIGN - CAN TAKE CARE OF THAT NOW IF (ISIGND) 260,350,270 260 DECIM=-1.0 GO TO 350 270 DECIM=1.0 GO TO 350 C PLUS SIGN 280 I=1 GO TO 300 C MINUS SIGN 290 I=-1 300 IF (ESW) GO TO 310 C NUMERIC SIGN IF (ISIGND.NE.0) GO TO 390 ISIGND=I GO TO 350 C EXPONENT SIGN 310 IF (ISIGNE.NE.0) GO TO 390 ISIGNE=I GO TO 350 C DECIMAL POINT 320 IF (POINT.OR.ESW) GO TO 390 POINT=.TRUE. GO TO 350 C E 330 IF (ESW) GO TO 390 C EXPONENT PART INITIALIZATION ESW=.TRUE. ISIGNE=0 DECIM=DECIM*10.0**IEXPO IEXPO=0 C GET NEXT CHARACTER 350 NUMER=.TRUE. COL=COL+1 IF (COL.GT.72) GO TO 390 CHAR=DATUM(COL) IF (CHAR.EQ.COMMA) GO TO 390 IF (CHAR.EQ.DOLLAR) GO TO 390 IF (CHAR.NE.BLANK) GO TO 210 C BLANK IS THE DELIMITER FINPUT=DECIM*10.0**IEXPO C IGNORE TRAILING BLANKS 360 COL=COL+1 IF (COL.GT.72) GO TO 380 CHAR=DATUM(COL) IF (CHAR.EQ.BLANK) GO TO 360 C MOVE TO COLUMN AFTER A COMMA 370 IF (CHAR.EQ.COMMA) COL=COL+1 C END OF SCAN - INDICATE NO ERROR 380 IERR=0 RETURN C DELIMITER - FINISH UP 390 FINPUT=DECIM*10.0**IEXPO GO TO 370 C ERROR OR END OF RECORD - RESET COLUMN POINTER TO ZERO 400 COL=0 RETURN END FUNCTION KINPUT(MODE,IERR) C KINPUT EQUALS FINPUT ROUNDED TO INTEGER R=FINPUT(MODE,IERR) IF (R) 10,20,30 10 K=R-0.5 GO TO 40 20 K=0 GO TO 40 30 K=R+0.5 40 KINPUT=K RETURN END BLOCK DATA COMMON/EXTRA2/TY(30) C MODIFIED FOR BLOCKS A,C,E 25 APR 74. DATA TY(1)/1HA/ DATA TY(3)/1HC/ DATA TY(5)/1HE/ C DATA TY(2)/1HB/ DATA TY(4)/1HD/ DATA TY(6)/1HF/ DATA TY(7)/1HG/ DATA TY(8)/1HH/ DATA TY(9)/1HI/ DATA TY(10)/1HJ/ DATA TY(11)/1HK/ DATA TY(12)/1HL/ DATA TY(13)/1HM/ DATA TY(14)/1HN/ DATA TY(15)/1HO/ DATA TY(16)/1HP/ DATA TY(17)/1HQ/ DATA TY(18)/1HR/ DATA TY(19)/1HS/ DATA TY(20)/1HT/ DATA TY(21)/1HU/ DATA TY(22)/1HV/ DATA TY(23)/1HW/ DATA TY(24)/1HX/ DATA TY(25)/1HY/ DATA TY(26)/1HZ/ DATA TY(27)/1H+/ DATA TY(28)/1H-/ DATA TY(29)/1H// DATA TY(30)/1H / END