mt08tt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mt08tt.f
00002 !
00074                      SUBROUTINE MT08TT
00075 !                    *****************
00076 !
00077      &( T,XM,XMUL,X,Y,Z,SF,F,IKLE,NELEM,NELMAX)
00078 !
00079 !***********************************************************************
00080 ! BIEF   V6P1                                  21/08/2010
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !| F              |-->| FUNCTION USED IN THE FORMULA
00091 !| FORMUL         |-->| FORMULA DESCRIBING THE RESULTING MATRIX
00092 !| IKLE           |-->| CONNECTIVITY TABLE.
00093 !| NELEM          |-->| NUMBER OF ELEMENTS
00094 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00095 !| SF             |-->| STRUCTURE OF FUNCTIONS F
00096 !| SURFAC         |-->| AREA OF 2D ELEMENTS
00097 !| T              |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
00098 !| Z              |-->| ELEVATIONS OF POINTS
00099 !| XM             |<->| OFF-DIAGONAL TERMS
00100 !| XMUL           |-->| COEFFICIENT FOR MULTIPLICATION
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !
00103       USE BIEF, EX_MT08TT => MT08TT
00104 !
00105       IMPLICIT NONE
00106       INTEGER LNG,LU
00107       COMMON/INFO/LNG,LU
00108 !
00109 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00110 !
00111       INTEGER,INTENT(IN) :: NELEM,NELMAX
00112       INTEGER,INTENT(IN) :: IKLE(NELMAX,4)
00113 !
00114       DOUBLE PRECISION,INTENT(INOUT) :: T(NELMAX,4),XM(NELMAX,12)
00115 !
00116       DOUBLE PRECISION,INTENT(IN) :: XMUL
00117       DOUBLE PRECISION,INTENT(IN) :: F(*),X(*),Y(*),Z(*)
00118 !
00119 !     STRUCTURE OF F
00120 !
00121       TYPE(BIEF_OBJ),INTENT(IN) :: SF
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125 !     DECLARATIONS SPECIFIC TO THIS SUBROUTINE
00126 !
00127       DOUBLE PRECISION X2,X3,X4,Y2,Y3,Y4,F1,F2,F3,F4,XSUR120
00128 !
00129       INTEGER I1,I2,I3,I4,IELEM
00130 !
00131 !**********************************************************************
00132 !
00133       XSUR120 = XMUL/120.D0
00134 !
00135       IF(SF%ELM.NE.31.AND.SF%ELM.NE.51) THEN
00136         IF (LNG.EQ.1) WRITE(LU,1000) SF%ELM
00137         IF (LNG.EQ.2) WRITE(LU,1001) SF%ELM
00138 1000    FORMAT(1X,'MT08TT (BIEF) : TYPE DE F NON PREVU : ',I6)
00139 1001    FORMAT(1X,'MT08TT (BIEF): TYPE OF F NOT IMPLEMENTED: ',I6)
00140         CALL PLANTE(1)
00141         STOP
00142       ENDIF
00143 !
00144 !   LOOP ON THE ELEMENTS
00145 !
00146       DO IELEM=1,NELEM
00147 !
00148         I1 = IKLE(IELEM,1)
00149         I2 = IKLE(IELEM,2)
00150         I3 = IKLE(IELEM,3)
00151         I4 = IKLE(IELEM,4)
00152 !
00153         X2 = X(I2)-X(I1)
00154         X3 = X(I3)-X(I1)
00155         X4 = X(I4)-X(I1)
00156 !
00157         Y2 = Y(I2)-Y(I1)
00158         Y3 = Y(I3)-Y(I1)
00159         Y4 = Y(I4)-Y(I1)
00160 !
00161         F1 = F(I1)
00162         F2 = F(I2)
00163         F3 = F(I3)
00164         F4 = F(I4)
00165 !
00166         T(IELEM,1)=(
00167      & X2*Y4*F3-X3*Y4*F3+X4*Y3*F2-Y2*X4*F2+X2*Y4*F2+2*Y2*X3*F1
00168      &-2*X3*Y4*F1+Y2*X3*F2+Y2*X3*F3+2*X4*Y3*F1+2*X2*Y4*F1-2*Y2*X4*F1
00169      &-2*X2*Y3*F1-Y2*X4*F3-X2*Y3*F2-X2*Y3*F3+X4*Y3*F3-X3*Y4*F4
00170      &+X2*Y4*F4-Y2*X4*F4-X2*Y3*F4+Y2*X3*F4+X4*Y3*F4-X3*Y4*F2 )*XSUR120
00171 !
00172         T(IELEM,2)=(
00173      & X3*Y4*F3-2*X4*Y3*F2+X3*Y4*F1-X4*Y3*F1-X4*Y3*F3+X3*Y4*F4
00174      &-X4*Y3*F4+2*X3*Y4*F2                        )*XSUR120
00175 !
00176         T(IELEM,3)=(-X2*Y4+Y2*X4)*(F1+2*F3+F2+F4) *XSUR120
00177 !
00178         T(IELEM,4)=(
00179      & -Y2*X3*F1-Y2*X3*F2-Y2*X3*F3+X2*Y3*F1+X2*Y3*F2+X2*Y3*F3+
00180      &2*X2*Y3*F4-2*Y2*X3*F4                       )*XSUR120
00181 !
00182         XM(IELEM,01)=(
00183      & X2*Y4*F3-X3*Y4*F3+2*X4*Y3*F2-2*Y2*X4*F2+2*X2*Y4*F2+Y2*X3*F1
00184      &-X3*Y4*F1+2*Y2*X3*F2+Y2*X3*F3+X4*Y3*F1+X2*Y4*F1-Y2*X4*F1-X2*Y3
00185      &*F1-Y2*X4*F3-2*X2*Y3*F2-X2*Y3*F3+X4*Y3*F3
00186      &-X3*Y4*F4+X2*Y4*F4-Y2*X4*F4
00187      &-X2*Y3*F4+Y2*X3*F4+X4*Y3*F4-2*X3*Y4*F2    )*XSUR120
00188 !
00189         XM(IELEM,02)=(
00190      &-X3*Y4+X4*Y3+X2*Y4-Y2*X4-X2*Y3+Y2*X3)*(F1+2*F3+F2+F4)*XSUR120
00191 !
00192         XM(IELEM,03)=(
00193      & X2*Y4*F3-X3*Y4*F3+X4*Y3*F2-Y2*X4*F2+X2*Y4*F2+Y2*X3*F1-X3*Y4*F1
00194      &+Y2*X3*F2+Y2*X3*F3+X4*Y3*F1+X2*Y4*F1-Y2*X4*F1-X2*Y3*F1-Y2*X4*F3
00195      &-X2*Y3*F2-X2*Y3*F3+X4*Y3*F3-2*X3*Y4*F4+2*X2*Y4*F4-2*Y2*X4*F4-2
00196      &*X2*Y3*F4+2*Y2*X3*F4+2*X4*Y3*F4-X3*Y4*F2)*XSUR120
00197 !
00198         XM(IELEM,04)= -(-X3*Y4+X4*Y3)*(F1+2*F3+F2+F4)*XSUR120
00199 !
00200         XM(IELEM,05)=( X3*Y4*F3-X4*Y3*F2+X3*Y4*F1-X4*Y3*F1-X4*Y3*F3
00201      &                 +2*X3*Y4*F4-2*X4*Y3*F4+X3*Y4*F2)*XSUR120
00202 !
00203         XM(IELEM,06)=( -X2*Y4*F3+Y2*X4*F2-X2*Y4*F2-X2*Y4*F1+Y2*X4*F1
00204      &                 +Y2*X4*F3-2*X2*Y4*F4+2*Y2*X4*F4)*XSUR120
00205 !
00206         XM(IELEM,07)=( X3*Y4*F3-X4*Y3*F2+2*X3*Y4*F1-2*X4*Y3*F1
00207      &                -X4*Y3*F3+X3*Y4*F4-X4*Y3*F4+X3*Y4*F2)*XSUR120
00208 !
00209         XM(IELEM,08)=( -X2*Y4*F3+Y2*X4*F2-X2*Y4*F2-2*X2*Y4*F1
00210      &                 +2*Y2*X4*F1+Y2*X4*F3-X2*Y4*F4+Y2*X4*F4)*XSUR120
00211 !
00212         XM(IELEM,09)=( -X2*Y4*F3+2*Y2*X4*F2-2*X2*Y4*F2-X2*Y4*F1
00213      &                 +Y2*X4*F1+Y2*X4*F3-X2*Y4*F4+Y2*X4*F4 )*XSUR120
00214 !
00215         XM(IELEM,10)=( -2*Y2*X3*F1-Y2*X3*F2-Y2*X3*F3+2*X2*Y3*F1
00216      &                 +X2*Y3*F2+X2*Y3*F3+X2*Y3*F4-Y2*X3*F4)*XSUR120
00217 !
00218         XM(IELEM,11)=(-Y2*X3*F1-2*Y2*X3*F2-Y2*X3*F3+X2*Y3*F1
00219      &                +2*X2*Y3*F2+X2*Y3*F3+X2*Y3*F4-Y2*X3*F4)*XSUR120
00220 !
00221         XM(IELEM,12)= -(-X2*Y3+Y2*X3)*(F1+2*F3+F2+F4)*XSUR120
00222 !
00223       ENDDO ! IELEM
00224 !
00225 !-----------------------------------------------------------------------
00226 !
00227       RETURN
00228       END

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