40 use element_mod , only : nixtg
41
42
43
44#include "implicit_f.inc"
45
46
47
48#include "mvsiz_p.inc"
49
50
51
52#include "comlock.inc"
53#include "com01_c.inc"
54#include "com08_c.inc"
55#include "param_c.inc"
56#include "scr06_c.inc"
57
58
59
60 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,
61 4 TYPE,NSINT,IPARSENS
62 INTEGER NSTRF(2,*),IXTG(NIXTG,*),IFRAM,NNOD,NOD(*)
64 . x(3,*), fsav(nthvki), fopta(6), secfcum(7,*),
65 . fx(mvsiz,3), fy(mvsiz,3), fz(mvsiz,3), mx(mvsiz,3),
66 . my(mvsiz,3), mz(mvsiz,3),
67 . v(3,*), vr(3,*),ms(*),xsec(4,3)
68 DOUBLE PRECISION FBSAV6(12,6)
69
70
71
72 INTEGER JJJ(), UNPACK(0:7,3),
73 . NSA, J, I, K, I1, IPACK, N
75 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
76 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
77 . dy1(mvsiz), dz1(mvsiz),fst(16),
78 . msx, msy, msz,
79 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
80 . xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
81 . fsty, fstz, dmx, dmy, dmz
82 my_real,
DIMENSION(:,:),
ALLOCATABLE :: fstparit
83
84 DATA unpack/0,1,0,1,0,1,0,1,
85 . 0,0,1,1,0,0,1,1,
86 . 0,0,0,0,1,1,1,1/
87
88 IF(nseg==0)RETURN
89 IF(lft+nft>nstrf(1,nseg))RETURN
90 IF(llt+nft<nstrf(1,1 ))RETURN
91
92 nsa=0
93
94 DO 20 j=1,nseg
95 i=nstrf(1,j)-nft
96 IF (lft>i) GOTO 20
97 IF (llt<i) GOTO 30
98 nsa=nsa+1
99 jjj(nsa)=j
100 20 CONTINUE
101 30 CONTINUE
102
103 IF(nsa==0)RETURN
104
105 IF(type+nsint==0)THEN
106
107 DO i=1,16
108 fst(i)=zero
109 ENDDO
110
111 IF(iparsens/=0) THEN
112 ALLOCATE(fstparit(12,nsa))
113 DO j=1,nsa
114 DO i=1,12
115 fstparit(i,j) = zero
116 ENDDO
117 ENDDO
118 ENDIF
119
120 IF(nspmd==1) THEN
122 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
123 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
124 ELSE
126 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
127 3 xxn, yyn, zzn, ifram, n1 , xsec)
128 END IF
129
130 IF(iparsens==0) THEN
131 DO k=1,nsa
132 j = jjj(k)
133 i = nstrf(1,j)-nft
134 ipack = nstrf(2,j)
135 DO i1 = 1,3
136 IF(unpack(ipack,i1)/=0)THEN
137 fx1(k)=fx(i,i1)
138 fy1(k)=fy(i,i1)
139 fz1(k)=fz(i,i1)
140
141 mx1(k)=mx(i,i1)
142 my1(k)=my(i,i1)
143 mz1(k)=mz(i,i1)
144
145 n = ixtg(i1+1,nstrf(1,j))
146 dx1(k)=x(1,n)
147 dy1(k)=x(2,n)
148 dz1(k)=x(3,n)
149
150 fsx=fx1(k)
151 fsy=fy1(k)
152 fsz=fz1(k)
153
154 fn=fsx*xxn+fsy*yyn+fsz*zzn
155 fsnx=fn*xxn
156 fsny=fn*yyn
157 fsnz=fn*zzn
158 fstx=fsx-fsnx
159 fsty=fsy-fsny
160 fstz=fsz-fsnz
161
162 dx1(k)=dx1(k)-xxc
163 dy1(k)=dy1(k)-yyc
164 dz1(k)=dz1(k)-zzc
165
166 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
167 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
168 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
169
170 msx =msx+mx1(k)
171 msy =msy+my1(k)
172 msz =msz+mz1(k)
173
174 dmx =msx*xx4+msy*yy4+msz*zz4
175 dmy =msx*xx5+msy*yy5+msz*zz5
176 dmz =msx*xx6+msy*yy6+msz*zz6
177
178 fst(1)=fst(1)+fsnx
179 fst(2)=fst(2)+fsny
180 fst(3)=fst(3)+fsnz
181 fst(4)=fst(4)+fstx
182 fst(5)=fst(5)+fsty
183 fst(6)=fst(6)+fstz
184 fst(7)=fst(7)+dmx
185 fst(8)=fst(8)+dmy
186 fst(9)=fst(9)+dmz
187 fst(10) = fst(10) + fsx
188 fst(11) = fst(11) + fsy
189 fst(12) = fst(12) + fsz
190 fst(13) = fst(13) + msx
191 fst(14) = fst(14) + msy
192 fst(15) = fst(15) + msz
193 fst(16)=fst(16)
194 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
195 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
196
197 ENDIF
198 ENDDO
199 ENDDO
200 ELSE
201 DO k=1,nsa
202 j = jjj(k)
203 i = nstrf(1,j)-nft
204 ipack = nstrf(2,j)
205 DO i1 = 1,3
206 IF(unpack(ipack,i1)/=0)THEN
207 fx1(k)=fx(i,i1)
208 fy1(k)=fy(i,i1)
209 fz1(k)=fz(i,i1)
210
211 mx1(k)=mx(i,i1)
212 my1(k)=my(i,i1)
213 mz1(k)=mz(i,i1)
214
215 n = ixtg(i1+1,nstrf(1,j))
216 dx1(k)=x(1,n)
217 dy1(k)=x(2,n)
218 dz1(k)=x(3,n)
219
220 fsx=fx1(k)
221 fsy=fy1(k)
222 fsz=fz1(k)
223
224 fn=fsx*xxn+fsy*yyn+fsz*zzn
225 fsnx=fn*xxn
226 fsny=fn*yyn
227 fsnz=fn*zzn
228 fstx=fsx-fsnx
229 fsty=fsy-fsny
230 fstz=fsz-fsnz
231
232 dx1(k)=dx1(k)-xxc
233 dy1(k)=dy1(k)-yyc
234 dz1(k)=dz1(k)-zzc
235
236 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
237 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
238 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
239
240 msx =msx+mx1(k)
241 msy =msy+my1(k)
242 msz =msz+mz1(k)
243
244 dmx =msx*xx4+msy*yy4+msz*zz4
245 dmy =msx*xx5+msy*yy5+msz*zz5
246 dmz =msx*xx6+msy*yy6+msz*zz6
247
248 fst(1)=fst(1)+fsnx
249 fst(2)=fst(2)+fsny
250 fst(3)=fst(3)+fsnz
251 fst(4)=fst(4)+fstx
252 fst(5)=fst(5)+fsty
253 fst(6)=fst(6)+fstz
254 fst(7)=fst(7)+dmx
255 fst(8)=fst(8)+dmy
256 fst(9)=fst(9)+dmz
257 fst(10) = fst(10) + fsx
258 fst(11) = fst(11) + fsy
259 fst(12) = fst(12) + fsz
260 fst(13) = fst(13) + msx
261 fst(14) = fst(14) + msy
262 fst(15) = fst(15) + msz
263 fst(16)=fst(16)
264 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
265 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
266
267 fstparit(1,k)=fstparit(1,k)+fsnx
268 fstparit(2,k)=fstparit(2,k)+fsny
269 fstparit(3,k)=fstparit(3,k)+fsnz
270 fstparit(4,k)=fstparit(4,k)+fstx
271 fstparit(5,k)=fstparit(5,k)+fsty
272 fstparit(6,k)=fstparit(6,k)+fstz
273 fstparit(7,k)=fstparit(7,k)+msx
274 fstparit(8,k)=fstparit(8,k)+msy
275 fstparit(9,k)=fstparit(9,k)+msz
276 fstparit(10,k)=fstparit(10,k) +
277 . ( xx4*(fsnx+fstx) +
278 . yy4*(fsny+fsty) +
279 . zz4*(fsnz+fstz) )
280 fstparit(11,k)=fstparit(11,k) +
281 . ( xx5*(fsnx+fstx) +
282 . yy5*(fsny+fsty) +
283 . zz5*(fsnz+fstz) )
284 fstparit(12,k)=fstparit(12,k) +
285 . ( xx6*(fsnx+fstx) +
286 . yy6*(fsny+fsty) +
287 . zz6*(fsnz+fstz) )
288 ENDIF
289 ENDDO
290 ENDDO
291
293
294 ENDIF
295
296#include "lockon.inc"
297 fsav(1)=fsav(1)+dt12*fst(1)
298 fsav(2)=fsav(2)+dt12*fst(2)
299 fsav(3)=fsav(3)+dt12*fst(3)
300 fsav(4)=fsav(4)+dt12*fst(4)
301 fsav(5)=fsav(5)+dt12*fst(5)
302 fsav(6)=fsav(6)+dt12*fst(6)
303 fsav(7)=fsav(7)+dt12*fst(7)
304 fsav(8)=fsav(8)+dt12*fst(8)
305 fsav(9)=fsav(9)+dt12*fst(9)
306 fsav(10)=fsav(10)+dt12*fst(16)
307 fsav(31)=fsav(31)+dt12*fst(13)
308 fsav(32)=fsav(32)+dt12*fst(14)
309 fsav(33)=fsav(33)+dt12*fst(15)
310 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
311 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
312 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
313 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
314 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
315 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
316 fsav(37)=xxc
317 fsav(38)=yyc
318 fsav(39)=zzc
319 fopta(1) = fopta(1) + fst(10)
320 fopta(2) = fopta(2) + fst(11)
321 fopta(3) = fopta(3) + fst(12)
322 fopta(4) = fopta(4) + fst(13)
323 fopta(5) = fopta(5) + fst(14)
324 fopta(6) = fopta(6) + fst(15)
325#include "lockoff.inc"
326
327 ELSE
328
329#include "lockon.inc"
330 DO i1 = 1,3
331 DO k=1,nsa
332 j = jjj(k)
333 i = nstrf(1,j)-nft
334 ipack = nstrf(2,j)
335 IF(unpack(ipack,i1)/=0)THEN
336 n = ixtg(i1+1,nstrf(1,j))
337 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
338 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
339 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
340 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
341 secfcum(6,n)=secfcum(6,n)+my(i,i1)
342 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
343 ENDIF
344 ENDDO
345 ENDDO
346#include "lockoff.inc"
347 ENDIF
348
349 IF((nsa/=0).AND.(iparsens/=0)) THEN
350 DEALLOCATE(fstparit)
351 ENDIF
352
353 RETURN
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
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)