vc01ff.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc01ff
!                   *****************
!
     &(xmul,sf,f,x,y,z,
     & ikle1,ikle2,ikle3,ikle4,nbor,neleb,nelebx,w1,w2,w3,w4,
     & nelbor,nulone,nelmax)
!
!***********************************************************************
! BIEF   V6P3                                  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 SEGMENT
!+
!+    F IS A VECTOR OF TYPE IELMF
!
!warning  THE JACOBIAN MUST BE POSITIVE
!warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM
!
!history  J-M HERVOUET (LNH)    ; F LEPEINTRE (LNH)
!+        05/02/91
!+        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 R&D, LNHE)
!+        11/012013
!+        V6P3
!+   Last 3 arguments added, use of XEL, YEL instead of XPT,YPT.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| IKLE1          |-->| FIRST POINT OF QUADRILATERAL
!| IKLE2          |-->| SECOND POINT OF QUADRILATERAL
!| IKLE3          |-->| THIRD POINT OF QUADRILATERAL
!| IKLE4          |-->| FOURTH POINT OF QUADRILATERAL
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| 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
!| W1             |<--| RESULT IN NON ASSEMBLED FORM
!| W2             |<--| RESULT IN NON ASSEMBLED FORM
!| W3             |<--| RESULT IN NON ASSEMBLED FORM
!| W4             |<--| RESULT IN NON ASSEMBLED FORM
!| X              |-->| ABSCISSAE OF POINTS IN THE MESH
!| XMUL           |-->| MULTIPLICATION COEFFICIENT
!| Y              |-->| ORDINATES OF POINTS IN THE MESH
!| Z              |-->| ELEVATIONS OF POINTS IN THE MESH
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_vc01ff => vc01ff
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEB,NELEBX,NELMAX
      INTEGER, INTENT(IN) :: NELBOR(nelebx),NULONE(nelebx,4),NBOR(*)
      INTEGER, INTENT(IN) :: IKLE1(nelebx),IKLE2(nelebx)
      INTEGER, INTENT(IN) :: IKLE3(nelebx),IKLE4(nelebx)
!
      DOUBLE PRECISION, INTENT(IN)    :: X(nelmax,6),Y(nelmax,6),Z(*)
      DOUBLE PRECISION, INTENT(INOUT) :: W1(nelebx),W2(nelebx)
      DOUBLE PRECISION, INTENT(INOUT) :: W3(nelebx),W4(nelebx)
!
!     STRUCTURE OF F AND REAL DATA
!
      TYPE(bief_obj), INTENT(IN)   :: SF
      DOUBLE PRECISION, INTENT(IN) :: F(*)
      DOUBLE PRECISION, INTENT(IN) :: XMUL
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IELEM,IELMF,I1,I2,I3,I4,IEL,J1,J2
      DOUBLE PRECISION XSUR72,H1,H2,HT,AL,F1,F2,F3,F4
!
      INTRINSIC sqrt
!
!***********************************************************************
!
      ielmf=sf%ELM
!
      xsur72 = xmul/72.d0
!
!-----------------------------------------------------------------------
!
!     F IS LINEAR BY BOUNDARY SIDE
!
      IF(ielmf.EQ.71) THEN
!
        DO ielem = 1,neleb
!
          iel=nelbor(ielem)
!
          IF(iel.GT.0) THEN
!
!           ELEMENT IN THE DOMAIN
!
!           LOOP ON THE BOUNDARY SIDES
!
!           GLOBAL NUMBERING OF THE SIDE NODES
!
            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) * xsur72
!
            h1 = z(nbor(i4)) - z(nbor(i1))
            h2 = z(nbor(i3)) - z(nbor(i2))
            ht = h1 + h2
            h1 = h1 + h1 + ht
            h2 = h2 + h2 + ht
!
            f1 = f(i1) + f(i1) + f(i4)
            f2 = f(i2) + f(i2) + f(i3)
            f3 = f(i2) + f(i3) + f(i3)
            f4 = f(i1) + f(i4) + f(i4)
!
            w1(ielem) = (f1*h1+f2*ht)*al
            w2(ielem) = (f1*ht+f2*h2)*al
            w3(ielem) = (f4*ht+f3*h2)*al
            w4(ielem) = (f4*h1+f3*ht)*al
!
          ELSE
!
!           ELEMENT NOT IN THE DOMAIN (PARALLELISM)
!
            w1(ielem) = 0.d0
            w2(ielem) = 0.d0
            w3(ielem) = 0.d0
            w4(ielem) = 0.d0
!
          ENDIF
!
        ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      ELSE
!
!-----------------------------------------------------------------------
!
        WRITE(lu,101) ielmf,sf%NAME
101     FORMAT(1x,'VC01FF (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
     &         1x,'REAL NAME: ',a6)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END