The TELEMAC-MASCARET system  trunk
make_eltcar.f
Go to the documentation of this file.
1 ! **********************
2  SUBROUTINE make_eltcar
3 ! **********************
4 !
5  &(eltcar,ifac,
6  & ikle,npoin2,nelem2,nelmax,knolg,iscore,mesh,nplan,ielm)
7 !
8 !***********************************************************************
9 ! BIEF V7P1
10 !***********************************************************************
11 !
12 !brief For every point in the mesh, gives an element that contains
13 !+ this point. This element must be the same in scalar and in
14 !+ parallel mode, ELTCAR(I)=0 means that the element is in another
15 !+ sub-domain.
16 !+ A byproduct is array IFAC, for every point it is 1, except
17 !+ on boundaries between sub-domains, where it is 0 for all
18 !+ sub-domain but 1.
19 !
20 !note In every triangle a point is followed by another one:
21 !+ 2 follows 1, 3 follows 2, 1 follows 3
22 !+ A point cannot be followed by the same point in 2 different
23 !+ triangles (if all triangles are counterclock-wise oriented).
24 !+ For every point we choose the element where the next point
25 !+ has the higher rank.
26 !+ With quadratic interpolation, the next linear point is taken
27 !+ 2 follows 4, 3 follows 5, 1 follows 6
28 !+ The case of quasi-bubble is obvious and not treated here: the
29 !+ point is in the middle of an element, so no problem of choice
30 !+
31 !+ Choosing the element with highest number would be easier but
32 !+ there is so far nothing like KNOLG for elements...
33 !
34 !history C. DENIS (SINETICS, EDF R&D), J-M HERVOUET (LNHE, EDF R&D)
35 !+ 27/04/2012
36 !+ V6P2
37 !+
38 !
39 !history J-M HERVOUET (LNHE, EDF R&D)
40 !+ 14/06/2012
41 !+ V6P2
42 !+ Prisms cut into tetrahedra added, quasi-bubble completed
43 !
44 !history J-M HERVOUET (LNHE, EDF R&D)
45 !+ 21/09/2012
46 !+ V6P3
47 !+ Correction of IELEM3D in tetrahedra part (1st use 1st bug...)
48 !
49 !history J-M HERVOUET (LNHE, EDF R&D)
50 !+ 20/11/2013
51 !+ V7P0
52 !+ Call of PARCOM2I and PARCOM2I_SEG added for ISCORE, instead of
53 !+ copying to a double precision SCORE (the latter suppressed).
54 !
55 !history J-M HERVOUET (LNHE, EDF LAB)
56 !+ 10/06/2015
57 !+ V7P1
58 !+ Array IFAC built, based on ELTCAR. This is for dot product.
59 !
60 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
61 !| ELTCAR |<--| ELEMENT CHOSEN FOR EVERY POINT
62 !| IELM |-->| TYPE OF ELEMENT (11: TRIANGLE, 41: PRISM...)
63 !| IKLE |-->| CONNECTIVITY TABLE
64 !| ISCORE |<->| INTEGER WORK ARRAY
65 !| KNOLG |-->| GLOBAL NUMBER OF POINTS IN ORIGINAL MESH
66 !| MESH |-->| MESH STRUCTURE
67 !| NELEM2 |-->| NUMBER OF ELEMENTS IN 2D MESH
68 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
69 !| NPLAN |-->| NUMBER OF PLANES (CASE OF A 3D MESH, OR 1 IN 2D)
70 !| NPOIN2 |-->| NUMBER OF POINTS IN 2D MESH
71 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
72 !
73  USE bief_def
75  IMPLICIT NONE
76 !
77 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
78 !
79  INTEGER, INTENT(IN) :: NPOIN2,NELEM2,NELMAX,NPLAN,IELM
80  INTEGER, INTENT(IN) :: IKLE(nelmax,*),KNOLG(*)
81  INTEGER, INTENT(INOUT) :: ELTCAR(*),IFAC(*)
82  INTEGER, INTENT(INOUT) :: ISCORE(*)
83  TYPE(bief_mesh), INTENT(INOUT) :: MESH
84 !
85 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
86 !
87  INTEGER I,IELEM,N1,N2,N3,N4,N5,N6,IPLAN,NP,I3D,K,IELEM3D
88 !
89  IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
90  np=npoin2
91  ELSEIF(ielm.EQ.13) THEN
92  np=npoin2+mesh%NSEG
93  ELSE
94  WRITE(lu,*) 'MAKE_ELTCAR NOT PROGRAMMED FOR IELM=',ielm
95  CALL plante(1)
96  stop
97  ENDIF
98 !
99  DO i=1,np
100  iscore(i)=0
101  ENDDO
102 !
103  IF(ncsize.LE.1) THEN
104 !
105 ! SIMPLE CASE: SCALAR MODE
106 !
107  IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
108 !
109  DO ielem = 1,nelem2
110  n1=ikle(ielem,1)
111  n2=ikle(ielem,2)
112  n3=ikle(ielem,3)
113  IF(iscore(n1).LT.n2) THEN
114  iscore(n1)=n2
115  eltcar(n1)=ielem
116  ENDIF
117  IF(iscore(n2).LT.n3) THEN
118  iscore(n2)=n3
119  eltcar(n2)=ielem
120  ENDIF
121  IF(iscore(n3).LT.n1) THEN
122  iscore(n3)=n1
123  eltcar(n3)=ielem
124  ENDIF
125  ENDDO
126 !
127  ELSEIF(ielm.EQ.13) THEN
128 !
129  DO ielem = 1,nelem2
130  n1=ikle(ielem,1)
131  n2=ikle(ielem,2)
132  n3=ikle(ielem,3)
133  n4=ikle(ielem,4)
134  n5=ikle(ielem,5)
135  n6=ikle(ielem,6)
136  IF(iscore(n1).LT.n2) THEN
137  iscore(n1)=n2
138  eltcar(n1)=ielem
139  ENDIF
140  IF(iscore(n2).LT.n3) THEN
141  iscore(n2)=n3
142  eltcar(n2)=ielem
143  ENDIF
144  IF(iscore(n3).LT.n1) THEN
145  iscore(n3)=n1
146  eltcar(n3)=ielem
147  ENDIF
148  IF(iscore(n4).LT.n2) THEN
149  iscore(n4)=n2
150  eltcar(n4)=ielem
151  ENDIF
152  IF(iscore(n5).LT.n3) THEN
153  iscore(n5)=n3
154  eltcar(n5)=ielem
155  ENDIF
156  IF(iscore(n6).LT.n1) THEN
157  iscore(n6)=n1
158  eltcar(n6)=ielem
159  ENDIF
160  ENDDO
161 !
162  ENDIF
163 !
164  ELSE
165 !
166 ! NOW IN PARALLEL, FIRST LIKE IN SCALAR BUT WITH GLOBAL NUMBERS
167 !
168  IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
169 !
170  DO ielem = 1,nelem2
171  n1=ikle(ielem,1)
172  n2=ikle(ielem,2)
173  n3=ikle(ielem,3)
174  IF(iscore(n1).LT.knolg(n2)) THEN
175  iscore(n1)=knolg(n2)
176  eltcar(n1)=ielem
177  ENDIF
178  IF(iscore(n2).LT.knolg(n3)) THEN
179  iscore(n2)=knolg(n3)
180  eltcar(n2)=ielem
181  ENDIF
182  IF(iscore(n3).LT.knolg(n1)) THEN
183  iscore(n3)=knolg(n1)
184  eltcar(n3)=ielem
185  ENDIF
186  ENDDO
187 !
188  ELSEIF(ielm.EQ.13) THEN
189 !
190  DO ielem = 1,nelem2
191  n1=ikle(ielem,1)
192  n2=ikle(ielem,2)
193  n3=ikle(ielem,3)
194  n4=ikle(ielem,4)
195  n5=ikle(ielem,5)
196  n6=ikle(ielem,6)
197  IF(iscore(n1).LT.knolg(n2)) THEN
198  iscore(n1)=knolg(n2)
199  eltcar(n1)=ielem
200  ENDIF
201  IF(iscore(n2).LT.knolg(n3)) THEN
202  iscore(n2)=knolg(n3)
203  eltcar(n2)=ielem
204  ENDIF
205  IF(iscore(n3).LT.knolg(n1)) THEN
206  iscore(n3)=knolg(n1)
207  eltcar(n3)=ielem
208  ENDIF
209  IF(iscore(n4).LT.knolg(n2)) THEN
210  iscore(n4)=knolg(n2)
211  eltcar(n4)=ielem
212  ENDIF
213  IF(iscore(n5).LT.knolg(n3)) THEN
214  iscore(n5)=knolg(n3)
215  eltcar(n5)=ielem
216  ENDIF
217  IF(iscore(n6).LT.knolg(n1)) THEN
218  iscore(n6)=knolg(n1)
219  eltcar(n6)=ielem
220  ENDIF
221  ENDDO
222 !
223  ENDIF
224 !
225 ! LARGEST VALUE BETWEEN NEIGHBOURING SUB-DOMAINS TAKEN
226  CALL parcom2i(iscore,iscore,iscore,npoin2,1,1,1,mesh)
227  IF(ielm.EQ.13) THEN
228  CALL parcom2i_seg(iscore(npoin2+1:np),
229  & iscore(npoin2+1:np),
230  & iscore(npoin2+1:np),
231  & mesh%NSEG,1,1,1,mesh,1,11)
232  ENDIF
233 !
234  IF(ielm.EQ.11.OR.ielm.EQ.12.OR.ielm.EQ.41.OR.ielm.EQ.51) THEN
235 !
236  DO ielem = 1,nelem2
237  n1=ikle(ielem,1)
238  n2=ikle(ielem,2)
239  n3=ikle(ielem,3)
240  IF(iscore(n1).EQ.knolg(n2)) THEN
241 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
242  iscore(n1)=0
243  ENDIF
244  IF(iscore(n2).EQ.knolg(n3)) THEN
245 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
246  iscore(n2)=0
247  ENDIF
248  IF(iscore(n3).EQ.knolg(n1)) THEN
249 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
250  iscore(n3)=0
251  ENDIF
252  ENDDO
253 !
254  ELSEIF(ielm.EQ.13) THEN
255 !
256  DO ielem = 1,nelem2
257  n1=ikle(ielem,1)
258  n2=ikle(ielem,2)
259  n3=ikle(ielem,3)
260  n4=ikle(ielem,4)
261  n5=ikle(ielem,5)
262  n6=ikle(ielem,6)
263  IF(iscore(n1).EQ.knolg(n2)) THEN
264 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
265  iscore(n1)=0
266  ENDIF
267  IF(iscore(n2).EQ.knolg(n3)) THEN
268 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
269  iscore(n2)=0
270  ENDIF
271  IF(iscore(n3).EQ.knolg(n1)) THEN
272 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
273  iscore(n3)=0
274  ENDIF
275  IF(iscore(n4).EQ.knolg(n2)) THEN
276 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
277  iscore(n4)=0
278  ENDIF
279  IF(iscore(n5).EQ.knolg(n3)) THEN
280 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
281  iscore(n5)=0
282  ENDIF
283  IF(iscore(n6).EQ.knolg(n1)) THEN
284 ! THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
285  iscore(n6)=0
286  ENDIF
287  ENDDO
288 !
289  ENDIF
290 !
291 ! IF A POINT HAS A BETTER ELEMENT IN ANOTHER SUB-DOMAIN
292  DO i=1,np
293  IF(iscore(i).NE.0) THEN
294  eltcar(i)=0
295  ENDIF
296  ENDDO
297 !
298  ENDIF
299 !
300 !-----------------------------------------------------------------------
301 !
302 ! NOW DEDUCING IFAC
303 !
304  IF(ncsize.GT.1) THEN
305  DO i=1,np
306  IF(eltcar(i).NE.0) THEN
307  ifac(i)=1
308  ELSE
309  ifac(i)=0
310  ENDIF
311  ENDDO
312  ENDIF
313 !
314 !-----------------------------------------------------------------------
315 !
316 ! COMPLETING FOR QUASI-BUBBLE
317 !
318  IF(ielm.EQ.12) THEN
319  DO ielem=1,nelem2
320  eltcar(npoin2+ielem)=ielem
321  ENDDO
322  ENDIF
323  IF(ncsize.GT.1.AND.ielm.EQ.12) THEN
324  DO ielem=1,nelem2
325  ifac(npoin2+ielem)=1
326  ENDDO
327  ENDIF
328 !
329 ! COMPLETING FOR 3D PRISMS
330 !
331  IF(nplan.GT.1) THEN
332  IF(ielm.EQ.41) THEN
333  DO iplan=2,nplan
334  DO i=1,npoin2
335 ! ACCORDING TO POINT AND ELEMENT NUMBERING IN PRISMS
336  i3d=i+(iplan-1)*npoin2
337  IF(eltcar(i).GT.0) THEN
338  eltcar(i3d)=eltcar(i)+(iplan-1)*nelem2
339  ELSE
340  eltcar(i3d)=0
341  ENDIF
342  ENDDO
343  ENDDO
344  ELSEIF(ielm.EQ.51) THEN
345  DO iplan=2,nplan
346  DO i=1,npoin2
347  i3d=i+(iplan-1)*npoin2
348  IF(eltcar(i).GT.0) THEN
349 ! 3 TETRAHEDRA POSSIBLE CANDIDATES
350  DO k=1,3
351 ! SEE ELEMENT NUMBERING IN PRISMS CUT INTO TETRAHEDRA
352  ielem3d=(iplan-2)*3*nelem2+(k-1)*nelem2+eltcar(i)
353 ! THIS MAY HIT SEVERAL TIMES AS A POINT MAY BELONG
354 ! TO MORE THAN ONE TETRAHEDRON AT THIS LEVEL,
355 ! THE LAST HIT IS KEPT, SAME BEHAVIOUR IN SCALAR OR
356 ! PARALLEL. NOT VERY ELEGANT, BETTER IDEA ?
357  IF(ikle(ielem3d,1).EQ.i3d) THEN
358  eltcar(i3d)=ielem3d
359  ELSEIF(ikle(ielem3d,2).EQ.i3d) THEN
360  eltcar(i3d)=ielem3d
361  ELSEIF(ikle(ielem3d,3).EQ.i3d) THEN
362  eltcar(i3d)=ielem3d
363  ELSEIF(ikle(ielem3d,4).EQ.i3d) THEN
364  eltcar(i3d)=ielem3d
365  ENDIF
366  ENDDO
367  ELSE
368  eltcar(i3d)=0
369  ENDIF
370  ENDDO
371  ENDDO
372  ENDIF
373 !
374 ! COMPLETING IFAC FOR PRISMS OR PRISMS CUT INTO TETRAHEDRA
375 !
376  IF(ncsize.GT.1) THEN
377  DO iplan=2,nplan
378  DO i=1,npoin2
379 ! ACCORDING TO POINT AND ELEMENT NUMBERING IN PRISMS
380  ifac(i+(iplan-1)*npoin2)=ifac(i)
381  ENDDO
382  ENDDO
383  ENDIF
384 !
385  ENDIF
386 !
387 !-----------------------------------------------------------------------
388 !
389  RETURN
390  END
391
subroutine make_eltcar(ELTCAR, IFAC, IKLE, NPOIN2, NELEM2, NELMAX, KNOLG, ISCORE, MESH, NPLAN, IELM)
Definition: make_eltcar.f:8
subroutine parcom2i(X1, X2, X3, NPOIN, NPLAN, ICOM, IAN, MESH)
Definition: parcom2i.f:7
integer ncsize
Definition: bief_def.f:49
subroutine parcom2i_seg(X1, X2, X3, NSEG, NPLAN, ICOM, IAN, MESH, OPT, IELM)
Definition: parcom2i_seg.f:7