mod_close.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "vect01_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)

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 )

Definition at line 30 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"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      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,*)
      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
C     REAL
      my_real
     .  x13,y13,z13,x24,y24,z24,sx(3),sy(3),sz(3),sn(3),dh,dhx,dhy,dhz,
     .  xc1,yc1,zc1,xc2,yc2,zc2,x(3,8),h,snmax,htest(mvsiz) 
      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=lft,llt
           htest(i)=geo(130,ngeo(i))
      ENDDO
C      
      DO i=lft,llt
          x(1,1)=x1(i)
          x(2,1)=y1(i)
          x(3,1)=z1(i)
          x(1,2)=x2(i)
          x(2,2)=y2(i)
          x(3,2)=z2(i)
          x(1,3)=x3(i)
          x(2,3)=y3(i)
          x(3,3)=z3(i)
          x(1,4)=x4(i)
          x(2,4)=y4(i)
          x(3,4)=z4(i)
          x(1,5)=x5(i)
          x(2,5)=y5(i)
          x(3,5)=z5(i)
          x(1,6)=x6(i)
          x(2,6)=y6(i)
          x(3,6)=z6(i)
          x(1,7)=x7(i)
          x(2,7)=y7(i)
          x(3,7)=z7(i)
          x(1,8)=x8(i)
          x(2,8)=y8(i)
          x(3,8)=z8(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)
C     SX(K)=SX(K)/SN(K)
C     SY(K)=SY(K)/SN(K)
C     SZ(K)=SZ(K)/SN(K)
        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
          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
            x1(i)=x(1,1)
            y1(i)=x(2,1)
            z1(i)=x(3,1)
            x2(i)=x(1,2)
            y2(i)=x(2,2)
            z2(i)=x(3,2)
            x3(i)=x(1,3)
            y3(i)=x(2,3)
            z3(i)=x(3,3)
            x4(i)=x(1,4)
            y4(i)=x(2,4)
            z4(i)=x(3,4)
            x5(i)=x(1,5)
            y5(i)=x(2,5)
            z5(i)=x(3,5)
            x6(i)=x(1,6)
            y6(i)=x(2,6)
            z6(i)=x(3,6)
            x7(i)=x(1,7)
            y7(i)=x(2,7)
            z7(i)=x(3,7)
            x8(i)=x(1,8)
            y8(i)=x(2,8)
            z8(i)=x(3,8)
          ENDIF
      ENDDO
      RETURN