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

Go to the source code of this file.

Functions/Subroutines

subroutine i24nitschfor3 (ipari, intbuf_tab, iparit, stressmean, intlist, nbintc, x, iads, forneqs, forneqsky, itab, ixs, iads10, iads20, iads16, nfacnit)

Function/Subroutine Documentation

◆ i24nitschfor3()

subroutine i24nitschfor3 ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer iparit,
stressmean,
integer, dimension(*) intlist,
integer nbintc,
x,
integer, dimension(8,*) iads,
forneqs,
forneqsky,
integer, dimension(*) itab,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) iads10,
integer, dimension(12,*) iads20,
integer, dimension(8,*) iads16,
integer nfacnit )

Definition at line 34 of file i24nitschfor3.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42 USE message_mod
43 USE intbufdef_mod
44 use element_mod , only : nixs
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53#include "com04_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER IPARIT, NBINTC, NFACNIT
58 INTEGER IPARI(NPARI,*) ,INTLIST(*) ,IADS(8,*) ,ITAB(*),IXS(NIXS,*),
59 . IADS10(6,*),IADS20(12,*),IADS16(8,*)
60 my_real stressmean(6,*) ,x(3,*) ,forneqs(3,*) ,forneqsky(3*nfacnit,*)
61 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER,ALLOCATABLE,DIMENSION(:) :: ITAG
66 INTEGER I ,NI ,NIN ,NTY ,NSN ,NRTS ,SN ,IE ,NF ,N1 ,N2 ,N3 ,N4 ,
67 . N ,K1 ,K2 ,K3 ,K4 ,INTNITSCHE ,ADS1 ,ADS2 ,ADS3 ,ADS4 ,IE10,
68 . NS1 ,NS2 ,NS3 ,NS4
69 my_real
70 . sx1 ,sy1 ,sz1 ,sx2 ,sy2 ,sz2 ,sx3 ,sy3 ,
71 . sz3 ,forx ,fory ,forz,
72 . signx ,signy ,signz
73C-----------------------------------------------
74C Equivalent nodal force computation using element mean stress:
75C mean of contribution of all surrounded elements
76C FORNEQS = SUM(PHI*STRESSMEAN*Facet_Normal*Facet_Area)
77C-----------------------------------------------
78 ALLOCATE(itag(numnod))
79 itag(1:numnod)=0
80 IF(iparit==0)THEN
81 DO ni=1,nbintc
82 nin = intlist(ni)
83 nty = ipari(7,nin)
84 nsn = ipari(5,nin)
85 nrts = ipari(3,nin)
86 intnitsche = ipari(86,nin)
87 IF(nty==24 .AND.intnitsche > 0) THEN
88 DO i=1,nrts
89 ie = intbuf_tab(nin)%IELNRTS(i)
90
91 ns1 = intbuf_tab(nin)%IRECTS(4*(i-1)+1)
92 ns2 = intbuf_tab(nin)%IRECTS(4*(i-1)+2)
93 ns3 = intbuf_tab(nin)%IRECTS(4*(i-1)+3)
94 ns4 = intbuf_tab(nin)%IRECTS(4*(i-1)+4)
95
96 n1 = intbuf_tab(nin)%NSV(ns1)
97 n2 = intbuf_tab(nin)%NSV(ns2)
98 n3 = intbuf_tab(nin)%NSV(ns3)
99 n4 = intbuf_tab(nin)%NSV(ns4)
100
101 ads1 = intbuf_tab(nin)%ADRECTS(4*(i-1)+1)
102 ads2 = intbuf_tab(nin)%ADRECTS(4*(i-1)+2)
103 ads3 = intbuf_tab(nin)%ADRECTS(4*(i-1)+3)
104 ads4 = intbuf_tab(nin)%ADRECTS(4*(i-1)+4)
105
106 IF(ie > 0) THEN
107
108 IF(n4 /=n3) THEN
109 sx1 = x(1,n3) - x(1,n1)
110 sy1 = x(2,n3) - x(2,n1)
111 sz1 = x(3,n3) - x(3,n1)
112 sx2 = x(1,n4) - x(1,n2)
113 sy2 = x(2,n4) - x(2,n2)
114 sz2 = x(3,n4) - x(3,n2)
115 sx3 = sy1*sz2 - sz1*sy2
116 sy3 = sz1*sx2 - sx1*sz2
117 sz3 = sx1*sy2 - sy1*sx2
118c AREAS= HALF*SQRT(SX3*SX3+SY3*SY3+SZ3*SZ3)
119
120C
121 signx = stressmean(1,ie)*sx3 + stressmean(4,ie)*sy3 +stressmean(6,ie)*sz3
122 signy = stressmean(4,ie)*sx3 + stressmean(2,ie)*sy3 +stressmean(5,ie)*sz3
123 signz = stressmean(6,ie)*sx3 + stressmean(5,ie)*sy3 +stressmean(3,ie)*sz3
124
125
126C
127
128 forx = one_over_16*signx
129 fory = one_over_16*signy
130 forz = one_over_16*signz
131
132C
133 IF(itag(n1)==0.AND.ads1 < 10) THEN
134 forneqs(1,n1) = forneqs(1,n1) + forx
135 forneqs(2,n1) = forneqs(2,n1) + fory
136 forneqs(3,n1) = forneqs(3,n1) + forz
137 ELSEIF(itag(n1)==0) THEN
138 forneqs(1,n1) = forneqs(1,n1) + half*forx
139 forneqs(2,n1) = forneqs(2,n1) + half*fory
140 forneqs(3,n1) = forneqs(3,n1) + half*forz
141 ENDIF
142 IF(itag(n2)==0.AND.ads2 < 10) THEN
143 forneqs(1,n2) = forneqs(1,n2) + forx
144 forneqs(2,n2) = forneqs(2,n2) + fory
145 forneqs(3,n2) = forneqs(3,n2) + forz
146 ELSEIF(itag(n2)==0) THEN
147 forneqs(1,n2) = forneqs(1,n2) + half*forx
148 forneqs(2,n2) = forneqs(2,n2) + half*fory
149 forneqs(3,n2) = forneqs(3,n2) + half*forz
150 ENDIF
151 IF(itag(n3)==0.AND.ads3 < 10) THEN
152 forneqs(1,n3) = forneqs(1,n3) + forx
153 forneqs(2,n3) = forneqs(2,n3) + fory
154 forneqs(3,n3) = forneqs(3,n3) + forz
155 ELSEIF(itag(n3)==0) THEN
156 forneqs(1,n3) = forneqs(1,n3) + half*forx
157 forneqs(2,n3) = forneqs(2,n3) + half*fory
158 forneqs(3,n3) = forneqs(3,n3) + half*forz
159 ENDIF
160 IF (itag(n4)==0.AND.ads1 < 10) THEN
161 forneqs(1,n4) = forneqs(1,n4) + forx
162 forneqs(2,n4) = forneqs(2,n4) + fory
163 forneqs(3,n4) = forneqs(3,n4) + forz
164 ELSEIF(itag(n4)==0) THEN
165 forneqs(1,n4) = forneqs(1,n4) + half*forx
166 forneqs(2,n4) = forneqs(2,n4) + half*fory
167 forneqs(3,n4) = forneqs(3,n4) + half*forz
168 ENDIF
169
170 ELSE
171
172 sx1 = x(1,n2) - x(1,n1)
173 sy1 = x(2,n2) - x(2,n1)
174 sz1 = x(3,n2) - x(3,n1)
175 sx2 = x(1,n3) - x(1,n1)
176 sy2 = x(2,n3) - x(2,n1)
177 sz2 = x(3,n3) - x(3,n1)
178 sx3 = sy1*sz2 - sz1*sy2
179 sy3 = sz1*sx2 - sx1*sz2
180 sz3 = sx1*sy2 - sy1*sx2
181c AREAS= SQRT(SX3*SX3+SY3*SY3+SZ3*SZ3)
182C
183 signx = stressmean(1,ie)*sx3 + stressmean(4,ie)*sy3 +stressmean(6,ie)*sz3
184 signy = stressmean(4,ie)*sx3 + stressmean(2,ie)*sy3 +stressmean(5,ie)*sz3
185 signz = stressmean(6,ie)*sx3 + stressmean(5,ie)*sy3 +stressmean(3,ie)*sz3
186C
187
188 forx = one_over_8*signx
189 fory = one_over_8*signy
190 forz = one_over_8*signz
191C
192 IF(itag(n1)==0.AND.ads1 < 10) THEN
193 forneqs(1,n1) = forneqs(1,n1) + forx
194 forneqs(2,n1) = forneqs(2,n1) + fory
195 forneqs(3,n1) = forneqs(3,n1) + forz
196 ELSEIF(itag(n1)==0) THEN
197 forneqs(1,n1) = forneqs(1,n1) + third*forx
198 forneqs(2,n1) = forneqs(2,n1) + third*fory
199 forneqs(3,n1) = forneqs(3,n1) + third*forz
200 ENDIF
201 IF(itag(n2)==0.AND.ads2 < 10) THEN
202 forneqs(1,n2) = forneqs(1,n2) + forx
203 forneqs(2,n2) = forneqs(2,n2) + fory
204 forneqs(3,n2) = forneqs(3,n2) + forz
205 ELSEIF(itag(n2)==0) THEN
206 forneqs(1,n2) = forneqs(1,n2) + third*forx
207 forneqs(2,n2) = forneqs(2,n2) + third*fory
208 forneqs(3,n2) = forneqs(3,n2) + third*forz
209 ENDIF
210 IF(itag(n3)==0.AND.ads3 < 10) THEN
211 forneqs(1,n3) = forneqs(1,n3) + forx
212 forneqs(2,n3) = forneqs(2,n3) + fory
213 forneqs(3,n3) = forneqs(3,n3) + forz
214 ELSEIF(itag(n3)==0) THEN
215 forneqs(1,n3) = forneqs(1,n3) + third*forx
216 forneqs(2,n3) = forneqs(2,n3) + third*fory
217 forneqs(3,n3) = forneqs(3,n3) + third*forz
218 ENDIF
219 ENDIF
220
221 ENDIF
222
223 ENDDO
224 DO n=1,nsn
225 sn = intbuf_tab(nin)%NSV(n)
226 itag(sn) = 1
227 ENDDO
228 ENDIF
229 ENDDO
230
231 ELSE !IPARIT
232
233 DO ni=1,nbintc
234 nin = intlist(ni)
235 nty = ipari(7,nin)
236 nsn = ipari(5,nin)
237 nrts = ipari(3,nin)
238 intnitsche = ipari(86,nin)
239 IF(nty==24 .AND.intnitsche > 0) THEN
240 DO i=1,nrts
241 ie = intbuf_tab(nin)%IELNRTS(i)
242 nf = intbuf_tab(nin)%FACNRTS(i)
243 ns1 = intbuf_tab(nin)%IRECTS(4*(i-1)+1)
244 ns2 = intbuf_tab(nin)%IRECTS(4*(i-1)+2)
245 ns3 = intbuf_tab(nin)%IRECTS(4*(i-1)+3)
246 ns4 = intbuf_tab(nin)%IRECTS(4*(i-1)+4)
247
248 n1 = intbuf_tab(nin)%NSV(ns1)
249 n2 = intbuf_tab(nin)%NSV(ns2)
250 n3 = intbuf_tab(nin)%NSV(ns3)
251 n4 = intbuf_tab(nin)%NSV(ns4)
252
253 ads1 = intbuf_tab(nin)%ADRECTS(4*(i-1)+1)
254 ads2 = intbuf_tab(nin)%ADRECTS(4*(i-1)+2)
255 ads3 = intbuf_tab(nin)%ADRECTS(4*(i-1)+3)
256 ads4 = intbuf_tab(nin)%ADRECTS(4*(i-1)+4)
257
258
259 IF(ie > 0) THEN
260
261 IF(n4 /=n3) THEN
262 sx1 = x(1,n3) - x(1,n1)
263 sy1 = x(2,n3) - x(2,n1)
264 sz1 = x(3,n3) - x(3,n1)
265 sx2 = x(1,n4) - x(1,n2)
266 sy2 = x(2,n4) - x(2,n2)
267 sz2 = x(3,n4) - x(3,n2)
268 sx3 = sy1*sz2 - sz1*sy2
269 sy3 = sz1*sx2 - sx1*sz2
270 sz3 = sx1*sy2 - sy1*sx2
271c AREAS= SQRT(SX3*SX3+SY3*SY3+SZ3*SZ3)
272C
273 signx = stressmean(1,ie)*sx3 + stressmean(4,ie)*sy3 +stressmean(6,ie)*sz3
274 signy = stressmean(4,ie)*sx3 + stressmean(2,ie)*sy3 +stressmean(5,ie)*sz3
275 signz = stressmean(6,ie)*sx3 + stressmean(5,ie)*sy3 +stressmean(3,ie)*sz3
276C
277
278 forx = one_over_16*signx
279 fory = one_over_16*signy
280 forz = one_over_16*signz
281C
282
283 IF(ads1 < 10) THEN
284 k1 = iads(ads1,ie)
285 ELSEIF(ads1 < 40) THEN
286 k1 = iads20(ads1-20,ie)
287 ELSEIF(ads1 < 50) THEN
288 k1 = iads16(ads1-40,ie)
289 ENDIF
290
291 IF(ads2 < 10) THEN
292 k2 = iads(ads2,ie)
293 ELSEIF(ads1 < 40) THEN
294 k2 = iads20(ads2-20,ie)
295 ELSEIF(ads1 < 50) THEN
296 k2 = iads16(ads2-40,ie)
297 ENDIF
298
299 IF(ads3 < 10) THEN
300 k3 = iads(ads3,ie)
301 ELSEIF(ads3 < 40) THEN
302 k3 = iads20(ads3-20,ie)
303 ELSEIF(ads3 < 50) THEN
304 k3 = iads16(ads3-40,ie)
305 ENDIF
306
307 IF(ads4 < 10) THEN
308 k4 = iads(ads4,ie)
309 ELSEIF(ads3 < 40) THEN
310 k4 = iads20(ads4-20,ie)
311 ELSEIF(ads1 < 50) THEN
312 k4 = iads16(ads4-40,ie)
313 ENDIF
314
315
316 IF(ads1 < 10) THEN
317 forneqsky(3*(nf-1)+1,k1) = forx
318 forneqsky(3*(nf-1)+2,k1) = fory
319 forneqsky(3*(nf-1)+3,k1) = forz
320 ELSE
321 forneqsky(3*(nf-1)+1,k1) = half*forx
322 forneqsky(3*(nf-1)+2,k1) = half*fory
323 forneqsky(3*(nf-1)+3,k1) = half*forz
324 ENDIF
325
326 IF(ads2 < 10) THEN
327 forneqsky(3*(nf-1)+1,k2) = forx
328 forneqsky(3*(nf-1)+2,k2) = fory
329 forneqsky(3*(nf-1)+3,k2) = forz
330 ELSE
331 forneqsky(3*(nf-1)+1,k2) = half*forx
332 forneqsky(3*(nf-1)+2,k2) = half*fory
333 forneqsky(3*(nf-1)+3,k2) = half*forz
334 ENDIF
335
336 IF(ads3 < 10) THEN
337 forneqsky(3*(nf-1)+1,k3) = forx
338 forneqsky(3*(nf-1)+2,k3) = fory
339 forneqsky(3*(nf-1)+3,k3) = forz
340 ELSE
341 forneqsky(3*(nf-1)+1,k3) = half*forx
342 forneqsky(3*(nf-1)+2,k3) = half*fory
343 forneqsky(3*(nf-1)+3,k3) = half*forz
344 ENDIF
345
346 IF(ads4 < 10) THEN
347 forneqsky(3*(nf-1)+1,k4) = forx
348 forneqsky(3*(nf-1)+2,k4) = fory
349 forneqsky(3*(nf-1)+3,k4) = forz
350 ELSE
351 forneqsky(3*(nf-1)+1,k4) = half*forx
352 forneqsky(3*(nf-1)+2,k4) = half*fory
353 forneqsky(3*(nf-1)+3,k4) = half*forz
354 ENDIF
355
356 ELSE
357
358 sx1 = x(1,n2) - x(1,n1)
359 sy1 = x(2,n2) - x(2,n1)
360 sz1 = x(3,n2) - x(3,n1)
361 sx2 = x(1,n3) - x(1,n1)
362 sy2 = x(2,n3) - x(2,n1)
363 sz2 = x(3,n3) - x(3,n1)
364 sx3 = sy1*sz2 - sz1*sy2
365 sy3 = sz1*sx2 - sx1*sz2
366 sz3 = sx1*sy2 - sy1*sx2
367c AREAS= SQRT(SX3*SX3+SY3*SY3+SZ3*SZ3)
368C
369 signx = stressmean(1,ie)*sx3 + stressmean(4,ie)*sy3 +stressmean(6,ie)*sz3
370 signy = stressmean(4,ie)*sx3 + stressmean(2,ie)*sy3 +stressmean(5,ie)*sz3
371 signz = stressmean(6,ie)*sx3 + stressmean(5,ie)*sy3 +stressmean(3,ie)*sz3
372C
373
374 forx = one_over_8*signx
375 fory = one_over_8*signy
376 forz = one_over_8*signz
377C
378 IF(ie > numels8) ie10 = ie - numels8
379
380 IF(ads1 < 10) THEN
381 k1 = iads(ads1,ie)
382 ELSE
383 k1 = iads10(ads1-10,ie10)
384 ENDIF
385
386 IF(ads2 < 10) THEN
387 k2 = iads(ads2,ie)
388 ELSE
389 k2 = iads10(ads2-10,ie10)
390 ENDIF
391
392 IF(ads3 < 10) THEN
393 k3 = iads(ads3,ie)
394 ELSE
395 k3 = iads10(ads3-10,ie10)
396 ENDIF
397
398
399 IF(ads1 < 10) THEN
400 forneqsky(3*(nf-1)+1,k1) = forx
401 forneqsky(3*(nf-1)+2,k1) = fory
402 forneqsky(3*(nf-1)+3,k1) = forz
403 ELSE
404 forneqsky(3*(nf-1)+1,k1) = third*forx
405 forneqsky(3*(nf-1)+2,k1) = third*fory
406 forneqsky(3*(nf-1)+3,k1) = third*forz
407 ENDIF
408
409 IF(ads2 < 10) THEN
410 forneqsky(3*(nf-1)+1,k2) = forx
411 forneqsky(3*(nf-1)+2,k2) = fory
412 forneqsky(3*(nf-1)+3,k2) = forz
413 ELSE
414 forneqsky(3*(nf-1)+1,k2) = third*forx
415 forneqsky(3*(nf-1)+2,k2) = third*fory
416 forneqsky(3*(nf-1)+3,k2) = third*forz
417 ENDIF
418
419 IF(ads3 < 10) THEN
420 forneqsky(3*(nf-1)+1,k3) = forx
421 forneqsky(3*(nf-1)+2,k3) = fory
422 forneqsky(3*(nf-1)+3,k3) = forz
423 ELSE
424 forneqsky(3*(nf-1)+1,k3) = third*forx
425 forneqsky(3*(nf-1)+2,k3) = third*fory
426 forneqsky(3*(nf-1)+3,k3) = third*forz
427 ENDIF
428 ENDIF
429C
430 ENDIF
431
432
433 ENDDO
434
435 DO n=1,nsn
436 sn = intbuf_tab(nin)%NSV(n)
437 itag(sn) = 1
438 ENDDO
439 ENDIF
440 ENDDO
441
442 ENDIF
443
444
445C-----------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257