Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50476/dabelt.for
There are 2 other files named dabelt.for in the archive. Click here to see a list.
      SUBROUTINE DABELT(KOLUMN,INTRVL,JSTIFY,LINE  ,ILEFT ,
     1    IRIGHT,LFTCOL,MAXBFR,IBUFFR,MAXLIN,MAXPRT,MAXUSD)
C     RENBR(/IDENTIFY COLUMN NUMBERS)
C
C     DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C     JAN 2, 1970 / LOGICAL IF VERSION JUL 26, 1975
C
C     WHEN A PROGRAM NEEDS TO DISPLAY TO THE USER A LINE OF
C     CHARACTERS  IN  WHICH  THE CHARACTERS ARE ORIENTED BY
C     COLUMNS, A BAND OF NUMBERS  IDENTIFYING  THE  COLUMNS
C     CAN  BE  PRINTED,  EITHER  ABOVE  OR  BELOW  THE MAIN
C     DISPLAY, BY CALLING THE DABELT  ROUTINE  TO  GENERATE
C     EACH LINE OF THE REPRESENTATION OF THE COLUMN NUMBERS
C     IN A BUFFER ARRAY WHICH THE CALLING PROGRAM CAN  THEN
C     PRINT  WITH  A  MULTIPLE  OF AN A1 FORMAT.  DABELT IS
C     CALLED AS MANY  TIMES  AS  THERE  ARE  LINES  IN  THE
C     REPRESENTATION  OF  THE  COLUMN  NUMBERS, THE CALLING
C     PROGRAM PRINTING THE RETURNED CHARACTERS BEFORE AGAIN
C     ASKING DABELT TO GENERATE THE NEXT LINE.
C
C     NUMBERS CAN BE GENERATED WITH  EACH  LINE  CONTAINING
C     DIGITS  CORRESPONDING  TO  SAME  POWER  OF  10  AS IN
C     FOLLOWING EXAMPLE
C
C                5432109876543210123456789012345
C                111111---------          111111
C                ------
C
C     OR  WITH  EACH  LINE  CONTAINING   DIGITS   OF   SAME
C     SIGNIFICANCE AS IN FOLLOWING EXAMPLE.
C
C                ---------------0123456789111111
C                111111987654321          012345
C                543210
C
C     NUMBERS  CAN  DECREASE  FROM  LEFT  TO  RIGHT  AS  IN
C     FOLLOWING EXAMPLE
C
C                5432109876543210123456789012345
C                111111          ---------111111
C                                         ------
C
C     AND  CAN  HAVE  ANY  DESIRED  SPACING  AND  INCREMENT
C     BETWEEN ADJACENT NUMBERS AS IN FOLLOWING EXAMPLE.
C
C         - - 0 1 2 3 4 5 6 7 8 9 1 1 1 1 1 1 1 1 1 1 2
C         2 1   0 0 0 0 0 0 0 0 0 0 1 2 3 4 5 6 7 8 9 0
C         0 0   0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
C         0 0                     0 0 0 0 0 0 0 0 0 0 0
C
C     FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED.
C
C     KOLUMN = NUMBER OF COLUMNS  TO  BE  USED  FOR  SINGLE
C              NUMBER.   IF  KOLUMN IS GREATER THAN 1, THEN
C              KOLUMN-1 COLUMNS OF SPACES WILL BE  INSERTED
C              BETWEEN   NUMBERS.   NO  EXTRA  SPACES  WILL
C              APPEAR TO RIGHT  OF  RIGHT  NUMBER  EVEN  IF
C              KOLUMN  IS  GREATER THAN 1.  EFFECTIVE VALUE
C              OF KOLUMN IS 1 IF KOLUMN IS INPUT LESS  THAN
C              OR EQUAL TO ZERO.
C
C     INTRVL = DIFFERENCE BETWEEN  ADJACENT  NUMBERS  WHICH
C              ARE  TO  BE REPRESENTED IN IBUFFR ARRAY.  IF
C              SIGN OF INTRVL  IS  WRONG  TO  PROCEED  FROM
C              ILEFT  TO  IRIGHT,  THEN  SIGN  OF EFFECTIVE
C              VALUE OF INTRVL IS REVERSED,  BUT  SIGN  AND
C              VALUE   OF   ARGUMENT  SUPPLIED  BY  CALLING
C              PROGRAM ARE LEFT UNCHANGED.  EFFECTIVE VALUE
C              OF  INTRVL  IS 1 IF INTRVL IS INPUT EQUAL TO
C              ZERO.
C
C     JSTIFY = 0,  EACH   LINE   IS   TO   CONTAIN   DIGITS
C              CORRESPONDING  TO  SAME  POWER  OF  10 AS IN
C              FIRST EXAMPLE AT START OF  DOCUMENTATION  OF
C              THIS  ROUTINE.   LINE  EQUAL  TO  1  SELECTS
C              DIGITS OF LOWEST  SIGNIFICANCE  IN  NUMBERS.
C              LINE  EQUAL  TO  MAXLIN  WILL  SELECT EITHER
C              MINUS SIGN OR DIGITS OF HIGHEST SIGNIFICANCE
C              IF  POSITIVE  IN NUMBER OR NUMBERS REQUIRING
C              MOST CHARACTERS TO REPRESENT.
C            = 1, EACH LINE IS TO CONTAIN  DIGITS  OF  SAME
C              SIGNIFICANCE  AS  IN SECOND EXAMPLE AT START
C              OF  DOCUMENTATION  OF  THIS  ROUTINE.   LINE
C              EQUAL 1 SELECTS EITHER MINUS SIGNS OR DIGITS
C              OF  HIGHEST  SIGNIFICANCE  IF  POSITIVE   IN
C              NUMBERS.   LINE  EQUAL TO MAXLIN WILL SELECT
C              DIGITS OF LOWEST SIGNIFICANCE IN  NUMBER  OR
C              NUMBERS   REQUIRING   MOST   CHARACTERS   TO
C              REPRESENT.
C
C     LINE   = SELECTS  WHICH  LINE  OF  REPRESENTATION  OF
C              NUMBERS  IS TO BE CONSTRUCTED.  LINE EQUAL 1
C              WILL SELECT DIGITS OF LOWEST SIGNIFICANCE IF
C              JSTIFY  IS ZERO, OR MINUS SIGNS OR DIGITS OF
C              HIGHEST SIGNIFICANCE OF POSITIVE NUMBERS  IF
C              JUSTIFY EQUALS 1.  LINE EQUAL TO MAXLIN WILL
C              SELECT MINUS  SIGNS  OR  DIGITS  OF  HIGHEST
C              SIGNIFICANCE   IF   POSITIVE  OF  NUMBER  OR
C              NUMBERS   REQUIRING   MOST   CHARACTERS   TO
C              REPRESENT  IF  JSTIFY  IS ZERO, OR DIGITS OF
C              LOWEST SIGNIFICANCE  OF  NUMBER  OR  NUMBERS
C              REQUIRING  MOST  CHARACTERS  TO REPRESENT IF
C              JSTIFY EQUALS 1.  MAXPRT AND MAXUSD ARE BOTH
C              RETURNED  EQUAL  TO INPUT VALUE OF LFTCOL IF
C              LINE IS INPUT GREATER THAN MAXLIN.
C
C              FOLLOWING EXAMPLES ILLUSTRATE DEFINITION  OF
C              LINE FOR JSTIFY EQUAL TO BOTH ZERO AND ONE.
C
C              KOLUMN= 2, INTRVL=75, JSTIFY= 0, ILEFT=-1052
C              LINE=1   2 7 2 7 2 7 2 7 2 7 2 7 2 7 2 3 8 3
C              LINE=2   5 7 0 2 5 7 0 2 5 7 0 2 5 7 - 7 4 2
C              LINE=3   0 9 9 8 7 6 6 5 4 3 3 2 1 -     1 2
C              LINE=4   1 - - - - - - - - - - - -
C              LINE=5   -
C              LINE=6
C
C              KOLUMN= 2, INTRVL=75, JSTIFY= 1, ILEFT=-1052
C              LINE=1   - - - - - - - - - - - - - - - 7 1 2
C              LINE=2   1 9 9 8 7 6 6 5 4 3 3 2 1 7 2 3 4 2
C              LINE=3   0 7 0 2 5 7 0 2 5 7 0 2 5 7     8 3
C              LINE=4   5 7 2 7 2 7 2 7 2 7 2 7 2
C              LINE=5   2
C              LINE=6
C
C              SINCE EFFECTIVE VALUE OF MAXLIN IS NOT KNOWN
C              PRIOR  TO  FIRST  CALL TO THIS ROUTINE, LINE
C              CAN BE SET TO ZERO TO REPRESENT SAME LINE AS
C              IF LINE WAS INPUT EQUAL TO RETURNED VALUE OF
C              MAXLIN.   LINE  IS  RETURNED  UNCHANGED,  SO
C              CALLING  PROGRAM  WOULD IN THIS CASE HAVE TO
C              SET LINE EQUAL TO RETURNED VALUE OF MAXLIN-1
C              PRIOR TO SECOND CALL TO THIS ROUTINE.
C
C     ILEFT  = THE LEFT OR FIRST NUMBER TO BE REPRESENTED.
C
C     IRIGHT = THE RIGHT OR FINAL LIMIT OF  NUMBERS  TO  BE
C              REPRESENTED.   UNLIKE  ILEFT WHICH IS ALWAYS
C              REPRESENTED, IRIGHT IS REPRESENTED  ONLY  IF
C              BUFFER  IS  LARGE  ENOUGH TO INCLUDE NUMBERS
C              THROUGH IRIGHT PLUS EXTRA SPACES  IF  KOLUMN
C              IS  GREATER  THAN  1, AND IF IRIGHT-ILEFT IS
C              EXACTLY WHOLE NUMBER MULTIPLE OF INTRVL.  IF
C              IRIGHT-ILEFT  IS  NOT  EXACTLY  WHOLE NUMBER
C              MULTIPLE OF INTRVL,  THEN  RIGHTMOST  NUMBER
C              WHICH  COULD  BE  REPRESENTED  IF  BUFFER IS
C              LARGE ENOUGH IS NUMBER WHICH IS NEXT SMALLER
C              WHOLE NUMBER MULTIPLE TO RIGHT OF ILEFT.
C
C     LFTCOL = THE SUBSCRIPT OF IBUFFR  ARRAY  LOCATION  TO
C              IMMEDIATE  LEFT OF LOCATION INTO WHICH IS TO
C              BE   PLACED   DIGIT    OR    SIGN    FORMING
C              REPRESENTATION  UPON  CURRENT  LINE  OF LEFT
C              NUMBER.
C
C     MAXBFR = SUBSCRIPT  OF  HIGHEST  LOCATION  IN  IBUFFR
C              ARRAY    INTO    WHICH    CAN    BE   PLACED
C              REPRESENTATIONS  OF   NUMBERS   FROM   ILEFT
C              THROUGH  IRIGHT.   THIS  WOULD  NORMALLY  BE
C              DIMENSION OF IBUFFR ARRAY.
C
C     FOLLOWING ARGUMENTS ARE USED FOR OUTPUT.  THEIR INPUT
C     VALUES ARE IGNORED.
C
C     IBUFFR = ARRAY IN WHICH NUMBERS ARE TO BE REPRESENTED
C              AND  WHICH  CAN  THEN  BE PRINTED BY CALLING
C              PROGRAM USING MULTIPLE OF A1 FORMAT.
C
C     MAXLIN = RETURNED CONTAINING NUMBER OF  LINES  NEEDED
C              TO  REPRESENT  NUMBERS ILEFT THROUGH IRIGHT.
C              ACTUAL NUMBER OF LINES WHICH  WOULD  INCLUDE
C              PRINTING  CHARACTERS MAY BE LESS SINCE RIGHT
C              NUMBER ACTUALLY DISPLAYED CAN REQUIRE  FEWER
C              CHARACTERS FOR ITS REPRESENTATION THAN WOULD
C              IRIGHT.
C
C     MAXPRT = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION IN IBUFFR ARRAY CONTAINING PRINTING
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              CURRENT  CALL  TO THIS ROUTINE HAS NOT ADDED
C              ANY  PRINTING  CHARACTERS  TO  IBUFFR,  THEN
C              MAXPRT WILL BE RETURNED EQUAL TO LFTCOL.
C
C     MAXUSD = RETURNED  CONTAINING  SUBSCRIPT   OF   RIGHT
C              LOCATION  IN  IBUFFR  ARRAY  CONTAINING  ANY
C              CHARACTER GENERATED  BY  THIS  ROUTINE.   IF
C              LINE  IS  LESS THAN OR EQUAL TO MAXLIN, THEN
C              MAXUSD WILL BE RETURNED EQUAL  TO  VALUE  OF
C              MAXPRT  WHICH  WOULD BE RETURNED IF LINE WAS
C              INPUT  AS  1.   SINCE   RIGHTMOST   PRINTING
C              CHARACTER  GENERATED BY CURRENT CALL TO THIS
C              ROUTINE CAN BE TO LEFT OF THAT GENERATED  IF
C              LINE  IS  1,  ARRAY  LOCATIONS  STARTING  AT
C              IBUFFR(MAXPRT+1) THROUGH IBUFFR(MAXUSD) WILL
C              CONTAIN  SPACES.   IF  LINE  IS GREATER THAN
C              RETURNED VALUE OF  MAXLIN,  THEN  MAXUSD  IS
C              RETURNED EQUAL TO LFTCOL.
C
      DIMENSION IBUFFR(MAXBFR),IDGT(10)
      DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ISPACE,IMINUS/1H ,1H-/
