i12cor3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	i12cor3 (xs, xm, irect, msr, irtl, ilev, x, tets, ix1, ix2, ix3, ix4, x1, x2, x3, x4, xi, y1, y2, y3, y4, yi, z1, z2, z3, z4, zi, xface, lft, llt, nft)

Function/Subroutine Documentation

i12cor3()

subroutine i12cor3	(		xs,
			xm,
		integer, dimension(4,*)	irect,
		integer, dimension(*)	msr,
		integer, dimension(*)	irtl,
		integer	ilev,
			x,
			tets,
		integer, dimension(mvsiz), intent(out)	ix1,
		integer, dimension(mvsiz), intent(out)	ix2,
		integer, dimension(mvsiz), intent(out)	ix3,
		integer, dimension(mvsiz), intent(out)	ix4,
		intent(out)	x1,
		intent(out)	x2,
		intent(out)	x3,
		intent(out)	x4,
		intent(out)	xi,
		intent(out)	y1,
		intent(out)	y2,
		intent(out)	y3,
		intent(out)	y4,
		intent(out)	yi,
		intent(out)	z1,
		intent(out)	z2,
		intent(out)	z3,
		intent(out)	z4,
		intent(out)	zi,
		intent(out)	xface,
		integer, intent(inout)	lft,
		integer, intent(inout)	llt,
		integer, intent(inout)	nft )

Definition at line 28 of file i12cor3.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, INTENT(INOUT) :: LFT
      INTEGER, INTENT(INOUT) :: LLT
      INTEGER, INTENT(INOUT) :: NFT
      INTEGER IRECT(4,*), MSR(*), IRTL(*),ILEV
      my_real
     .   xs(3,*),xm(3,*),x(3,*),tets(*)
      INTEGER, DIMENSION(MVSIZ), INTENT(OUT) ::  IX1,IX2,IX3,IX4
      my_real, DIMENSION(MVSIZ), INTENT(OUT) ::  x1,x2,x3,x4,xi
      my_real, DIMENSION(MVSIZ), INTENT(OUT) ::  y1,y2,y3,y4,yi
      my_real, DIMENSION(MVSIZ), INTENT(OUT) ::  z1,z2,z3,z4,zi
      my_real, DIMENSION(MVSIZ), INTENT(OUT) ::  xface
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IL, L, NN
      my_real
     .   deupi,tetmin,tetmax,rmin
C-----------------------------------------------
 
      deupi=two*pi
 
      DO i=lft,llt
        xface(i)=one
        il=i+nft
        l=irtl(il)
 
        xi(i)=xs(1,il)
        yi(i)=xs(2,il)
        zi(i)=xs(3,il)
 
        nn=irect(1,l)
        ix1(i)=msr(nn)
        x1(i)=xm(1,nn)
        y1(i)=xm(2,nn)
        z1(i)=xm(3,nn)
 
        nn=irect(2,l)
        ix2(i)=msr(nn)
        x2(i)=xm(1,nn)
        y2(i)=xm(2,nn)
        z2(i)=xm(3,nn)
 
        nn=irect(3,l)
        ix3(i)=msr(nn)
        x3(i)=xm(1,nn)
        y3(i)=xm(2,nn)
        z3(i)=xm(3,nn)
 
        nn=irect(4,l)
        ix4(i)=msr(nn)
        x4(i)=xm(1,nn)
        y4(i)=xm(2,nn)
        z4(i)=xm(3,nn)
      ENDDO
      
      IF(ilev==1)THEN
      !--------------------------------------------------!
      !   CORRECTION DES TET SI A CHEVAL AXE Y NEGATIF   !
      !--------------------------------------------------!
        DO i=lft,llt
          tetmin=min(z1(i),z2(i),z3(i),z4(i),zi(i))
          tetmax=max(z1(i),z2(i),z3(i),z4(i),zi(i))
          IF(tetmax-tetmin >= pi)THEN
            IF(z1(i)<zero)z1(i)=z1(i)+deupi
            IF(z2(i)<zero)z2(i)=z2(i)+deupi
            IF(z3(i)<zero)z3(i)=z3(i)+deupi
            IF(z4(i)<zero)z4(i)=z4(i)+deupi
            IF(zi(i)<zero)zi(i)=zi(i)+deupi
          ENDIF
        ENDDO
 
        !--------------------------------------------------!
        !   CAS D'UNE FACETTE CENTRALE                     !
        !--------------------------------------------------!
        DO i=lft,llt
          rmin=min(y1(i),y2(i),y3(i),y4(i))
          IF(yi(i)<rmin)THEN
            tetmin=min(z1(i),z2(i),z3(i),z4(i))
            tetmax=max(z1(i),z2(i),z3(i),z4(i))
            IF(tetmax-tetmin >= pi)THEN
              il=i+nft
              l=irtl(il)
              nn=msr(irect(1,l))
              ix1(i)=nn
              x1(i)=x(1,nn)
              y1(i)=x(2,nn)
              z1(i)=x(3,nn)
 
              nn=msr(irect(2,l))
              ix2(i)=nn
              x2(i)=x(1,nn)
              y2(i)=x(2,nn)
              z2(i)=x(3,nn)
 
              nn=msr(irect(3,l))
              ix3(i)=nn
              x3(i)=x(1,nn)
              y3(i)=x(2,nn)
              z3(i)=x(3,nn)
 
              nn=msr(irect(4,l))
              ix4(i)=nn
              x4(i)=x(1,nn)
              y4(i)=x(2,nn)
              z4(i)=x(3,nn)
              tets(i)=10001.
            ENDIF          
          ENDIF
        ENDDO !I=LFT,LLT
      ENDIF !(ILEV==1)
 
      RETURN