32
33 USE elbufdef_mod
34 use element_mod , only : nixs
35
36
37
38#include "implicit_f.inc"
39
40
41
42#include "mvsiz_p.inc"
43
44
45
46 INTEGER IENUNL(2,*),IXS(NIXS,*),IPARG(NPARG,NGROUP)
47 TYPE(ELBUF_STRUCT_),DIMENSION(NGROUP), TARGET :: ELBUF_STR
48
49
50
51
52#include "param_c.inc"
53#include "com01_c.inc"
54#include "com04_c.inc"
55
56
57
58 INTEGER I,NG, NEL, NFT,N, ITY,JHBE,IGTYP,ICSTR,ISOLNOD
59 INTEGER ITAG(NUMNOD),N1,N2,NC(8,MVSIZ),NEDG
60 TYPE(G_BUFEL_) ,POINTER :: GBUF
61
62
63 itag(1:numnod)=0
64 nedg = 0
65 DO ng=1,ngroup
66 nel=iparg(2,ng)
67 nft=iparg(3,ng)
68 ity=iparg(5,ng)
69 icstr= iparg(17,ng)
70 jhbe = iparg(23,ng)
71 igtyp = iparg(38,ng)
72 isolnod= iparg(28,ng)
73 IF (iparg(8,ng)==1) cycle
74 IF (ity /= 1) cycle
75 IF (igtyp == 20.OR.igtyp == 21.OR.igtyp == 22)THEN
76 gbuf => elbuf_str(ng)%GBUF
77
78 IF(isolnod==6)THEN
79 DO i=1,nel
80 n = nft+i
81 nc(1:3,i)=ixs(2:4,n)
82 nc(4:6,i)=ixs(6:8,n)
83 ENDDO
84 DO i=1,nel
85 IF (gbuf%IDT_TSH(i)<=0) cycle
86 n1 = nc(1,i)
87 n2 = nc(4,i)
88 IF (itag(n1)==0.AND.itag(n2)==0) THEN
89 nedg = nedg + 1
90 ienunl(1,nedg) = n1
91 ienunl(2,nedg) = n2
92 itag(n1)=nedg
93 itag(n2)=nedg
94 END IF
95 n1 = nc(2,i)
96 n2 = nc(5,i)
97 IF (itag(n1)==0.AND.itag(n2)==0) THEN
98 nedg = nedg + 1
99 ienunl(1,nedg) = n1
100 ienunl(2,nedg) = n2
101 itag(n1)=nedg
102 itag(n2)=nedg
103 END IF
104 n1 = nc(3,i)
105 n2 = nc(6,i)
106 IF (itag(n1)==0.AND.itag(n2)==0) THEN
107 nedg = nedg + 1
108 ienunl(1,nedg) = n1
109 ienunl(2,nedg) = n2
110 itag(n1)=nedg
111 itag(n2)=nedg
112 END IF
113 ENDDO
114 ELSEIF(isolnod==8)THEN
115 DO i=1,nel
116 n = nft+i
117 nc(1:8,i)=ixs(2:9,n)
118 ENDDO
119 IF (jhbe==14) THEN
120 SELECT CASE (icstr)
121 CASE(100)
122 DO i=1,nel
123 IF (gbuf%IDT_TSH(i)<=0) cycle
124 n1 = nc(1,i)
125 n2 = nc(4,i)
126 IF (itag(n1)==0.AND.itag(n2)==0) THEN
127 nedg = nedg + 1
128 ienunl(1,nedg) = n1
129 ienunl(2,nedg) = n2
130 itag(n1)=nedg
131 itag(n2)=nedg
132 END IF
133 n1 = nc(2,i)
134 n2 = nc(3,i)
135 IF (itag(n1)==0.AND.itag(n2)==0) THEN
136 nedg = nedg + 1
137 ienunl(1,nedg) = n1
138 ienunl(2,nedg) = n2
139 itag(n1)=nedg
140 itag(n2)=nedg
141 END IF
142 n1 = nc(5,i)
143 n2 = nc(8,i)
144 IF (itag(n1)==0.AND.itag(n2)==0) THEN
145 nedg = nedg + 1
146 ienunl(1,nedg) = n1
147 ienunl(2,nedg) = n2
148 itag(n1)=nedg
149 itag(n2)=nedg
150 END IF
151 n1 = nc(6,i)
152 n2 = nc(7,i)
153 IF (itag(n1)==0.AND.itag(n2)==0) THEN
154 nedg = nedg + 1
155 ienunl(1,nedg) = n1
156 ienunl(2,nedg) = n2
157 itag(n1)=nedg
158 itag(n2)=nedg
159 END IF
160 ENDDO
161 CASE(10)
162 DO i=1,nel
163 IF (gbuf%IDT_TSH(i)<=0) cycle
164 n1 = nc(1,i)
165 n2 = nc(5,i)
166 IF (itag(n1)==0.AND.itag(n2)==0) THEN
167 nedg = nedg + 1
168 ienunl(1,nedg) = n1
169 ienunl(2,nedg) = n2
170 itag(n1)=nedg
171 itag(n2)=nedg
172 END IF
173 n1 = nc(2,i)
174 n2 = nc(6,i)
175 IF (itag(n1)==0.AND.itag(n2)==0) THEN
176 nedg = nedg + 1
177 ienunl(1,nedg) = n1
178 ienunl(2,nedg) = n2
179 itag(n1)=nedg
180 itag(n2)=nedg
181 END IF
182 n1 = nc(3,i)
183 n2 = nc(7,i)
184 IF (itag(n1)==0.AND.itag(n2)==0) THEN
185 nedg = nedg + 1
186 ienunl(1,nedg) = n1
187 ienunl(2,nedg) = n2
188 itag(n1)=nedg
189 itag(n2)=nedg
190 END IF
191 n1 = nc(4,i)
192 n2 = nc(8,i)
193 IF (itag(n1)==0.AND.itag(n2)==0) THEN
194 nedg = nedg + 1
195 ienunl(1,nedg) = n1
196 ienunl(2,nedg) = n2
197 itag(n1)=nedg
198 itag(n2)=nedg
199 END IF
200 ENDDO
201 CASE(1)
202 DO i=1,nel
203 IF (gbuf%IDT_TSH(i)<=0) cycle
204 n1 = nc(1,i)
205 n2 = nc(2,i)
206 IF (itag(n1)==0.AND.itag(n2)==0) THEN
207 nedg = nedg + 1
208 ienunl(1,nedg) = n1
209 ienunl(2,nedg) = n2
210 itag(n1)=nedg
211 itag(n2)=nedg
212 END IF
213 n1 = nc(4,i)
214 n2 = nc(3,i)
215 IF (itag(n1)==0.AND.itag(n2)==0) THEN
216 nedg = nedg + 1
217 ienunl(1,nedg) = n1
218 ienunl(2,nedg) = n2
219 itag(n1)=nedg
220 itag(n2)=nedg
221 END IF
222 n1 = nc(5,i)
223 n2 = nc(6,i)
224 IF (itag(n1)==0.AND.itag(n2)==0) THEN
225 nedg = nedg + 1
226 ienunl(1,nedg) = n1
227 ienunl(2,nedg) = n2
228 itag(n1)=nedg
229 itag(n2)=nedg
230 END IF
231 n1 = nc(8,i)
232 n2 = nc(7,i)
233 IF (itag(n1)==0.AND.itag(n2)==0) THEN
234 nedg = nedg + 1
235 ienunl(1,nedg) = n1
236 ienunl(2,nedg) = n2
237 itag(n1)=nedg
238 itag(n2)=nedg
239 END IF
240 ENDDO
241 END SELECT
242 ELSEIF (jhbe==15) THEN
243 DO i=1,nel
244 IF (gbuf%IDT_TSH(i)<=0) cycle
245 n1 = nc(1,i)
246 n2 = nc(5,i)
247 IF (itag(n1)==0.AND.itag(n2)==0) THEN
248 nedg = nedg + 1
249 ienunl(1,nedg) = n1
250 ienunl(2,nedg) = n2
251 itag(n1)=nedg
252 itag(n2)=nedg
253 END IF
254 n1 = nc(2,i)
255 n2 = nc(6,i)
256 IF (itag(n1)==0.AND.itag(n2)==0) THEN
257 nedg = nedg + 1
258 ienunl(1,nedg) = n1
259 ienunl(2,nedg) = n2
260 itag(n1)=nedg
261 itag(n2)=nedg
262 END IF
263 n1 = nc(3,i)
264 n2 = nc(7,i)
265 IF (itag(n1)==0.AND.itag(n2)==0) THEN
266 nedg = nedg + 1
267 ienunl(1,nedg) = n1
268 ienunl(2,nedg) = n2
269 itag(n1)=nedg
270 itag(n2)=nedg
271 END IF
272 n1 = nc(4,i)
273 n2 = nc(8,i)
274 IF (itag(n1)==0.AND.itag(n2)==0) THEN
275 nedg = nedg + 1
276 ienunl(1,nedg) = n1
277 ienunl(2,nedg) = n2
278 itag(n1)=nedg
279 itag(n2)=nedg
280 END IF
281 ENDDO
282 END IF
283 END IF
284 END IF
285 ENDDO
286
287 RETURN