itribox.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	itribox (tri, box, norm, nverts, poly, nvmax)
subroutine	polclip (polyin, npin, a, n, polyout, npout)

Function/Subroutine Documentation

itribox()

subroutine itribox	(		tri,
			box,
			norm,
		integer	nverts,
			poly,
		integer	nvmax )

Definition at line 30 of file itribox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NVERTS, NVMAX
      my_real
     .        tri(3,*), box(3,*), norm(3,*), poly(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, NPOUT, J
      INTEGER JJ, NN, IFOUND, REDIR(NVMAX)
      my_real
     .        a(3), n(3), polyout(3,nvmax)
      my_real
     .        x1, y1, z1, x2, y2, z2, dd, tole
      INTEGER P_REF(6)
      DATA p_ref /1,5,1,2,3,4/
#ifdef MYREAL8
      tole=em10
#else
      tole=em5
#endif
C Intersection triangle-box
      nverts=3
      DO i=1,nverts
         poly(1,i)=tri(1,i)
         poly(2,i)=tri(2,i)
         poly(3,i)=tri(3,i)
      ENDDO
C      
      DO i=1,6
         a(1)=box(1,p_ref(i))
         a(2)=box(2,p_ref(i))
         a(3)=box(3,p_ref(i))
         n(1)=norm(1,i)
         n(2)=norm(2,i)
         n(3)=norm(3,i)
         CALL polclip(poly,  nverts, a, n, polyout, npout)
         nverts=npout
         DO j=1,nverts
            poly(1,j)=polyout(1,j)
            poly(2,j)=polyout(2,j)
            poly(3,j)=polyout(3,j)
         ENDDO
      ENDDO   
C Elimination des noeuds doubles
      nn=0
      DO i=1,nverts
         x1=poly(1,i)
         y1=poly(2,i)
         z1=poly(3,i)
         ifound=0
         DO j=1,nn
            jj=redir(j)
            x2=poly(1,jj)
            y2=poly(2,jj)
            z2=poly(3,jj)
            dd=sqrt((x1-x2)**2+(y1-y2)**2+(z1-z2)**2)
            IF (dd<=tole) ifound=j
         ENDDO
         IF (ifound==0) THEN
            nn=nn+1
            redir(nn)=i
         ENDIF
      ENDDO
C
      nverts=nn
      DO i=1,nverts
         poly(1,i)=polyout(1,redir(i))
         poly(2,i)=polyout(2,redir(i))
         poly(3,i)=polyout(3,redir(i))
      ENDDO
C
      RETURN

polclip()

subroutine polclip	(		polyin,
		integer	npin,
			a,
			n,
			polyout,
		integer	npout )

Definition at line 115 of file itribox.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPIN, NPOUT
      my_real polyin(3,*), a(*), n(*), polyout(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II
      my_real x1, y1, z1, x2, y2, z2, ss1, ss2, x12, y12, z12, xa1, ya1, za1, alpha, xm, ym, zm, ssn
 
C polygon clipping with a plane
      npout=0
      DO i=1,npin
         IF (i/=npin) THEN
            ii=i+1
         ELSE
            ii=1
         ENDIF 
C
         x1=polyin(1,i)
         y1=polyin(2,i)
         z1=polyin(3,i)
         x2=polyin(1,ii)
         y2=polyin(2,ii)
         z2=polyin(3,ii)
C
         ss1=(x1-a(1))*n(1)+(y1-a(2))*n(2)+(z1-a(3))*n(3)
         ss2=(x2-a(1))*n(1)+(y2-a(2))*n(2)+(z2-a(3))*n(3)
         IF (ss1<zero.AND.ss2<zero) cycle
         IF (ss1>=zero.AND.ss2>=zero) THEN
            npout=npout+1
            polyout(1,npout)=x1
            polyout(2,npout)=y1
            polyout(3,npout)=z1
            cycle
         ENDIF       
C
         x12=x2-x1
         y12=y2-y1
         z12=z2-z1
         xa1=x1-a(1)
         ya1=y1-a(2)
         za1=z1-a(3)
         ssn=x12*n(1)+y12*n(2)+z12*n(3)
         alpha=-(xa1*n(1)+ya1*n(2)+za1*n(3))/ssn
         xm=x1+alpha*x12
         ym=y1+alpha*y12
         zm=z1+alpha*z12
         IF (ss1>=zero) THEN
            npout=npout+1
            polyout(1,npout)=x1
            polyout(2,npout)=y1
            polyout(3,npout)=z1
            npout=npout+1
            polyout(1,npout)=xm
            polyout(2,npout)=ym
            polyout(3,npout)=zm
         ELSEIF (ss2>=zero) THEN
            npout=npout+1
            polyout(1,npout)=xm
            polyout(2,npout)=ym
            polyout(3,npout)=zm        
         ENDIF
      ENDDO       
C
      RETURN