36 . RNEDGE, NBNEDGE, NX , NY , NZ ,
37 . X0 , Y0 , Z0 , INS , RNS ,
38 . NN , NHOL , INZ , IZ , NNS3 ,
39 . NPOLY , NS , IELNOD , IELNOD_OLD)
43#include "implicit_f.inc"
47 INTEGER NN, NHOL, IPOLY(6+2*NN+1+NHOL,*), (*),
48 . INEDGE(6,*), NBNEDGE, INS(2,*), INZ, IZ(3,*), NNS3,
49 . NPOLY, NS, IELNOD(2*NN,*), IELNOD_OLD(*)
51 . rpoly(4+3*2*nn+3*nhol,*), rpoly_old(*), rnedge(6,*), nx,
52 . ny, nz, x0, y0, z0, rns(4,*)
56 INTEGER NN1, I, IADHOL(NHOL+1), NSEG, ITAG(2*NN+1), II,
57 . TSEG(3,2*NN), NHOL_OLD, ICUT, J, JJ, NSEG_INI, NSEG1,
58 . REDIR(NN), N1, N2, ISTOP, NNP, ICLOSE, ISEG,
59 . POLY(2*NN,NN), IN, IN1, IN2, LENPOLY(NN), K, KK,
60 . thol(nhol), jn, nholp, iadholp(nhol), kn,
61 . itag2(2*nn), itagn(nn), itags(nn), iseg_old
63 . x1, y1, z1, x2, y2, z2, zl1, zl2,
alpha, npx, npy, npz,
64 . xp0, yp0, zp0, vx, vy, vz, xx, yy, zz, xl(nn), xlmin,
65 . xlc, xx1, yy1, zz1, xx2, yy2, zz2, vx1, vy1,
66 . vz1, vx2, vy2, vz2, nr1, nr2, ss, vvx, vvy, vvz,
67 . ss1, zl, xns(3,nn), tole, ll, zlm
69 tole=epsilon(zero)*0.5
75 nn1=ipoly_old(6+nn+1+1)-1
77 iadhol(i)=ipoly_old(6+nn+1+i)
97 x1=rpoly_old(4+3*(i-1)+1)
98 y1=rpoly_old(4+3*(i-1)+2)
99 z1=rpoly_old(4+3*(i-1)+3)
100 x2=rpoly_old(4+3*(ii-1)+1)
101 y2=rpoly_old(4+3*(ii-1)+2)
102 z2=rpoly_old(4+3*(ii-1)+3)
103 zl1=(x1-x0)*nx+(y1-y0)*ny+(z1-z0)*nz
104 zl2=(x2-x0)*nx+(y2-y0)*ny+(z2-z0)*nz
105 IF (zl1-zl2/=zero)
THEN
109 ins(1,ns)=ipoly_old(6+i)
110 ins(2,ns)=ipoly_old(6+ii)
123 ELSEIF (
alpha==zero)
THEN
124 IF (itagn(ii)==0)
THEN
127 ins(1,ns)=ipoly_old(6+i)
128 ins(2,ns)=ipoly_old(6+ii)
148 ELSEIF (
alpha==one)
THEN
149 IF (itagn(i)==0)
THEN
152 ins(1,ns)=ipoly_old(6+i)
153 ins(2,ns)=ipoly_old(6+ii)
194 DO j=iadhol(i),iadhol(i+1)-1
196 IF (j==(iadhol(i+1)-1)) jj=iadhol(i)
197 x1=rpoly_old(4+3*(j-1)+1)
198 y1=rpoly_old(4+3*(j-1)+2)
199 z1=rpoly_old(4+3*(j-1)+3)
200 x2=rpoly_old(4+3*(jj-1)+1)
201 y2=rpoly_old(4+3*(jj-1)+2)
202 z2=rpoly_old(4+3*(jj-1)+3)
203 zl1=(x1-x0)*nx+(y1-y0)*ny+(z1-z0)*nz
204 zl2=(x2-x0)*nx+(y2-y0)*ny+(z2-z0)*nz
205 IF (zl1-zl2/=zero)
THEN
210 ins(1,ns)=ipoly_old(6+j)
211 ins(2,ns)=ipoly_old(6+jj)
224 ELSEIF (
alpha==zero)
THEN
226 IF (itagn(ii)==0)
THEN
229 ins(1,ns)=ipoly_old(6+j)
230 ins(2,ns)=ipoly_old(6+jj)
250 ELSEIF (
alpha==one)
THEN
252 IF (itagn(i)==0)
THEN
255 ins(1,ns)=ipoly_old(6+j)
256 ins(2,ns)=ipoly_old(6+jj)
289 tseg(3,nseg)=nseg_ini+1
319 xl(i)=(xx-xp0)*vx+(yy-yp0)*vy+(zz-zp0)*vz
349 ll=sqrt((x1-x2)**2+(y1-y2)**2+(z1-z2)**2)
367 DO WHILE (itag(i)/=0.AND.i<=nseg)
379 poly(nnp,npoly)=tseg(1,iseg)
381 IF (tseg(3,iseg)>0)
THEN
387 IF (itag(j)/=0) cycle
392 ELSEIF (in2==in)
THEN
398 IF (iseg==0) iseg=tseg(3,iseg_old)
403 IF (itag2(iseg)==1) itag(iseg)=1
412 IF (itag(iseg)/=0)
THEN
424 DO WHILE (itag(j)/=-i)
428 xx=rpoly_old(4+3*(n1-1)+1)
429 yy=rpoly_old(4+3*(n1-1)+2)
430 zz=rpoly_old(4+3*(n1-1)+3)
435 IF (k==lenpoly(j)) kk=1
439 xx1=rpoly_old(4+3*(n1-1)+1)
440 yy1=rpoly_old(4+3*(n1-1)+2)
441 zz1=rpoly_old(4+3*(n1-1)+3)
449 yy2=rpoly_old(4+3*(n2-1)+2)
450 zz2=rpoly_old(4+3*(n2-1)+3)
462 nr1=sqrt(vx1**2+vy1**2+vz1**2)
463 nr2=sqrt(vx2**2+vy2**2+vz2**2)
470 ss=vx1*vx2+vy1*vy2+vz1*vz2
474 ss1=npx*vvx+npy*vvy+npz*vvz
482 IF (abs(
alpha)>=one) thol(i)=j
493 ipoly(1,i)=ipoly_old(1)
494 ipoly(3,i)=ipoly_old(3)
495 ipoly(4,i)=ipoly_old(4)
496 ipoly(5,i)=ipoly_old(5)
497 ipoly(6,i)=ipoly_old(6)
507 ipoly(6+nnp,i)=ipoly_old(6+jn)
508 rpoly(4+3*(nnp-1)+1,i)=rpoly_old(4+3*(jn-1)+1)
509 rpoly(4+3*(nnp-1)+2,i)=rpoly_old(4+3*(jn-1)+2)
510 rpoly(4+3*(nnp-1)+3,i)=rpoly_old(4+3*(jn-1)+3)
511 ielnod(nnp,i)=ielnod_old(jn)
513 IF (itags(-jn)==0)
THEN
515 ipoly(6+nnp,i)=-nns3+jn
516 rpoly(4+3*(nnp-1)+1,i)=xns(1,-jn
517 rpoly(4+3*(nnp-1)+2,i)=xns(2,-jn)
518 rpoly(4+3*(nnp-1)+3,i)=xns(3,-jn)
522 IF (j==lenpoly(i)) jj=poly(1,i)
527 x2=rpoly_old(4+3*(jj-1)+1)
528 y2=rpoly_old(4+3*(jj-1)+2)
529 z2=rpoly_old(4+3*(jj-1)+3)
535 ll=sqrt((x1-x2)**2+(y1-y2)**2+(z1-z2)**2)
538 ipoly(6+nnp,i)=-nns3+jn
539 rpoly(4+3*(nnp-1)+1,i)=xns(1,-jn)
540 rpoly(4+3*(nnp-1)+2,i)=xns(2,-jn)
541 rpoly(4+3*(nnp-1)+3,i)=xns(3,-jn)
555 IF (tseg(3,k)==-j)
THEN
559 rpoly(4+3*(nnp-1)+1,i)=rpoly_old(4+3*(kn-1)+1)
560 rpoly(4+3*(nnp-1)+2,i)=rpoly_old(4+3*(kn-1)+2)
561 rpoly(4+3*(nnp-1)+3,i)=rpoly_old(4+3*(kn-1)+3)
567 ipoly(6+nnp+1,i)=nholp
569 ipoly(6+nnp+1+j,i)=iadholp(j)
577 inedge(1,nbnedge)=ipoly_old(1)
578 inedge(2,nbnedge)=nns3+n1
579 inedge(3,nbnedge)=nns3+n2
580 inedge(4,nbnedge)=ipoly_old(3)
581 inedge(5,nbnedge)=ipoly_old(4)
582 inedge(6,nbnedge)=inz
592 rnedge(1,nbnedge)=xx1
593 rnedge(2,nbnedge)=yy1
594 rnedge(3,nbnedge)=zz1
595 rnedge(4,nbnedge)=xx2
596 rnedge(5,nbnedge)=yy2
597 rnedge(6,nbnedge)=zz2
604 xx=rpoly(4+3*(j-1)+1,i)
605 yy=rpoly(4+3*(j-1)+2,i)
606 zz=rpoly(4+3*(j-1)+3,i)
607 zl=(xx-x0)*nx+(yy-y0)*ny+(zz-z0)*nz
608 IF (abs(zl)>abs(zlm)) zlm=zl
613 ELSEIF (zlm<zero)
THEN