OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
searchigeo3d.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!|| presearchigeo3d ../starter/source/elements/ige3d/searchigeo3d.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| myqsort3d ../starter/source/elements/ige3d/searchigeo3d.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE presearchigeo3d(IGRSURF,xigetmp, permige)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE groupdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER PERMIGE(*)
48C REAL
49 my_real
50 . xigetmp(*)
51 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER IGS,J,NBTABIGE,IADTABIGE
56C-----------------------------------------------
57c NBTABIGE=0
58 iadtabige = 0
59c
60 DO igs=1,nsurf
61 IF(igrsurf(igs)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
62c NBTABIGE=NBTABIGE+16*IGRSURF(IGS)%NSEG_IGE ! nombre de points non tries de cette surface
63 nbtabige=16*igrsurf(igs)%NSEG_IGE/9 ! nombre de points non tries de cette surface
64
65 CALL myqsort3d(nbtabige,xigetmp(3*(iadtabige)+1),permige(iadtabige+1))
66
67 iadtabige = iadtabige + nbtabige
68
69 ENDIF
70 ENDDO
71
72c CALL MYQSORT3D(NBTABIGE,XIGETMP,PERMIGE)
73c
74 RETURN
75 END
76
77!||====================================================================
78!|| searchigeo3d ../starter/source/elements/ige3d/searchigeo3d.F
79!||--- called by ------------------------------------------------------
80!|| lectur ../starter/source/starter/lectur.F
81!||--- uses -----------------------------------------------------
82!||====================================================================
83 SUBROUTINE searchigeo3d(IGRSURF,IADTABIGEINI, PERM,
84 . NIGETMP, NIGE, RIGETMP, RIGE,
85 . XIGETMP, XIGE, VIGETMP, VIGE,
86 . NDOUBLONSTOT)
87C-----------------------------------------------
88C M o d u l e s
89C-----------------------------------------------
90 USE groupdef_mod
91C-----------------------------------------------
92C I m p l i c i t T y p e s
93C-----------------------------------------------
94#include "implicit_f.inc"
95C-----------------------------------------------
96C C o m m o n B l o c k s
97C-----------------------------------------------
98#include "com04_c.inc"
99C-----------------------------------------------
100C D u m m y A r g u m e n t s
101C-----------------------------------------------
102 INTEGER IADTABIGEINI,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
103c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
104c . IGBUFSSGTMP(*), IGBUFSSG(*)
105C REAL
106 my_real
107 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
108 . rige(3,*) , xige(3,*) , vige(3,*)
109 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
110C-----------------------------------------------
111C L o c a l V a r i a b l e s
112C-----------------------------------------------
113 INTEGER NVALEURS, PERMUTE(IADTABIGEINI),NDOUBLONS,NBTABIGE
114 INTEGER I,J,K,ITSURF,DECALSURF,IADTABIGE
115C REAL
116 my_real
117 . tol
118C-----------------------------------------------
119 tol=em06
120c
121 itsurf=1
122 i=1
123 ndoublonstot=0
124 iadtabige=0
125 DO itsurf=1,nsurf
126
127 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
128
129 igrsurf(itsurf)%IAD_IGE = i-1
130 decalsurf=i+ndoublonstot-1
131 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9 ! nombre de points non tries de cette surface
132 iadtabige = iadtabige + nbtabige
133 ndoublons=0
134
135 DO WHILE(i+ndoublonstot+ndoublons<=iadtabige)
136 nvaleurs = 0
137 nige(i) = nigetmp(perm(i+ndoublonstot+ndoublons)+decalsurf) ! + decalage dans le perm
138 rige(:,i) = rigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
139 xige(:,i) = xigetmp(:,i+ndoublonstot+ndoublons)
140 vige(:,i) = vigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
141 permute(perm(i+ndoublonstot+ndoublons)+decalsurf) = i - igrsurf(itsurf)%IAD_IGE
142 DO WHILE (((i+ndoublonstot+ndoublons+nvaleurs+1)<=decalsurf+nbtabige)!-1)
143 . .AND. (abs(xigetmp(1,i+ndoublonstot+ndoublons)-
144 . xigetmp(1,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
145 . .AND. (abs(xigetmp(2,i+ndoublonstot+ndoublons)-
146 . xigetmp(2,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
147 . .AND. (abs(xigetmp(3,i+ndoublonstot+ndoublons)-
148 . xigetmp(3,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol))
149 nvaleurs = nvaleurs + 1
150 permute(perm(i+ndoublonstot+ndoublons+nvaleurs)+decalsurf) = i - igrsurf(itsurf)%IAD_IGE
151 ENDDO
152 ndoublons=ndoublons+nvaleurs
153 i=i+1
154 ENDDO
155 ndoublonstot=ndoublonstot+ndoublons
156
157 DO j=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
158 DO k=1,4
159 igrsurf(itsurf)%NODES_IGE(j,k)=permute(igrsurf(itsurf)%NODES_IGE(j,k)-numnod)+numnod
160 ENDDO
161 ENDDO
162 ENDIF
163
164 ENDDO
165c
166 numfakenodigeo=numfakenodigeo-ndoublonstot
167
168 RETURN
169 END
170
171!||====================================================================
172!|| searchigeo3dold ../starter/source/elements/ige3d/searchigeo3d.F
173!||--- uses -----------------------------------------------------
174!||====================================================================
175 SUBROUTINE searchigeo3dold(IGRSURF,IADTABIGEINI, PERM,
176 . NIGETMP, NIGE, RIGETMP, RIGE,
177 . XIGETMP, XIGE, VIGETMP, VIGE,
178 . NDOUBLONSTOT)
179C-----------------------------------------------
180C M o d u l e s
181C-----------------------------------------------
182 USE groupdef_mod
183C-----------------------------------------------
184C I m p l i c i t T y p e s
185C-----------------------------------------------
186#include "implicit_f.inc"
187C-----------------------------------------------
188C C o m m o n B l o c k s
189C-----------------------------------------------
190#include "com04_c.inc"
191C-----------------------------------------------
192C D u m m y A r g u m e n t s
193C-----------------------------------------------
194 INTEGER IADTABIGEINI,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
195c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
196c . IGBUFSSGTMP(*), IGBUFSSG(*)
197C REAL
198 my_real
199 . RIGETMP(3,*), XIGETMP(3,*), VIGETMP(3,*),
200 . rige(3,*) , xige(3,*) , vige(3,*)
201 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205 INTEGER NVALEURS, PERMUTE(IADTABIGEINI),NDOUBLONS,NBTABIGE
206 INTEGER I,J,ITSURF,DECALSURF,IADTABIGE
207C REAL
208 my_real
209 . tol
210C-----------------------------------------------
211 tol=em06
212c
213 itsurf=1
214 i=1
215 ndoublonstot=0
216 DO itsurf=1,nsurf
217
218 decalsurf=i+ndoublonstot-1
219
220 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
221 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9! nombre de points non tries de cette surface
222 ndoublons=0
223
224 DO WHILE(i+ndoublonstot+ndoublons<=decalsurf+nbtabige)
225 nvaleurs = 0
226 nige(i) = nigetmp(perm(i+ndoublonstot+ndoublons)+decalsurf) ! + decalage dans le perm
227 rige(:,i) = rigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
228 xige(:,i) = xigetmp(:,i+ndoublonstot+ndoublons)
229 vige(:,i) = vigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
230 permute(perm(i+ndoublonstot+ndoublons)+decalsurf) = i!+DECALSURF
231 DO WHILE (((i+ndoublonstot+ndoublons+nvaleurs+1)<=decalsurf+nbtabige)!-1)
232 . .AND. (abs(xigetmp(1,i+ndoublonstot+ndoublons)-
233 . xigetmp(1,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
234 . .AND. (abs(xigetmp(2,i+ndoublonstot+ndoublons)-
235 . xigetmp(2,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
236 . .AND. (abs(xigetmp(3,i+ndoublonstot+ndoublons)-
237 . xigetmp(3,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol))
238 nvaleurs = nvaleurs + 1
239 permute(perm(i+ndoublonstot+ndoublons+nvaleurs)+decalsurf) = i!+DECALSURF
240 ENDDO
241 ndoublons=ndoublons+nvaleurs
242 i=i+1
243 ENDDO
244 ndoublonstot=ndoublonstot+ndoublons
245 ENDIF
246
247 ENDDO
248c
249 iadtabige=0
250 DO itsurf=1,nsurf
251 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
252 DO i=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
253 DO j=1,4
254 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
255 ENDDO
256 ENDDO
257 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9 ! nombre de points non tries de cette surface
258 iadtabige = iadtabige + nbtabige
259 ENDIF
260
261 ENDDO
262c
263 numfakenodigeo=numfakenodigeo-ndoublonstot
264
265 RETURN
266 END
267
268!||====================================================================
269!|| searchigeo3d3 ../starter/source/elements/ige3d/searchigeo3d.F
270!||--- uses -----------------------------------------------------
271!||====================================================================
272 SUBROUTINE searchigeo3d3(IGRSURF,N, PERM,
273c SUBROUTINE SEARCHIGEO3D(IGRSURF,N, NSEGIGE ,PERM,
274 . NIGETMP, NIGE, RIGETMP, RIGE,
275 . XIGETMP, XIGE, VIGETMP, VIGE,
276 . NDOUBLONSTOT)
277c . IGBUFSSGTMP, IGBUFSSG, NDOUBLONSTOT)
278C-----------------------------------------------
279C M o d u l e s
280C-----------------------------------------------
281 USE groupdef_mod
282C-----------------------------------------------
283C I m p l i c i t T y p e s
284C-----------------------------------------------
285#include "implicit_f.inc"
286C-----------------------------------------------
287C C o m m o n B l o c k s
288C-----------------------------------------------
289#include "com04_c.inc"
290C-----------------------------------------------
291C D u m m y A r g u m e n t s
292C-----------------------------------------------
293 INTEGER N,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
294c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
295c . IGBUFSSGTMP(*), IGBUFSSG(*)
296C REAL
297 my_real
298 . RIGETMP(3,*), XIGETMP(3,*), VIGETMP(3,*),
299 . RIGE(3,*) , XIGE(3,*) , VIGE(3,*)
300 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
301C-----------------------------------------------
302C L o c a l V a r i a b l e s
303C-----------------------------------------------
304 INTEGER NVALEURS, PERMUTE(N-1),NDOUBLONS,NBTABIGE,IADTABIGE,
305 . IADTABIGEINI
306 INTEGER I,J,ITSURF,DECALSURF,DECAL
307C REAL
308 my_real
309 . tol
310C-----------------------------------------------
311 tol=em06
312c IADTABIGEINI=N-1
313
314 iadtabigeini=n
315c
316 itsurf=1
317 ndoublonstot=0
318 i=1
319 decalsurf=0
320 decal=0
321 nbtabige=0
322
323 DO itsurf=1,nsurf
324 decalsurf=decalsurf+i-1 !+NDOUBLONS-1
325 decal = decal+nbtabige
326 i=1
327
328c on attaque ici les groupes de surface mais on a aussi les tableaux NIGE RIGE ET XIGE qui sont globaux
329
330 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
331 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9! nombre de points non tries de cette surface
332
333c NBTABIGE=16*IGRSURF(ITSURF)%NSEG_IGE ! nombre de points non tries de cette surface
334c IADTABIGE=ISURF(13,ITSURF) ! adresse des points non tries de cette surface dans NIGE
335c ISURF(13,ITSURF)=I ! nouvelle adresse des points tries de cette surface dans NIGE
336 ndoublons=0
337
338 DO WHILE(i+ndoublons<=nbtabige) ! a devrait etre tout les points, pas qu'une seule surface
339c DO WHILE(I+NDOUBLONSTOT+NDOUBLONS<=IADTABIGE+NBTABIGE-1)
340 nvaleurs = 0
341 nige(i+decalsurf) = nigetmp(perm(i+ndoublons+decal)) ! + decalage dans le perm
342 rige(:,i+decalsurf) = rigetmp(:,perm(i+ndoublons+decal))
343 xige(:,i+decalsurf) = xigetmp(:,i+decalsurf+ndoublons)
344 vige(:,i+decalsurf) = vigetmp(:,perm(i+ndoublons+decal))
345 permute(perm(i+ndoublons+decal)) = i+decalsurf
346c PERMUTE(PERM(I+NDOUBLONSTOT+NDOUBLONS)+DECALSURF) = I-ISURF(13,ITSURF)+1
347 DO WHILE (((i+ndoublons+nvaleurs+1)<=nbtabige)
348c DO WHILE (((I+NDOUBLONSTOT+NDOUBLONS+NVALEURS+1)<=IADTABIGE+NBTABIGE-1)
349 . .AND. (abs(xigetmp(1,i+decalsurf+ndoublons)-
350 . xigetmp(1,i+decalsurf+ndoublons+nvaleurs+1)) <= tol)
351 . .AND. (abs(xigetmp(2,i+decalsurf+ndoublons)-
352 . xigetmp(2,i+decalsurf+ndoublons+nvaleurs+1)) <= tol)
353 . .AND. (abs(xigetmp(3,i+decalsurf+ndoublons)-
354 . xigetmp(3,i+decalsurf+ndoublons+nvaleurs+1)) <= tol))
355 nvaleurs = nvaleurs + 1
356 permute(perm(i+ndoublons+nvaleurs+decal)) = i+decalsurf
357c PERMUTE(PERM(I+NDOUBLONSTOT+NDOUBLONS+NVALEURS)+DECALSURF) = I-ISURF(13,ITSURF)+1
358 ENDDO
359 ndoublons=ndoublons+nvaleurs
360 i=i+1
361 ENDDO
362 ndoublonstot=ndoublonstot+ndoublons
363 ENDIF
364
365 ENDDO
366c
367 DO itsurf=1,nsurf
368 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
369 DO i=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
370 DO j=1,4
371 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
372c IGBUFSSG(6*(I-1)+J) = PERMUTE(IGBUFSSGTMP(6*(I-1)+J)-NUMNOD)+NUMNOD
373 ENDDO
374 ENDDO
375 ENDIF
376 ENDDO
377c
378 numfakenodigeo=numfakenodigeo-ndoublonstot
379c NUMFAKENODIGEO=IADTABIGEINI-NDOUBLONSTOT
380c N=NUMFAKENODIGEO
381c
382 RETURN
383 END
384c
385
386!||====================================================================
387!|| searchigeo3d2 ../starter/source/elements/ige3d/searchigeo3d.F
388!||--- uses -----------------------------------------------------
389!||====================================================================
390 SUBROUTINE searchigeo3d2(IGRSURF,IADTABIGE, PERM,
391 . NIGETMP, NIGE, RIGETMP, RIGE,
392 . XIGETMP, XIGE, VIGETMP, VIGE,
393 . NDOUBLONS)
394C-----------------------------------------------
395C M o d u l e s
396C-----------------------------------------------
397 USE groupdef_mod
398C-----------------------------------------------
399C I m p l i c i t T y p e s
400C-----------------------------------------------
401#include "implicit_f.inc"
402C-----------------------------------------------
403C C o m m o n B l o c k s
404C-----------------------------------------------
405#include "com04_c.inc"
406C-----------------------------------------------
407C D u m m y A r g u m e n t s
408C-----------------------------------------------
409 INTEGER NDOUBLONS,PERM(*), NIGETMP(*),NIGE(*),
410 . iadtabige
411C REAL
412 my_real
413 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
414 . rige(3,*) , xige(3,*) , vige(3,*)
415 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
416C-----------------------------------------------
417C L o c a l V a r i a b l e s
418C-----------------------------------------------
419 INTEGER NVALEURS, PERMUTE(IADTABIGE)
420 INTEGER I,J,ITSURF
421C REAL
422 my_real
423 . tol
424C-----------------------------------------------
425 tol=em06
426c
427 itsurf=1
428 i=1
429 ndoublons=0
430
431 DO WHILE(i+ndoublons<=iadtabige)
432 nvaleurs = 0
433 nige(i) = nigetmp(perm(i+ndoublons)) ! + decalage dans le perm
434 rige(:,i) = rigetmp(:,perm(i+ndoublons))
435 xige(:,i) = xigetmp(:,i+ndoublons)
436 vige(:,i) = vigetmp(:,perm(i+ndoublons))
437 permute(perm(i+ndoublons)) = i!+1
438 DO WHILE (((i+ndoublons+nvaleurs+1)<=iadtabige))
439 IF(abs(xigetmp(3,i+ndoublons)-xigetmp(3,i+ndoublons+nvaleurs+1)) > tol) EXIT
440 IF(abs(xigetmp(2,i+ndoublons)-xigetmp(2,i+ndoublons+nvaleurs+1)) > tol) EXIT
441 IF(abs(xigetmp(1,i+ndoublons)-xigetmp(1,i+ndoublons+nvaleurs+1)) > tol) EXIT
442c . .AND. (ABS(XIGETMP(1,I+NDOUBLONS)-
443c . XIGETMP(1,I+NDOUBLONS+NVALEURS+1)) <= TOL)
444c . .AND. (ABS(XIGETMP(2,I+NDOUBLONS)-
445c . XIGETMP(2,I+NDOUBLONS+NVALEURS+1)) <= TOL)
446c . .AND. (ABS(XIGETMP(3,I+NDOUBLONS)-
447c . XIGETMP(3,I+NDOUBLONS+NVALEURS+1)) <= TOL))
448 nvaleurs = nvaleurs + 1
449 permute(perm(i+ndoublons+nvaleurs)) = i!+1
450 ENDDO
451 ndoublons=ndoublons+nvaleurs
452 i=i+1
453 ENDDO
454
455 DO itsurf=1,nsurf
456 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !! on est sur une surface o on a des elements isogeometriques
457 DO i=1,igrsurf(itsurf)%NSEG_IGE
458 DO j=1,4
459 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
460 ENDDO
461 ENDDO
462 ENDIF
463 ENDDO
464c
465 numfakenodigeo=iadtabige-ndoublons
466 iadtabige=numfakenodigeo
467c
468 RETURN
469 END
470c
471!||====================================================================
472!|| myqsort3d ../starter/source/elements/ige3d/searchigeo3d.F
473!||--- called by ------------------------------------------------------
474!|| presearchigeo3d ../starter/source/elements/ige3d/searchigeo3d.F
475!|| reorder_ig3d ../starter/source/elements/ige3d/reorder_ig3d.F
476!||--- calls -----------------------------------------------------
477!||====================================================================
478 SUBROUTINE myqsort3d(n, X, perm)
479C-----------------------------------------------
480C I m p l i c i t T y p e s
481C-----------------------------------------------
482#include "implicit_f.inc"
483C-----------------------------------------------
484C D u m m y A r g u m e n t s
485C-----------------------------------------------
486 INTEGER n,perm (n)
487 my_real
488 . X (3,n)
489C-----------------------------------------------
490C L o c a l V a r i a b l e s
491C-----------------------------------------------
492 my_real, DIMENSION(:,:), ALLOCATABLE:: x_copy
493 my_real, DIMENSION(:), ALLOCATABLE :: rkey
494 my_real :: maxi
495 INTEGER :: I,error
496
497C-----------------------------------------------
498 ALLOCATE(X_copy(3,n))
499 ALLOCATE(rkey(n))
500
501
502 x_copy(1:3,1:n) = x(1:3,1:n)
503 maxi = 0
504 DO i = 1,n
505 maxi = max(abs(x(1,i)),maxi)
506 maxi = max(abs(x(2,i)),maxi)
507 maxi = max(abs(x(3,i)),maxi)
508 ENDDO
509 DO i = 1,n
510 rkey(i) = (x(1,i)+maxi) * maxi * maxi + (x(2,i)+maxi) * maxi + (x(3,i)+maxi)
511 ENDDO
512 CALL myqsort(3*n,rkey,perm,error)
513 DO i = 1, n
514 x(1,i) = x_copy(1,perm(i))
515 x(2,i) = x_copy(2,perm(i))
516 x(3,i) = x_copy(3,perm(i))
517 ENDDO
518 DEALLOCATE(x_copy)
519 DEALLOCATE(rkey)
520 RETURN
521c
522 end
523c
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
groupdef_mod
Definition groupdef_mod.F:662
searchigeo3d3
subroutine searchigeo3d3(igrsurf, n, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
Definition searchigeo3d.F:277
myqsort3d
subroutine myqsort3d(n, x, perm)
Definition searchigeo3d.F:479
presearchigeo3d
subroutine presearchigeo3d(igrsurf, xigetmp, permige)
Definition searchigeo3d.F:32
searchigeo3d
subroutine searchigeo3d(igrsurf, iadtabigeini, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
Definition searchigeo3d.F:87
searchigeo3d2
subroutine searchigeo3d2(igrsurf, iadtabige, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublons)
Definition searchigeo3d.F:394
searchigeo3dold
subroutine searchigeo3dold(igrsurf, iadtabigeini, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
Definition searchigeo3d.F:179