The TELEMAC-MASCARET system  trunk
vc11bb.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vc11bb
3 ! *****************
4 !
5  &( xmul,sf,sg,f,g,xel,yel,
6  & ikle1,ikle2,ikle3,ikle4,nelem,nelmax,w1,w2,w3,w4 , icoord )
7 !
8 !***********************************************************************
9 ! BIEF V6P1 21/08/2010
10 !***********************************************************************
11 !
12 !brief COMPUTES THE FOLLOWING TERMS:
13 !code
14 !+ (EXAMPLE OF THE X COMPONENT, WHICH CORRESPONDS TO ICOORD=1)
15 !+
16 !+ / DF
17 !+ VEC(I) = XMUL / ( G P *( -- )) D(OMEGA)
18 !+ /OMEGA I DX
19 !+
20 !+
21 !+ P IS A QUASI-BUBBLE BASE
22 !+ I
23 !+
24 !+ F IS A VECTOR OF TYPE P1 OR OTHER
25 !+ G IS A VECTOR OF TYPE P1 OR OTHER
26 !
27 !note IMPORTANT : IF F IS OF TYPE P0, THE RESULT IS 0.
28 !+
29 !+ HERE, IF F IS P0, IT REALLY MEANS THAT F IS P1,
30 !+ BUT GIVEN BY ELEMENTS.
31 !+
32 !+ THE SIZE OF F SHOULD THEN BE : F(NELMAX,3).
33 !
34 !warning THE JACOBIAN MUST BE POSITIVE
35 !warning THE RESULT IS IN W IN NOT ASSEMBLED FORM
36 !
37 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
38 !+ 09/12/94
39 !+ V5P1
40 !+
41 !
42 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
43 !+ 13/07/2010
44 !+ V6P0
45 !+ Translation of French comments within the FORTRAN sources into
46 !+ English comments
47 !
48 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
49 !+ 21/08/2010
50 !+ V6P0
51 !+ Creation of DOXYGEN tags for automated documentation and
52 !+ cross-referencing of the FORTRAN sources
53 !
54 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
55 !| F |-->| FUNCTION USED IN THE VECTOR FORMULA
56 !| G |-->| FUNCTION USED IN THE VECTOR FORMULA
57 !| ICOORD |-->| 1: DERIVATIVE ALONG X, 2: ALONG Y
58 !| IKLE1 |-->| FIRST POINT OF TRIANGLES
59 !| IKLE2 |-->| SECOND POINT OF TRIANGLES
60 !| IKLE3 |-->| THIRD POINT OF TRIANGLES
61 !| IKLE4 |-->| QUASI-BUBBLE POINT OF TRIANGLES
62 !| NELEM |-->| NUMBER OF ELEMENTS
63 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
64 !| SF |-->| BIEF_OBJ STRUCTURE OF F
65 !| SG |-->| BIEF_OBJ STRUCTURE OF G
66 !| SURFAC |-->| AREA OF TRIANGLES
67 !| W1 |<--| RESULT IN NON ASSEMBLED FORM
68 !| W2 |<--| RESULT IN NON ASSEMBLED FORM
69 !| W3 |<--| RESULT IN NON ASSEMBLED FORM
70 !| W4 |<--| RESULT IN NON ASSEMBLED FORM
71 !| XEL |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
72 !| XMUL |-->| MULTIPLICATION COEFFICIENT
73 !| YEL |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
74 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
75 !
76  USE bief, ex_vc11bb => vc11bb
77 !
78  USE declarations_special
79  IMPLICIT NONE
80 !
81 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
82 !
83  INTEGER, INTENT(IN) :: NELEM,NELMAX,ICOORD
84  INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
85  INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
86 !
87  DOUBLE PRECISION, INTENT(IN) :: XEL(nelmax,*),YEL(nelmax,*)
88  DOUBLE PRECISION, INTENT(INOUT) :: W1(nelmax),W2(nelmax)
89  DOUBLE PRECISION, INTENT(INOUT) :: W3(nelmax),W4(nelmax)
90  DOUBLE PRECISION, INTENT(IN) :: XMUL
91 !
92 ! STRUCTURES OF F, G AND REAL DATA
93 !
94  TYPE(bief_obj), INTENT(IN) :: SF,SG
95  DOUBLE PRECISION, INTENT(IN) :: F(*),G(*)
96 !
97 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
98 !
99  INTEGER IELEM,IELMF,IELMG
100 !
101  DOUBLE PRECISION F1,F2,F3,F4,G1,G2,G3,G4,X2,X3,Y2,Y3,AUX
102  DOUBLE PRECISION XSUR72 ,XSU216,XSUR18
103 !
104 !-----------------------------------------------------------------------
105 !
106  xsur72= xmul / 72.d0
107  xsu216= xmul /216.d0
108  xsur18= xmul / 18.d0
109 !
110 !-----------------------------------------------------------------------
111 !
112  ielmf=sf%ELM
113  ielmg=sg%ELM
114 !
115 !-----------------------------------------------------------------------
116 !
117 ! F AND G ARE LINEAR
118 !
119  IF(ielmf.EQ.11.AND.ielmg.EQ.11) THEN
120 !
121 ! X COORDINATE
122 !
123  IF(icoord.EQ.1) THEN
124 !
125  DO ielem = 1 , nelem
126 !
127  f1 = f(ikle1(ielem))
128  f2 = f(ikle2(ielem)) - f1
129  f3 = f(ikle3(ielem)) - f1
130  g1 = g(ikle1(ielem))
131  g2 = g(ikle2(ielem))
132  g3 = g(ikle3(ielem))
133  y2 = yel(ielem,2)
134  y3 = yel(ielem,3)
135  aux = f2*y3 - f3*y2
136 !
137  w1(ielem)=(5*g3+5*g2+14*g1)*aux*xsu216
138  w2(ielem)=(5*g3+14*g2+5*g1)*aux*xsu216
139  w3(ielem)=(14*g3+5*g2+5*g1)*aux*xsu216
140  w4(ielem)=(g3+g2+g1) *aux*xsur18
141 !
142  ENDDO ! IELEM
143 !
144  ELSEIF(icoord.EQ.2) THEN
145 !
146 ! Y COORDINATE
147 !
148  DO ielem = 1 , nelem
149 !
150  f1 = f(ikle1(ielem))
151  f2 = f(ikle2(ielem)) - f1
152  f3 = f(ikle3(ielem)) - f1
153  g1 = g(ikle1(ielem))
154  g2 = g(ikle2(ielem))
155  g3 = g(ikle3(ielem))
156  x2 = xel(ielem,2)
157  x3 = xel(ielem,3)
158  aux = x2*f3 - x3*f2
159 !
160  w1(ielem)=aux*(5*g3+5*g2+14*g1)*xsu216
161  w2(ielem)=aux*(5*g3+14*g2+5*g1)*xsu216
162  w3(ielem)=aux*(14*g3+5*g2+5*g1)*xsu216
163  w4(ielem)=aux*(g3+g2+g1) *xsur18
164 !
165  ENDDO ! IELEM
166 !
167  ELSE
168 !
169  WRITE(lu,21) icoord
170 21 FORMAT(1x,'VC11BB (BIEF) : IMPOSSIBLE COMPONENT ',
171  & 1i6,' CHECK ICOORD')
172  CALL plante(0)
173  stop
174 !
175  ENDIF
176 !
177 !-----------------------------------------------------------------------
178 !
179 ! F AND G ARE QUASI-BUBBLE
180 !
181  ELSEIF(ielmf.EQ.12.AND.ielmg.EQ.12) THEN
182 !
183 ! X COORDINATE
184 !
185  IF(icoord.EQ.1) THEN
186 !
187  DO ielem = 1 , nelem
188 !
189  f1 = f(ikle1(ielem))
190  f2 = f(ikle2(ielem)) - f1
191  f3 = f(ikle3(ielem)) - f1
192  f4 = f(ikle4(ielem)) - f1
193  g1 = g(ikle1(ielem))
194  g2 = g(ikle2(ielem))
195  g3 = g(ikle3(ielem))
196  g4 = g(ikle4(ielem))
197  y2 = yel(ielem,2)
198  y3 = yel(ielem,3)
199 !
200  w1(ielem)=(3*((y3-y2)*g4+2*(y3-y2)*g1+g3*y3-g2*y2)*f4-(g3+
201  & g4+2*g1)*(y3+y2)*f3+(g4+g2+2*g1)*(y3+y2)*f2)*xsur72
202  w2(ielem)=(((2*y3-y2)*g3+(y3+y2)*g1+3*g4*y3+6*g2*y3)*f2-3
203  & *((y3-y2)*g3+g4*y3+2*g2*y3+g1*y2)*f4+(g3+g4+2*g2)*(y3-
204  & 2*y2)*f3)*xsur72
205  w3(ielem)=(-(((y3+y2)*g1-(y3-2*y2)*g2+6*g3*y2+3*g4*y2)*f3+
206  & 3*((y3-y2)*g2-2*g3*y2-g4*y2-g1*y3)*f4-(2*g3+g4+g2)*(2*
207  & y3-y2)*f2))*xsur72
208  w4(ielem)=(((2*y3-y2)*g3+(y3+y2)*g1+6*g4*y3+3*g2*y3)*f2-((
209  & y3+y2)*g1-(y3-2*y2)*g2+3*g3*y2+6*g4*y2)*f3+3*((y3-y2)
210  & *g1+g3*y2-g2*y3)*f4)*xsur72
211 !
212  ENDDO ! IELEM
213 !
214  ELSEIF(icoord.EQ.2) THEN
215 !
216 ! Y COORDINATE
217 !
218  DO ielem = 1 , nelem
219 !
220  f1 = f(ikle1(ielem))
221  f2 = f(ikle2(ielem)) - f1
222  f3 = f(ikle3(ielem)) - f1
223  f4 = f(ikle4(ielem)) - f1
224  g1 = g(ikle1(ielem))
225  g2 = g(ikle2(ielem))
226  g3 = g(ikle3(ielem))
227  g4 = g(ikle4(ielem))
228  x2 = xel(ielem,2)
229  x3 = xel(ielem,3)
230 !
231  w1(ielem)=(-(3*((g3+g4+2*g1)*x3-(g4+g2+2*g1)*x2)*f4-(x2+x3
232  & )*(g3+g4+2*g1)*f3+(x2+x3)*(g4+g2+2*g1)*f2))*xsur72
233  w2(ielem)=(-(((2*g3+3*g4+6*g2+g1)*x3-(g3-g1)*x2)*f2-3*((
234  & g3+g4+2*g2)*x3-(g3-g1)*x2)*f4-(2*x2-x3)*(g3+g4+2*g2)*
235  & f3))*xsur72
236  w3(ielem)=(((6*g3+3*g4+2*g2+g1)*x2-(g2-g1)*x3)*f3-3*((2*
237  & g3+g4+g2)*x2-(g2-g1)*x3)*f4+(x2-2*x3)*(2*g3+g4+g2)*f2)*xsur72
238  w4(ielem)=(((3*g3+6*g4+2*g2+g1)*x2-(g2-g1)*x3)*f3-((2*g3+
239  & 6*g4+3*g2+g1)*x3-(g3-g1)*x2)*f2-3*((g3-g1)*x2-(g2-g1)*
240  & x3)*f4)*xsur72
241 !
242  ENDDO ! IELEM
243 !
244  ELSE
245 !
246  WRITE(lu,21) icoord
247  CALL plante(0)
248  stop
249 !
250  ENDIF
251 !
252 !-----------------------------------------------------------------------
253 !
254  ELSE
255 !
256 !-----------------------------------------------------------------------
257 !
258  WRITE(lu,101) ielmf,sf%NAME
259  WRITE(lu,201) ielmg,sg%NAME
260  WRITE(lu,301)
261 101 FORMAT(1x,'VC11BB (BIEF) :',/,
262  & 1x,'DISCRETIZATION OF F:',1i6,
263  & 1x,'REAL NAME: ',a6)
264 201 FORMAT(1x,'DISCRETIZATION OF G:',1i6,
265  & 1x,'REAL NAME: ',a6)
266 301 FORMAT(1x,'CASE NOT IMPLEMENTED')
267  CALL plante(0)
268  stop
269 !
270  ENDIF
271 !
272 !-----------------------------------------------------------------------
273 !
274  RETURN
275  END
declarations_special
Definition: declarations_special.F:3
declarations_special::lu
integer lu
Definition: declarations_special.F:45
vc11bb
subroutine vc11bb(XMUL, SF, SG, F, G, XEL, YEL, IKLE1, IKLE2, IKLE3, IKLE4, NELEM, NELMAX, W1, W2, W3, W4, ICOORD)
Definition: vc11bb.f:8
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:37:53 for The TELEMAC-MASCARET system by doxygen 1.8.13