Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/dasave.for
There are 2 other files named dasave.for in the archive. Click here to see a list.
SUBROUTINE DASAVE(IPART ,IFORMT,MAXCLM,MAXLIN,IDATA ,
1 KNTDAT,LETTER,KNTLTR,NAME ,KNTNAM,IOUT ,IERR )
C RENBR(/INTEGER AND 1H DATA STATEMENT GENERATOR)
C
C DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C JUL 14, 1970
C
C IPART = -1, CONSTRUCT DIMENSION AND EQUIVALENCE
C STATEMENTS BUT NOT DATA STATEMENTS
C = 0, CONSTRUCT DIMENSION, EQUIVALENCE AND DATA
C STATEMENTS
C = 1, CONSTRUCT DIMENSION STATEMENTS ONLY
C = 2, CONSTRUCT EQUIVALENCE STATEMENTS ONLY
C = 3, CONSTRUCT DATA STATEMENTS ONLY
C = -4, -3 OR -2, IDENTICAL TO IPART=-1, 0 OR 1
C RESPECTIVELY, EXCEPT THAT DIMENSION
C STATEMENTS SPECIFY COMPONENT ARRAYS NECESARY
C TO CONSTRUCT ORGINAL ARRAY BUT DO NOT
C INCLUDE NAME AND DIMENSION OF ORIGINAL
C ARRAY.
C IFORMT = -1, REPRESENT CHARACTERS IN LETTER ARRAY
C WHICH WERE DEFINED BY 1H FIELDS OR READ WITH
C A1 FORMATS
C = 0, REPRESENT INTEGERS IN IDATA ARRAY IN
C COMPACT FORM
C = 1 OR GREATER, REPRESENT INTEGERS IN IDATA
C ARRAY IN COLUMNS WHICH ARE AT LEAST IFORMT
C CHARACTERS WIDE (IFORMT=10 IS EQUIVALENT TO
C I10 FORMAT)
C MAXCLM = NUMBER OF CHARACTERS TO BE IN STATEMENT
C FIELD (66 IF MAXIMUM, IE 72 MINUS LEFT 6
C COLUMNS)
C MAXLIN = MAXIMUM NUMBER OF LINES FOR SINGLE STATEMENT
C IDATA = ARRAY OF INTEGERS TO BE REPRESENTED IN DATA
C STATEMENTS IF IFORMT IS ZERO OR GREATER
C KNTDAT = NUMBER OF LOCATIONS IN IDATA ARRAY TO BE
C REPRESENTED IN DATA STATEMENTS
C LETTER = ARRAY OF CHARACTERS READ WITH A1 FORMAT OR
C DEFINED USING 1H FIELDS TO BE REPRESENTED IN
C DATA STATEMENTS IF IFORMT HAS VALUE -1
C KNTLTR = NUMBER OF LOCATIONS IN LETTER ARRAY TO BE
C REPRESENTED IN DATA STATEMENTS
C NAME = ALPHAMERIC ARRAY CONTAINING NAME OF ARRAY
C (READ BY MULTIPLE OF A1 FORMAT)
C KNTNAM = NUMBER OF LETTERS IN NAME OF ARRAY
C IOUT = OUTPUT UNIT ON WHICH STATEMENT IS WRITTEN
C IERR = 0 RETURNED IF COULD GENERATE DATA STATEMENT
C = 1 RETURNED IF MAXCLM TOO SMALL
C = 2 RETURNED IF ISTORE ARRAY TOO SMALL
C
DIMENSION IDATA(KNTDAT),LETTER(KNTLTR),NAME(KNTNAM),
1IBUFFR(66),ISTORE(200)
DATA IBLANK,ISLASH,KOMMA,ILPR,IRPR,IONE,IHOLLR/
11H ,1H/,1H,,1H(,1H),1H1,1HH/
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
JPART=IPART
IF(JPART.LT.-1)JPART=JPART+3
IERR=0
IF(IFORMT)1,2,2
1 NEEDED=KNTLTR
GO TO 3
2 NEEDED=KNTDAT
3 IF(NEEDED)113,113,4
4 LOCK=1
MOST=0
MAX1=MAXCLM-1
MAX2=MAXCLM-2
LEFT=0
CALL DANUMB(0,NEEDED,10,IBUFFR,LEFT,0,MAXCLM)
LENGTH=KNTNAM+LEFT
IF(LENGTH-6)6,6,5
5 LENGTH=6
6 IF(IFORMT)12,81,7
C
C PREPARE FOR EXPANDED FORMAT
7 MOST=IDATA(1)
LEAST=MOST
DO 8 INDEX=1,NEEDED
IF(LEAST.GT.IDATA(INDEX))LEAST=IDATA(INDEX)
IF(MOST.LT.IDATA(INDEX))MOST=IDATA(INDEX)
8 CONTINUE
KOUNT=0
CALL DANUMB(0,MOST,10,IBUFFR,KOUNT,0,MAXCLM)
MOST=KOUNT
KOUNT=0
CALL DANUMB(0,LEAST,10,IBUFFR,KOUNT,0,MAXCLM)
IF(MOST-KOUNT)9,10,10
9 MOST=KOUNT
10 IF(MOST-IFORMT)11,13,13
11 MOST=IFORMT
GO TO 13
12 MOST=3
13 LIMIT=MAXLIN*((MAXCLM-LENGTH-6)/(MOST+1))
IF(LIMIT)112,112,14
14 KNTPRT=1+((NEEDED-1)/LIMIT)
IF(KNTPRT-JSTORE)15,15,111
15 LEAST=1
DO 16 INDEX=1,KNTPRT
ISTORE(INDEX)=LEAST
16 LEAST=LEAST+LIMIT
C
C TEST IF LABELS ARE OF MINIMUM LENGTH
17 ITEST=0
CALL DANUMB(0,ISTORE(KNTPRT),10,IBUFFR,ITEST,0,
1MAXCLM)
IF(KNTNAM+ITEST-LENGTH)18,19,19
18 LENGTH=KNTNAM+ITEST
IF(IFORMT)13,81,13
19 LOCK=0
IF(IFORMT)21,20,21
20 LEFT=0
ITEST=0
C
C CONSTRUCT SINGLE LINE OF DIMENSION STATEMENT
21 IF(JPART-2)22,59,81
22 INDEX=0
DO 23 LEAST=1,10
23 IBUFFR(LEAST)=IBLANK
24 LINE=1
LAST=INDEX
25 KOUNT=10
26 IF(INDEX)27,27,39
C
C INSERT NAME OF MAIN ARRAY
27 IF(IFORMT)28,29,28
28 LIMIT=-LENGTH
GO TO 30
29 LIMIT=0
30 LEAST=KOUNT
CALL DABOTH(LIMIT,LEFT,NAME,KNTNAM,0,NEEDED,IBUFFR,
1KOUNT,MAX1)
C
C OUTPUT COMMENT LINE DESCRIBING DIMENSION
IF(IPART+1)31,38,38
31 IF(LINE-1)32,32,35
32 IF(KOUNT-10)33,33,34
33 WRITE(IOUT,120)
GO TO 52
34 WRITE(IOUT,120)(IBUFFR(LEAST),LEAST=11,KOUNT)
GO TO 37
35 IF(KOUNT-LEAST)112,112,36
36 WRITE(IOUT,121)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
37 INDEX=1
GO TO 24
C
C INSERT NAME OF SMALL ARRAY
38 IF(KOUNT-LEAST)46,46,43
39 IF(INDEX-KNTPRT)41,40,40
40 LIMIT=NEEDED-ISTORE(INDEX)+1
GO TO 42
41 LIMIT=ISTORE(INDEX+1)-ISTORE(INDEX)
42 LEAST=KOUNT
CALL DABOTH(LENGTH,LEFT,NAME,KNTNAM,ISTORE(INDEX),
1LIMIT,IBUFFR,KOUNT,MAX1)
IF(KOUNT-LEAST)44,44,43
43 INDEX=INDEX+1
KOUNT=KOUNT+1
IBUFFR(KOUNT)=KOMMA
IF(INDEX-KNTPRT)26,26,45
C
C OUTPUT SINGLE LINE OF DIMENSION STATEMENT
44 IF(LINE-MAXLIN)46,45,45
45 KOUNT=KOUNT-1
46 IF(LINE-1)47,47,50
47 IF(KOUNT-10)48,48,49
48 WRITE(IOUT,116)
GO TO 52
49 WRITE(IOUT,116)(IBUFFR(LEAST),LEAST=11,KOUNT)
GO TO 52
50 IF(KOUNT)112,112,51
51 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)53,53,52
52 MANY=1
53 IF(INDEX-KNTPRT)54,54,58
54 IF(LINE-MAXLIN)56,55,55
55 IF(INDEX-LAST)112,112,24
56 LINE=LINE+1
IF(IFORMT)25,57,25
57 KOUNT=0
GO TO 26
C
C CONSTRUCT SINGLE LINE OF EQUIVALENCE STATEMENT
58 IF(JPART)59,59,113
59 INDEX=1
DO 60 LEAST=1,12
60 IBUFFR(LEAST)=IBLANK
61 LINE=1
LAST=INDEX
62 KOUNT=12
C
C INSERT NAME OF SMALL ARRAY
63 KOUNT=KOUNT+1
LEAST=KOUNT
CALL DABOTH(LENGTH,0,NAME,KNTNAM,ISTORE(INDEX),1,
1IBUFFR,KOUNT,MAX2)
IF(KOUNT-LEAST)66,66,64
C
C INSERT NAME OF MAIN ARRAY
64 KOUNT=KOUNT+1
LIMIT=KOUNT
CALL DABOTH(0,ITEST,NAME,KNTNAM,0,ISTORE(INDEX),
1IBUFFR,KOUNT,MAX2)
IF(KOUNT-LIMIT)66,66,65
65 IBUFFR(LEAST)=ILPR
IBUFFR(LIMIT)=KOMMA
KOUNT=KOUNT+1
IBUFFR(KOUNT)=IRPR
KOUNT=KOUNT+1
IBUFFR(KOUNT)=KOMMA
INDEX=INDEX+1
IF(INDEX-KNTPRT)63,63,67
C
C OUTPUT SINGLE LINE OF EQUIVALENCE STATEMENT
66 KOUNT=LEAST-1
IF(LINE-MAXLIN)68,67,67
67 KOUNT=KOUNT-1
68 IF(LINE-1)69,69,72
69 IF(KOUNT-12)70,70,71
70 WRITE(IOUT,117)
GO TO 74
71 WRITE(IOUT,117)(IBUFFR(LEAST),LEAST=13,KOUNT)
GO TO 74
72 IF(KOUNT)112,112,73
73 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)75,75,74
74 MANY=1
75 IF(INDEX-KNTPRT)76,76,80
76 IF(LINE-MAXLIN)78,77,77
77 IF(INDEX-LAST)112,112,61
78 LINE=LINE+1
IF(IFORMT)62,79,62
79 KOUNT=0
GO TO 63
C
C CONSTRUCT SINGLE LINE OF DATA STATEMENT
80 IF(JPART)113,81,113
81 INDEX=1
KNTPRT=0
82 LINE=1
LAST=INDEX+1
KOUNT=5
83 LIMIT=KOUNT+MOST
84 LEAST=KOUNT
IF(LAST-INDEX)88,88,85
C
C INSERT NAME OF SMALL ARRAY
85 CALL DABOTH(LENGTH,-1,NAME,KNTNAM,INDEX,0,IBUFFR,
1KOUNT,MAX1)
IF(KOUNT-LEAST)97,97,86
86 LAST=INDEX
KOUNT=KOUNT+1
IBUFFR(KOUNT)=ISLASH
IF(KNTPRT-JSTORE)87,111,111
87 KNTPRT=KNTPRT+1
ISTORE(KNTPRT)=INDEX
GO TO 83
C
C INSERT INTEGER ENTRY
88 IF(IFORMT)90,89,89
89 CALL DANUMB(IFORMT,IDATA(INDEX),10,IBUFFR,KOUNT,
1LIMIT,MAX1)
IF(KOUNT-LEAST)95,95,94
GO TO 94
90 IF(LIMIT-MAX1)91,91,95
91 IF(KOUNT-(LIMIT-3))92,93,93
92 KOUNT=KOUNT+1
IBUFFR(KOUNT)=IBLANK
GO TO 91
93 KOUNT=KOUNT+3
IBUFFR(KOUNT-2)=IONE
IBUFFR(KOUNT-1)=IHOLLR
IBUFFR(KOUNT)=LETTER(INDEX)
94 KOUNT=KOUNT+1
IBUFFR(KOUNT)=KOMMA
INDEX=INDEX+1
IF(INDEX-NEEDED)83,83,96
C
C OUTPUT SINGLE LINE OF DATA STATEMENT
95 IF(LINE-MAXLIN)97,96,96
96 IBUFFR(KOUNT)=ISLASH
97 IF(LOCK)98,98,105
98 IF(LINE-1)99,99,102
99 IF(KOUNT-5)100,100,101
100 WRITE(IOUT,118)
GO TO 104
101 WRITE(IOUT,118)(IBUFFR(LEAST),LEAST=6,KOUNT)
GO TO 104
102 IF(KOUNT)112,112,103
103 WRITE(IOUT,119)MANY,(IBUFFR(LEAST),LEAST=1,KOUNT)
MANY=MANY+1
IF(MANY-9)105,105,104
104 MANY=1
105 IF(INDEX-NEEDED)106,106,110
106 IF(LINE-MAXLIN)108,107,107
107 IF(INDEX-LAST)112,112,82
108 LINE=LINE+1
KOUNT=0
IF(IFORMT)109,83,109
109 LIMIT=6+LENGTH+MOST
GO TO 84
110 IF(LOCK)113,113,17
C
C RETURN TO CALLING PROGRAM
111 WRITE(IOUT,114)JSTORE
IERR=2
GO TO 113
112 WRITE(IOUT,115)MAXCLM
IERR=1
113 RETURN
114 FORMAT(19H DASAVE - MORE THAN,1I4,11H STATEMENTS)
115 FORMAT(21H DASAVE - FIELD WIDTH,1I3,10H TOO SHORT)
116 FORMAT(6X,10HDIMENSION ,66A1)
117 FORMAT(6X,12HEQUIVALENCE ,66A1)
118 FORMAT(6X,5HDATA ,61A1)
119 FORMAT(5X,1I1,66A1)
120 FORMAT(1HC,5X,10HDIMENSION ,66A1)
121 FORMAT(1HC,4X,1I1,66A1)
C985104445547
END