OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_sol_skin_ixskin.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_sol_skin_ixskin (elbuf_tab, iparg, iparts, ixs, ixs10, ixskin, tag_skins6, nskin)

Function/Subroutine Documentation

◆ h3d_sol_skin_ixskin()

subroutine h3d_sol_skin_ixskin ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) iparts,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(nixq,*) ixskin,
integer, dimension(*) tag_skins6,
integer nskin )

Definition at line 35 of file h3d_sol_skin_ixskin.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE initbuf_mod
41 USE elbufdef_mod
42 use element_mod , only : nixs,nixq
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57C REAL
58 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IPARTS(*),IXSKIN(NIXQ,*),
59 . IXS10(6,*) ,TAG_SKINS6(*) ,NSKIN
60 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,ISOLNOD,ICS,NG,N,J
65 INTEGER
66 . MLW ,NEL ,NFT ,IAD ,ITY ,
67 . NPT ,JALE ,ISMSTR ,JEUL ,JTUR ,
68 . JTHE ,JLAG ,JMULT ,JHBE ,JIVF ,
69 . NVAUX ,JPOR ,KCVT ,JCLOSE ,JPLASOL ,
70 . IREP ,IINT ,IGTYP ,ISRAT ,ISROT ,
71 . ICSEN ,ISORTH ,ISORTHG ,IFAILURE,JSMS ,
72 . NN,NN1,N1
73 INTEGER NC(10,MVSIZ),PWR(7),LL
74 INTEGER FACES(4,6),NS(4),JJ,II,K1,K2,T3(3),T6(6),TIA4S(3,4)
75 DATA pwr/1,2,4,8,16,32,64/
76 DATA faces/4,3,2,1,
77 . 5,6,7,8,
78 . 1,2,6,5,
79 . 3,4,8,7,
80 . 2,3,7,6,
81 . 1,5,8,4/
82 DATA tia4s/3,5,6,
83 . 2,4,5,
84 . 1,6,4,
85 . 4,6,5/
86C----tetra4:-------------------------------------------
87c N8=N4 FACES : 2 2 1 1
88c N7=N3 4 3 3 4
89c N6=N3 1 1 3 4
90c N5=N4 2 2 4 3
91c N4=N2 1 2 3 3
92c N3=N2 1 4 4 2
93c N2=N1
94c N1=N1
95C
96 DO ng=1,ngroup
97 CALL initbuf(iparg ,ng ,
98 2 mlw ,nel ,nft ,iad ,ity ,
99 3 npt ,jale ,ismstr ,jeul ,jtur ,
100 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
101 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
102 6 irep ,iint ,igtyp ,israt ,isrot ,
103 7 icsen ,isorth ,isorthg ,ifailure,jsms )
104!
105 IF(mlw == 13 .OR. mlw == 0.OR.ity /= 1) cycle
106C------
107 IF (igtyp==6 .OR. igtyp==14 ) THEN
108 isolnod = iparg(28,ng)
109 ics = iparg(17,ng)
110 IF(isolnod == 4)THEN
111 DO i=1,nel
112 n = i + nft
113 nc(1,i)=ixs(2,n)
114 nc(2,i)=ixs(4,n)
115 nc(3,i)=ixs(7,n)
116 nc(4,i)=ixs(6,n)
117 ENDDO
118C---------each face
119 DO i=1,nel
120 n = i + nft
121 ll=tag_skins6(n)
122 jj = 5
123 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
124C---------3,2,1
125 nskin = nskin + 1
126 ixskin(1,nskin) = iparts(n)
127 ixskin(2,nskin) = nc(3,i)
128 ixskin(3,nskin) = nc(2,i)
129 ixskin(4,nskin) = nc(1,i)
130 ixskin(5,nskin) = ixskin(4,nskin)
131 ixskin(6,nskin) = ixs(nixs-1,n)
132 ixskin(7,nskin) = nskin
133 END IF
134C---------2,3 ,4
135 jj = 4
136 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
137 nskin = nskin + 1
138 ixskin(1,nskin) = iparts(n)
139 ixskin(2,nskin) = nc(2,i)
140 ixskin(3,nskin) = nc(3,i)
141 ixskin(4,nskin) = nc(4,i)
142 ixskin(5,nskin) = ixskin(4,nskin)
143 ixskin(6,nskin) = ixs(nixs-1,n)
144 ixskin(7,nskin) = nskin
145 END IF
146C---------1,4,3
147 jj = 3
148 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
149 nskin = nskin + 1
150 ixskin(1,nskin) = iparts(n)
151 ixskin(2,nskin) = nc(1,i)
152 ixskin(3,nskin) = nc(4,i)
153 ixskin(4,nskin) = nc(3,i)
154 ixskin(5,nskin) = ixskin(4,nskin)
155 ixskin(6,nskin) = ixs(nixs-1,n)
156 ixskin(7,nskin) = nskin
157 END IF
158C---------1,2,4
159 jj = 6
160 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
161 nskin = nskin + 1
162 ixskin(1,nskin) = iparts(n)
163 ixskin(2,nskin) = nc(1,i)
164 ixskin(3,nskin) = nc(2,i)
165 ixskin(4,nskin) = nc(4,i)
166 ixskin(5,nskin) = ixskin(4,nskin)
167 ixskin(6,nskin) = ixs(nixs-1,n)
168 ixskin(7,nskin) = nskin
169 END IF
170 ENDDO
171 ELSEIF(isolnod == 6)THEN
172 ELSEIF(isolnod == 10)THEN
173 DO i=1,nel
174 n = i + nft
175 nc(1,i)=ixs(2,n)
176 nc(2,i)=ixs(4,n)
177 nc(3,i)=ixs(7,n)
178 nc(4,i)=ixs(6,n)
179 nn1 = n - numels8
180 nc(5:10,i) = ixs10(1:6,nn1)
181 ENDDO
182C---------each face 4x4
183 DO i=1,nel
184 n = i + nft
185 ll=tag_skins6(n)
186C---------1,2,3
187 jj = 5
188 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
189 t6(1:3) = nc(1:3,i)
190 t6(4:6) = nc(5:7,i)
191 DO j=1,4
192 nskin = nskin + 1
193 ixskin(1,nskin) = iparts(n)
194 t3(1:3) = t6(tia4s(1:3,j))
195 ixskin(2:4,nskin) = t3(1:3)
196 ixskin(5,nskin) = ixskin(4,nskin)
197 ixskin(6,nskin) = ixs(nixs-1,n)
198 ixskin(7,nskin) = nskin
199 END DO
200 END IF
201C---------2,3 ,4
202 jj = 4
203 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
204 t6(1:3) = nc(2:4,i)
205 t6(4) = nc(6,i)
206 t6(5) = nc(10,i)
207 t6(6) = nc(9,i)
208 DO j=1,4
209 nskin = nskin + 1
210 ixskin(1,nskin) = iparts(n)
211 t3(1:3) = t6(tia4s(1:3,j))
212 ixskin(2:4,nskin) = t3(1:3)
213 ixskin(5,nskin) = ixskin(4,nskin)
214 ixskin(6,nskin) = ixs(nixs-1,n)
215 ixskin(7,nskin) = nskin
216 END DO
217 END IF
218C---------1,4,3
219 jj = 3
220 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
221 t6(1) = nc(3,i)
222 t6(2) = nc(1,i)
223 t6(3) = nc(4,i)
224 t6(4) = nc(7,i)
225 t6(5) = nc(8,i)
226 t6(6) = nc(10,i)
227 DO j=1,4
228 nskin = nskin + 1
229 ixskin(1,nskin) = iparts(n)
230 t3(1:3) = t6(tia4s(1:3,j))
231 ixskin(2:4,nskin) = t3(1:3)
232 ixskin(5,nskin) = ixskin(4,nskin)
233 ixskin(6,nskin) = ixs(nixs-1,n)
234 ixskin(7,nskin) = nskin
235 END DO
236 END IF
237C---------1,2,4
238 jj = 6
239 IF(mod(ll,pwr(jj+1))/pwr(jj) == 0) THEN
240 t6(1:2) = nc(1:2,i)
241 t6(3) = nc(4,i)
242 t6(4) = nc(5,i)
243 t6(5) = nc(9,i)
244 t6(6) = nc(8,i)
245 DO j=1,4
246 nskin = nskin + 1
247 ixskin(1,nskin) = iparts(n)
248 t3(1:3) = t6(tia4s(1:3,j))
249 ixskin(2:4,nskin) = t3(1:3)
250 ixskin(5,nskin) = ixskin(4,nskin)
251 ixskin(6,nskin) = ixs(nixs-1,n)
252 ixskin(7,nskin) = nskin
253 END DO
254 END IF
255 ENDDO
256C-----------S8 (&degenerated),S20
257 ELSE
258 DO i=1,nel
259 n = i + nft
260 nc(1:8,i) = ixs(2:9,n)
261 ll=tag_skins6(n)
262C--------per face :
263 DO jj=1,6
264 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
265 DO ii=1,4
266 ns(ii)=nc(faces(ii,jj),i)
267 END DO
268C---------for degenerated cases
269 DO k1=1,3
270 DO k2=k1+1,4
271 IF(ns(k2)==ns(k1))ns(k2)=0
272 END DO
273 END DO
274 nn=0
275 DO k1=1,4
276 n1=ns(k1)
277 IF(n1/=0)THEN
278 nn=nn+1
279 ns(nn)= n1
280 END IF
281 END DO
282 IF (nn>2) THEN
283 nskin = nskin + 1
284 ixskin(1,nskin) = iparts(n)
285 ixskin(2:4,nskin) = ns(1:3)
286 IF (nn > 3) THEN
287 ixskin(5,nskin) = ns(4)
288 ELSE
289 ixskin(5,nskin) = ixskin(4,nskin)
290 END IF
291 ixskin(6,nskin) = ixs(nixs-1,n)
292 ixskin(7,nskin) = nskin
293 END IF
294 ENDDO
295 ENDDO
296 ENDIF
297 ENDIF !IF (IGTYP==
298 END DO ! NG=1,NGROUP
299C-----------
300 RETURN
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261