i25norm3.F File Reference

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

Go to the source code of this file.

Modules
module	mod_i25norm

Functions/Subroutines
subroutine	i25norm (nrtm, irectm, numnod, x, nod_normal, nmn, msr, itab, nrtm0, msegtyp, mvoisin, evoisin, nedge, ledge, lbound, admsr, vtx_bisector, e2s_nod_normal, nadmsr, iedge, ielem_m)

Variables
real *4, dimension(:,:,:), allocatable	mod_i25norm::wnod_normal

Function/Subroutine Documentation

i25norm()

subroutine i25norm	(	integer	nrtm,
		integer, dimension(4,nrtm)	irectm,
		integer	numnod,
			x,
		real*4, dimension(3,4,nrtm)	nod_normal,
		integer	nmn,
		integer, dimension(*)	msr,
		integer, dimension(*)	itab,
		integer	nrtm0,
		integer, dimension(*)	msegtyp,
		integer, dimension(4,nrtm)	mvoisin,
		integer, dimension(4,nrtm)	evoisin,
		integer	nedge,
		integer, dimension(nledge,*)	ledge,
		integer, dimension(*)	lbound,
		integer, dimension(4,*)	admsr,
		real*4, dimension(3,2,*)	vtx_bisector,
		real*4, dimension(3,*)	e2s_nod_normal,
		integer	nadmsr,
		integer	iedge,
		integer, dimension(2,nrtm), intent(inout)	ielem_m )

Definition at line 40 of file i25norm3.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE mod_i25norm
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NRTM,NUMNOD,NRTM0,NADMSR,IEDGE,IRECTM(4,NRTM),NMN,MSR(*),
     .        MVOISIN(4,NRTM), EVOISIN(4,NRTM),ITAB(*),MSEGTYP(*),
     .        NEDGE, LEDGE(NLEDGE,*), LBOUND(*), ADMSR(4,*)
C     REAL
      my_real
     .   x(3,numnod)
      real*4 nod_normal(3,4,nrtm), vtx_bisector(3,2,*),e2s_nod_normal(3,*)
      INTEGER  , INTENT(INOUT) :: IELEM_M(2,NRTM)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, FIRST, LAST, IRM, IEDG, I1, I2, I3, I4 
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
     .        JRM, JEDG, IS1, IS2, ISH, SOL_EDGE
C     REAL
      real*4
     .     x0(mvsiz), y0(mvsiz), z0(mvsiz),
     .     x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
     .     y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .     z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .     x01(mvsiz),  x02(mvsiz),  x03(mvsiz), x04(mvsiz),
     .     y01(mvsiz),  y02(mvsiz),  y03(mvsiz), y04(mvsiz),
     .     z01(mvsiz),  z02(mvsiz),  z03(mvsiz), z04(mvsiz),
     .     xn1(mvsiz),yn1(mvsiz),zn1(mvsiz),
     .     xn2(mvsiz),yn2(mvsiz),zn2(mvsiz),
     .     xn3(mvsiz),yn3(mvsiz),zn3(mvsiz),
     .     xn4(mvsiz),yn4(mvsiz),zn4(mvsiz),
     .     xs(mvsiz),ys(mvsiz),zs(mvsiz),
     .     aaa, xad, s1, s2, s3, s4,
     .     rzero, run, rem30, rep30, rdix,
     .     nx, ny, nz, vx, vy, vz, x12, y12, z12
C-----------------------------------------------
      rzero = 0.
      run   = 1.
      rdix  = 10.
      rep30 = rdix**30
      rem30 = run/rep30
C
      nod_normal(1:3,1:4,1:nrtm) = rzero
      vtx_bisector(1:3,1:2,1:nadmsr) = rzero
C optimisable en spmd si ajout flag pour routine de comm, spmd_exchange_n
      sol_edge = 0 
      IF(iedge/=0) sol_edge =iedge/10 ! solids
      IF(sol_edge  /=0)THEN
        DO i=1,nadmsr
          e2s_nod_normal(1,i) = rzero
          e2s_nod_normal(2,i) = rzero
          e2s_nod_normal(3,i) = rzero
        END DO
      ENDIF
 
      first=1
      last =min(nrtm0,mvsiz)
C
 100  CONTINUE
C
      DO i=1,last-first+1
        irm=i+first-1
        IF(ielem_m(2,irm) ==0)THEN
            ix1(i)=irectm(1,irm)
            ix2(i)=irectm(2,irm)
            ix3(i)=irectm(3,irm)
            ix4(i)=irectm(4,irm)
            x1(i)=x(1,ix1(i))
            y1(i)=x(2,ix1(i))
            z1(i)=x(3,ix1(i))
            x2(i)=x(1,ix2(i))
            y2(i)=x(2,ix2(i))
            z2(i)=x(3,ix2(i))
            x3(i)=x(1,ix3(i))
            y3(i)=x(2,ix3(i))
            z3(i)=x(3,ix3(i))
            x4(i)=x(1,ix4(i))
            y4(i)=x(2,ix4(i))
            z4(i)=x(3,ix4(i))
        ENDIF
      END DO
