vc05aa.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc05aa
!                   *****************
!
     &( xmul,sf,f,surfac,
     &  ikle1,ikle2,ikle3,nelem,nelmax,w1,w2,w3)
!
!***********************************************************************
! BIEF   V7P1                                   27/04/2015
!***********************************************************************
!
!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  A JOLY (LNHE)
!+        27/04/2015
!+        V7P1
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| 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 declarations_special
      USE bief, ex_vc05aa => vc05aa
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
!
      DOUBLE PRECISION, INTENT(IN) :: SURFAC(nelmax)
      DOUBLE PRECISION,INTENT(INOUT)::W1(nelmax),W2(nelmax),W3(nelmax)
      DOUBLE PRECISION, INTENT(IN) :: XMUL
!
!     STRUCTURE OF F AND REAL DATA
!
      TYPE(bief_obj), INTENT(IN)   :: SF
      DOUBLE PRECISION, INTENT(IN) :: F(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!
! ! Method 1
!       INTEGER IELEM,IELMF
!       DOUBLE PRECISION XSUR03,F1,F2,F3,COEF
!
! Method 2
      INTEGER IELEM,IELMF
      DOUBLE PRECISION XSUR12,F1,F2,F3,F123,COEF
!
!
!-----------------------------------------------------------------------
!
      ielmf=sf%ELM
!
!-----------------------------------------------------------------------
!
!     F IS A LINEAR TRIANGLE
!
      IF(ielmf.EQ.11) THEN
!
! !---------------
! ! Method 1
! !---------------
!       XSUR03 = XMUL / 3.D0
! !
!       DO IELEM = 1 , NELEM
! !
!         F1  = F(IKLE1(IELEM))
!         F2  = F(IKLE2(IELEM))
!         F3  = F(IKLE3(IELEM))
! !
!         COEF = XSUR03 * SURFAC(IELEM)
! !
!         ! SURFACE / 3.D0 * NOEUD
!         W1(IELEM) = COEF * F1
!         W2(IELEM) = COEF * F2
!         W3(IELEM) = COEF * F3
!         W4(IELEM) = 0.D0
!         W5(IELEM) = 0.D0
!         W6(IELEM) = 0.D0
! !
!       ENDDO
!
!---------------
! Method 2
!---------------
      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)
!
        ! SURFACE / 3.D0 * MOYENNE (FACE + NOEUD)
        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,'VC05AA (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END