40 use element_mod , only : nixc
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 "parit_c.inc"
57#include "scr06_c.inc"
58
59
60
61 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,
62 . TYPE,NSINT,IPARSENS
63 INTEGER NSTRF(2,*),IXC(NIXC,*),IFRAM,NNOD,NOD(*)
65 . x(3,*), fsav(nthvki), fopta(6), secfcum(7,*),
66 . v(3,*), vr(3,*),ms(*),xsec(4,3)
67 DOUBLE PRECISION FBSAV6(12,6)
68
69
70
71 INTEGER JJJ(MVSIZ), UNPACK(0:15,4),
72 . NSA, J, I, K, I1, I2, IPACK, N, JJ
74 . fx(mvsiz,4), fy(mvsiz,4), fz(mvsiz,4), mx(mvsiz,4),
75 . my(mvsiz,4), mz(mvsiz,4), fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
76 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
77 . dy1(mvsiz), dz1(mvsiz),fst(16), dx11, dy11, dz11,
78 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
79 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
80 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
81 . fsty, fstz, dmx, dmy, dmz
83 . msxphi, msyphi, mszphi, fsxphi,
84 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
85 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
87 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
89 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
91 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
93 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
95 . al4,al5,al6
96 my_real,
DIMENSION(:,:),
ALLOCATABLE :: fstparit
97
98
99 DATA unpack/0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,
100 . 0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,
101 . 0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,
102 . 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1/
103
104
105 IF(nseg==0) RETURN
106 IF(lft+nft>nstrf(1,nseg)) RETURN
107 IF(llt+nft<nstrf(1,1 )) RETURN
108
109 nsa=0
110
111 IF(ivector==0) THEN
112 DO 20 j=1,nseg
113 i=nstrf(1,j)-nft
114 IF (lft>i) GOTO 20
115 IF (llt<i) GOTO 30
116 nsa=nsa+1
117 jjj(nsa)=j
118 20 CONTINUE
119 30 CONTINUE
120 ELSE
121 IF (nseg>15) THEN
122 DO j=1,nseg
123 i=nstrf(1,j)-nft
124 IF (lft<=i.AND.llt>=i) THEN
125 nsa=nsa+1
126 jjj(nsa)=j
127 ENDIF
128 ENDDO
129 ELSE
130 DO j=1,nseg
131 i=nstrf(1,j)-nft
132 IF (lft<=i.AND.llt>=i) THEN
133 nsa=nsa+1
134 jjj(nsa)=j
135 ENDIF
136 ENDDO
137 ENDIF
138 ENDIF
139
140 IF(nsa==0)RETURN
141
142 IF(type+nsint==0)THEN
143
144 IF(iparsens/=0) THEN
145 ALLOCATE(fstparit(12,nsa))
146 DO j=1,nsa
147 DO i=1,12
148 fstparit(i,j) = zero
149 ENDDO
150 ENDDO
151 ENDIF
152
153 DO i=1,16
154 fst(i)=zero
155 ENDDO
156
157 IF(nspmd==1) THEN
159 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
160 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
161 ELSE
163 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
164 3 xxn, yyn, zzn, ifram, n1 , xsec)
165 END IF
166
167
168 IF((iparsens==0)) THEN
169 IF (nsa>15.OR.ivector==0) THEN
170 DO k=1,nsa
171 j = jjj(k)
172 i = nstrf(1,j)-nft
173 ipack = nstrf(2,j)
174 DO i1=1,4
175 IF(unpack(ipack,i1)/=0)THEN
176
177 n = ixc(i1+1,nstrf(1,j))
178 dx11=x(1,n)
179 dy11=x(2,n)
180 dz11=x(3,n)
181
182 fsx=fx(i,i1)
183 fsy=fy(i,i1)
184 fsz=fz(i,i1)
185
186 fn=fsx*xxn+fsy*yyn+fsz*zzn
187 fsnx=fn*xxn
188 fsny=fn*yyn
189 fsnz=fn*zzn
190 fstx=fsx-fsnx
191 fsty=fsy-fsny
192 fstz=fsz-fsnz
193
194 dx11=dx11-xxc
195 dy11=dy11-yyc
196 dz11=dz11-zzc
197
198 msx =dy11*fsz-dz11*fsy
199 msy =dz11*fsx-dx11*fsz
200 msz =dx11*fsy-dy11*fsx
201
202 msx =msx+mx(i,i1)
203 msy =msy+my(i,i1)
204 msz =msz+mz(i,i1)
205
206 dmx =msx*xx4+msy*yy4+msz*zz4
207 dmy =msx*xx5+msy*yy5+msz*zz5
208 dmz =msx*xx6+msy*yy6+msz*zz6
209
210 fst(1)=fst(1)+fsnx
211 fst(2)=fst(2)+fsny
212 fst(3)=fst(3)+fsnz
213 fst(4)=fst(4)+fstx
214 fst(5)=fst(5)+fsty
215 fst(6)=fst(6)+fstz
216 fst(7)=fst(7)+dmx
217 fst(8)=fst(8)+dmy
218 fst(9)=fst(9)+dmz
219 fst(10) = fst(10) + fsx
220 fst(11) = fst(11) + fsy
221 fst(12) = fst(12) + fsz
222 fst(13) = fst(13) + msx
223 fst(14) = fst(14) + msy
224 fst(15) = fst(15) + msz
225 fst(16)=fst(16)
226 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
227 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
228
229 ENDIF
230 ENDDO
231 ENDDO
232 ELSE
233 DO k=1,nsa
234 j = jjj(k)
235 i = nstrf(1,j)-nft
236 ipack = nstrf(2,j)
237 DO i1=1,4
238 IF(unpack(ipack,i1)/=0)THEN
239 n = ixc(i1+1,nstrf(1,j))
240
241 dx11=x(1,n)
242 dy11=x(2,n)
243 dz11=x(3,n)
244
245 fsx=fx(i,i1)
246 fsy=fy(i,i1)
247 fsz=fz(i,i1)
248
249 fn=fsx*xxn+fsy*yyn+fsz*zzn
250 fsnx=fn*xxn
251 fsny=fn*yyn
252 fsnz=fn*zzn
253 fstx=fsx-fsnx
254 fsty=fsy-fsny
255 fstz=fsz-fsnz
256
257 dx11=dx11-xxc
258 dy11=dy11-yyc
259 dz11=dz11-zzc
260
261 msx =dy11*fsz-dz11*fsy
262 msy =dz11*fsx-dx11*fsz
263 msz =dx11*fsy-dy11*fsx
264
265 msx =msx+mx(i,i1)
266 msy =msy+my(i,i1)
267 msz =msz+mz(i,i1)
268
269 dmx =msx*xx4+msy*yy4+msz*zz4
270 dmy =msx*xx5+msy*yy5+msz*zz5
271 dmz =msx*xx6+msy*yy6+msz*zz6
272
273 fst(1)=fst(1)+fsnx
274 fst(2)=fst(2)+fsny
275 fst(3)=fst(3)+fsnz
276 fst(4)=fst(4)+fstx
277 fst(5)=fst(5)+fsty
278 fst(6)=fst(6)+fstz
279 fst(7)=fst(7)+dmx
280 fst(8)=fst(8)+dmy
281 fst(9)=fst(9)+dmz
282 fst(10) = fst(10) + fsx
283 fst(11) = fst(11) + fsy
284 fst(12) = fst(12) + fsz
285 fst(13) = fst(13) + msx
286 fst(14) = fst(14) + msy
287 fst(15) = fst(15) + msz
288 fst(16)=fst(16)
289 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
290 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
291 ENDIF
292 ENDDO
293 ENDDO
294 ENDIF
295 ELSE
296 IF (nsa>15.OR.ivector==0) THEN
297 DO k=1,nsa
298 j = jjj(k)
299 i = nstrf(1,j)-nft
300 ipack = nstrf(2,j)
301 DO i1=1,4
302 IF(unpack(ipack,i1)/=0)THEN
303
304 n = ixc(i1+1,nstrf(1,j))
305 dx11=x(1,n)
306 dy11=x(2,n)
307 dz11=x(3,n)
308
309 fsx=fx(i,i1)
310 fsy=fy(i,i1)
311 fsz=fz(i,i1)
312
313 fn=fsx*xxn+fsy*yyn+fsz*zzn
314 fsnx=fn*xxn
315 fsny=fn*yyn
316 fsnz=fn*zzn
317 fstx=fsx-fsnx
318 fsty=fsy-fsny
319 fstz=fsz-fsnz
320
321 dx11=dx11-xxc
322 dy11=dy11-yyc
323 dz11=dz11-zzc
324
325 msx =dy11*fsz-dz11*fsy
326 msy =dz11*fsx-dx11*fsz
327 msz =dx11*fsy-dy11*fsx
328
329 msx =msx+mx(i,i1)
330 msy =msy+my(i,i1)
331 msz =msz+mz(i,i1)
332
333 dmx =msx*xx4+msy*yy4+msz*zz4
334 dmy =msx*xx5+msy*yy5+msz*zz5
335 dmz =msx*xx6+msy*yy6+msz*zz6
336
337 fst(1)=fst(1)+fsnx
338 fst(2)=fst(2)+fsny
339 fst(3)=fst(3)+fsnz
340 fst(4)=fst(4)+fstx
341 fst(5)=fst(5)+fsty
342 fst(6)=fst(6)+fstz
343 fst(7)=fst(7)+dmx
344 fst(8)=fst(8)+dmy
345 fst(9)=fst(9)+dmz
346 fst(10) = fst(10) + fsx
347 fst(11) = fst(11) + fsy
348 fst(12) = fst(12) + fsz
349 fst(13) = fst(13) + msx
350 fst(14) = fst(14) + msy
351 fst(15) = fst(15) + msz
352 fst(16)=fst(16)
353 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
354 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
355
356 fstparit(1,k)=fstparit(1,k)+fsnx
357 fstparit(2,k)=fstparit(2,k)+fsny
358 fstparit(3,k)=fstparit(3,k)+fsnz
359 fstparit(4,k)=fstparit(4,k)+fstx
360 fstparit(5,k)=fstparit(5,k)+fsty
361 fstparit(6,k)=fstparit(6,k)+fstz
362 fstparit(7,k)=fstparit(7,k)+msx
363 fstparit(8,k)=fstparit(8,k)+msy
364 fstparit(9,k)=fstparit(9,k)+msz
365 fstparit(10,k)=fstparit(10,k) +
366 . ( xx4*(fsnx+fstx) +
367 . yy4*(fsny+fsty) +
368 . zz4*(fsnz+fstz) )
369 fstparit(11,k)=fstparit(11,k) +
370 . ( xx5*(fsnx+fstx) +
371 . yy5*(fsny+fsty) +
372 . zz5*(fsnz+fstz) )
373 fstparit(12,k)=fstparit(12,k) +
374 . ( xx6*(fsnx+fstx) +
375 . yy6*(fsny+fsty) +
376 . zz6*(fsnz+fstz) )
377
378 ENDIF
379 ENDDO
380 ENDDO
381
383
384 ELSE
385 DO k=1,nsa
386 j = jjj(k)
387 i = nstrf(1,j)-nft
388 ipack = nstrf(2,j)
389 DO i1=1,4
390 IF(unpack(ipack,i1)/=0)THEN
391 n = ixc(i1+1,nstrf(1,j))
392
393 dx11=x(1,n)
394 dy11=x(2,n)
395 dz11=x(3,n)
396
397 fsx=fx(i,i1)
398 fsy=fy(i,i1)
399 fsz=fz(i,i1)
400
401 fn=fsx*xxn+fsy*yyn+fsz*zzn
402 fsnx=fn*xxn
403 fsny=fn*yyn
404 fsnz=fn*zzn
405 fstx=fsx-fsnx
406 fsty=fsy-fsny
407 fstz=fsz-fsnz
408
409 dx11=dx11-xxc
410 dy11=dy11-yyc
411 dz11=dz11-zzc
412
413 msx =dy11*fsz-dz11*fsy
414 msy =dz11*fsx-dx11*fsz
415 msz =dx11*fsy-dy11*fsx
416
417 msx =msx+mx(i,i1)
418 msy =msy+my(i,i1)
419 msz =msz+mz(i,i1)
420
421 dmx =msx*xx4+msy*yy4+msz*zz4
422 dmy =msx*xx5+msy*yy5+msz*zz5
423 dmz =msx*xx6+msy*yy6+msz*zz6
424
425 fst(1)=fst(1)+fsnx
426 fst(2)=fst(2)+fsny
427 fst(3)=fst(3)+fsnz
428 fst(4)=fst(4)+fstx
429 fst(5)=fst(5)+fsty
430 fst(6)=fst(6)+fstz
431 fst(7)=fst(7)+dmx
432 fst(8)=fst(8)+dmy
433 fst(9)=fst(9)+dmz
434 fst(10) = fst(10) + fsx
435 fst(11) = fst(11) + fsy
436 fst(12) = fst(12) + fsz
437 fst(13) = fst(13) + msx
438 fst(14) = fst(14) + msy
439 fst(15) = fst(15) + msz
440 fst(16)=fst(16)
441 . +fsx*v(1,n) +fsy*v(2,n) +fsz*v(3,n)
442 . +msx*vr(1,n)+msy*vr(2,n)+msz*vr(3,n)
443
444 fstparit(1,k)=fstparit(1,k)+fsnx
445 fstparit(2,k)=fstparit(2,k)+fsny
446 fstparit(3,k)=fstparit(3,k)+fsnz
447 fstparit(4,k)=fstparit(4,k)+fstx
448 fstparit(5,k)=fstparit(5,k)+fsty
449 fstparit(6,k)=fstparit(6,k)+fstz
450 fstparit(7,k)=fstparit(7,k)+msx
451 fstparit(8,k)=fstparit(8,k)+msy
452 fstparit(9,k)=fstparit(9,k)+msz
453 fstparit(10,k)=fstparit(10,k) +
454 . ( xx4*(fsnx+fstx) +
455 . yy4*(fsny+fsty) +
456 . zz4*(fsnz+fstz) )
457 fstparit(11,k)=fstparit(11,k) +
458 . ( xx5*(fsnx+fstx) +
459 . yy5*(fsny+fsty) +
460 . zz5*(fsnz+fstz) )
461 fstparit(12,k)=fstparit(12,k) +
462 . ( xx6*(fsnx+fstx) +
463 . yy6*(fsny+fsty) +
464 . zz6*(fsnz+fstz) )
465
466 ENDIF
467 ENDDO
468 ENDDO
470
471 ENDIF
472 ENDIF
473
474#include "lockon.inc"
475 fsav(1)=fsav(1)+dt12*fst(1)
476 fsav(2)=fsav(2)+dt12*fst(2)
477 fsav(3)=fsav(3)+dt12*fst(3)
478 fsav(4)=fsav(4)+dt12*fst(4)
479 fsav(5)=fsav(5)+dt12*fst(5)
480 fsav(6)=fsav(6)+dt12*fst(6)
481 fsav(7)=fsav(7)+dt12*fst(7)
482 fsav(8)=fsav(8)+dt12*fst(8)
483 fsav(9)=fsav(9)+dt12*fst(9)
484 fsav(10)=fsav(10)+dt12*fst(16)
485 fsav(31)=fsav(31)+dt12*fst(13)
486 fsav(32)=fsav(32)+dt12*fst(14)
487 fsav(33)=fsav(33)+dt12*fst(15)
488 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
489 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
490 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
491 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
492 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
493 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
494 fsav(37)=xxc
495 fsav(38)=yyc
496 fsav(39)=zzc
497 fopta(1) = fopta(1) + fst(10)
498 fopta(2) = fopta(2) + fst(11)
499 fopta(3) = fopta(3) + fst(12)
500 fopta(4) = fopta(4) + fst(13)
501 fopta(5) = fopta(5) + fst(14)
502 fopta(6) = fopta(6) + fst(15)
503#include "lockoff.inc"
504
505 ELSE
506
507#include "lockon.inc"
508 DO i1=1,4
509 DO k=1,nsa
510 j = jjj(k)
511 i = nstrf(1,j)-nft
512 ipack = nstrf(2,j)
513 IF(unpack(ipack,i1)/=0)THEN
514 n = ixc(i1+1,nstrf(1,j))
515 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
516 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
517 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
518 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
519 secfcum(6,n)=secfcum(6,n)+my(i,i1)
520 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
521 ENDIF
522 ENDDO
523 ENDDO
524#include "lockoff.inc"
525 ENDIF
526
527 IF((nsa/=0).AND.(iparsens/=0)) THEN
528 DEALLOCATE(fstparit)
529 ENDIF
530
531 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)
1.15.0