Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/daboth.for
There are 2 other files named daboth.for in the archive. Click here to see a list.
SUBROUTINE DABOTH(INDEX,IFORMT,NAME,KNTLTR,NUMBER,
1IVALUE,LETTER,KOUNT,MAX)
C
C ROUTINE TO CREATE ARRAY NAMES WITH DIMENSION NUMBERS
C
C DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C INDEX = NEGATIVE OR 0, A SYMBOL CONTAINING AT LEAST
C -INDEX CHARACTERS IS PRODUCED IN LETTER
C ARRAY BY COPYING LOCATIONS 1 THRU KNTLTR OF
C NAME ARRAY AND INSERTING RIGHT BLANKS IF
C NECESSARY.
C = 1 OR GREATER, IS LENGTH OF SYMBOL TO BE
C OUTPUT IN LETTER ARRAY BY RIGHT JUSTIFYING
C DIGITS OF NUMBER AND MAKING LEFT CHARACTERS
C BE THOSE IN NAME ARRAY OR THE LETTER ZERO.
C IFORMT = -1, NO NUMBER IS GIVEN ENCLOSED IN
C PARENTHESES.
C = 0, IVALUE IS REPRESENTED ENCLOSED IN
C PARENTHESES TO RIGHT OF SYMBOL.
C = 1 OR GREATER, IVALUE IS REPRESENTED RIGHT
C JUSTIFIED IN A FIELD OF IFORMT LOCATIONS AND
C ENCLOSED IN PARENTHESES TO RIGHT OF SYMBOL.
C NAME = ALPHAMERIC ARRAY READ BY MULTIPLE OF A1
C FORMAT AND CONTAINING LETTERS OF SYMBOL.
C KNTLTR = NUMBER OF SYMBOL CHARACTERS IN NAME ARRAY.
C NUMBER = NUMBER TO BECOME PART OF SYMBOL IF INDEX=1
C OR GREATER.
C IVALUE = NUMBER TO FOLLOW SYMBOL IF IFORMT=1 OR
C GREATER.
C LETTER = ARRAY TO RECEIVE SYMBOL.
C KOUNT = NUMBER OF LOCATIONS OF LETTER ARRAY IN USE.
C MAX = MAXIMUM NUMBER OF LOCATIONS IN LETTER WHICH
C CAN BE FILLED.
C
DIMENSION LETTER(MAX),NAME(KNTLTR)
DATA IBLANK,IZERO,ILPR,IRPR/1H ,1H0,1H(,1H)/
C
C COPY SYMBOL WITHOUT RIGHT JUSTIFIED NUMBER
INIT=KOUNT
IF(INDEX)1,1,8
1 IF(KOUNT+KNTLTR-MAX)2,2,17
2 KOLUMN=0
3 IF(KOLUMN-KNTLTR)4,5,5
4 KOUNT=KOUNT+1
KOLUMN=KOLUMN+1
LETTER(KOUNT)=NAME(KOLUMN)
GO TO 3
5 IF(KOUNT-INDEX-KNTLTR-MAX)7,7,15
6 KOUNT=KOUNT+1
KOLUMN=KOLUMN+1
LETTER(KOUNT)=IBLANK
7 IF(KOLUMN+INDEX)6,13,13
C
C COPY SYMBOL WITH RIGHT JUSTIFIED NUMBER
8 KOLUMN=KOUNT+INDEX
IF(KOLUMN-MAX)9,9,17
9 LONG=KOUNT
CALL DANUMB(1,NUMBER,10,LETTER,KOUNT,KOLUMN,MAX)
KOLUMN=0
10 LONG=LONG+1
IF(LETTER(LONG).NE.IBLANK)GO TO 13
IF(KOLUMN-KNTLTR)12,11,11
11 LETTER(LONG)=IZERO
GO TO 10
12 KOLUMN=KOLUMN+1
LETTER(LONG)=NAME(KOLUMN)
GO TO 10
C
C INSERT NUMBER ENCLOSED IN PARENTHESES
13 IF(IFORMT)17,14,14
14 KOLUMN=KOUNT+IFORMT+1
CALL DANUMB(IFORMT,IVALUE,10,LETTER,KOUNT,KOLUMN,
1MAX-1)
IF(KOUNT-KOLUMN)15,16,16
15 KOUNT=INIT
GO TO 17
16 KOLUMN=KOLUMN-IFORMT
LETTER(KOLUMN)=ILPR
KOUNT=KOUNT+1
LETTER(KOUNT)=IRPR
C
C RETURN TO CALLING PROGRAM
17 RETURN
C353052349589
END