The TELEMAC-MASCARET system  trunk
vc10oo.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vc10oo
3 ! *****************
4 !
5  &(xmul,sf,su,sv,f,u,v,xnor,ynor,lgseg,
6  & ikle,nbor,nelem,nelmax,w1,w2)
7 !
8 !***********************************************************************
9 ! BIEF V6P2 21/08/2010
10 !***********************************************************************
11 !
12 !brief COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
13 !code
14 !+ / -> ->
15 !+ VEC(I) = XMUL / PSI(I) * F U . N D(OMEGA)
16 !+ /OMEGA
17 !+
18 !+ PSI(I) IS A BASE OF TYPE P1 SEGMENT
19 !+ F IS A STRUCTURE OF VECTOR
20 !+ ->
21 !+ U IS A VECTOR WITH COMPONENTS U AND V
22 !+ ->
23 !+ N IS THE OUTGOING NORMAL VECTOR TO THE ELEMENT
24 !
25 !warning The Jacobian must be positive
26 !warning THE RESULT IS IN W IN NOT ASSEMBLED FORM
27 !warning NELEM is sometimes over-dimensioned, some boundary elements in
28 !+ THE list 1 to NELEM in parallel being in another subdomain. In
29 !+ this case NBOR may give a dummy value, that will cause no
30 !+ crash, but the result W1 and W2 will be dummy also.
31 !
32 !history J-M HERVOUET (LNH)
33 !+ 15/12/1994
34 !+
35 !+
36 !
37 !history ALGIANE FROEHLY (STAGIAIRE MATMECA)
38 !+ 29/05/2008
39 !+ V5P9
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 !| IKLE |-->| CONNECTIVITY TABLE
57 !| LGSEG |-->| LENGTH OF SEGMENTS
58 !| NBOR |-->| GLOBAL NUMBER OF BOUNDARY POINTS
59 !| NELEM |-->| NUMBER OF ELEMENTS
60 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
61 !| SF |-->| BIEF_OBJ STRUCTURE OF F
62 !| SU |-->| BIEF_OBJ STRUCTURE OF U
63 !| SV |-->| BIEF_OBJ STRUCTURE OF V
64 !| U |-->| FUNCTION USED IN THE VECTOR FORMULA
65 !| V |-->| FUNCTION USED IN THE VECTOR FORMULA
66 !| W1 |<--| RESULT IN NON ASSEMBLED FORM
67 !| W2 |<--| RESULT IN NON ASSEMBLED FORM
68 !| XMUL |-->| MULTIPLICATION COEFFICIENT
69 !| XNOR |-->| FIRST COMPONENT OF NORMAL TO ELEMENT
70 !| YNOR |-->| SECOND COMPONENT OF NORMAL TO ELEMENT
71 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
72 !
73  USE bief, ex_vc10oo => vc10oo
74 !
76  IMPLICIT NONE
77 !
78 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
79 !
80  INTEGER, INTENT(IN) :: NELEM,NELMAX
81  INTEGER, INTENT(IN) :: IKLE(nelmax,*)
82  INTEGER, INTENT(IN) :: NBOR(*)
83 !
84  DOUBLE PRECISION, INTENT(IN) :: XNOR(nelmax),YNOR(nelmax)
85  DOUBLE PRECISION, INTENT(INOUT) :: W1(nelmax),W2(nelmax)
86  DOUBLE PRECISION, INTENT(IN) :: LGSEG(*)
87  DOUBLE PRECISION, INTENT(IN) :: XMUL
88 !
89 ! STRUCTURES OF F, U, V AND REAL DATA
90 !
91  TYPE(bief_obj), INTENT(IN) :: SF,SU,SV
92  DOUBLE PRECISION, INTENT(IN) :: F(*),U(*),V(*)
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  INTEGER N1,N2,N3,NG1,NG2,NG3,IELEM,IELMF,IELMU,IELMV
97  DOUBLE PRECISION XSUR12,XSUR04,XSUR60,F1,F2,F3,U1,U2,U3
98  DOUBLE PRECISION V1,V2,V3,VX1,VY1,VX2,VY2
99 !
100 !-----------------------------------------------------------------------
101 !
102  xsur12 = xmul/12.d0
103  xsur04 = xmul/ 4.d0
104  xsur60 = xmul/60.d0
105 !
106 !-----------------------------------------------------------------------
107 !
108  ielmf=sf%ELM
109  ielmu=su%ELM
110  ielmv=sv%ELM
111 !
112 !-----------------------------------------------------------------------
113 ! ->
114 ! F AND U ARE LINEAR FUNCTIONS ON TRIANGLES OR QUADRILATERALS
115 !
116  IF( (ielmf.EQ.11.OR.ielmf.EQ.12.OR.ielmf.EQ.21) .AND.
117  & (ielmu.EQ.11.OR.ielmu.EQ.12.OR.ielmu.EQ.21) .AND.
118  & (ielmv.EQ.11.OR.ielmv.EQ.12.OR.ielmv.EQ.21) ) THEN
119 !
120  DO ielem =1,nelem
121 !
122 ! NUMBERING OF THE BOUNDARY NODES
123 !
124 ! GLOBAL NUMBERING
125 !
126  ng1= nbor(ikle(ielem,1))
127  ng2= nbor(ikle(ielem,2))
128 !
129  f1 = f(ng1)
130  f2 = f(ng2)
131  u1 = u(ng1)
132  u2 = u(ng2)
133  v1 = v(ng1)
134  v2 = v(ng2)
135 !
136 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
137 !
138  vx1 = xsur04 * f1 * u1 + xsur12 * ( f1 * u2 + f2 * ( u1 + u2 ) )
139  vy1 = xsur04 * f1 * v1 + xsur12 * ( f1 * v2 + f2 * ( v1 + v2 ) )
140  vx2 = xsur04 * f2 * u2 + xsur12 * ( f2 * u1 + f1 * ( u1 + u2 ) )
141  vy2 = xsur04 * f2 * v2 + xsur12 * ( f2 * v1 + f1 * ( v1 + v2 ) )
142 !
143  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
144  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
145 !
146  ENDDO ! IELEM
147 !
148 !-----------------------------------------------------------------------
149 ! F LINEAR FUNCTION ON TRIANGLES OR QUADRILATERALS
150 ! ->
151 ! U LINEAR FUNCTIONS ON SEGMENTS
152 !
153  ELSEIF( (ielmf.EQ.11.OR.ielmf.EQ.12.OR.ielmf.EQ.21) .AND.
154  & (ielmu.EQ.1 ) .AND.
155  & (ielmv.EQ.1 ) ) THEN
156 !
157  DO ielem =1,nelem
158 !
159 ! NUMBERING OF THE BOUNDARY NODES
160 !
161  n1 = ikle(ielem,1)
162  n2 = ikle(ielem,2)
163 !
164 ! GLOBAL NUMBERING
165 !
166  ng1= nbor(n1)
167  ng2= nbor(n2)
168 !
169  f1 = f(ng1)
170  f2 = f(ng2)
171  u1 = u(n1)
172  u2 = u(n2)
173  v1 = v(n1)
174  v2 = v(n2)
175 !
176 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
177 !
178  vx1 = xsur04 * f1 * u1 + xsur12 * ( f1 * u2 + f2 * ( u1 + u2 ) )
179  vy1 = xsur04 * f1 * v1 + xsur12 * ( f1 * v2 + f2 * ( v1 + v2 ) )
180  vx2 = xsur04 * f2 * u2 + xsur12 * ( f2 * u1 + f1 * ( u1 + u2 ) )
181  vy2 = xsur04 * f2 * v2 + xsur12 * ( f2 * v1 + f1 * ( v1 + v2 ) )
182 !
183  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
184  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
185 !
186  ENDDO ! IELEM
187 !
188 !-----------------------------------------------------------------------
189 ! F LINEAR FUNCTION ON SEGMENTS
190 ! ->
191 ! U LINEAR FUNCTIONS ON SEGMENTS
192 !
193  ELSEIF( ielmf.EQ.1 .AND.
194  & ielmu.EQ.1 .AND.
195  & ielmv.EQ.1 ) THEN
196 !
197  DO ielem =1,nelem
198 !
199 ! NUMBERING OF THE BOUNDARY NODES
200 !
201  n1 = ikle(ielem,1)
202  n2 = ikle(ielem,2)
203 !
204 ! GLOBAL NUMBERING
205 !
206  f1 = f(n1)
207  f2 = f(n2)
208  u1 = u(n1)
209  u2 = u(n2)
210  v1 = v(n1)
211  v2 = v(n2)
212 !
213 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
214 !
215  vx1 = xsur04 * f1 * u1 + xsur12 * ( f1 * u2 + f2 * ( u1 + u2 ) )
216  vy1 = xsur04 * f1 * v1 + xsur12 * ( f1 * v2 + f2 * ( v1 + v2 ) )
217  vx2 = xsur04 * f2 * u2 + xsur12 * ( f2 * u1 + f1 * ( u1 + u2 ) )
218  vy2 = xsur04 * f2 * v2 + xsur12 * ( f2 * v1 + f1 * ( v1 + v2 ) )
219 !
220  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
221  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
222 !
223  ENDDO ! IELEM
224 !
225 !
226 !-----------------------------------------------------------------------
227 !
228 ! F LINEAR FUNCTION ON TRIANGLES
229 ! ->
230 ! AND U QUADRATIC FUNCTIONS ON TRIANGLES
231 !
232  ELSEIF( (ielmf.EQ.11.OR.ielmf.EQ.12.OR.ielmf.EQ.21 ) .AND.
233  & (ielmu.EQ.13 ) .AND.
234  & (ielmv.EQ.13 ) ) THEN
235 !
236  DO ielem =1,nelem
237 !
238 ! NUMBERING OF THE BOUNDARY NODES
239 !
240 ! GLOBAL NUMBERING
241 !
242  ng1= nbor(ikle(ielem,1))
243  ng2= nbor(ikle(ielem,2))
244  ng3= nbor(ikle(ielem,3))
245 !
246  f1 = f(ng1)
247  f2 = f(ng2)
248  u1 = u(ng1)
249  u2 = u(ng2)
250  u3 = u(ng3)
251  v1 = v(ng1)
252  v2 = v(ng2)
253  v3 = v(ng3)
254 !
255 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
256 !
257  vx1 = xsur60 *(9.d0*f1*u1-f1*u2+12.d0*f1*u3+f2*(u1+u2)+8.d0*f2*u3)
258  vy1 = xsur60 *(9.d0*f1*v1-f1*v2+12.d0*f1*v3+f2*(v1+v2)+8.d0*f2*v3)
259  vx2 = xsur60 *(f1*(u1+u2)+8.d0*f1*u3-f2*u1+9.d0*f2*u2+12.d0*f2*u3)
260  vy2 = xsur60 *(f1*(v1+v2)+8.d0*f1*v3-f2*v1+9.d0*f2*v2+12.d0*f2*v3)
261 !
262  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
263  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
264 !
265  ENDDO ! IELEM
266 !
267 !-----------------------------------------------------------------------
268 ! F LINEAR FUNCTION ON TRIANGLES
269 ! ->
270 ! U QUADRATIC FUNCTIONS ON SEGMENTS
271 !
272  ELSEIF( (ielmf.EQ.11.OR.ielmf.EQ.12.OR.ielmf.EQ.21) .AND.
273  & (ielmu.EQ.2 ) .AND.
274  & (ielmv.EQ.2 ) ) THEN
275 !
276  DO ielem =1,nelem
277 !
278 ! NUMBERING OF THE BOUNDARY NODES
279 !
280  n1 = ikle(ielem,1)
281  n2 = ikle(ielem,2)
282  n3 = ikle(ielem,3)
283 !
284 ! GLOBAL NUMBERING
285 !
286  ng1= nbor(n1)
287  ng2= nbor(n2)
288  ng3= nbor(n3)
289 !
290  f1 = f(ng1)
291  f2 = f(ng2)
292  u1 = u(n1)
293  u2 = u(n2)
294  u3 = u(n3)
295  v1 = v(n1)
296  v2 = v(n2)
297  v3 = v(n3)
298 !
299 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
300 !
301  vx1 = xsur60 *(9.d0*f1*u1-f1*u2+12.d0*f1*u3+f2*(u1+u2)+8.d0*f2*u3)
302  vy1 = xsur60 *(9.d0*f1*v1-f1*v2+12.d0*f1*v3+f2*(v1+v2)+8.d0*f2*v3)
303  vx2 = xsur60 *(f1*(u1+u2)+8.d0*f1*u3-f2*u1+9.d0*f2*u2+12.d0*f2*u3)
304  vy2 = xsur60 *(f1*(v1+v2)+8.d0*f1*v3-f2*v1+9.d0*f2*v2+12.d0*f2*v3)
305 !
306  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
307  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
308 !
309  ENDDO ! IELEM
310 !
311 !-----------------------------------------------------------------------
312 ! F QUADRATIC FUNCTION ON SEGMENTS
313 ! ->
314 ! U QUADRATIC FUNCTIONS ON SEGMENTS
315 !
316  ELSEIF( ielmf.EQ.2 .AND.
317  & ielmu.EQ.2 .AND.
318  & ielmv.EQ.2 ) THEN
319 !
320  DO ielem =1,nelem
321 !
322 ! NUMBERING OF THE BOUNDARY NODES
323 !
324  n1 = ikle(ielem,1)
325  n2 = ikle(ielem,2)
326  n3 = ikle(ielem,3)
327 !
328 ! GLOBAL NUMBERING
329 !
330  f1 = f(n1)
331  f2 = f(n2)
332  f3 = f(n3)
333 !
334  u1 = u(n1)
335  u2 = u(n2)
336  u3 = u(n3)
337 !
338  v1 = v(n1)
339  v2 = v(n2)
340  v3 = v(n3)
341 !
342 ! DETERMINES THE BASE FUNCTIONS AT THE BOUNDARY:
343 !
344  vx1 = xsur60 *(9.d0*f1*u1-f1*u2+12.d0*f1*u3+f2*(u1+u2)+8.d0*f2*u3)
345  vy1 = xsur60 *(9.d0*f1*v1-f1*v2+12.d0*f1*v3+f2*(v1+v2)+8.d0*f2*v3)
346  vx2 = xsur60 *(f1*(u1+u2)+8.d0*f1*u3-f2*u1+9.d0*f2*u2+12.d0*f2*u3)
347  vy2 = xsur60 *(f1*(v1+v2)+8.d0*f1*v3-f2*v1+9.d0*f2*v2+12.d0*f2*v3)
348 !
349  w1(ielem) = lgseg(ielem) * ( vx1*xnor(ielem) + vy1*ynor(ielem) )
350  w2(ielem) = lgseg(ielem) * ( vx2*xnor(ielem) + vy2*ynor(ielem) )
351 !
352  ENDDO ! IELEM
353 !
354 !
355 !-----------------------------------------------------------------------
356  ELSE
357 !
358 !-----------------------------------------------------------------------
359 !
360  WRITE(lu,110)
361  WRITE(lu,111) ielmf,sf%NAME
362  WRITE(lu,112) ielmu,su%NAME
363  WRITE(lu,113) ielmv,sv%NAME
364  WRITE(lu,114)
365 110 FORMAT(1x,'VC10OO (BIEF):')
366 111 FORMAT(1x,'DISCRETIZATION OF F:',1i6,
367  & 1x,'REAL NAME: ',a6)
368 112 FORMAT(1x,'DISCRETIZATION OF U:',1i6,
369  & 1x,'REAL NAME: ',a6)
370 113 FORMAT(1x,'DISCRETIZATION OF V:',1i6,
371  & 1x,'REAL NAME: ',a6)
372 114 FORMAT(1x,'CASE NOT IMPLEMENTED')
373  CALL plante(1)
374  stop
375 !
376  ENDIF
377 !
378 !-----------------------------------------------------------------------
379 !
380  RETURN
381  END
subroutine vc10oo(XMUL, SF, SU, SV, F, U, V, XNOR, YNOR, LGSEG, IKLE, NBOR, NELEM, NELMAX, W1, W2)
Definition: vc10oo.f:8
Definition: bief.f:3