OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_s.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_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)

Function/Subroutine Documentation

◆ section_s()

subroutine section_s ( 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(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer isolnod,
xsec,
double precision, dimension(12,6) fbsav6,
integer iparsens )

Definition at line 34 of file section_s.F.

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