File: GETIN.LS of Disk: V50/Source/Source-Listing-FORTRAN-2

(Source file text) 

---

        FORTRAN IV  V50-A (A6)  24-JUL-20 

	C WAS SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)
	C OS/8 version returns 4 chars in the first word of each command entity
	C
	C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH
	C  BLANKS, AND RETURN IT IN WORD1 AND WORD1A. (for OS/8, WORD1)
	C  CHARS 5  AND 6 ARE RETURNED IN WORD1X, IN
	C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF
	C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN
	C  WORD2 AND WORD2A (CHARS 5 AND 68 IN WORD2X), ELSE WORD2 IS SET TO ZERO.
	C  (for OS/8, WORD2 and WORD2X).
	C
	C       IMPLICIT INTEGER (A-Z)
	C       LOGICAL*1 FRST(20),BLANK,LCA,LCZ,UCA
	C       DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/
	
0002	        SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)
0003	        INTEGER INPUT(20),WORD1,WORD1X
0004	        INTEGER WORD2,WORD2X
	
0005	10      WRITE(4,1)
0006	1       FORMAT(' > ',$)
	C       READ(4,2)INPUT
	C2      FORMAT(20A1)
0007	        CALL RDLINE(INPUT, 20)
0010	        WORD1 = ' '
0011	        WORD1X = ' '
0012	        WORD2 = ' '
0013	        WORD2X = ' '
	
0014	        DO 15 I=1,20
	C Using INT here to normalize the input values
0015	        J = INT(INPUT(I))
0016	15      INPUT(I) = J
0017	        IX1=0
0020	        IX2=0
0021	        I=0
	C
	C Find first nonblank
	C
0022	20      I=I+1
0023	        IF(I.GT.20)GOTO 10
0024	        IF(INPUT(I).EQ.32)GOTO 20
	C
	C Move four characters to WORD1
	C
0025	        DO 30 IX1 = 1, 4
0026	        CALL CPUT(WORD1, IX1, INPUT(I))
0027	        I=I+1
0030	        IF(I.GT.20)GOTO 100
	C
	C If blank, go to word 2
	C
0031	        IF(INPUT(I) .EQ. 32) GOTO 50
0032	30      CONTINUE
	C
        FORTRAN IV  V50-A (A6)  24-JUL-20 

	C Move two characters to WORD1X
	C
0033	        DO 40 IX1 = 1, 2
0034	        CALL CPUT(WORD1X, IX1, INPUT(I))
0035	        I=I+1
0036	        IF(I.GT.20)GOTO 100
0037	        IF(INPUT(I).EQ.32)GOTO 50
0040	40      CONTINUE
	
	C
	C Find next nonblank
	C
0041	50      I = I + 1
0042	        IF(I.GT.20) GOTO 100
0043	        IF (INPUT(I).EQ. 32)GOTO 50
	
	C
	C Move four to WORD2
	C
0044	        DO 60 IX1 = 1,4
0045	        CALL CPUT(WORD2, IX1, INPUT(I))
0046	        I = I + 1
0047	        IF (I.GT.20) GOTO 100
0050	        IF (INPUT(I).EQ. 32) GOTO 100
0051	60      CONTINUE
	C
	C Move to to WORD2X
	C
0052	        DO 70 IX1 = 1,2
0053	        CALL CPUT(WORD2X, IX1, INPUT(I))
0054	        I = I + 1
0055	        IF (I.GT.20) GOTO 100
0056	        IF(INPUT(I).EQ.32) GOTO 100
0057	70      CONTINUE
0060	100     IF (WORD2 .NE. ' ') RETURN
0061	        WORD2 = 0
0062	        WORD2X = 0
0063	        RETURN
0064	        END

---