OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sppro3.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!|| sppro3 ../engine/source/elements/sph/sppro3.F
25!||--- called by ------------------------------------------------------
26!|| sptrivox ../engine/source/elements/sph/sptrivox.F
27!||--- calls -----------------------------------------------------
28!|| myqsort ../common_source/tools/sort/myqsort.F
29!||--- uses -----------------------------------------------------
30!|| sphbox ../engine/share/modules/sphbox.F
31!||====================================================================
32 SUBROUTINE sppro3(IL ,KXSP ,IXSP ,NOD2SP,JVOIS,
33 . JSTOR,JPERM ,DVOIS,IREDUCE,KREDUCE,
34 . KXSPR,IXSPR,TAB_DK)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE sphbox
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "sphcom.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*),
55 . JVOIS(*),JSTOR(*), JPERM(*), IREDUCE, KREDUCE(*),
56 . kxspr(*), ixspr(kvoisph,*)
57C REAL
58 my_real
59 . dvois(*),tab_dk(*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER IL,
64 . JG,
65 . nvois, k, jk, nvois1, nvois2, ierror
66C REAL
67 my_real
68 . dk
69 my_real, DIMENSION(:), ALLOCATABLE :: dstor
70
71
72 IF(il <= numsph.AND.il > 0)THEN
73C-----------------
74C SORT THE LIST, KEEP THE FIRST KVOISPH
75C (INCREASING SAFETY COEFFICIENT).
76
77C-----------------
78 nvois=kxsp(5,il)
79 tab_dk(il) = -one
80 IF(nvois>kvoisph)THEN
81
82 ireduce =1
83 kreduce(il)=1
84
85 CALL myqsort(nvois,dvois,jperm,ierror)
86 DO k=1,nvois
87 jstor(k)=jvois(k)
88 ENDDO
89 DO k=1,kvoisph
90 jvois(k)=jstor(jperm(k))
91 ENDDO
92 dk=dvois(kvoisph)
93 tab_dk(il) = dk
94C-----------------
95C Choice of cells to keep such that distance < DK to avoid parallelization problems
96 nvois=0
97 DO k=1,kxsp(5,il)
98 IF(dvois(k)<dk)THEN
99 nvois=nvois+1
100 END IF
101 END DO
102
103 ENDIF
104C-----------------
105 nvois=min(nvois,kvoisph)
106 kxsp(5,il)=nvois
107 DO k=1,nvois
108 jk=jvois(k)
109 dk=dvois(k)
110
111 IF(jk<=numsph) THEN
112 jg =kxsp(3,jk)
113 ELSE
114 jg = -jk+numsph ! si voisin remote alors no noeud = - no cellule remote
115 xsphr(1,-jg) = -abs(xsphr(1,-jg)) ! reperage cell remote utile
116 END IF
117 ixsp(k,il)=jg
118 ENDDO
119C-----------------------------------------------------------
120 ELSEIF(il > numsph)THEN ! Treatment for unnecessary remote
121C-----------------
122 xsphr(1,il-numsph) = -abs(xsphr(1,il-numsph)) ! reperage cell remote utile
123C
124C SORT THE LIST, KEEP THE FIRST KVOISPH
125C (INCREASING SAFETY COEFFICIENT).
126C-----------------
127! Get the DK of the original cell
128 dk = dkr(il - numsph)
129 nvois=kxspr(il-numsph)
130 IF(dk>=zero) THEN
131 IF(nvois>kvoisph) THEN
132C-----------------
133C Choice of cells to keep such that distance < DK to avoid parallelization problems
134 nvois=kxspr(il-numsph)
135 CALL myqsort(nvois,dvois,jperm,ierror)
136 DO k=1,nvois
137 jstor(k)=jvois(k)
138 ENDDO
139 DO k=1,min(kvoisph,nvois)
140 jvois(k)=jstor(jperm(k))
141 ENDDO
142 nvois=min(nvois,kvoisph)
143 ELSE
144 ALLOCATE(dstor(kxspr(il-numsph)))
145 DO k=1,kxspr(il-numsph)
146 jstor(k)=jvois(k)
147 dstor(k)=dvois(k)
148 ENDDO
149 nvois=0
150 DO k=1,kxspr(il-numsph)
151 IF(dstor(k)<dk)THEN
152 nvois=nvois+1
153 jvois(nvois)=jstor(k)
154 dvois(nvois)=dstor(k)
155 END IF
156 END DO
157 DEALLOCATE(dstor)
158 nvois=min(nvois,kvoisph)
159 ENDIF
160 ELSE
161 nvois=kxspr(il-numsph)
162 ENDIF
163C-----------------
164 kxspr(il-numsph)=nvois
165 DO k=1,nvois
166 jk=jvois(k)
167 dk=dvois(k)
168 IF(jk<=numsph) THEN
169 jg=kxsp(3,jk)
170 ELSE
171 jg = 0
172 print *,'internal error'
173 END IF
174 ixspr(k,il-numsph)=jg
175 ENDDO
176 ELSE ! IL < 0 <=> Gauge
177C
178Cf gauges IL=-NUMSPH-...
179 il=abs(il)
180C-----------------
181C SORT THE LIST, KEEP THE FIRST KVOISPH
182C (INCREASING SAFETY COEFFICIENT).
183
184C-----------------
185 nvois=kxsp(5,il)
186 IF(nvois>kvoisph)THEN
187
188 CALL myqsort(nvois,dvois,jperm,ierror)
189 DO k=1,nvois
190 jstor(k)=jvois(k)
191 ENDDO
192 DO k=1,kvoisph
193 jvois(k)=jstor(jperm(k))
194 ENDDO
195 dk=dvois(kvoisph)
196C-----------------
197C Choice of cells to keep such that distance < DK to avoid parallelization problems
198 nvois=0
199 DO k=1,kxsp(5,il)
200 IF(dvois(k)<dk)THEN
201 nvois=nvois+1
202 END IF
203 END DO
204 ENDIF
205C-----------------
206 nvois=min(nvois,kvoisph)
207 kxsp(5,il)=nvois
208 nvois1=0
209 nvois2=nvois
210 DO k=1,nvois
211 jk =jvois(k)
212 dk =dvois(k)
213 IF(jk<=numsph) THEN
214 jg =kxsp(3,jk)
215 ELSE
216 jg = -jk+numsph ! si voisin remote alors no noeud = - no cellule remote
217 xsphr(1,-jg) = -abs(xsphr(1,-jg)) ! reperage cell remote utile
218 END IF
219
220 IF(dk<one)THEN
221 nvois1=nvois1+1
222 ixsp(nvois1,il)=jg
223 ELSE
224 ixsp(nvois2,il)=jg
225 nvois2=nvois2-1
226 ENDIF
227 ENDDO
228 kxsp(4,il)=nvois1
229C-----------------------------------------------------------
230 END IF
231
232 RETURN
233 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
sppro3
subroutine sppro3(il, kxsp, ixsp, nod2sp, jvois, jstor, jperm, dvois, ireduce, kreduce, kxspr, ixspr, tab_dk)
Definition sppro3.F:35