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 34 of file h3d_sol_skin_ixskin.F.

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