OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
searchigeo3d.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine presearchigeo3d (igrsurf, xigetmp, permige)
subroutine searchigeo3d (igrsurf, iadtabigeini, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
subroutine searchigeo3dold (igrsurf, iadtabigeini, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
subroutine searchigeo3d3 (igrsurf, n, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
subroutine searchigeo3d2 (igrsurf, iadtabige, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublons)
subroutine myqsort3d (n, x, perm)

Function/Subroutine Documentation

◆ myqsort3d()

subroutine myqsort3d ( integer n,
x,
integer, dimension (n) perm )

Definition at line 478 of file searchigeo3d.F.

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
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

◆ presearchigeo3d()

subroutine presearchigeo3d ( type (surf_), dimension(nsurf) igrsurf,
xigetmp,
integer, dimension(*) permige )

Definition at line 31 of file searchigeo3d.F.

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
groupdef_mod
Definition groupdef_mod.F:662
myqsort3d
subroutine myqsort3d(n, x, perm)
Definition searchigeo3d.F:479

◆ searchigeo3d()

subroutine searchigeo3d ( type (surf_), dimension(nsurf) igrsurf,
integer iadtabigeini,
integer, dimension(*) perm,
integer, dimension(*) nigetmp,
integer, dimension(*) nige,
rigetmp,
rige,
xigetmp,
xige,
vigetmp,
vige,
integer ndoublonstot )

Definition at line 83 of file searchigeo3d.F.

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

◆ searchigeo3d2()

subroutine searchigeo3d2 ( type (surf_), dimension(nsurf) igrsurf,
integer iadtabige,
integer, dimension(*) perm,
integer, dimension(*) nigetmp,
integer, dimension(*) nige,
rigetmp,
rige,
xigetmp,
xige,
vigetmp,
vige,
integer ndoublons )

Definition at line 390 of file searchigeo3d.F.

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

◆ searchigeo3d3()

subroutine searchigeo3d3 ( type (surf_), dimension(nsurf) igrsurf,
integer n,
integer, dimension(*) perm,
integer, dimension(*) nigetmp,
integer, dimension(*) nige,
rigetmp,
rige,
xigetmp,
xige,
vigetmp,
vige,
integer ndoublonstot )

Definition at line 272 of file searchigeo3d.F.

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
groupdef_mod::surf_
Definition groupdef_mod.F:745

◆ searchigeo3dold()

subroutine searchigeo3dold ( type (surf_), dimension(nsurf) igrsurf,
integer iadtabigeini,
integer, dimension(*) perm,
integer, dimension(*) nigetmp,
integer, dimension(*) nige,
rigetmp,
rige,
xigetmp,
xige,
vigetmp,
vige,
integer ndoublonstot )

Definition at line 175 of file searchigeo3d.F.

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