C
      DO i=1,last-first+1
        irm=i+first-1
        IF(ielem_m(2,irm) ==0)THEN
          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
        ENDIF
      END DO
C
      DO i=1,last-first+1
        irm=i+first-1
        IF(ielem_m(2,irm) ==0)THEN
C
          x01(i) = x1(i) - x0(i)
          y01(i) = y1(i) - y0(i)
          z01(i) = z1(i) - z0(i)
C
          x02(i) = x2(i) - x0(i)
          y02(i) = y2(i) - y0(i)
          z02(i) = z2(i) - z0(i)
C
          x03(i) = x3(i) - x0(i)
          y03(i) = y3(i) - y0(i)
          z03(i) = z3(i) - z0(i)
C
          x04(i) = x4(i) - x0(i)
          y04(i) = y4(i) - y0(i)
          z04(i) = z4(i) - z0(i)
C
        ENDIF
      ENDDO
C
      DO i=1,last-first+1
         irm=i+first-1
         IF(ielem_m(2,irm) ==0)THEN
C
           xn1(i) = y01(i)*z02(i) - z01(i)*y02(i)
           yn1(i) = z01(i)*x02(i) - x01(i)*z02(i)
           zn1(i) = x01(i)*y02(i) - y01(i)*x02(i)
C
           xn2(i) = y02(i)*z03(i) - z02(i)*y03(i)
           yn2(i) = z02(i)*x03(i) - x02(i)*z03(i)
           zn2(i) = x02(i)*y03(i) - y02(i)*x03(i)
C
           xn3(i) = y03(i)*z04(i) - z03(i)*y04(i)
           yn3(i) = z03(i)*x04(i) - x03(i)*z04(i)
           zn3(i) = x03(i)*y04(i) - y03(i)*x04(i)
C
           xn4(i) = y04(i)*z01(i) - z04(i)*y01(i)
           yn4(i) = z04(i)*x01(i) - x04(i)*z01(i)
           zn4(i) = x04(i)*y01(i) - y04(i)*x01(i)
C
         ENDIF
      ENDDO
C
      DO i=1,last-first+1
C
         irm=i+first-1
         IF(ielem_m(2,irm) ==0)THEN
           aaa=run/max(rem30,sqrt(xn1(i)*xn1(i)+yn1(i)*yn1(i)+zn1(i)*zn1(i)))
           xn1(i) = xn1(i)*aaa
           yn1(i) = yn1(i)*aaa
           zn1(i) = zn1(i)*aaa
C
           aaa=run/max(rem30,sqrt(xn2(i)*xn2(i)+yn2(i)*yn2(i)+zn2(i)*zn2(i)))
           xn2(i) = xn2(i)*aaa
           yn2(i) = yn2(i)*aaa
           zn2(i) = zn2(i)*aaa
C
           aaa=run/max(rem30,sqrt(xn3(i)*xn3(i)+yn3(i)*yn3(i)+zn3(i)*zn3(i)))
           xn3(i) = xn3(i)*aaa
           yn3(i) = yn3(i)*aaa
           zn3(i) = zn3(i)*aaa
C
           aaa=run/max(rem30,sqrt(xn4(i)*xn4(i)+yn4(i)*yn4(i)+zn4(i)*zn4(i)))
           xn4(i) = xn4(i)*aaa
           yn4(i) = yn4(i)*aaa
           zn4(i) = zn4(i)*aaa
C
         ENDIF
      ENDDO
C
      DO i=1,last-first+1
C
        irm=i+first-1
C
        IF(ielem_m(2,irm) ==0)THEN
 
          IF(ix4(i)/=ix3(i))THEN
C
            nod_normal(1,1,irm)=xn1(i)
            nod_normal(2,1,irm)=yn1(i)
            nod_normal(3,1,irm)=zn1(i)
C
            nod_normal(1,2,irm)=xn2(i)
            nod_normal(2,2,irm)=yn2(i)
            nod_normal(3,2,irm)=zn2(i)
C
            nod_normal(1,3,irm)=xn3(i)
            nod_normal(2,3,irm)=yn3(i)
            nod_normal(3,3,irm)=zn3(i)
C
            nod_normal(1,4,irm)=xn4(i)
            nod_normal(2,4,irm)=yn4(i)
            nod_normal(3,4,irm)=zn4(i)
C
          ELSE
C
            nod_normal(1,1,irm)=xn1(i)
            nod_normal(2,1,irm)=yn1(i)
            nod_normal(3,1,irm)=zn1(i)
