vc01pp.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc01pp
!                   *****************
!
     &( xmul,sf,f,z,surfac,
     &  ikle1,ikle2,ikle3,ikle4,ikle5,ikle6,nelem,nelmax,
     &  w1,w2,w3,w4,w5,w6)
!
!***********************************************************************
! BIEF   V6P1                                   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 PRISM
!+
!+    F IS A VECTOR OF TYPE IELMF
!
!warning  THE JACOBIAN MUST BE POSITIVE
!warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM - REAL MESH
!
!history  J-M HERVOUET (LNH)    ; F LEPEINTRE (LNH)
!+        09/12/94
!+        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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| IKLE1          |-->| FIRST POINT OF PRISMS
!| IKLE2          |-->| SECOND POINT OF PRISMS
!| IKLE3          |-->| THIRD POINT OF PRISMS
!| IKLE4          |-->| FOURTH POINT OF PRISMS
!| IKLE5          |-->| FIFTH POINT OF PRISMS
!| IKLE6          |-->| SIXTH POINT OF PRISMS
!| 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
!| W4             |<--| RESULT IN NON ASSEMBLED FORM
!| W5             |<--| RESULT IN NON ASSEMBLED FORM
!| W6             |<--| RESULT IN NON ASSEMBLED FORM
!| XMUL           |-->| MULTIPLICATION COEFFICIENT
!| Z              |-->| ELEVATIONS OF POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_vc01pp => vc01pp
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
      INTEGER, INTENT(IN) :: IKLE4(nelmax),IKLE5(nelmax),IKLE6(nelmax)
!
      DOUBLE PRECISION, INTENT(IN) :: Z(*)
      DOUBLE PRECISION, INTENT(IN) :: SURFAC(nelmax)
      DOUBLE PRECISION,INTENT(INOUT)::W1(nelmax),W2(nelmax),W3(nelmax)
      DOUBLE PRECISION,INTENT(INOUT)::W4(nelmax),W5(nelmax),W6(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 SUR360,COEF,H1,H2,H3,SHT,SH1,SH2,SH3
      DOUBLE PRECISION F1,F2,F3,F4,F5,F6,SFI,SFS,SF1,SF2,SF3,SF4,SF5,SF6
      DOUBLE PRECISION HF1,HF2,HF3,HF4,HF5,HF6,SHFI,SHFS
      DOUBLE PRECISION SHF1,SHF2,SHF3,SHF4,SHF5,SHF6
!
!***********************************************************************
!
      ielmf=sf%ELM
!
!-----------------------------------------------------------------------
!
!   F IS LINEAR
!
      IF(ielmf.EQ.41) THEN
!
        sur360 = xmul / 360.d0
!
        DO ielem = 1 , nelem
!
          coef = sur360 * surfac(ielem)
!
          h1  = coef * (z(ikle4(ielem)) - z(ikle1(ielem)))
          h2  = coef * (z(ikle5(ielem)) - z(ikle2(ielem)))
          h3  = coef * (z(ikle6(ielem)) - z(ikle3(ielem)))
          sht = h1 + h2 + h3
          sh1 = h1 + sht
          sh2 = h2 + sht
          sh3 = h3 + sht
!
          f1  = f(ikle1(ielem))
          f2  = f(ikle2(ielem))
          f3  = f(ikle3(ielem))
          f4  = f(ikle4(ielem))
          f5  = f(ikle5(ielem))
          f6  = f(ikle6(ielem))
          sfi = f1 + f2 + f3
          sfs = f4 + f5 + f6
          sf1 = f1 + sfi
          sf2 = f2 + sfi
          sf3 = f3 + sfi
          sf4 = f4 + sfs
          sf5 = f5 + sfs
          sf6 = f6 + sfs
!
          hf1  = h1 * f1
          hf2  = h2 * f2
          hf3  = h3 * f3
          hf4  = h1 * f4
          hf5  = h2 * f5
          hf6  = h3 * f6
          shfi = hf1 + hf2 + hf3
          shfs = hf4 + hf5 + hf6
          shf1 = hf1 + shfi
          shf2 = hf2 + shfi
          shf3 = hf3 + shfi
          shf4 = hf4 + shfs
          shf5 = hf5 + shfs
          shf6 = hf6 + shfs
!
          w1(ielem) = sh1 * (sf1+sf1+sf4) + shf1 + shf1 + shf4
          w2(ielem) = sh2 * (sf2+sf2+sf5) + shf2 + shf2 + shf5
          w3(ielem) = sh3 * (sf3+sf3+sf6) + shf3 + shf3 + shf6
          w4(ielem) = sh1 * (sf1+sf4+sf4) + shf1 + shf4 + shf4
          w5(ielem) = sh2 * (sf2+sf5+sf5) + shf2 + shf5 + shf5
          w6(ielem) = sh3 * (sf3+sf6+sf6) + shf3 + shf6 + shf6
!
        ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      ELSE
!
        WRITE(lu,102) ielmf,sf%NAME
102     FORMAT(1x,'VC01PP (BIEF) :',/,
     &         1x,'DISCRETISATION OF F : ',1i6,' NOT IMPLEMENTED',/,
     &         1x,'REAL NAME OF F: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END