The TELEMAC-MASCARET system  trunk
vc05ff.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE vc05ff
3 ! *****************
4 !
5  &(xmul,su,sv,u,v,x,y,z,
6  & ikle1,ikle2,ikle3,ikle4,nbor,neleb,nelebx,w1,w2,w3,w4,
7  & nelbor,nulone,nelmax)
8 !
9 !***********************************************************************
10 ! BIEF V6P3 21/08/2010
11 !***********************************************************************
12 !
13 !brief COMPUTES THE FOLLOWING VECTOR IN FINITE ELEMENTS:
14 !code
15 !+ / ->
16 !+ VEC(I) = XMUL / (U,V).N PSI(I) D(GAMMA)
17 !+ /GAMMA
18 !+
19 !+ PSI(I) IS A BASE OF TYPE P1 QUADRILATERAL
20 !
21 !warning THE JACOBIAN MUST BE POSITIVE
22 !warning THE RESULT IS IN W IN NOT ASSEMBLED FORM - REAL MESH
23 !
24 !history J-M HERVOUET (LNH)
25 !+ 24/07/2009
26 !+ V6P0
27 !+
28 !
29 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
30 !+ 13/07/2010
31 !+ V6P0
32 !+ Translation of French comments within the FORTRAN sources into
33 !+ English comments
34 !
35 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
36 !+ 21/08/2010
37 !+ V6P0
38 !+ Creation of DOXYGEN tags for automated documentation and
39 !+ cross-referencing of the FORTRAN sources
40 !
41 !history J-M HERVOUET (EDF R&D, LNHE)
42 !+ 11/012013
43 !+ V6P3
44 !+ Last 3 arguments added, use of XEL, YEL instead of XPT,YPT.
45 !
46 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
47 !| IKLE1 |-->| FIRST POINT OF QUADRILATERAL
48 !| IKLE2 |-->| SECOND POINT OF QUADRILATERAL
49 !| IKLE3 |-->| THIRD POINT OF QUADRILATERAL
50 !| IKLE4 |-->| FOURTH POINT OF QUADRILATERAL
51 !| NBOR |-->| GLOBAL NUMBER OF BOUNDARY POINTS
52 !| NELBOR |-->| ADJACENT ELEMENT NUMBER
53 !| NELEB |-->| NUMBER OF BOUNDARY ELEMENTS
54 !| NELEBX |-->| MAXIMUM NUMBER OF BOUNDARY ELEMENTS
55 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
56 !| NULONE |-->| LOCAL NUMBERING OF BOUNDARY ELEMENT IN ADJACENT
57 !| | | ELEMENT.
58 !| SU |-->| BIEF_OBJ STRUCTURE OF U
59 !| SV |-->| BIEF_OBJ STRUCTURE OF V
60 !| U |-->| FUNCTION USED IN THE VECTOR FORMULA
61 !| V |-->| FUNCTION USED IN THE VECTOR FORMULA
62 !| W1 |<--| RESULT IN NON ASSEMBLED FORM
63 !| W2 |<--| RESULT IN NON ASSEMBLED FORM
64 !| W3 |<--| RESULT IN NON ASSEMBLED FORM
65 !| W4 |<--| RESULT IN NON ASSEMBLED FORM
66 !| X |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
67 !| XMUL |-->| MULTIPLICATION COEFFICIENT
68 !| Y |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
69 !| Z |-->| ELEVATIONS OF POINTS IN THE MESH, PER POINT !!!!
70 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
71 !
72  USE bief, ex_vc05ff => vc05ff
73 !
75  IMPLICIT NONE
76 !
77 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
78 !
79  INTEGER, INTENT(IN) :: NELEB,NELEBX,NELMAX
80  INTEGER, INTENT(IN) :: NELBOR(nelebx),NULONE(nelebx,4),NBOR(*)
81  INTEGER, INTENT(IN) :: IKLE1(nelebx),IKLE2(nelebx)
82  INTEGER, INTENT(IN) :: IKLE3(nelebx),IKLE4(nelebx)
83 !
84  DOUBLE PRECISION, INTENT(IN) :: X(nelmax,6),Y(nelmax,6),Z(*)
85  DOUBLE PRECISION, INTENT(INOUT) :: W1(nelebx),W2(nelebx)
86  DOUBLE PRECISION, INTENT(INOUT) :: W3(nelebx),W4(nelebx)
87  DOUBLE PRECISION, INTENT(IN) :: XMUL
88 !
89 ! STRUCTURES OF U, V AND REAL DATA
90 !
91  TYPE(bief_obj), INTENT(IN) :: SU,SV
92  DOUBLE PRECISION, INTENT(IN) :: U(*),V(*)
93 !
94 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
95 !
96  INTEGER IELMU,IELMV,IELEM,N1,N2,N3,N4,I1,I2,I3,I4,J1,J2,IEL
97 !
98  DOUBLE PRECISION XSUR72,H1,H2,HT,AX,AY
99  DOUBLE PRECISION U1,U2,U3,U4,V1,V2,V3,V4
100 !
101 !-----------------------------------------------------------------------
102 !
103  ielmu=su%ELM
104  ielmv=sv%ELM
105 !
106 !-----------------------------------------------------------------------
107 !
108  xsur72 = xmul/72.d0
109 !
110 ! U LINEAR BY PRISMS
111 !
112 !-----------------------------------------------------------------------
113 !
114  IF(ielmu.EQ.71.AND.ielmv.EQ.71) THEN
115 !
116 !-----------------------------------------------------------------------
117 !
118 ! LOOP ON THE BOUNDARY SIDES
119 !
120  DO ielem = 1,neleb
121 !
122  iel=nelbor(ielem)
123 !
124  IF(iel.GT.0) THEN
125 !
126 ! ELEMENT IN THE DOMAIN
127 !
128 ! LOCAL NUMBERING OF THE SIDE NODES
129 !
130  i1 = ikle1(ielem)
131  i2 = ikle2(ielem)
132  i3 = ikle3(ielem)
133  i4 = ikle4(ielem)
134 !
135 ! GLOBAL NUMBERING OF THE SIDE NODES
136 !
137  n1 = nbor(i1)
138  n2 = nbor(i2)
139  n3 = nbor(i3)
140  n4 = nbor(i4)
141 !
142  h1 = z(n4) - z(n1)
143  h2 = z(n3) - z(n2)
144  ht = h1 + h2
145  h1 = h1 + h1 + ht
146  h2 = h2 + h2 + ht
147 !
148  j1=nulone(ielem,1)
149  j2=nulone(ielem,2)
150  ax = (y(iel,j2)-y(iel,j1)) * xsur72
151  ay = (x(iel,j1)-x(iel,j2)) * xsur72
152 ! AX = (Y(N2)-Y(N1)) * XSUR72
153 ! AY = (X(N1)-X(N2)) * XSUR72
154 !
155  u1 = u(i1) + u(i1) + u(i4)
156  u2 = u(i2) + u(i2) + u(i3)
157  u3 = u(i2) + u(i3) + u(i3)
158  u4 = u(i1) + u(i4) + u(i4)
159 !
160  v1 = v(i1) + v(i1) + v(i4)
161  v2 = v(i2) + v(i2) + v(i3)
162  v3 = v(i2) + v(i3) + v(i3)
163  v4 = v(i1) + v(i4) + v(i4)
164 !
165  w1(ielem) = (u1*h1+u2*ht)*ax + (v1*h1+v2*ht)*ay
166  w2(ielem) = (u1*ht+u2*h2)*ax + (v1*ht+v2*h2)*ay
167  w3(ielem) = (u4*ht+u3*h2)*ax + (v4*ht+v3*h2)*ay
168  w4(ielem) = (u4*h1+u3*ht)*ax + (v4*h1+v3*ht)*ay
169 !
170  ELSE
171 !
172 ! ELEMENT NOT IN THE DOMAIN (POSSIBLE IN PARALLELISM)
173 !
174  w1(ielem) = 0.d0
175  w2(ielem) = 0.d0
176  w3(ielem) = 0.d0
177  w4(ielem) = 0.d0
178 !
179  ENDIF
180 !
181  ENDDO
182 !
183 !-----------------------------------------------------------------------
184 !
185 !
186 !-----------------------------------------------------------------------
187 !
188  ELSEIF(ielmu.EQ.41.AND.ielmv.EQ.41) THEN
189 !
190 !-----------------------------------------------------------------------
191 !
192 ! LOOP ON THE BOUNDARY SIDES
193 !
194  DO ielem = 1,neleb
195 !
196  iel=nelbor(ielem)
197 !
198  IF(iel.GT.0) THEN
199 !
200 ! GLOBAL NUMBERING OF THE SIDE NODES
201 !
202  n1 = nbor(ikle1(ielem))
203  n2 = nbor(ikle2(ielem))
204  n3 = nbor(ikle3(ielem))
205  n4 = nbor(ikle4(ielem))
206 !
207  h1 = z(n4) - z(n1)
208  h2 = z(n3) - z(n2)
209  ht = h1 + h2
210  h1 = h1 + h1 + ht
211  h2 = h2 + h2 + ht
212 !
213  j1=nulone(ielem,1)
214  j2=nulone(ielem,2)
215  ax = (y(iel,j2)-y(iel,j1)) * xsur72
216  ay = (x(iel,j1)-x(iel,j2)) * xsur72
217 ! AX = (Y(N2)-Y(N1)) * XSUR72
218 ! AY = (X(N1)-X(N2)) * XSUR72
219 !
220  u1 = u(n1) + u(n1) + u(n4)
221  u2 = u(n2) + u(n2) + u(n3)
222  u3 = u(n2) + u(n3) + u(n3)
223  u4 = u(n1) + u(n4) + u(n4)
224 !
225  v1 = v(n1) + v(n1) + v(n4)
226  v2 = v(n2) + v(n2) + v(n3)
227  v3 = v(n2) + v(n3) + v(n3)
228  v4 = v(n1) + v(n4) + v(n4)
229 !
230  w1(ielem) = (u1*h1+u2*ht)*ax + (v1*h1+v2*ht)*ay
231  w2(ielem) = (u1*ht+u2*h2)*ax + (v1*ht+v2*h2)*ay
232  w3(ielem) = (u4*ht+u3*h2)*ax + (v4*ht+v3*h2)*ay
233  w4(ielem) = (u4*h1+u3*ht)*ax + (v4*h1+v3*ht)*ay
234 !
235  ELSE
236 !
237 ! ELEMENT NOT IN THE DOMAIN (PARALLELISM)
238 !
239  w1(ielem) = 0.d0
240  w2(ielem) = 0.d0
241  w3(ielem) = 0.d0
242  w4(ielem) = 0.d0
243 !
244  ENDIF
245 !
246  ENDDO
247 !
248 !-----------------------------------------------------------------------
249 !
250  ELSE
251 !
252 !-----------------------------------------------------------------------
253 !
254  WRITE(lu,101) ielmu,su%NAME
255 101 FORMAT(1x,'VC05FF (BIEF) :',/,
256  & 1x,'DISCRETIZATION OF U NOT AVAILABLE:',1i6,
257  & 1x,'REAL NAME: ',a6)
258  CALL plante(1)
259  stop
260 !
261  ENDIF
262 !
263 !-----------------------------------------------------------------------
264 !
265  RETURN
266  END
subroutine vc05ff(XMUL, SU, SV, U, V, X, Y, Z, IKLE1, IKLE2, IKLE3, IKLE4, NBOR, NELEB, NELEBX, W1, W2, W3, W4, NELBOR, NULONE, NELMAX)
Definition: vc05ff.f:9
Definition: bief.f:3