C
            nod_normal(1,2,irm)=xn1(i)
            nod_normal(2,2,irm)=yn1(i)
            nod_normal(3,2,irm)=zn1(i)
C
            nod_normal(1,4,irm)=xn1(i)
            nod_normal(2,4,irm)=yn1(i)
            nod_normal(3,4,irm)=zn1(i)
C
          END IF
C
        ENDIF
      ENDDO
C
      DO i=1,last-first+1
C
        irm=i+first-1
C
        IF(ielem_m(2,irm) ==0)THEN
 
          ish=msegtyp(irm)
          IF(ish > 0) THEN
            IF(ish > nrtm)ish=ish-nrtm
C
            IF(ix3(i)/=ix4(i))THEN
C
              nod_normal(1,1,ish)=-xn1(i)
              nod_normal(2,1,ish)=-yn1(i)
              nod_normal(3,1,ish)=-zn1(i)
C
              nod_normal(1,4,ish)=-xn2(i)
              nod_normal(2,4,ish)=-yn2(i)
              nod_normal(3,4,ish)=-zn2(i)
C
              nod_normal(1,3,ish)=-xn3(i)
              nod_normal(2,3,ish)=-yn3(i)
              nod_normal(3,3,ish)=-zn3(i)
C
              nod_normal(1,2,ish)=-xn4(i)
              nod_normal(2,2,ish)=-yn4(i)
              nod_normal(3,2,ish)=-zn4(i)
C
            ELSE
C
              nod_normal(1,1,ish)=-xn1(i)
              nod_normal(2,1,ish)=-yn1(i)
              nod_normal(3,1,ish)=-zn1(i)
C
              nod_normal(1,4,ish)=-xn1(i)
              nod_normal(2,4,ish)=-yn1(i)
              nod_normal(3,4,ish)=-zn1(i)
C
              nod_normal(1,2,ish)=-xn1(i)
              nod_normal(2,2,ish)=-yn1(i)
              nod_normal(3,2,ish)=-zn1(i)
C
            ENDIF
          END IF
        END IF
 
      ENDDO
 
 
      IF(sol_edge/=0)THEN
C
        DO i=1,last-first+1
C
           irm=i+first-1
C
           i1=abs(admsr(1,irm))
           i2=abs(admsr(2,irm))
           i3=abs(admsr(3,irm))
           i4=abs(admsr(4,irm))
C
           xad=admsr(1,irm)
           s1=sign(run,xad)
c        s1=ONE
           xad=admsr(2,irm)
           s2=sign(run,xad)
c        s2=ONE
           xad=admsr(3,irm)
           s3=sign(run,xad)
c        s3=ONE
           xad=admsr(4,irm)
           s4=sign(run,xad)
c        s4=ONE
C
          IF(i4/=i3)THEN
C
            e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*(xn4(i)+xn1(i))
            e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*(yn4(i)+yn1(i))
            e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*(zn4(i)+zn1(i))
C
            e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*(xn1(i)+xn2(i))
            e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*(yn1(i)+yn2(i))
            e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*(zn1(i)+zn2(i))
C
            e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*(xn2(i)+xn3(i))
            e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*(yn2(i)+yn3(i))
            e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*(zn2(i)+zn3(i))
C
            e2s_nod_normal(1,i4)=e2s_nod_normal(1,i4)+s4*(xn3(i)+xn4(i))
            e2s_nod_normal(2,i4)=e2s_nod_normal(2,i4)+s4*(yn3(i)+yn4(i))
            e2s_nod_normal(3,i4)=e2s_nod_normal(3,i4)+s4*(zn3(i)+zn4(i))
C
          ELSE
C
            e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*xn1(i)
            e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*yn1(i)
            e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*zn1(i)
C
            e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*xn1(i)
            e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*yn1(i)
            e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*zn1(i)
C
            e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*xn1(i)
            e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*yn1(i)
            e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*zn1(i)
C
          END IF
C
        ENDDO
 
      ENDIF
 
 
C
      IF(last < nrtm0)THEN
        first=last+1
        last =min(last+mvsiz,nrtm0)
        GO TO 100
      END IF
C------------------------------------
      DO irm=1,nrtm
C
        IF(ielem_m(2,irm) ==0)THEN
            DO iedg=1,4
               IF(mvoisin(iedg,irm)==0)THEN
                  IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
C
                     nx=nod_normal(1,iedg,irm)
                     ny=nod_normal(2,iedg,irm)
                     nz=nod_normal(3,iedg,irm)
