The TELEMAC-MASCARET system  trunk
comp_seg.f
Go to the documentation of this file.
1 ! *******************
2  SUBROUTINE comp_seg
3 ! *******************
4 !
5  &(nelem,nelmax,ielm,ikle,gloseg,maxseg,eltseg,oriseg,nseg)
6 !
7 !***********************************************************************
8 ! BIEF V6P1 21/08/2010
9 !***********************************************************************
10 !
11 !brief COMPLETES THE DATA STRUCTURE FOR EDGE-BASED STORAGE
12 !+ FOR HIGHER ORDER ELEMENTS.
13 !code
14 !+ NUMBERING OF QUADRATIC ELEMENTS SEGMENTS:
15 !+
16 !+ 01 --> 1 - 2
17 !+ 02 --> 2 - 3
18 !+ 03 --> 3 - 1
19 !+ 04 --> 1 - 4
20 !+ 05 --> 2 - 5
21 !+ 06 --> 3 - 6
22 !+ 07 --> 2 - 4
23 !+ 08 --> 3 - 5
24 !+ 09 --> 1 - 6
25 !+ 10 --> 1 - 5
26 !+ 11 --> 2 - 6
27 !+ 12 --> 3 - 4
28 !+ 13 --> 4 - 5
29 !+ 14 --> 5 - 6
30 !+ 15 --> 6 - 4
31 !
32 !history J-M HERVOUET (LNHE)
33 !+ 05/02/2010
34 !+ V6P0
35 !+
36 !
37 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
38 !+ 13/07/2010
39 !+ V6P0
40 !+ Translation of French comments within the FORTRAN sources into
41 !+ English comments
42 !
43 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
44 !+ 21/08/2010
45 !+ V6P0
46 !+ Creation of DOXYGEN tags for automated documentation and
47 !+ cross-referencing of the FORTRAN sources
48 !
49 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
50 !| ELTSEG |<--| SEGMENTS OF EVERY TRIANGLE.
51 !| GLOSEG |<--| GLOBAL NUMBERS OF POINTS OF SEGMENTS.
52 !| IELM |-->| 11: TRIANGLES.
53 !| | | 21: QUADRILATERES.
54 !| IKLE |-->| NUMEROS GLOBAUX DES POINTS DE CHAQUE ELEMENT.
55 !| MAXSEG |<--| 1st DIMENSION OF MAXSEG.
56 !| NELEM |-->| NOMBRE D'ELEMENTS DANS LE MAILLAGE.
57 !| NELMAX |-->| NOMBRE MAXIMUM D'ELEMENTS DANS LE MAILLAGE.
58 !| | | (CAS DES MAILLAGES ADAPTATIFS)
59 !| NSEG |<--| NUMBER OF SEGMENTS OF THE MESH.
60 !| ORISEG |-->| ORIENTATION OF SEGMENTS
61 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62 !
63  USE bief, ex_comp_seg => comp_seg
64 !
65  USE declarations_special
66  IMPLICIT NONE
67 !
68 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
69 !
70  INTEGER, INTENT(IN) :: NELMAX,NSEG,MAXSEG,IELM,NELEM
71  INTEGER, INTENT(IN) :: IKLE(nelmax,*)
72  INTEGER, INTENT(INOUT) :: GLOSEG(maxseg,2),ELTSEG(nelmax,*)
73  INTEGER, INTENT(INOUT) :: ORISEG(nelmax,*)
74 !
75 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
76 !
77  INTEGER IELEM,IAD
78 !
79 !-----------------------------------------------------------------------
80 !
81  IF(ielm.EQ.12) THEN
82 !
83 ! 3 ADDITIONAL SEGMENTS WITHIN QUASI-BUBBLE ELEMENTS
84 ! FOR THEM ORISEG IS IMPLICITLY 1 AND IS NEVER USED
85 !
86  DO ielem = 1 , nelem
87  eltseg(ielem,4) = nseg + 3*(ielem-1) + 1
88  eltseg(ielem,5) = nseg + 3*(ielem-1) + 2
89  eltseg(ielem,6) = nseg + 3*(ielem-1) + 3
90 ! PRINCIPLE: FROM LINEAR POINT TO QUASI-BUBBLE POINT
91  gloseg(eltseg(ielem,4),1) = ikle(ielem,1)
92  gloseg(eltseg(ielem,4),2) = ikle(ielem,4)
93  gloseg(eltseg(ielem,5),1) = ikle(ielem,2)
94  gloseg(eltseg(ielem,5),2) = ikle(ielem,4)
95  gloseg(eltseg(ielem,6),1) = ikle(ielem,3)
96  gloseg(eltseg(ielem,6),2) = ikle(ielem,4)
97  ENDDO
98 !
99  ELSEIF(ielm.EQ.13) THEN
100 !
101 ! 12 ADDITIONAL SEGMENTS IN QUADRATIC ELEMENTS
102 ! SEE GLOSEG BELOW
103 !
104  DO ielem = 1 , nelem
105 ! 6 SMALL LATERAL SEGMENTS (NUMBERED LIKE THEIR LARGER
106 ! SEGMENT WITH A SHIFT, AND SO THAT NUMBERS CORRESPOND
107 ! ON EITHER SIDE)
108  IF(oriseg(ielem,1).EQ.1) THEN
109  eltseg(ielem,04)=nseg+eltseg(ielem,01)
110  eltseg(ielem,07)=nseg+eltseg(ielem,01)+nseg
111  ELSE
112  eltseg(ielem,04)=nseg+eltseg(ielem,01)+nseg
113  eltseg(ielem,07)=nseg+eltseg(ielem,01)
114  ENDIF
115  IF(oriseg(ielem,2).EQ.1) THEN
116  eltseg(ielem,05)=nseg+eltseg(ielem,02)
117  eltseg(ielem,08)=nseg+eltseg(ielem,02)+nseg
118  ELSE
119  eltseg(ielem,05)=nseg+eltseg(ielem,02)+nseg
120  eltseg(ielem,08)=nseg+eltseg(ielem,02)
121  ENDIF
122  IF(oriseg(ielem,3).EQ.1) THEN
123  eltseg(ielem,06)=nseg+eltseg(ielem,03)
124  eltseg(ielem,09)=nseg+eltseg(ielem,03)+nseg
125  ELSE
126  eltseg(ielem,06)=nseg+eltseg(ielem,03)+nseg
127  eltseg(ielem,09)=nseg+eltseg(ielem,03)
128  ENDIF
129  ENDDO
130  iad=3*nseg
131  DO ielem = 1 , nelem
132 ! THE 3 LARGE SEGMENTS INSIDE THE ELEMENT
133  eltseg(ielem,10) = iad + 3*(ielem-1) + 1
134  eltseg(ielem,11) = iad + 3*(ielem-1) + 2
135  eltseg(ielem,12) = iad + 3*(ielem-1) + 3
136  ENDDO
137  iad=iad+3*nelem
138  DO ielem = 1 , nelem
139 ! THE 3 SMALL SEGMENTS INSIDE THE ELEMENT
140  eltseg(ielem,13) = iad + 3*(ielem-1) + 1
141  eltseg(ielem,14) = iad + 3*(ielem-1) + 2
142  eltseg(ielem,15) = iad + 3*(ielem-1) + 3
143  ENDDO
144  iad=iad+3*nelem
145 !
146  IF(iad.NE.maxseg) THEN
147  WRITE(lu,*) 'COMP_SEG: ERROR ON MAXIMUM NUMBER OF SEGMENTS'
148  CALL plante(1)
149  stop
150  ENDIF
151 !
152  DO ielem = 1 , nelem
153 ! FOR SEGMENTS 4 TO 12: FROM LINEAR POINT TO QUADRATIC POINT
154 ! THIS IS IMPORTANT FOR RECTANGULAR MATRICES AND MVSEG
155  gloseg(eltseg(ielem,04),1) = ikle(ielem,1)
156  gloseg(eltseg(ielem,04),2) = ikle(ielem,4)
157  gloseg(eltseg(ielem,05),1) = ikle(ielem,2)
158  gloseg(eltseg(ielem,05),2) = ikle(ielem,5)
159  gloseg(eltseg(ielem,06),1) = ikle(ielem,3)
160  gloseg(eltseg(ielem,06),2) = ikle(ielem,6)
161  gloseg(eltseg(ielem,07),1) = ikle(ielem,2)
162  gloseg(eltseg(ielem,07),2) = ikle(ielem,4)
163  gloseg(eltseg(ielem,08),1) = ikle(ielem,3)
164  gloseg(eltseg(ielem,08),2) = ikle(ielem,5)
165  gloseg(eltseg(ielem,09),1) = ikle(ielem,1)
166  gloseg(eltseg(ielem,09),2) = ikle(ielem,6)
167  gloseg(eltseg(ielem,10),1) = ikle(ielem,1)
168  gloseg(eltseg(ielem,10),2) = ikle(ielem,5)
169  gloseg(eltseg(ielem,11),1) = ikle(ielem,2)
170  gloseg(eltseg(ielem,11),2) = ikle(ielem,6)
171  gloseg(eltseg(ielem,12),1) = ikle(ielem,3)
172  gloseg(eltseg(ielem,12),2) = ikle(ielem,4)
173 ! FOR SEGMENTS 13 TO 15: NO SPECIFIC PRINCIPLE
174  gloseg(eltseg(ielem,13),1) = ikle(ielem,4)
175  gloseg(eltseg(ielem,13),2) = ikle(ielem,5)
176  gloseg(eltseg(ielem,14),1) = ikle(ielem,5)
177  gloseg(eltseg(ielem,14),2) = ikle(ielem,6)
178  gloseg(eltseg(ielem,15),1) = ikle(ielem,6)
179  gloseg(eltseg(ielem,15),2) = ikle(ielem,4)
180 ! SHOULD NOT BE USEFUL (MEMORY TO BE REMOVED ?)
181 ! ORIENTATION FROM LINEAR TO QUADRATIC NEEDS NO
182 ! EXTRA INFORMATION
183  oriseg(ielem,04) = 1
184  oriseg(ielem,05) = 1
185  oriseg(ielem,06) = 1
186  oriseg(ielem,07) = 1
187  oriseg(ielem,08) = 1
188  oriseg(ielem,09) = 1
189  oriseg(ielem,10) = 1
190  oriseg(ielem,11) = 1
191  oriseg(ielem,12) = 1
192  oriseg(ielem,13) = 1
193  oriseg(ielem,14) = 1
194  oriseg(ielem,15) = 1
195  ENDDO
196  ELSE
197  WRITE(lu,501) ielm
198 501 FORMAT(1x,'COMP_SEG (BIEF): UNEXPECTED ELEMENT: ',1i6)
199  CALL plante(1)
200  stop
201  ENDIF
202 !
203 !-----------------------------------------------------------------------
204 !
205  RETURN
206  END
declarations_special
Definition: declarations_special.F:3
comp_seg
subroutine comp_seg(NELEM, NELMAX, IELM, IKLE, GLOSEG, MAXSEG, ELTSEG, ORISEG, NSEG)
Definition: comp_seg.f:7
declarations_special::lu
integer lu
Definition: declarations_special.F:45
bief
Definition: bief.f:3
Generated on Tue Jan 5 2021 14:36:31 for The TELEMAC-MASCARET system by doxygen 1.8.13