C
C     FIND OUT WHICH DIRECTION TO TRAVEL
      MAXUSD=LFTCOL
      MAXPRT=LFTCOL
      JNCRMT=INTRVL
      IF(JNCRMT.LT.0)JNCRMT=-JNCRMT
      IF(JNCRMT.EQ.0)JNCRMT=1
      IF(ILEFT.GT.IRIGHT)JNCRMT=-JNCRMT
      INCRMT=INTRVL
      IF(INCRMT.LT.0)INCRMT=-INCRMT
      IF(INCRMT.LE.0)INCRMT=1
C
C     FIND LIMITING VALUE OF INTERVAL
      IF(ILEFT.LE.IRIGHT)GO TO 2
      IF(IRIGHT.GE.0)GO TO 1
      ITEST=-10*IRIGHT
      IF(ILEFT.LE.ITEST)GO TO 4
    1 ITEST=ILEFT
      GO TO 4
    2 IF(ILEFT.GE.0)GO TO 3
      ITEST=-10*ILEFT
      IF(IRIGHT.LE.ITEST)GO TO 4
    3 ITEST=IRIGHT
C
C     FIND INTERVAL CORRESPONDING TO LINE NUMBER
    4 IPWR10=1
      MAXLIN=0
    5 MAXLIN=MAXLIN+1
      IF(LINE.EQ.MAXLIN)IUSE=IPWR10
      IPWR10=10*IPWR10
      IF(IPWR10.LE.ITEST)GO TO 5
