mt06ft2.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE mt06ft2
!                   ******************
!
     &( a11 , a12 , a13 ,
     &        a22 , a23 ,
     &              a33 ,
     &  xmul,sf,f,sg,g,x,y,z,ikle1,ikle2,ikle3,nbor,nelem,nelmax)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    COMPUTES THE COEFFICIENTS OF THE FOLLOWING MATRIX:
!code
!+                              /
!+                    A    =   /  F * (P *P )*J(X,Y) DXDY
!+                     I J    /S        I  J
!+
!+     BY ELEMENTARY CELL;
!+  !! THE ELEMENT IS THE P1 TRIANGLE, BUT IN A MESH OF PRISMS !!
!+  !! SPLIT IN TETRAHEDRONS                                   !!
!+
!+     J(X,Y): JACOBIAN OF THE ISOPARAMETRIC TRANSFORMATION
!
!warning  THE JACOBIAN MUST BE POSITIVE
!
!history  J-M HERVOUET (LNH)
!+        26/04/04
!+        V5P5
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A11            |<--| ELEMENTS OF MATRIX
!| A12            |<--| ELEMENTS OF MATRIX
!| A13            |<--| ELEMENTS OF MATRIX
!| A22            |<--| ELEMENTS OF MATRIX
!| A23            |<--| ELEMENTS OF MATRIX
!| A33            |<--| ELEMENTS OF MATRIX
!| F              |-->| FUNCTION F USED IN THE FORMULA
!| G              |-->| FUNCTION G USED IN THE FORMULA
!| IKLE1          |-->| FIRST POINTS OF TRIANGLES
!| IKLE2          |-->| SECOND POINTS OF TRIANGLES
!| IKLE3          |-->| THIRD POINTS OF TRIANGLES
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| SF             |-->| BIEF_OBJ STRUCTURE OF F
!| SG             |-->| BIEF_OBJ STRUCTURE OF G
!| SURFAC         |-->| AREA OF TRIANGLES
!| XMUL           |-->| MULTIPLICATION FACTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_mt06ft2 => mt06ft2
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NBOR(*),NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
!
      DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
      DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*)
      DOUBLE PRECISION, INTENT(INOUT) ::               A33(*)
!
      DOUBLE PRECISION, INTENT(IN) :: XMUL
      DOUBLE PRECISION, INTENT(IN) :: F(*),G(*)
!
!     STRUCTURE OF F
      TYPE(bief_obj), INTENT(IN) :: SF,SG
!
      DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTRINSIC sqrt
!
!-----------------------------------------------------------------------
!
!     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
!
      INTEGER IELMF,IELMG,I1,I2,I3,IELEM
!
      DOUBLE PRECISION SUR60,S,X1,X2,X3,Y1,Y2,Y3,Z1,Z2,Z3,F1,F2,F3,F123
      DOUBLE PRECISION DET1,DET2
!
!**********************************************************************
!
      ielmf=sf%ELM
      ielmg=sg%ELM
!
!-----------------------------------------------------------------------
!
!     F LINEAR BY BOUNDARY SIDE
!
      IF( (ielmf.EQ.61.OR.ielmf.EQ.81) .AND. ielmg.EQ.80 ) THEN
!
        sur60  = xmul/60.d0
!
!   LOOP ON THE BOUNDARY SIDES
!
        DO ielem = 1,nelem
!
!         GLOBAL NUMBERING OF THE SIDE VERTICES
!
          i1 = nbor(ikle1(ielem))
          i2 = nbor(ikle2(ielem))
          i3 = nbor(ikle3(ielem))
!
          x1 = x(i1)
          y1 = y(i1)
          z1 = z(i1)
!
          x2 = x(i2)-x1
          x3 = x(i3)-x1
          y2 = y(i2)-y1
          y3 = y(i3)-y1
          z2 = z(i2)-z1
          z3 = z(i3)-z1
!
          f1 = f(ikle1(ielem)) * g(ielem)
          f2 = f(ikle2(ielem)) * g(ielem)
          f3 = f(ikle3(ielem)) * g(ielem)
          f123  = f1 + f2 + f3
!
!         COMPUTES THE AREA OF THE TRIANGLE (BY VECTOR PRODUCT)
!
          s=0.5d0*sqrt(  (y2*z3-y3*z2)**2
     &                  +(x3*z2-x2*z3)**2
     &                  +(x2*y3-x3*y2)**2  )
!
          det1 = s * sur60
          det2 = det1 + det1
!
!***********************************************************************
!
!         ELEMENTS OFF THE DIAGONAL
!
          a12(ielem) = det1 * (f123+f123-f3)
          a13(ielem) = det1 * (f123+f123-f2)
          a23(ielem) = det1 * (f123+f123-f1)
!
!         DIAGONAL TERMS
!
          a11(ielem) = det2 * (f123+f1+f1)
          a22(ielem) = det2 * (f123+f2+f2)
          a33(ielem) = det2 * (f123+f3+f3)
!
        ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
!     OTHER TYPES OF DISCRETISATION OF F
!
      ELSE
!
        WRITE(lu,101) ielmf,sf%NAME,sg%NAME
101     FORMAT(1x,'MT06FT2 (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6,' AND ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!     NOTE: ON A TRIANGULAR MESH IN PLANE (X, Y)
!
!     DO IELEM = 1 , NELEM
!
!     F1 = F(IKLE1(IELEM))
!     F2 = F(IKLE2(IELEM))
!     F3 = F(IKLE3(IELEM))
!
!     F123 = F1 + F2 + F3
!
!     DET1 = SURFAC(IELEM) * SUR60
!     DET2 = DET1 + DET1
!
!***********************************************************************
!
!  ELEMENTS OFF THE DIAGONAL
!
!     A12(IELEM) = DET1 * (F123+F123-F3)
!     A13(IELEM) = DET1 * (F123+F123-F2)
!     A23(IELEM) = DET1 * (F123+F123-F1)
!
!  DIAGONAL TERMS
!
!     A11(IELEM) = DET2 * (F123+F1+F1)
!     A22(IELEM) = DET2 * (F123+F2+F2)
!     A33(IELEM) = DET2 * (F123+F3+F3)
!
!      ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      RETURN
      END