Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/dajoin.for
There are 2 other files named dajoin.for in the archive. Click here to see a list.
      SUBROUTINE DAJOIN(ITRAIL,IBUFFR,MAXBFR,LOWBFR,KIND  ,
     1    VALUE ,DIVISR,ISHIFT,JSHIFT)
C     RENBR(/EVALUATE FRACTIONS AND MIXED NUMBERS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS ROUTINE EVALUATES THE WHOLE  NUMBERS,  FRACTIONS
C     AND  MIXED  NUMBERS  CONTAINED IN A LINE OF TEXT READ
C     WITH A MULTIPLE OF AN A1 FORMAT.  IF THE FRACTION  OR
C     MIXED  NUMBER  IS  TO  BE MULTIPLED BY 10.0 RAISED TO
C     SOME POWER, THEN THIS EXPONENT  MUST  APPEAR  TO  THE
C     IMMEDATE  RIGHT  OF  THE DENOMINATOR OF THE FRACTION.
C     THE TEXT CONTENTS 1 1/2K OR 1.5K OR  3/2K  WOULD  ALL
C     REPRESENT THE VALUE 1500.
C
C     FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT  AND  ARE
C     RETURNED UNCHANGED.
C
C     ITRAIL = SELECTS  WHETHER   EXPONENTS   ARE   TO   BE
C              RECOGNIZED.   IF  EXPONENTS  ARE  NOT  TO BE
C              RECOGNIZED  BUT  EXPONENT  IS  FOUND,   THEN
C              EVALUATION  OF CONTENTS OF INPUT TEXT BUFFER
C              WILL BE TERMINATED  PRIOR  TO  EXPONENT  AND
C              FIRST  CHARACTER OF EXPONENT WILL BE TREATED
C              SAME  AS  ANY   OTHER   UNKNOWN   ALPHABETIC
C              CHARACTER.   WHEN  SUCH UNKNOWN CHARACTER IS
C              FOUND, KIND IS  RETURNED  CONTAINING  2  AND
C              LOWBFR   IS  RETURNED  POINTING  TO  UNKNOWN
C              CHARACTER.
C            = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C              BE  RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C              K AND M ARE TO BE TREATED SAME AS ANY  OTHER
C              ALPHABETIC CHARACTERS.
C            = 0,  NO  EXPONENTS  ARE  TO  BE   RECOGNIZED.
C              EVALUATION   WILL  BE  TERMINATED  PRIOR  TO
C              PERCENT SIGNS OR TO LETTERS E OR K OR M.
C            = 1, PERCENT  SIGNS,  LETTERS  K  AND  M,  AND
C              EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C              BE RECOGNIZED.
C     IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS  OF
C              LINE   OF   TEXT   TO  BE  INTERPRETED,  ONE
C              CHARACTER PER ARRAY  LOCATION,  AS  READ  BY
C              MULTIPLE OF A1 FORMAT.
C     MAXBFR = SUBSCRIPT   OF   IBUFFR    ARRAY    LOCATION
C              CONTAINING   RIGHTMOST  (HIGHEST  SUBSCRIPT)
C              CHARACTER IN LINE OF TEXT BEING INTERPRETED.
C              MAXBFR WOULD NORMALLY BE DIMENSION OF IBUFFR
C              ARRAY.
C
C     FOLLOWING ARGUMENT IS USED BOTH  FOR  INPUT  TO  THIS
C     ROUTINE AND FOR OUTPUT TO CALLING PROGRAM.
C
C     LOWBFR = INPUT CONTAINING SUBSCRIPT OF  IBUFFR  ARRAY
C              LOCATION  WHICH  CONTAINS  LEFTMOST  (LOWEST
C              SUBSCRIPT)  CHARACTER   WHICH   IS   TO   BE
C              INTERPRETED  BY  THIS  ROUTINE.   LOWBFR  IS
C              RETURNED POINTING TO LEFTMOST CHARACTER  NOT
C              YET  IDENTIFIED BY THIS ROUTINE.  IF KIND IS
C              RETURNED  CONTAINING  3  OR  GREATER,   THEN
C              LOWBFR  IS RETURNED POINTING TO CHARACTER TO
C              IMMEDIATE RIGHT OF REPRESENTATION OF NUMBER.
C              IF  KIND  IS  RETURNED  CONTAINING  2,  THEN
C              LOWBFR IS  RETURNED  POINTING  TO  CHARACTER
C              WHICH  COULD  NOT  BE EVALUATED.  IF KIND IS
C              RETURNED  CONTAINING  1,  THEN   LOWBFR   IS
C              RETURNED POINTING BEYOND END OF BUFFER.
C
C     FOLLOWING ARGUMENTS ARE USED FOR OUTPUT ONLY.   THEIR
C     INPUT VALUES ARE IGNORED.
C
C     KIND   = 1, NO PRINTING CHARACTERS APPEARED AT OR  TO
C              THE  RIGHT  OF  IBUFFR(LOWBFR).   LOWBFR  IS
C              RETURNED POINTING BEYOND END OF BUFFER.
C            = 2, UNKNOWN CHARACTER WAS FOUND.   LOWBFR  IS
C              RETURNED   CONTAINING  SUBSCRIPT  OF  IBUFFR
C              ARRAY  LOCATION  CONTAINING   THIS   UNKNOWN
C              CHARACTER.  LOWBFR MUST BE INCREMENTED BY AT
C              LEAST 1 BEFORE THIS ROUTINE IS AGAIN  CALLED
C              TO CONTINUE PROCESSING OF TEXT.
C            = 3,  WHOLE  NUMBER  WAS  FOUND.   LOWBFR   IS
C              RETURNED  POINTING TO CHARACTER TO IMMEDIATE
C              RIGHT OF REPRESENTATION OF WHOLE NUMBER.
C            = 4, MIXED NUMBER CONSISTING OF  WHOLE  NUMBER
C              FOLLOWED  BY  UNSIGNED  FRACTION  WAS FOUND.
C              LOWBFR IS RETURNED POINTING TO CHARACTER  TO
C              IMMEDIATE   RIGHT   OF   REPRESENTATION   OF
C              FRACTION.
C            = 5, FRACTION WAS FOUND.  LOWBFR  IS  RETURNED
C              POINTING  TO CHARACTER TO IMMEDIATE RIGHT OF
C              REPRESENTATION OF FRACTION.
C            = 6, MIXED NUMBER OR  FRACTION  WAS  FOUND  IN
C              WHICH  RIGHTMOST  DENOMINATOR  WAS  MISSING.
C              LOWBFR IS RETURNED POINTING TO CHARACTER  TO
C              RIGHT OF RIGHTMOST SLASH.
C     VALUE  = RETURNED CONTAINING VALUE OF  WHOLE  NUMBER,
C              OR  MIXED  NUMBER  OR  FRACTION  IF  KIND IS
C              RETURNED CONTAINING 3  OR  GREATER.   VALUE,
C              DIVISR,   ISHIFT  AND  JSHIFT  ARE  RETURNED
C              UNDEFINED IF KIND IS RETURNED  CONTAINING  1
C              OR 2.
C     DIVISR = RETURNED CONTAINING VALUE OF DENOMINATOR  IF
C              FRACTION OR MIXED NUMBER IS FOUND.  RETURNED
C              SET TO 1 IF WHOLE NUMBER IS FOUND.
C     ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C              M FOLLOW NUMBER
C            = 1, PERCENT SIGN FOLLOWS NUMBER
C            = 2, K FOLLOWS NUMBER
C            = 3, M FOLLOWS NUMBER
C            = LESS  THAN  ZERO,  RETURNED  IF  E   FOLLOWS
C              NUMBER.
C            = -1, E  AND  POSSIBLY  SIGNED  NUMBER  FOLLOW
C              NUMBER.
C            = -2, E IS FOLLOWED BY PLUS SIGN NOT  IN  TURN
C              FOLLOWED BY DIGITS.
C            = -3, E IS FOLLOWED BY MINUS SIGN NOT IN  TURN
C              FOLLOWED BY DIGITS.
C            = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C     JSHIFT = EXPONENT  INDICATED  BY  FOLLOWING   PERCENT
C              SIGN,  K, M OR E FOLLOWED BY DIGITS.  12.34K
C              OR 12.34E3 OR  12  34/100K  OR  12  34/100E3
C              WOULD  GIVE JSHIFT OF 3.  12% OR 12E-2 WOULD
C              GIVE JSHIFT -2.
C
      DIMENSION IBUFFR(MAXBFR)
C
C     ISPACE CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C     TAB CHARACTER.  IF TAB CHARACTER IS NOT AVAILABLE,
C     ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
      DATA MINUS,IPLUS,ISLASH,ISPACE,ITAB/
     11H-,1H+,1H/,1H ,1H	/
C
C     INITIALIZE
      INITAL=0
      LEVEL=0
      ISIGN=1
      KIND=1
      JTRAIL=10
      IF(ITRAIL.LT.0)JTRAIL=9
      IF(ITRAIL.GT.0)JTRAIL=11
      GO TO 3
C
C     *********************
C     *  SCAN FOR NUMBER  *
C     *********************
C
C     LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
    1 LEVEL=1
    2 LOWBFR=LOWBFR+1
    3 IF(LOWBFR.GT.MAXBFR)GO TO 12
      NOWLTR=IBUFFR(LOWBFR)
C
C     LOOK FOR LEADING SPACES, SIGNS OR SLASHES
      IF(LEVEL.NE.0)GO TO 5
      IF(NOWLTR.EQ.ISPACE)GO TO 2
      IF(NOWLTR.EQ.ITAB)GO TO 2
      IF(NOWLTR.EQ.ISLASH)GO TO 7
      IF(NOWLTR.EQ.IPLUS)GO TO 4
      IF(NOWLTR.NE.MINUS)GO TO 6
      ISIGN=-1
    4 IF(INITAL.NE.0)GO TO 12
      GO TO 6
    5 IF(NOWLTR.EQ.IPLUS)GO TO 12
      IF(NOWLTR.EQ.MINUS)GO TO 12
      IF(NOWLTR.EQ.ISPACE)GO TO 12
      IF(NOWLTR.EQ.ITAB)GO TO 12
      IF(NOWLTR.EQ.ISLASH)GO TO 2
C
C     EVALUATE NUMBER
    6 CALL DAHEFT(1,JTRAIL,0,IBUFFR,MAXBFR,
     1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
     2VALUE)
      IF(KIND.NE.3)GO TO 12
      KSHIFT=KSHIFT-JSHIFT
      IF(KSHIFT.NE.0)VALUE=VALUE*(10.0**KSHIFT)
C
C     MARK THAT ARE IN FRACTION IF FIND SLASH
      IF(ISHIFT.NE.0)GO TO 9
      IF(LOWBFR.GT.MAXBFR)GO TO 9
      IF(IBUFFR(LOWBFR).NE.ISLASH)GO TO 9
      IF(LEVEL.EQ.0)GO TO 8
      LEVEL=-1
      GO TO 10
    7 VALUE=0.0
    8 DIVISR=1.0
      FRACTN=VALUE
      GO TO 1
C
C     *******************************
C     *  NUMBER HAS BEEN EVALUATED  *
C     *******************************
C
C     DIVIDE FRACTION BY NEW DENOMINATOR
    9 IF(LEVEL.EQ.0)GO TO 11
   10 IF(LSHIFT.LE.0)VALUE=1.0
      DIVISR=VALUE
      FRACTN=FRACTN/VALUE
      IF(LEVEL.GT.0)GO TO 13
      GO TO 1
C
C     STORE WHOLE NUMBER AND LOOP BACK FOR FRACTION
   11 IF(INITAL.NE.0)GO TO 12
      IF(ISHIFT.NE.0)GO TO 19
      INITAL=ISIGN
      LOWSAV=LOWBFR
      WHOLE=VALUE
      GO TO 3
C
C     COMBINE WHOLE NUMBER AND FRACTION
   12 ISHIFT=0
      JSHIFT=0
      IF(LEVEL.EQ.0)GO TO 18
      KIND=6
      IF(INITAL.EQ.0)GO TO 17
      GO TO 14
   13 IF(INITAL.EQ.0)GO TO 16
      KIND=4
   14 IF(INITAL.GT.0)GO TO 15
      VALUE=WHOLE-FRACTN
      GO TO 20
   15 VALUE=WHOLE+FRACTN
      GO TO 20
   16 KIND=5
   17 VALUE=FRACTN
      GO TO 20
   18 IF(INITAL.EQ.0)GO TO 21
      LOWBFR=LOWSAV
      VALUE=WHOLE
   19 KIND=3
      DIVISR=1.0
   20 IF(JSHIFT.NE.0)VALUE=VALUE*(10.0**JSHIFT)
      GO TO 22
C
C     SIMULATE NUMBER IF NONE FOUND
   21 VALUE=0.0
      DIVISR=1.0
C
C     RETURN TO CALLING PROGRAM
   22 RETURN
C     INITAL = 0, NO WHOLE NUMBER STORED
C            = -1, NEGATIVE WHOLE NUMBER STORED
C            = 1, POSITIVE WHOLE NUMBER STORED
C     ISIGN  = -1, MINUS SIGN AT START OF NUMBER
C            = 1, NUMBER DOES NOT START WITH MINUS SIGN
C     LEVEL  = 0, A SLASH HAS NOT BEEN FOUND.
C            = 1, THE NUMERATOR OF FRACTION HAS BEEN
C              STORED AND NEED TO GET DENOMINATOR.
C            = -1, A SLASH APPEARS AT RIGHT OF THE
C              DENOMINATOR OF THE FRACTION SO NEED
C              TO CALCULATE NEW NUMERATOR AND THEN
C              GO BACK TO LEVEL=1 STATE.
C510407084164
      END