Google
 

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