The TELEMAC-MASCARET system  trunk
mt05tt.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mt05tt
3 ! *****************
4 !
5  &( t,xm,xmul,su,sv,sw,u,v,w,x,y,z,ikle,nelem,nelmax)
6 !
7 !***********************************************************************
8 ! BIEF V6P2 21/08/2010
9 !***********************************************************************
10 !
11 !brief COMPUTES THE MATVGR MATRIX.
12 !code
13 !+ STORAGE CONVENTION FOR EXTRA-DIAGONAL TERMS:
14 !+
15 !+ XM(IELEM, 1) ----> M(1,2)
16 !+ XM(IELEM, 2) ----> M(1,3)
17 !+ XM(IELEM, 3) ----> M(1,4)
18 !+ XM(IELEM, 4) ----> M(2,3)
19 !+ XM(IELEM, 5) ----> M(2,4)
20 !+ XM(IELEM, 6) ----> M(3,4)
21 !
22 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
23 !+ 04/01/02
24 !+ V5P4
25 !+
26 !
27 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
28 !+ 13/07/2010
29 !+ V6P0
30 !+ Translation of French comments within the FORTRAN sources into
31 !+ English comments
32 !
33 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
34 !+ 21/08/2010
35 !+ V6P0
36 !+ Creation of DOXYGEN tags for automated documentation and
37 !+ cross-referencing of the FORTRAN sources
38 !
39 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
40 !+ 30/08/2011
41 !+ V6P2
42 !+ Element 51 (prism cut into tetrahedrons) taken into account
43 !+
44 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45 !| IKLE |-->| CONNECTIVITY TABLE.
46 !| NELEM |-->| NUMBER OF ELEMENTS
47 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
48 !| SU |-->| STRUCTURE OF FUNCTIONS U
49 !| SV |-->| STRUCTURE OF FUNCTIONS V
50 !| SW |-->| STRUCTURE OF FUNCTIONS W
51 !| T |<->| WORK ARRAY FOR ELEMENT BY ELEMENT DIAGONAL
52 !| U |-->| FUNCTION USED IN THE FORMULA
53 !| V |-->| FUNCTION USED IN THE FORMULA
54 !| W |-->| FUNCTION USED IN THE FORMULA
55 !| X |-->| ABSCISSAE OF POINTS
56 !| Y |-->| ORDINATES OF POINTS
57 !| Z |-->| ELEVATIONS OF POINTS
58 !| XM |<->| OFF-DIAGONAL TERMS
59 !| XMUL |-->| COEFFICIENT FOR MULTIPLICATION
60 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
61 !
62  USE bief, ex_mt05tt => mt05tt
63 !
64  USE declarations_special
65  IMPLICIT NONE
66 !
67 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
68 !
69  INTEGER, INTENT(IN) :: NELEM,NELMAX
70  INTEGER, INTENT(IN) :: IKLE(nelmax,4)
71 !
72  DOUBLE PRECISION, INTENT(INOUT) :: T(nelmax,4),XM(nelmax,12)
73 !
74  DOUBLE PRECISION, INTENT(IN) :: XMUL
75 !
76  DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
77 !
78 ! STRUCTURES OF U, V
79 !
80  TYPE(bief_obj), INTENT(IN) :: SU, SV, SW
81  DOUBLE PRECISION, INTENT(IN) :: U(*), V(*), W(*)
82 !
83 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
84 !
85 ! SPECIFIC DECLARATIONS
86 !
87  DOUBLE PRECISION X2,Y2,Z2,X3,Y3,Z3,X4,Y4,Z4
88  DOUBLE PRECISION U1,U2,U3,U4,V1,V2,V3,V4,W1,W2,W3,W4
89  INTEGER I1,I2,I3,I4,IELEM,IELMU
90 !
91  DOUBLE PRECISION XSUR120
92 !
93 !***********************************************************************
94 !
95  xsur120=xmul/120.d0
96 !
97 !-----------------------------------------------------------------------
98 !
99  ielmu = su%ELM
100 ! U P1
101  IF(ielmu.EQ.31.OR.ielmu.EQ.51) THEN
102 ! AND IELMV=11 AND IELMW=11
103 !-----------------------------------------------------------------------
104 ! LOOP ON THE TETRAHEDRONS
105 !
106  DO ielem=1,nelem
107 !
108  i1=ikle(ielem,1)
109  i2=ikle(ielem,2)
110  i3=ikle(ielem,3)
111  i4=ikle(ielem,4)
112 !
113  u1 = u(i1)
114  u2 = u(i2)
115  u3 = u(i3)
116  u4 = u(i4)
117  v1 = v(i1)
118  v2 = v(i2)
119  v3 = v(i3)
120  v4 = v(i4)
121  w1 = w(i1)
122  w2 = w(i2)
123  w3 = w(i3)
124  w4 = w(i4)
125 !
126 !-----------------------------------------------------------------------
127 !
128  x2=x(i2)-x(i1)
129  y2=y(i2)-y(i1)
130  z2=z(i2)-z(i1)
131  x3=x(i3)-x(i1)
132  y3=y(i3)-y(i1)
133  z3=z(i3)-z(i1)
134  x4=x(i4)-x(i1)
135  y4=y(i4)-y(i1)
136  z4=z(i4)-z(i1)
137 !
138 ! JACOBIAN : Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3)
139 !
140 ! VOLUME OF THE TETRAHEDRON:
141 !
142 ! (Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))/6
143 !
144 !
145  t(ielem,1) = (w2*y2*x3-w2*x2*y3-v2*z2*x3-u2*z2*y4+v2*
146  &x2*z3+u2*z2*y3-u4*z2*y4+u4*y4*z3-u4*y3*z4-v4*x
147  &4*z3-w4*y2*x4-w4*x3*y4-u1*z2*y4*2-u1*y3*z4*2-w1*y2*x
148  &4*2+v1*z2*x4*2-v1*x2*z4*2+v1*x3*z4*2+w1*x2*y4*2+u3*y2*z4+
149  &u3*y4*z3-u3*y3*z4-w1*x3*y4*2-u3*z2*y4+v3*z2*x4+w3
150  &*x2*y4+w3*x4*y3-w3*x3*y4+u1*y2*z4*2+u1*y4*z3*2-v1*x4
151  &*z3*2+w1*x4*y3*2-u2*y2*z3+w3*y2*x3+v4*z2*x4-w3*x2*y3-w2*y2*x4
152  &+w2*x2*y4+w2*x4*y3-w2*x3*y4+v2*x3*z4+v2*z2*x4
153  &-v2*x2*z4+w4*x2*y4-v2*x4*z3+v4*x3*z4+u2*y2*z4
154  &+u2*y4*z3-u2*y3*z4-v3*x2*z4-w3*y2*x4+u4*z2*y3
155  &-u4*y2*z3-v4*z2*x3+v4*x2*z3+w4*y2*x3-w4*x2*y3
156  &-u1*y2*z3*2-v1*z2*x3*2+w1*y2*x3*2+w4*x4*y3-w1*x2*y3*2+u3*z
157  &2*y3-u3*y2*z3-v3*x4*z3-v3*z2*x3+u1*z2*y3*2+v3*x2*
158  &z3+u4*y2*z4+v3*x3*z4-v4*x2*z4+v1*x2
159  &*z3*2)*xsur120
160 !
161  t(ielem,2) = (u2*y3*z4*2-u2*y4*z3*2+v2*x4*z3*2-v2*x3*z4*2+w2*x3*y
162  &4*2-w2*x4*y3*2-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x3*y4
163  &-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4*z3
164  &-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4-w4*x4*y3
165  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120
166 !
167  t(ielem,3) = (w3*y2*x4*2+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*z
168  &2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4-w3*x2*y4*2-v3*z2*
169  &x4*2+v3*x2*z4*2+u3*z2*y4*2-u3*y2*z4*2-w1*x2*y4+v1*x2*z4
170  &-v1*z2*x4+w1*y2*x4+u1*z2*y4-w4*x2*y4+w4*y2*x4
171  &+v4*x2*z4-v4*z2*x4-u4*y2*z4+u4*z2*y4)*xsur120
172 !
173  t(ielem,4) = (w3*x2*y3-w3*y2*x3+u2*y2*z3-u2*z2*y3-v2*
174  &x2*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3+v3*z
175  &2*x3+u3*y2*z3-u3*z2*y3+w1*x2*y3-u1*z2*y3-v1*x2
176  &*z3-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3*2-w4*y2*x
177  &3*2-v4*x2*z3*2+v4*z2*x3*2+u4*y2*z3*2-u4*z2*y3*2)*xsur120
178 !
179  xm(ielem,1) =
180  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
181  &x3*y4-w2*x4*y3-w1*x4*y3*2+v1*x4*z3*2-u1*y4*z3*2+w3*x3*y
182  &4-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4*z3
183  &-v1*x3*z4*2+w1*x3*y4*2+u1*y3*z4*2+w4*x3*y4-w4*x4*y3
184  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120 !MAT[2,1]
185 !
186  xm(ielem,2) =
187  &(w3*y2*x4+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*
188  &z2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4*2-w3*x2*y4-v3*z2
189  &*x4+v3*x2*z4+u3*z2*y4-u3*y2*z4-w1*x2*y4*2+v1*x2*z
190  &4*2-v1*z2*x4*2+w1*y2*x4*2+u1*z2*y4*2-w4*x2*y4+w4*y2*x4
191  &+v4*x2*z4-v4*z2*x4-u4*y2*z4+u4*z2*y4)*xsur120 !MAT[3,1]
192 !
193  xm(ielem,3) =
194  &(w3*x2*y3-w3*y2*x3+u2*y2*z3-u2*z2*y3-v2*
195  &x2*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3+v3*z
196  &2*x3+u3*y2*z3-u3*z2*y3+w1*x2*y3*2-u1*z2*y3*2-v1*x2*z
197  &3*2-w1*y2*x3*2+v1*z2*x3*2+u1*y2*z3*2+w4*x2*y3-w4*y2*x3
198  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,1]
199 !
200  xm(ielem,7) = (w3*x4*y3-v3*x2*z4+v3*z2*x4+u1*y2*z4-w4*
201  &y2*x4+w4*x2*y4-u3*y2*z3-v4*x2*z4-w1*y2*x4+w1*x
202  &2*y4-u1*y2*z3-v4*x4*z3+v4*x3*z4+u4*y4*z3+u4*z2
203  &*y3-u4*y3*z4+w2*y2*x3*2+u2*y4*z3*2-u2*y2*z3*2-u2*y3*z4*2
204  &+v1*z2*x4+u1*y4*z3-v2*x2*z4*2+u4*y2*z4+w4*x4*y3
205  &-u4*z2*y4-v3*z2*x3+w4*y2*x3+u2*z2*y3*2+u3*y2*z4
206  &-w4*x3*y4+w2*x4*y3*2-w3*x3*y4-u1*z2*y4+u3*z2*y3+w
207  &2*x2*y4*2+w1*x4*y3-u3*y3*z4-u4*y2*z3-w2*x2*y3*2-w4*x
208  &2*y3+v4*x2*z3+w3*y2*x3+v1*x2*z3-u3*z2*y4+u1*z2
209  &*y3+v2*z2*x4*2-w2*y2*x4*2-w3*x2*y3+v4*z2*x4-v1*x2*z4
210  &-w3*y2*x4+w3*x2*y4-u2*z2*y4*2+u2*y2*z4*2-w1*x3*y4
211  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3
212  &-v1*z2*x3-w2*x3*y4*2+v3*x2*z3-w1*x2*y3+v2*x3*z4*2
213  &-v2*z2*x3*2+v2*x2*z3*2-v2*x4*z3*2+u3*y4*z3-v3*x4*z3+v3
214  &*x3*z4)*xsur120 !MAT[1,2]
215 !
216  xm(ielem,4) = (-w2*x2*y4*2+w2*y2*x4*2+v2*x2*z4*2
217  &-v2*z2*x4*2-v3*z2*
218  &x4+v3*x2*z4-u3*y2*z4+u3*z2*y4-u2*y2*z4*2+u2*z2*y4
219  &*2-w3*x2*y4+w3*y2*x4+v1*x2*z4-v4*z2*x4+v4*x2*z4
220  &+u4*z2*y4-u4*y2*z4-w4*x2*y4+w4*y2*x4-u1*y2*z4
221  &+u1*z2*y4-v1*z2*x4-w1*x2*y4+w1*y2*x4)*xsur120 !MAT[3,2]
222 !
223  xm(ielem,5) =
224  &(w3*x2*y3-w3*y2*x3+u2*y2*z3*2-u2*z2*y3*2-v2*x2
225  &*z3*2+v2*z2*x3*2+w2*x2*y3*2-w2*y2*x3*2-v3*x2*z3+v3*z2*x3
226  &+u3*y2*z3-u3*z2*y3+w1*x2*y3-u1*z2*y3-v1*x2*z3
227  &-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3-w4*y2*x3
228  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,2]
229 !
230  xm(ielem,8) = (
231  &w3*x4*y3*2-v3*x2*z4*2+v3*z2*x4*2+u1*y2*z4-w4*y2*
232  &x4+w4*x2*y4-u3*y2*z3*2-v4*x2*z4-w1*y2*x4+w1*x2*y4
233  &-u1*y2*z3-v4*x4*z3+v4*x3*z4+u4*y4*z3+u4*z2*y3
234  &-u4*y3*z4+w2*y2*x3+u2*y4*z3-u2*y2*z3-u2*y3*z4
235  &+v1*z2*x4+u1*y4*z3-v2*x2*z4+u4*y2*z4+w4*x4*y3
236  &-u4*z2*y4-v3*z2*x3*2+w4*y2*x3+u2*z2*y3+u3*y2*z4*2
237  &-w4*x3*y4+w2*x4*y3-w3*x3*y4*2-u1*z2*y4+u3*z2*y3*2+w2
238  &*x2*y4+w1*x4*y3-u3*y3*z4*2-u4*y2*z3-w2*x2*y3-w4*x
239  &2*y3+v4*x2*z3+w3*y2*x3*2+v1*x2*z3-u3*z2*y4*2+u1*z2*y
240  &3+v2*z2*x4-w2*y2*x4-w3*x2*y3*2+v4*z2*x4-v1*x2*z4
241  &-w3*y2*x4*2+w3*x2*y4*2-u2*z2*y4+u2*y2*z4-w1*x3*y4
242  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3
243  &-v1*z2*x3-w2*x3*y4+v3*x2*z3*2-w1*x2*y3+v2*x3*z4
244  &-v2*z2*x3+v2*x2*z3-v2*x4*z3+u3*y4*z3*2-v3*x4*z3*2+
245  &v3*x3*z4*2)*xsur120 !MAT[1,3]
246 !
247  xm(ielem,10) =
248  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
249  &x3*y4-w2*x4*y3-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x
250  &3*y4*2-w3*x4*y3*2+v3*x4*z3*2-v3*x3*z4*2+u3*y3*z4*2-2*u3*y4*z3
251  &-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4-w4*x4*y3
252  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120 !MAT[2,3]
253 !
254  xm(ielem,6) =
255  &(w3*x2*y3*2-w3*y2*x3*2+u2*y2*z3-u2*z2*y3-v2*x2
256  &*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3*2+v3*z2*x
257  &3*2+u3*y2*z3*2-u3*z2*y3*2+w1*x2*y3-u1*z2*y3-v1*x2*z3
258  &-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3-w4*y2*x3
259  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,3]
260 !
261  xm(ielem,9) =
262  &(w3*x4*y3-v3*x2*z4+v3*z2*x4+u1*y2*z4-w4*
263  &y2*x4*2+w4*x2*y4*2-u3*y2*z3-v4*x2*z4*2-w1*y2*x4+w1*x2*y
264  &4-u1*y2*z3-v4*x4*z3*2+v4*x3*z4*2+u4*y4*z3*2+u4*z2*y3*2
265  &-u4*y3*z4*2+w2*y2*x3+u2*y4*z3-u2*y2*z3-u2*y3*z4+
266  &v1*z2*x4+u1*y4*z3-v2*x2*z4+u4*y2*z4*2+w4*x4*y3*2
267  &-u4*z2*y4*2-v3*z2*x3+w4*y2*x3*2+u2*z2*y3+u3*y2*z4-w
268  &4*x3*y4*2+w2*x4*y3-w3*x3*y4-u1*z2*y4+u3*z2*y3+w2*
269  &x2*y4+w1*x4*y3-u3*y3*z4-u4*y2*z3*2-w2*x2*y3-w4*x2
270  &*y3*2+v4*x2*z3*2+w3*y2*x3+v1*x2*z3-u3*z2*y4+u1*z2*y3
271  &+v2*z2*x4-w2*y2*x4-w3*x2*y3+v4*z2*x4*2-v1*x2*z4
272  &-w3*y2*x4+w3*x2*y4-u2*z2*y4+u2*y2*z4-w1*x3*y4
273  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3*2-
274  &v1*z2*x3-w2*x3*y4+v3*x2*z3-w1*x2*y3+v2*x3*z4-v
275  &2*z2*x3+v2*x2*z3-v2*x4*z3+u3*y4*z3-v3*x4*z3+v3
276  &*x3*z4)*xsur120 !MAT[1,4]
277 !
278  xm(ielem,11) =
279  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
280  &x3*y4-w2*x4*y3-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x
281  &3*y4-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4
282  &*z3-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4*2-w4*x4*y
283  &3*2+v4*x4*z3*2-v4*x3*z4*2+u4*y3*z4*2-u4*y4*z3*2)*xsur120 !MAT[2,4]
284 !
285  xm(ielem,12) =
286  &(w3*y2*x4+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*
287  &z2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4-w3*x2*y4-v3*z
288  &2*x4+v3*x2*z4+u3*z2*y4-u3*y2*z4-w1*x2*y4+v1*x2
289  &*z4-v1*z2*x4+w1*y2*x4+u1*z2*y4-w4*x2*y4*2+w4*y2*x
290  &4*2+v4*x2*z4*2-v4*z2*x4*2-u4*y2*z4*2+u4*z2*y4*2)*xsur120 !MAT[3,4]
291 !
292 !-----------------------------------------------------------------------
293 !
294  ENDDO ! IELEM
295 !
296 !-----------------------------------------------------------------------
297  ELSEIF (ielmu.EQ.30.OR.ielmu.EQ.50) THEN
298 ! AND V AND W
299 !-----------------------------------------------------------------------
300 ! LOOP ON THE TETRAHEDRONS
301 !
302  DO ielem=1,nelem
303 !
304  i1=ikle(ielem,1)
305  i2=ikle(ielem,2)
306  i3=ikle(ielem,3)
307  i4=ikle(ielem,4)
308 !
309  u1 = u(ielem)
310  u2 = u1
311  u3 = u1
312  u4 = u1
313  v1 = v(ielem)
314  v2 = v1
315  v3 = v1
316  v4 = v1
317  w1 = w(ielem)
318  w2 = w1
319  w3 = w1
320  w4 = w1
321 !
322 !-----------------------------------------------------------------------
323 !
324  x2=x(i2)-x(i1)
325  y2=y(i2)-y(i1)
326  z2=z(i2)-z(i1)
327  x3=x(i3)-x(i1)
328  y3=y(i3)-y(i1)
329  z3=z(i3)-z(i1)
330  x4=x(i4)-x(i1)
331  y4=y(i4)-y(i1)
332  z4=z(i4)-z(i1)
333 !
334 ! JACOBIAN : Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3)
335 !
336 ! VOLUME OF THE TETRAHEDRON:
337 !
338 ! (Z2*(X3*Y4-X4*Y3)+Y2*(X4*Z3-X3*Z4)+X2*(Y3*Z4-Y4*Z3))/6
339 !
340  t(ielem,1) = (w2*y2*x3-w2*x2*y3-v2*z2*x3-u2*z2*y4+v2*
341  &x2*z3+u2*z2*y3-u4*z2*y4+u4*y4*z3-u4*y3*z4-v4*x
342  &4*z3-w4*y2*x4-w4*x3*y4-u1*z2*y4*2-u1*y3*z4*2-w1*y2*x
343  &4*2+v1*z2*x4*2-v1*x2*z4*2+v1*x3*z4*2+w1*x2*y4*2+u3*y2*z4+
344  &u3*y4*z3-u3*y3*z4-w1*x3*y4*2-u3*z2*y4+v3*z2*x4+w3
345  &*x2*y4+w3*x4*y3-w3*x3*y4+u1*y2*z4*2+u1*y4*z3*2-v1*x4
346  &*z3*2+w1*x4*y3*2-u2*y2*z3+w3*y2*x3+v4*z2*x4-w3*x2*y3-w2*y2*x4
347  &+w2*x2*y4+w2*x4*y3-w2*x3*y4+v2*x3*z4+v2*z2*x4
348  &-v2*x2*z4+w4*x2*y4-v2*x4*z3+v4*x3*z4+u2*y2*z4
349  &+u2*y4*z3-u2*y3*z4-v3*x2*z4-w3*y2*x4+u4*z2*y3
350  &-u4*y2*z3-v4*z2*x3+v4*x2*z3+w4*y2*x3-w4*x2*y3
351  &-u1*y2*z3*2-v1*z2*x3*2+w1*y2*x3*2+w4*x4*y3-w1*x2*y3*2+u3*z
352  &2*y3-u3*y2*z3-v3*x4*z3-v3*z2*x3+u1*z2*y3*2+v3*x2*
353  &z3+u4*y2*z4+v3*x3*z4-v4*x2*z4+v1*x2
354  &*z3*2)*xsur120
355 !
356  t(ielem,2) = (u2*y3*z4*2-u2*y4*z3*2+v2*x4*z3*2-v2*x3*z4*2+w2*x3*y
357  &4*2-w2*x4*y3*2-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x3*y4
358  &-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4*z3
359  &-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4-w4*x4*y3
360  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120
361 !
362  t(ielem,3) = (w3*y2*x4*2+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*z
363  &2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4-w3*x2*y4*2-v3*z2*
364  &x4*2+v3*x2*z4*2+u3*z2*y4*2-u3*y2*z4*2-w1*x2*y4+v1*x2*z4
365  &-v1*z2*x4+w1*y2*x4+u1*z2*y4-w4*x2*y4+w4*y2*x4
366  &+v4*x2*z4-v4*z2*x4-u4*y2*z4+u4*z2*y4)*xsur120
367 !
368  t(ielem,4) = (w3*x2*y3-w3*y2*x3+u2*y2*z3-u2*z2*y3-v2*
369  &x2*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3+v3*z
370  &2*x3+u3*y2*z3-u3*z2*y3+w1*x2*y3-u1*z2*y3-v1*x2
371  &*z3-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3*2-w4*y2*x
372  &3*2-v4*x2*z3*2+v4*z2*x3*2+u4*y2*z3*2-u4*z2*y3*2)*xsur120
373 !
374  xm(ielem,1) =
375  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
376  &x3*y4-w2*x4*y3-w1*x4*y3*2+v1*x4*z3*2-u1*y4*z3*2+w3*x3*y
377  &4-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4*z3
378  &-v1*x3*z4*2+w1*x3*y4*2+u1*y3*z4*2+w4*x3*y4-w4*x4*y3
379  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120 !MAT[2,1]
380 !
381  xm(ielem,2) =
382  &(w3*y2*x4+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*
383  &z2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4*2-w3*x2*y4-v3*z2
384  &*x4+v3*x2*z4+u3*z2*y4-u3*y2*z4-w1*x2*y4*2+v1*x2*z
385  &4*2-v1*z2*x4*2+w1*y2*x4*2+u1*z2*y4*2-w4*x2*y4+w4*y2*x4
386  &+v4*x2*z4-v4*z2*x4-u4*y2*z4+u4*z2*y4)*xsur120 !MAT[3,1]
387 !
388  xm(ielem,3) =
389  &(w3*x2*y3-w3*y2*x3+u2*y2*z3-u2*z2*y3-v2*
390  &x2*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3+v3*z
391  &2*x3+u3*y2*z3-u3*z2*y3+w1*x2*y3*2-u1*z2*y3*2-v1*x2*z
392  &3*2-w1*y2*x3*2+v1*z2*x3*2+u1*y2*z3*2+w4*x2*y3-w4*y2*x3
393  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,1]
394 !
395  xm(ielem,7) = (w3*x4*y3-v3*x2*z4+v3*z2*x4+u1*y2*z4-w4*
396  &y2*x4+w4*x2*y4-u3*y2*z3-v4*x2*z4-w1*y2*x4+w1*x
397  &2*y4-u1*y2*z3-v4*x4*z3+v4*x3*z4+u4*y4*z3+u4*z2
398  &*y3-u4*y3*z4+w2*y2*x3*2+u2*y4*z3*2-u2*y2*z3*2-u2*y3*z4*2
399  &+v1*z2*x4+u1*y4*z3-v2*x2*z4*2+u4*y2*z4+w4*x4*y3
400  &-u4*z2*y4-v3*z2*x3+w4*y2*x3+u2*z2*y3*2+u3*y2*z4
401  &-w4*x3*y4+w2*x4*y3*2-w3*x3*y4-u1*z2*y4+u3*z2*y3+w
402  &2*x2*y4*2+w1*x4*y3-u3*y3*z4-u4*y2*z3-w2*x2*y3*2-w4*x
403  &2*y3+v4*x2*z3+w3*y2*x3+v1*x2*z3-u3*z2*y4+u1*z2
404  &*y3+v2*z2*x4*2-w2*y2*x4*2-w3*x2*y3+v4*z2*x4-v1*x2*z4
405  &-w3*y2*x4+w3*x2*y4-u2*z2*y4*2+u2*y2*z4*2-w1*x3*y4
406  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3
407  &-v1*z2*x3-w2*x3*y4*2+v3*x2*z3-w1*x2*y3+v2*x3*z4*2
408  &-v2*z2*x3*2+v2*x2*z3*2-v2*x4*z3*2+u3*y4*z3-v3*x4*z3+v3
409  &*x3*z4)*xsur120 !MAT[1,2]
410 !
411  xm(ielem,4) = (-w2*x2*y4*2+w2*y2*x4*2+v2*x2*z4*2
412  &-v2*z2*x4*2-v3*z2*
413  &x4+v3*x2*z4-u3*y2*z4+u3*z2*y4-u2*y2*z4*2+u2*z2*y4
414  &*2-w3*x2*y4+w3*y2*x4+v1*x2*z4-v4*z2*x4+v4*x2*z4
415  &+u4*z2*y4-u4*y2*z4-w4*x2*y4+w4*y2*x4-u1*y2*z4
416  &+u1*z2*y4-v1*z2*x4-w1*x2*y4+w1*y2*x4)*xsur120 !MAT[3,2]
417 !
418  xm(ielem,5) =
419  &(w3*x2*y3-w3*y2*x3+u2*y2*z3*2-u2*z2*y3*2-v2*x2
420  &*z3*2+v2*z2*x3*2+w2*x2*y3*2-w2*y2*x3*2-v3*x2*z3+v3*z2*x3
421  &+u3*y2*z3-u3*z2*y3+w1*x2*y3-u1*z2*y3-v1*x2*z3
422  &-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3-w4*y2*x3
423  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,2]
424 !
425  xm(ielem,8) = (
426  &w3*x4*y3*2-v3*x2*z4*2+v3*z2*x4*2+u1*y2*z4-w4*y2*
427  &x4+w4*x2*y4-u3*y2*z3*2-v4*x2*z4-w1*y2*x4+w1*x2*y4
428  &-u1*y2*z3-v4*x4*z3+v4*x3*z4+u4*y4*z3+u4*z2*y3
429  &-u4*y3*z4+w2*y2*x3+u2*y4*z3-u2*y2*z3-u2*y3*z4
430  &+v1*z2*x4+u1*y4*z3-v2*x2*z4+u4*y2*z4+w4*x4*y3
431  &-u4*z2*y4-v3*z2*x3*2+w4*y2*x3+u2*z2*y3+u3*y2*z4*2
432  &-w4*x3*y4+w2*x4*y3-w3*x3*y4*2-u1*z2*y4+u3*z2*y3*2+w2
433  &*x2*y4+w1*x4*y3-u3*y3*z4*2-u4*y2*z3-w2*x2*y3-w4*x
434  &2*y3+v4*x2*z3+w3*y2*x3*2+v1*x2*z3-u3*z2*y4*2+u1*z2*y
435  &3+v2*z2*x4-w2*y2*x4-w3*x2*y3*2+v4*z2*x4-v1*x2*z4
436  &-w3*y2*x4*2+w3*x2*y4*2-u2*z2*y4+u2*y2*z4-w1*x3*y4
437  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3
438  &-v1*z2*x3-w2*x3*y4+v3*x2*z3*2-w1*x2*y3+v2*x3*z4
439  &-v2*z2*x3+v2*x2*z3-v2*x4*z3+u3*y4*z3*2-v3*x4*z3*2+
440  &v3*x3*z4*2)*xsur120 !MAT[1,3]
441 !
442  xm(ielem,10) =
443  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
444  &x3*y4-w2*x4*y3-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x
445  &3*y4*2-w3*x4*y3*2+v3*x4*z3*2-v3*x3*z4*2+u3*y3*z4*2-2*u3*y4*z3
446  &-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4-w4*x4*y3
447  &+v4*x4*z3-v4*x3*z4+u4*y3*z4-u4*y4*z3)*xsur120 !MAT[2,3]
448 !
449  xm(ielem,6) =
450  &(w3*x2*y3*2-w3*y2*x3*2+u2*y2*z3-u2*z2*y3-v2*x2
451  &*z3+v2*z2*x3+w2*x2*y3-w2*y2*x3-v3*x2*z3*2+v3*z2*x
452  &3*2+u3*y2*z3*2-u3*z2*y3*2+w1*x2*y3-u1*z2*y3-v1*x2*z3
453  &-w1*y2*x3+v1*z2*x3+u1*y2*z3+w4*x2*y3-w4*y2*x3
454  &-v4*x2*z3+v4*z2*x3+u4*y2*z3-u4*z2*y3)*xsur120 !MAT[4,3]
455 !
456  xm(ielem,9) =
457  &(w3*x4*y3-v3*x2*z4+v3*z2*x4+u1*y2*z4-w4*
458  &y2*x4*2+w4*x2*y4*2-u3*y2*z3-v4*x2*z4*2-w1*y2*x4+w1*x2*y
459  &4-u1*y2*z3-v4*x4*z3*2+v4*x3*z4*2+u4*y4*z3*2+u4*z2*y3*2
460  &-u4*y3*z4*2+w2*y2*x3+u2*y4*z3-u2*y2*z3-u2*y3*z4+
461  &v1*z2*x4+u1*y4*z3-v2*x2*z4+u4*y2*z4*2+w4*x4*y3*2
462  &-u4*z2*y4*2-v3*z2*x3+w4*y2*x3*2+u2*z2*y3+u3*y2*z4-w
463  &4*x3*y4*2+w2*x4*y3-w3*x3*y4-u1*z2*y4+u3*z2*y3+w2*
464  &x2*y4+w1*x4*y3-u3*y3*z4-u4*y2*z3*2-w2*x2*y3-w4*x2
465  &*y3*2+v4*x2*z3*2+w3*y2*x3+v1*x2*z3-u3*z2*y4+u1*z2*y3
466  &+v2*z2*x4-w2*y2*x4-w3*x2*y3+v4*z2*x4*2-v1*x2*z4
467  &-w3*y2*x4+w3*x2*y4-u2*z2*y4+u2*y2*z4-w1*x3*y4
468  &-v1*x4*z3+v1*x3*z4-u1*y3*z4+w1*y2*x3-v4*z2*x3*2-
469  &v1*z2*x3-w2*x3*y4+v3*x2*z3-w1*x2*y3+v2*x3*z4-v
470  &2*z2*x3+v2*x2*z3-v2*x4*z3+u3*y4*z3-v3*x4*z3+v3
471  &*x3*z4)*xsur120 !MAT[1,4]
472 !
473  xm(ielem,11) =
474  &(u2*y3*z4-u2*y4*z3+v2*x4*z3-v2*x3*z4+w2*
475  &x3*y4-w2*x4*y3-w1*x4*y3+v1*x4*z3-u1*y4*z3+w3*x
476  &3*y4-w3*x4*y3+v3*x4*z3-v3*x3*z4+u3*y3*z4-u3*y4
477  &*z3-v1*x3*z4+w1*x3*y4+u1*y3*z4+w4*x3*y4*2-w4*x4*y
478  &3*2+v4*x4*z3*2-v4*x3*z4*2+u4*y3*z4*2-u4*y4*z3*2)*xsur120 !MAT[2,4]
479 !
480  xm(ielem,12) =
481  &(w3*y2*x4+u2*z2*y4-u2*y2*z4+v2*x2*z4-v2*
482  &z2*x4-w2*x2*y4+w2*y2*x4-u1*y2*z4-w3*x2*y4-v3*z
483  &2*x4+v3*x2*z4+u3*z2*y4-u3*y2*z4-w1*x2*y4+v1*x2
484  &*z4-v1*z2*x4+w1*y2*x4+u1*z2*y4-w4*x2*y4*2+w4*y2*x
485  &4*2+v4*x2*z4*2-v4*z2*x4*2-u4*y2*z4*2+u4*z2*y4*2)*xsur120 !MAT[3,4]
486 !
487  ENDDO ! IELEM
488 !-----------------------------------------------------------------------
489  ELSE
490 !
491  WRITE(lu,1001) su%ELM,sv%ELM,sw%ELM
492 1001 FORMAT(1x,'MT05TT (BIEF) : WRONG TYPE OF U,V OR W: ',
493  & i6,1x,i6,1x,i6)
494  CALL plante(1)
495  stop
496 !
497  ENDIF
498 !-----------------------------------------------------------------------
499 !
500  RETURN
501  END
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
mt05tt
subroutine mt05tt(T, XM, XMUL, SU, SV, SW, U, V, W, X, Y, Z, IKLE, NELEM, NELMAX)
Definition: mt05tt.f:7
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:08 for The TELEMAC-MASCARET system by doxygen 1.8.13