mt06tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt06tt.f
00002 !
00073                      SUBROUTINE MT06TT
00074 !                    *****************
00075 !
00076      &( T,XM,XMUL,SF,F,X,Y,Z,IKLE,NELEM,NELMAX)
00077 !
00078 !***********************************************************************
00079 ! BIEF   V6P1                                   21/08/2010
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| F              |-->| FUNCTION USED IN THE FORMULA
00088 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00089 !| IKLE           |-->| CONNECTIVITY TABLE.
00090 !| NELEM          |-->| NUMBER OF ELEMENTS
00091 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00092 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00093 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00094 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00095 !| Z              |-->| ELEVATIONS OF POINTS
00096 !| XM             |<->| OFF-DIAGONAL TERMS
00097 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !
00100       USE BIEF, EX_MT06TT => MT06TT
00101       IMPLICIT NONE
00102 !
00103       INTEGER LNG,LU
00104       COMMON/INFO/LNG,LU
00105 !
00106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00107 !
00108       INTEGER, INTENT(IN) :: NELEM,NELMAX
00109       INTEGER, INTENT(IN) :: IKLE(NELMAX,4)
00110 !
00111       DOUBLE PRECISION, INTENT(INOUT) :: T(NELMAX,4),XM(NELMAX,6)
00112 !
00113       DOUBLE PRECISION, INTENT(IN) :: XMUL
00114 !
00115       DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
00116 !
00117       TYPE(BIEF_OBJ), INTENT(IN) :: SF
00118       DOUBLE PRECISION, INTENT(IN) :: F(*)
00119 !
00120 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00121 !
00122 !     SPECIFIC DECLARATIONS
00123 !
00124       DOUBLE PRECISION X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4,F1,F2,F3,F4
00125       INTEGER I1,I2,I3,I4
00126       INTEGER IELMF,IELEM
00127 !
00128       DOUBLE PRECISION XSUR720,JACOB
00129 !
00130 !***********************************************************************
00131 !
00132 !     DISCRETISES VECTOR F
00133       IELMF=SF%ELM
00134       XSUR720=XMUL/720.D0
00135 !
00136 !-----------------------------------------------------------------------
00137 !
00138 ! CASE WHERE F IS P1 LINEAR
00139 !
00140       IF (IELMF .EQ. 31) THEN
00141 !     LOOP ON THE TETRAHEDRONS
00142 !
00143           DO IELEM=1,NELEM
00144 !
00145               I1=IKLE(IELEM,1)
00146               I2=IKLE(IELEM,2)
00147               I3=IKLE(IELEM,3)
00148               I4=IKLE(IELEM,4)
00149 !
00150               F1 = F(I1)
00151               F2 = F(I2)
00152               F3 = F(I3)
00153               F4 = F(I4)
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157               X2=X(I2)-X(I1)
00158               Y2=Y(I2)-Y(I1)
00159               Z2=Z(I2)-Z(I1)
00160               X3=X(I3)-X(I1)
00161               Y3=Y(I3)-Y(I1)
00162               Z3=Z(I3)-Z(I1)
00163               X4=X(I4)-X(I1)
00164               Y4=Y(I4)-Y(I1)
00165               Z4=Z(I4)-Z(I1)
00166 !
00167 !     JACOBIAN : Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3)
00168 !
00169 !     VOLUME OF THE TETRAHEDRON:
00170 !
00171 !     (Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))/6
00172 !
00173               JACOB = (   Z2*(X3*Y4-X4*Y3)
00174      &                  + Y2*(X4*Z3-X3*Z4)
00175      &                  + X2*(Y3*Z4-Y4*Z3) ) * XSUR720
00176 !
00177               T(IELEM,1)  = JACOB*(2*F3+6*F1+2*F4+2*F2)
00178               T(IELEM,2)  = JACOB*(2*F3+2*F1+2*F4+6*F2)
00179               T(IELEM,3)  = JACOB*2*(F1+3*F3+F2+F4)
00180               T(IELEM,4)  = JACOB*(2*F1+2*F3+6*F4+2*F2)
00181 !
00182               XM(IELEM,1) = JACOB*(F3+2*F1+F4+2*F2)
00183               XM(IELEM,2) = JACOB*(2*F3+F2+2*F1+F4)
00184               XM(IELEM,3) = JACOB*(F2+F3+2*F4+2*F1)
00185               XM(IELEM,4) = JACOB*(F1+2*F2+F4+2*F3)
00186               XM(IELEM,5) = JACOB*(2*F4+F3+F1+2*F2)
00187               XM(IELEM,6) = JACOB*(F1+2*F3+F2+2*F4)
00188 !
00189 !-----------------------------------------------------------------------
00190 !
00191           ENDDO ! IELEM
00192 !
00193 !-----------------------------------------------------------------------
00194 !
00195 ! CASE WHERE F IS CONSTANT BY P0 ELEMENT
00196 !
00197       ELSEIF (IELMF .EQ. 30) THEN
00198 !     LOOP ON THE TETRAHEDRONS
00199 !
00200           DO IELEM=1,NELEM
00201 !
00202               I1=IKLE(IELEM,1)
00203               I2=IKLE(IELEM,2)
00204               I3=IKLE(IELEM,3)
00205               I4=IKLE(IELEM,4)
00206 !
00207 !             SAME VALUE FOR THE 4 FI
00208 !             NOTE THAT THE COMPUTATIONS FOR T AND XM
00209 !             COULD BE SIMPLIFIED ...
00210 !
00211               F1 = F(IELEM)
00212               F2 = F1
00213               F3 = F1
00214               F4 = F1
00215 !
00216 !-----------------------------------------------------------------------
00217 !
00218               X2=X(I2)-X(I1)
00219               Y2=Y(I2)-Y(I1)
00220               Z2=Z(I2)-Z(I1)
00221               X3=X(I3)-X(I1)
00222               Y3=Y(I3)-Y(I1)
00223               Z3=Z(I3)-Z(I1)
00224               X4=X(I4)-X(I1)
00225               Y4=Y(I4)-Y(I1)
00226               Z4=Z(I4)-Z(I1)
00227 !
00228 !     JACOBIAN : Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3)
00229 !
00230 !     VOLUME OF THE TETRAHEDRON:
00231 !
00232 !     (Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))/6
00233 !
00234               JACOB = (   Z2*(X3*Y4-X4*Y3)
00235      &                  + Y2*(X4*Z3-X3*Z4)
00236      &                  + X2*(Y3*Z4-Y4*Z3) ) * XSUR720
00237 !
00238               T(IELEM,1)  = JACOB*(2*F3+6*F1+2*F4+2*F2)
00239               T(IELEM,2)  = JACOB*(2*F3+2*F1+2*F4+6*F2)
00240               T(IELEM,3)  = JACOB*2*(F1+3*F3+F2+F4)
00241               T(IELEM,4)  = JACOB*(2*F1+2*F3+6*F4+2*F2)
00242 !
00243               XM(IELEM,1) = JACOB*(F3+2*F1+F4+2*F2)
00244               XM(IELEM,2) = JACOB*(2*F3+F2+2*F1+F4)
00245               XM(IELEM,3) = JACOB*(F2+F3+2*F4+2*F1)
00246               XM(IELEM,4) = JACOB*(F1+2*F2+F4+2*F3)
00247               XM(IELEM,5) = JACOB*(2*F4+F3+F1+2*F2)
00248               XM(IELEM,6) = JACOB*(F1+2*F3+F2+2*F4)
00249 !
00250 !-----------------------------------------------------------------------
00251 !
00252       ENDDO ! IELEM
00253 !
00254 !-----------------------------------------------------------------------
00255       ELSE
00256 !
00257           IF (LNG.EQ.1) WRITE(LU,100) IELMF,SF%NAME
00258           IF (LNG.EQ.2) WRITE(LU,101) IELMF,SF%NAME
00259 100       FORMAT(1X,'MT06TT (BIEF) :',/,
00260      &        1X,'DISCRETISATION DE F NON PREVUE : ',1I6,
00261      &        1X,'NOM REEL : ',A6)
00262 101       FORMAT(1X,'MT06TT (BIEF) :',/,
00263      &        1X,'DISCRETIZATION OF F NOT AVAILABLE:',1I6,
00264      &        1X,'REAL NAME: ',A6)
00265           CALL PLANTE(1)
00266           STOP
00267 !
00268       ENDIF
00269 !
00270 !-----------------------------------------------------------------------
00271 !
00272       RETURN
00273       END SUBROUTINE MT06TT

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