OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_s.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_s ../engine/source/tools/sect/section_s.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!||====================================================================
32 SUBROUTINE section_s (LFT,LLT,NFT,NSEG,N1,
33 2 N2,N3,NSTRF,X,V,FSAV,
34 3 IXS,FOPTA,SECFCUM,FX,FY,FZ,
35 4 TYPE,NSINT,IFRAM,NNOD,NOD,MS,
36 6 IXS20,IXS16,ISOLNOD,XSEC,FBSAV6,
37 7 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 "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(*),IXS20(12,*),IXS16(8,*),ISOLNOD
59 INTEGER IPARSENS
60 my_real X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),
61 . FX(MVSIZ,20), FY(MVSIZ,20), FZ(MVSIZ,20), V(3,*) ,MS(*),XSEC(4,3)
62 DOUBLE PRECISION FBSAV6(12,6)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER JJJ(MVSIZ), UNPACK(0:511,10), NSA, J, I, K, I1, I2, IPACK, N,POWER2(20), JJ
67 my_real fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
68 . dx1(mvsiz),dy1(mvsiz), dz1(mvsiz),fst(16),
69 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
70 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
71 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
72 . fsty, fstz, dmx, dmy, dmz
73 my_real msxphi, msyphi, mszphi, fsxphi,
74 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
75 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
76 my_real xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
77 my_real yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
78 my_real zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
79 my_real al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
80 my_real al4,al5,al6
81 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
82 DATA power2/1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536,131072,262144,524288/
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 DO i=1,16
109 fst(i)=zero
110 ENDDO
111C
112 IF(iparsens==1) THEN
113 ALLOCATE(fstparit(12,nsa))
114 DO j=1,nsa
115 DO i=1,12
116 fstparit(i,j) = zero
117 ENDDO
118 ENDDO
119 ENDIF
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 i1=1,8
137 IF(unpack(ipack,i1)/=0)THEN
138 fx1(k)=-fx(i,i1)
139 fy1(k)=-fy(i,i1)
140 fz1(k)=-fz(i,i1)
141C
142 n = ixs(i1+1,nstrf(1,j))
143 dx1(k)=x(1,n)
144 dy1(k)=x(2,n)
145 dz1(k)=x(3,n)
146C
147 fsx=fx1(k)
148 fsy=fy1(k)
149 fsz=fz1(k)
150C
151 fn=fsx*xxn+fsy*yyn+fsz*zzn
152 fsnx=fn*xxn
153 fsny=fn*yyn
154 fsnz=fn*zzn
155 fstx=fsx-fsnx
156 fsty=fsy-fsny
157 fstz=fsz-fsnz
158C
159 dx1(k)=dx1(k)-xxc
160 dy1(k)=dy1(k)-yyc
161 dz1(k)=dz1(k)-zzc
162C
163 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
164 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
165 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
166C
167 dmx =msx*xx4+msy*yy4+msz*zz4
168 dmy =msx*xx5+msy*yy5+msz*zz5
169 dmz =msx*xx6+msy*yy6+msz*zz6
170C
171 fst(1)=fst(1)+fsnx
172 fst(2)=fst(2)+fsny
173 fst(3)=fst(3)+fsnz
174 fst(4)=fst(4)+fstx
175 fst(5)=fst(5)+fsty
176 fst(6)=fst(6)+fstz
177 fst(7)=fst(7)+dmx
178 fst(8)=fst(8)+dmy
179 fst(9)=fst(9)+dmz
180 fst(10) = fst(10) + fsx
181 fst(11) = fst(11) + fsy
182 fst(12) = fst(12) + fsz
183 fst(13) = fst(13) + msx
184 fst(14) = fst(14) + msy
185 fst(15) = fst(15) + msz
186 fst(16)=fst(16)
187 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
188C
189 ENDIF
190 ENDDO
191 ENDDO
192 ELSE ! Parith/on
193 DO k=1,nsa
194 j = jjj(k)
195 i = nstrf(1,j)-nft
196 ipack = mod(nstrf(2,j),256)
197 DO i1=1,8
198 IF(unpack(ipack,i1)/=0)THEN
199 fx1(k)=-fx(i,i1)
200 fy1(k)=-fy(i,i1)
201 fz1(k)=-fz(i,i1)
202C
203 n = ixs(i1+1,nstrf(1,j))
204 dx1(k)=x(1,n)
205 dy1(k)=x(2,n)
206 dz1(k)=x(3,n)
207C
208 fsx=fx1(k)
209 fsy=fy1(k)
210 fsz=fz1(k)
211C
212 fn=fsx*xxn+fsy*yyn+fsz*zzn
213 fsnx=fn*xxn
214 fsny=fn*yyn
215 fsnz=fn*zzn
216 fstx=fsx-fsnx
217 fsty=fsy-fsny
218 fstz=fsz-fsnz
219C
220 dx1(k)=dx1(k)-xxc
221 dy1(k)=dy1(k)-yyc
222 dz1(k)=dz1(k)-zzc
223C
224 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
225 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
226 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
227C
228 dmx =msx*xx4+msy*yy4+msz*zz4
229 dmy =msx*xx5+msy*yy5+msz*zz5
230 dmz =msx*xx6+msy*yy6+msz*zz6
231C
232 fst(1)=fst(1)+fsnx
233 fst(2)=fst(2)+fsny
234 fst(3)=fst(3)+fsnz
235 fst(4)=fst(4)+fstx
236 fst(5)=fst(5)+fsty
237 fst(6)=fst(6)+fstz
238 fst(7)=fst(7)+dmx
239 fst(8)=fst(8)+dmy
240 fst(9)=fst(9)+dmz
241 fst(10) = fst(10) + fsx
242 fst(11) = fst(11) + fsy
243 fst(12) = fst(12) + fsz
244 fst(13) = fst(13) + msx
245 fst(14) = fst(14) + msy
246 fst(15) = fst(15) + msz
247 fst(16)=fst(16)
248 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
249C
250 fstparit(1,k)=fstparit(1,k)+fsnx
251 fstparit(2,k)=fstparit(2,k)+fsny
252 fstparit(3,k)=fstparit(3,k)+fsnz
253 fstparit(4,k)=fstparit(4,k)+fstx
254 fstparit(5,k)=fstparit(5,k)+fsty
255 fstparit(6,k)=fstparit(6,k)+fstz
256 fstparit(7,k)=fstparit(7,k)+msx
257 fstparit(8,k)=fstparit(8,k)+msy
258 fstparit(9,k)=fstparit(9,k)+msz
259 fstparit(10,k)=fstparit(10,k) +
260 . ( xx4*(fsnx+fstx) +
261 . yy4*(fsny+fsty) +
262 . zz4*(fsnz+fstz) )
263 fstparit(11,k)=fstparit(11,k) +
264 . ( xx5*(fsnx+fstx) +
265 . yy5*(fsny+fsty) +
266 . zz5*(fsnz+fstz) )
267 fstparit(12,k)=fstparit(12,k) +
268 . ( xx6*(fsnx+fstx) +
269 . yy6*(fsny+fsty) +
270 . zz6*(fsnz+fstz) )
271 ENDIF
272 ENDDO
273 ENDDO
274 ENDIF
275C
276 IF(isolnod==20)THEN
277C bricks 20
278 IF(iparsens==0) THEN ! Parith/Off
279 DO k=1,nsa
280 j = jjj(k)
281 i = nstrf(1,j)-nft
282 ipack = nstrf(2,j)
283 DO i1=9,20
284 IF(mod(ipack/power2(i1),2)/=0)THEN
285 fx1(k)=-fx(i,i1)
286 fy1(k)=-fy(i,i1)
287 fz1(k)=-fz(i,i1)
288C
289 n = ixs20(i1-8,nstrf(1,j)-numels8-numels10)
290 dx1(k)=x(1,n)
291 dy1(k)=x(2,n)
292 dz1(k)=x(3,n)
293C
294 fsx=fx1(k)
295 fsy=fy1(k)
296 fsz=fz1(k)
297C
298 fn=fsx*xxn+fsy*yyn+fsz*zzn
299 fsnx=fn*xxn
300 fsny=fn*yyn
301 fsnz=fn*zzn
302 fstx=fsx-fsnx
303 fsty=fsy-fsny
304 fstz=fsz-fsnz
305C
306 dx1(k)=dx1(k)-xxc
307 dy1(k)=dy1(k)-yyc
308 dz1(k)=dz1(k)-zzc
309C
310 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
311 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
312 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
313C
314 dmx =msx*xx4+msy*yy4+msz*zz4
315 dmy =msx*xx5+msy*yy5+msz*zz5
316 dmz =msx*xx6+msy*yy6+msz*zz6
317C
318 fst(1)=fst(1)+fsnx
319 fst(2)=fst(2)+fsny
320 fst(3)=fst(3)+fsnz
321 fst(4)=fst(4)+fstx
322 fst(5)=fst(5)+fsty
323 fst(6)=fst(6)+fstz
324 fst(7)=fst(7)+dmx
325 fst(8)=fst(8)+dmy
326 fst(9)=fst(9)+dmz
327 fst(10) = fst(10) + fsx
328 fst(11) = fst(11) + fsy
329 fst(12) = fst(12) + fsz
330 fst(13) = fst(13) + msx
331 fst(14) = fst(14) + msy
332 fst(15) = fst(15) + msz
333 fst(16)=fst(16)
334 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
335C
336 ENDIF
337 ENDDO
338 ENDDO
339 ELSE ! Parith/on
340 DO k=1,nsa
341 j = jjj(k)
342 i = nstrf(1,j)-nft
343 ipack = nstrf(2,j)
344 DO i1=9,20
345 IF(mod(ipack/power2(i1),2)/=0)THEN
346 fx1(k)=-fx(i,i1)
347 fy1(k)=-fy(i,i1)
348 fz1(k)=-fz(i,i1)
349C
350 n = ixs20(i1-8,nstrf(1,j)-numels8-numels10)
351 dx1(k)=x(1,n)
352 dy1(k)=x(2,n)
353 dz1(k)=x(3,n)
354C
355 fsx=fx1(k)
356 fsy=fy1(k)
357 fsz=fz1(k)
358C
359 fn=fsx*xxn+fsy*yyn+fsz*zzn
360 fsnx=fn*xxn
361 fsny=fn*yyn
362 fsnz=fn*zzn
363 fstx=fsx-fsnx
364 fsty=fsy-fsny
365 fstz=fsz-fsnz
366C
367 dx1(k)=dx1(k)-xxc
368 dy1(k)=dy1(k)-yyc
369 dz1(k)=dz1(k)-zzc
370C
371 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
372 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
373 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
374C
375 dmx =msx*xx4+msy*yy4+msz*zz4
376 dmy =msx*xx5+msy*yy5+msz*zz5
377 dmz =msx*xx6+msy*yy6+msz*zz6
378C
379 fst(1)=fst(1)+fsnx
380 fst(2)=fst(2)+fsny
381 fst(3)=fst(3)+fsnz
382 fst(4)=fst(4)+fstx
383 fst(5)=fst(5)+fsty
384 fst(6)=fst(6)+fstz
385 fst(7)=fst(7)+dmx
386 fst(8)=fst(8)+dmy
387 fst(9)=fst(9)+dmz
388 fst(10) = fst(10) + fsx
389 fst(11) = fst(11) + fsy
390 fst(12) = fst(12) + fsz
391 fst(13) = fst(13) + msx
392 fst(14) = fst(14) + msy
393 fst(15) = fst(15) + msz
394 fst(16)=fst(16)
395 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
396C
397 fstparit(1,k)=fstparit(1,k)+fsnx
398 fstparit(2,k)=fstparit(2,k)+fsny
399 fstparit(3,k)=fstparit(3,k)+fsnz
400 fstparit(4,k)=fstparit(4,k)+fstx
401 fstparit(5,k)=fstparit(5,k)+fsty
402 fstparit(6,k)=fstparit(6,k)+fstz
403 fstparit(7,k)=fstparit(7,k)+msx
404 fstparit(8,k)=fstparit(8,k)+msy
405 fstparit(9,k)=fstparit(9,k)+msz
406 fstparit(10,k)=fstparit(10,k) +
407 . ( xx4*(fsnx+fstx) +
408 . yy4*(fsny+fsty) +
409 . zz4*(fsnz+fstz) )
410 fstparit(11,k)=fstparit(11,k) +
411 . ( xx5*(fsnx+fstx) +
412 . yy5*(fsny+fsty) +
413 . zz5*(fsnz+fstz) )
414 fstparit(12,k)=fstparit(12,k) +
415 . ( xx6*(fsnx+fstx) +
416 . yy6*(fsny+fsty) +
417 . zz6*(fsnz+fstz) )
418 ENDIF
419 ENDDO
420 ENDDO
421 ENDIF
422 ELSE IF(isolnod==16)THEN
423C shells 16
424 IF(iparsens==0) THEN ! Parith/Off
425 DO k=1,nsa
426 j = jjj(k)
427 i = nstrf(1,j)-nft
428 ipack = nstrf(2,j)
429 DO i1=9,16
430 IF(mod(ipack/power2(i1),2)/=0)THEN
431 fx1(k)=-fx(i,i1)
432 fy1(k)=-fy(i,i1)
433 fz1(k)=-fz(i,i1)
434C
435 n = ixs16(i1-8,nstrf(1,j)-numels8-numels10-numels20)
436 dx1(k)=x(1,n)
437 dy1(k)=x(2,n)
438 dz1(k)=x(3,n)
439C
440 fsx=fx1(k)
441 fsy=fy1(k)
442 fsz=fz1(k)
443C
444 fn=fsx*xxn+fsy*yyn+fsz*zzn
445 fsnx=fn*xxn
446 fsny=fn*yyn
447 fsnz=fn*zzn
448 fstx=fsx-fsnx
449 fsty=fsy-fsny
450 fstz=fsz-fsnz
451C
452 dx1(k)=dx1(k)-xxc
453 dy1(k)=dy1(k)-yyc
454 dz1(k)=dz1(k)-zzc
455C
456 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
457 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
458 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
459C
460 dmx =msx*xx4+msy*yy4+msz*zz4
461 dmy =msx*xx5+msy*yy5+msz*zz5
462 dmz =msx*xx6+msy*yy6+msz*zz6
463C
464 fst(1)=fst(1)+fsnx
465 fst(2)=fst(2)+fsny
466 fst(3)=fst(3)+fsnz
467 fst(4)=fst(4)+fstx
468 fst(5)=fst(5)+fsty
469 fst(6)=fst(6)+fstz
470 fst(7)=fst(7)+dmx
471 fst(8)=fst(8)+dmy
472 fst(9)=fst(9)+dmz
473 fst(10) = fst(10) + fsx
474 fst(11) = fst(11) + fsy
475 fst(12) = fst(12) + fsz
476 fst(13) = fst(13) + msx
477 fst(14) = fst(14) + msy
478 fst(15) = fst(15) + msz
479 fst(16)=fst(16)
480 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
481C
482 ENDIF
483 ENDDO
484 ENDDO
485 ELSE ! Parith/on
486 DO k=1,nsa
487 j = jjj(k)
488 i = nstrf(1,j)-nft
489 ipack = nstrf(2,j)
490 DO i1=9,16
491 IF(mod(ipack/power2(i1),2)/=0)THEN
492 fx1(k)=-fx(i,i1)
493 fy1(k)=-fy(i,i1)
494 fz1(k)=-fz(i,i1)
495C
496 n = ixs16(i1-8,nstrf(1,j)-numels8-numels10-numels20)
497 dx1(k)=x(1,n)
498 dy1(k)=x(2,n)
499 dz1(k)=x(3,n)
500C
501 fsx=fx1(k)
502 fsy=fy1(k)
503 fsz=fz1(k)
504C
505 fn=fsx*xxn+fsy*yyn+fsz*zzn
506 fsnx=fn*xxn
507 fsny=fn*yyn
508 fsnz=fn*zzn
509 fstx=fsx-fsnx
510 fsty=fsy-fsny
511 fstz=fsz-fsnz
512C
513 dx1(k)=dx1(k)-xxc
514 dy1(k)=dy1(k)-yyc
515 dz1(k)=dz1(k)-zzc
516C
517 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
518 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
519 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
520C
521 dmx =msx*xx4+msy*yy4+msz*zz4
522 dmy =msx*xx5+msy*yy5+msz*zz5
523 dmz =msx*xx6+msy*yy6+msz*zz6
524C
525 fst(1)=fst(1)+fsnx
526 fst(2)=fst(2)+fsny
527 fst(3)=fst(3)+fsnz
528 fst(4)=fst(4)+fstx
529 fst(5)=fst(5)+fsty
530 fst(6)=fst(6)+fstz
531 fst(7)=fst(7)+dmx
532 fst(8)=fst(8)+dmy
533 fst(9)=fst(9)+dmz
534 fst(10) = fst(10) + fsx
535 fst(11) = fst(11) + fsy
536 fst(12) = fst(12) + fsz
537 fst(13) = fst(13) + msx
538 fst(14) = fst(14) + msy
539 fst(15) = fst(15) + msz
540 fst(16)=fst(16)
541 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
542C
543 fstparit(1,k)=fstparit(1,k)+fsnx
544 fstparit(2,k)=fstparit(2,k)+fsny
545 fstparit(3,k)=fstparit(3,k)+fsnz
546 fstparit(4,k)=fstparit(4,k)+fstx
547 fstparit(5,k)=fstparit(5,k)+fsty
548 fstparit(6,k)=fstparit(6,k)+fstz
549 fstparit(7,k)=fstparit(7,k)+msx
550 fstparit(8,k)=fstparit(8,k)+msy
551 fstparit(9,k)=fstparit(9,k)+msz
552 fstparit(10,k)=fstparit(10,k) +
553 . ( xx4*(fsnx+fstx) +
554 . yy4*(fsny+fsty) +
555 . zz4*(fsnz+fstz) )
556 fstparit(11,k)=fstparit(11,k) +
557 . ( xx5*(fsnx+fstx) +
558 . yy5*(fsny+fsty) +
559 . zz5*(fsnz+fstz) )
560 fstparit(12,k)=fstparit(12,k) +
561 . ( xx6*(fsnx+fstx) +
562 . yy6*(fsny+fsty) +
563 . zz6*(fsnz+fstz) )
564 ENDIF
565 ENDDO
566 ENDDO
567 ENDIF
568 END IF
569#include "lockon.inc"
570 fsav(1)=fsav(1)+dt12*fst(1)
571 fsav(2)=fsav(2)+dt12*fst(2)
572 fsav(3)=fsav(3)+dt12*fst(3)
573 fsav(4)=fsav(4)+dt12*fst(4)
574 fsav(5)=fsav(5)+dt12*fst(5)
575 fsav(6)=fsav(6)+dt12*fst(6)
576 fsav(7)=fsav(7)+dt12*fst(7)
577 fsav(8)=fsav(8)+dt12*fst(8)
578 fsav(9)=fsav(9)+dt12*fst(9)
579 fsav(10)=fsav(10)+dt12*fst(16)
580 fsav(31)=fsav(31)+dt12*fst(13)
581 fsav(32)=fsav(32)+dt12*fst(14)
582 fsav(33)=fsav(33)+dt12*fst(15)
583 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
584 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
585 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
586 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
587 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
588 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
589 fsav(37)=xxc
590 fsav(38)=yyc
591 fsav(39)=zzc
592 fopta(1) = fopta(1) + fst(10)
593 fopta(2) = fopta(2) + fst(11)
594 fopta(3) = fopta(3) + fst(12)
595 fopta(4) = fopta(4) + fst(13)
596 fopta(5) = fopta(5) + fst(14)
597 fopta(6) = fopta(6) + fst(15)
598#include "lockoff.inc"
599C
600 IF(iparsens/=0) THEN ! Parith/On
601 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
602 DEALLOCATE(fstparit)
603 ENDIF
604
605 ELSE
606C
607#include "lockon.inc"
608 DO i1=1,8
609 DO k=1,nsa
610 j = jjj(k)
611 i = nstrf(1,j)-nft
612 ipack = mod(nstrf(2,j),256)
613 IF(unpack(ipack,i1)/=0)THEN
614 n = ixs(i1+1,nstrf(1,j))
615 secfcum(1,n)=secfcum(1,n)-fx(i,i1)
616 secfcum(2,n)=secfcum(2,n)-fy(i,i1)
617 secfcum(3,n)=secfcum(3,n)-fz(i,i1)
618 ENDIF
619 ENDDO
620 ENDDO
621 IF(isolnod==20)THEN
622C bricks 20
623 DO i1=9,20
624 DO k=1,nsa
625 j = jjj(k)
626 i = nstrf(1,j)-nft
627 ipack = nstrf(2,j)
628 IF(mod(ipack/power2(i1),2)/=0)THEN
629 n = ixs20(i1-8,nstrf(1,j)-numels8-numels10)
630 secfcum(1,n)=secfcum(1,n)-fx(i,i1)
631 secfcum(2,n)=secfcum(2,n)-fy(i,i1)
632 secfcum(3,n)=secfcum(3,n)-fz(i,i1)
633 ENDIF
634 ENDDO
635 ENDDO
636 ELSE IF(isolnod==16)THEN
637C shells 16
638 DO i1=9,16
639 DO k=1,nsa
640 j = jjj(k)
641 i = nstrf(1,j)-nft
642 ipack = nstrf(2,j)
643 IF(mod(ipack/power2(i1),2)/=0)THEN
644 n = ixs16(i1-8,nstrf(1,j)-numels8-numels10-numels20)
645 secfcum(1,n)=secfcum(1,n)-fx(i,i1)
646 secfcum(2,n)=secfcum(2,n)-fy(i,i1)
647 secfcum(3,n)=secfcum(3,n)-fz(i,i1)
648 ENDIF
649 ENDDO
650 ENDDO
651 END IF
652#include "lockoff.inc"
653 ENDIF
654C
655 RETURN
656 END
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_s
subroutine section_s(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, fsav, ixs, fopta, secfcum, fx, fy, fz, type, nsint, ifram, nnod, nod, ms, ixs20, ixs16, isolnod, xsec, fbsav6, iparsens)
Definition section_s.F:38
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