OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_c.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| section_c ../engine/source/tools/sect/section_c.F
25!||--- called by ------------------------------------------------------
26!|| forintc ../engine/source/elements/forintc.F
27!||--- calls -----------------------------------------------------
28!|| section_skew ../engine/source/tools/sect/section_skew.F
29!|| section_skewp ../engine/source/tools/sect/section_skewp.F
30!|| sum_6_float_sect ../engine/source/system/parit.F
31!||--- uses -----------------------------------------------------
32!|| element_mod ../common_source/modules/elements/element_mod.f90
33!||====================================================================
34 SUBROUTINE section_c(LFT,LLT,NFT,NSEG,N1,
35 2 N2,N3,NSTRF,X,V,VR,FSAV,
36 3 IXC,FOPTA,SECFCUM,
37 4 FX,FY,FZ,MX,MY,MZ,
38 5 TYPE,NSINT,IFRAM,NNOD,NOD,MS,
39 7 XSEC,FBSAV6,IPARSENS)
40 use element_mod , only : nixc
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "comlock.inc"
53#include "com01_c.inc"
54#include "com08_c.inc"
55#include "param_c.inc"
56#include "parit_c.inc"
57#include "scr06_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,
62 . TYPE,NSINT,IPARSENS
63 INTEGER NSTRF(2,*),IXC(NIXC,*),IFRAM,NNOD,NOD(*)
64 my_real
65 . X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),
66 . v(3,*), vr(3,*),ms(*),xsec(4,3)
67 DOUBLE PRECISION FBSAV6(12,6)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER JJJ(MVSIZ), UNPACK(0:15,4),
72 . nsa, j, i, k, i1, i2, ipack, n, jj
73 my_real
74 . fx(mvsiz,4), fy(mvsiz,4), fz(mvsiz,4), mx(mvsiz,4),
75 . my(mvsiz,4), mz(mvsiz,4), fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
76 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
77 . dy1(mvsiz), dz1(mvsiz),fst(16), dx11, dy11, dz11,
78 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
79 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
80 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
81 . fsty, fstz, dmx, dmy, dmz
82 my_real
83 . msxphi, msyphi, mszphi, fsxphi,
84 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
85 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
86 my_real
87 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
88 my_real
89 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
90 my_real
91 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
92 my_real
93 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
94 my_real
95 . al4,al5,al6
96 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
97C-----------------------------------------------
98C
99 DATA unpack/0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,
100 . 0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,
101 . 0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,
102 . 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1/
103C---------------------------------------------------------
104C---------------------------------------------------------
105 IF(nseg==0) RETURN
106 IF(lft+nft>nstrf(1,nseg)) RETURN
107 IF(llt+nft<nstrf(1,1 )) RETURN
108C---------------------------------------------------------
109 nsa=0
110C
111 IF(ivector==0) THEN
112 DO 20 j=1,nseg
113 i=nstrf(1,j)-nft
114 IF (lft>i) GOTO 20
115 IF (llt<i) GOTO 30
116 nsa=nsa+1
117 jjj(nsa)=j
118 20 CONTINUE
119 30 CONTINUE
120 ELSE
121 IF (nseg>15) THEN
122 DO j=1,nseg
123 i=nstrf(1,j)-nft
124 IF (lft<=i.AND.llt>=i) THEN
125 nsa=nsa+1
126 jjj(nsa)=j
127 ENDIF
128 ENDDO
129 ELSE
130 DO j=1,nseg
131 i=nstrf(1,j)-nft
132 IF (lft<=i.AND.llt>=i) THEN
133 nsa=nsa+1
134 jjj(nsa)=j
135 ENDIF
136 ENDDO
137 ENDIF
138 ENDIF
139C
140 IF(nsa==0)RETURN
141C
142 IF(type+nsint==0)THEN
143C
144 IF(iparsens/=0) THEN
145 ALLOCATE(fstparit(12,nsa))
146 DO j=1,nsa
147 DO i=1,12
148 fstparit(i,j) = zero
149 ENDDO
150 ENDDO
151 ENDIF
152C
153 DO i=1,16
154 fst(i)=zero
155 ENDDO
156C
157 IF(nspmd==1) THEN
158 CALL section_skew(n1 ,n2 ,n3 ,x , xxc, yyc, zzc,
159 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
160 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
161 ELSE
162 CALL section_skewp(xxc, yyc, zzc, xx4 , yy4 , zz4 ,
163 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
164 3 xxn, yyn, zzn, ifram, n1 , xsec)
165 END IF
166C
167
168 IF((iparsens==0)) THEN ! Parith/Off
169 IF (nsa>15.OR.ivector==0) THEN
170 DO k=1,nsa
171 j = jjj(k)
172 i = nstrf(1,j)-nft
173 ipack = nstrf(2,j)
174 DO i1=1,4
175 IF(unpack(ipack,i1)/=0)THEN
176C
177 n = ixc(i1+1,nstrf(1,j))
178 dx11=x(1,n)
179 dy11=x(2,n)
180 dz11=x(3,n)
181C
182 fsx=fx(i,i1)
183 fsy=fy(i,i1)
184 fsz=fz(i,i1)
185C
186 fn=fsx*xxn+fsy*yyn+fsz*zzn
187 fsnx=fn*xxn
188 fsny=fn*yyn
189 fsnz=fn*zzn
190 fstx=fsx-fsnx
191 fsty=fsy-fsny
192 fstz=fsz-fsnz
193C
194 dx11=dx11-xxc
195 dy11=dy11-yyc
196 dz11=dz11-zzc
197C
198 msx =dy11*fsz-dz11*fsy
199 msy =dz11*fsx-dx11*fsz
200 msz =dx11*fsy-dy11*fsx
201C
202 msx =msx+mx(i,i1)
203 msy =msy+my(i,i1)
204 msz =msz+mz(i,i1)
205C
206 dmx =msx*xx4+msy*yy4+msz*zz4
207 dmy =msx*xx5+msy*yy5+msz*zz5
208 dmz =msx*xx6+msy*yy6+msz*zz6
209C
210 fst(1)=fst(1)+fsnx
211 fst(2)=fst(2)+fsny
212 fst(3)=fst(3)+fsnz
213 fst(4)=fst(4)+fstx
214 fst(5)=fst(5)+fsty
215 fst(6)=fst(6)+fstz
216 fst(7)=fst(7)+dmx
217 fst(8)=fst(8)+dmy
218 fst(9)=fst(9)+dmz
219 fst(10) = fst(10) + fsx
220 fst(11) = fst(11) + fsy
221 fst(12) = fst(12) + fsz
222 fst(13) = fst(13) + msx
223 fst(14) = fst(14) + msy
224 fst(15) = fst(15) + msz
225 fst(16)=fst(16)
226 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
227 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
228C
229 ENDIF
230 ENDDO
231 ENDDO
232 ELSE
233 DO k=1,nsa
234 j = jjj(k)
235 i = nstrf(1,j)-nft
236 ipack = nstrf(2,j)
237 DO i1=1,4
238 IF(unpack(ipack,i1)/=0)THEN
239 n = ixc(i1+1,nstrf(1,j))
240C
241 dx11=x(1,n)
242 dy11=x(2,n)
243 dz11=x(3,n)
244C
245 fsx=fx(i,i1)
246 fsy=fy(i,i1)
247 fsz=fz(i,i1)
248C
249 fn=fsx*xxn+fsy*yyn+fsz*zzn
250 fsnx=fn*xxn
251 fsny=fn*yyn
252 fsnz=fn*zzn
253 fstx=fsx-fsnx
254 fsty=fsy-fsny
255 fstz=fsz-fsnz
256C
257 dx11=dx11-xxc
258 dy11=dy11-yyc
259 dz11=dz11-zzc
260C
261 msx =dy11*fsz-dz11*fsy
262 msy =dz11*fsx-dx11*fsz
263 msz =dx11*fsy-dy11*fsx
264C
265 msx =msx+mx(i,i1)
266 msy =msy+my(i,i1)
267 msz =msz+mz(i,i1)
268C
269 dmx =msx*xx4+msy*yy4+msz*zz4
270 dmy =msx*xx5+msy*yy5+msz*zz5
271 dmz =msx*xx6+msy*yy6+msz*zz6
272C
273 fst(1)=fst(1)+fsnx
274 fst(2)=fst(2)+fsny
275 fst(3)=fst(3)+fsnz
276 fst(4)=fst(4)+fstx
277 fst(5)=fst(5)+fsty
278 fst(6)=fst(6)+fstz
279 fst(7)=fst(7)+dmx
280 fst(8)=fst(8)+dmy
281 fst(9)=fst(9)+dmz
282 fst(10) = fst(10) + fsx
283 fst(11) = fst(11) + fsy
284 fst(12) = fst(12) + fsz
285 fst(13) = fst(13) + msx
286 fst(14) = fst(14) + msy
287 fst(15) = fst(15) + msz
288 fst(16)=fst(16)
289 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
290 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
291 ENDIF
292 ENDDO
293 ENDDO
294 ENDIF
295 ELSE ! Parith/On
296 IF (nsa>15.OR.ivector==0) THEN
297 DO k=1,nsa
298 j = jjj(k)
299 i = nstrf(1,j)-nft
300 ipack = nstrf(2,j)
301 DO i1=1,4
302 IF(unpack(ipack,i1)/=0)THEN
303C
304 n = ixc(i1+1,nstrf(1,j))
305 dx11=x(1,n)
306 dy11=x(2,n)
307 dz11=x(3,n)
308C
309 fsx=fx(i,i1)
310 fsy=fy(i,i1)
311 fsz=fz(i,i1)
312C
313 fn=fsx*xxn+fsy*yyn+fsz*zzn
314 fsnx=fn*xxn
315 fsny=fn*yyn
316 fsnz=fn*zzn
317 fstx=fsx-fsnx
318 fsty=fsy-fsny
319 fstz=fsz-fsnz
320C
321 dx11=dx11-xxc
322 dy11=dy11-yyc
323 dz11=dz11-zzc
324C
325 msx =dy11*fsz-dz11*fsy
326 msy =dz11*fsx-dx11*fsz
327 msz =dx11*fsy-dy11*fsx
328C
329 msx =msx+mx(i,i1)
330 msy =msy+my(i,i1)
331 msz =msz+mz(i,i1)
332C
333 dmx =msx*xx4+msy*yy4+msz*zz4
334 dmy =msx*xx5+msy*yy5+msz*zz5
335 dmz =msx*xx6+msy*yy6+msz*zz6
336C
337 fst(1)=fst(1)+fsnx
338 fst(2)=fst(2)+fsny
339 fst(3)=fst(3)+fsnz
340 fst(4)=fst(4)+fstx
341 fst(5)=fst(5)+fsty
342 fst(6)=fst(6)+fstz
343 fst(7)=fst(7)+dmx
344 fst(8)=fst(8)+dmy
345 fst(9)=fst(9)+dmz
346 fst(10) = fst(10) + fsx
347 fst(11) = fst(11) + fsy
348 fst(12) = fst(12) + fsz
349 fst(13) = fst(13) + msx
350 fst(14) = fst(14) + msy
351 fst(15) = fst(15) + msz
352 fst(16)=fst(16)
353 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
354 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
355C
356 fstparit(1,k)=fstparit(1,k)+fsnx
357 fstparit(2,k)=fstparit(2,k)+fsny
358 fstparit(3,k)=fstparit(3,k)+fsnz
359 fstparit(4,k)=fstparit(4,k)+fstx
360 fstparit(5,k)=fstparit(5,k)+fsty
361 fstparit(6,k)=fstparit(6,k)+fstz
362 fstparit(7,k)=fstparit(7,k)+msx
363 fstparit(8,k)=fstparit(8,k)+msy
364 fstparit(9,k)=fstparit(9,k)+msz
365 fstparit(10,k)=fstparit(10,k) +
366 . ( xx4*(fsnx+fstx) +
367 . yy4*(fsny+fsty) +
368 . zz4*(fsnz+fstz) )
369 fstparit(11,k)=fstparit(11,k) +
370 . ( xx5*(fsnx+fstx) +
371 . yy5*(fsny+fsty) +
372 . zz5*(fsnz+fstz) )
373 fstparit(12,k)=fstparit(12,k) +
374 . ( xx6*(fsnx+fstx) +
375 . yy6*(fsny+fsty) +
376 . zz6*(fsnz+fstz) )
377C
378 ENDIF
379 ENDDO
380 ENDDO
381C
382 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
383C
384 ELSE
385 DO k=1,nsa
386 j = jjj(k)
387 i = nstrf(1,j)-nft
388 ipack = nstrf(2,j)
389 DO i1=1,4
390 IF(unpack(ipack,i1)/=0)THEN
391 n = ixc(i1+1,nstrf(1,j))
392C
393 dx11=x(1,n)
394 dy11=x(2,n)
395 dz11=x(3,n)
396C
397 fsx=fx(i,i1)
398 fsy=fy(i,i1)
399 fsz=fz(i,i1)
400C
401 fn=fsx*xxn+fsy*yyn+fsz*zzn
402 fsnx=fn*xxn
403 fsny=fn*yyn
404 fsnz=fn*zzn
405 fstx=fsx-fsnx
406 fsty=fsy-fsny
407 fstz=fsz-fsnz
408C
409 dx11=dx11-xxc
410 dy11=dy11-yyc
411 dz11=dz11-zzc
412C
413 msx =dy11*fsz-dz11*fsy
414 msy =dz11*fsx-dx11*fsz
415 msz =dx11*fsy-dy11*fsx
416C
417 msx =msx+mx(i,i1)
418 msy =msy+my(i,i1)
419 msz =msz+mz(i,i1)
420C
421 dmx =msx*xx4+msy*yy4+msz*zz4
422 dmy =msx*xx5+msy*yy5+msz*zz5
423 dmz =msx*xx6+msy*yy6+msz*zz6
424C
425 fst(1)=fst(1)+fsnx
426 fst(2)=fst(2)+fsny
427 fst(3)=fst(3)+fsnz
428 fst(4)=fst(4)+fstx
429 fst(5)=fst(5)+fsty
430 fst(6)=fst(6)+fstz
431 fst(7)=fst(7)+dmx
432 fst(8)=fst(8)+dmy
433 fst(9)=fst(9)+dmz
434 fst(10) = fst(10) + fsx
435 fst(11) = fst(11) + fsy
436 fst(12) = fst(12) + fsz
437 fst(13) = fst(13) + msx
438 fst(14) = fst(14) + msy
439 fst(15) = fst(15) + msz
440 fst(16)=fst(16)
441 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
442 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
443C
444 fstparit(1,k)=fstparit(1,k)+fsnx
445 fstparit(2,k)=fstparit(2,k)+fsny
446 fstparit(3,k)=fstparit(3,k)+fsnz
447 fstparit(4,k)=fstparit(4,k)+fstx
448 fstparit(5,k)=fstparit(5,k)+fsty
449 fstparit(6,k)=fstparit(6,k)+fstz
450 fstparit(7,k)=fstparit(7,k)+msx
451 fstparit(8,k)=fstparit(8,k)+msy
452 fstparit(9,k)=fstparit(9,k)+msz
453 fstparit(10,k)=fstparit(10,k) +
454 . ( xx4*(fsnx+fstx) +
455 . yy4*(fsny+fsty) +
456 . zz4*(fsnz+fstz) )
457 fstparit(11,k)=fstparit(11,k) +
458 . ( xx5*(fsnx+fstx) +
459 . yy5*(fsny+fsty) +
460 . zz5*(fsnz+fstz) )
461 fstparit(12,k)=fstparit(12,k) +
462 . ( xx6*(fsnx+fstx) +
463 . yy6*(fsny+fsty) +
464 . zz6*(fsnz+fstz) )
465C
466 ENDIF
467 ENDDO
468 ENDDO
469 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
470C
471 ENDIF
472 ENDIF
473C
474#include "lockon.inc"
475 fsav(1)=fsav(1)+dt12*fst(1)
476 fsav(2)=fsav(2)+dt12*fst(2)
477 fsav(3)=fsav(3)+dt12*fst(3)
478 fsav(4)=fsav(4)+dt12*fst(4)
479 fsav(5)=fsav(5)+dt12*fst(5)
480 fsav(6)=fsav(6)+dt12*fst(6)
481 fsav(7)=fsav(7)+dt12*fst(7)
482 fsav(8)=fsav(8)+dt12*fst(8)
483 fsav(9)=fsav(9)+dt12*fst(9)
484 fsav(10)=fsav(10)+dt12*fst(16)
485 fsav(31)=fsav(31)+dt12*fst(13)
486 fsav(32)=fsav(32)+dt12*fst(14)
487 fsav(33)=fsav(33)+dt12*fst(15)
488 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
489 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
490 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
491 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
492 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
493 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
494 fsav(37)=xxc
495 fsav(38)=yyc
496 fsav(39)=zzc
497 fopta(1) = fopta(1) + fst(10)
498 fopta(2) = fopta(2) + fst(11)
499 fopta(3) = fopta(3) + fst(12)
500 fopta(4) = fopta(4) + fst(13)
501 fopta(5) = fopta(5) + fst(14)
502 fopta(6) = fopta(6) + fst(15)
503#include "lockoff.inc"
504C
505 ELSE
506C
507#include "lockon.inc"
508 DO i1=1,4
509 DO k=1,nsa
510 j = jjj(k)
511 i = nstrf(1,j)-nft
512 ipack = nstrf(2,j)
513 IF(unpack(ipack,i1)/=0)THEN
514 n = ixc(i1+1,nstrf(1,j))
515 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
516 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
517 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
518 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
519 secfcum(6,n)=secfcum(6,n)+my(i,i1)
520 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
521 ENDIF
522 ENDDO
523 ENDDO
524#include "lockoff.inc"
525 ENDIF
526C
527 IF((nsa/=0).AND.(iparsens/=0)) THEN
528 DEALLOCATE(fstparit)
529 ENDIF
530C
531 RETURN
532 END
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_c
subroutine section_c(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixc, fopta, secfcum, fx, fy, fz, mx, my, mz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)
Definition section_c.F:40
section_skew
subroutine section_skew(n1, n2, n3, x, xxc, yyc, zzc, xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn, ifram, nnod, nod, ms)
Definition section_skew.F:40
section_skewp
subroutine section_skewp(xxc, yyc, zzc, xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn, ifram, n1, xsec)
Definition section_skewp.F:40