33
34
35
38
39
40
41#include "implicit_f.inc"
42
43
44
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48
49
50
51
53 . geo(npropg,*)
54 INTEGER IXC(NIXC,*),IPARTQ(*),IPARTTG(*),IXTG(NIXTG,*),
55 . IPARG(NPARG,*), IPARTC(*),IGEO(NPROPGI,*)
56
57 TYPE (STACK_PLY) :: STACK
58
59
60
61 LOGICAL ::
62 INTEGER IE,NG, ITY, LFT, LLT, NPT, N, I, J,
63 . IPRT, NEL, IAD, NPAR, NFT, IMID,IALEL,MTN,
64 . JJ, K, SH_IH, IHBE,BUF,ISHPLYXFEM,IPID,IPT,
65 . IPLY,IPPID,JPID,
66 . NCOUNT,SHCOUNT,MATER(NPART),ISUBSTACK
67 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_ARRAY,TAG_SHELLS
68
69
70 ALLOCATE(tag_array(numnod))
71 ALLOCATE(tag_shells(numelc))
72 DO i=1,npart
73 mater(i)=0
74 ENDDO
75
76 computation_needed = .false.
77 DO ng = 1, ngroup
78 nel =iparg(2,ng)
79 nft =iparg(3,ng)
80 ity =iparg(5,ng)
81 IF(ity==2)THEN
82 DO i = 1, nel
83 n = i + nft
84 mater(ipartq(n)) = 1
85 ENDDO
86 ELSEIF(ity==3)THEN
87 DO i = 1, nel
88 n = i + nft
89 mater(ipartc(n)) = 1
90 ENDDO
91 ELSEIF(ity==7)THEN
92 DO i = 1, nel
93 n = i + nft
94 mater(iparttg(n)) = 1
95 ENDDO
96 ENDIF
97 ishplyxfem = iparg(50,ng)
98 IF(ishplyxfem/=0) computation_needed = .true.
99 ENDDO
100
101
102
103
104
106
107 DO i=1,nplymax
109 ENDDO
110
112 DO i=1,nplymax
114 ENDDO
115
116
117
118 ie = 0
119
120 ippid = 100
121
122
123
126 IF(computation_needed) THEN
127 DO k=1,nplymax
128 tag_array=0
129 tag_shells=0
130 shcount=0
131 DO 500 iprt=1,npart
132 IF(mater(iprt) == 0)GOTO 500
133 DO 490 ng=1,ngroup
134 mtn =iparg(1,ng)
135 nel =iparg(2,ng)
136 nft =iparg(3,ng)
137 iad =iparg(4,ng)
138 ity =iparg(5,ng)
139 ishplyxfem = iparg(50,ng)
140 lft=1
141 llt=nel
142
143 IF(ishplyxfem > 0) THEN
144
145
146
147 IF(ity==3)THEN
148 npt =iparg(6,ng)
149 ihbe = iparg(23,ng)
150 isubstack = iparg(71,ng)
151 ippid = 2
152 DO 130 i=lft,llt
153 n = i + nft
154 IF(ipartc(n)/=iprt)GOTO 130
155 ipid = ixc(6,n)
156 DO ipt=1,npt
157 jpid = stack%IGEO(ippid + ipt, isubstack)
158 iply = igeo(102 ,jpid)
160 IF (iply == k) THEN
161 tag_array(ixc(2,n))=1
162 tag_array(ixc(3,n))=1
163 tag_array(ixc(4,n))=1
164 tag_array(ixc(5,n))=1
165
166 tag_shells(n) = ipt
168 ENDIF
169
170 ENDDO
171130 CONTINUE
172
173
174
175
176 ELSEIF(ity==7)THEN
177
178 ENDIF
179 ENDIF
180 490 CONTINUE
181
182 500 CONTINUE
183
184
185
186 DO i=1,numnod
187 IF (tag_array(i)==1)
plynod(k)%PLYNUMNODS =
plynod(k)%PLYNUMNODS + 1
188 ENDDO
190
191 ncount = 0
192 DO i=1,numnod
193 IF (tag_array(i)==1) THEN
194 ncount=ncount+1
196 ENDIF
197 ENDDO
198
199
200
203
204
205
206 shcount=0
207 DO i=1, numelc
208 IF (tag_shells(i) > 0)THEN
209 shcount=shcount+1
211 plyshell(k)%SHELLIPT(shcount)=tag_shells(i)
212 ENDIF
213 ENDDO
214 ENDDO
215
216 ELSE
217 DO k=1,nplymax
221 ENDDO
222 ENDIF
223
224
225
226 ncount = 0
227 DO k=1,nplymax
230 ncount=ncount+1
232 ENDDO
233 ENDDO
234
235
236
237
238 ncount = 0
239 DO k=1,nplymax
241 DO i=1,
plynod(k)%PLYNUMNODS
242 ncount=ncount+1
243 plynod(k)%PLYNODID(i)=ncount
244 ENDDO
245 ENDDO
246
247
248
249
253 DO k=1,nplymax
254 IF (
plyshell(k)%PLYNUMSHELL >0)
THEN
258 ENDIF
259 ENDDO
260
261 nplynodg = 0
262 DO k=1,nplymax
263 nplynodg = nplynodg +
plynod(k)%PLYNUMNODS
264 ENDDO
265
266 DEALLOCATE(tag_array)
267 DEALLOCATE(tag_shells)
268
269
270 RETURN
integer, dimension(:), allocatable indx_ply
integer, dimension(:), allocatable idpid_ply
type(plyshells), dimension(:), allocatable plyshell