The TELEMAC-MASCARET system  trunk
mt03aa.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mt03aa
3 ! *****************
4 !
5  &( a11 , a12 , a13 ,
6  & a21 , a22 , a23 ,
7  & a31 , a32 , a33 ,
8  & xmul,sf,sg,su,sv,f,g,u,v,
9  & xel,yel,surfac,ikle1,ikle2,ikle3,ikle4,nelem,nelmax)
10 !
11 !***********************************************************************
12 ! BIEF V6P1 21/08/2010
13 !***********************************************************************
14 !
15 !brief COMPUTES THE COEFFICIENTS OF THE FOLLOWING MATRIX:
16 !code
17 !+ / --> - --> --> --->
18 !+ A(I,J) = XMUL / KEL . GRAD(PSI1(I)) * U . GRAD(PSI2(J)) D(OMEGA)
19 !+ /OMEGA
20 !+ -->
21 !+ KEL CONSTANT VECTOR ON THE ELEMENT, WITH COMPONENTS F AND G
22 !
23 !warning THE JACOBIAN MUST BE POSITIVE
24 !
25 !history J-M HERVOUET (LNH) ; C MOULIN (LNH)
26 !+ 12/04/93
27 !+ V5P1
28 !+
29 !
30 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
31 !+ 13/07/2010
32 !+ V6P0
33 !+ Translation of French comments within the FORTRAN sources into
34 !+ English comments
35 !
36 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
37 !+ 21/08/2010
38 !+ V6P0
39 !+ Creation of DOXYGEN tags for automated documentation and
40 !+ cross-referencing of the FORTRAN sources
41 !
42 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
43 !| A11 |<--| ELEMENTS OF MATRIX
44 !| A12 |<--| ELEMENTS OF MATRIX
45 !| A13 |<--| ELEMENTS OF MATRIX
46 !| A21 |<--| ELEMENTS OF MATRIX
47 !| A22 |<--| ELEMENTS OF MATRIX
48 !| A23 |<--| ELEMENTS OF MATRIX
49 !| A31 |<--| ELEMENTS OF MATRIX
50 !| A32 |<--| ELEMENTS OF MATRIX
51 !| A33 |<--| ELEMENTS OF MATRIX
52 !| F |-->| FUNCTION USED IN THE FORMULA
53 !| G |-->| FUNCTION USED IN THE FORMULA
54 !| IKLE1 |-->| FIRST POINTS OF TRIANGLES
55 !| IKLE2 |-->| SECOND POINTS OF TRIANGLES
56 !| IKLE3 |-->| THIRD POINTS OF TRIANGLES
57 !| IKLE4 |-->| QUASI-BUBBLE POINT
58 !| NELEM |-->| NUMBER OF ELEMENTS
59 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
60 !| SF |-->| STRUCTURE OF FUNCTIONS F
61 !| SG |-->| STRUCTURE OF FUNCTIONS G
62 !| SU |-->| BIEF_OBJ STRUCTURE OF U
63 !| SURFAC |-->| AREA OF TRIANGLES
64 !| SV |-->| BIEF_OBJ STRUCTURE OF V
65 !| U |-->| FUNCTION U USED IN THE FORMULA
66 !| V |-->| FUNCTION V USED IN THE FORMULA
67 !| XEL |-->| ABSCISSAE OF POINTS IN THE MESH, PER ELEMENT
68 !| YEL |-->| ORDINATES OF POINTS IN THE MESH, PER ELEMENT
69 !| XMUL |-->| MULTIPLICATION FACTOR
70 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
71 !
72  USE bief, ex_mt03aa => mt03aa
73 !
74  USE declarations_special
75  IMPLICIT NONE
76 !
77 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
78 !
79  INTEGER, INTENT(IN) :: NELEM,NELMAX
80  INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax)
81  INTEGER, INTENT(IN) :: IKLE3(nelmax),IKLE4(nelmax)
82 !
83  DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
84  DOUBLE PRECISION, INTENT(INOUT) :: A21(*),A22(*),A23(*)
85  DOUBLE PRECISION, INTENT(INOUT) :: A31(*),A32(*),A33(*)
86 !
87  DOUBLE PRECISION, INTENT(IN) :: XMUL
88  DOUBLE PRECISION, INTENT(IN) :: F(*),G(*),U(*),V(*)
89 !
90 ! STRUCTURES OF F, G, U, V
91  TYPE(bief_obj), INTENT(IN) :: SF,SG,SU,SV
92 !
93  DOUBLE PRECISION, INTENT(IN) :: XEL(nelmax,3),YEL(nelmax,3)
94  DOUBLE PRECISION, INTENT(IN) :: SURFAC(nelmax)
95 !
96 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
97 !
98 ! DECLARATIONS SPECIFIC TO THIS SUBROUTINE
99 !
100  INTEGER IELMF,IELMG,IELMU,IELMV,IELEM
101 !
102  DOUBLE PRECISION SUR12,SUR36,X2,X3,Y2,Y3,U1,U2,U3,U4,V1,V2,V3,V4
103  DOUBLE PRECISION V123,U123,DEN,KKX,KKY,AUX1,AUX2,AUX3,AUX4
104 !
105 !-----------------------------------------------------------------------
106 !
107  sur12 = xmul/12.d0
108  sur36 = xmul/36.d0
109 !
110 !-----------------------------------------------------------------------
111 !
112  ielmf = sf%ELM
113  ielmg = sg%ELM
114  ielmu = su%ELM
115  ielmv = sv%ELM
116 !
117  IF(ielmf.EQ.10.AND.ielmg.EQ.10.AND.
118  & ielmu.EQ.11.AND.ielmv.EQ.11) THEN
119 !
120 ! LOOP ON THE ELEMENTS
121 !
122  DO ielem = 1 , nelem
123 !
124  x2 = xel(ielem,2)
125  x3 = xel(ielem,3)
126  y2 = yel(ielem,2)
127  y3 = yel(ielem,3)
128 !
129  u1 = u(ikle1(ielem))
130  u2 = u(ikle2(ielem))
131  u3 = u(ikle3(ielem))
132  v1 = v(ikle1(ielem))
133  v2 = v(ikle2(ielem))
134  v3 = v(ikle3(ielem))
135 !
136  u123 = u1 + u2 + u3
137  v123 = v1 + v2 + v3
138 !
139  den = sur12 / surfac(ielem)
140  kkx = f(ielem)*den
141  kky = g(ielem)*den
142 !
143  aux1 = x2 * v123 - y2 * u123
144  aux2 = x3 * v123 - y3 * u123
145  aux3 = x2 * kky - y2 * kkx
146  aux4 = x3 * kky - y3 * kkx
147 !
148  a11(ielem) = ( aux1 - aux2 ) * ( aux3 - aux4 )
149  a22(ielem) = aux2 * aux4
150  a12(ielem) = aux2 * ( aux3 - aux4 )
151  a21(ielem) = ( aux1 - aux2 ) * aux4
152 !
153 ! USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
154 ! (SUM OF EACH LINE AND EACH COLUMN IS 0)
155 !
156  a13(ielem) = - a11(ielem) - a12(ielem)
157  a23(ielem) = - a22(ielem) - a21(ielem)
158  a31(ielem) = - a11(ielem) - a21(ielem)
159  a32(ielem) = - a22(ielem) - a12(ielem)
160  a33(ielem) = - a13(ielem) - a23(ielem)
161 !
162  ENDDO ! IELEM
163 !
164 !-----------------------------------------------------------------------
165 !
166  ELSEIF(ielmf.EQ.10.AND.ielmg.EQ.10.AND.ielmu.EQ.12) THEN
167 !
168 ! LOOP ON THE ELEMENTS
169 !
170  DO ielem = 1 , nelem
171 !
172  x2 = xel(ielem,2)
173  x3 = xel(ielem,3)
174  y2 = yel(ielem,2)
175  y3 = yel(ielem,3)
176 !
177  u1 = u(ikle1(ielem))
178  u2 = u(ikle2(ielem))
179  u3 = u(ikle3(ielem))
180  u4 = u(ikle4(ielem))
181  v1 = v(ikle1(ielem))
182  v2 = v(ikle2(ielem))
183  v3 = v(ikle3(ielem))
184  v4 = v(ikle4(ielem))
185 !
186  den = sur36 / surfac(ielem)
187  kkx=f(ielem)*den
188  kky=g(ielem)*den
189 !
190  a11(ielem) = ((x2*kky-x3*kky+kkx*y3-kkx*y2)*(2*x2*v3+3*x2*v4+
191  & 2*x2*v2+2*x2*v1-2*x3*v3-3*x3*v4-2*x3*v2-2*x3*v1+2*
192  & u3*y3-2*u3*y2+3*u4*y3-3*u4*y2+2*u2*y3-2*u2*y2+2*u1*
193  & y3-2*u1*y2))
194  a22(ielem) = ((x3*kky-kkx*y3)*(2*x3*v3+3*x3*v4+2*x3*v2+2*
195  & x3*v1-2*u3*y3-3*u4*y3-2*u2*y3-2*u1*y3))
196  a12(ielem) = ((x2*kky-x3*kky+kkx*y3-kkx*y2)*(2*x3*v3+3*x3*v4+
197  & 2*x3*v2+2*x3*v1-2*u3*y3-3*u4*y3-2*u2*y3-2*u1*y3))
198  a21(ielem) = ((2*x2*v3+3*x2*v4+2*x2*v2+2*x2*v1-2*x3*v3-
199  & 3*x3*v4-2*x3*v2-2*x3*v1+2*u3*y3-2*u3*y2+3*u4*y3-3*
200  & u4*y2+2*u2*y3-2*u2*y2+2*u1*y3-2*u1*y2)*(x3*kky-kkx*y3))
201 !
202 ! USES HERE THE 'MAGIC SQUARE' PROPERTIES OF A DIFFUSION-LIKE MATRIX
203 ! (SUM OF EACH LINE AND EACH COLUMN IS 0)
204 !
205  a13(ielem) = - a11(ielem) - a12(ielem)
206  a23(ielem) = - a22(ielem) - a21(ielem)
207  a31(ielem) = - a11(ielem) - a21(ielem)
208  a32(ielem) = - a22(ielem) - a12(ielem)
209  a33(ielem) = - a13(ielem) - a23(ielem)
210 !
211  ENDDO ! IELEM
212 ! OTHER TYPES OF FUNCTIONS F AND G
213 !
214 !-----------------------------------------------------------------------
215 !
216  ELSE
217 !
218  WRITE(lu,101) ielmf,sf%NAME
219  WRITE(lu,111) ielmg,sg%NAME
220  WRITE(lu,201) ielmu,su%NAME
221  WRITE(lu,301)
222 101 FORMAT(1x,'MT03AA (BIEF) :',/,
223  & 1x,'DISCRETIZATION OF F:',1i6,
224  & 1x,'REAL NAME: ',a6)
225 111 FORMAT(1x,'DISCRETIZATION OF G:',1i6,
226  & 1x,'REAL NAME: ',a6)
227 201 FORMAT(1x,'DISCRETIZATION OF U:',1i6,
228  & 1x,'REAL NAME: ',a6)
229 301 FORMAT(1x,'CASE NOT IMPLEMENTED')
230  CALL plante(0)
231  stop
232 !
233  ENDIF
234 !
235 !-----------------------------------------------------------------------
236 !
237  RETURN
238  END
declarations_special
Definition: declarations_special.F:3
mt03aa
subroutine mt03aa(A11, A12, A13, A21, A22, A23, A31, A32, A33, XMUL, SF, SG, SU, SV, F, G, U, V, XEL, YEL, SURFAC, IKLE1, IKLE2, IKLE3, IKLE4, NELEM, NELMAX)
Definition: mt03aa.f:11
declarations_special::lu
integer lu
Definition: declarations_special.F:45
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:36:46 for The TELEMAC-MASCARET system by doxygen 1.8.13