The TELEMAC-MASCARET system  trunk
vc15aa.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vc15aa
3 ! *****************
4 !
5  &( xmul,sf,su,sv,f,u,v,
6  & xel,yel,
7  & ikle1,ikle2,ikle3,ikle4,nelem,nelmax,
8  & w1,w2,w3)
9 !
10 !***********************************************************************
11 ! BIEF V6P1 21/08/2010
12 !***********************************************************************
13 !
14 !brief COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
15 !code
16 !+ / D(FU) D(FV)
17 !+ V = XMUL / PSII * ( -- + -- ) D(OMEGA)
18 !+ I /OMEGA DX DY
19 !+
20 !+
21 !+ PSI(I) IS A BASE OF TYPE P1 TRIANGLE
22 !
23 !warning THE JACOBIAN MUST BE POSITIVE
24 !warning THE RESULT IS IN W IN NOT ASSEMBLED FORM
25 !
26 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
27 !+ 09/12/94
28 !+ V5P1
29 !+
30 !
31 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
32 !+ 13/07/2010
33 !+ V6P0
34 !+ Translation of French comments within the FORTRAN sources into
35 !+ English comments
36 !
37 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
38 !+ 21/08/2010
39 !+ V6P0
40 !+ Creation of DOXYGEN tags for automated documentation and
41 !+ cross-referencing of the FORTRAN sources
42 !
43 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
44 !| F |-->| FUNCTION USED IN THE VECTOR FORMULA
45 !| IKLE1 |-->| FIRST POINT OF TRIANGLES
46 !| IKLE2 |-->| SECOND POINT OF TRIANGLES
47 !| IKLE3 |-->| THIRD POINT OF TRIANGLES
48 !| IKLE4 |-->| QUASI-BUBBLE POINT OF TRIANGLES
49 !| NELEM |-->| NUMBER OF ELEMENTS
50 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
51 !| SF |-->| BIEF_OBJ STRUCTURE OF F
52 !| SU |-->| BIEF_OBJ STRUCTURE OF U
53 !| SV |-->| BIEF_OBJ STRUCTURE OF V
54 !| SURFAC |-->| AREA OF TRIANGLES
55 !| U |-->| FUNCTION USED IN THE VECTOR FORMULA
56 !| V |-->| FUNCTION USED IN THE VECTOR FORMULA
57 !| W1 |<--| RESULT IN NON ASSEMBLED FORM
58 !| W2 |<--| RESULT IN NON ASSEMBLED FORM
59 !| W3 |<--| RESULT IN NON ASSEMBLED FORM
60 !| XEL |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
61 !| XMUL |-->| MULTIPLICATION COEFFICIENT
62 !| YEL |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
63 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64 !
65  USE bief, ex_vc15aa => vc15aa
66 !
67  USE declarations_special
68  IMPLICIT NONE
69 !
70 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
71 !
72  INTEGER, INTENT(IN) :: NELEM,NELMAX
73  INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
74  INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
75 !
76  DOUBLE PRECISION, INTENT(IN) :: XEL(nelmax,*),YEL(nelmax,*)
77  DOUBLE PRECISION, INTENT(INOUT) ::W1(nelmax),W2(nelmax),W3(nelmax)
78  DOUBLE PRECISION, INTENT(IN) :: XMUL
79 !
80 ! STRUCTURES OF F, G, H, U, V, W AND REAL DATA
81 !
82  TYPE(bief_obj), INTENT(IN) :: SF,SU,SV
83  DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*)
84 !
85 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
86 !
87  INTEGER IELEM,IELMF,IELMU,IELMV
88  DOUBLE PRECISION X2,Y2,X3,Y3,F1,F2,F3,U1,U2,U3,U4,V1,V2,V3,V4
89  DOUBLE PRECISION XSUR24,XSU216
90 !
91 !-----------------------------------------------------------------------
92 !
93  xsur24 = xmul/24.d0
94  xsu216 = xmul/216.d0
95 !
96  ielmf=sf%ELM
97  ielmu=su%ELM
98  ielmv=sv%ELM
99 !
100 !-----------------------------------------------------------------------
101 !
102 ! FUNCTION F AND VECTOR U ARE LINEAR
103 !
104  IF(ielmf.EQ.11.AND.ielmu.EQ.11.AND.ielmv.EQ.11) THEN
105 !
106  DO ielem = 1 , nelem
107 !
108  x2 = xel(ielem,2)
109  x3 = xel(ielem,3)
110  y2 = yel(ielem,2)
111  y3 = yel(ielem,3)
112 !
113  f1 = f(ikle1(ielem))
114  f2 = f(ikle2(ielem))
115  f3 = f(ikle3(ielem))
116 !
117  u1 = u(ikle1(ielem))
118  u2 = u(ikle2(ielem))
119  u3 = u(ikle3(ielem))
120  v1 = v(ikle1(ielem))
121  v2 = v(ikle2(ielem))
122  v3 = v(ikle3(ielem))
123 !
124  w1(ielem)=(((2*f3+f2+f1)*v3+(f3-f2-4*f1)*v1+(f3-f1)*v2)*x2-((
125  & f3+2*f2+f1)*v2-(f3-f2+4*f1)*v1+(f2-f1)*v3)*x3-((y3+y2)*
126  & f3-(y3+y2)*f2+4*(y3-y2)*f1)*u1+((y3+y2)*f1+(y3-y2)*f3+2
127  & *f2*y3)*u2-((y3+y2)*f1-(y3-y2)*f2+2*f3*y2)*u3)*xsur24
128  w2(ielem)=(-(((f3+4*f2-f1)*v2-(f3+f2+2*f1)*v1+(f2-f1)*v3)*x3-
129  & 2*((f3+f2)*v3+(f3-f1)*v2-(f2+f1)*v1)*x2+(2*(y3-y2)*f1+(
130  & y3-2*y2)*f2+f3*y3)*u1-((y3-2*y2)*f3-(y3-2*y2)*f1+4*f2
131  & *y3)*u2-((y3-2*y2)*f2-2*f3*y2-f1*y3)*u3))*xsur24
132  w3(ielem)=(((4*f3+f2-f1)*v3-(f3+f2+2*f1)*v1+(f3-f1)*v2)*x2-2
133  & *((f3+f2)*v2-(f3+f1)*v1+(f2-f1)*v3)*x3-((2*y3-y2)*f3+2*
134  & (y3-y2)*f1-f2*y2)*u1+((2*y3-y2)*f3+2*f2*y3+f1*y2)*u2+((
135  & 2*y3-y2)*f2-(2*y3-y2)*f1-4*f3*y2)*u3)*xsur24
136 !
137  ENDDO ! IELEM
138 !
139 !-----------------------------------------------------------------------
140 !
141 ! FUNCTION F IS LINEAR AND VECTOR U IS QUASI-BUBBLE
142 !
143  ELSEIF(ielmf.EQ.11.AND.ielmu.EQ.12.AND.ielmu.EQ.12) THEN
144 !
145 !
146  DO ielem = 1 , nelem
147 !
148  x2 = xel(ielem,2)
149  x3 = xel(ielem,3)
150  y2 = yel(ielem,2)
151  y3 = yel(ielem,3)
152 !
153  f1 = f(ikle1(ielem))
154  f2 = f(ikle2(ielem))
155  f3 = f(ikle3(ielem))
156 !
157  u1 = u(ikle1(ielem))
158  u2 = u(ikle2(ielem))
159  u3 = u(ikle3(ielem))
160  u4 = u(ikle4(ielem))
161  v1 = v(ikle1(ielem))
162  v2 = v(ikle2(ielem))
163  v3 = v(ikle3(ielem))
164  v4 = v(ikle4(ielem))
165 !
166  w1(ielem)=((14*x2*v3+12*x2*v4+5*x2*v2+5*x2*v1+4*x3*v3-
167  & 12*x3*v4-5*x3*v2+13*x3*v1-4*u3*y3-14*u3*y2+12*u4*y3-
168  & 12*u4*y2+5*u2*y3-5*u2*y2-13*u1*y3-5*u1*y2)*f3+(5*x2*
169  & v3+12*x2*v4-4*x2*v2-13*x2*v1-5*x3*v3-12*x3*v4-14*x3
170  & *v2-5*x3*v1+5*u3*y3-5*u3*y2+12*u4*y3-12*u4*y2+14*u2
171  & *y3+4*u2*y2+5*u1*y3+13*u1*y2)*f2+(5*x2*v3+12*x2*v4-
172  & 13*x2*v2-40*x2*v1+13*x3*v3-12*x3*v4-5*x3*v2+40*x3*v1
173  & -13*u3*y3-5*u3*y2+12*u4*y3-12*u4*y2+5*u2*y3+13*u2*
174  & y2-40*u1*y3+40*u1*y2)*f1)*xsu216
175  w2(ielem)=(18*x2*v3*f3+18*x2*v3*f2+18*x2*v2*f3-18*x2*v2*
176  & f1-18*x2*v1*f2-18*x2*v1*f1-4*x3*v3*f3-13*x3*v3*f2+5*
177  & x3*v3*f1+12*x3*v4*f3+12*x3*v4*f2+12*x3*v4*f1-13*x3*v2
178  & *f3-40*x3*v2*f2+5*x3*v2*f1+5*x3*v1*f3+5*x3*v1*f2+14*
179  & x3*v1*f1+4*u3*y3*f3+13*u3*y3*f2-5*u3*y3*f1-18*u3*y2*
180  & f3-18*u3*y2*f2-12*u4*y3*f3-12*u4*y3*f2-12*u4*y3*f1+
181  & 13*u2*y3*f3+40*u2*y3*f2-5*u2*y3*f1-18*u2*y2*f3+18*u2*
182  & y2*f1-5*u1*y3*f3-5*u1*y3*f2-14*u1*y3*f1+18*u1*y2*f2+
183  & 18*u1*y2*f1)*xsu216
184  w3(ielem)=(40*x2*v3*f3+13*x2*v3*f2-5*x2*v3*f1-12*x2*v4*f3
185  & -12*x2*v4*f2-12*x2*v4*f1+13*x2*v2*f3+4*x2*v2*f2-5*x2
186  & *v2*f1-5*x2*v1*f3-5*x2*v1*f2-14*x2*v1*f1-18*x3*v3*f2+
187  & 18*x3*v3*f1-18*x3*v2*f3-18*x3*v2*f2+18*x3*v1*f3+18*x3
188  & *v1*f1+18*u3*y3*f2-18*u3*y3*f1-40*u3*y2*f3-13*u3*y2*
189  & f2+5*u3*y2*f1+12*u4*y2*f3+12*u4*y2*f2+12*u4*y2*f1+18
190  & *u2*y3*f3+18*u2*y3*f2-13*u2*y2*f3-4*u2*y2*f2+5*u2*y2*
191  & f1-18*u1*y3*f3-18*u1*y3*f1+5*u1*y2*f3+5*u1*y2*f2+14*
192  & u1*y2*f1)*xsu216
193 !
194  ENDDO ! IELEM
195 !
196 !-----------------------------------------------------------------------
197 !
198  ELSE
199 !
200 !-----------------------------------------------------------------------
201 !
202  WRITE(lu,101) ielmf,sf%NAME
203  WRITE(lu,201) ielmu,su%NAME
204  WRITE(lu,301)
205 101 FORMAT(1x,'VC15AA (BIEF) :',/,
206  & 1x,'DISCRETIZATION OF F:',1i6,
207  & 1x,'REAL NAME: ',a6)
208 201 FORMAT(1x,'DISCRETIZATION OF U:',1i6,
209  & 1x,'REAL NAME: ',a6)
210 301 FORMAT(1x,'CASE NOT IMPLEMENTED')
211  CALL plante(1)
212  stop
213 !
214  ENDIF
215 !
216 !-----------------------------------------------------------------------
217 !
218  RETURN
219  END
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
vc15aa
subroutine vc15aa(XMUL, SF, SU, SV, F, U, V, XEL, YEL, IKLE1, IKLE2, IKLE3, IKLE4, NELEM, NELMAX, W1, W2, W3)
Definition: vc15aa.f:10
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:56 for The TELEMAC-MASCARET system by doxygen 1.8.13