vc08tt.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vc08tt
!                   *****************
!
     &(xmul,sf,su,sv,sw,f,u,v,w,x,y,z,
     & ikle1,ikle2,ikle3,ikle4,nelem,nelmax,w1,w2,w3,w4)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
!code
!+                    /                  DF      DF
!+      V  =  XMUL   /       PSII  * ( U --  + V -- )   D(OMEGA)
!+       I          /OMEGA               DX      DY
!+
!+    PSI(I) IS A BASE OF TYPE P1 TETRAHEDRON
!
!warning  THE JACOBIAN MUST BE POSITIVE
!warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM - REAL MESH
!
!history  J-M HERVOUET (LNH)
!+        22/03/02
!+        V5P3
!+
!
!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 TETRAHEDRA
!| IKLE2          |-->| SECOND POINT OF TETRAHEDRA
!| IKLE3          |-->| THIRD POINT OF TETRAHEDRA
!| IKLE4          |-->| FOURTH POINT OF TETRAHEDRA
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
!| SF             |-->| BIEF_OBJ STRUCTURE OF F
!| SU             |-->| BIEF_OBJ STRUCTURE OF U
!| SV             |-->| BIEF_OBJ STRUCTURE OF V
!| SW             |-->| BIEF_OBJ STRUCTURE OF W
!| U              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| V              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| W              |-->| FUNCTION USED IN THE VECTOR FORMULA
!| 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
!| Y              |-->| ORDINATES OF POINTS IN THE MESH
!| XMUL           |-->| MULTIPLICATION COEFFICIENT
!| Z              |-->| ELEVATIONS OF POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_vc08tt => vc08tt
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NELEM,NELMAX
      INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
      INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
!
      DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*),XMUL
      DOUBLE PRECISION, INTENT(INOUT) :: W1(nelmax),W2(nelmax)
      DOUBLE PRECISION, INTENT(INOUT) :: W3(nelmax),W4(nelmax)
!
!     STRUCTURES OF F, U, V AND REAL DATA
!
      TYPE(bief_obj),   INTENT(IN) :: SF,SU,SV,SW
      DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*),W(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION X2,X3,X4,Y2,Y3,Y4,Z2,Z3,Z4
      DOUBLE PRECISION U1,U2,U3,U4,V1,V2,V3,V4,Q1,Q2,Q3,Q4
      DOUBLE PRECISION F1MF2,F1MF3,F1MF4,HELP1,HELP2,HELP3
      DOUBLE PRECISION U1234,V1234,W1234,XSUR120
!
      INTEGER I1,I2,I3,I4,IELEM,IELMF,IELMU,IELMV,IELMW
!
!**********************************************************************
!
      xsur120 = xmul / 120.d0
!
      ielmf=sf%ELM
      ielmu=su%ELM
      ielmv=sv%ELM
      ielmw=sw%ELM
!
!-----------------------------------------------------------------------
!
!     FUNCTION F AND VECTOR U ARE LINEAR
!
      IF( (ielmu.EQ.31.AND.ielmv.EQ.31.AND.ielmw.EQ.31.AND.ielmf.EQ.31)
     &    .OR.
     &    (ielmu.EQ.51.AND.ielmv.EQ.51.AND.ielmw.EQ.51.AND.ielmf.EQ.51)
     &  ) THEN
!
!        LOOP ON THE ELEMENTS
!
        DO ielem = 1,nelem
!
          i1 = ikle1(ielem)
          i2 = ikle2(ielem)
          i3 = ikle3(ielem)
          i4 = ikle4(ielem)
!
          x2  =   x(i2) - x(i1)
          x3  =   x(i3) - x(i1)
          x4  =   x(i4) - x(i1)
          y2  =   y(i2) - y(i1)
          y3  =   y(i3) - y(i1)
          y4  =   y(i4) - y(i1)
          z2  =   z(i2) - z(i1)
          z3  =   z(i3) - z(i1)
          z4  =   z(i4) - z(i1)
!
          u1  =  u(i1)
          u2  =  u(i2)
          u3  =  u(i3)
          u4  =  u(i4)
!
          v1  =  v(i1)
          v2  =  v(i2)
          v3  =  v(i3)
          v4  =  v(i4)
!
          q1  =  w(i1)
          q2  =  w(i2)
          q3  =  w(i3)
          q4  =  w(i4)
!
          u1234 = u1 + u2 + u3 + u4
          v1234 = v1 + v2 + v3 + v4
          w1234 = q1 + q2 + q3 + q4
!
          f1mf2  =  f(i1) - f(i2)
          f1mf3  =  f(i1) - f(i3)
          f1mf4  =  f(i1) - f(i4)
!
          help1 = (  (y4*z3-y3*z4)*f1mf2
     &              +(y2*z4-y4*z2)*f1mf3
     &              +(y3*z2-y2*z3)*f1mf4  ) * xsur120
!
          help2 = (  (x3*z4-x4*z3)*f1mf2
     &              +(x4*z2-x2*z4)*f1mf3
     &              +(x2*z3-x3*z2)*f1mf4  ) * xsur120
!
          help3 = (  (x4*y3-x3*y4)*f1mf2
     &              +(x2*y4-x4*y2)*f1mf3
     &              +(x3*y2-x2*y3)*f1mf4  ) * xsur120
!
          w1(ielem) = ( u1234 + u1 ) * help1
     &              + ( v1234 + v1 ) * help2
     &              + ( w1234 + q1 ) * help3
          w2(ielem) = ( u1234 + u2 ) * help1
     &              + ( v1234 + v2 ) * help2
     &              + ( w1234 + q2 ) * help3
          w3(ielem) = ( u1234 + u3 ) * help1
     &              + ( v1234 + v3 ) * help2
     &              + ( w1234 + q3 ) * help3
          w4(ielem) = ( u1234 + u4 ) * help1
     &              + ( v1234 + v4 ) * help2
     &              + ( w1234 + q4 ) * help3
!
        ENDDO ! IELEM
!
!-----------------------------------------------------------------------
!
      ELSE
!
!-----------------------------------------------------------------------
!
        WRITE(lu,101) ielmf,sf%NAME
        WRITE(lu,201) ielmu,su%NAME
        WRITE(lu,301)
101     FORMAT(1x,'VC08TT (BIEF) :',/,
     &         1x,'DISCRETIZATION OF F:',1i6,
     &         1x,'REAL NAME: ',a6)
201     FORMAT(1x,'DISCRETIZATION OF U:',1i6,
     &         1x,'REAL NAME: ',a6)
301     FORMAT(1x,'CASE NOT IMPLEMENTED')
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END