C
C     DETERMINE IF LINE NUMBER IS IN PROPER RANGE
      IF(LINE.GT.MAXLIN)GO TO 38
C
C     INITIAL CONDITIONS
      ITOTAL=ILEFT
      IPOSN=LFTCOL
      LEVEL=LINE
      IF(LINE.GT.0)GO TO 6
      IUSE=IPWR10/10
      LEVEL=MAXLIN
    6 IF(JSTIFY.GT.0)GO TO 26
C
C     DETERMINE HOW MANY TIMES FIRST DIGIT APPEARS
    7 LIMIT=ITOTAL
      IF(LIMIT.LT.0)LIMIT=-LIMIT
      LIMIT=LIMIT/IUSE
      IF(ILEFT.GT.IRIGHT)GO TO 8
      JUSE=IUSE
      IF(ITOTAL.LT.0)GO TO 10
      LIMIT=(JUSE*LIMIT)+IUSE-1
      GO TO 9
    8 JUSE=-IUSE
      IF(ITOTAL.GT.0)GO TO 10
      LIMIT=(JUSE*LIMIT)-IUSE+1
    9 JDRCTN=1
      GO TO 11
   10 LIMIT=-(JUSE*LIMIT)
      JDRCTN=-1
   11 IADD=1
      IF(IUSE.LE.INCRMT)IADD=INCRMT/IUSE
      IADD=JUSE*IADD
      GO TO 33
