mod_close.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	mod_close (geo, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, hh, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, nel)

Function/Subroutine Documentation

mod_close()

subroutine mod_close	(		geo,
		integer, dimension(*)	ngeo,
			x1,
			x2,
			x3,
			x4,
			x5,
			x6,
			x7,
			x8,
			y1,
			y2,
			y3,
			y4,
			y5,
			y6,
			y7,
			y8,
			z1,
			z2,
			z3,
			z4,
			z5,
			z6,
			z7,
			z8,
			hh,
		double precision, dimension(*)	xd1,
		double precision, dimension(*)	xd2,
		double precision, dimension(*)	xd3,
		double precision, dimension(*)	xd4,
		double precision, dimension(*)	xd5,
		double precision, dimension(*)	xd6,
		double precision, dimension(*)	xd7,
		double precision, dimension(*)	xd8,
		double precision, dimension(*)	yd1,
		double precision, dimension(*)	yd2,
		double precision, dimension(*)	yd3,
		double precision, dimension(*)	yd4,
		double precision, dimension(*)	yd5,
		double precision, dimension(*)	yd6,
		double precision, dimension(*)	yd7,
		double precision, dimension(*)	yd8,
		double precision, dimension(*)	zd1,
		double precision, dimension(*)	zd2,
		double precision, dimension(*)	zd3,
		double precision, dimension(*)	zd4,
		double precision, dimension(*)	zd5,
		double precision, dimension(*)	zd6,
		double precision, dimension(*)	zd7,
		double precision, dimension(*)	zd8,
		integer, intent(in)	nel )

