35 2 N2,N3,NSTRF,X,V,VR,FSAV,
38 5 ITYPE,NSINT,IFRAM,NNOD,NOD,MS,
39 7 XSEC,FBSAV6,IPARSENS)
40 use element_mod ,
only : nixp
44#include "implicit_f.inc"
59 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3, ITYPE,NSINT
60 INTEGER NSTRF(2,*),IXP(NIXP,*),IFRAM,NNOD,(*)
62 my_real X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),
63 . FX(MVSIZ,2), FY(MVSIZ,2), FZ(MVSIZ,2), MX(MVSIZ,2),
64 . my(mvsiz,2), mz(mvsiz,2),
65 . v(3,*), vr(3,*),ms(*),xsec(4,3)
66 DOUBLE PRECISION FBSAV6(12,6)
70 INTEGER JJJ(MVSIZ), UNPACK(3,2),
71 . nsa, j, i, k, i1, ipack, n
73 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
74 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
75 . dy1(mvsiz), dz1(mvsiz),fst(16),
77 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
78 . xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
79 . fsty, fstz, dmx, dmy, dmz
80 my_real,
DIMENSION(:,:),
ALLOCATABLE :: fstparit
86 IF(lft+nft>nstrf(1,nseg))
RETURN
87 IF(llt+nft<nstrf(1,1 ))
RETURN
101 IF(itype+nsint==0)
THEN
108 ALLOCATE(fstparit(12,nsa))
118 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
119 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
122 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
123 3 xxn, yyn, zzn, ifram, n1 , xsec)
132 IF(unpack(ipack,i1)/=0)
THEN
141 n = ixp(i1+1,nstrf(1,j))
150 fn=fsx*xxn+fsy*yyn+fsz*zzn
162 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
163 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
164 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
170 dmx =msx*xx4+msy*yy4+msz*zz4
171 dmy =msx*xx5+msy*yy5+msz*zz5
172 dmz =msx*xx6+msy*yy6+msz*zz6
183 fst(10) = fst(10) + fsx
184 fst(11) = fst(11) + fsy
185 fst(12) = fst(12) + fsz
186 fst(13) = fst(13) + msx
187 fst(14) = fst(14) + msy
188 fst(15) = fst(15) + msz
190 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
191 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
202 IF(unpack(ipack,i1)/=0)
THEN
211 n = ixp(i1+1,nstrf(1,j))
220 fn=fsx*xxn+fsy*yyn+fsz*zzn
232 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
233 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
234 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
240 dmx =msx*xx4+msy*yy4+msz*zz4
241 dmy =msx*xx5+msy*yy5+msz*zz5
242 dmz =msx*xx6+msy*yy6+msz*zz6
253 fst(10) = fst(10) + fsx
254 fst(11) = fst(11) + fsy
255 fst(12) = fst(12) + fsz
256 fst(13) = fst(13) + msx
257 fst(14) = fst(14) + msy
258 fst(15) = fst(15) + msz
260 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
261 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
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) +
276 fstparit(11,k)=fstparit(11,k) +
277 . ( xx5*(fsnx+fstx) +
280 fstparit(12,k)=fstparit(12,k) +
281 . ( xx6*(fsnx+fstx) +
294 fsav(1)=fsav(1)+dt12*fst(1)
295 fsav(2)=fsav(2)+dt12*fst(2)
296 fsav(3)=fsav(3)+dt12*fst(3)
297 fsav(4)=fsav(4)+dt12*fst(4)
298 fsav(5)=fsav(5)+dt12*fst(5)
299 fsav(6)=fsav(6)+dt12*fst(6)
300 fsav(7)=fsav(7)+dt12*fst(7)
301 fsav(8)=fsav(8)+dt12*fst(8)
302 fsav(9)=fsav(9)+dt12*fst(9)
303 fsav(10)=fsav(10)+dt12*fst(16)
304 fsav(31)=fsav(31)+dt12*fst(13)
305 fsav(32)=fsav(32)+dt12*fst(14)
306 fsav(33)=fsav(33)+dt12*fst(15)
307 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
308 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
309 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
310 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
311 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
312 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
316 fopta(1) = fopta(1) + fst(10)
317 fopta(2) = fopta(2) + fst(11)
318 fopta(3) = fopta(3) + fst(12)
319 fopta(4) = fopta(4) + fst(13)
320 fopta(5) = fopta(5) + fst(14)
321 fopta(6) = fopta(6) + fst(15)
322#include "lockoff.inc"
332 IF(unpack(ipack,i1)/=0)
THEN
333 n = ixp(i1+1,nstrf(1,j))
334 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
335 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
336 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
337 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
338 secfcum(6,n)=secfcum(6,n)+my(i,i1)
339 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
343#include "lockoff.inc"