Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/getnum.for
There are 4 other files named getnum.for in the archive. Click here to see a list.
SUBROUTINE GETNUM(KONTRL,IBUFFR,MAXBFR,LOWBFR,KIND ,
1 IVALUE,VALUE )
C RENBR(/GET NEXT NUMBER IN SINGLE LINE)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C KONTRL = 0, RETURN INTEGER AS ARGUMENT IVALUE
C = 1, RETURN REAL NUMBER IN ARGUMENT VALUE
C IBUFFR = TEXT TYPED BY USER READ WITH MULTIPLE OF A1
C FORMAT
C MAXBFR = NUMBER OF CHARACTERS IN IBUFFR
C LOWBFR = INITIALLY SHOULD BE INPUT CONTAINING ZERO
C TO ALLOW INITIAL COMMA TO INDICATE MISSING
C ITEM. THEREAFTER SHOULD BE INPUT CONTAINING
C SUBSCRIPT OF NEXT LOCATION IN IBUFFR ARRAY
C WHICH IS TO BE EXAMINED.
C = RETURNED POINTING TO NEXT CHARACTER NOT YET
C EXAMINED.
C KIND = 1, LINE IS EMPTY
C = 2, ERROR MESSAGE TYPED TO USER
C = 3, MISSING NUMBER
C = 4, A NUMBER HAS BEEN EVALUATED
C IVALUE = RETURNED CONTAINING INTEGER VALUE IF
C KONTRL=0
C VALUE = RETURNED CONTAINING REAL VALUE IF KONTRL=1
C
DIMENSION IBUFFR(MAXBFR)
DATA IWHAT/1H?/
DATA ITTY/5/
C
C OBTAIN NEXT ITEM IN TEXT BUFFER
MANY=1
IF(LOWBFR.GT.0)GO TO 1
LOWBFR=1
MANY=0
1 LOCK=MANY
CALL DAMISS(KONTRL,1,0,IBUFFR,MAXBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE,MANY,LCNBFR,LCNERR)
GO TO(5,12,6,6,2,4,14),KIND
C
C TREAT SEMICOLON LIKE COMMA
2 IF(LOCK.EQ.0)GO TO 3
MANY=-1
GO TO 1
3 LOWBFR=LOWBFR-1
GO TO 14
C
C BUFFER IS EMPTY
4 IF(MANY.LT.0)GO TO 14
5 KIND=1
GO TO 15
C
C NUMBER FOUND
6 IF(LSHIFT.LT.0)GO TO 8
IF(KONTRL.GT.0)GO TO 7
IF(KSHIFT.LT.0)GO TO 10
7 KIND=4
GO TO 15
C
C ILLEGAL NUMBER REPRESENTATION
8 LOWBFR=LCNERR
LCNERR=LCNERR-1
WRITE(ITTY,9)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
9 FORMAT(' NUMBER REQUIRED BUT NO VALUE DIGITS IN ',
1132A1)
KIND=2
GO TO 15
10 LOWBFR=LCNERR
LCNERR=LCNERR-1
WRITE(ITTY,11)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
11 FORMAT(' INTEGER REQUIRED BUT TENTHS SPECIFIED IN ',
1132A1)
KIND=2
GO TO 15
C
C UNKNOWN INITIAL CHARACTER
12 LOWBFR=LCNERR
LCNERR=LCNERR-1
WRITE(ITTY,13)IWHAT,(IBUFFR(I),I=LCNBFR,LCNERR),IWHAT
13 FORMAT(' NUMBER EXPECTED BUT INSTEAD FOUND ',132A1)
KIND=2
GO TO 15
C
C MISSING NUMBER
14 KIND=3
C
C RETURN TO CALLING PROGRAM
15 RETURN
C372999423353?'
END