Definition at line 29 of file mod_close.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "mvsiz_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      double precision
     .   xd1(*), xd2(*), xd3(*), xd4(*), xd5(*), xd6(*), xd7(*), xd8(*),
     .   yd1(*), yd2(*), yd3(*), yd4(*), yd5(*), yd6(*), yd7(*), yd8(*),
     .   zd1(*), zd2(*), zd3(*), zd4(*), zd5(*), zd6(*), zd7(*), zd8(*)     
 
      my_real
     .   x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
     .   y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
     .   z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
     .   geo(npropg,*),hh(*)
     
      INTEGER NGEO(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,J1,J2,K,IX1,IX2,IX3,IX4,IX5,IX6,IX7,IX8,KMAX
      my_real
     .  x13,y13,z13,x24,y24,z24,sx(3),sy(3),sz(3),sn(3),dh,dhx,dhy,dhz,
     .  h,snmax,htest(mvsiz),hclos(mvsiz),x(3,8)
      INTEGER ICF1(4,3),ICF2(4,3)
      DATA icf1/1,2,3,4, 2,6,7,3, 1,5,6,2/
      DATA icf2/5,6,7,8, 1,5,8,4, 4,8,7,3/
C
      DO i=1,nel
       hclos(i)=geo(129,ngeo(i))
       htest(i)=geo(130,ngeo(i))
      ENDDO
C      
      DO i=1,nel
          x(1,1)=xd1(i)
          x(2,1)=yd1(i)
          x(3,1)=zd1(i)
          x(1,2)=xd2(i)
          x(2,2)=yd2(i)
          x(3,2)=zd2(i)
          x(1,3)=xd3(i)
          x(2,3)=yd3(i)
          x(3,3)=zd3(i)
          x(1,4)=xd4(i)
          x(2,4)=yd4(i)
          x(3,4)=zd4(i)
          x(1,5)=xd5(i)
          x(2,5)=yd5(i)
          x(3,5)=zd5(i)
          x(1,6)=xd6(i)
          x(2,6)=yd6(i)
          x(3,6)=zd6(i)
          x(1,7)=xd7(i)
          x(2,7)=yd7(i)
          x(3,7)=zd7(i)
          x(1,8)=xd8(i)
          x(2,8)=yd8(i)
          x(3,8)=zd8(i)
C
        DO k=1,3
           ix1=icf1(1,k)
           ix2=icf1(2,k)
           ix3=icf1(3,k)
           ix4=icf1(4,k)
           ix5=icf2(1,k)
           ix6=icf2(2,k)
           ix7=icf2(3,k)
           ix8=icf2(4,k)
           x13=x(1,ix3)-x(1,ix1)+x(1,ix7)-x(1,ix5)
           y13=x(2,ix3)-x(2,ix1)+x(2,ix7)-x(2,ix5)
           z13=x(3,ix3)-x(3,ix1)+x(3,ix7)-x(3,ix5)
           x24=x(1,ix4)-x(1,ix2)+x(1,ix8)-x(1,ix6)
           y24=x(2,ix4)-x(2,ix2)+x(2,ix8)-x(2,ix6)
           z24=x(3,ix4)-x(3,ix2)+x(3,ix8)-x(3,ix6)
             sx(k)=y13*z24-z13*y24
             sy(k)=z13*x24-x13*z24
             sz(k)=x13*y24-y13*x24
             sn(k)=sqrt(sx(k)**2+sy(k)**2+sz(k)**2)
        ENDDO
        snmax=0
        kmax = 1
        DO k=1,3
            IF(sn(k)>snmax)THEN
               kmax=k
               snmax=sn(k)
             sx(k)=sx(k)/sn(k)
             sy(k)=sy(k)/sn(k)
             sz(k)=sz(k)/sn(k)
            ENDIF
          ENDDO
C
        h=1.e30
        DO j=1,4
            j2=icf2(j,kmax)
            j1=icf1(j,kmax)
          h=min(h,
     .      (x(1,j2)-x(1,j1))*sx(kmax)+
     .      (x(2,j2)-x(2,j1))*sy(kmax)+
     .      (x(3,j2)-x(3,j1))*sz(kmax)   )
        ENDDO
C
        hh(i)=zero
C
          IF(h<htest(i))THEN
          ix1=icf1(1,kmax)
          ix2=icf1(2,kmax)
          ix3=icf1(3,kmax)
          ix4=icf1(4,kmax)
          ix5=icf2(1,kmax)
          ix6=icf2(2,kmax)
          ix7=icf2(3,kmax)
          ix8=icf2(4,kmax)
          dh=half*(htest(i)-h)
            dhx=dh*sx(kmax)
            dhy=dh*sy(kmax)
            dhz=dh*sz(kmax)
            x(1,ix1)=x(1,ix1)-dhx
            x(2,ix1)=x(2,ix1)-dhy
            x(3,ix1)=x(3,ix1)-dhz
            x(1,ix2)=x(1,ix2)-dhx
            x(2,ix2)=x(2,ix2)-dhy
            x(3,ix2)=x(3,ix2)-dhz
            x(1,ix3)=x(1,ix3)-dhx
            x(2,ix3)=x(2,ix3)-dhy
            x(3,ix3)=x(3,ix3)-dhz
            x(1,ix4)=x(1,ix4)-dhx
            x(2,ix4)=x(2,ix4)-dhy
            x(3,ix4)=x(3,ix4)-dhz
            x(1,ix5)=x(1,ix5)+dhx
            x(2,ix5)=x(2,ix5)+dhy
            x(3,ix5)=x(3,ix5)+dhz
            x(1,ix6)=x(1,ix6)+dhx
            x(2,ix6)=x(2,ix6)+dhy
            x(3,ix6)=x(3,ix6)+dhz
            x(1,ix7)=x(1,ix7)+dhx
            x(2,ix7)=x(2,ix7)+dhy
            x(3,ix7)=x(3,ix7)+dhz
            x(1,ix8)=x(1,ix8)+dhx
            x(2,ix8)=x(2,ix8)+dhy
            x(3,ix8)=x(3,ix8)+dhz
            xd1(i)=x(1,1)
            yd1(i)=x(2,1)
            zd1(i)=x(3,1)
            xd2(i)=x(1,2)
            yd2(i)=x(2,2)
            zd2(i)=x(3,2)
            xd3(i)=x(1,3)
            yd3(i)=x(2,3)
            zd3(i)=x(3,3)
            xd4(i)=x(1,4)
            yd4(i)=x(2,4)
            zd4(i)=x(3,4)
            xd5(i)=x(1,5)
            yd5(i)=x(2,5)
            zd5(i)=x(3,5)
            xd6(i)=x(1,6)
            yd6(i)=x(2,6)
            zd6(i)=x(3,6)
            xd7(i)=x(1,7)
            yd7(i)=x(2,7)
            zd7(i)=x(3,7)
            xd8(i)=x(1,8)
            yd8(i)=x(2,8)
            zd8(i)=x(3,8)        
          hh(i)=max(one-h/hclos(i),zero)
            hh(i)=min(one,hh(i))
          ENDIF
      ENDDO
      
c copy and cast XD(DP) to X(SP) to assure coherence between XD et X      
      DO i=1,nel
        x1(i)= xd1(i) 
        y1(i)= yd1(i) 
        z1(i)= zd1(i)
        x2(i)= xd2(i)  
        y2(i)= yd2(i)  
        z2(i)= zd2(i) 
        x3(i)= xd3(i) 
        y3(i)= yd3(i) 
        z3(i)= zd3(i) 
        x4(i)= xd4(i) 
        y4(i)= yd4(i) 
        z4(i)= zd4(i) 
        x5(i)= xd5(i) 
        y5(i)= yd5(i)
        z5(i)= zd5(i) 
        x6(i)= xd6(i) 
        y6(i)= yd6(i) 
        z6(i)= zd6(i) 
        x7(i)= xd7(i) 
        y7(i)= yd7(i) 
        z7(i)= zd7(i) 
        x8(i)= xd8(i) 
        y8(i)= yd8(i) 
        z8(i)= zd8(i) 
      ENDDO          
          
      RETURN