C
C     PUT IN DIGITS OR SPACES OR MINUS SIGNS
   12 IF(ILEFT.LE.IRIGHT)GO TO 13
      IF(LIMIT.LT.IRIGHT)LIMIT=IRIGHT
      GO TO 14
   13 IF(LIMIT.GT.IRIGHT)LIMIT=IRIGHT
   14 IF(ILEFT.LE.IRIGHT)GO TO 15
      IF(ITOTAL.GE.LIMIT)GO TO 16
      IF(ITOTAL.LT.IRIGHT)GO TO 38
      GO TO 27
   15 IF(ITOTAL.LE.LIMIT)GO TO 16
      IF(ITOTAL.GT.IRIGHT)GO TO 38
      GO TO 27
   16 IF(IPOSN.GE.MAXBFR)GO TO 38
      IPOSN=IPOSN+1
      IF(JSTIFY.LE.0)GO TO 18
      IF(LEVEL.NE.1)GO TO 17
      IF(ITOTAL.LT.0)GO TO 19
      IF(ITOTAL.EQ.0)INDEX=1
      GO TO 22
   17 IF(IUSE.LE.0)GO TO 21
      GO TO 22
   18 IF(IUSE.EQ.1)GO TO 22
      IF(ITOTAL.GE.0)GO TO 20
      IF(ITOTAL.LE.-IUSE)GO TO 22
      IF(ITOTAL.GT.-(IUSE/10))GO TO 21
   19 IBUFFR(IPOSN)=IMINUS
      GO TO 23
   20 IF(ITOTAL.GE.IUSE)GO TO 22
   21 IBUFFR(IPOSN)=ISPACE
      GO TO 24
   22 IBUFFR(IPOSN)=IDGT(INDEX)
   23 MAXPRT=IPOSN
   24 MAXUSD=IPOSN
      JSPACE=KOLUMN
      ITOTAL=ITOTAL+JNCRMT
   25 IF(IPOSN.GE.MAXBFR)GO TO 38
      JSPACE=JSPACE-1
      IF(JSPACE.LE.0)GO TO 14
      IPOSN=IPOSN+1
      IBUFFR(IPOSN)=ISPACE
      GO TO 25
