OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_s4.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ section_s4()

subroutine section_s4 ( integer lft,
integer llt,
integer nft,
integer nseg,
integer n1,
integer n2,
integer n3,
integer, dimension(2,*) nstrf,
x,
v,
fsav,
integer, dimension(nixs,*) ixs,
fopta,
secfcum,
fx,
fy,
fz,
integer type,
integer nsint,
integer ifram,
integer nnod,
integer, dimension(*) nod,
ms,
integer, dimension(6,*) ixs10,
integer isolnod,
xsec,
double precision, dimension(12,6) fbsav6,
integer iparsens )

Definition at line 32 of file section_s4.F.

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