OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
quicksort.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!|| quicksort ../common_source/tools/sort/quicksort.F
25!||--- called by ------------------------------------------------------
26!|| fvmesh1 ../engine/source/airbag/fvmesh.F
27!|| stat_inimap1d_file_spmd ../engine/source/output/sta/stat_inimap1d_file_spmd.F
28!|| stat_inimap1d_spmd ../engine/source/output/sta/stat_inimap1d_spmd.F
29!|| stat_inimap2d_file_spmd ../engine/source/output/sta/stat_inimap2d_file_spmd.F
30!|| stat_inimap2d_spmd ../engine/source/output/sta/stat_inimap2d_spmd.F
31!||--- calls -----------------------------------------------------
32!||====================================================================
33 RECURSIVE SUBROUTINE quicksort(A, IDX, FIRST, LAST)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C D u m m y A r g u m e n t s
40C-----------------------------------------------
41 my_real, INTENT(INOUT) :: a(*)
42 INTEGER, INTENT(IN) :: first, last
43 INTEGER, INTENT(INOUT) :: idx(*)
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 my_real x, t
48 INTEGER :: i, j, i1
49C-----------------------------------------------
50C P r e - C o n d i t i o n
51C-----------------------------------------------
52 IF(first>last)RETURN
53C-----------------------------------------------
54C S o u r c e L i n e s
55C-----------------------------------------------
56 x = a( (first + last) / 2 )
57 i = first
58 j = last
59 DO
60 DO WHILE (a(i) < x)
61 i = i + 1
62 ENDDO
63 DO WHILE(x < a(j))
64 j = j - 1
65 ENDDO
66 IF (i >= j) EXIT
67 t = a(i)
68 a(i) = a(j)
69 a(j) = t
70 i1 = idx(i)
71 idx(i) = idx(j)
72 idx(j) = i1
73 i = i + 1
74 j = j - 1
75 ENDDO
76 IF (first < i - 1) CALL quicksort(a, idx, first, i - 1)
77 IF (j + 1 < last) CALL quicksort(a, idx, j + 1, last)
78 END SUBROUTINE
79C________________________________________________________________________________________________________
80
81!||====================================================================
82!|| quicksort_i ../common_source/tools/sort/quicksort.F
83!||--- called by ------------------------------------------------------
84!|| ale_compute_connectivity ../common_source/modules/ale/ale_connectivity_mod.F
85!|| ini_inimap1d ../starter/source/initial_conditions/inimap/ini_inimap1d.F
86!|| monvol_check_delete_duplicated ../starter/source/airbag/monvol_check_delete_duplicated.F
87!|| sensor_init ../engine/source/tools/sensor/sensor_init.F
88!|| st_qaprint_model_tools ../starter/source/output/qaprint/st_qaprint_model_tools.F
89!||--- calls -----------------------------------------------------
90!||====================================================================
91 RECURSIVE SUBROUTINE quicksort_i(A, FIRST, LAST)
92C-----------------------------------------------
93C I m p l i c i t T y p e s
94C-----------------------------------------------
95#include "implicit_f.inc"
96C-----------------------------------------------
97C D u m m y A r g u m e n t s
98C-----------------------------------------------
99 INTEGER, INTENT(INOUT) :: a(*)
100 INTEGER, INTENT(IN) :: first, last
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104 INTEGER x, t
105 INTEGER :: i, j
106C-----------------------------------------------
107C P r e - C o n d i t i o n
108C-----------------------------------------------
109 IF(first>last)RETURN
110C-----------------------------------------------
111C S o u r c e L i n e s
112C-----------------------------------------------
113 x = a( (first + last) / 2 )
114 i = first
115 j = last
116 DO
117 DO WHILE (a(i) < x)
118 i = i + 1
119 ENDDO
120 DO WHILE(x < a(j))
121 j = j - 1
122 ENDDO
123 IF (i >= j) EXIT
124 t = a(i)
125 a(i) = a(j)
126 a(j) = t
127 i = i + 1
128 j = j - 1
129 ENDDO
130 IF (first < i - 1) CALL quicksort_i(a, first, i - 1)
131 IF (j + 1 < last) CALL quicksort_i(a, j + 1, last)
132 END SUBROUTINE
133C________________________________________________________________________________________________________
134
135!||====================================================================
136!|| quicksort_i2 ../common_source/tools/sort/quicksort.F
137!||--- called by ------------------------------------------------------
138!|| ale_compute_connectivity ../common_source/modules/ale/ale_connectivity_mod.F
139!|| nloc_dmg_init ../starter/source/materials/fail/nloc_dmg_init.F
140!|| spmd_ne_connect ../starter/source/ale/spmd_ne_connect.F
141!|| st_qaprint_constraints ../starter/source/output/qaprint/st_qaprint_constraints.F
142!|| st_qaprint_general_controls ../starter/source/output/qaprint/st_qaprint_general_controls.F
143!|| st_qaprint_initial_conditions ../starter/source/output/qaprint/st_qaprint_initial_conditions.F
144!|| st_qaprint_loads ../starter/source/output/qaprint/st_qaprint_loads.F
145!|| st_qaprint_model_tools ../starter/source/output/qaprint/st_qaprint_model_tools.F
146!|| st_qaprint_monvol ../starter/source/output/qaprint/st_qaprint_monvol.F
147!|| st_qaprint_thgrou ../starter/source/output/qaprint/st_qaprint_time_histories.F
148!|| stat_inimap2d_file_spmd ../engine/source/output/sta/stat_inimap2d_file_spmd.F
149!|| stat_inimap2d_spmd ../engine/source/output/sta/stat_inimap2d_spmd.F
150!||--- calls -----------------------------------------------------
151!||====================================================================
152 RECURSIVE SUBROUTINE quicksort_i2(A, IDX, FIRST, LAST)
153C-----------------------------------------------
154C I m p l i c i t T y p e s
155C-----------------------------------------------
156#include "implicit_f.inc"
157C-----------------------------------------------
158C D u m m y A r g u m e n t s
159C-----------------------------------------------
160 INTEGER, INTENT(INOUT) :: a(*)
161 INTEGER, INTENT(IN) :: first, last
162 INTEGER, INTENT(INOUT) :: idx(*)
163C-----------------------------------------------
164C L o c a l V a r i a b l e s
165C-----------------------------------------------
166 INTEGER :: x, t
167 INTEGER :: i, j, i1
168C-----------------------------------------------
169C P r e - C o n d i t i o n
170C-----------------------------------------------
171 IF(first>last)RETURN
172C-----------------------------------------------
173C S o u r c e L i n e s
174C-----------------------------------------------
175 x = a( (first + last) / 2 )
176 i = first
177 j = last
178 DO
179 DO WHILE (a(i) < x)
180 i = i + 1
181 ENDDO
182 DO WHILE(x < a(j))
183 j = j - 1
184 ENDDO
185 IF (i >= j) EXIT
186 t = a(i)
187 a(i) = a(j)
188 a(j) = t
189 i1 = idx(i)
190 idx(i) = idx(j)
191 idx(j) = i1
192 i = i + 1
193 j = j - 1
194 ENDDO
195 IF (first < i - 1) CALL quicksort_i2(a, idx, first, i - 1)
196 IF (j + 1 < last) CALL quicksort_i2(a, idx, j + 1, last)
197 END SUBROUTINE
198C________________________________________________________________________________________________________
199
200!||====================================================================
201!|| quicksort_integer_2arrays ../common_source/tools/sort/quicksort.F
202!||--- called by ------------------------------------------------------
203!||--- calls -----------------------------------------------------
204!||====================================================================
205 RECURSIVE SUBROUTINE quicksort_integer_2arrays(A, B, FIRST, LAST)
206 ! SORT columns A,B (key=A)
207C-----------------------------------------------
208C I m p l i c i t T y p e s
209C-----------------------------------------------
210#include "implicit_f.inc"
211C-----------------------------------------------
212C D u m m y A r g u m e n t s
213C-----------------------------------------------
214 INTEGER, INTENT(INOUT) :: a(*),b(*)
215 INTEGER, INTENT(IN) :: first, last
216C-----------------------------------------------
217C L o c a l V a r i a b l e s
218C-----------------------------------------------
219 INTEGER x, t
220 INTEGER :: i, j
221C-----------------------------------------------
222C P r e - C o n d i t i o n
223C-----------------------------------------------
224 IF(first>last)RETURN
225C-----------------------------------------------
226C S o u r c e L i n e s
227C-----------------------------------------------
228 x = a( (first + last) / 2 )
229 i = first
230 j = last
231 DO
232 DO WHILE (a(i) < x)
233 i = i + 1
234 ENDDO
235 DO WHILE(x < a(j))
236 j = j - 1
237 ENDDO
238 IF (i >= j) EXIT
239 t = a(i)
240 a(i) = a(j)
241 a(j) = t
242 !
243 t = b(i)
244 b(i) = b(j)
245 b(j) = t
246 !
247 i = i + 1
248 j = j - 1
249 ENDDO
250 IF (first < i - 1) CALL quicksort_integer_2arrays(a,b, first, i - 1)
251 IF (j + 1 < last) CALL quicksort_integer_2arrays(a,b, j + 1, last)
252 END SUBROUTINE
253C________________________________________________________________________________________________________
254
255!||====================================================================
256!|| quicksort_integer_3arrays ../common_source/tools/sort/quicksort.F
257!||--- called by ------------------------------------------------------
258!||--- calls -----------------------------------------------------
259!||====================================================================
260 RECURSIVE SUBROUTINE quicksort_integer_3arrays(A, B, C, FIRST, LAST)
261 ! SORT columns A,B,C (key=A)
262C-----------------------------------------------
263C I m p l i c i t T y p e s
264C-----------------------------------------------
265#include "implicit_f.inc"
266C-----------------------------------------------
267C D u m m y A r g u m e n t s
268C-----------------------------------------------
269 INTEGER, INTENT(INOUT) :: a(*),b(*),c(*)
270 INTEGER, INTENT(IN) :: first, last
271C-----------------------------------------------
272C L o c a l V a r i a b l e s
273C-----------------------------------------------
274 INTEGER x, t
275 INTEGER :: i, j
276C-----------------------------------------------
277C P r e - C o n d i t i o n
278C-----------------------------------------------
279 IF(first>last)RETURN
280C-----------------------------------------------
281C S o u r c e L i n e s
282C-----------------------------------------------
283 x = a( (first + last) / 2 )
284 i = first
285 j = last
286 DO
287 DO WHILE (a(i) < x)
288 i = i + 1
289 ENDDO
290 DO WHILE(x < a(j))
291 j = j - 1
292 ENDDO
293 IF (i >= j) EXIT
294 t = a(i)
295 a(i) = a(j)
296 a(j) = t
297 !
298 t = b(i)
299 b(i) = b(j)
300 b(j) = t
301 !
302 t = c(i)
303 c(i) = c(j)
304 c(j) = t
305 !
306 i = i + 1
307 j = j - 1
308 ENDDO
309 IF (first < i - 1) CALL quicksort_integer_3arrays(a,b,c, first, i - 1)
310 IF (j + 1 < last) CALL quicksort_integer_3arrays(a,b,c, j + 1, last)
311 END SUBROUTINE
312C________________________________________________________________________________________________________
my_real
#define my_real
Definition cppsort.cpp:32
quicksort_integer_2arrays
recursive subroutine quicksort_integer_2arrays(a, b, first, last)
Definition quicksort.F:206
quicksort_integer_3arrays
recursive subroutine quicksort_integer_3arrays(a, b, c, first, last)
Definition quicksort.F:261
quicksort_i
recursive subroutine quicksort_i(a, first, last)
Definition quicksort.F:92
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
quicksort
recursive subroutine quicksort(a, idx, first, last)
Definition quicksort.F:34