vc01aa.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc01aa
!                   *****************
!
     &( xmul,sf,f,surfac,
     &  ikle1,ikle2,ikle3,nelem,nelmax,
     &  w1,w2,w3 )
!
!***********************************************************************
! BIEF   V7P0                                   21/08/2010
!***********************************************************************
!
!brief    COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
!code
!+                    /
!+    VEC(I) = XMUL  /    PSI(I) * F  D(OMEGA)
!+                  /OMEGA
!+
!+    PSI(I) IS A BASE OF TYPE P1 TRIANGLE
!+
!+    F IS A VECTOR OF DISCRETISATION P0, P1 OR DISCONTINUOUS P1
!
!warning  THE JACOBIAN MUST BE POSITIVE
!warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM
!
!history  J-M HERVOUET (LNH)    ; F LEPEINTRE (LNH)
!+        29/10/99
!+        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
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        12/05/2014
!+        V7P0
!+   Discontinuous elements better treated: new types 15, 16 and 17 for
!+   discontinuous linear, quasi-bubble, and quadratic, rather than
!+   using component DIMDISC=11, 12 or 13.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| IKLE1          |-->| FIRST POINT OF TRIANGLES
!| IKLE2          |-->| SECOND POINT OF TRIANGLES
!| IKLE3          |-->| THIRD POINT OF TRIANGLES
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| SF             |-->| BIEF_OBJ STRUCTURE OF F
!| SURFAC         |-->| AREA OF TRIANGLES
!| W1             |<--| RESULT IN NON ASSEMBLED FORM
!| W2             |<--| RESULT IN NON ASSEMBLED FORM
!| W3             |<--| RESULT IN NON ASSEMBLED FORM
!| XMUL           |-->| MULTIPLICATION COEFFICIENT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_vc01aa => vc01aa
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
!
      DOUBLE PRECISION, INTENT(INOUT) :: W1(nelmax)
      DOUBLE PRECISION, INTENT(INOUT) :: W2(nelmax)
      DOUBLE PRECISION, INTENT(INOUT) :: W3(nelmax)
      DOUBLE PRECISION, INTENT(IN)    :: SURFAC(nelmax)
      DOUBLE PRECISION, INTENT(IN)    :: XMUL
!
!     STRUCTURE OF F AND REAL DATA
!
      TYPE(bief_obj), INTENT(IN)   :: SF
      DOUBLE PRECISION, INTENT(IN) :: F(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IELEM,IELMF
      DOUBLE PRECISION XSUR03,XSUR12,F1,F2,F3,F123,COEF
!
!-----------------------------------------------------------------------
!
      ielmf=sf%ELM
!
!-----------------------------------------------------------------------
!
!     F IS LINEAR
!
      IF(ielmf.EQ.11) THEN
!
      xsur12 = xmul / 12.d0
!
      DO ielem = 1 , nelem
!
        f1  = f(ikle1(ielem))
        f2  = f(ikle2(ielem))
        f3  = f(ikle3(ielem))
        f123  = f1 + f2 + f3
!
        coef = xsur12 * surfac(ielem)
!
        w1(ielem) = coef * ( f123 + f1 )
        w2(ielem) = coef * ( f123 + f2 )
        w3(ielem) = coef * ( f123 + f3 )
!
      ENDDO
!
!-----------------------------------------------------------------------
!
!     F IS CONSTANT BY ELEMENT
!
      ELSEIF(ielmf.EQ.10.AND.sf%DIM2.EQ.1) THEN
!
      xsur03 = xmul / 3.d0
!
      DO ielem = 1 , nelem
!
        w1(ielem) = xsur03 * surfac(ielem) * f(ielem)
        w2(ielem) = w1(ielem)
        w3(ielem) = w1(ielem)
!
      ENDDO
!
!-----------------------------------------------------------------------
!
!     F IS DISCONTINUOUS P1
!
      ELSEIF(ielmf.EQ.15) THEN
!
      xsur12 = xmul / 12.d0
!
      DO ielem = 1 , nelem
!
        f1  = f(ielem)
        f2  = f(ielem+nelem)
        f3  = f(ielem+2*nelem)
        f123  = f1 + f2 + f3
!
        coef = xsur12 * surfac(ielem)
!
        w1(ielem) = coef * ( f123 + f1 )
        w2(ielem) = coef * ( f123 + f2 )
        w3(ielem) = coef * ( f123 + f3 )
!
      ENDDO
!
!-----------------------------------------------------------------------
!
      ELSE
!
!-----------------------------------------------------------------------
!
        WRITE(lu,101) ielmf,sf%NAME
101     FORMAT(1x,'VC01AA (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END