C
                     i1=irectm(iedg,irm)
                     i2=irectm(mod(iedg,4)+1,irm)
        
                     x12=x(1,i2)-x(1,i1)
                     y12=x(2,i2)-x(2,i1)
                     z12=x(3,i2)-x(3,i1)
        
                     vx=y12*nz-z12*ny
                     vy=z12*nx-x12*nz
                     vz=x12*ny-y12*nx
        
                     aaa=run/max(rem30,sqrt(vx*vx+vy*vy+vz*vz))
                     vx=vx*aaa
                     vy=vy*aaa
                     vz=vz*aaa
        
                     nod_normal(1,iedg,irm)=vx
                     nod_normal(2,iedg,irm)=vy
                     nod_normal(3,iedg,irm)=vz
        
                  END IF
               END IF
             END DO
        ENDIF
      END DO
C
      DO irm=1,nrtm
 
            IF(ielem_m(2,irm) ==0)THEN
                  DO iedg=1,4
               IF(mvoisin(iedg,irm)==0)THEN
                IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
        
                  vx=nod_normal(1,iedg,irm)
                  vy=nod_normal(2,iedg,irm)
                  vz=nod_normal(3,iedg,irm)
C
                  is1=admsr(iedg,irm)
C                 LBOUND(IS1)=1
                  IF(vtx_bisector(1,1,is1)==rzero.AND.
     .               vtx_bisector(2,1,is1)==rzero.AND.
     .               vtx_bisector(3,1,is1)==rzero)THEN
                       vtx_bisector(1,1,is1)=vx
                       vtx_bisector(2,1,is1)=vy
                       vtx_bisector(3,1,is1)=vz
                  ELSE
                       vtx_bisector(1,2,is1)=vx
                       vtx_bisector(2,2,is1)=vy
                       vtx_bisector(3,2,is1)=vz
                  END IF    
C
                  is2=admsr(mod(iedg,4)+1,irm)
C         LBOUND(IS2)=1
                  IF(vtx_bisector(1,1,is2)==rzero.AND.
     .               vtx_bisector(2,1,is2)==rzero.AND.
     .               vtx_bisector(3,1,is2)==rzero)THEN
                      vtx_bisector(1,1,is2)=vx
                      vtx_bisector(2,1,is2)=vy
                      vtx_bisector(3,1,is2)=vz
                  ELSE
                      vtx_bisector(1,2,is2)=vx
                      vtx_bisector(2,2,is2)=vy
                      vtx_bisector(3,2,is2)=vz
                  END IF    
        
                 END IF
                END IF
            END DO
        ENDIF
      END DO
C------------------------------------
      ALLOCATE(wnod_normal(3,4,nrtm))
C------------------------------------
      DO irm=1,nrtm
         IF(ielem_m(2,irm) ==0)THEN
            DO j=1,4
               IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
                  jrm =mvoisin(j,irm)
                  jedg=evoisin(j,irm)
                  IF(jrm /= 0)THEN
                     wnod_normal(1,j,irm)=nod_normal(1,jedg,jrm)
                     wnod_normal(2,j,irm)=nod_normal(2,jedg,jrm)
                     wnod_normal(3,j,irm)=nod_normal(3,jedg,jrm)
                  ELSE
                     wnod_normal(1,j,irm)=rzero
                     wnod_normal(2,j,irm)=rzero
                     wnod_normal(3,j,irm)=rzero
                   END IF
                END IF
            END DO
        ENDIF
      END DO
C------------------------------------
      DO irm=1,nrtm
        IF(ielem_m(2,irm) ==0)THEN
            DO j=1,4
               IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
                  jrm =mvoisin(j,irm)
                  IF( jrm /= 0) THEN
                      nx=nod_normal(1,j,irm)+wnod_normal(1,j,irm)
                      ny=nod_normal(2,j,irm)+wnod_normal(2,j,irm)
                      nz=nod_normal(3,j,irm)+wnod_normal(3,j,irm)
                      aaa=run/max(rem30,sqrt(nx*nx+ny*ny+nz*nz))
                      nod_normal(1,j,irm)=nx*aaa
                      nod_normal(2,j,irm)=ny*aaa
                      nod_normal(3,j,irm)=nz*aaa
                  END IF
               END IF
            END DO
        ENDIF
      END DO
C------------------------------------
C     Nodal normals
C------------------------------------
      IF(sol_edge/=0)THEN 
        DO i=1,nadmsr
          aaa=run/max(rem30,sqrt(e2s_nod_normal(1,i)*e2s_nod_normal(1,i)+
     .                       e2s_nod_normal(2,i)*e2s_nod_normal(2,i)+
     .                       e2s_nod_normal(3,i)*e2s_nod_normal(3,i)))
          e2s_nod_normal(1,i)=e2s_nod_normal(1,i)*aaa
          e2s_nod_normal(2,i)=e2s_nod_normal(2,i)*aaa
          e2s_nod_normal(3,i)=e2s_nod_normal(3,i)*aaa
        END DO
       ENDIF
C------------------------------------
 
      DEALLOCATE(wnod_normal)
 
      RETURN