v8p2r0/html/vc13tt_8f_source.html

 !                   *****************
                     SUBROUTINE vc13tt
 !                   *****************
 !
      &(xmul,sf,f,x,y,z,ikle1,ikle2,ikle3,ikle4,nelem,nelmax,
      & w1,w2,w3,w4,icoord,formul)
 !
 !***********************************************************************
 ! BIEF   V6P2                                   21/08/2010
 !***********************************************************************
 !
 !brief    COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
 !code
 !+   (EXAMPLE OF THE X COMPONENT, WHICH CORRESPONDS TO ICOORD=1)
 !+
 !+                       /            DF
 !+    VEC(I)  =  XMUL   /     ( P  *( --  )) D(OMEGA)
 !+                     /OMEGA    I    DX
 !+
 !+    P   IS A LINEAR BASE
 !+     I
 !+
 !+    F IS A VECTOR OF TYPE P1 OR OTHER
 !+
 !+    IN THIS CASE THE ELEMENT IS A LINEAR TETRAHEDRON
 !
 !note     IMPORTANT : IF F IS OF TYPE P0, THE RESULT IS 0.
 !+                     HERE, IF F IS P0, IT REALLY MEANS THAT F IS
 !+                     P1, BUT GIVEN BY ELEMENTS.
 !+                     THE SIZE OF F SHOULD THEN BE : F(NELMAX,3).
 !
 !warning  THE JACOBIAN MUST BE POSITIVE
 !warning  THE RESULT IS IN W IN NOT ASSEMBLED FORM - REAL MESH
 !
 !history  J-M HERVOUET (LNH)
 !+        25/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
 !
 !history  J-M HERVOUET (LNH)
 !+        06/12/2011
 !+        V6P2
 !+   Treating crushed elements and securing options which are not
 !+   implemented.
 !
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !| F              |-->| FUNCTION USED IN THE VECTOR FORMULA
 !| FORMUL         |-->| SEE AT THE END OF THE SUBROUTINE
 !| ICOORD         |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
 !| 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
 !| 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
 !| XEL            |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
 !| XMUL           |-->| MULTIPLICATION COEFFICIENT
 !| YEL            |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !
       USE bief, ex_vc13tt => vc13tt
 !
       USE declarations_special
       IMPLICIT NONE
 !
 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
 !
       INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
       INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
       INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
 !
       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
       DOUBLE PRECISION, INTENT(INOUT) :: W1(nelmax),W2(nelmax)
       DOUBLE PRECISION, INTENT(INOUT) :: W3(nelmax),W4(nelmax)
       DOUBLE PRECISION, INTENT(IN) :: XMUL
 !
 !     STRUCTURE OF F AND REAL DATA
 !
       TYPE(bief_obj), INTENT(IN) :: SF
       DOUBLE PRECISION, INTENT(IN) :: F(*)
       CHARACTER(LEN=16), INTENT(IN) :: FORMUL
 !
 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
 !
       INTEGER IELEM,IELMF
       DOUBLE PRECISION X2,X3,X4,Y2,Y3,Y4,Z2,Z3,Z4,XSUR24,SUR6
       DOUBLE PRECISION VOL
       INTEGER I1,I2,I3,I4
 !
 !-----------------------------------------------------------------------
 !
       sur6=1.d0/6.d0
       xsur24 = xmul/24.d0
 !
 !-----------------------------------------------------------------------
 !
       ielmf=sf%ELM
 !
 !=======================================================================
 !
 !     FILTERING OPTIONS NOT TREATED
 !
       IF(formul(6:6).EQ.'2') THEN
         WRITE(lu,*) 'VC13TT: FORMUL=',formul
         WRITE(lu,*) '        OPTION NOT TREATED'
         CALL plante(1)
         stop
       ENDIF
 !
 !-----------------------------------------------------------------------
 !
 !     F IS LINEAR
 !
       IF(ielmf.EQ.31.OR.ielmf.EQ.51) THEN
 !
       IF(icoord.EQ.1) THEN
 !
 !-----------------------------------------------------------------------
 !
 !     DERIVATIVE WITH RESPECT TO X
 !
       DO ielem = 1 , nelem
 !
         i1 = ikle1(ielem)
         i2 = ikle2(ielem)
         i3 = ikle3(ielem)
         i4 = ikle4(ielem)
 !
 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
 !
         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)
 !
         w1(ielem)=(  (f(i2)-f(i1))*(y3*z4-y4*z3)
      &              +(f(i3)-f(i1))*(z2*y4-y2*z4)
      &              +(f(i4)-f(i1))*(y2*z3-z2*y3)  )*xsur24
 !
         w2(ielem)=w1(ielem)
         w3(ielem)=w1(ielem)
         w4(ielem)=w1(ielem)
 !
       ENDDO ! IELEM
 !
       ELSEIF(icoord.EQ.2) THEN
 !
 !-----------------------------------------------------------------------
 !
 !     DERIVATIVE WITH RESPECT TO Y
 !
       DO ielem = 1 , nelem
 !
         i1 = ikle1(ielem)
         i2 = ikle2(ielem)
         i3 = ikle3(ielem)
         i4 = ikle4(ielem)
 !
 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
 !
         x2  =  x(i2) - x(i1)
         x3  =  x(i3) - x(i1)
         x4  =  x(i4) - x(i1)
         z2  =  z(i2) - z(i1)
         z3  =  z(i3) - z(i1)
         z4  =  z(i4) - z(i1)
 !
         w1(ielem)=(  (f(i2)-f(i1))*(x4*z3-x3*z4)
      &              +(f(i3)-f(i1))*(x2*z4-z2*x4)
      &              +(f(i4)-f(i1))*(z2*x3-x2*z3)  )*xsur24
 !
         w2(ielem)=w1(ielem)
         w3(ielem)=w1(ielem)
         w4(ielem)=w1(ielem)
 !
       ENDDO
 !
       ELSEIF(icoord.EQ.3) THEN
 !
 !-----------------------------------------------------------------------
 !
 !     DERIVATIVE WITH RESPECT TO Z
 !
       DO ielem = 1 , nelem
 !
         i1 = ikle1(ielem)
         i2 = ikle2(ielem)
         i3 = ikle3(ielem)
         i4 = ikle4(ielem)
 !
 !       REAL COORDINATES OF THE POINTS OF THE ELEMENT (ORIGIN IN 1)
 !
         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)
 !
         w1(ielem)=(  (f(i2)-f(i1))*(x3*y4-x4*y3)
      &              +(f(i3)-f(i1))*(y2*x4-x2*y4)
      &              +(f(i4)-f(i1))*(x2*y3-y2*x3)  )*xsur24
 !
         w2(ielem)=w1(ielem)
         w3(ielem)=w1(ielem)
         w4(ielem)=w1(ielem)
 !
       ENDDO ! IELEM
 !
       ELSE
 !
 !-----------------------------------------------------------------------
 !
         WRITE(lu,201) icoord
 201     FORMAT(1x,'VC13TT (BIEF) : IMPOSSIBLE COMPONENT ',
      &            1i6,' CHECK ICOORD')
         CALL plante(1)
         stop
 !
       ENDIF
 !
 !=======================================================================
 !
       ELSE
 !
 !=======================================================================
 !
         WRITE(lu,102) ielmf,sf%NAME
 102     FORMAT(1x,'VC13TT (BIEF) :',/,
      &         1x,'DISCRETISATION OF F : ',1i6,' NOT IMPLEMENTED',/,
      &         1x,'REAL NAME OF F: ',a6)
         CALL plante(1)
         stop
 !
       ENDIF
 !
 !=======================================================================
 !
 !     FILTER FOR PARTLY CRUSHED ELEMENTS (ON THE VERTICAL)
 !
       IF(formul(7:7).EQ.'2') THEN
 !
         DO ielem = 1 , nelem
           i1 = ikle1(ielem)
           i2 = ikle2(ielem)
           i3 = ikle3(ielem)
           i4 = ikle4(ielem)
 !
           x2=x(i2)-x(i1)
           y2=y(i2)-y(i1)
           z2=z(i2)-z(i1)
           x3=x(i3)-x(i1)
           y3=y(i3)-y(i1)
           z3=z(i3)-z(i1)
           x4=x(i4)-x(i1)
           y4=y(i4)-y(i1)
           z4=z(i4)-z(i1)
 !
           vol=(z2*(x3*y4-x4*y3)+y2*(x4*z3-x3*z4)+x2*(y3*z4-y4*z3))*sur6
 !
 !         TEST DE VC13PP
 !         IF(Z(I4)-Z(I1).LT.1.D-3.OR.
 !    &       Z(I5)-Z(I2).LT.1.D-3.OR.
 !    &       Z(I6)-Z(I3).LT.1.D-3     ) THEN
 !
 !         HIDDEN PARAMETER !!!!!!!!!!!!!!!!!!!
 !
           IF(vol.LT.1.d-6) THEN
             w1(ielem)=0.d0
             w2(ielem)=0.d0
             w3(ielem)=0.d0
             w4(ielem)=0.d0
           ENDIF
         ENDDO
 !
       ELSEIF(formul(7:7).NE.' ') THEN
         WRITE(lu,*) 'VC13TT: FORMUL=',formul
         WRITE(lu,*) '        OPTION NOT TREATED'
         CALL plante(1)
         stop
       ENDIF
 !
 !=======================================================================
 !
       RETURN
       END
declarations_special
Definition: declarations_special.F:3

vc13tt
subroutine vc13tt(XMUL, SF, F, X, Y, Z, IKLE1, IKLE2, IKLE3, IKLE4, NELEM, NELMAX, W1, W2, W3, W4, ICOORD, FORMUL)
Definition: vc13tt.f:8

declarations_special::lu
integer lu
Definition: declarations_special.F:45

bief
Definition: bief.f:3