The TELEMAC-MASCARET system  trunk
vc17pp.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vc17pp
3 ! *****************
4 !
5  &( xmul,surfac,su,sv,sw,u,v,w,x,y,z,
6  & ikle1,ikle2,ikle3,ikle4,ikle5,ikle6,nelem,nelmax,
7  & w1,w2,w3,w4,w5,w6 )
8 !
9 !***********************************************************************
10 ! BIEF V8P0 21/06/2018
11 !***********************************************************************
12 !
13 !brief COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
14 !code
15 !+ / DU DV DU DW
16 !+ V = XMUL / PSII *((-- - -- )^2 + (-- - -- )^2
17 !+ I /OMEGA DY DX DZ DX
18 !+
19 !+ DV DW
20 !+ + (-- - -- )^2 ) D(OMEGA)
21 !+ DZ DY
22 !+ PSI(I) IS A BASE OF TYPE P1 PRISM
23 !
24 !history A. BOURGOIN (EDF R&D LNHE)
25 !+ 07/01/2018
26 !+ V7P8
27 !+ creation.
28 !
29 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
30 !| F |-->| FUNCTION USED IN THE VECTOR FORMULA
31 !| IKLE1 |-->| FIRST POINT OF PRISMS
32 !| IKLE2 |-->| SECOND POINT OF PRISMS
33 !| IKLE3 |-->| THIRD POINT OF PRISMS
34 !| IKLE4 |-->| FOURTH POINT OF PRISMS
35 !| IKLE5 |-->| FIFTH POINT OF PRISMS
36 !| IKLE6 |-->| SIXTH POINT OF PRISMS
37 !| NELEM |-->| NUMBER OF ELEMENTS
38 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
39 !| SF |-->| BIEF_OBJ STRUCTURE OF F
40 !| SU |-->| BIEF_OBJ STRUCTURE OF U
41 !| SV |-->| BIEF_OBJ STRUCTURE OF V
42 !| SW |-->| BIEF_OBJ STRUCTURE OF W
43 !| U |-->| FUNCTION USED IN THE VECTOR FORMULA
44 !| V |-->| FUNCTION USED IN THE VECTOR FORMULA
45 !| W |-->| FUNCTION USED IN THE VECTOR FORMULA
46 !| W1 |<--| RESULT IN NON ASSEMBLED FORM
47 !| W2 |<--| RESULT IN NON ASSEMBLED FORM
48 !| W3 |<--| RESULT IN NON ASSEMBLED FORM
49 !| W4 |<--| RESULT IN NON ASSEMBLED FORM
50 !| W5 |<--| RESULT IN NON ASSEMBLED FORM
51 !| W6 |<--| RESULT IN NON ASSEMBLED FORM
52 !| X |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
53 !| Y |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
54 !| XMUL |-->| MULTIPLICATION COEFFICIENT
55 !| Z |-->| ELEVATIONS OF POINTS ,PER POINT !!!
56 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 !
58  USE bief!, EX_VC08PP => VC08PP
59 !
60  USE declarations_special
61  IMPLICIT NONE
62 !
63 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
64 !
65  INTEGER, INTENT(IN) :: NELEM,NELMAX
66  INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
67  INTEGER, INTENT(IN) :: IKLE4(nelmax),IKLE5(nelmax),IKLE6(nelmax)
68 !
69  DOUBLE PRECISION, INTENT(IN) :: X(nelmax,6),Y(nelmax,6),Z(*)
70  DOUBLE PRECISION, INTENT(IN) :: XMUL,SURFAC(nelmax)
71  DOUBLE PRECISION, INTENT(INOUT)::W1(nelmax),W2(nelmax),W3(nelmax)
72  DOUBLE PRECISION, INTENT(INOUT)::W4(nelmax),W5(nelmax),W6(nelmax)
73 !
74 ! STRUCTURES OF F, U, V AND REAL DATA
75 !
76  TYPE(bief_obj), INTENT(IN) :: SU,SV,SW
77  DOUBLE PRECISION, INTENT(IN) :: U(*),V(*),W(*)
78 !
79 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
80 !
81  DOUBLE PRECISION X2,X3,Y2,Y3,COEF,XS24,XS144
82  DOUBLE PRECISION Z2,Z3,Z4,Z5,Z6
83  DOUBLE PRECISION U1,U2,U3,U4,U5,U6,V1,V2,V3,V4,V5,V6
84  DOUBLE PRECISION Q1,Q2,Q3,Q4,Q5,Q6,H1,H2,H3,SHT,DIFFU,DIFFV
85 !
86  INTEGER I1,I2,I3,I4,I5,I6,IELEM,IELMU,IELMV,IELMW
87 !
88 !**********************************************************************
89 !
90  xs24 = xmul/24.d0
91  xs144 = xmul/144.d0
92 !
93  ielmu=su%ELM
94  ielmv=sv%ELM
95  ielmw=sw%ELM
96 !
97 !-----------------------------------------------------------------------
98 !
99 ! FUNCTION F AND VECTOR U ARE LINEAR
100 !
101  IF(ielmu.EQ.41.AND.ielmv.EQ.41.AND.ielmw.EQ.41) THEN
102 !
103 ! LOOP ON THE ELEMENTS
104 !
105  DO ielem = 1,nelem
106 !
107  i1 = ikle1(ielem)
108  i2 = ikle2(ielem)
109  i3 = ikle3(ielem)
110  i4 = ikle4(ielem)
111  i5 = ikle5(ielem)
112  i6 = ikle6(ielem)
113 !
114  x2 = x(ielem,2)
115  x3 = x(ielem,3)
116  y2 = y(ielem,2)
117  y3 = y(ielem,3)
118 !
119  u1 = u(i1)
120  u2 = u(i2)
121  u3 = u(i3)
122  u4 = u(i4)
123  u5 = u(i5)
124  u6 = u(i6)
125  v1 = v(i1)
126  v2 = v(i2)
127  v3 = v(i3)
128  v4 = v(i4)
129  v5 = v(i5)
130  v6 = v(i6)
131  q1 = w(i1)
132  q2 = w(i2)
133  q3 = w(i3)
134  q4 = w(i4)
135  q5 = w(i5)
136  q6 = w(i6)
137 !
138  coef=xs24*surfac(ielem)
139  h1 = z(ikle4(ielem)) - z(ikle1(ielem))
140  h2 = z(ikle5(ielem)) - z(ikle2(ielem))
141  h3 = z(ikle6(ielem)) - z(ikle3(ielem))
142  sht = h1 + h2 + h3
143 !
144  z2 = z(i2) - z(i1)
145  z3 = z(i3) - z(i1)
146  z4 = z(i4) - z(i1)
147  z5 = z(i5) - z(i1)
148  z6 = z(i6) - z(i1)
149 !
150 !
151  w1(ielem)=(((z5+3*z4-3*z3-z2)*(-(2*v1-v6)*y2-(2*u1-u6)*x2)
152  & +(-z6-3*z4+z3+3*z2)*(-(2*v1-v5)*y3-(2*u1-u5)*x3)
153  & +(2*z6+3*z5+3*z4-2*z3)*(-v2*y3-u2*x3)
154  & +(-3*z6-2*z5-3*z4+2*z2)*(-v3*y2-u3*x2)
155  & +(z5-z4+2*z2)*(-(v3-v6)*y3-(u3-u6)*x3)
156  & +(3*z6+z5+3*z3-z2)*(-v4*y2-u4*x2)
157  & +(-z6-3*z5+z3-3*z2)*(-v4*y3-u4*x3)
158  & +(z6-z4+2*z3)*(-(v5-v2)*y2-(u5-u2)*x2))*xs144)**2
159 !
160  w2(ielem)=(((z6+4*z5+3*z4-4*z3-4*z2)*(-v1*y2-u1*x2)
161  & +(-2*z6-3*z5-3*z4+2*z3+6*z2)*(-v1*y3-u1*x3)
162  & +(z6+3*z5-z3)*(-(2*v2-v4)*y3-(2*u2-u4)*x3)
163  & +(-3*z6-4*z5-z4+4*z2)*(-v3*y2-u3*x2)
164  & +(2*z6+2*z5+z3-2*z2)*(-v4*y2-u4*x2)
165  & +(z6-z4+2*z3)*(-2*(v5-v2)*y2-2*(u5-u2)*x2)
166  & +(z6+3*z4-z3-6*z2)*(-v5*y3-u5*x3)
167  & +(-2*z5-2*z4+3*z3+2*z2)*(-v6*y2-u6*x2)
168  & +(-z5+z4-2*z2)*(-(v6-v3)*y3-(u6-u3)*x3))*xs144)**2
169 !
170  w3(ielem)=(((3*z6+2*z5+3*z4-6*z3-2*z2)*(-v1*y2-u1*x2)
171  & +(-4*z6-z5-3*z4+4*z3+4*z2)*(-v1*y3-u1*x3)
172  & +(4*z6+3*z5+z4-4*z3)*(-v2*y3-u2*x3)
173  & +(-3*z6-z5+z2)*(-(2*v3-v4)*y2-(2*u3-u4)*x2)
174  & +(-2*z6-2*z5+2*z3-z2)*(-v4*y3-u4*x3)
175  & +(z6-z4+2*z3)*(-(v5-v2)*y2-(u5-u2)*x2)
176  & +(2*z6+2*z4-2*z3-3*z2)*(-v5*y3-u5*x3)
177  & +(-z5-3*z4+6*z3+z2)*(-v6*y2-u6*x2)
178  & +(-z5+z4-2*z2)*(-2*(v6-v3)*y3-2*(u6-u3)*x3))*xs144)**2
179 !
180  w4(ielem)=(((-3*z6+z5+6*z4-3*z3-z2)*(-v1*y2-u1*x2)
181  & +(-z6+3*z5-6*z4+z3+3*z2)*(-v1*y3-u1*x3)
182  & +(3*z6+z5-z2)*(-(2*v4-v3)*y2-(2*u4-u3)*x2)
183  & +(-z6-3*z5+z3)*(-(2*v4-v2)*y3-(2*u4-u2)*x3)
184  & +(2*z6-2*z4+z3)*(-2*(v5-v2)*y2-2*(u5-u2)*x2)
185  & +(2*z6+6*z4-2*z3-3*z2)*(-v5*y3-u5*x3)
186  & +(-2*z5-6*z4+3*z3+2*z2)*(-v6*y2-u6*x2)
187  & +(-2*z5+2*z4-z2)*(-(v6-v3)*y3-(u6-u3)*x3))*xs144)**2
188 !
189  w5(ielem)=(((-z6+2*z5+3*z4-2*z3-2*z2)*(-v1*y2-u1*x2)
190  & +(z6+6*z5-3*z4-z3)*(-v2*y3-u2*x3)
191  & +(-3*z6-2*z5+z4+2*z2)*(-v3*y2-u3*x2)
192  & +(4*z6+4*z5-z3-4*z2)*(-v4*y2-u4*x2)
193  & +(-2*z6-6*z5+2*z3+3*z2)*(-v4*y3-u4*x3)
194  & +(2*z6-2*z4+z3)*(-2*(v5-v2)*y2-2*(u5-u2)*x2)
195  & +(z6+3*z4-z3-3*z2)*(-(2*v5-v1)*y3-(2*u5-u1)*x3)
196  & +(-4*z5-4*z4+3*z3+4*z2)*(-v6*y2-u6*x2)
197  & +(-2*z5+2*z4-z2)*(-(v6-v3)*y3-(u6-u3)*x3))*xs144)**2
198 !
199  w6(ielem)=(((-2*z6+z5-3*z4+2*z3+2*z2)*(-v1*y3-u1*x3)
200  & +(2*z6+3*z5-z4-2*z3)*(-v2*y3-u2*x3)
201  & +(-6*z6-z5+3*z4+z2)*(-v3*y2-u3*x2)
202  & +(6*z6+2*z5-3*z3-2*z2)*(-v4*y2-u4*x2)
203  & +(-4*z6-4*z5+4*z3+z2)*(-v4*y3-u4*x3)
204  & +(2*z6-2*z4+z3)*(-(v5-v2)*y2-(u5-u2)*x2)
205  & +(4*z6+4*z4-4*z3-3*z2)*(-v5*y3-u5*x3)
206  & +(-z5-3*z4+3*z3+z2)*(-(2*v6-v1)*y2-(2*u6-u1)*x2)
207  & +(-2*z5+2*z4-z2)*(-2*(v6-v3)*y3-2*(u6-u3)*x3))*xs144)**2
208 !
209  diffu = (u4+u5+u6)-(u1+u2+u3)
210  diffv = (v4+v5+v6)-(v1+v2+v3)
211 !
212  w1(ielem)=w1(ielem)+((u4-u1+diffu)*coef
213  & -((2*q1-q6)*y2*(z5+3*z4-3*z3 -z2)
214  & +(2*q1-q5)*y3*(-z6-3*z4 +z3+3*z2)
215  & +q2*y3*(2*z6+3*z5+3*z4-2*z3)
216  & +q3*y2*(-3*z6-2*z5-3*z4+2*z2)
217  & +(q3-q6)*y3*(z5-z4+2*z2)
218  & +q4*y2*(3*z6+z5+3*z3-z2)
219  & +q4*y3*(-z6-3*z5+z3-3*z2)
220  & +(q5-q2)*y2*(z6-z4+2*z3))*xs144)**2
221 !
222  w2(ielem)=w2(ielem)+((u5-u2+diffu)*coef
223  & -(q1*y2*(z6+4*z5+3*z4-4*z3-4*z2)
224  & +q1*y3*(-2*z6-3*z5-3*z4+2*z3+6*z2)
225  & +(2*q2-q4)*y3*(z6+3*z5-z3)
226  & +q3*y2*(-3*z6-4*z5-z4+4*z2)
227  & +q4*y2*(2*z6+2*z5+z3-2*z2)
228  & +2*(q5-q2)*y2*(z6-z4+2*z3)
229  & +q5*y3*(z6+3*z4-z3-6*z2)
230  & +q6*y2*(-2*z5-2*z4+3*z3+2*z2)
231  & +(q6-q3)*y3*(-z5+z4-2*z2))*xs144)**2
232 !
233  w3(ielem)=w3(ielem)+((u6-u3+diffu)*coef
234  & -(q1*y2*(3*z6+2*z5+3*z4-6*z3-2*z2)
235  & +q1*y3*(-4*z6-z5-3*z4+4*z3+4*z2)
236  & +q2*y3*(4*z6+3*z5+z4-4*z3)
237  & +(2*q3-q4)*y2*(-3*z6-z5+z2)
238  & +q4*y3*(-2*z6-2*z5+2*z3-z2)
239  & +(q5-q2)*y2*(z6-z4+2*z3)
240  & +q5*y3*(2*z6+2*z4-2*z3-3*z2)
241  & +q6*y2*(-z5-3*z4+6*z3+z2)
242  & +2*(q6-q3)*y3*(-z5+z4-2*z2) )*xs144)**2
243 !
244  w4(ielem)=w4(ielem)+((u4-u1+diffu)*coef
245  & -(q1*y2*(-3*z6+z5+6*z4-3*z3-z2)
246  & +q1*y3*(-z6+3*z5-6*z4+z3+3*z2)
247  & +q2*y3*(z6+3*z5-z3)
248  & +(2*q4-q3)*y2*(3*z6+z5-z2)
249  & +2*q4*y3*(-z6-3*z5+z3)
250  & +(q5-q2)*y2*(2*z6-2*z4+z3)
251  & +q5*y3*(2*z6+6*z4-2*z3-3*z2)
252  & +q6*y2*(-2*z5-6*z4+3*z3+2*z2)
253  & +(q6-q3)*y3*(-2*z5+2*z4-z2) )*xs144)**2
254 !
255  w5(ielem)=w5(ielem)+((u5-u2+diffu)*coef
256  & -(q1*y2*(-z6+2*z5+3*z4-2*z3-2*z2)
257  & +q2*y3*(z6+6*z5-3*z4-z3)
258  & +q3*y2*(-3*z6-2*z5+z4+2*z2)
259  & +q4*y2*(4*z6+4*z5-z3-4*z2)
260  & +q4*y3*(-2*z6-6*z5+2*z3+3*z2)
261  & +2*(q5-q2)*y2*(2*z6-2*z4+z3)
262  & +(2*q5-q1)*y3*(z6+3*z4-z3-3*z2)
263  & +q6*y2*(-4*z5-4*z4+3*z3+4*z2)
264  & +(q6-q3)*y3*(-2*z5+2*z4-z2) )*xs144)**2
265 !
266  w6(ielem)=w6(ielem)+((u6-u3+diffu)*coef
267  & -(q1*y3*(-2*z6+z5-3*z4+2*z3+2*z2)
268  & +q2*y3*(2*z6+3*z5-z4-2*z3)
269  & +q3*y2*(-6*z6-z5+3*z4+z2)
270  & +q4*y2*(6*z6+2*z5-3*z3-2*z2)
271  & +q4*y3*(-4*z6-4*z5+4*z3+z2)
272  & +(q5-q2)*y2*(2*z6-2*z4+z3)
273  & +q5*y3*(4*z6+4*z4-4*z3-3*z2)
274  & +(2*q6-q1)*y2*(-z5-3*z4+3*z3+z2)
275  & +2*(q6-q3)*y3*(-2*z5+2*z4-z2) )*xs144)**2
276 !
277  w1(ielem)=w1(ielem)+((v4-v1+diffv)*coef
278  & -((2*q1-q6)*x2*(z5+3*z4-3*z3 -z2)
279  & +(2*q1-q5)*x3*(-z6-3*z4 +z3+3*z2)
280  & +q2*x3*(2*z6+3*z5+3*z4-2*z3)
281  & +q3*x2*(-3*z6-2*z5-3*z4+2*z2)
282  & +(q3-q6)*x3*(z5-z4+2*z2)
283  & +q4*x2*(3*z6+z5+3*z3-z2)
284  & +q4*x3*(-z6-3*z5+z3-3*z2)
285  & +(q5-q2)*x2*(z6-z4+2*z3))*xs144)**2
286 !
287  w2(ielem)=w2(ielem)+((v5-v2+diffv)*coef
288  & -(q1*x2*(z6+4*z5+3*z4-4*z3-4*z2)
289  & +q1*x3*(-2*z6-3*z5-3*z4+2*z3+6*z2)
290  & +(2*q2-q4)*x3*(z6+3*z5-z3)
291  & +q3*x2*(-3*z6-4*z5-z4+4*z2)
292  & +q4*x2*(2*z6+2*z5+z3-2*z2)
293  & +2*(q5-q2)*x2*(z6-z4+2*z3)
294  & +q5*x3*(z6+3*z4-z3-6*z2)
295  & +q6*x2*(-2*z5-2*z4+3*z3+2*z2)
296  & +(q6-q3)*x3*(-z5+z4-2*z2))*xs144)**2
297 !
298  w3(ielem)=w3(ielem)+((v6-v3+diffv)*coef
299  & -(q1*x2*(3*z6+2*z5+3*z4-6*z3-2*z2)
300  & +q1*x3*(-4*z6-z5-3*z4+4*z3+4*z2)
301  & +q2*x3*(4*z6+3*z5+z4-4*z3)
302  & +(2*q3-q4)*x2*(-3*z6-z5+z2)
303  & +q4*x3*(-2*z6-2*z5+2*z3-z2)
304  & +(q5-q2)*x2*(z6-z4+2*z3)
305  & +q5*x3*(2*z6+2*z4-2*z3-3*z2)
306  & +q6*x2*(-z5-3*z4+6*z3+z2)
307  & +2*(q6-q3)*x3*(-z5+z4-2*z2) )*xs144)**2
308 !
309  w4(ielem)=w4(ielem)+((v4-v1+diffv)*coef
310  & -(q1*x2*(-3*z6+z5+6*z4-3*z3-z2)
311  & +q1*x3*(-z6+3*z5-6*z4+z3+3*z2)
312  & +q2*x3*(z6+3*z5-z3)
313  & +(2*q4-q3)*x2*(3*z6+z5-z2)
314  & +2*q4*x3*(-z6-3*z5+z3)
315  & +(q5-q2)*x2*(2*z6-2*z4+z3)
316  & +q5*x3*(2*z6+6*z4-2*z3-3*z2)
317  & +q6*x2*(-2*z5-6*z4+3*z3+2*z2)
318  & +(q6-q3)*x3*(-2*z5+2*z4-z2) )*xs144)**2
319 !
320  w5(ielem)=w5(ielem)+((v5-v2+diffv)*coef
321  & -(q1*x2*(-z6+2*z5+3*z4-2*z3-2*z2)
322  & +q2*x3*(z6+6*z5-3*z4-z3)
323  & +q3*x2*(-3*z6-2*z5+z4+2*z2)
324  & +q4*x2*(4*z6+4*z5-z3-4*z2)
325  & +q4*x3*(-2*z6-6*z5+2*z3+3*z2)
326  & +2*(q5-q2)*x2*(2*z6-2*z4+z3)
327  & +(2*q5-q1)*x3*(z6+3*z4-z3-3*z2)
328  & +q6*x2*(-4*z5-4*z4+3*z3+4*z2)
329  & +(q6-q3)*x3*(-2*z5+2*z4-z2) )*xs144)**2
330 !
331  w6(ielem)=w6(ielem)+((v6-v3+diffv)*coef
332  & -(q1*x3*(-2*z6+z5-3*z4+2*z3+2*z2)
333  & +q2*x3*(2*z6+3*z5-z4-2*z3)
334  & +q3*x2*(-6*z6-z5+3*z4+z2)
335  & +q4*x2*(6*z6+2*z5-3*z3-2*z2)
336  & +q4*x3*(-4*z6-4*z5+4*z3+z2)
337  & +(q5-q2)*x2*(2*z6-2*z4+z3)
338  & +q5*x3*(4*z6+4*z4-4*z3-3*z2)
339  & +(2*q6-q1)*x2*(-z5-3*z4+3*z3+z2)
340  & +2*(q6-q3)*x3*(-2*z5+2*z4-z2) )*xs144)**2
341 !
342  w1(ielem)=w1(ielem)/(coef*(sht+h1))
343  w2(ielem)=w2(ielem)/(coef*(sht+h2))
344  w3(ielem)=w3(ielem)/(coef*(sht+h3))
345  w4(ielem)=w4(ielem)/(coef*(sht+h1))
346  w5(ielem)=w5(ielem)/(coef*(sht+h2))
347  w6(ielem)=w6(ielem)/(coef*(sht+h3))
348 !
349  ENDDO ! IELEM
350 !
351 !-----------------------------------------------------------------------
352 !
353  ELSE
354 !
355 !-----------------------------------------------------------------------
356 !
357  WRITE(lu,201) ielmu,su%NAME
358  WRITE(lu,301)
359 
360 201 FORMAT(1x,'DISCRETIZATION OF U:',1i6,
361  & 1x,'REAL NAME: ',a6)
362 301 FORMAT(1x,'CASE NOT IMPLEMENTED')
363  CALL plante(1)
364  stop
365 !
366  ENDIF
367 !
368 !-----------------------------------------------------------------------
369 !
370  RETURN
371  END
372 
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
vc17pp
subroutine vc17pp(XMUL, SURFAC, SU, SV, SW, U, V, W, X, Y, Z, IKLE1, IKLE2, IKLE3, IKLE4, IKLE5, IKLE6, NELEM, NELMAX, W1, W2, W3, W4, W5, W6)
Definition: vc17pp.f:9
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:57 for The TELEMAC-MASCARET system by doxygen 1.8.13