OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
reorder_ig3d.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| reorder_ig3d ../starter/source/elements/ige3d/reorder_ig3d.F
25!||--- called by ------------------------------------------------------
26!|| prerafig3d ../starter/source/elements/ige3d/prerafig3d.F
27!||--- calls -----------------------------------------------------
28!|| myqsort3d ../starter/source/elements/ige3d/searchigeo3d.F
29!||====================================================================
30 SUBROUTINE reorder_ig3d(IXIG3D, KXIG3D,KNOTLOCPC,KNOTLOCEL,
31 . X_TMP,D_TMP,V_TMP,MS_TMP,WIGE_TMP,
32 . TAB_REMOVE,TAB_NEWFCT,EL_CONNECT,
33 . IPARTIG3D,IGEO,TAB_STAY,FLAG_PRE,FLAG_DEBUG)
34C----------------------------------------------------------------------
35C ROUTINE QUI REORDONNE LES TABLEAUX DE POINTS X, KNOTLOCPC, D, V ETC
36C EN COMPACTANT : ENLEVE LES POINTS SUPPRIMES, RAJOUTE LES NOUVEAUX,
37C SANS LAISSER DE TROU
38C LA ROUTINE TRIE EGALEMENT LES DOUBLONS EN BORD DE PATCHS, MAIS NE
39C SUPPRIME PAS COMPLETEMENT LES POINTS (DESACTIVATION)
40C ELLE REORDONNE EN FIN LES TABLES DE CONNECTIVITES DE TOUT LES ELEMENTS
41C QUI ONT ETE MODIFIES
42C----------------------------------------------------------------------
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "ige3d_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IXIG3D(*),KXIG3D(NIXIG3D,*),IGEO(NPROPGI,*),
57 . IPARTIG3D(*),TAB_NEWFCT(*),TAB_REMOVE(*),
58 . TAB_STAY(*),FLAG_PRE,EL_CONNECT(*),FLAG_DEBUG
59 my_real knotlocpc(deg_max,3,*),knotlocel(2,3,*)
60 my_real x_tmp(3,*),v_tmp(3,*),d_tmp(3,*),ms_tmp(*),wige_tmp(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,J,K,L,M,IAD_IXIG3D,INCTRL,L_TABWORK,WORK(70000),
65 . NDOUBLON_REMOVE, NDOUBLON_NEWFCT, L_REAL_REMOVE, L_REAL_NEWFCT,NVALEURS,
66 . DECALIXIG3D,DECALGEO,DECALGEOFINAL,
67 . nzero_remove,nzero_newfct,itpatch,numpcstay,numpcleave,
68 . nctrl,ipid,px,py,pz,ndoublonige,itnctrl,inctrl2,inctrl3,inctrl4
69 INTEGER TMPZ(4),TMPZY(4),TABPOSZ(64),TABPOSZY(64),TABPOSZYX(64)
70 my_real TOL
71 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX, TAB_REMOVE_TRI, TAB_NEWFCT_TRI
72 INTEGER, DIMENSION(:), ALLOCATABLE :: PERMIGE
73 my_real, DIMENSION(:,:), ALLOCATABLE :: x_trie
74C=======================================================================
75C
76 tol=em06
77c
78c ------------------------------------------------------------------------------------------
79CC TRI DE MANIERE CROISSANTE LES TABLEAUX REMOVE ET NEWFCT
80c ------------------------------------------------------------------------------------------
81c
82 ALLOCATE(tab_remove_tri(l_tab_remove))
83 tab_remove_tri(:) = 0
84 ALLOCATE(index(2*l_tab_remove))
85 CALL my_orders(0, work, tab_remove, index, l_tab_remove , 1)
86 DO i=1,l_tab_remove
87 tab_remove_tri(i)=tab_remove(index(i))
88 ENDDO
89 DEALLOCATE(index)
90 DO i=1,l_tab_remove
91 tab_remove(i) = 0
92 ENDDO
93C
94 ALLOCATE(tab_newfct_tri(l_tab_newfct))
95 tab_newfct_tri(:) = 0
96 ALLOCATE(index(2*l_tab_newfct))
97 CALL my_orders(0, work, tab_newfct, index, l_tab_newfct , 1)
98 DO i=1,l_tab_newfct
99 tab_newfct_tri(i)=tab_newfct(index(i))
100 ENDDO
101 DEALLOCATE(index)
102 DO i=1,l_tab_newfct
103 tab_newfct(i) = 0
104 ENDDO
105c
106c ------------------------------------------------------------------------------------------
107CC ELIMINATION DES DOUBLONS S'IL Y A PLUSIEURS PATCHS EN CONTACT
108CC (ON PEUT FAIRE ONE FLAG QUI LE REND OPTIONNEL)
109c ------------------------------------------------------------------------------------------
110c
111 ndoublon_remove = 0
112 IF(nbpart_ig3d>1) THEN
113 i = 1
114 DO WHILE (i<=l_tab_remove-ndoublon_remove-1)
115 nvaleurs = 0
116 tab_remove(i) = tab_remove_tri(i+ndoublon_remove)
117 DO WHILE (((i+ndoublon_remove+nvaleurs+1)<=l_tab_remove)
118 . .AND. (tab_remove(i+ndoublon_remove)==tab_remove(i+ndoublon_remove+nvaleurs+1)))
119 nvaleurs = nvaleurs + 1
120 ENDDO
121 ndoublon_remove = ndoublon_remove + nvaleurs
122 i = i + 1
123 ENDDO
124 ENDIF
125c
126 l_real_remove = l_tab_remove - ndoublon_remove
127c
128 ndoublon_newfct = 0
129 IF(nbpart_ig3d>1) THEN
130 i = 1
131 DO WHILE (i<=l_tab_newfct-ndoublon_newfct-1)
132 nvaleurs = 0
133 tab_newfct(i) = tab_newfct_tri(i+ndoublon_newfct)
134 DO WHILE (((i+ndoublon_newfct+nvaleurs+1)<=l_tab_newfct)
135 . .AND. (tab_newfct(i+ndoublon_newfct)==tab_newfct(i+ndoublon_newfct+nvaleurs+1)))
136 nvaleurs = nvaleurs + 1
137 ENDDO
138 ndoublon_newfct = ndoublon_newfct + nvaleurs
139 i = i + 1
140 ENDDO
141 ENDIF
142c
143 l_real_newfct = l_tab_newfct - ndoublon_newfct
144c
145c ------------------------------------------------------------------------------------------
146C SUPPRESSION DES VALEURS COMMUNES AUX TWO LISTES (LES POINTS CREES PUIS SUPPRIMES)
147c ------------------------------------------------------------------------------------------
148c
149 i=1
150 DO WHILE (i<=l_real_remove)
151 j=1
152 DO WHILE (j<=l_real_newfct)
153 IF(tab_remove_tri(i)==tab_newfct_tri(j)) THEN
154 tab_remove_tri(i) = 0
155 tab_newfct_tri(j) = 0
156 ENDIF
157 j=j+1
158 ENDDO
159 i=i+1
160 ENDDO
161c
162 i = 1
163 nzero_remove = 0
164 DO WHILE (i<=l_real_remove-nzero_remove)
165 nvaleurs = 0
166 DO WHILE ((i+nzero_remove+nvaleurs)<=l_real_remove.AND.
167 . tab_remove_tri(i+nzero_remove+nvaleurs)==0)
168 nvaleurs=nvaleurs+1
169 ENDDO
170 nzero_remove = nzero_remove + nvaleurs
171 tab_remove_tri(i) = tab_remove_tri(i+nzero_remove)
172 i = i + 1
173 ENDDO
174c
175 i = 1
176 nzero_newfct = 0
177 DO WHILE (i<=l_real_newfct-nzero_newfct)
178 nvaleurs = 0
179 DO WHILE ((i+nzero_newfct+nvaleurs)<=l_real_newfct.AND.
180 . tab_newfct_tri(i+nzero_newfct+nvaleurs)==0)
181 nvaleurs=nvaleurs+1
182 ENDDO
183 nzero_newfct = nzero_newfct + nvaleurs
184 tab_newfct_tri(i) = tab_newfct_tri(i+nzero_newfct)
185 i = i + 1
186 ENDDO
187c
188 l_real_remove = l_tab_remove - nzero_remove
189 l_real_newfct = l_tab_newfct - nzero_newfct
190 nbnewx_final = l_real_newfct - l_real_remove ! attention il faudra s'il y avait des 0 concatener
191c
192c ------------------------------------------------------------------------------------------
193C PUIS IL FAUT REMPLACER CHAQUE POINT DE REMOVE PAR LES POINTS DE NEWS ET QUAND IL N'Y A PLUS DE PLACE
194C ON COMPTE LE NOMBRE REEL DE POINT AJOUTES ET ON REMPLIT AVEC NUMNODO + ITNBNEWX
195C
196CC MODIFICATION DES CONNECTIVITES DES ELEMENTS ET DES DONNES DES POINTS DE CONTROLE
197c ------------------------------------------------------------------------------------------
198c
199 IF(flag_pre==1) THEN
200
201 i=1
202 DO WHILE (i<=l_real_remove)
203 x_tmp(:,tab_remove_tri(i)) = x_tmp(:,tab_newfct_tri(i)) ! X a pile poil la bonne taille
204 d_tmp(:,tab_remove_tri(i)) = d_tmp(:,tab_newfct_tri(i))
205 v_tmp(:,tab_remove_tri(i)) = v_tmp(:,tab_newfct_tri(i))
206 ms_tmp(tab_remove_tri(i)) = ms_tmp(tab_newfct_tri(i))
207 wige_tmp(tab_remove_tri(i)) = wige_tmp(tab_newfct_tri(i))
208 DO itpatch=1,numgeo ! SI ON DECALE ONE POINT, C'EST QU'IL EST SUR ONE SEUL PATCH, DONC ON VA DECALER TOUT LES KNOT
209cc DE CE POINT SUR TOUT LES PATCH POUR ETRE SUR, MAIS IL AURAIT FALU JUSTE SAVOIR SUR LEQUEL IL EST POU RNE PAS
210C DECALER DES 0
211 decalgeo=(itpatch-1)*(numnod+nbnewx_tmp) ! nb total de point ajoute avec ceux qu'on supprime
212 knotlocpc(:,1,decalgeo+tab_remove_tri(i)) = knotlocpc(:,1,decalgeo+tab_newfct_tri(i))
213 knotlocpc(:,2,decalgeo+tab_remove_tri(i)) = knotlocpc(:,2,decalgeo+tab_newfct_tri(i))
214 knotlocpc(:,3,decalgeo+tab_remove_tri(i)) = knotlocpc(:,3,decalgeo+tab_newfct_tri(i))
215 ENDDO
216 j=1
217 DO WHILE(j<=sixig3d+addsixig3d)
218 DO WHILE(ixig3d(j)==tab_newfct_tri(i).AND.j<=sixig3d+addsixig3d)
219c print*,'IXIG3D = ', IXIG3D(J),'IXIG3D final = ', TAB_REMOVE_TRI(I)
220 ixig3d(j)=tab_remove_tri(i)
221 j=j+1
222 ENDDO
223 j=j+1
224 ENDDO
225 i=i+1
226 ENDDO
227c
228 j=1
229 DO WHILE (i<=l_real_newfct)
230 x_tmp(:,numnodige0+j) = x_tmp(:,tab_newfct_tri(i))
231 d_tmp(:,numnodige0+j) = d_tmp(:,tab_newfct_tri(i))
232 v_tmp(:,numnodige0+j) = v_tmp(:,tab_newfct_tri(i))
233 ms_tmp(numnodige0+j) = ms_tmp(tab_newfct_tri(i))
234 wige_tmp(numnodige0+j) = wige_tmp(tab_newfct_tri(i))
235 DO itpatch=1,numgeo
236 decalgeo=(itpatch-1)*(numnod+nbnewx_tmp) ! nb total de point ajoute avec ceux qu'on supprime
237 knotlocpc(:,1,decalgeo+numnodige0+j) = knotlocpc(:,1,decalgeo+tab_newfct_tri(i))
238 knotlocpc(:,2,decalgeo+numnodige0+j) = knotlocpc(:,2,decalgeo+tab_newfct_tri(i))
239 knotlocpc(:,3,decalgeo+numnodige0+j) = knotlocpc(:,3,decalgeo+tab_newfct_tri(i))
240 ENDDO
241 k=1
242 DO WHILE(k<=sixig3d+addsixig3d)
243 DO WHILE(ixig3d(k)==tab_newfct_tri(i).AND.k<=sixig3d+addsixig3d)
244c print*,'IXIG3D = ', IXIG3D(K),'IXIG3D final = ', NUMNODIGE0+J
245 ixig3d(k)=numnodige0+j
246 k=k+1
247 ENDDO
248 k=k+1
249 ENDDO
250 i=i+1
251 j=j+1
252 ENDDO
253c
254c ------------------------------------------------------------------------------------------
255c TEST DE DOUBLON GEOMETRIQUE (CAUSE PAR DU RAFFINEMENT DE MULTIPATCH COLLES)
256C MERGE EN CAS DE BESOIN
257C ATTENTION A BIEN RAMENER LES INFORMATIONS SUR CHACUN DES PATCHS
258C
259C ATTENTION : TWO PATCHS PEUVENT AVOIR DES POINTS AU MEME ENDROIT,
260C MAIS POURRAIENT NE PAS AVOIR A ETRE CONNECTES
261C LE MERGE DE CES TWO POINTS CAUSERAIT ONE SOUCIS
262C ATTENTION2 : NE SUPPRIME PAS LES DOUBLONS DU MODELE : ILS SONT SEULEMENT DESACTIVES
263c ------------------------------------------------------------------------------------------
264c
265 IF(nbpart_ig3d>1) THEN ! ET SI ON A GARDE DES POINTS (CONDITION QUI VIENT DE RAFIG3D.F)
266 ALLOCATE(permige(numnod))
267 ALLOCATE(x_trie(3,numnod))
268 DO i=1,numnod
269 x_trie(:,i) = x_tmp(:,i)
270 ENDDO
271 CALL myqsort3d(numnod,x_trie,permige)
272c
273 i = 1
274 ndoublonige = 0
275 DO WHILE (i <= numnod-ndoublonige-1)
276 nvaleurs = 0
277 DO WHILE (((i+ndoublonige+nvaleurs+1) <= numnod)
278 . .AND. (abs(x_trie(1,i+ndoublonige)-x_trie(1,i+ndoublonige+nvaleurs+1)) <= tol)
279 . .AND. (abs(x_trie(2,i+ndoublonige)-x_trie(2,i+ndoublonige+nvaleurs+1)) <= tol)
280 . .AND. (abs(x_trie(3,i+ndoublonige)-x_trie(3,i+ndoublonige+nvaleurs+1)) <= tol))
281c
282c ------------------------------------------------------------------------------------------
283CC TEST POUR SAVOIR LEQUEL DES POINTS DOUBLONS EST A GARDER
284CC ET MODIFICATION DES DONNES DES POINTS DE CONTROLE ET DES TABLES
285CC DE CONNECTIVITES
286c ------------------------------------------------------------------------------------------
287c
288 numpcstay =0
289 numpcleave=0
290 DO k=1,l_tab_stay
291 IF(permige(i+ndoublonige)==tab_stay(k)) THEN
292 numpcstay = permige(i+ndoublonige)
293 numpcleave = permige(i+ndoublonige+nvaleurs+1)
294 EXIT
295 ENDIF
296 IF(permige(i+ndoublonige+nvaleurs+1)==tab_stay(k)) THEN
297 numpcstay = permige(i+ndoublonige+nvaleurs+1)
298 numpcleave = permige(i+ndoublonige)
299 EXIT
300 ENDIF
301 ENDDO
302 IF(numpcstay==0.AND.numpcleave==0) THEN ! LES TWO POINTS SONT A SUPPRIMER
303 numpcstay = permige(i+ndoublonige)
304 numpcleave = permige(i+ndoublonige+nvaleurs+1)
305c print*,'jai supprime au hasard ',NUMPCLEAVE
306c ELSE
307c print*,'jai supprime',NUMPCLEAVE,' et j ai garde',NUMPCSTAY
308 ENDIF
309c
310 j=1
311 DO WHILE(j<=sixig3d+addsixig3d)
312 DO WHILE(ixig3d(j)==numpcleave.AND.j<=sixig3d+addsixig3d)
313 ixig3d(j)=numpcstay
314 j=j+1
315 ENDDO
316 j=j+1
317 ENDDO
318
319ccc il faut savoir de quel patch vient le point qu'on supprime et de quel patch est le point qui va le remplacer
320
321 DO itpatch=1,nbpart_ig3d
322 decalgeo=(itpatch-1)*(numnod+nbnewx_tmp)
323c on ramene les knotlocpc des patch lorsque l'etendue est non nulle pour ce patch
324 DO k=1,4 ! test des etendues knot (vide ou non)
325 IF(knotlocpc(k,1,decalgeo+numpcleave)/=0) THEN
326 knotlocpc(:,1,decalgeo+numpcstay)=knotlocpc(:,1,decalgeo+numpcleave)
327 knotlocpc(:,2,decalgeo+numpcstay)=knotlocpc(:,2,decalgeo+numpcleave)
328 knotlocpc(:,3,decalgeo+numpcstay)=knotlocpc(:,3,decalgeo+numpcleave)
329 EXIT
330 ENDIF
331 ENDDO
332 ENDDO
333
334 nvaleurs = nvaleurs + 1
335
336 ENDDO
337 ndoublonige = ndoublonige + nvaleurs
338 i = i + 1
339 ENDDO
340
341C changer pour ne pas ecrire de facon croissante mais simplement eliminer les points doublons
342c
343c IF(NDOUBLONIGE>0) print*, 'J AI TROUVE ET SUPPRIME DES CONNECTIVITES :',NDOUBLONIGE,' DOUBLONS !'
344c
345 DEALLOCATE(permige)
346 DEALLOCATE(x_trie)
347 ENDIF
348c ------------------------------------------------------------------------------------------
349 ENDIF
350c
351 DEALLOCATE(tab_remove_tri)
352 DEALLOCATE(tab_newfct_tri)
353c
354 IF(flag_pre==1) THEN
355c
356C-----------------------------------------------
357CC ON RE-ORDONNE LA TABLE DE CONNECTIVITE DES ELEMENTS :
358CC PEUT TRAITER DES ELEMENTS MAXI DE DEGRE 3*3*3
359CC (TMPZ(4),TMPZY(4),TABPOSZ(64),TABPOSZY(64),TABPOSZYX(64))
360C-----------------------------------------------
361c
362 DO i=1,numelig3d0+addelig3d ! TAILLE DE EL_CONNECT
363c
364 IF(el_connect(i)/=1) cycle
365c
366 decalixig3d=kxig3d(4,i)
367 decalgeo=(kxig3d(2,i)-1)*(numnod+nbnewx_tmp)
368 nctrl=kxig3d(3,i)
369 ipid=ipartig3d(i)
370 px = igeo(41,ipid)
371 py = igeo(42,ipid)
372 pz = igeo(43,ipid)
373C
374 tabposz(:)=0
375 tmpz(:)=0
376 DO j=1,nctrl ! POUR CHACUNE DES (PX*PY*PZ) FONCTIONS
377 DO k=1,pz
378 IF(knotlocpc(k,3,decalgeo+ixig3d(decalixig3d+j-1))<knotlocel(1,3,i)+tol.AND.
379 . knotlocpc(k+1,3,decalgeo+ixig3d(decalixig3d+j-1))>knotlocel(2,3,i)-tol) THEN
380c la position en Z de cette fonction est K : 1 la fonction est en haut, PZ la fonction est en bas
381 tmpz(k)=tmpz(k)+1
382 tabposz((k-1)*(px*py)+tmpz(k)) = ixig3d(decalixig3d+j-1)
383 ENDIF
384 ENDDO
385 ENDDO
386C
387 tabposzy(:)=0
388 DO j=1,pz ! sur chacun des PZ niveaux
389 tmpzy(:)=0
390 DO k=1,px*py ! POUR CHACUNE DES (PX*PY) FONCTIONS
391 DO l=1,py
392 IF(knotlocpc(l,2,decalgeo+tabposz((j-1)*(px*py)+k))<knotlocel(1,2,i)+tol.AND.
393 . knotlocpc(l+1,2,decalgeo+tabposz((j-1)*(px*py)+k))>knotlocel(2,2,i)-tol) THEN
394c la position en Y de cette fonction est L : 1 la fonction est a droite, PY la fonction est a gauche
395 tmpzy(l)=tmpzy(l)+1
396 tabposzy((j-1)*(px*py)+(l-1)*py+tmpzy(l)) = tabposz((j-1)*(px*py)+k)
397 ENDIF
398 ENDDO
399 ENDDO
400 ENDDO
401C
402 tabposzyx(:)=0
403 DO j=1,pz ! sur chacun des PZ niveaux
404 DO k=1,py ! sur chacune des PY lignes
405 DO l=1,px ! POUR CHACUNE DES PX FONCTIONS
406 DO m=1,px
407 IF(knotlocpc(m,1,decalgeo+tabposzy((j-1)*(px*py)+(k-1)*py+l))<knotlocel(1,1,i)+tol.AND.
408 . knotlocpc(m+1,1,decalgeo+tabposzy((j-1)*(px*py)+(k-1)*py+l))>knotlocel(2,1,i)-tol) THEN
409c la position en X de cette fonction est M : 1 la fonction est devant, PX la fonction est derriere
410 tabposzyx((j-1)*(px*py)+(k-1)*py+m) = tabposzy((j-1)*(px*py)+(k-1)*py+l)
411 ENDIF
412 ENDDO
413 ENDDO
414 ENDDO
415 ENDDO
416C
417C-----------------------------------------------
418CC REECRICUTE DANS LA TABLE DE CONNECTIVITE GLOBALE DES
419CC ELEMENTS ISOGEOMETRIQUES
420C-----------------------------------------------
421C
422 DO j=1,nctrl
423 ixig3d(decalixig3d+j-1)=tabposzyx(j)
424 ENDDO
425C
426C-----------------------------------------------
427CC VERIFICATION DE LA REORGANISATION DES TABLES DE CONNECTIVITE
428CC EN FONCTION DES ETENDUES KNOT DE L'ELEMENTS ET DES PC
429C-----------------------------------------------
430C
431 IF(flag_debug==1) THEN
432 DO j=1,kxig3d(3,i)
433 inctrl=ixig3d(kxig3d(4,i)+j-1)
434 IF(knotlocel(1,1,i)<knotlocpc(1,1,decalgeo+inctrl)-em06 .OR.
435 . knotlocel(2,1,i)>knotlocpc(4,1,decalgeo+inctrl)+em06 .OR.
436 . knotlocel(1,2,i)<knotlocpc(1,2,decalgeo+inctrl)-em06 .OR.
437 . knotlocel(2,2,i)>knotlocpc(4,2,decalgeo+inctrl)+em06 .OR.
438 . knotlocel(1,3,i)<knotlocpc(1,3,decalgeo+inctrl)-em06 .OR.
439 . knotlocel(2,3,i)>knotlocpc(4,3,decalgeo+inctrl)+em06) THEN
440 print*,'DECALAGE : element : ',i,'point',inctrl
441 print*,'*************'
442 DO k=1,kxig3d(3,i)
443 print*,ixig3d(decalixig3d+k-1)
444 ENDDO
445 ENDIF
446 ENDDO
447
448C-----------------------------------------------
449C VERIFICATION PARTIEL DE L'ORDRE DE LA CONNECTIVITE
450C-----------------------------------------------
451
452 DO j=1,pz-1
453 DO k=1,py-1
454 DO l=1,px-1
455
456 itnctrl=(px*py)*(j-1)+px*(k-1)+l
457
458 inctrl=ixig3d(kxig3d(4,i)+itnctrl-1) !! IXIG3D range a l'envers 27->1
459 inctrl2=ixig3d(kxig3d(4,i)+itnctrl-1+1)
460 IF(knotlocpc(1,1,decalgeo+inctrl)<knotlocpc(1,1,decalgeo+inctrl2)) THEN
461 print*,'MAUVAIS RANGEMENT DANS IXIG3D : element : ',i,'point',inctrl
462 ENDIF
463
464 inctrl3=ixig3d(kxig3d(4,i)+itnctrl-1+px)
465 IF(knotlocpc(1,2,decalgeo+inctrl)<knotlocpc(1,2,decalgeo+inctrl3)) THEN
466 print*,'MAUVAIS RANGEMENT DANS IXIG3D : element : ',i,'point',inctrl
467 ENDIF
468
469 inctrl4=ixig3d(kxig3d(4,i)+itnctrl-1+px*py)
470 IF(knotlocpc(1,3,decalgeo+inctrl)<knotlocpc(1,3,decalgeo+inctrl4)) THEN
471 print*,'MAUVAIS RANGEMENT DANS IXIG3D : element : ',i,'point',inctrl
472 ENDIF
473
474 ENDDO
475
476 ENDDO
477 ENDDO
478
479 ENDIF
480C
481 ENDDO
482C
483 ENDIF
484C
485 RETURN
486 END
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
my_real
#define my_real
Definition cppsort.cpp:32
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
reorder_ig3d
subroutine reorder_ig3d(ixig3d, kxig3d, knotlocpc, knotlocel, x_tmp, d_tmp, v_tmp, ms_tmp, wige_tmp, tab_remove, tab_newfct, el_connect, ipartig3d, igeo, tab_stay, flag_pre, flag_debug)
Definition reorder_ig3d.F:34
myqsort3d
subroutine myqsort3d(n, x, perm)
Definition searchigeo3d.F:479