mt06bb.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE mt06bb
!                   *****************
!
     &( a11 , a12 , a13 , a14 ,
     &        a22 , a23 , a24 ,
     &              a33 , a34 ,
     &                    a44 ,
     &  xmul,sf,f,surfac,ikle1,ikle2,ikle3,ikle4,nelem,nelmax)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    BUILDS THE FOLLOWING MATRIX:
!code
!+     SUM(F*PSII*PSIJ)
!+
!+            WITH:  P1 QUASI-BUBBLE
!+                   P2 QUASI-BUBBLE
!+                   F P1 OR QUASI-BUBBLE
!
!warning  THE JACOBIAN MUST BE POSITIVE
!
!history  J-M HERVOUET (LNH)    ; C MOULIN (LNH)
!+        10/01/95
!+        V5P1
!+
!
!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
!| 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 TRIANGLES
!| IKLE2          |-->| SECOND POINTS OF TRIANGLES
!| IKLE3          |-->| THIRD POINTS OF TRIANGLES
!| IKLE4          |-->| QUASI-BUBBLE POINT
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| SF             |-->| BIEF_OBJ STRUCTURE OF F
!| SURFAC         |-->| AREA OF TRIANGLES
!| XMUL           |-->| MULTIPLICATION FACTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_mt06bb => mt06bb
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
      INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
!
      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) :: SURFAC(nelmax)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
!
      DOUBLE PRECISION F1,F2,F3,F4,XMS090,XMS180,XMS540
      DOUBLE PRECISION XMS018,XMS054,XMS006,XMS009,XMS036
      INTEGER IELMF,IELEM
!
!=======================================================================
!
!     EXTRACTS THE TYPE OF ELEMENT FOR F
!
      ielmf = sf%ELM
!
!  CASE WHERE F IS P0
!
      IF(ielmf.EQ.10) THEN
!
      xms009 = xmul /  9.d0
      xms006 = xmul /  6.d0
      xms018 = xmul / 18.d0
      xms036 = xmul / 36.d0
!
      DO ielem = 1 , nelem
!
!   INITIALISES THE GEOMETRICAL VARIABLES
!
        f1  =  f(ielem) * surfac(ielem)
!
!  DIAGONAL TERMS
!
        a11(ielem) = f1*xms009
        a22(ielem) = f1*xms009
        a33(ielem) = f1*xms009
        a44(ielem) = f1*xms006
!
!  EXTRADIAGONAL TERMS
!
        a12(ielem) = f1*xms036
        a13(ielem) = f1*xms036
        a14(ielem) = f1*xms018
        a23(ielem) = f1*xms036
        a24(ielem) = f1*xms018
        a34(ielem) = f1*xms018
!
      ENDDO ! IELEM
!
!
!-----------------------------------------------------------------------
!
!  CASE WHERE F IS LINEAR
!
      ELSEIF(ielmf.EQ.11) THEN
!
      xms054 = xmul /  54.d0
      xms018 = xmul /  18.d0
      xms540 = xmul / 540.d0
!
      DO ielem = 1 , nelem
!
!   INITIALISES THE GEOMETRICAL VARIABLES
!
        f1  =  f(ikle1(ielem))
        f2  =  f(ikle2(ielem))
        f3  =  f(ikle3(ielem))
!
!   INITIALISES THE INTERMEDIATE VARIABLES
!
!
!  DIAGONAL TERMS
!
        a11(ielem) = (surfac(ielem)*(f3+f2+4*f1))*xms054
        a22(ielem) = (surfac(ielem)*(f3+4*f2+f1))*xms054
        a33(ielem) = (surfac(ielem)*(4*f3+f2+f1))*xms054
        a44(ielem) = (surfac(ielem)*(f3+f2+f1))  *xms018
!
!  EXTRADIAGONAL TERMS
!
        a12(ielem) = (surfac(ielem)*(   f3+ 7*f2+ 7*f1))*xms540
        a13(ielem) = (surfac(ielem)*( 7*f3+   f2+ 7*f1))*xms540
        a14(ielem) = (surfac(ielem)*( 7*f3+ 7*f2+16*f1))*xms540
        a23(ielem) = (surfac(ielem)*( 7*f3+ 7*f2+   f1))*xms540
        a24(ielem) = (surfac(ielem)*( 7*f3+16*f2+ 7*f1))*xms540
        a34(ielem) = (surfac(ielem)*(16*f3+ 7*f2+ 7*f1))*xms540
!
      ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      ELSEIF(ielmf.EQ.12) THEN
!
!-----------------------------------------------------------------------
!
!   QUASI-BUBBLE DISCRETISATION OF F:
!
!
      xms090 = xmul / 90.d0
      xms180 = xmul / 180.d0
!
      DO ielem = 1 , nelem
!
!   INITIALISES THE GEOMETRICAL VARIABLES
!
        f1  =  f(ikle1(ielem))
        f2  =  f(ikle2(ielem))
        f3  =  f(ikle3(ielem))
        f4  =  f(ikle4(ielem))
!
!  DIAGONAL TERMS
!
        a11(ielem) = (surfac(ielem)*(  f3+2*f4+  f2+6*f1))*xms090
        a22(ielem) = (surfac(ielem)*(  f3+2*f4+6*f2+  f1))*xms090
        a33(ielem) = (surfac(ielem)*(6*f3+2*f4+  f2+  f1))*xms090
        a44(ielem) = (surfac(ielem)*(2*f3+9*f4+2*f2+2*f1))*xms090
!
!  EXTRADIAGONAL TERMS
!
        a12(ielem) = (surfac(ielem)*(f4+2*f2+2*f1))*xms180
        a13(ielem) = (surfac(ielem)*(2*f3+f4+2*f1))*xms180
        a14(ielem) = (surfac(ielem)*(f3+4*f4+f2+4*f1))*xms180
        a23(ielem) = (surfac(ielem)*(2*f3+f4+2*f2))*xms180
        a24(ielem) = (surfac(ielem)*(f3+4*f4+4*f2+f1))*xms180
        a34(ielem) = (surfac(ielem)*(4*f3+4*f4+f2+f1))*xms180
!
      ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
!   ANOTHER DISCRETISATION
!      ELSEIF(IELMF.EQ.XX) THEN
!
!-----------------------------------------------------------------------
!
      ELSE
!
        WRITE(lu,101) ielmf,sf%NAME
101     FORMAT(1x,'MT06BB (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END