1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
/*
This subroutine computes a proper tree
Copyright (C) 1999 Dan Stanger
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.
This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Dan Stanger dan.stanger@ieee.org
*/
/* this function will return the a matrix
due to no local arrays, this function will prefix all arrays used
with the prefix pt, to avoid name clashes. it will delete them at the end
the reference node will be 0.
*/
nameNode(l):=first(l)$
fromNode(l):=third(l)$
toNode(l):=fourth(l)$
typeNode(l):=second(l)$
valueNode(l):=fifth(l)$
countNodes(cl):=block([n:0],
map(lambda([x],n:max(n,fromNode(x),toNode(x))),cl),n)$
printarray2(a,na,n,b):=block([ipw:integer_print_width],integer_print_width:4,
apply(print, makelist(na[j],j,1,b)),
for i:1 thru n do apply(print,makelist(a[i,j],j,1,b)),
integer_print_width:ipw)$
swap(a,i,j)::=buildq([a,i,j],block([temp:a[i]],a[i]:a[j],a[j]:temp))$
properTree(filename):=block([cl, MB, MN, retvals, dbg:true],
/* MB number of branches */
/* MN number of nodes */
if dbg then print("entry"),
cl:readfile(filename),
if dbg then print("before sort", cl),
cl:sort(cl,
lambda([x,y],
getElementIndex(typeNode(x))<getElementIndex(typeNode(y)))),
if dbg then print("after sort", cl),
MB:length(cl),
MN:countNodes(cl),
if dbg then print("branches", MB, " nodes", MN),
array(pt_A,MN,MB), array(pt_D, MN, MB),
array([pt_NF,pt_NT,pt_V,pt_JT, pt_MT, pt_name, pt_aJT], MB),
/* DIMENSION A(10,10),D(10,10),NF(10),NT(10),V(10),JT(10),MT(10) */
/* READ 99, (NF(I),NT(I),V(I),JT(I),MT(I) I=1,MB)
C I IS BRANCH NUMBER, NF IS FROM NODE, NT IS TO NODE
C V IS ELEMENT VALUE, JT IS ELEMENT TYPE
C MT TELLS TREE OR LINK
C WHEN MT IS 0 BRANCH IS TREE, OTHER NUMBER BRANCH IS
C LINK
C MT(I) HAS ALL ZERO ELEMENTS INITIALLY */
/* pt_name is the symbolic name of the circuit element, and if a element
is not given a value, then it's value is its name. maybe there should
be a flag, to assign symbolic names even if there are numeric values,
to be more compatible with spice.
pt_aJT is the element type in the order of the pt_A array */
block([i:0],
for l in cl do (i:i+1,
pt_NF[i]:fromNode(l), pt_NT[i]:toNode(l), pt_V[i]:valueNode(l),
pt_JT[i]:typeNode(l), pt_MT[i]:0, pt_name[i]:nameNode(l),
if pt_V[i] = false then pt_V[i]:pt_name[i])),
/* CONSTRUCT INCIDENCE MATRIX D */
if dbg then print("constructing incidence matrix d"),
fillarray(pt_D,[0]),
for i:1 thru MB do (
if pt_NF[i] > 0 then pt_d[pt_NF[i],i]:1,
if pt_NT[i] > 0 then pt_d[pt_NT[i],i]:-1),
if dbg then print("number of nodes", MN, "number of branches", MB),
/* print the d matrix for debugging */
if dbg then printarray2(pt_d,pt_name,MN,MB),
/* SELECT TREE BRANCHES AND LINKS
C KV IS TREE VOLTAGE SOURCE NUMBER
C KC IS TREE CAPACITOR NUMBER
C KR IS TREE RESISTOR NUMBER
C IR IS LINK RESISTOR NUMBER
C IL IS LINK INDUCTOR NUMBER
C IC IS LINK CURRENT SOURCE NUMBER
C IK IS TREE BRANCH NUMBER
C K IS LINK BRANCH NUMBER */
block([KV:0, KC:0, KR:0, IR:0, IL:0, IC:0, IK:0, K:0],
for i:1 thru MB do (
if pt_MT[i] = 0 then (
if i < MB then block([continu,treebranch:false],
for j:(i+1) thru MB while (treebranch = false) do (
continu:false,
if dbg then print("52", j, pt_MT[j]),
if pt_MT[j] = 0 then (
if dbg then print("pt_MT[j]=0,i,pt_NT[i],j,pt_NT[j]", i, pt_NT[i], j, pt_NT[j]),
if pt_NT[i] = pt_NT[j] then ( /* 61 */
if pt_NF[i] # pt_NF[j] then (/* 5 */
pt_NT[j]:pt_NF[i], /* 43 */
if dbg then print("1 j-MB",j-MB,52,102,102),
/* IF(J-MB)52,102,102 * 220 */
continu:true
) else (if dbg then print("should do 6"))
)
else (
if dbg then print("33 i,pt_NT[i],j,pt_NF[j]",i,pt_NT[i],j,pt_NF[j]),
if pt_NT[i] # pt_NF[j] then ( /* 33 */
if dbg then print("2 j-MB",j-MB,52,102,102),
/* IF(J-MB)52,102,102 * 220 */
continu:true
)
else (
if pt_NF[i] # pt_NT[j] then ( /* 63 */
pt_NF[j]:pt_NF[i], /* 83 */
/* IF(J-MB)52,102,102 * 220 */
if dbg then print("3 j-MB",j-MB,52,102,102),
continu:true
) else (if dbg then print("should do 6"))
)
),
if continu = true then (
if dbg then print("goto 102"),
if j >= MB then treebranch:true /* goto 102 */
)
else ( /* 6 branch j is a link */
K:K+1,
if dbg then print("k", k, " adding a link 6"),
pt_MT[j]:MN + K,
pt_aJT[pt_MT[j]]:pt_JT[j],
for L:1 thru MN do pt_A[L,pt_MT[j]]:pt_D[L,j],
if getElementIndex(pt_JT[j]) < 4 then IR:IR+1
else (
if getElementIndex(pt_JT[j]) > 4 then IC:IC+1
else IL:IL+1
),
/* IF(J-MB)52,102,103 */
if dbg then print("4 j-MB",j-MB,52,102,103),
if j = MB then treebranch:true,
if j >= MB then return
)
)
),
if dbg then print("102 treebranch is ", treebranch),
if treebranch = true then ( /* 102 branch i is a tree branch */
IK:IK+1,
if dbg then print("ik", ik,"i",i, " in 102 row swap"),
for M:1 thru MN do pt_A[M,IK]:pt_D[M,i],
pt_aJT[IK]:pt_JT[i],
swap(pt_name,i,IK),
if getElementIndex(pt_JT[i]) < 2 then KV:KV+1
else (
if getElementIndex(pt_JT[i]) > 2 then KR:KR+1
else KC:KC+1
)
)
)
)
),
retvals:[KC, KR, KV, IL, IR, IC, MN, MB]
),
if dbg then print("103? MB MN",MB,MN),
if dbg then printarray2(pt_a, pt_name, MN, MB),
retvals
)
$
|
