Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/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