OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_s4.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_s4 ../engine/source/tools/sect/section_s4.F
25!||--- called by ------------------------------------------------------
26!|| forint ../engine/source/elements/forint.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_s4 (LFT,LLT,NFT,NSEG,N1,
35 2 N2,N3,NSTRF,X,V,FSAV,
36 3 IXS,FOPTA,SECFCUM,FX,FY,
37 4 FZ,TYPE,NSINT,IFRAM,NNOD,NOD,MS,
38 6 IXS10,ISOLNOD,XSEC,FBSAV6,
39 7 IPARSENS)
40 use element_mod , only : nixs
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 "com04_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,TYPE,NSINT
61 INTEGER NSTRF(2,*),IXS(NIXS,*),IFRAM,NNOD,NOD(*),
62 . IXS10(6,*),ISOLNOD
63 INTEGER IPARSENS
64 my_real X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),XSEC(4,3),
65 . fx(mvsiz,10), fy(mvsiz,10), fz(mvsiz,10), v(3,*) ,ms(*)
66 DOUBLE PRECISION FBSAV6(12,6)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER JJJ(MVSIZ), UNPACK(0:511,10),
71 . nsa, j, i, k, i1, ipack, n,power2(14),iperm(4),ii
72 my_real
73 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
74 . dx1(mvsiz),dy1(mvsiz), dz1(mvsiz),fst(16),
75 . msx, msy, msz,
76 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
77 . xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
78 . fsty, fstz, dmx, dmy, dmz
79 DATA power2/1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192/
80 DATA iperm/1,3,6,5/
81 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
82C---------------------------------------------------------
83C---------------------------------------------------------
84 IF(nseg==0)RETURN
85 IF(lft+nft>nstrf(1,nseg))RETURN
86 IF(llt+nft<nstrf(1,1 ))RETURN
87C---------------------------------------------------------
88 nsa=0
89C
90 DO i=1,8
91 DO j=0,255
92 unpack(j,i)=mod(j/power2(i),2)
93 ENDDO
94 ENDDO
95C
96 DO j=1,nseg
97 i=nstrf(1,j)-nft
98 IF (lft>i) cycle
99 IF (llt<i) EXIT
100 nsa=nsa+1
101 jjj(nsa)=j
102 ENDDO
103C
104 IF(nsa==0)RETURN
105C
106 IF(type+nsint==0)THEN
107C
108 IF(iparsens/=0) THEN
109 ALLOCATE(fstparit(12,nsa))
110 DO j=1,nsa
111 DO i=1,12
112 fstparit(i,j) = zero
113 ENDDO
114 ENDDO
115 ENDIF
116C
117 DO i=1,16
118 fst(i)=zero
119 ENDDO
120C
121 IF(nspmd==1) THEN
122 CALL section_skew(n1 ,n2 ,n3 ,x , xxc, yyc, zzc,
123 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
124 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
125 ELSE
126 CALL section_skewp(xxc, yyc, zzc, xx4 , yy4 , zz4 ,
127 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
128 3 xxn, yyn, zzn, ifram, n1 , xsec)
129 END IF
130C
131 IF(iparsens==0) THEN ! Parith/Off
132 DO k=1,nsa
133 j = jjj(k)
134 i = nstrf(1,j)-nft
135 ipack = mod(nstrf(2,j),256)
136 DO ii=1,4
137 i1=iperm(ii)
138 IF(unpack(ipack,i1)/=0)THEN
139 fx1(k)=-fx(i,ii)
140 fy1(k)=-fy(i,ii)
141 fz1(k)=-fz(i,ii)
142C
143 n = ixs(i1+1,nstrf(1,j))
144 dx1(k)=x(1,n)
145 dy1(k)=x(2,n)
146 dz1(k)=x(3,n)
147C
148 fsx=fx1(k)
149 fsy=fy1(k)
150 fsz=fz1(k)
151C
152 fn=fsx*xxn+fsy*yyn+fsz*zzn
153 fsnx=fn*xxn
154 fsny=fn*yyn
155 fsnz=fn*zzn
156 fstx=fsx-fsnx
157 fsty=fsy-fsny
158 fstz=fsz-fsnz
159C
160 dx1(k)=dx1(k)-xxc
161 dy1(k)=dy1(k)-yyc
162 dz1(k)=dz1(k)-zzc
163C
164 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
165 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
166 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
167C
168 dmx =msx*xx4+msy*yy4+msz*zz4
169 dmy =msx*xx5+msy*yy5+msz*zz5
170 dmz =msx*xx6+msy*yy6+msz*zz6
171C
172 fst(1)=fst(1)+fsnx
173 fst(2)=fst(2)+fsny
174 fst(3)=fst(3)+fsnz
175 fst(4)=fst(4)+fstx
176 fst(5)=fst(5)+fsty
177 fst(6)=fst(6)+fstz
178 fst(7)=fst(7)+dmx
179 fst(8)=fst(8)+dmy
180 fst(9)=fst(9)+dmz
181 fst(10) = fst(10) + fsx
182 fst(11) = fst(11) + fsy
183 fst(12) = fst(12) + fsz
184 fst(13) = fst(13) + msx
185 fst(14) = fst(14) + msy
186 fst(15) = fst(15) + msz
187 fst(16)=fst(16)
188 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
189C
190 ENDIF
191 ENDDO
192 ENDDO
193 ELSE ! PArith/on
194 DO k=1,nsa
195 j = jjj(k)
196 i = nstrf(1,j)-nft
197 ipack = mod(nstrf(2,j),256)
198 DO ii=1,4
199 i1=iperm(ii)
200 IF(unpack(ipack,i1)/=0)THEN
201 fx1(k)=-fx(i,ii)
202 fy1(k)=-fy(i,ii)
203 fz1(k)=-fz(i,ii)
204C
205 n = ixs(i1+1,nstrf(1,j))
206 dx1(k)=x(1,n)
207 dy1(k)=x(2,n)
208 dz1(k)=x(3,n)
209C
210 fsx=fx1(k)
211 fsy=fy1(k)
212 fsz=fz1(k)
213C
214 fn=fsx*xxn+fsy*yyn+fsz*zzn
215 fsnx=fn*xxn
216 fsny=fn*yyn
217 fsnz=fn*zzn
218 fstx=fsx-fsnx
219 fsty=fsy-fsny
220 fstz=fsz-fsnz
221C
222 dx1(k)=dx1(k)-xxc
223 dy1(k)=dy1(k)-yyc
224 dz1(k)=dz1(k)-zzc
225C
226 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
227 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
228 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
229C
230 dmx =msx*xx4+msy*yy4+msz*zz4
231 dmy =msx*xx5+msy*yy5+msz*zz5
232 dmz =msx*xx6+msy*yy6+msz*zz6
233C
234 fst(1)=fst(1)+fsnx
235 fst(2)=fst(2)+fsny
236 fst(3)=fst(3)+fsnz
237 fst(4)=fst(4)+fstx
238 fst(5)=fst(5)+fsty
239 fst(6)=fst(6)+fstz
240 fst(7)=fst(7)+dmx
241 fst(8)=fst(8)+dmy
242 fst(9)=fst(9)+dmz
243 fst(10) = fst(10) + fsx
244 fst(11) = fst(11) + fsy
245 fst(12) = fst(12) + fsz
246 fst(13) = fst(13) + msx
247 fst(14) = fst(14) + msy
248 fst(15) = fst(15) + msz
249 fst(16)=fst(16)
250 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
251C
252 fstparit(1,k)=fstparit(1,k)+fsnx
253 fstparit(2,k)=fstparit(2,k)+fsny
254 fstparit(3,k)=fstparit(3,k)+fsnz
255 fstparit(4,k)=fstparit(4,k)+fstx
256 fstparit(5,k)=fstparit(5,k)+fsty
257 fstparit(6,k)=fstparit(6,k)+fstz
258 fstparit(7,k)=fstparit(7,k)+msx
259 fstparit(8,k)=fstparit(8,k)+msy
260 fstparit(9,k)=fstparit(9,k)+msz
261 fstparit(10,k)=fstparit(10,k) +
262 . ( xx4*(fsnx+fstx) +
263 . yy4*(fsny+fsty) +
264 . zz4*(fsnz+fstz) )
265 fstparit(11,k)=fstparit(11,k) +
266 . ( xx5*(fsnx+fstx) +
267 . yy5*(fsny+fsty) +
268 . zz5*(fsnz+fstz) )
269 fstparit(12,k)=fstparit(12,k) +
270 . ( xx6*(fsnx+fstx) +
271 . yy6*(fsny+fsty) +
272 . zz6*(fsnz+fstz) )
273 ENDIF
274 ENDDO
275 ENDDO
276 ENDIF
277C
278 IF(isolnod==10)THEN
279 IF(iparsens==0) THEN ! Parith/Off
280 DO k=1,nsa
281 j = jjj(k)
282 i = nstrf(1,j)-nft
283 ipack = nstrf(2,j)
284 DO ii=5,10
285 i1=ii+4
286 IF(mod(ipack/power2(i1),2)/=0)THEN
287 fx1(k)=-fx(i,ii)
288 fy1(k)=-fy(i,ii)
289 fz1(k)=-fz(i,ii)
290C
291 n = ixs10(i1-8,nstrf(1,j)-numels8)
292 dx1(k)=x(1,n)
293 dy1(k)=x(2,n)
294 dz1(k)=x(3,n)
295C
296 fsx=fx1(k)
297 fsy=fy1(k)
298 fsz=fz1(k)
299C
300 fn=fsx*xxn+fsy*yyn+fsz*zzn
301 fsnx=fn*xxn
302 fsny=fn*yyn
303 fsnz=fn*zzn
304 fstx=fsx-fsnx
305 fsty=fsy-fsny
306 fstz=fsz-fsnz
307C
308 dx1(k)=dx1(k)-xxc
309 dy1(k)=dy1(k)-yyc
310 dz1(k)=dz1(k)-zzc
311C
312 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
313 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
314 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
315C
316 dmx =msx*xx4+msy*yy4+msz*zz4
317 dmy =msx*xx5+msy*yy5+msz*zz5
318 dmz =msx*xx6+msy*yy6+msz*zz6
319C
320 fst(1)=fst(1)+fsnx
321 fst(2)=fst(2)+fsny
322 fst(3)=fst(3)+fsnz
323 fst(4)=fst(4)+fstx
324 fst(5)=fst(5)+fsty
325 fst(6)=fst(6)+fstz
326 fst(7)=fst(7)+dmx
327 fst(8)=fst(8)+dmy
328 fst(9)=fst(9)+dmz
329 fst(10) = fst(10) + fsx
330 fst(11) = fst(11) + fsy
331 fst(12) = fst(12) + fsz
332 fst(13) = fst(13) + msx
333 fst(14) = fst(14) + msy
334 fst(15) = fst(15) + msz
335 fst(16)=fst(16)
336 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
337C
338 ENDIF
339 ENDDO
340 ENDDO
341 ELSE ! Parith/On
342 DO k=1,nsa
343 j = jjj(k)
344 i = nstrf(1,j)-nft
345 ipack = nstrf(2,j)
346 DO ii=5,10
347 i1=ii+4
348 IF(mod(ipack/power2(i1),2)/=0)THEN
349 fx1(k)=-fx(i,ii)
350 fy1(k)=-fy(i,ii)
351 fz1(k)=-fz(i,ii)
352C
353 n = ixs10(i1-8,nstrf(1,j)-numels8)
354 dx1(k)=x(1,n)
355 dy1(k)=x(2,n)
356 dz1(k)=x(3,n)
357C
358 fsx=fx1(k)
359 fsy=fy1(k)
360 fsz=fz1(k)
361C
362 fn=fsx*xxn+fsy*yyn+fsz*zzn
363 fsnx=fn*xxn
364 fsny=fn*yyn
365 fsnz=fn*zzn
366 fstx=fsx-fsnx
367 fsty=fsy-fsny
368 fstz=fsz-fsnz
369C
370 dx1(k)=dx1(k)-xxc
371 dy1(k)=dy1(k)-yyc
372 dz1(k)=dz1(k)-zzc
373C
374 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
375 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
376 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
377C
378 dmx =msx*xx4+msy*yy4+msz*zz4
379 dmy =msx*xx5+msy*yy5+msz*zz5
380 dmz =msx*xx6+msy*yy6+msz*zz6
381C
382 fst(1)=fst(1)+fsnx
383 fst(2)=fst(2)+fsny
384 fst(3)=fst(3)+fsnz
385 fst(4)=fst(4)+fstx
386 fst(5)=fst(5)+fsty
387 fst(6)=fst(6)+fstz
388 fst(7)=fst(7)+dmx
389 fst(8)=fst(8)+dmy
390 fst(9)=fst(9)+dmz
391 fst(10) = fst(10) + fsx
392 fst(11) = fst(11) + fsy
393 fst(12) = fst(12) + fsz
394 fst(13) = fst(13) + msx
395 fst(14) = fst(14) + msy
396 fst(15) = fst(15) + msz
397 fst(16)=fst(16)
398 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
399C
400 fstparit(1,k)=fstparit(1,k)+fsnx
401 fstparit(2,k)=fstparit(2,k)+fsny
402 fstparit(3,k)=fstparit(3,k)+fsnz
403 fstparit(4,k)=fstparit(4,k)+fstx
404 fstparit(5,k)=fstparit(5,k)+fsty
405 fstparit(6,k)=fstparit(6,k)+fstz
406 fstparit(7,k)=fstparit(7,k)+msx
407 fstparit(8,k)=fstparit(8,k)+msy
408 fstparit(9,k)=fstparit(9,k)+msz
409 fstparit(10,k)=fstparit(10,k) +
410 . ( xx4*(fsnx+fstx) +
411 . yy4*(fsny+fsty) +
412 . zz4*(fsnz+fstz) )
413 fstparit(11,k)=fstparit(11,k) +
414 . ( xx5*(fsnx+fstx) +
415 . yy5*(fsny+fsty) +
416 . zz5*(fsnz+fstz) )
417 fstparit(12,k)=fstparit(12,k) +
418 . ( xx6*(fsnx+fstx) +
419 . yy6*(fsny+fsty) +
420 . zz6*(fsnz+fstz) )
421 ENDIF
422 ENDDO
423 ENDDO
424 ENDIF
425 END IF
426C
427#include "lockon.inc"
428 fsav(1)=fsav(1)+dt12*fst(1)
429 fsav(2)=fsav(2)+dt12*fst(2)
430 fsav(3)=fsav(3)+dt12*fst(3)
431 fsav(4)=fsav(4)+dt12*fst(4)
432 fsav(5)=fsav(5)+dt12*fst(5)
433 fsav(6)=fsav(6)+dt12*fst(6)
434 fsav(7)=fsav(7)+dt12*fst(7)
435 fsav(8)=fsav(8)+dt12*fst(8)
436 fsav(9)=fsav(9)+dt12*fst(9)
437 fsav(10)=fsav(10)+dt12*fst(16)
438 fsav(31)=fsav(31)+dt12*fst(13)
439 fsav(32)=fsav(32)+dt12*fst(14)
440 fsav(33)=fsav(33)+dt12*fst(15)
441 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
442 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
443 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
444 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
445 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
446 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
447 fsav(37)=xxc
448 fsav(38)=yyc
449 fsav(39)=zzc
450 fopta(1) = fopta(1) + fst(10)
451 fopta(2) = fopta(2) + fst(11)
452 fopta(3) = fopta(3) + fst(12)
453 fopta(4) = fopta(4) + fst(13)
454 fopta(5) = fopta(5) + fst(14)
455 fopta(6) = fopta(6) + fst(15)
456#include "lockoff.inc"
457C
458 IF(iparsens/=0) THEN ! Parith/On
459 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
460 DEALLOCATE(fstparit)
461 ENDIF
462
463 ELSE
464C
465#include "lockon.inc"
466 DO ii=1,4
467 i1=iperm(ii)
468 DO k=1,nsa
469 j = jjj(k)
470 i = nstrf(1,j)-nft
471 ipack = mod(nstrf(2,j),256)
472 IF(unpack(ipack,i1)/=0)THEN
473 n = ixs(i1+1,nstrf(1,j))
474 secfcum(1,n)=secfcum(1,n)- fx(i,ii)
475 secfcum(2,n)=secfcum(2,n)- fy(i,ii)
476 secfcum(3,n)=secfcum(3,n)- fz(i,ii)
477 ENDIF
478 ENDDO
479 ENDDO
480 IF(isolnod==10)THEN
481 DO ii=5,10
482 i1=ii+4
483 DO k=1,nsa
484 j = jjj(k)
485 i = nstrf(1,j)-nft
486 ipack = nstrf(2,j)
487 IF(mod(ipack/power2(i1),2)/=0)THEN
488 n = ixs10(i1-8,nstrf(1,j)-numels8)
489 secfcum(1,n)=secfcum(1,n)- fx(i,ii)
490 secfcum(2,n)=secfcum(2,n)- fy(i,ii)
491 secfcum(3,n)=secfcum(3,n)- fz(i,ii)
492 ENDIF
493 ENDDO
494 ENDDO
495 END IF
496#include "lockoff.inc"
497 ENDIF
498C
499 RETURN
500 END
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_s4
subroutine section_s4(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, fsav, ixs, fopta, secfcum, fx, fy, fz, type, nsint, ifram, nnod, nod, ms, ixs10, isolnod, xsec, fbsav6, iparsens)
Definition section_s4.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