The TELEMAC-MASCARET system  trunk
mt07cc.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE mt07cc
3 ! *****************
4 !
5  &( a11 , a12 , a13 , a14 , a15 , a16 ,
6  & a22 , a23 , a24 , a25 , a26 ,
7  & a33 , a34 , a35 , a36 ,
8  & a44 , a45 , a46 ,
9  & a55 , a56 ,
10  & a66 ,
11  & xmul,sf,f,surfac,nelem,nelmax)
12 !
13 !***********************************************************************
14 ! BIEF V6P1 21/08/2010
15 !***********************************************************************
16 !
17 !brief BUILDS THE FOLLOWING MATRIX
18 !+ FOR P2 TRIANGLES:
19 !code
20 !+ T*M + (1-T) *DM
21 !+
22 !+ M IS THE MASS MATRIX P2*P2
23 !+ DM IS MASS-LUMPED M
24 !+ T IS A VECTOR CONSTANT BY ELEMENT
25 !
26 !warning THE JACOBIAN MUST BE POSITIVE
27 !
28 !history A FROEHLY (MATMECA)
29 !+ 01/08/08
30 !+ V5P9
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 !| ... |<--| ELEMENTS OF MATRIX
48 !| A66 |<--| ELEMENTS OF MATRIX
49 !| F |-->| FUNCTION USED IN THE FORMULA
50 !| NELEM |-->| NUMBER OF ELEMENTS
51 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
52 !| SF |-->| STRUCTURE OF FUNCTIONS F
53 !| SURFAC |-->| AREA OF TRIANGLES
54 !| XMUL |-->| MULTIPLICATION FACTOR
55 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56 !
57  USE bief!, EX_MT07CC => MT07CC
58 !
60  IMPLICIT NONE
61 !
62 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
63 !
64  INTEGER, INTENT(IN) :: NELEM,NELMAX
65 !
66  DOUBLE PRECISION, INTENT(INOUT) :: A11(*),A12(*),A13(*)
67  DOUBLE PRECISION, INTENT(INOUT) :: A14(*),A15(*),A16(*)
68  DOUBLE PRECISION, INTENT(INOUT) :: A22(*),A23(*),A24(*)
69  DOUBLE PRECISION, INTENT(INOUT) :: A25(*),A26(*),A33(*)
70  DOUBLE PRECISION, INTENT(INOUT) :: A34(*),A35(*),A36(*)
71  DOUBLE PRECISION, INTENT(INOUT) :: A44(*),A45(*),A46(*)
72  DOUBLE PRECISION, INTENT(INOUT) :: A55(*),A56(*),A66(*)
73 !
74  DOUBLE PRECISION, INTENT(IN) :: XMUL
75  DOUBLE PRECISION, INTENT(IN) :: F(*)
76 !
77 ! STRUCTURE OF F
78  TYPE(bief_obj), INTENT(IN) :: SF
79 !
80  DOUBLE PRECISION, INTENT(IN) :: SURFAC(nelmax)
81 !
82 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
83 !
84 ! DECLARATIONS SPECIFIC TO THIS SUBROUTINE
85 !
86  DOUBLE PRECISION T,XSUR30,XSUR45,XSUR180
87  INTEGER IELEM
88 !
89 !=======================================================================
90 !
91  xsur30 = xmul/30.d0
92  xsur45 = xmul/45.d0
93  xsur180 = xmul/180.d0
94 !
95 !-----------------------------------------------------------------------
96 !
97  IF(sf%ELM.EQ.10) THEN
98 !
99 !-----------------------------------------------------------------------
100 !
101 ! P0 DISCRETISATION OF F:
102 !
103  DO ielem = 1 , nelem
104 !
105 ! INITIALISES THE INTERMEDIATE VARIABLES
106 !
107  t = f(ielem)
108 !
109 ! DIAGONAL TERMS
110 !
111 ! FOR P2 ELEMENTS, DM(1) = DM(2) = DM(3) = 0
112 ! AND DM(4) = DM(5) = DM(6) = S/3
113  a11(ielem) = t*surfac(ielem)*xsur30
114  a22(ielem) = a11(ielem)
115  a33(ielem) = a11(ielem)
116  a44(ielem) = (15.d0-7.d0*t)*surfac(ielem)*xsur45
117  a55(ielem) = a44(ielem)
118  a66(ielem) = a44(ielem)
119 !
120 ! EXTRADIAGONAL TERMS
121 !
122  a12(ielem) = -surfac(ielem)*t*xsur180
123  a13(ielem) = a12(ielem)
124  a14(ielem) = 0.d0
125  a15(ielem) = -surfac(ielem)*t*xsur45
126  a16(ielem) = 0.d0
127  a23(ielem) = a12(ielem)
128  a24(ielem) = 0.d0
129  a25(ielem) = 0.d0
130  a26(ielem) = a15(ielem)
131  a34(ielem) = a15(ielem)
132  a35(ielem) = 0.d0
133  a36(ielem) = 0.d0
134  a45(ielem) = (15.d0-11.d0*t)*surfac(ielem)*xsur45
135  a46(ielem) = a45(ielem)
136  a56(ielem) = a45(ielem)
137 !
138  ENDDO ! IELEM
139 !
140 !-----------------------------------------------------------------------
141 !
142 ! ANOTHER DISCRETISATION OF F
143 ! ELSEIF(SF%ELM.EQ.XX) THEN
144 !
145 !-----------------------------------------------------------------------
146 !
147  ELSE
148 !
149  WRITE(lu,101) sf%ELM,sf%NAME
150 101 FORMAT(1x,'MT07CC (BIEF) :',/,
151  & 1x,'DISCRETIZATION OF F NOT AVAILABLE:',1i6,
152  & 1x,'REAL NAME: ',a6)
153  CALL plante(1)
154  stop
155 !
156  ENDIF
157 !
158 !-----------------------------------------------------------------------
159 !
160  RETURN
161  END
subroutine mt07cc(A11, A12, A13, A14, A15, A16, A22, A23, A24, A25, A26, A33, A34, A35, A36, A44, A45, A46, A55, A56, A66, XMUL, SF, F, SURFAC, NELEM, NELMAX)
Definition: mt07cc.f:13
Definition: bief.f:3