vc03aa.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc03aa
!                   *****************
!
     &(xmul,sf,sg,sh,su,sv,f,g,h,u,v,xel,yel,surfac,
     & ikle1,ikle2,ikle3,nelem,nelmax,w1,w2,w3 )
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
!code
!+                    /                     DF      DF
!+      V  =  XMUL   /   K GRAD(PSII) * ( U --  + V -- )   D(OMEGA)
!+       I          /OMEGA                  DX      DY
!+
!+    PSI(I) IS A BASE OF TYPE P1 TRIANGLE
!+
!+    F, U AND V ARE VECTORS
!+    K IS A VECTOR WITH COMPONENTS G AND H
!
!warning  THE JACOBIAN MUST BE POSITIVE
!warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM
!
!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
!| G              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| H              |-->| 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
!| SG             |-->| BIEF_OBJ STRUCTURE OF G
!| SH             |-->| BIEF_OBJ STRUCTURE OF H
!| SU             |-->| BIEF_OBJ STRUCTURE OF U
!| SV             |-->| BIEF_OBJ STRUCTURE OF V
!| SURFAC         |-->| AREA OF TRIANGLES
!| U              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| V              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| W1             |<--| RESULT IN NON ASSEMBLED FORM
!| W2             |<--| RESULT IN NON ASSEMBLED FORM
!| W3             |<--| RESULT IN NON ASSEMBLED FORM
!| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
!| XMUL           |-->| MULTIPLICATION COEFFICIENT
!| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_vc03aa => vc03aa
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
!
      DOUBLE PRECISION, INTENT(IN)   :: XEL(nelmax,*),YEL(nelmax,*)
      DOUBLE PRECISION, INTENT(INOUT):: W1(nelmax),W2(nelmax),W3(nelmax)
      DOUBLE PRECISION, INTENT(IN)   :: SURFAC(nelmax)
      DOUBLE PRECISION, INTENT(IN)   :: XMUL
!
!     STRUCTURES OF F, G, H, U, V AND REAL DATA
!
      TYPE(bief_obj), INTENT(IN) :: SF,SG,SH,SU,SV
      DOUBLE PRECISION, INTENT(IN) :: F(*),G(*),H(*),U(*),V(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IELEM,IELMF,IELMG,IELMU,IELMV,IELMH
      DOUBLE PRECISION X2,Y2,X3,Y3,F1,F2,F3,U123,V123
      DOUBLE PRECISION WX1,WX2,WX3,WY1,WY2,WY3,XSUR12,COEF
!
!-----------------------------------------------------------------------
!
      xsur12 = xmul / 12.d0
!
!-----------------------------------------------------------------------
!
      ielmf=sf%ELM
      ielmg=sg%ELM
      ielmu=su%ELM
      ielmv=sv%ELM
      ielmh=sh%ELM
!
!-----------------------------------------------------------------------
!
!     F IS LINEAR; G AND H P0; AND U, V LINEAR
!
      IF(       ielmf.EQ.11
     &     .AND.ielmg.EQ.10
     &     .AND.ielmh.EQ.10
     &     .AND.ielmu.EQ.11
     &     .AND.ielmv.EQ.11  ) THEN
!
      DO ielem = 1 , nelem
!
      x2 = xel(ielem,2)
      x3 = xel(ielem,3)
      y2 = yel(ielem,2)
      y3 = yel(ielem,3)
!
      f1 = f(ikle1(ielem))
      f2 = f(ikle2(ielem)) - f1
      f3 = f(ikle3(ielem)) - f1
!
!     F1 NOW =0 (ONLY THE GRADIENT OF F IS USED)
!
      u123 = u(ikle1(ielem)) + u(ikle2(ielem)) + u(ikle3(ielem))
      v123 = v(ikle1(ielem)) + v(ikle2(ielem)) + v(ikle3(ielem))
!
      wx1 = ( - f2*x3*y2 + f2*x3*y3 + f3*x2*y2 - f3*x2*y3 ) * v123
     &    + ( + f2*y2*y3 - f2*y3*y3 - f3*y2*y2 + f3*y2*y3 ) * u123
!
      wy1 = (   f2*x2*x3 - f3*x2*x2 - f2*x3*x3 + f3*x2*x3 ) * v123
     &    + ( - f2*x2*y3 + f2*x3*y3 + f3*x2*y2 - f3*x3*y2 ) * u123
!
      wx2 = y3 * ( (f3*x2-f2*x3) * v123 + (f2*y3-f3*y2) * u123 )
!
      wy2 = x3 * ( (f2*x3-f3*x2) * v123 + (f3*y2-f2*y3) * u123 )
!
      wx3 = y2 * ( (f2*x3-f3*x2) * v123 + (f3*y2-f2*y3) * u123 )
!
      wy3 = x2 * ( (f3*x2-f2*x3) * v123 + (f2*y3-f3*y2) * u123 )
!
      coef = xsur12 / surfac(ielem)
!
      w1(ielem) = ( wx1*g(ielem) + wy1*h(ielem) ) * coef
      w2(ielem) = ( wx2*g(ielem) + wy2*h(ielem) ) * coef
      w3(ielem) = ( wx3*g(ielem) + wy3*h(ielem) ) * coef
!
      ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      ELSE
!
!-----------------------------------------------------------------------
!
        WRITE(lu,101) ielmf,sf%NAME
        WRITE(lu,111) ielmg,sg%NAME
        WRITE(lu,201) ielmu,su%NAME
        WRITE(lu,301)
101     FORMAT(1x,'VC03AA (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F:',1i6,
     &         1x,'REAL NAME: ',a6)
111     FORMAT(1x,'DISCRETIZATION OF G:',1i6,
     &         1x,'REAL NAME: ',a6)
201     FORMAT(1x,'DISCRETIZATION OF U:',1i6,
     &         1x,'REAL NAME: ',a6)
301     FORMAT(1x,'CASE NOT IMPLEMENTED')
        CALL plante(0)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END