35
37
38
39
40#include "implicit_f.inc"
41
42
43
44#include "assert.inc"
45
46
47
48#include "param_c.inc"
49
50
51
52
53
54
55
56
57 INTEGER I_STOK,NEDGE,NIN,NEDGE_L,IFQ
58 INTEGER CAND_S(I_STOK),CAND_M(I_STOK),CAND_A(*),IFPEN(*)
59 INTEGER LEDGE(NLEDGE,NEDGE)
61 . cand_p(4,*),cand_fx(4,*) ,cand_fy(4,*) ,cand_fz(4,*)
62
63
64
65 INTEGER I,N,NN,K,E,CAND_X,
66 . IGET(I_STOK),IPUT(I_STOK)
68 . cand_xf
69
70
71
72 DO n=1,nedge+3
73 cand_a(n) = 0
74 ENDDO
75
76 DO i=1,i_stok
77 nn = cand_s(i)
78 e = cand_m(i)
79
80 assert(cand_s(i) > 0)
81 assert(cand_s(i) <= nedge)
82 debug_e2e(eids == d_es,cand_p(1,i))
83 debug_e2e(eids == d_es,cand_p(2,i))
84 debug_e2e(eids == d_es,cand_p(3,i))
85 debug_e2e(eids == d_es,cand_p(4,i))
86
87
88 IF (ifq == 0) THEN
89 IF(cand_p(1,i)==zero.AND.
90 . cand_p(2,i)==zero.AND.
91 . cand_p(3,i)==zero.AND.
92 . cand_p(4,i)==zero)THEN
93 cand_s(i) = nedge+1
94 ENDIF
95 ELSE
96 IF(ifpen(i)==0.AND.cand_p(1,i)==zero.AND.
97 . cand_p(2,i)==zero.AND.
98 . cand_p(3,i)==zero.AND.
99 . cand_p(4,i)==zero)THEN
100 cand_s(i) = nedge+1
101 ENDIF
102 ENDIF
103
104
105 ENDDO
106
107
108
109
110 DO i=1,i_stok
111 nn = cand_s(i) + 2
112 cand_a(nn) = cand_a(nn) + 1
113 ENDDO
114
115
116
117
118 cand_a(1) = 1
119 cand_a(2) = 1
120 DO n=3,nedge+2
121 cand_a(n) = cand_a(n) + cand_a(n-1)
122 ENDDO
123
124
125
126
127
128 DO i=1,i_stok
129 nn = cand_s(i) + 1
130 k = cand_a(nn)
131 assert(k > 0)
132 assert(nn > 0)
133 iput(i) = k
134 iget(k) = i
135 cand_a(nn) = cand_a(nn) + 1
136 ENDDO
137
138
139
140
141
142 DO k=1,i_stok
143 i = iget(k)
144 assert(i > 0)
145
146 cand_x = cand_s(k)
147 cand_s(k) = cand_s(i)
148 cand_s(i) = cand_x
149
150 cand_x = cand_m(k)
151 cand_m(k) = cand_m(i)
152 cand_m(i) = cand_x
153
154 cand_xf = cand_p(1,k)
155 cand_p(1,k) = cand_p(1,i)
156 cand_p(1,i) = cand_xf
157
158 cand_xf = cand_p(2,k)
159 cand_p(2,k) = cand_p(2,i)
160 cand_p(2,i) = cand_xf
161
162 cand_xf = cand_p(3,k)
163 cand_p(3,k) = cand_p(3,i)
164 cand_p(3,i) = cand_xf
165
166 cand_xf = cand_p(4,k)
167 cand_p(4,k) = cand_p(4,i)
168 cand_p(4,i) = cand_xf
169
170 cand_xf = cand_fx(1,k)
171 cand_fx(1,k) = cand_fx(1,i)
172 cand_fx(1,i) = cand_xf
173
174 cand_xf = cand_fx(2,k)
175 cand_fx(2,k) = cand_fx(2,i)
176 cand_fx(2,i) = cand_xf
177
178 cand_xf = cand_fx(3,k)
179 cand_fx(3,k) = cand_fx(3,i)
180 cand_fx(3,i) = cand_xf
181
182 cand_xf = cand_fx(4,k)
183 cand_fx(4,k) = cand_fx(4,i)
184 cand_fx(4,i) = cand_xf
185
186 cand_xf = cand_fy(1,k)
187 cand_fy(1,k) = cand_fy(1,i)
188 cand_fy(1,i) = cand_xf
189
190 cand_xf = cand_fy(2,k)
191 cand_fy(2,k) = cand_fy(2,i)
192 cand_fy(2,i) = cand_xf
193
194 cand_xf = cand_fy(3,k)
195 cand_fy(3,k) = cand_fy(3,i)
196 cand_fy(3,i) = cand_xf
197
198 cand_xf = cand_fy(4,k)
199 cand_fy(4,k) = cand_fy(4,i)
200 cand_fy(4,i) = cand_xf
201
202 cand_xf = cand_fz(1,k)
203 cand_fz(1,k) = cand_fz(1,i)
204 cand_fz(1,i) = cand_xf
205
206 cand_xf = cand_fz(2,k)
207 cand_fz(2,k) = cand_fz(2,i)
208 cand_fz(2,i) = cand_xf
209
210 cand_xf = cand_fz(3,k)
211 cand_fz(3,k) = cand_fz(3,i)
212 cand_fz(3,i) = cand_xf
213
214 cand_xf = cand_fz(4,k)
215 cand_fz(4,k) = cand_fz(4,i)
216 cand_fz(4,i) = cand_xf
217
218 cand_x = ifpen(k)
219 ifpen(k) = ifpen(i)
220 ifpen(i) = cand_x
221
222 iput(i) = iput(k)
223
224 assert(iput(i) > 0)
225 assert(iput(i) <= i_stok)
226
227 iget(iput(i)) = i
228 ENDDO
229
230
231
232 i_stok = cand_a(nedge+1) - 1
233 cand_a(nedge+2) = cand_a(nedge+1)
234
235 RETURN