i25cor3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	i25cor3 (jlt, igap, x, irect, nsv, cand_e, cand_n, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, gap_s, gaps, admsr, nod_normal, x1, x2, x3, x4, x0, y1, y2, y3, y4, y0, z1, z2, z3, z4, z0, nnx, nny, nnz, mvoisin, mvoisn, gap_m, gapm, gap_nm, gapnm, gap_s_l, gap_m_l, gapmxl, lbound, ibound)

Function/Subroutine Documentation

i25cor3()

subroutine i25cor3	(	integer	jlt,
		integer	igap,
			x,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	nsv,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			xi,
			yi,
			zi,
		integer, dimension(mvsiz)	ix1,
		integer, dimension(mvsiz)	ix2,
		integer, dimension(mvsiz)	ix3,
		integer, dimension(mvsiz)	ix4,
		integer, dimension(mvsiz)	nsvg,
		integer	nsn,
			gap_s,
			gaps,
		integer, dimension(4,*)	admsr,
		real*4, dimension(3,4,*)	nod_normal,
			x1,
			x2,
			x3,
			x4,
			x0,
			y1,
			y2,
			y3,
			y4,
			y0,
			z1,
			z2,
			z3,
			z4,
			z0,
			nnx,
			nny,
			nnz,
		integer, dimension(4,*)	mvoisin,
		integer, dimension(mvsiz,4)	mvoisn,
			gap_m,
			gapm,
			gap_nm,
			gapnm,
			gap_s_l,
			gap_m_l,
			gapmxl,
		integer, dimension(*)	lbound,
		integer, dimension(4,mvsiz)	ibound )

Definition at line 28 of file i25cor3.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
     .        JLT, NSN, IGAP
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ), 
     .        NSVG(MVSIZ), ADMSR(4,*),
     .        MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ)
      my_real
     .   x(3,*), gap_s(*), gaps(mvsiz), gap_m(*), gapm(*),
     .   gap_nm(4,*), gapnm(4,*), gap_s_l(*), gap_m_l(*),
     .   gapmxl(*)
      my_real
     .   xi(mvsiz), yi(mvsiz), zi(mvsiz), 
     .   x1(mvsiz),y1(mvsiz),z1(mvsiz),
     .   x2(mvsiz),y2(mvsiz),z2(mvsiz),
     .   x3(mvsiz),y3(mvsiz),z3(mvsiz),
     .   x4(mvsiz),y4(mvsiz),z4(mvsiz),
     .   x0(mvsiz),y0(mvsiz),z0(mvsiz),
     .   nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
      real*4 nod_normal(3,4,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I ,J , L, NN, IG, JFT, IX,  NI, I1, I2, I3, I4
      my_real
     .        xn
C-----------------------------------------------
      DO i=1,jlt
        ni = cand_n(i)
C
        ig = nsv(ni)
        nsvg(i) = ig
C
        xi(i) = x(1,ig)
        yi(i) = x(2,ig)
        zi(i) = x(3,ig)
        gaps(i)  = gap_s(ni)
C
      END DO
C
      DO i=1,jlt
C
        l  = cand_e(i)
C
        ix=irect(1,l)  
        ix1(i)=ix      
        x1(i)=x(1,ix)  
        y1(i)=x(2,ix)  
        z1(i)=x(3,ix)  
C
        ix=irect(2,l)  
        ix2(i)=ix      
        x2(i)=x(1,ix)  
        y2(i)=x(2,ix)  
        z2(i)=x(3,ix)  
C
        ix=irect(3,l)  
        ix3(i)=ix      
        x3(i)=x(1,ix)  
        y3(i)=x(2,ix)  
        z3(i)=x(3,ix)  
C
        ix=irect(4,l)  
        ix4(i)=ix      
        x4(i)=x(1,ix)  
        y4(i)=x(2,ix)  
        z4(i)=x(3,ix)  
C
        gapm(i)  = gap_m(l)
        gapnm(1:4,i)=gap_nm(1:4,l)
C
      END DO
C
      IF(igap/=3)THEN
        gapmxl(1:jlt)=ep30
      ELSE
        DO i=1,jlt
          ni = cand_n(i)
          l  = cand_e(i)
          gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
        END DO
      END IF
C
      DO i=1,jlt
C
        IF(ix3(i) /= ix4(i))THEN
         x0(i)  = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
         y0(i)  = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
         z0(i)  = fourth*(z1(i)+z2(i)+z3(i)+z4(i)) 
        ELSE
         x0(i)  = x3(i)
         y0(i)  = y3(i)
         z0(i)  = z3(i) 
        ENDIF
C
      END DO
C
      DO i=1,jlt
C
        l  = cand_e(i)
C
        nnx(i,1)=nod_normal(1,1,l)
        nny(i,1)=nod_normal(2,1,l)
        nnz(i,1)=nod_normal(3,1,l)
C
        nnx(i,2)=nod_normal(1,2,l)
        nny(i,2)=nod_normal(2,2,l)
        nnz(i,2)=nod_normal(3,2,l)
C
        nnx(i,3)=nod_normal(1,3,l)
        nny(i,3)=nod_normal(2,3,l)
        nnz(i,3)=nod_normal(3,3,l)
C
        nnx(i,4)=nod_normal(1,4,l)
        nny(i,4)=nod_normal(2,4,l)
        nnz(i,4)=nod_normal(3,4,l)
C
      END DO
C
      DO i=1,jlt
        IF(ix3(i)/=ix4(i))THEN
          nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
          nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
          nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
        ELSE
          nnx(i,5)=nnx(i,4)
          nny(i,5)=nny(i,4)
          nnz(i,5)=nnz(i,4)
        ENDIF
        xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
        nnx(i,5)=xn*nnx(i,5)
        nny(i,5)=xn*nny(i,5)
        nnz(i,5)=xn*nnz(i,5)       
      END DO
C
      ibound(1:4,1:jlt)=0
      DO i=1,jlt
        l   = cand_e(i)
        DO j=1,4
          mvoisn(i,j)=mvoisin(j,l)
          IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
        END DO
      END DO
C
      RETURN