cdk6bc3.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	cdk6bc3 (icodr, iskew, iskwn, ixtg, ixtg1, npby, x, skew)

Function/Subroutine Documentation

cdk6bc3()

subroutine cdk6bc3	(	integer, dimension(*)	icodr,
		integer, dimension(*)	iskew,
		integer, dimension(liskn,*)	iskwn,
		integer, dimension(nixtg,*)	ixtg,
		integer, dimension(4,*)	ixtg1,
		integer, dimension(nnpby,*)	npby,
			x,
			skew )

Definition at line 30 of file cdk6bc3.F.

      use element_mod , only : nixtg
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      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICODR(*),ISKEW(*),ISKWN(LISKN,*),IXTG(NIXTG,*),
     .        IXTG1(4,*),NPBY(NNPBY,*)
      my_real
     .  x(3,*),skew(lskew,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,IC1,IC2,IC3,N1,N2,N3,J1(3),IS,NELTG3
      my_real
     .  lx,ly,lz,ll,ll1,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z
C-----------------------------------------------
        neltg3 = numeltg-numeltg6
       DO i=1,numeltg6
C        II=IXTG1(4,I)
        ii = i + neltg3
        n1=ixtg(2,ii)
        n2=ixtg(3,ii)
        n3=ixtg(4,ii)
        ic1=icodr(n1)
        ic2=icodr(n2)
        ic3=icodr(n3)
C--------ligne 1--------------
        IF (ic1>0.AND.ic2>0)THEN
         lx=x(1,n1)-x(1,n2)
         ly=x(2,n1)-x(2,n2)
         lz=x(3,n1)-x(3,n2)
         ll =sqrt(lx*lx+ly*ly+lz*lz)
         j1(1)=ic1/4
         j1(2)=(ic1-4*j1(1))/2
         j1(3)=(ic1-4*j1(1)-2*j1(2))
         is=iskew(n1)
         IF (is==1) THEN
          e1x=skew(1,is)
          e1y=skew(2,is)
          e1z=skew(3,is)
          e2x=skew(4,is)
          e2y=skew(5,is)
          e2z=skew(6,is)
          e3x=skew(7,is)
          e3y=skew(8,is)
          e3z=skew(9,is)
          ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
         ELSE
          ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
         ENDIF
         IF (abs(ll1)/ll>em6) THEN
          j1(1)=ic2/4
          j1(2)=(ic2-4*j1(1))/2
          j1(3)=(ic2-4*j1(1)-2*j1(2))
          is=iskew(n2)
          IF (is==1) THEN
           e1x=skew(1,is)
           e1y=skew(2,is)
           e1z=skew(3,is)
           e2x=skew(4,is)
           e2y=skew(5,is)
           e2z=skew(6,is)
           e3x=skew(7,is)
           e3y=skew(8,is)
           e3z=skew(9,is)
           ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
          ELSE
           ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
          ENDIF
          IF (abs(ll1)/ll>em6) ixtg1(1,i)=-1
         ENDIF
C--------ligne 2--------------
        ELSEIF (ic2>0.AND.ic3>0)THEN
         lx=x(1,n3)-x(1,n2)
         ly=x(2,n3)-x(2,n2)
         lz=x(3,n3)-x(3,n2)
         ll =sqrt(lx*lx+ly*ly+lz*lz)
         j1(1)=ic3/4
         j1(2)=(ic3-4*j1(1))/2
         j1(3)=(ic3-4*j1(1)-2*j1(2))
         is=iskew(n3)
         IF (is==1) THEN
          e1x=skew(1,is)
          e1y=skew(2,is)
          e1z=skew(3,is)
          e2x=skew(4,is)
          e2y=skew(5,is)
          e2z=skew(6,is)
          e3x=skew(7,is)
          e3y=skew(8,is)
          e3z=skew(9,is)
          ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
         ELSE
          ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
         ENDIF
         IF (abs(ll1)/ll>em6) THEN
          j1(1)=ic2/4
          j1(2)=(ic2-4*j1(1))/2
          j1(3)=(ic2-4*j1(1)-2*j1(2))
          is=iskew(n2)
          IF (is==1) THEN
           e1x=skew(1,is)
           e1y=skew(2,is)
           e1z=skew(3,is)
           e2x=skew(4,is)
           e2y=skew(5,is)
           e2z=skew(6,is)
           e3x=skew(7,is)
           e3y=skew(8,is)
           e3z=skew(9,is)
           ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
          ELSE
           ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
          ENDIF
          IF (abs(ll1)/ll>em6) ixtg1(2,i)=-1
         ENDIF
C--------ligne 3--------------
        ELSEIF (ic1>0.AND.ic3>0)THEN
         lx=x(1,n3)-x(1,n1)
         ly=x(2,n3)-x(2,n1)
         lz=x(3,n3)-x(3,n1)
         ll =sqrt(lx*lx+ly*ly+lz*lz)
         j1(1)=ic3/4
         j1(2)=(ic3-4*j1(1))/2
         j1(3)=(ic3-4*j1(1)-2*j1(2))
         is=iskew(n3)
         IF (is==1) THEN
          e1x=skew(1,is)
          e1y=skew(2,is)
          e1z=skew(3,is)
          e2x=skew(4,is)
          e2y=skew(5,is)
          e2z=skew(6,is)
          e3x=skew(7,is)
          e3y=skew(8,is)
          e3z=skew(9,is)
          ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
         ELSE
          ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
         ENDIF
         IF (abs(ll1)/ll>em6) THEN
          j1(1)=ic1/4
          j1(2)=(ic1-4*j1(1))/2
          j1(3)=(ic1-4*j1(1)-2*j1(2))
          is=iskew(n1)
          IF (is==1) THEN
           e1x=skew(1,is)
           e1y=skew(2,is)
           e1z=skew(3,is)
           e2x=skew(4,is)
           e2y=skew(5,is)
           e2z=skew(6,is)
           e3x=skew(7,is)
           e3y=skew(8,is)
           e3z=skew(9,is)
           ll1=lx*(e1x+e2x+e3x)+ly*(e1y+e2y+e3y)+lz*(e1z+e2z+e3z)
          ELSE
           ll1=lx*j1(1)+ly*j1(2)+lz*j1(3)
          ENDIF
          IF (abs(ll1)/ll>em6) ixtg1(3,i)=-1
         ENDIF
        ENDIF
       ENDDO
C-----------------------------------------------
      RETURN