Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0050/datast.for
There is 1 other file named datast.for in the archive. Click here to see a list.
SUBROUTINE DATA(IDATA,KNTDAT,NAME,KNTLTR,
1IFORMT,MAXLTR,MAXLIN,IOUT)
C JUL 14, 1970
C DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C ROUTINE TO WRITE INTEGER DATA STATEMENTS
C
C IDATA = DATA ARRAY TO BE WRITTEN AS DATA STATEMENT
C KNTDAT = NUMBER OF ENTRIES IN DATA ARRAY
C NAME = ALPHAMERIC ARRAY CONTAINING NAME OF ARRAY
C (READ BY MULTIPLE OF A1 FORMAT)
C KNTLTR = NUMBER OF LETTERS IN NAME OF ARRAY
C IFORMT = 0, GIVES COMPACT FORMAT DATA STATEMENT
C = 1 OR GREATER, GIVES EXPANDED FORMAT AND IS
C MINIMUM LENGTH OF THE FIELD INTO WHICH
C EACH ENTRY IS PLACED IF ALL ENTRIES FIT THIS
C (IFORMT=10 IS EQUIVALENT TO I10 FORMAT)
C MAXLTR = NUMBER OF CHARACTERS TO BE IN STATEMENT FIELD
C (66 IF MAXIMUM, IE 72 MINUS LEFT 6 COLUMNS)
C MAXLIN = MAXIMUM NUMBER OF LINES FOR SINGLE STATEMENT
C IOUT = OUTPUT UNIT ON WHICH STATEMENT IS WRITTEN
C
DIMENSION IDATA(1),NAME(1),LETTER(66),ISTORE(200)
DATA IBLANK,ISLASH,KOMMA,ILPR,IRPR/
11H ,1H/,1H,,1H(,1H)/
C
C JSTORE = DIMENSION OF ISTORE ARRAY. THIS IS THE
C MAXIMUM NUMBER OF SMALL ARRAYS WHICH CAN
C BE USED TO REPRESENT THE IDATA ARRAY.
C
DATA JSTORE/200/
C
IF(KNTDAT)93,93,1
1 LOCK=1
MOST=0
MAX1=MAXLTR-1
MAX2=MAXLTR-2
LEFT=0
CALL DANUMB(0,KNTDAT,10,LETTER,LEFT,0,MAXLTR)
LENGTH=KNTLTR+LEFT
IF(LENGTH-6)3,3,2
2 LENGTH=6
3 IF(IFORMT)66,66,4
C
C PREPARE FOR EXPANDED FORMAT
4 MOST=IDATA(1)
LEAST=MOST
DO 5 INDEX=1,KNTDAT
IF(LEAST.GT.IDATA(INDEX))LEAST=IDATA(INDEX)
IF(MOST.LT.IDATA(INDEX))MOST=IDATA(INDEX)
5 CONTINUE
KOUNT=0
CALL DANUMB(0,MOST,10,LETTER,KOUNT,0,MAXLTR)
MOST=KOUNT
KOUNT=0
CALL DANUMB(0,LEAST,10,LETTER,KOUNT,0,MAXLTR)
IF(MOST-KOUNT)6,7,7
6 MOST=KOUNT
7 IF(MOST-IFORMT)8,9,9
8 MOST=IFORMT
9 LIMIT=MAXLIN*((MAXLTR-LENGTH-6)/(MOST+1))
IF(LIMIT)92,92,10
10 KNTPRT=1+((KNTDAT-1)/LIMIT)
IF(KNTPRT-JSTORE)11,11,91
11 LEAST=1
DO 12 INDEX=1,KNTPRT
ISTORE(INDEX)=LEAST
12 LEAST=LEAST+LIMIT
C
C TEST IF LABELS ARE OF MINIMUM LENGTH
13 ITEST=0
CALL DANUMB(0,ISTORE(KNTPRT),10,LETTER,ITEST,0,MAXLTR)
IF(KNTLTR+ITEST-LENGTH)14,15,15
14 LENGTH=KNTLTR+ITEST
IF(IFORMT)66,66,9
15 LOCK=0
IF(IFORMT)16,16,17
16 LEFT=0
ITEST=0
C
C CONSTRUCT SINGLE LINE OF DIMENSION STATEMENT
17 INDEX=0
DO 18 LEAST=1,10
18 LETTER(LEAST)=IBLANK
19 LINE=1
LAST=INDEX
20 KOUNT=10
21 IF(INDEX)22,22,26
C
C INSERT NAME OF MAIN ARRAY
22 IF(IFORMT)24,24,23
23 LIMIT=-LENGTH
GO TO 25
24 LIMIT=0
25 LEAST=KOUNT
CALL DAWORD(LIMIT,LEFT,NAME,KNTLTR,0,KNTDAT,LETTER,
1KOUNT,MAX1)
IF(KOUNT-LEAST)33,33,30
C
C INSERT NAME OF SMALL ARRAY
26 IF(INDEX-KNTPRT)28,27,27
27 LIMIT=KNTDAT-ISTORE(INDEX)+1
GO TO 29
28 LIMIT=ISTORE(INDEX+1)-ISTORE(INDEX)
29 LEAST=KOUNT
CALL DAWORD(LENGTH,LEFT,NAME,KNTLTR,ISTORE(INDEX),
1LIMIT,LETTER,KOUNT,MAX1)
IF(KOUNT-LEAST)31,31,30
30 INDEX=INDEX+1
KOUNT=KOUNT+1
LETTER(KOUNT)=KOMMA
IF(INDEX-KNTPRT)21,21,32
C
C OUTPUT SINGLE LINE OF DIMENSION STATEMENT
31 IF(LINE-MAXLIN)33,32,32
32 KOUNT=KOUNT-1
33 IF(LINE-1)34,34,37
34 IF(KOUNT-10)35,35,36
35 WRITE(IOUT,96)
GO TO 39
36 WRITE(IOUT,96)(LETTER(LEAST),LEAST=11,KOUNT)
GO TO 39
37 IF(KOUNT)92,92,38
38 WRITE(IOUT,99)MANY,(LETTER(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)40,40,39
39 MANY=1
40 IF(INDEX-KNTPRT)41,41,45
41 IF(LINE-MAXLIN)43,42,42
42 IF(INDEX-LAST)92,92,19
43 LINE=LINE+1
IF(IFORMT)44,44,20
44 KOUNT=0
GO TO 21
C
C CONSTRUCT SINGLE LINE OF EQUIVALENCE STATEMENT
45 INDEX=1
DO 46 LEAST=1,12
46 LETTER(LEAST)=IBLANK
47 LINE=1
LAST=INDEX
48 KOUNT=12
C
C INSERT NAME OF SMALL ARRAY
49 KOUNT=KOUNT+1
LEAST=KOUNT
CALL DAWORD(LENGTH,0,NAME,KNTLTR,ISTORE(INDEX),1,
1LETTER,KOUNT,MAX2)
IF(KOUNT-LEAST)52,52,50
C
C INSERT NAME OF MAIN ARRAY
50 KOUNT=KOUNT+1
LIMIT=KOUNT
CALL DAWORD(0,ITEST,NAME,KNTLTR,0,ISTORE(INDEX),
1LETTER,KOUNT,MAX2)
IF(KOUNT-LIMIT)52,52,51
51 LETTER(LEAST)=ILPR
LETTER(LIMIT)=KOMMA
KOUNT=KOUNT+1
LETTER(KOUNT)=IRPR
KOUNT=KOUNT+1
LETTER(KOUNT)=KOMMA
INDEX=INDEX+1
IF(INDEX-KNTPRT)49,49,53
C
C OUTPUT SINGLE LINE OF EQUIVALENCE STATEMENT
52 KOUNT=LEAST-1
IF(LINE-MAXLIN)54,53,53
53 KOUNT=KOUNT-1
54 IF(LINE-1)55,55,58
55 IF(KOUNT-12)56,56,57
56 WRITE(IOUT,97)
GO TO 60
57 WRITE(IOUT,97)(LETTER(LEAST),LEAST=13,KOUNT)
GO TO 60
58 IF(KOUNT)92,92,59
59 WRITE(IOUT,99)MANY,(LETTER(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)61,61,60
60 MANY=1
61 IF(INDEX-KNTPRT)62,62,66
62 IF(LINE-MAXLIN)64,63,63
63 IF(INDEX-LAST)92,92,47
64 LINE=LINE+1
IF(IFORMT)65,65,48
65 KOUNT=0
GO TO 49
C
C CONSTRUCT SINGLE LINE OF DATA STATEMENT
66 INDEX=1
KNTPRT=0
67 LINE=1
LAST=INDEX+1
KOUNT=5
68 LIMIT=KOUNT+MOST
69 LEAST=KOUNT
IF(LAST-INDEX)73,73,70
C
C INSERT NAME OF SMALL ARRAY
70 CALL DAWORD(LENGTH,-1,NAME,KNTLTR,INDEX,0,LETTER,KOUNT,
1MAX1)
IF(KOUNT-LEAST)77,77,71
71 LAST=INDEX
KOUNT=KOUNT+1
LETTER(KOUNT)=ISLASH
IF(KNTPRT-JSTORE)72,91,91
72 KNTPRT=KNTPRT+1
ISTORE(KNTPRT)=INDEX
GO TO 68
C
C INSERT INTEGER ENTRY
73 CALL DANUMB(IFORMT,IDATA(INDEX),10,LETTER,KOUNT,
1LIMIT,MAX1)
IF(KOUNT-LEAST)75,75,74
74 KOUNT=KOUNT+1
LETTER(KOUNT)=KOMMA
INDEX=INDEX+1
IF(INDEX-KNTDAT)68,68,76
C
C OUTPUT SINGLE LINE OF DATA STATEMENT
75 IF(LINE-MAXLIN)77,76,76
76 LETTER(KOUNT)=ISLASH
77 IF(LOCK)78,78,85
78 IF(LINE-1)79,79,82
79 IF(KOUNT-5)80,80,81
80 WRITE(IOUT,98)
GO TO 84
81 WRITE(IOUT,98)(LETTER(LEAST),LEAST=6,KOUNT)
GO TO 84
82 IF(KOUNT)92,92,83
83 WRITE(IOUT,99)MANY,(LETTER(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)85,85,84
84 MANY=1
85 IF(INDEX-KNTDAT)86,86,90
86 IF(LINE-MAXLIN)88,87,87
87 IF(INDEX-LAST)92,92,67
88 LINE=LINE+1
KOUNT=0
IF(IFORMT)68,68,89
89 LIMIT=6+LENGTH+MOST
GO TO 69
90 IF(LOCK)93,93,13
C
C RETURN TO CALLING PROGRAM
91 WRITE(IOUT,94)
GO TO 93
92 WRITE(IOUT,95)
93 RETURN
94 FORMAT(26H INCREASE ISTORE DIMENSION)
95 FORMAT(21H INSUFFICIENT STORAGE)
96 FORMAT(6X,10HDIMENSION ,66A1)
97 FORMAT(6X,12HEQUIVALENCE ,66A1)
98 FORMAT(6X,5HDATA ,61A1)
99 FORMAT(5X,1I1,66A1)
END
SUBROUTINE DAWORD(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 ARRAY
C BY COPYING LOCATIONS 1 THRU KNTLTR OF NAME
C ARRAY AND INSERTING RIGHT BLANKS IF 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 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 FORMAT
C AND CONTAINING THE LETTERS OF THE 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 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(1),NAME(1)
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,MAX-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
END
SUBROUTINE DANUMB(KONTRL,NUMBER,IRADIX,LETTER,
1KOUNT,LFTCOL,MAX)
C JAN 2, 1970
C SUBROUTINE TO PRINT NUMBERS HORIZONTALLY
C
C DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C
C KONTRL = 0 LEFT JUSTIFIES AT LFTCOL OR AT KOUNT+1
C IF KOUNT IS GREATER THAN LFTCOL.
C KONTRL = 1 RIGHT JUSTIFIES AT LFTCOL.
C NUMBER = NUMBER TO BE INSERTED.
C IRADIX = BASE TO WHICH NUMBER WILL BE EXPRESSED.
C LETTER = ALPHAMERIC BUFFER ARRAY TO BE CODED.
C KOUNT = NUMBER OF LOCATIONS IN LETTER IN USE.
C LFTCOL = LOCATION OF NEW NUMBER.
C LFTCOL = CHARACTERS LEFT OF NUMBER IF KONTRL = 0.
C LFTCOL = POSITION OF RIGHT DIGIT IF KONTRL = 1.
C MAX = DIMENSION OF LETTER ARRAY.
C
DIMENSION LETTER(130),IDGT(10)
DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA IBLANK,IMINUS/1H ,1H-/
C
C EVEN UP RIGHT MARGIN IF NEEDED
KSAVE=KOUNT
IF(LFTCOL-MAX)1,1,26
1 IF(KOUNT-MAX)2,26,26
2 IF(KONTRL)26,4,3
3 IF(KOUNT-LFTCOL)6,26,26
4 IF(KOUNT-LFTCOL)5,6,5
5 KOUNT=KOUNT+1
LETTER(KOUNT)=IBLANK
IF(KOUNT-LFTCOL)5,6,6
C
C SET INITIAL POINTERS
6 KNT=0
KEEP=KOUNT+1
IF(NUMBER)8,7,7
C
C POSITIVE NUMBER
7 NUMB=NUMBER
IF(KOUNT-MAX)12,25,25
C
C NEGATIVE NUMBER
8 IF(KEEP-MAX)9,25,25
9 KOUNT=KOUNT+1
LETTER(KOUNT)=IMINUS
C ABSOLUTE VALUE OF A NEGATIVE NUMBER IS DECREMENTED
C BY ONE SINCE, ON A TWO'S COMPLEMENT COMPUTER, THE
C ABSOLUTE VALUE OF THE LARGEST NEGATIVE NUMBER (SIGN
C BIT ON AND ALL OTHER BITS OFF) CANNOT BE REPRESENTED.
C THIS NUMBER CAN BE EASILY OBTAINED IF SIGN BIT IS
C USED FOR STORING INFORMATION IN SETS.
INDEX=NUMBER+1
NUMB=-INDEX
GO TO 12
C
C INSERT DIGITS OF NUMBER
10 INDEX=KOUNT+KNT
11 LETTER(INDEX+1)=LETTER(INDEX)
INDEX=INDEX-1
IF(INDEX-KOUNT)26,12,11
12 KNT=KNT+1
INDEX=NUMB
NUMB=NUMB/IRADIX
INDEX=INDEX-IRADIX*NUMB
IF(NUMBER)13,16,16
13 IF(KNT-1)26,14,16
14 INDEX=INDEX+1
IF(INDEX-IRADIX)16,15,26
15 INDEX=0
NUMB=NUMB+1
16 LETTER(KOUNT+1)=IDGT(INDEX+1)
IF(NUMB)26,18,17
17 IF(KNT+KOUNT-MAX)10,25,25
18 KOUNT=KOUNT+KNT
C
C EVEN UP LEFT MARGIN IF NEEDED
IF(KONTRL)26,26,19
19 IF(KOUNT-LFTCOL)20,26,23
C
C ADD BLANKS TO LEFT MARGIN
20 DO 21 KNT=KEEP,KOUNT
INDEX=LFTCOL-KNT+KEEP
NUMB=KOUNT-KNT+KEEP
21 LETTER(INDEX)=LETTER(NUMB)
INDEX=LFTCOL-KOUNT+KEEP-1
DO 22 KNT=KEEP,INDEX
22 LETTER(KNT)=IBLANK
KOUNT=LFTCOL
GO TO 26
C
C REMOVE EXCESS DIGITS FROM LEFT MARGIN
23 DO 24 KNT=KEEP,LFTCOL
INDEX=KNT+KOUNT-LFTCOL
24 LETTER(KNT)=LETTER(INDEX)
KOUNT=LFTCOL
GO TO 26
25 KOUNT=KSAVE
26 RETURN
C KEEP = SUBSCRIPT AT WHICH INSERT 1ST CHARACTER.
C KNT = NUMBER OF DIGITS ADDED TO ARRAY.
C KSAVE = NUMBER OF CHARACTERS IN ORIGINAL ARRAY.
C NUMB = ABSOLUTE VALUE OF UNUSED PART OF NUMBER.
END