The TELEMAC-MASCARET system  trunk
as3_1313_q.f
Go to the documentation of this file.
1 ! *********************
2  SUBROUTINE as3_1313_q
3 ! *********************
4 !
5  &(xm,nseg1,xmt,dim1xmt,dim2xmt,stoxmt,nelmax,nelem,eltseg,oriseg)
6 !
7 !***********************************************************************
8 ! BIEF V6P1 21/08/2010
9 !***********************************************************************
10 !
11 !brief ASSEMBLES MATRICES EXTRA-DIAGONAL TERMS
12 !+ IN THE CASE OF EDGE-BASED STORAGE.
13 !+
14 !+ CASE OF QUADRATIC TRIANGLE AND NON SYMMETRICAL MATRIX.
15 !code
16 !+ LOCAL NUMBERING OF SEGMENTS IN A TRIANGLE
17 !+
18 !+ 01 --> 1 - 2
19 !+ 02 --> 2 - 3
20 !+ 03 --> 3 - 1
21 !+ 04 --> 1 - 4
22 !+ 05 --> 2 - 5
23 !+ 06 --> 3 - 6
24 !+ 07 --> 2 - 4
25 !+ 08 --> 3 - 5
26 !+ 09 --> 1 - 6
27 !+ 10 --> 1 - 5
28 !+ 11 --> 2 - 6
29 !+ 12 --> 3 - 4
30 !+ 13 --> 4 - 5
31 !+ 14 --> 5 - 6
32 !+ 15 --> 6 - 4
33 !+
34 !+ LOCAL NUMBERING OF ELEMENT BY ELEMENT EXTRA-DIAGONAL TERMS
35 !+
36 !+ 01 : POINTS 1-2 16 : POINTS 2-1
37 !+ 02 : POINTS 1-3 17 : POINTS 3-1
38 !+ 03 : POINTS 1-4 18 : POINTS 4-1
39 !+ 04 : POINTS 1-5 19 : POINTS 5-1
40 !+ 05 : POINTS 1-6 20 : POINTS 6-1
41 !+ 06 : POINTS 2-3 21 : POINTS 3-2
42 !+ 07 : POINTS 2-4 22 : POINTS 4-2
43 !+ 08 : POINTS 2-5 23 : POINTS 5-2
44 !+ 09 : POINTS 2-6 24 : POINTS 6-2
45 !+ 10 : POINTS 3-4 25 : POINTS 4-3
46 !+ 11 : POINTS 3-5 26 : POINTS 5-3
47 !+ 12 : POINTS 3-6 27 : POINTS 6-3
48 !+ 13 : POINTS 4-5 28 : POINTS 5-4
49 !+ 14 : POINTS 4-6 29 : POINTS 6-4
50 !+ 15 : POINTS 5-6 30 : POINTS 6-5
51 !
52 !history J-M HERVOUET (LNHE)
53 !+ 05/02/2010
54 !+ V6P0
55 !+
56 !
57 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
58 !+ 13/07/2010
59 !+ V6P0
60 !+ Translation of French comments within the FORTRAN sources into
61 !+ English comments
62 !
63 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
64 !+ 21/08/2010
65 !+ V6P0
66 !+ Creation of DOXYGEN tags for automated documentation and
67 !+ cross-referencing of the FORTRAN sources
68 !
69 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
70 !| DIM1XMT |-->| FIRST DIMENSION OF XMT
71 !| DIM2XMT |-->| SECOND DIMENSION OF XMT
72 !| ELTSEG |-->| SEGMENTS OF A TRIANGLE
73 !| NELEM |-->| NUMBER OF ELEMENTS IN THE MESH
74 !| NELMAX |-->| FIRST DIMENSION OF IKLE AND W.
75 !| NSEG1 |-->| NUMBER OF SEGMENTS
76 !| ORISEG |-->| ORIENTATION OF SEGMENTS
77 !| STOXMT |-->| STORAGE OF XMT 1: (NELMAX,*)
78 !| | | 2: (*,NELMAX)
79 !| XM |<--| ASSEMBLED OFF-DIAGONAL TERMS XA12,23,31
80 !| XMT |-->| ELEMENT BY ELEMENT STORAGE OF MATRIX
81 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
82 !
83  USE declarations_special
84  IMPLICIT NONE
85 !
86 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
87 !
88  INTEGER , INTENT(IN) :: NELMAX,NELEM,NSEG1
89  INTEGER , INTENT(IN) :: DIM1XMT,DIM2XMT,STOXMT
90  INTEGER , INTENT(IN) :: ELTSEG(nelmax,15)
91  INTEGER , INTENT(IN) :: ORISEG(nelmax,15)
92  DOUBLE PRECISION, INTENT(IN) :: XMT(dim1xmt,dim2xmt)
93  DOUBLE PRECISION, INTENT(INOUT) :: XM(nseg1,2)
94 !
95 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
96 !
97  INTEGER ISEG,IELEM
98 !
99 !-----------------------------------------------------------------------
100 !
101 ! INITIALISES
102 !
103  DO iseg = 1 , nseg1
104  xm(iseg,1) = 0.d0
105  xm(iseg,2) = 0.d0
106  ENDDO
107 !
108 !-----------------------------------------------------------------------
109 !
110  IF(stoxmt.EQ.1) THEN
111 !
112 ! ASSEMBLES
113 !
114  DO ielem = 1,nelem
115 !
116 ! SEGMENT 01 (TERMS 1-2 AND 2-1)
117  xm(eltseg(ielem,01),oriseg(ielem,01))
118  & = xm(eltseg(ielem,01),oriseg(ielem,01)) + xmt(ielem,01)
119  xm(eltseg(ielem,01),3-oriseg(ielem,01))
120  & = xm(eltseg(ielem,01),3-oriseg(ielem,01)) + xmt(ielem,16)
121 !
122 ! SEGMENT 02 (TERMS 2-3 AND 3-2)
123  xm(eltseg(ielem,02),oriseg(ielem,02))
124  & = xm(eltseg(ielem,02),oriseg(ielem,02)) + xmt(ielem,06)
125  xm(eltseg(ielem,02),3-oriseg(ielem,02))
126  & = xm(eltseg(ielem,02),3-oriseg(ielem,02)) + xmt(ielem,21)
127 !
128 ! SEGMENT 03 (TERMS 3-1 AND 1-3)
129  xm(eltseg(ielem,03),oriseg(ielem,03))
130  & = xm(eltseg(ielem,03),oriseg(ielem,03)) + xmt(ielem,17)
131  xm(eltseg(ielem,03),3-oriseg(ielem,03))
132  & = xm(eltseg(ielem,03),3-oriseg(ielem,03)) + xmt(ielem,02)
133 !
134 ! SEGMENT 04 (TERMS 1-4 AND 4-1)
135  xm(eltseg(ielem,04),1)=xm(eltseg(ielem,04),1)+xmt(ielem,03)
136  xm(eltseg(ielem,04),2)=xm(eltseg(ielem,04),2)+xmt(ielem,18)
137 !
138 ! SEGMENT 05 (TERMS 2-5 AND 5-2)
139  xm(eltseg(ielem,05),1)=xm(eltseg(ielem,05),1)+xmt(ielem,08)
140  xm(eltseg(ielem,05),2)=xm(eltseg(ielem,05),2)+xmt(ielem,23)
141 !
142 ! SEGMENT 06 (TERMS 3-6 AND 6-3)
143  xm(eltseg(ielem,06),1)=xm(eltseg(ielem,06),1)+xmt(ielem,12)
144  xm(eltseg(ielem,06),2)=xm(eltseg(ielem,06),2)+xmt(ielem,27)
145 !
146 ! SEGMENT 7 (TERMS 2-4 AND 4-2)
147  xm(eltseg(ielem,07),1)=xm(eltseg(ielem,07),1)+xmt(ielem,07)
148  xm(eltseg(ielem,07),2)=xm(eltseg(ielem,07),2)+xmt(ielem,22)
149 !
150 ! SEGMENT 8 (TERMS 3-5 AND 5-3)
151  xm(eltseg(ielem,08),1)=xm(eltseg(ielem,08),1)+xmt(ielem,11)
152  xm(eltseg(ielem,08),2)=xm(eltseg(ielem,08),2)+xmt(ielem,26)
153 !
154 ! SEGMENT 9 (TERMS 1-6 AND 6-1)
155  xm(eltseg(ielem,09),1)=xm(eltseg(ielem,09),1)+xmt(ielem,05)
156  xm(eltseg(ielem,09),2)=xm(eltseg(ielem,09),2)+xmt(ielem,20)
157 !
158 ! SEGMENT 10 (TERMS 1-5 AND 5-1)
159  xm(eltseg(ielem,10),1)=xm(eltseg(ielem,10),1)+xmt(ielem,04)
160  xm(eltseg(ielem,10),2)=xm(eltseg(ielem,10),2)+xmt(ielem,19)
161 !
162 ! SEGMENT 11 (TERMS 2-6 AND 6-2)
163  xm(eltseg(ielem,11),1)=xm(eltseg(ielem,11),1)+xmt(ielem,09)
164  xm(eltseg(ielem,11),2)=xm(eltseg(ielem,11),2)+xmt(ielem,24)
165 !
166 ! SEGMENT 12 (TERMS 3-4 AND 4-3)
167  xm(eltseg(ielem,12),1)=xm(eltseg(ielem,12),1)+xmt(ielem,10)
168  xm(eltseg(ielem,12),2)=xm(eltseg(ielem,12),2)+xmt(ielem,25)
169 !
170 ! SEGMENT 13 (TERMS 4-5 AND 5-4)
171  xm(eltseg(ielem,13),1)=xm(eltseg(ielem,13),1)+xmt(ielem,13)
172  xm(eltseg(ielem,13),2)=xm(eltseg(ielem,13),2)+xmt(ielem,28)
173 !
174 ! SEGMENT 14 (TERMS 5-6 AND 6-5)
175  xm(eltseg(ielem,14),1)=xm(eltseg(ielem,14),1)+xmt(ielem,15)
176  xm(eltseg(ielem,14),2)=xm(eltseg(ielem,14),2)+xmt(ielem,30)
177 !
178 ! SEGMENT 15 (TERMS 6-4 AND 4-6)
179  xm(eltseg(ielem,15),1)=xm(eltseg(ielem,15),1)+xmt(ielem,29)
180  xm(eltseg(ielem,15),2)=xm(eltseg(ielem,15),2)+xmt(ielem,14)
181 !
182  ENDDO
183 !
184 !-----------------------------------------------------------------------
185 !
186  ELSEIF(stoxmt.EQ.2) THEN
187 !
188 ! ASSEMBLES
189 !
190  DO ielem = 1,nelem
191 !
192 ! SEGMENT 01 (TERMS 1-2 AND 2-1)
193  xm(eltseg(ielem,01),oriseg(ielem,01))
194  & = xm(eltseg(ielem,01),oriseg(ielem,01)) + xmt(01,ielem)
195  xm(eltseg(ielem,01),3-oriseg(ielem,01))
196  & = xm(eltseg(ielem,01),3-oriseg(ielem,01)) + xmt(16,ielem)
197 !
198 ! SEGMENT 02 (TERMS 2-3 AND 3-2)
199  xm(eltseg(ielem,02),oriseg(ielem,02))
200  & = xm(eltseg(ielem,02),oriseg(ielem,02)) + xmt(06,ielem)
201  xm(eltseg(ielem,02),3-oriseg(ielem,02))
202  & = xm(eltseg(ielem,02),3-oriseg(ielem,02)) + xmt(21,ielem)
203 !
204 ! SEGMENT 03 (TERMS 3-1 AND 1-3)
205  xm(eltseg(ielem,03),oriseg(ielem,03))
206  & = xm(eltseg(ielem,03),oriseg(ielem,03)) + xmt(17,ielem)
207  xm(eltseg(ielem,03),3-oriseg(ielem,03))
208  & = xm(eltseg(ielem,03),3-oriseg(ielem,03)) + xmt(02,ielem)
209 !
210 ! SEGMENT 04 (TERMS 1-4 AND 4-1)
211  xm(eltseg(ielem,04),1)=xm(eltseg(ielem,04),1)+xmt(03,ielem)
212  xm(eltseg(ielem,04),2)=xm(eltseg(ielem,04),2)+xmt(18,ielem)
213 !
214 ! SEGMENT 05 (TERMS 2-5 AND 5-2)
215  xm(eltseg(ielem,05),1)=xm(eltseg(ielem,05),1)+xmt(08,ielem)
216  xm(eltseg(ielem,05),2)=xm(eltseg(ielem,05),2)+xmt(23,ielem)
217 !
218 ! SEGMENT 06 (TERMS 3-6 AND 6-3)
219  xm(eltseg(ielem,06),1)=xm(eltseg(ielem,06),1)+xmt(12,ielem)
220  xm(eltseg(ielem,06),2)=xm(eltseg(ielem,06),2)+xmt(27,ielem)
221 !
222 ! SEGMENT 7 (TERMS 2-4 AND 4-2)
223  xm(eltseg(ielem,07),1)=xm(eltseg(ielem,07),1)+xmt(07,ielem)
224  xm(eltseg(ielem,07),2)=xm(eltseg(ielem,07),2)+xmt(22,ielem)
225 !
226 ! SEGMENT 8 (TERMS 3-5 AND 5-3)
227  xm(eltseg(ielem,08),1)=xm(eltseg(ielem,08),1)+xmt(11,ielem)
228  xm(eltseg(ielem,08),2)=xm(eltseg(ielem,08),2)+xmt(26,ielem)
229 !
230 ! SEGMENT 9 (TERMS 1-6 AND 6-1)
231  xm(eltseg(ielem,09),1)=xm(eltseg(ielem,09),1)+xmt(05,ielem)
232  xm(eltseg(ielem,09),2)=xm(eltseg(ielem,09),2)+xmt(20,ielem)
233 !
234 ! SEGMENT 10 (TERMS 1-5 AND 5-1)
235  xm(eltseg(ielem,10),1)=xm(eltseg(ielem,10),1)+xmt(04,ielem)
236  xm(eltseg(ielem,10),2)=xm(eltseg(ielem,10),2)+xmt(19,ielem)
237 !
238 ! SEGMENT 11 (TERMS 2-6 AND 6-2)
239  xm(eltseg(ielem,11),1)=xm(eltseg(ielem,11),1)+xmt(09,ielem)
240  xm(eltseg(ielem,11),2)=xm(eltseg(ielem,11),2)+xmt(24,ielem)
241 !
242 ! SEGMENT 12 (TERMS 3-4 AND 4-3)
243  xm(eltseg(ielem,12),1)=xm(eltseg(ielem,12),1)+xmt(10,ielem)
244  xm(eltseg(ielem,12),2)=xm(eltseg(ielem,12),2)+xmt(25,ielem)
245 !
246 ! SEGMENT 13 (TERMS 4-5 AND 5-4)
247  xm(eltseg(ielem,13),1)=xm(eltseg(ielem,13),1)+xmt(13,ielem)
248  xm(eltseg(ielem,13),2)=xm(eltseg(ielem,13),2)+xmt(28,ielem)
249 !
250 ! SEGMENT 14 (TERMS 5-6 AND 6-5)
251  xm(eltseg(ielem,14),1)=xm(eltseg(ielem,14),1)+xmt(15,ielem)
252  xm(eltseg(ielem,14),2)=xm(eltseg(ielem,14),2)+xmt(30,ielem)
253 !
254 ! SEGMENT 15 (TERMS 6-4 AND 4-6)
255  xm(eltseg(ielem,15),1)=xm(eltseg(ielem,15),1)+xmt(29,ielem)
256  xm(eltseg(ielem,15),2)=xm(eltseg(ielem,15),2)+xmt(14,ielem)
257 !
258  ENDDO
259 !
260 !-----------------------------------------------------------------------
261 !
262  ELSE
263  WRITE(lu,*) 'AS3_1313_Q: UNKNOWN STORAGE OF XMT : ',stoxmt
264  CALL plante(1)
265  stop
266  ENDIF
267 !
268 !-----------------------------------------------------------------------
269 !
270  RETURN
271  END
declarations_special
Definition: declarations_special.F:3
as3_1313_q
subroutine as3_1313_q(XM, NSEG1, XMT, DIM1XMT, DIM2XMT, STOXMT, NELMAX, NELEM, ELTSEG, ORISEG)
Definition: as3_1313_q.f:7
declarations_special::lu
integer lu
Definition: declarations_special.F:45
Generated on Tue Jan 5 2021 14:36:11 for The TELEMAC-MASCARET system by doxygen 1.8.13