33 2 N2,N3,NSTRF,X,V,VR,FSAV,
36 5 TYPE,NSINT,IFRAM,NNOD,NOD,MS,
37 7 XSEC,FBSAV6,IPARSENS)
41#include "implicit_f.inc"
58 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,
60 INTEGER NSTRF(2,*),IXC(NIXC,*),IFRAM,NNOD,NOD(*)
62 . X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),
63 . v(3,*), vr(3,*),ms(*),xsec(4,3)
64 DOUBLE PRECISION FBSAV6(12,6)
68 INTEGER JJJ(MVSIZ), UNPACK(0:15,4),
69 . nsa, j, i, k, i1, i2, ipack, n, jj
71 . fx(mvsiz,4), fy(mvsiz,4), fz(mvsiz,4), mx(mvsiz,4),
72 . my(mvsiz,4), mz(mvsiz,4), fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
73 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
74 . dy1(mvsiz), dz1(mvsiz),fst(16), dx11, dy11, dz11,
75 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
76 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
77 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
78 . fsty, fstz, dmx, dmy, dmz
80 . msxphi, msyphi, mszphi, fsxphi,
81 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
82 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
84 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
86 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
88 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
90 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
93 my_real,
DIMENSION(:,:),
ALLOCATABLE :: fstparit
96 DATA unpack/0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,
97 . 0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,
98 . 0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,
99 . 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1/
103 IF(lft+nft>nstrf(1,nseg))
RETURN
104 IF(llt+nft<nstrf(1,1 ))
RETURN
121 IF (lft<=i.AND.llt>=i)
THEN
129 IF (lft<=i.AND.llt>=i)
THEN
139 IF(type+nsint==0)
THEN
142 ALLOCATE(fstparit(12,nsa))
156 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
157 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
160 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
161 3 xxn, yyn, zzn, ifram, n1 , xsec)
165 IF((iparsens==0))
THEN
166 IF (nsa>15.OR.ivector==0)
THEN
172 IF(unpack(ipack,i1)/=0)
THEN
174 n = ixc(i1+1,nstrf(1,j))
183 fn=fsx*xxn+fsy*yyn+fsz*zzn
195 msx =dy11*fsz-dz11*fsy
196 msy =dz11*fsx-dx11*fsz
197 msz =dx11*fsy-dy11*fsx
203 dmx =msx*xx4+msy*yy4+msz*zz4
204 dmy =msx*xx5+msy*yy5+msz*zz5
205 dmz =msx*xx6+msy*yy6+msz*zz6
216 fst(10) = fst(10) + fsx
217 fst(11) = fst(11) + fsy
218 fst(12) = fst(12) + fsz
219 fst(13) = fst(13) + msx
221 fst(15) = fst(15) + msz
223 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
224 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
235 IF(unpack(ipack,i1)/=0)
THEN
236 n = ixc(i1+1,nstrf(1,j))
246 fn=fsx*xxn+fsy*yyn+fsz*zzn
258 msx =dy11*fsz-dz11*fsy
259 msy =dz11*fsx-dx11*fsz
260 msz =dx11*fsy-dy11*fsx
266 dmx =msx*xx4+msy*yy4+msz*zz4
267 dmy =msx*xx5+msy*yy5+msz*zz5
268 dmz =msx*xx6+msy*yy6+msz*zz6
279 fst(10) = fst(10) + fsx
280 fst(11) = fst(11) + fsy
281 fst(12) = fst(12) + fsz
282 fst(13) = fst(13) + msx
283 fst(14) = fst(14) + msy
284 fst(15) = fst(15) + msz
286 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
287 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
293 IF (nsa>15.OR.ivector==0)
THEN
299 IF(unpack(ipack,i1)/=0)
THEN
301 n = ixc(i1+1,nstrf(1,j))
310 fn=fsx*xxn+fsy*yyn+fsz*zzn
322 msx =dy11*fsz-dz11*fsy
323 msy =dz11*fsx-dx11*fsz
324 msz =dx11*fsy-dy11*fsx
330 dmx =msx*xx4+msy*yy4+msz*zz4
331 dmy =msx*xx5+msy*yy5+msz*zz5
332 dmz =msx*xx6+msy*yy6+msz*zz6
343 fst(10) = fst(10) + fsx
344 fst(11) = fst(11) + fsy
345 fst(12) = fst(12) + fsz
346 fst(13) = fst(13) + msx
347 fst(14) = fst(14) + msy
348 fst(15) = fst(15) + msz
350 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
351 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
353 fstparit(1,k)=fstparit(1,k)+fsnx
354 fstparit(2,k)=fstparit(2,k)+fsny
355 fstparit(3,k)=fstparit(3,k)+fsnz
356 fstparit(4,k)=fstparit(4,k)+fstx
357 fstparit(5,k)=fstparit(5,k)+fsty
358 fstparit(6,k)=fstparit(6,k)+fstz
359 fstparit(7,k)=fstparit(7,k)+msx
360 fstparit(8,k)=fstparit(8,k)+msy
361 fstparit(9,k)=fstparit(9,k)+msz
362 fstparit(10,k)=fstparit(10,k) +
363 . ( xx4*(fsnx+fstx) +
366 fstparit(11,k)=fstparit(11,k) +
367 . ( xx5*(fsnx+fstx) +
370 fstparit(12,k)=fstparit(12,k) +
371 . ( xx6*(fsnx+fstx) +
387 IF(unpack(ipack,i1)/=0)
THEN
388 n = ixc(i1+1,nstrf(1,j))
398 fn=fsx*xxn+fsy*yyn+fsz*zzn
410 msx =dy11*fsz-dz11*fsy
411 msy =dz11*fsx-dx11*fsz
412 msz =dx11*fsy-dy11*fsx
418 dmx =msx*xx4+msy*yy4+msz*zz4
419 dmy =msx*xx5+msy*yy5+msz*zz5
420 dmz =msx*xx6+msy*yy6+msz*zz6
431 fst(10) = fst(10) + fsx
432 fst(11) = fst(11) + fsy
433 fst(12) = fst(12) + fsz
434 fst(13) = fst(13) + msx
435 fst(14) = fst(14) + msy
436 fst(15) = fst(15) + msz
438 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
439 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
441 fstparit(1,k)=fstparit(1,k)+fsnx
442 fstparit(2,k)=fstparit(2,k)+fsny
443 fstparit(3,k)=fstparit(3,k)+fsnz
444 fstparit(4,k)=fstparit(4,k)+fstx
445 fstparit(5,k)=fstparit(5,k)+fsty
446 fstparit(6,k)=fstparit(6,k)+fstz
447 fstparit(7,k)=fstparit(7,k)+msx
448 fstparit(8,k)=fstparit(8,k)+msy
449 fstparit(9,k)=fstparit(9,k)+msz
450 fstparit(10,k)=fstparit(10,k) +
451 . ( xx4*(fsnx+fstx) +
454 fstparit(11,k)=fstparit(11,k) +
455 . ( xx5*(fsnx+fstx) +
458 fstparit(12,k)=fstparit(12,k) +
459 . ( xx6*(fsnx+fstx) +
472 fsav(1)=fsav(1)+dt12*fst(1)
473 fsav(2)=fsav(2)+dt12*fst(2)
474 fsav(3)=fsav(3)+dt12*fst(3)
475 fsav(4)=fsav(4)+dt12*fst(4)
476 fsav(5)=fsav(5)+dt12*fst(5)
477 fsav(6)=fsav(6)+dt12*fst(6)
478 fsav(7)=fsav(7)+dt12*fst(7)
479 fsav(8)=fsav(8)+dt12*fst(8)
480 fsav(9)=fsav(9)+dt12*fst(9)
481 fsav(10)=fsav(10)+dt12*fst(16)
482 fsav(31)=fsav(31)+dt12*fst(13)
483 fsav(32)=fsav(32)+dt12*fst(14)
484 fsav(33)=fsav(33)+dt12*fst(15)
485 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
486 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
487 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
488 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
489 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
490 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
494 fopta(1) = fopta(1) + fst(10)
495 fopta(2) = fopta(2) + fst(11)
496 fopta(3) = fopta(3) + fst(12)
497 fopta(4) = fopta(4) + fst(13)
498 fopta(5) = fopta(5) + fst(14)
499 fopta(6) = fopta(6) + fst(15)
500#include "lockoff.inc"
510 IF(unpack(ipack,i1)/=0)
THEN
511 n = ixc(i1+1,nstrf(1,j))
512 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
513 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
514 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
515 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
516 secfcum(6,n)=secfcum(6,n)+my(i,i1)
517 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
521#include "lockoff.inc"
524 IF((nsa/=0).AND.(iparsens/=0))
THEN