mt01tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt01tt.f
00002 !
00064                      SUBROUTINE MT01TT
00065 !                    *****************
00066 !
00067      &( T,XM,XMUL,X,Y,Z,IKLE,NELEM,NELMAX)
00068 !
00069 !***********************************************************************
00070 ! BIEF   V6P1                                   21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00078 !| IKLE           |-->| CONNECTIVITY TABLE.
00079 !| NELEM          |-->| NUMBER OF ELEMENTS
00080 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00081 !| SURFAC         |-->| AREA OF TRIANGLES
00082 !| T              |<--| NON ASSEMBLED DIAGONAL
00083 !| XM             |<--| NON ASSEMBLED OFF-DIAGONAL TERMS
00084 !| XMUL           |-->| MULTIPLICATION FACTOR
00085 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00086 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00087 !| Z              |-->| ELEVATIONS OF POINTS IN THE MESH
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !
00090       USE BIEF, EX_MT01TT => MT01TT
00091 !
00092       IMPLICIT NONE
00093 !
00094       INTEGER LNG,LU
00095       COMMON/INFO/LNG,LU
00096 !
00097 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00098 !
00099       INTEGER, INTENT(IN)             :: NELEM,NELMAX
00100       INTEGER, INTENT(IN)             :: IKLE(NELMAX,4)
00101       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,4),XM(NELMAX,6)
00102       DOUBLE PRECISION, INTENT(IN)    :: XMUL
00103       DOUBLE PRECISION, INTENT(IN)    :: X(*),Y(*),Z(*)
00104 !
00105 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00106 !
00107 !     SPECIFIC DECLARATIONS
00108 !
00109       DOUBLE PRECISION X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4,VOLSUR20
00110       INTEGER I1,I2,I3,I4,IELEM
00111 !
00112       DOUBLE PRECISION XSUR120
00113 !
00114 !***********************************************************************
00115 !
00116       XSUR120=XMUL/120.D0
00117 !
00118 !-----------------------------------------------------------------------
00119 !
00120 !     LOOP ON THE TETRAHEDRONS
00121 !
00122       DO IELEM=1,NELEM
00123 !
00124       I1=IKLE(IELEM,1)
00125       I2=IKLE(IELEM,2)
00126       I3=IKLE(IELEM,3)
00127       I4=IKLE(IELEM,4)
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       X2=X(I2)-X(I1)
00132       Y2=Y(I2)-Y(I1)
00133       Z2=Z(I2)-Z(I1)
00134       X3=X(I3)-X(I1)
00135       Y3=Y(I3)-Y(I1)
00136       Z3=Z(I3)-Z(I1)
00137       X4=X(I4)-X(I1)
00138       Y4=Y(I4)-Y(I1)
00139       Z4=Z(I4)-Z(I1)
00140 !
00141 !     EXTRA-DIAGONAL TERMS
00142 !
00143 !     VOLUME OF THE TETRAHEDRON:
00144 !
00145 !     (Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))/6
00146 !
00147 !     XM(IELEM,1) = VOLUME / 20
00148 !
00149 !     SUMS UP THE TERMS (INC. SYMMETRIC ONES) TO YIELD VOLUME OF THE TETRAHEDRON
00150 !
00151       VOLSUR20 =
00152      &(Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))*XSUR120
00153       XM(IELEM,1) = MAX(VOLSUR20,1.D-4)
00154       XM(IELEM,2) = XM(IELEM,1)
00155       XM(IELEM,3) = XM(IELEM,1)
00156       XM(IELEM,4) = XM(IELEM,1)
00157       XM(IELEM,5) = XM(IELEM,1)
00158       XM(IELEM,6) = XM(IELEM,1)
00159 !
00160 !     DIAGONAL TERMS
00161 !
00162       T(IELEM,1) = 2 * XM(IELEM,1)
00163       T(IELEM,2) = T(IELEM,1)
00164       T(IELEM,3) = T(IELEM,1)
00165       T(IELEM,4) = T(IELEM,1)
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169       ENDDO ! IELEM
00170 !
00171 !-----------------------------------------------------------------------
00172 !
00173       RETURN
00174       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0