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 33 of file i24nitschfor3.F.

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