The TELEMAC-MASCARET system  trunk
mt06ft.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mt06ft
3 ! *****************
4 !
5  &( a11 , a12 , a13 ,
6  & a22 , a23 ,
7  & a33 ,
8  & xmul,sf,f,x,y,z,ikle1,ikle2,ikle3,nbor,nelem,nelmax)
9 !
10 !***********************************************************************
11 ! BIEF V6P1 21/08/2010
12 !***********************************************************************
13 !
14 !brief COMPUTES THE COEFFICIENTS OF THE FOLLOWING MATRIX:
15 !code
16 !+ /
17 !+ A = / F * (P *P )*J(X,Y) DXDY
18 !+ I J /S I J
19 !+
20 !+ BY ELEMENTARY CELL;
21 !+ !! THE ELEMENT IS THE P1 TRIANGLE, BUT IN A MESH OF PRISMS !!
22 !+ !! SPLIT IN TETRAHEDRONS !!
23 !+
24 !+ J(X,Y): JACOBIAN OF THE ISOPARAMETRIC TRANSFORMATION
25 !
26 !warning THE JACOBIAN MUST BE POSITIVE
27 !
28 !history J-M HERVOUET (LNH)
29 !+ 26/04/04
30 !+ V5P5
31 !+
32 !
33 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
34 !+ 13/07/2010
35 !+ V6P0
36 !+ Translation of French comments within the FORTRAN sources into
37 !+ English comments
38 !
39 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
40 !+ 21/08/2010
41 !+ V6P0
42 !+ Creation of DOXYGEN tags for automated documentation and
43 !+ cross-referencing of the FORTRAN sources
44 !
45 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 !| A11 |<--| ELEMENTS OF MATRIX
47 !| A12 |<--| ELEMENTS OF MATRIX
48 !| A13 |<--| ELEMENTS OF MATRIX
49 !| A22 |<--| ELEMENTS OF MATRIX
50 !| A23 |<--| ELEMENTS OF MATRIX
51 !| A33 |<--| ELEMENTS OF MATRIX
52 !| F |-->| FUNCTION F USED IN THE FORMULA
53 !| IKLE1 |-->| FIRST POINTS OF TRIANGLES
54 !| IKLE2 |-->| SECOND POINTS OF TRIANGLES
55 !| IKLE3 |-->| THIRD POINTS OF TRIANGLES
56 !| NBOR |-->| GLOBAL NUMBER OF BOUNDARY POINTS
57 !| NELEM |-->| NUMBER OF ELEMENTS
58 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
59 !| SF |-->| BIEF_OBJ STRUCTURE OF F
60 !| SURFAC |-->| AREA OF TRIANGLES
61 !| XMUL |-->| MULTIPLICATION FACTOR
62 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
63 !
64  USE bief, ex_mt06ft => mt06ft
65 !
67  IMPLICIT NONE
68 !
69 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
70 !
71  INTEGER, INTENT(IN) :: NBOR(*),NELEM,NELMAX
72  INTEGER, INTENT(IN) :: IKLE1(nelmax),IKLE2(nelmax),IKLE3(nelmax)
73 !
74  DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
75  DOUBLE PRECISION, INTENT(INOUT) :: A22(*),A23(*)
76  DOUBLE PRECISION, INTENT(INOUT) :: A33(*)
77 !
78  DOUBLE PRECISION, INTENT(IN) :: XMUL
79  DOUBLE PRECISION, INTENT(IN) :: F(*)
80 !
81 ! STRUCTURE OF F
82  TYPE(bief_obj), INTENT(IN) :: SF
83 !
84  DOUBLE PRECISION, INTENT(IN) :: X(*),Y(*),Z(*)
85 !
86 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
87 !
88  INTRINSIC sqrt
89 !
90 !-----------------------------------------------------------------------
91 !
92 ! DECLARATIONS SPECIFIC TO THIS SUBROUTINE
93 !
94  INTEGER IELMF,I1,I2,I3,IELEM
95 !
96  DOUBLE PRECISION SUR60,S,X1,X2,X3,Y1,Y2,Y3,Z1,Z2,Z3,F1,F2,F3,F123
97  DOUBLE PRECISION DET1,DET2
98 !
99 !**********************************************************************
100 !
101  ielmf=sf%ELM
102 !
103 !-----------------------------------------------------------------------
104 !
105 ! F LINEAR BY BOUNDARY SIDE
106 !
107  IF(ielmf.EQ.61.OR.ielmf.EQ.81) THEN
108 !
109  sur60 = xmul/60.d0
110 !
111 ! LOOP ON THE BOUNDARY SIDES
112 !
113  DO ielem = 1,nelem
114 !
115 ! GLOBAL NUMBERING OF THE SIDE VERTICES
116 !
117  i1 = nbor(ikle1(ielem))
118  i2 = nbor(ikle2(ielem))
119  i3 = nbor(ikle3(ielem))
120 !
121  x1 = x(i1)
122  y1 = y(i1)
123  z1 = z(i1)
124 !
125  x2 = x(i2)-x1
126  x3 = x(i3)-x1
127  y2 = y(i2)-y1
128  y3 = y(i3)-y1
129  z2 = z(i2)-z1
130  z3 = z(i3)-z1
131 !
132  f1 = f(ikle1(ielem))
133  f2 = f(ikle2(ielem))
134  f3 = f(ikle3(ielem))
135  f123 = f1 + f2 + f3
136 !
137 ! COMPUTES THE AREA OF THE TRIANGLE (BY VECTOR PRODUCT)
138 !
139  s=0.5d0*sqrt( (y2*z3-y3*z2)**2
140  & +(x3*z2-x2*z3)**2
141  & +(x2*y3-x3*y2)**2 )
142 !
143  det1 = s * sur60
144  det2 = det1 + det1
145 !
146 !***********************************************************************
147 !
148 ! ELEMENTS OFF THE DIAGONAL
149 !
150  a12(ielem) = det1 * (f123+f123-f3)
151  a13(ielem) = det1 * (f123+f123-f2)
152  a23(ielem) = det1 * (f123+f123-f1)
153 !
154 ! DIAGONAL TERMS
155 !
156  a11(ielem) = det2 * (f123+f1+f1)
157  a22(ielem) = det2 * (f123+f2+f2)
158  a33(ielem) = det2 * (f123+f3+f3)
159 !
160  ENDDO ! IELEM
161 !
162 !-----------------------------------------------------------------------
163 !
164 ! OTHER TYPES OF DISCRETISATION OF F
165 !
166  ELSE
167 !
168  WRITE(lu,101) ielmf,sf%NAME
169 101 FORMAT(1x,'MT06FT (BIEF) :',/,
170  & 1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
171  & 1x,'REAL NAME: ',a6)
172  CALL plante(1)
173  stop
174 !
175  ENDIF
176 !
177 !-----------------------------------------------------------------------
178 !
179 ! NOTE: ON A TRIANGULAR MESH IN PLANE (X, Y)
180 !
181 ! DO IELEM = 1 , NELEM
182 !
183 ! F1 = F(IKLE1(IELEM))
184 ! F2 = F(IKLE2(IELEM))
185 ! F3 = F(IKLE3(IELEM))
186 !
187 ! F123 = F1 + F2 + F3
188 !
189 ! DET1 = SURFAC(IELEM) * SUR60
190 ! DET2 = DET1 + DET1
191 !
192 !***********************************************************************
193 !
194 ! ELEMENTS OFF THE DIAGONAL
195 !
196 ! A12(IELEM) = DET1 * (F123+F123-F3)
197 ! A13(IELEM) = DET1 * (F123+F123-F2)
198 ! A23(IELEM) = DET1 * (F123+F123-F1)
199 !
200 ! DIAGONAL TERMS
201 !
202 ! A11(IELEM) = DET2 * (F123+F1+F1)
203 ! A22(IELEM) = DET2 * (F123+F2+F2)
204 ! A33(IELEM) = DET2 * (F123+F3+F3)
205 !
206 ! ENDDO ! IELEM
207 !
208 !-----------------------------------------------------------------------
209 !
210  RETURN
211  END
subroutine mt06ft(A11, A12, A13, A22, A23, A33, XMUL, SF, F, X, Y, Z, IKLE1, IKLE2, IKLE3, NBOR, NELEM, NELMAX)
Definition: mt06ft.f:10
Definition: bief.f:3