C
C     FIND NEXT POWER OF 10 IF JSTIFY IS GREATER THAN ZERO
   26 LUSE=10*IUSE
      KUSE=IUSE
      GO TO 28
   27 IF(JSTIFY.LE.0)GO TO 31
   28 ITEST=ITOTAL
      IF(ITEST.LT.0)ITEST=-10*ITEST
      IF(ITEST.LT.KUSE)GO TO 30
      ITEST=ITEST/LUSE
      IUSE=1
   29 IF(IUSE.GT.ITEST)GO TO 7
      IUSE=10*IUSE
      GO TO 29
   30 IUSE=0
      LIMIT=ITOTAL
      GO TO 12
C
C     GET LIMIT IF JSTIFY EQUALS ZERO
   31 LIMIT=LIMIT+IADD
      IF(JDRCTN.GE.0)GO TO 33
      IF(ILEFT.LE.IRIGHT)GO TO 32
      IF(ITOTAL.GT.0)GO TO 35
      IF(IADD.NE.-1)LIMIT=LIMIT+1
      JDRCTN=1
      GO TO 34
   32 IF(ITOTAL.LT.0)GO TO 34
      IF(IADD.NE.1)LIMIT=LIMIT-1
      JDRCTN=1
      GO TO 35
C
C     GET NEXT DIGIT TO DISPLAY
   33 IF(ITOTAL.GE.0)GO TO 35
   34 INDEX=-ITOTAL/IUSE
      GO TO 36
   35 INDEX=ITOTAL/IUSE
   36 IF(INDEX.LE.9)GO TO 37
      I=INDEX/10
      INDEX=INDEX-(10*I)
   37 INDEX=INDEX+1
      GO TO 12
C
C     RETURN TO CALLING PROGRAM
   38 RETURN
C830889848930
      END