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 32 of file section_s.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(*),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
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