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