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