Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/datrek.for
There are 2 other files named datrek.for in the archive. Click here to see a list.
SUBROUTINE DATREK(LOWVLU,MAXVLU,MAXBFR,IBUFFR,LOWBFR,
1 KIND ,IVALUE,KNTVLU)
C RENBR(/EVALUATE INTEGER SERIES OF FORM 1.2.3)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C ROUTINE TO EVALUATE SERIES OF UNSIGNED INTEGERS
C SEPARATED BY PERIODS. VALUE OF -1 IS RETURNED FOR A
C MISSING INTEGER INDICATED BY AN INITIAL PERIOD, BY A
C TRAILING PERIOD, OR BY 2 ADJACENT PERIODS. SIGNS AND
C EXPONENTS ARE NOT RECOGNIZED.
C
C LOWVLU = SUBSCRIPT OF LOWEST LOCATION IN IVALUE ARRAY
C WHICH CAN BE USED TO RETURN VALUES IN SERIES
C MAXVLU = SUBSCRIPT OF HIGHEST LOCATION IN IVALUE
C ARRAY WHICH CAN BE USED TO RETURN VALUES IN
C SERIES
C MAXBFR = SUBSCRIPT OF LOCATION IN IBUFFR ARRAY
C CONTAINING FINAL CHARACTER TO BE EVALUATED
C IBUFFR = ARRAY CONTAINING IN LOCATIONS LOWBFR THROUGH
C MAXBFR THE CHARACTERS TO BE EVALUATED AS IF
C READ BY MULTIPLE OF A1 FORMAT OR BY SEVERAL
C 1H FIELDS
C LOWBFR = INPUT CONTAINING SUBSCRIPT OF FIRST LOCATION
C OF IBUFFR ARRAY CONTAINING CHARACTER TO BE
C EVALUATED
C = RETURNED CONTAINING SUBSCRIPT OF FIRST
C LOCATION IN IBUFFR ARRAY CONTAINING
C CHARACTER NOT YET EVALUATED BY THIS ROUTINE
C KIND = 1, RETURNED IF IBUFFR IS EMPTY OR CONTAINS
C ONLY BLANKS OR TABS. LOWBFR IS RETURNED
C CONTAINING MAXBFR+1
C = 2, RETURNED IF NUMBER NOT FOUND, BUT UNKNOWN
C CHARACTER IS LOCATED AT RETURNED VALUE OF
C LOWBFR
C = 3, RETURNED IF NUMBER OR SERIES OF NUMBERS
C WAS FOUND. LOWBFR IS RETURNED POINTING TO
C NEXT CHARACTER BEYOND END OF SERIES OF
C NUMBERS
C = 4, SAME AS KIND=3, EXCEPT IVALUE CONTAINS
C INSUFFICIENT SPACE TO STORE ALL THE VALUES
C ENCOUNTERED.
C IVALUE = ARRAY RETURNED CONTAINING EVALUATED NUMBERS
C IN LOCATIONS LOWVLU THROUGH RETURNED VALUE
C OF KNTVLU. A NUMBER INDICATED AS MISSING BY
C AN INITIAL OR TERMINAL PERIOD, OR BY 2
C ADJACENT PERIODS, IS INDICATED BY THE VALUE
C -1 BEING RETURNED IN IVALUE. NEGATIVE
C NUMBERS ARE NOT OTHERWISE RETURNED
C KNTVLU = RETURNED CONTAINING SUBSCRIPT OF HIGHEST
C LOCATION USED IN IVALUE ARRAY.
C
DIMENSION IBUFFR(MAXBFR),IVALUE(MAXVLU),IDIGIT(10)
DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA IDOT,IBLANK,ITAB/1H.,1H ,1H /
C
KNTVLU=LOWVLU-1
ISTATE=0
NEWVLU=0
GO TO 4
C
C PERIOD FOUND
1 IF(KNTVLU.GE.MAXVLU)GO TO 2
IF(ISTATE.LE.0)NEWVLU=-1
KNTVLU=KNTVLU+1
IVALUE(KNTVLU)=NEWVLU
2 NEWVLU=0
ISTATE=-1
C
C CHECK IF NEXT CHARACTER IS ALLOWED IN NUMBER SERIES
3 LOWBFR=LOWBFR+1
4 IF(LOWBFR.GT.MAXBFR)GO TO 7
LETTER=IBUFFR(LOWBFR)
IF(LETTER.EQ.IBLANK)GO TO 6
IF(LETTER.EQ.ITAB)GO TO 6
IF(LETTER.EQ.IDOT)GO TO 1
DO 5 I=1,10
IF(LETTER.NE.IDIGIT(I))GO TO 5
ISTATE=1
NEWVLU=(10*NEWVLU)+I-1
GO TO 3
5 CONTINUE
C
C UNKNOWN CHARACTER FOUND
IF(ISTATE.EQ.0)GO TO 9
C
C SPACE OR TAB CHARACTER FOUND
6 IF(ISTATE.EQ.0)GO TO 3
C
C END OF BUFFER
7 IF(ISTATE.EQ.0)GO TO 8
C
C END OF NUMBER SEQUENCE
IF(KNTVLU.GE.MAXVLU)GO TO 11
IF(ISTATE.LE.0)NEWVLU=-1
KNTVLU=KNTVLU+1
IVALUE(KNTVLU)=NEWVLU
GO TO 10
C
C RETURN TO CALLING PROGRAM
8 KIND=1
GO TO 12
9 KIND=2
GO TO 12
10 KIND=3
GO TO 12
11 KIND=4
12 RETURN
C309755265976
END