mt06ff.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE mt06ff
!                   *****************
!
     &( a11 , a12 , a13 , a14 ,
     &        a22 , a23 , a24 ,
     &              a33 , a34 ,
     &                    a44 ,
     &  xmul,sf,f,x,y,z,ikle1,ikle2,ikle3,ikle4,nbor,nelbor,
     &  nulone,neleb,nelebx,nelmax)
!
!***********************************************************************
! BIEF   V6P3                                  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 Q1 QUADRILATERAL, IN A PRISM MESH !!
!+
!+     J(X,Y): JACOBIAN OF THE ISOPARAMETRIC TRANSFORMATION
!
!warning  THE JACOBIAN MUST BE POSITIVE
!
!history  J-M HERVOUET (LNH)
!+        18/08/94
!+        V5P3
!+
!
!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
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        11/01/2013
!+        V6P3
!+   ARguments added, XEL and YEL sent instead of XPT and YPT for X and Y.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A11            |<--| ELEMENTS OF MATRIX
!| A12            |<--| ELEMENTS OF MATRIX
!| A13            |<--| ELEMENTS OF MATRIX
!| A14            |<--| ELEMENTS OF MATRIX
!| A22            |<--| ELEMENTS OF MATRIX
!| A23            |<--| ELEMENTS OF MATRIX
!| A24            |<--| ELEMENTS OF MATRIX
!| A33            |<--| ELEMENTS OF MATRIX
!| A34            |<--| ELEMENTS OF MATRIX
!| A44            |<--| ELEMENTS OF MATRIX
!| F              |-->| FUNCTION F USED IN THE FORMULA
!| IKLE1          |-->| FIRST POINTS OF QUADRILATERALS
!| IKLE2          |-->| SECOND POINTS OF QUADRILATERALS
!| IKLE3          |-->| THIRD POINTS OF QUADRILATERALS
!| IKLE4          |-->| FOURTH POINTS OF QUADRILATERALS
!| NELBOR         |-->| ADJACENT ELEMENT NUMBER
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| NULONE         |-->| LOCAL NUMBERING OF BOUNDARY ELEMENT IN ADJACENT
!|                |   | ELEMENT.
!| SF             |-->| BIEF_OBJ STRUCTURE OF F
!| SURFAC         |-->| AREA OF TRIANGLES
!| XMUL           |-->| MULTIPLICATION FACTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_mt06ff => mt06ff
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEB,NELEBX,NELMAX
      INTEGER, INTENT(IN) :: NBOR(*),NELBOR(nelebx),NULONE(nelebx,4)
      INTEGER, INTENT(IN) :: IKLE1(nelebx),IKLE2(nelebx)
      INTEGER, INTENT(IN) :: IKLE3(nelebx),IKLE4(nelebx)
!
      DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*),A14(*)
      DOUBLE PRECISION, INTENT(INOUT) ::        A22(*),A23(*),A24(*)
      DOUBLE PRECISION, INTENT(INOUT) ::               A33(*),A34(*)
      DOUBLE PRECISION, INTENT(INOUT) ::                      A44(*)
!
      DOUBLE PRECISION, INTENT(IN) :: XMUL
      DOUBLE PRECISION, INTENT(IN) :: F(*)
!
!     STRUCTURE OF F
      TYPE(bief_obj), INTENT(IN) :: SF
!
      DOUBLE PRECISION, INTENT(IN) :: X(nelmax,6),Y(nelmax,6),Z(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTRINSIC sqrt
!
!     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
!
      INTEGER IELMF,I1,I2,I3,I4,IELEM,IEL,J1,J2
!
      DOUBLE PRECISION SUR720,AL,S1,S2,S11112,S11122,S11222,S12222
      DOUBLE PRECISION F14,F23,F1114,F2223,F2333,F1444
!
!**********************************************************************
!
      ielmf=sf%ELM
!
!-----------------------------------------------------------------------
!
!     F LINEAR BY BOUNDARY SIDE
!
      IF(ielmf.EQ.71) THEN
!
        sur720  = xmul/720.d0
!
!       LOOP ON THE BOUNDARY SIDES
!
        DO ielem = 1,neleb
!
          iel=nelbor(ielem)
!
          IF(iel.GT.0) THEN
!
!           ELEMENT IN DOMAIN
!
!           GLOBAL NUMBERING OF THE SIDE VERTICES
!
            i1 = ikle1(ielem)
            i2 = ikle2(ielem)
            i3 = ikle3(ielem)
            i4 = ikle4(ielem)
!
            j1=nulone(ielem,1)
            j2=nulone(ielem,2)
            al = sqrt((x(iel,j2)-x(iel,j1))**2
     &               +(y(iel,j2)-y(iel,j1))**2) * sur720
!
            s1 = (z(nbor(i4)) - z(nbor(i1))) * al
            s2 = (z(nbor(i3)) - z(nbor(i2))) * al
            s11112 = s1 + s1 + s1 + s1 + s2
            s11122 = s1 + s1 + s1 + s2 + s2
            s11222 = s1 + s1 + s2 + s2 + s2
            s12222 = s1 + s2 + s2 + s2 + s2
!
            f14 = f(i1) + f(i4)
            f23 = f(i2) + f(i3)
            f1114 = f(i1) + f(i1) + f14
            f2223 = f(i2) + f(i2) + f23
            f2333 = f23 + f(i3) + f(i3)
            f1444 = f14 + f(i4) + f(i4)
!
!           DIAGONAL TERMS
!
            a11(ielem) = 3*f1114*s11112 + f2223*s11122
            a22(ielem) = 3*f2223*s12222 + f1114*s11222
            a33(ielem) = 3*f2333*s12222 + f1444*s11222
            a44(ielem) = 3*f1444*s11112 + f2333*s11122
!
!           ELEMENTS OFF THE DIAGONAL
!
            a12(ielem) = f1114*s11122 + f2223*s11222
            a13(ielem) =   f14*s11122 +   f23*s11222
            a14(ielem) = 3*f14*s11112 +   f23*s11122
            a23(ielem) = 3*f23*s12222 +   f14*s11222
            a24(ielem) = a13(ielem)
            a34(ielem) = f2333*s11222 + f1444*s11122
!
          ELSE
!
!           ELEMENT NOT IN DOMAIN (PARALLELISM)
!
            a11(ielem) = 0.d0
            a22(ielem) = 0.d0
            a33(ielem) = 0.d0
            a44(ielem) = 0.d0
            a12(ielem) = 0.d0
            a13(ielem) = 0.d0
            a14(ielem) = 0.d0
            a23(ielem) = 0.d0
            a24(ielem) = 0.d0
            a34(ielem) = 0.d0
!
          ENDIF
!
        ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
!     OTHER TYPES OF DISCRETISATION OF F
!
      ELSE
!
        WRITE(lu,101) ielmf,sf%NAME
101     FORMAT(1x,'MT06FF (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END