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 465 of file searchigeo3d.F.

466C-----------------------------------------------
467C I m p l i c i t T y p e s
468C-----------------------------------------------
469#include "implicit_f.inc"
470C-----------------------------------------------
471C D u m m y A r g u m e n t s
472C-----------------------------------------------
473 INTEGER n,perm (n)
474 my_real
475 . x(3,n)
476C-----------------------------------------------
477C L o c a l V a r i a b l e s
478C-----------------------------------------------
479 my_real, DIMENSION(:,:), ALLOCATABLE:: x_copy
480 my_real, DIMENSION(:), ALLOCATABLE :: rkey
481 my_real :: maxi
482 INTEGER :: I,error
483
484C-----------------------------------------------
485 ALLOCATE(x_copy(3,n))
486 ALLOCATE(rkey(n))
487
488
489 x_copy(1:3,1:n) = x(1:3,1:n)
490 maxi = 0
491 DO i = 1,n
492 maxi = max(abs(x(1,i)),maxi)
493 maxi = max(abs(x(2,i)),maxi)
494 maxi = max(abs(x(3,i)),maxi)
495 ENDDO
496 DO i = 1,n
497 rkey(i) = (x(1,i)+maxi) * maxi * maxi + (x(2,i)+maxi) * maxi + (x(3,i)+maxi)
498 ENDDO
499 CALL myqsort(3*n,rkey,perm,error)
500 DO i = 1, n
501 x(1,i) = x_copy(1,perm(i))
502 x(2,i) = x_copy(2,perm(i))
503 x(3,i) = x_copy(3,perm(i))
504 ENDDO
505 DEALLOCATE(x_copy)
506 DEALLOCATE(rkey)
507 RETURN
508c
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(*)
48 my_real :: xigetmp(*)
49 TYPE (SURF_), DIMENSION(NSURF) :: IGRSURF
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER IGS,NBTABIGE,IADTABIGE
54C-----------------------------------------------
55 iadtabige = 0
56c
57 DO igs=1,nsurf
58 IF(igrsurf(igs)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
59 nbtabige=16*igrsurf(igs)%NSEG_IGE/9 ! number of unsorted points on this surface
60 CALL myqsort3d(nbtabige,xigetmp(3*(iadtabige)+1),permige(iadtabige+1))
61 iadtabige = iadtabige + nbtabige
62 ENDIF
63 ENDDO
64
65c CALL MYQSORT3D(NBTABIGE,XIGETMP,PERMIGE)
66c
67 RETURN
groupdef_mod
Definition groupdef_mod.F:668
myqsort3d
subroutine myqsort3d(n, x, perm)
Definition searchigeo3d.F:466

◆ 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 76 of file searchigeo3d.F.

80C-----------------------------------------------
81C M o d u l e s
82C-----------------------------------------------
83 USE groupdef_mod
84C-----------------------------------------------
85C I m p l i c i t T y p e s
86C-----------------------------------------------
87#include "implicit_f.inc"
88C-----------------------------------------------
89C C o m m o n B l o c k s
90C-----------------------------------------------
91#include "com04_c.inc"
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 INTEGER IADTABIGEINI,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
96c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
97c . IGBUFSSGTMP(*), IGBUFSSG(*)
98C REAL
99 my_real
100 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
101 . rige(3,*) , xige(3,*) , vige(3,*)
102 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER NVALEURS, PERMUTE(IADTABIGEINI),NDOUBLONS,NBTABIGE
107 INTEGER I,J,K,ITSURF,DECALSURF,IADTABIGE
108C REAL
109 my_real
110 . tol
111C-----------------------------------------------
112 tol=em06
113c
114 itsurf=1
115 i=1
116 ndoublonstot=0
117 iadtabige=0
118 DO itsurf=1,nsurf
119
120 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
121
122 igrsurf(itsurf)%IAD_IGE = i-1
123 decalsurf=i+ndoublonstot-1
124 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9 ! number of unsorted points on this surface
125 iadtabige = iadtabige + nbtabige
126 ndoublons=0
127
128 DO WHILE(i+ndoublonstot+ndoublons<=iadtabige)
129 nvaleurs = 0
130 nige(i) = nigetmp(perm(i+ndoublonstot+ndoublons)+decalsurf) ! + offset in the perm
131 rige(:,i) = rigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
132 xige(:,i) = xigetmp(:,i+ndoublonstot+ndoublons)
133 vige(:,i) = vigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
134 permute(perm(i+ndoublonstot+ndoublons)+decalsurf) = i - igrsurf(itsurf)%IAD_IGE
135 DO WHILE (((i+ndoublonstot+ndoublons+nvaleurs+1)<=decalsurf+nbtabige)!-1)
136 . .AND. (abs(xigetmp(1,i+ndoublonstot+ndoublons)-
137 . xigetmp(1,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
138 . .AND. (abs(xigetmp(2,i+ndoublonstot+ndoublons)-
139 . xigetmp(2,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
140 . .AND. (abs(xigetmp(3,i+ndoublonstot+ndoublons)-
141 . xigetmp(3,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol))
142 nvaleurs = nvaleurs + 1
143 permute(perm(i+ndoublonstot+ndoublons+nvaleurs)+decalsurf) = i - igrsurf(itsurf)%IAD_IGE
144 ENDDO
145 ndoublons=ndoublons+nvaleurs
146 i=i+1
147 ENDDO
148 ndoublonstot=ndoublonstot+ndoublons
149
150 DO j=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
151 DO k=1,4
152 igrsurf(itsurf)%NODES_IGE(j,k)=permute(igrsurf(itsurf)%NODES_IGE(j,k)-numnod)+numnod
153 ENDDO
154 ENDDO
155 ENDIF
156
157 ENDDO
158c
159 numfakenodigeo=numfakenodigeo-ndoublonstot
160
161 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 377 of file searchigeo3d.F.

381C-----------------------------------------------
382C M o d u l e s
383C-----------------------------------------------
384 USE groupdef_mod
385C-----------------------------------------------
386C I m p l i c i t T y p e s
387C-----------------------------------------------
388#include "implicit_f.inc"
389C-----------------------------------------------
390C C o m m o n B l o c k s
391C-----------------------------------------------
392#include "com04_c.inc"
393C-----------------------------------------------
394C D u m m y A r g u m e n t s
395C-----------------------------------------------
396 INTEGER NDOUBLONS,PERM(*), NIGETMP(*),NIGE(*),
397 . IADTABIGE
398C REAL
399 my_real
400 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
401 . rige(3,*) , xige(3,*) , vige(3,*)
402 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
403C-----------------------------------------------
404C L o c a l V a r i a b l e s
405C-----------------------------------------------
406 INTEGER NVALEURS, PERMUTE(IADTABIGE)
407 INTEGER I,J,ITSURF
408C REAL
409 my_real
410 . tol
411C-----------------------------------------------
412 tol=em06
413c
414 itsurf=1
415 i=1
416 ndoublons=0
417
418 DO WHILE(i+ndoublons<=iadtabige)
419 nvaleurs = 0
420 nige(i) = nigetmp(perm(i+ndoublons)) ! + offset in the perm
421 rige(:,i) = rigetmp(:,perm(i+ndoublons))
422 xige(:,i) = xigetmp(:,i+ndoublons)
423 vige(:,i) = vigetmp(:,perm(i+ndoublons))
424 permute(perm(i+ndoublons)) = i!+1
425 DO WHILE (((i+ndoublons+nvaleurs+1)<=iadtabige))
426 IF(abs(xigetmp(3,i+ndoublons)-xigetmp(3,i+ndoublons+nvaleurs+1)) > tol) EXIT
427 IF(abs(xigetmp(2,i+ndoublons)-xigetmp(2,i+ndoublons+nvaleurs+1)) > tol) EXIT
428 IF(abs(xigetmp(1,i+ndoublons)-xigetmp(1,i+ndoublons+nvaleurs+1)) > tol) EXIT
429c . .AND. (ABS(XIGETMP(1,I+NDOUBLONS)-
430c . XIGETMP(1,I+NDOUBLONS+NVALEURS+1)) <= TOL)
431c . .AND. (ABS(XIGETMP(2,I+NDOUBLONS)-
432c . XIGETMP(2,I+NDOUBLONS+NVALEURS+1)) <= TOL)
433c . .AND. (ABS(XIGETMP(3,I+NDOUBLONS)-
434c . XIGETMP(3,I+NDOUBLONS+NVALEURS+1)) <= TOL))
435 nvaleurs = nvaleurs + 1
436 permute(perm(i+ndoublons+nvaleurs)) = i!+1
437 ENDDO
438 ndoublons=ndoublons+nvaleurs
439 i=i+1
440 ENDDO
441
442 DO itsurf=1,nsurf
443 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
444 DO i=1,igrsurf(itsurf)%NSEG_IGE
445 DO j=1,4
446 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
447 ENDDO
448 ENDDO
449 ENDIF
450 ENDDO
451c
452 numfakenodigeo=iadtabige-ndoublons
453 iadtabige=numfakenodigeo
454c
455 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 265 of file searchigeo3d.F.

270c . IGBUFSSGTMP, IGBUFSSG, NDOUBLONSTOT)
271C-----------------------------------------------
272C M o d u l e s
273C-----------------------------------------------
274 USE groupdef_mod
275C-----------------------------------------------
276C I m p l i c i t T y p e s
277C-----------------------------------------------
278#include "implicit_f.inc"
279C-----------------------------------------------
280C C o m m o n B l o c k s
281C-----------------------------------------------
282#include "com04_c.inc"
283C-----------------------------------------------
284C D u m m y A r g u m e n t s
285C-----------------------------------------------
286 INTEGER N,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
287c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
288c . IGBUFSSGTMP(*), IGBUFSSG(*)
289C REAL
290 my_real
291 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
292 . rige(3,*) , xige(3,*) , vige(3,*)
293 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
294C-----------------------------------------------
295C L o c a l V a r i a b l e s
296C-----------------------------------------------
297 INTEGER :: NVALEURS, PERMUTE(N-1),NDOUBLONS,NBTABIGE, IADTABIGEINI
298 INTEGER :: I,J,ITSURF,DECALSURF,DECAL
299 my_real :: tol
300C-----------------------------------------------
301 tol=em06
302 iadtabigeini=n
303 itsurf=1
304 ndoublonstot=0
305 i=1
306 decalsurf=0
307 decal=0
308 nbtabige=0
309
310 DO itsurf=1,nsurf
311 decalsurf=decalsurf+i-1 !+NDOUBLONS-1
312 decal = decal+nbtabige
313 i=1
314
315c here we start the surface groups but we also have the NIGE, RIGE and XIGE arrays which are global
316
317 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
318 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9! number of unsorted points on this surface
319
320c NBTABIGE=16*IGRSURF(ITSURF)%NSEG_IGE ! number of unsorted points on this surface
321c IADTABIGE=ISURF(13,ITSURF) ! address of the unsorted points of this surface in NIGE
322c ISURF(13,ITSURF)=I ! new address of the sorted points of this surface in NIGE
323 ndoublons=0
324
325 DO WHILE(i+ndoublons<=nbtabige) ! A should be all the points, not just one surface
326c DO WHILE(I+NDOUBLONSTOT+NDOUBLONS<=IADTABIGE+NBTABIGE-1)
327 nvaleurs = 0
328 nige(i+decalsurf) = nigetmp(perm(i+ndoublons+decal)) ! + offset in the perm
329 rige(:,i+decalsurf) = rigetmp(:,perm(i+ndoublons+decal))
330 xige(:,i+decalsurf) = xigetmp(:,i+decalsurf+ndoublons)
331 vige(:,i+decalsurf) = vigetmp(:,perm(i+ndoublons+decal))
332 permute(perm(i+ndoublons+decal)) = i+decalsurf
333c PERMUTE(PERM(I+NDOUBLONSTOT+NDOUBLONS)+DECALSURF) = I-ISURF(13,ITSURF)+1
334 DO WHILE (((i+ndoublons+nvaleurs+1)<=nbtabige)
335c DO WHILE (((I+NDOUBLONSTOT+NDOUBLONS+NVALEURS+1)<=IADTABIGE+NBTABIGE-1)
336 . .AND. (abs(xigetmp(1,i+decalsurf+ndoublons)-
337 . xigetmp(1,i+decalsurf+ndoublons+nvaleurs+1)) <= tol)
338 . .AND. (abs(xigetmp(2,i+decalsurf+ndoublons)-
339 . xigetmp(2,i+decalsurf+ndoublons+nvaleurs+1)) <= tol)
340 . .AND. (abs(xigetmp(3,i+decalsurf+ndoublons)-
341 . xigetmp(3,i+decalsurf+ndoublons+nvaleurs+1)) <= tol))
342 nvaleurs = nvaleurs + 1
343 permute(perm(i+ndoublons+nvaleurs+decal)) = i+decalsurf
344c PERMUTE(PERM(I+NDOUBLONSTOT+NDOUBLONS+NVALEURS)+DECALSURF) = I-ISURF(13,ITSURF)+1
345 ENDDO
346 ndoublons=ndoublons+nvaleurs
347 i=i+1
348 ENDDO
349 ndoublonstot=ndoublonstot+ndoublons
350 ENDIF
351
352 ENDDO
353c
354 DO itsurf=1,nsurf
355 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
356 DO i=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
357 DO j=1,4
358 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
359c IGBUFSSG(6*(I-1)+J) = PERMUTE(IGBUFSSGTMP(6*(I-1)+J)-NUMNOD)+NUMNOD
360 ENDDO
361 ENDDO
362 ENDIF
363 ENDDO
364c
365 numfakenodigeo=numfakenodigeo-ndoublonstot
366c NUMFAKENODIGEO=IADTABIGEINI-NDOUBLONSTOT
367c N=NUMFAKENODIGEO
368c
369 RETURN

◆ 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 168 of file searchigeo3d.F.

172C-----------------------------------------------
173C M o d u l e s
174C-----------------------------------------------
175 USE groupdef_mod
176C-----------------------------------------------
177C I m p l i c i t T y p e s
178C-----------------------------------------------
179#include "implicit_f.inc"
180C-----------------------------------------------
181C C o m m o n B l o c k s
182C-----------------------------------------------
183#include "com04_c.inc"
184C-----------------------------------------------
185C D u m m y A r g u m e n t s
186C-----------------------------------------------
187 INTEGER IADTABIGEINI,NDOUBLONSTOT,PERM(*), NIGETMP(*),NIGE(*)
188c INTEGER N,NDOUBLONSTOT,NSEGIGE,PERM(*), NIGETMP(*),NIGE(*),
189c . IGBUFSSGTMP(*), IGBUFSSG(*)
190C REAL
191 my_real
192 . rigetmp(3,*), xigetmp(3,*), vigetmp(3,*),
193 . rige(3,*) , xige(3,*) , vige(3,*)
194 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
195C-----------------------------------------------
196C L o c a l V a r i a b l e s
197C-----------------------------------------------
198 INTEGER NVALEURS, PERMUTE(IADTABIGEINI),NDOUBLONS,NBTABIGE
199 INTEGER I,J,ITSURF,DECALSURF,IADTABIGE
200C REAL
201 my_real
202 . tol
203C-----------------------------------------------
204 tol=em06
205c
206 itsurf=1
207 i=1
208 ndoublonstot=0
209 DO itsurf=1,nsurf
210
211 decalsurf=i+ndoublonstot-1
212
213 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
214 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9! number of unsorted points on this surface
215 ndoublons=0
216
217 DO WHILE(i+ndoublonstot+ndoublons<=decalsurf+nbtabige)
218 nvaleurs = 0
219 nige(i) = nigetmp(perm(i+ndoublonstot+ndoublons)+decalsurf) ! + offset in the perm
220 rige(:,i) = rigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
221 xige(:,i) = xigetmp(:,i+ndoublonstot+ndoublons)
222 vige(:,i) = vigetmp(:,perm(i+ndoublonstot+ndoublons)+decalsurf)
223 permute(perm(i+ndoublonstot+ndoublons)+decalsurf) = i!+DECALSURF
224 DO WHILE (((i+ndoublonstot+ndoublons+nvaleurs+1)<=decalsurf+nbtabige)!-1)
225 . .AND. (abs(xigetmp(1,i+ndoublonstot+ndoublons)-
226 . xigetmp(1,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
227 . .AND. (abs(xigetmp(2,i+ndoublonstot+ndoublons)-
228 . xigetmp(2,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol)
229 . .AND. (abs(xigetmp(3,i+ndoublonstot+ndoublons)-
230 . xigetmp(3,i+ndoublonstot+ndoublons+nvaleurs+1)) <= tol))
231 nvaleurs = nvaleurs + 1
232 permute(perm(i+ndoublonstot+ndoublons+nvaleurs)+decalsurf) = i!+DECALSURF
233 ENDDO
234 ndoublons=ndoublons+nvaleurs
235 i=i+1
236 ENDDO
237 ndoublonstot=ndoublonstot+ndoublons
238 ENDIF
239
240 ENDDO
241c
242 iadtabige=0
243 DO itsurf=1,nsurf
244 IF(igrsurf(itsurf)%NSEG_IGE>0) THEN !we are on a surface where there are isogeometric elements
245 DO i=1,igrsurf(itsurf)%NSEG_IGE!NSEGIGE
246 DO j=1,4
247 igrsurf(itsurf)%NODES_IGE(i,j)=permute(igrsurf(itsurf)%NODES_IGE(i,j)-numnod)+numnod
248 ENDDO
249 ENDDO
250 nbtabige=16*igrsurf(itsurf)%NSEG_IGE/9 ! number of unsorted points on this surface
251 iadtabige = iadtabige + nbtabige
252 ENDIF
253
254 ENDDO
255c
256 numfakenodigeo=numfakenodigeo-ndoublonstot
257
258 RETURN