OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_ne_connect.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!|| c_spmd_ne_connect ../starter/source/ale/spmd_ne_connect.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- uses -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE c_spmd_ne_connect(ALE_CONNECTIVITY, PROC , CEP , CEL ,
30 . NODGLOBAL , NODLOCAL,
31 . NUMEL , NUMNOD , NUMEL_L , NUMNOD_L,
32 . NUMELS_L , NUMELQ_L, NUMELTG_L,
33 . NERVOIS , NESVOIS ,
34 . NSVOIS , NQVOIS , NTGVOIS)
35C-----------------------------------------------
36C D e s c r i p t i o n
37C-----------------------------------------------
38C This subroutine is used to split connectivity
39C buffers in case of SPMD domain decomposition
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE ale_connectivity_mod
44! Includes
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
57 INTEGER, INTENT(IN) :: CEP(*), CEL(*)
58 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: NODLOCAL
59 INTEGER, DIMENSION(NUMNOD_L), INTENT(IN) :: NODGLOBAL
60 INTEGER, INTENT(IN) :: PROC, NUMNOD, NUMNOD_L, NUMEL, NUMEL_L,
61 . numels_l, numelq_l, numeltg_l
62 INTEGER, INTENT(INOUT) :: NSVOIS, NQVOIS, NTGVOIS, NERVOIS, NESVOIS
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER :: INODE, IAD, IAD1, IAD2, NODE_ID, P, IELEM, IELEM_L, PROC2, II
67 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGELE
68 INTEGER, DIMENSION(:, :), ALLOCATABLE :: TAGELE_L
69 INTEGER, DIMENSION(:), ALLOCATABLE :: LERCVOIS, LESDVOIS, NERCVOIS, NESDVOIS
70 INTEGER, DIMENSION(:), ALLOCATABLE :: PROC_LIST
71 INTEGER :: ELEM1_L, ELEM2_L
72 LOGICAL :: OK_RC
73C-----------------------------------------------
74C S o u r c e L i n e s
75C-----------------------------------------------
76 ALLOCATE(tagele(numel))
77 tagele(1:numel) = 0
78 ALLOCATE(tagele_l(nspmd, numel_l))
79 tagele_l(1:nspmd, 1:numel_l) = 0
80
81 ALLOCATE(nercvois(nspmd + 1))
82 nercvois(1:nspmd + 1) = 0
83 ALLOCATE(nesdvois(nspmd + 1))
84 nesdvois(1:nspmd + 1) = 0
85
86 nsvois = 0
87 nqvois = 0
88 ntgvois = 0
89
90 DO inode = 1, numnod_l
91 node_id = nodglobal(inode)
92 iad1 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id)
93 iad2 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id + 1) - 1
94 IF (iad2 >= iad1) ALLOCATE(proc_list(iad2 - iad1 + 1))
95 ok_rc = .false.
96 DO iad = iad1, iad2
97 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
98 ielem_l = cel(ielem)
99 proc2 = cep(ielem) ! CEP numbered from 0 to NSPMD - 1
100 proc_list(iad - iad1 + 1) = proc2
101 IF (proc2 == proc) THEN
102 ok_rc = .true.
103 ENDIF
104 ENDDO
105
106 IF (ok_rc) THEN
107 DO iad = iad1, iad2
108 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
109 ielem_l = cel(ielem)
110 proc2 = proc_list(iad - iad1 + 1)
111 IF (proc2 /= proc) THEN
112 IF (tagele(ielem) == 0) THEN
113 tagele(ielem) = 1
114 nercvois(proc2 + 1) = nercvois(proc2 + 1) + 1
115 IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 1) THEN
116 nsvois = nsvois + 1
117 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 2) THEN
118 nqvois = nqvois + 1
119 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 2) THEN
120 ntgvois = ntgvois + 1
121 ENDIF
122 ENDIF
123 ENDIF
124 ENDDO
125 ENDIF
126 DO iad = iad1, iad2
127 IF (proc_list(iad - iad1 + 1) == proc) THEN
128 elem1_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(iad))
129 DO ii = iad1, iad2
130 IF (ii /= iad) THEN
131 elem2_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(ii))
132 proc2 = proc_list(ii - iad1 + 1)
133 IF (proc2 /= proc) THEN
134 IF (tagele_l(proc2 + 1, elem1_l) == 0) THEN
135 tagele_l(proc2 + 1, elem1_l) = 1
136 nesdvois(proc2 + 1) = nesdvois(proc2 + 1) + 1
137 ENDIF
138 ENDIF
139 ENDIF
140 ENDDO
141 ENDIF
142 ENDDO
143 IF (ALLOCATED(proc_list)) DEALLOCATE(proc_list)
144 ENDDO
145 nesvois = 0
146 nervois = 0
147 DO p = 1, nspmd
148 nesvois = nesvois + nesdvois(p)
149 nervois = nervois + nercvois(p)
150 ENDDO
151
152 DEALLOCATE(tagele_l, tagele, nercvois, nesdvois)
153
154 END SUBROUTINE c_spmd_ne_connect
155
156
157!||====================================================================
158!|| spmd_ne_connect ../starter/source/ale/spmd_ne_connect.F
159!||--- called by ------------------------------------------------------
160!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
161!||--- calls -----------------------------------------------------
162!||--- uses -----------------------------------------------------
163!||====================================================================
164 SUBROUTINE spmd_ne_connect(ALE_CONNECTIVITY, PROC , CEP , CEL ,
165 . NODGLOBAL , NODLOCAL,
166 . NUMEL , NUMNOD , NUMEL_L , NUMNOD_L,
167 . NUMELS_L , NUMELQ_L, NUMELTG_L,
168 . NERVOIS , NESVOIS ,
169 . NSVOIS , NQVOIS , NTGVOIS , ELEMID_L, LEN_IA,IXS)
170C-----------------------------------------------
171C D e s c r i p t i o n
172C-----------------------------------------------
173C This subroutine is used to split connectivity
174C buffers in case of SPMD domain decomposition
175C-----------------------------------------------
176C M o d u l e s
177C-----------------------------------------------
178 USE ale_connectivity_mod
179C-----------------------------------------------
180C I m p l i c i t T y p e s
181C-----------------------------------------------
182#include "implicit_f.inc"
183C-----------------------------------------------
184C C o m m o n B l o c k s
185C-----------------------------------------------
186#include "com01_c.inc"
187C-----------------------------------------------
188C D u m m y A r g u m e n t s
189C-----------------------------------------------
190 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
191 INTEGER, INTENT(IN) :: CEP(*), CEL(*)
192 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: NODLOCAL
193 INTEGER, DIMENSION(NUMNOD_L), INTENT(IN) :: NODGLOBAL
194 INTEGER, INTENT(IN) :: PROC, NUMNOD, NUMNOD_L, NUMEL, NUMEL_L, NUMELS_L, NUMELQ_L, NUMELTG_L
195 INTEGER, INTENT(IN) :: NERVOIS, NESVOIS
196 INTEGER, INTENT(INOUT) :: NSVOIS, NQVOIS, NTGVOIS
197 INTEGER, DIMENSION(NUMEL), INTENT(INOUT) :: ELEMID_L
198 INTEGER, INTENT(INOUT) :: LEN_IA
199 INTEGER, INTENT(IN) :: IXS(11,*)
200C-----------------------------------------------
201C L o c a l V a r i a b l e s
202C-----------------------------------------------
203 INTEGER :: INODE, IAD, IAD1, IAD2, NODE_ID, P, IELEM, IELEM_L, PROC2, IFE, JFE, II
204 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGELE
205 INTEGER, DIMENSION(:, :), ALLOCATABLE :: TAGELE_L
206 INTEGER, DIMENSION(:), ALLOCATABLE :: LERCVOIS, LESDVOIS, NERCVOIS, NESDVOIS
207 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALER, CPULOCALES, TAGER, TAGES
208 INTEGER, DIMENSION(:), ALLOCATABLE :: IDX, TMP, TMP2, PROC_LIST
209 INTEGER :: ELEM1_L, ELEM2_L
210 LOGICAL :: OK_RC
211C-----------------------------------------------
212C S o u r c e L i n e s
213C-----------------------------------------------
214 ALLOCATE(tagele(numel))
215 tagele(1:numel) = 0
216 ALLOCATE(tagele_l(nspmd, numel_l))
217 tagele_l(1:nspmd, 1:numel_l) = 0
218 elemid_l(1:numel) = 0
219 ALLOCATE(lercvois(nervois))
220 lercvois(1:nervois) = 0
221 ALLOCATE(lesdvois(nesvois))
222 lercvois(1:nervois) = 0
223 ALLOCATE(nercvois(nspmd + 1))
224 nercvois(1:nspmd + 1) = 0
225 ALLOCATE(nesdvois(nspmd + 1))
226 nesdvois(1:nspmd + 1) = 0
227 ALLOCATE(tager(nervois))
228 tager(1:nervois) = 0
229 ALLOCATE(cpulocaler(nervois))
230 cpulocaler(1:nervois) = 0
231 ALLOCATE(tages(nesvois))
232 tages(1:nesvois) = 0
233 ALLOCATE(cpulocales(nesvois))
234 cpulocales(1:nesvois) = 0
235 ALLOCATE(idx(max(nervois, nesvois)))
236 idx(1:max(nervois, nesvois)) = 0
237 ALLOCATE(tmp(max(nervois, nesvois)))
238 tmp(1:max(nervois, nesvois)) = 0
239 ALLOCATE(tmp2(max(nervois, nesvois)))
240 tmp2(1:max(nervois, nesvois)) = 0
241
242 ife = 0
243 jfe = 0
244
245 DO inode = 1, numnod_l
246 node_id = nodglobal(inode)
247 iad1 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id)
248 iad2 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id + 1) - 1
249 IF (iad2 >= iad1) ALLOCATE(proc_list(iad2 - iad1 + 1))
250 ok_rc = .false.
251 DO iad = iad1, iad2
252 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
253 ielem_l = cel(ielem)
254 proc2 = cep(ielem) ! CEP numbered from 0 to NSPMD - 1
255 proc_list(iad - iad1 + 1) = proc2
256 IF (proc2 == proc) THEN
257 ok_rc = .true.
258 elemid_l(ielem) = ielem_l
259 ENDIF
260 ENDDO
261
262 IF (ok_rc) THEN
263 DO iad = iad1, iad2
264 ielem = ale_connectivity%NE_CONNECT%CONNECTED(iad)
265 ielem_l = cel(ielem)
266 proc2 = proc_list(iad - iad1 + 1)
267 IF (proc2 /= proc) THEN
268 IF (tagele(ielem) == 0) THEN
269 tagele(ielem) = 1
270 ife = ife + 1
271 IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 1) THEN
272 elemid_l(ielem) = numels_l + ife
273 lercvois(ife) = numels_l + ife
274 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 2) THEN
275 elemid_l(ielem) = numelq_l + ife
276 lercvois(ife) = numelq_l + ife
277 ELSE IF (ale_connectivity%NE_CONNECT%TYPE(iad) == 3) THEN
278 elemid_l(ielem) = numeltg_l + ife
279 lercvois(ife) = numeltg_l + ife
280 ENDIF
281 nercvois(proc2 + 1) = nercvois(proc2 + 1) + 1
282 tager(ife) = ielem
283 cpulocaler(ife) = proc2
284 ENDIF
285 ENDIF
286 ENDDO
287 ENDIF
288 DO iad = iad1, iad2
289 IF (proc_list(iad - iad1 + 1) == proc) THEN
290 elem1_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(iad))
291 DO ii = iad1, iad2
292 IF (ii /= iad) THEN
293 elem2_l = cel(ale_connectivity%NE_CONNECT%CONNECTED(ii))
294 proc2 = proc_list(ii - iad1 + 1)
295 IF (proc2 /= proc) THEN
296 IF (tagele_l(proc2 + 1, elem1_l) == 0) THEN
297 tagele_l(proc2 + 1, elem1_l) = 1
298 nesdvois(proc2 + 1) = nesdvois(proc2 + 1) + 1
299 jfe = jfe + 1
300 lesdvois(jfe) = elem1_l
301 tages(jfe) = ale_connectivity%NE_CONNECT%CONNECTED(iad)
302 cpulocales(jfe) = proc2
303 ENDIF
304 ENDIF
305 ENDIF
306 ENDDO
307 ENDIF
308 ENDDO
309
310 IF (ALLOCATED(proc_list)) DEALLOCATE(proc_list)
311 ENDDO
312
313 DO p = 1, nspmd
314 nercvois(nspmd + 1) = nercvois(nspmd + 1) + nercvois(p)
315 nesdvois(nspmd + 1) = nesdvois(nspmd + 1) + nesdvois(p)
316 ENDDO
317
318C Sorting LERCVOIS
319 DO ii = 1, nervois
320 tmp(ii) = tager(ii)
321 tmp2(ii) = lercvois(ii)
322 idx(ii) = ii
323 ENDDO
324 CALL quicksort_i2(cpulocaler, idx, 1, nervois)
325
326 DO ii = 1, nervois
327 tager(ii) = tmp(idx(ii))
328 lercvois(ii) = tmp2(idx(ii))
329 ENDDO
330 DO ii = 1, nervois
331 tmp2(ii) = lercvois(ii)
332 ENDDO
333
334 iad = 1
335 DO WHILE (iad <= nervois)
336 DO iad1 = iad, nervois
337 IF (cpulocaler(iad) /= cpulocaler(iad1)) THEN
338 EXIT
339 ENDIF
340 ENDDO
341 DO ii = iad, iad1 - 1
342 idx(ii) = ii
343 ENDDO
344 CALL quicksort_i2(tager(iad:iad1 - 1), idx(iad:iad1 - 1), 1, iad1 - iad)
345 iad = iad1
346 ENDDO
347
348 DO ii = 1, nervois
349 lercvois(ii) = tmp2(idx(ii))
350 ENDDO
351
352C Sorting LESDVOIS
353 DO ii = 1, nesvois
354 tmp(ii) = tages(ii)
355 tmp2(ii) = lesdvois(ii)
356 idx(ii) = ii
357 ENDDO
358 CALL quicksort_i2(cpulocales, idx, 1, nesvois)
359
360 DO ii = 1, nesvois
361 tages(ii) = tmp(idx(ii))
362 lesdvois(ii) = tmp2(idx(ii))
363 ENDDO
364 DO ii = 1, nesvois
365 tmp2(ii) = lesdvois(ii)
366 ENDDO
367
368 iad = 1
369 DO WHILE (iad <= nesvois)
370 DO iad1 = iad, nesvois
371 IF (cpulocales(iad) /= cpulocales(iad1)) THEN
372 EXIT
373 ENDIF
374 ENDDO
375 DO ii = iad, iad1 - 1
376 idx(ii) = ii
377 ENDDO
378 CALL quicksort_i2(tages(iad:iad1 - 1), idx(iad:iad1 - 1), 1, iad1 - iad)
379 iad = iad1
380 ENDDO
381
382 DO ii = 1, nesvois
383 lesdvois(ii) = tmp2(idx(ii))
384 ENDDO
385
386 CALL write_i_c(nercvois, nspmd + 1)
387 len_ia = len_ia + nspmd + 1
388 CALL write_i_c(lercvois, nervois)
389 len_ia = len_ia + nervois
390 CALL write_i_c(nesdvois, nspmd + 1)
391 len_ia = len_ia + nspmd + 1
392 CALL write_i_c(lesdvois, nesvois)
393 len_ia = len_ia + nesvois
394
395 DEALLOCATE(tagele, tagele_l, nercvois, nesdvois, lercvois, lesdvois,
396 . cpulocaler, cpulocales, tager, tages, tmp, tmp2, idx)
397 END SUBROUTINE spmd_ne_connect
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
c_spmd_ne_connect
subroutine c_spmd_ne_connect(ale_connectivity, proc, cep, cel, nodglobal, nodlocal, numel, numnod, numel_l, numnod_l, numels_l, numelq_l, numeltg_l, nervois, nesvois, nsvois, nqvois, ntgvois)
Definition spmd_ne_connect.F:35
spmd_ne_connect
subroutine spmd_ne_connect(ale_connectivity, proc, cep, cel, nodglobal, nodlocal, numel, numnod, numel_l, numnod_l, numels_l, numelq_l, numeltg_l, nervois, nesvois, nsvois, nqvois, ntgvois, elemid_l, len_ia, ixs)
Definition spmd_ne_connect.F:170
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645