OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ana_orderings_wrappers_m.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14#if defined(__ve__)
15#if defined(VHOFFLOAD)
16#include 've.h'
17#endif
18#endif
19 MODULE mumps_ana_ord_wrappers
20 IMPLICIT NONE
21 CONTAINS
22#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
23#if defined(metis4) || defined(parmetis3)
24 SUBROUTINE mumps_metis_nodewnd_mixedto32( NCMP, IPE8, IW, FRERE,
25 & NUMFLAG,
26 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
27 & LP, LPOK )
28 IMPLICIT NONE
29 INTEGER :: INFO(2), LOPTIONS_METIS
30 INTEGER :: NCMP, NUMFLAG, IKEEP1(:), IKEEP2(:), FRERE(:)
31 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS), IW(:)
32 INTEGER, INTENT(IN) :: LP
33 LOGICAL, INTENT(IN) :: LPOK
34 INTEGER(8) :: IPE8(:)
35 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE
36 INTEGER :: allocok
37 IF (ipe8(ncmp+1) .GE. int(huge(iw),8)) THEN
38 info(1) = -51
39 CALL mumps_set_ierror(
40 & ipe8(ncmp+1), info(2))
41 RETURN
42 ENDIF
43 ALLOCATE(ipe(ncmp+1), stat=allocok)
44 IF (allocok > 0) THEN
45 info(1)=-7
46 info(2)=ncmp+1
47 IF (lpok) WRITE(lp,'(A)')
48 & "ERROR memory allocation in METIS_NODEWND_MIXEDto32"
49 RETURN
50 ENDIF
51 CALL mumps_icopy_64to32(ipe8(1), ncmp+1, ipe)
52 CALL metis_nodewnd(ncmp, ipe, iw(1),frere(1),
53 & numflag, options_metis,
54 & ikeep2(1), ikeep1(1) )
55 RETURN
56 END SUBROUTINE mumps_metis_nodewnd_mixedto32
57 SUBROUTINE mumps_metis_nodend_mixedto32( NCMP, IPE8, IW, NUMFLAG,
58 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
59 & LP, LPOK)
60 IMPLICIT NONE
61 INTEGER :: INFO(2), LOPTIONS_METIS
62 INTEGER :: NCMP, NUMFLAG, IKEEP1(:), IKEEP2(:), IW(:)
63 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS)
64 INTEGER(8) :: IPE8(:)
65 INTEGER, INTENT(IN) :: LP
66 LOGICAL, INTENT(IN) :: LPOK
67 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE
68 INTEGER :: allocok
69 IF (ipe8(ncmp+1) .GE. int(huge(iw),8)) THEN
70 info(1) = -51
71 CALL mumps_set_ierror(
72 & ipe8(ncmp+1), info(2))
73 RETURN
74 ENDIF
75 ALLOCATE(ipe(ncmp+1), stat=allocok)
76 IF (allocok > 0) THEN
77 info(1)=-7
78 info(2)=ncmp+1
79 IF (lpok) WRITE(lp,'(A)')
80 & "ERROR memory allocation in METIS_NODEND_MIXEDto32"
81 RETURN
82 ENDIF
83 CALL mumps_icopy_64to32(ipe8(1), ncmp+1, ipe)
84 CALL metis_nodend(ncmp, ipe, iw(1),
85 & numflag, options_metis,
86 & ikeep2(1), ikeep1(1) )
87 DEALLOCATE(ipe)
88 RETURN
89 END SUBROUTINE mumps_metis_nodend_mixedto32
90#else
91 SUBROUTINE mumps_metis_nodend_mixedto32( NCMP, IPE8, IW, FRERE,
92 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
93 & LP, LPOK )
94 IMPLICIT NONE
95 INTEGER :: INFO(2), LOPTIONS_METIS
96 INTEGER :: NCMP, IKEEP1(:), IKEEP2(:), FRERE(:), IW(:)
97 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS)
98 INTEGER(8) :: IPE8(:)
99 INTEGER, INTENT(IN) :: LP
100 LOGICAL, INTENT(IN) :: LPOK
101 INTEGER,ALLOCATABLE, DIMENSION(:) :: IPE
102 INTEGER :: allocok
103 IF (ipe8(ncmp+1) .GE. int(huge(iw),8)) THEN
104 info(1) = -51
105 CALL mumps_set_ierror(
106 & ipe8(ncmp+1), info(2))
107 RETURN
108 ENDIF
109 ALLOCATE(ipe(ncmp+1), stat=allocok)
110 IF (allocok > 0) THEN
111 info(1)=-7
112 info(2)=ncmp+1
113 IF (lpok) WRITE(lp,'(A)')
114 & "ERROR memory allocation in METIS_NODEND_MIXEDto32"
115 RETURN
116 ENDIF
117 CALL mumps_icopy_64to32(ipe8(1), ncmp+1, ipe)
118 CALL metis_nodend( ncmp, ipe, iw(1), frere(1),
119 & options_metis, ikeep2(1), ikeep1(1))
120 DEALLOCATE(ipe)
121 RETURN
122 END SUBROUTINE mumps_metis_nodend_mixedto32
123#endif
124#endif
125#if defined(metis) || defined(parmetis) || defined(metis4) || defined(parmetis3)
126#if defined(metis4) || defined(parmetis3)
127 SUBROUTINE mumps_metis_nodewnd_mixedto64( NCMP, IPE8, IW, FRERE,
128 & NUMFLAG,
129 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
130 & LP, LPOK, KEEP10, INPLACE64_GRAPH_COPY )
131 IMPLICIT NONE
132 INTEGER :: INFO(2), LOPTIONS_METIS
133 INTEGER :: NCMP, NUMFLAG, IKEEP1(:), IKEEP2(:), FRERE(:)
134 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS), IW(:)
135 INTEGER(8) :: IPE8(:)
136 INTEGER, INTENT(IN) :: LP, KEEP10
137 LOGICAL, INTENT(IN) :: LPOK
138 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY
139 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8, FRERE8,
140 & IKEEP18, IKEEP28
141 INTEGER :: allocok
142 IF (keep10.EQ.1) THEN
143 CALL metis_nodewnd(ncmp, ipe8(1), iw(1),frere,
144 & numflag, options_metis,
145 & ikeep2(1), ikeep1(1) )
146 ELSE
147 IF (inplace64_graph_copy) THEN
148 CALL mumps_icopy_32to64_64c_ip(iw(1), ipe8(ncmp+1)-1_8)
149 ELSE
150 ALLOCATE(iw8(ipe8(ncmp+1)-1_8),
151 & stat=allocok)
152 IF (allocok > 0) THEN
153 info(1)=-7
154 CALL mumps_set_ierror(
155 & int(keep10,8)* ( ipe8(ncmp+1)-1_8 )
156 & , info(2)
157 & )
158 IF (lpok) WRITE(lp,'(A)')
159 & "ERROR memory allocation in METIS_NODEWND_MIXEDto64"
160 RETURN
161 ENDIF
162 CALL mumps_icopy_32to64_64c(iw(1), ipe8(ncmp+1)-1_8, iw8 )
163 ENDIF
164 ALLOCATE(frere8(ncmp),
165 & ikeep18(ncmp), ikeep28(ncmp), stat=allocok)
166 IF (allocok > 0) THEN
167 info(1)=-7
168 CALL mumps_set_ierror(
169 & int(keep10,8)* ( 3_8*int(ncmp,8) )
170 & , info(2)
171 & )
172 IF (lpok) WRITE(lp,'(A)')
173 & "ERROR memory allocation in METIS_NODEWND_MIXEDto64"
174 RETURN
175 ENDIF
176 CALL mumps_icopy_32to64 (frere, ncmp , frere8)
177 IF (inplace64_graph_copy) THEN
178 CALL metis_nodewnd(ncmp, ipe8(1), iw(1),frere8,
179 & numflag, options_metis,
180 & ikeep2(1), ikeep1(1) )
181 ELSE
182 CALL metis_nodewnd(ncmp, ipe8(1), iw8,frere8,
183 & numflag, options_metis,
184 & ikeep2(1), ikeep1(1) )
185 ENDIF
186 CALL mumps_icopy_64to32(ikeep18, ncmp, ikeep1(1))
187 CALL mumps_icopy_64to32(ikeep28, ncmp, ikeep2(1))
188 IF (inplace64_graph_copy) THEN
189 DEALLOCATE(frere8, ikeep18, ikeep28)
190 ELSE
191 DEALLOCATE(iw8, frere8, ikeep18, ikeep28)
192 ENDIF
193 ENDIF
194 RETURN
195 END SUBROUTINE mumps_metis_nodewnd_mixedto64
196 SUBROUTINE mumps_metis_nodend_mixedto64( NCMP, IPE8, IW, NUMFLAG,
197 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
198 & LP, LPOK, KEEP10,
199 & LIW8, INPLACE64_GRAPH_COPY, INPLACE64_RESTORE_GRAPH
200 & )
201 IMPLICIT NONE
202 INTEGER :: INFO(2), LOPTIONS_METIS
203 INTEGER :: NCMP, NUMFLAG, IKEEP1(:), IKEEP2(:), IW(:)
204 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS)
205 INTEGER(8) :: IPE8(:)
206 INTEGER, INTENT(IN) :: LP, KEEP10
207 LOGICAL, INTENT(IN) :: LPOK
208 INTEGER(8) :: LIW8
209 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY,
210 & inplace64_restore_graph
211 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8,
212 & IKEEP18, IKEEP28
213 INTEGER :: allocok
214 IF (KEEP10.EQ.1) THEN
215 CALL metis_nodend(ncmp, ipe8(1), iw(1),
216 & numflag, options_metis,
217 & ikeep2(1), ikeep1(1) )
218 ELSE
219 IF (inplace64_graph_copy) THEN
220 CALL mumps_icopy_32to64_64c_ip(iw(1), ipe8(ncmp+1)-1_8)
221 ELSE
222 ALLOCATE(iw8(ipe8(ncmp+1)-1_8), stat=allocok)
223 IF (allocok > 0) THEN
224 info(1)=-7
225 CALL mumps_set_ierror( int(keep10,8)*
226 & ( ipe8(ncmp+1)-1_8+2_8*int(ncmp,8) )
227 & , info(2) )
228 IF (lpok) WRITE(lp,'(A)')
229 & "ERROR 1 memory allocation in METIS_METIS_NODEND_MIXEDto64"
230 RETURN
231 ENDIF
232 CALL mumps_icopy_32to64_64c(iw(1), ipe8(ncmp+1)-1_8, iw8 )
233 ENDIF
234 ALLOCATE(ikeep18(ncmp), ikeep28(ncmp), stat=allocok)
235 IF (allocok > 0) THEN
236 info(1)=-7
237 CALL mumps_set_ierror( int(keep10,8)*
238 & 2_8*int(ncmp,8), info(2) )
239 IF (lpok) WRITE(lp,'(A)')
240 & "ERROR 2 memory allocation in METIS_METIS_NODEND_MIXEDto64"
241 RETURN
242 ENDIF
243 IF (inplace64_graph_copy) THEN
244 CALL metis_nodend(ncmp, ipe8(1), iw(1),
245 & numflag, options_metis,
246 & ikeep28, ikeep18 )
247 ELSE
248 CALL metis_nodend(ncmp, ipe8(1), iw8,
249 & numflag, options_metis,
250 & ikeep28, ikeep18 )
251 ENDIF
252 CALL mumps_icopy_64to32(ikeep18, ncmp, ikeep1(1))
253 CALL mumps_icopy_64to32(ikeep28, ncmp, ikeep2(1))
254 IF (inplace64_graph_copy) THEN
255 IF (inplace64_restore_graph) THEN
256 CALL mumps_icopy_64to32_64c_ip(iw(1), ipe8(ncmp+1)-1_8)
257 ENDIF
258 DEALLOCATE(ikeep18, ikeep28)
259 ELSE
260 DEALLOCATE(iw8, ikeep18, ikeep28)
261 ENDIF
262 ENDIF
263 RETURN
264 END SUBROUTINE mumps_metis_nodend_mixedto64
265#else
266 SUBROUTINE mumps_metis_nodend_mixedto64( NCMP, IPE8, IW, FRERE,
267 & OPTIONS_METIS, LOPTIONS_METIS, IKEEP2, IKEEP1, INFO,
268 & LP, LPOK, KEEP10,
269 & LIW8, INPLACE64_GRAPH_COPY, INPLACE64_RESTORE_GRAPH
270 & )
271 IMPLICIT NONE
272 INTEGER :: INFO(2)
273 INTEGER :: LOPTIONS_METIS
274 INTEGER :: NCMP, IKEEP1(:), IKEEP2(:), FRERE(:), IW(:)
275 INTEGER :: OPTIONS_METIS(LOPTIONS_METIS)
276 INTEGER(8) :: IPE8(:)
277 INTEGER, INTENT(IN) :: LP, KEEP10
278 LOGICAL, INTENT(IN) :: LPOK
279 INTEGER(8) :: LIW8
280 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY,
281 & inplace64_restore_graph
282 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: IW8, FRERE8,
283 & IKEEP18, IKEEP28,
284 & options_metis8
285 INTEGER :: allocok
286 IF (KEEP10.EQ.1) THEN
287 CALL METIS_NODEND( NCMP, IPE8(1), IW(1), FRERE(1),
288 & OPTIONS_METIS, IKEEP2(1), IKEEP1(1) )
289 ELSE
290 IF (inplace64_graph_copy) THEN
291 CALL mumps_icopy_32to64_64c_ip(iw(1), ipe8(ncmp+1)-1_8)
292 ELSE
293 ALLOCATE(iw8(ipe8(ncmp+1)-1_8), stat=allocok)
294 IF (allocok > 0) THEN
295 info(1)=-7
296 CALL mumps_set_ierror( int(keep10,8) * (ipe8(ncmp+1)-1_8)
297 & , info(2) )
298 IF (lpok) WRITE(lp,'(A)')
299 & "ERROR 1 memory allocation in METIS_METIS_NODEND_MIXEDto64"
300 RETURN
301 ENDIF
302 CALL mumps_icopy_32to64_64c(iw(1), ipe8(ncmp+1)-1_8, iw8 )
303 ENDIF
304 ALLOCATE(frere8(ncmp),
305 & ikeep18(ncmp), ikeep28(ncmp),
306 & options_metis8(loptions_metis), stat=allocok)
307 IF (allocok > 0) THEN
308 info(1)=-7
309 CALL mumps_set_ierror(
310 & int(keep10,8)*
311 & (3_8*int(ncmp,8)+int(loptions_metis,8))
312 & , info(2))
313 IF (lpok) WRITE(lp,'(A)')
314 & "ERROR 2 memory allocation in METIS_NODEND_MIXEDto64"
315 RETURN
316 ENDIF
317 CALL mumps_icopy_32to64 (frere(1), ncmp, frere8)
318 CALL mumps_icopy_32to64 (options_metis, loptions_metis,
319 & options_metis8)
320 IF (inplace64_graph_copy) THEN
321 CALL metis_nodend( int(ncmp,8), ipe8(1), iw(1), frere8,
322 & options_metis8, ikeep28, ikeep18 )
323 ELSE
324 CALL metis_nodend( int(ncmp,8), ipe8(1), iw8, frere8,
325 & options_metis8, ikeep28, ikeep18 )
326 ENDIF
327 CALL mumps_icopy_64to32(ikeep18, ncmp, ikeep1(1))
328 CALL mumps_icopy_64to32(ikeep28, ncmp, ikeep2(1))
329 IF (inplace64_graph_copy) THEN
330 IF (inplace64_restore_graph) THEN
331 CALL mumps_icopy_64to32_64c_ip(iw(1), ipe8(ncmp+1)-1_8)
332 ENDIF
333 DEALLOCATE(frere8, ikeep18, ikeep28, options_metis8)
334 ELSE
335 DEALLOCATE(iw8, frere8, ikeep18, ikeep28, options_metis8)
336 ENDIF
337 ENDIF
338 RETURN
339 END SUBROUTINE mumps_metis_nodend_mixedto64
340#endif
341#endif
342#if defined(scotch) || defined(ptscotch)
343 SUBROUTINE mumps_scotch_mixedto32(NCMP, LIW8, IPE8, PARENT, IWFR8,
344 & PTRAR, IW, IWL1, IKEEP1,
345 & IKEEP2, NCMPA, INFO, LP, LPOK,
346 & WEIGHTUSED, WEIGHTREQUESTED, SCOTCH_SYMBOLIC)
347!$ USE OMP_LIB
348 IMPLICIT NONE
349 INTEGER, INTENT(IN) :: NCMP
350 INTEGER(8), INTENT(IN) :: LIW8
351 INTEGER, INTENT(OUT) :: NCMPA
352 INTEGER(8), INTENT(INOUT) :: IPE8(:)
353 INTEGER, INTENT(OUT) :: PARENT(NCMP)
354 INTEGER(8), INTENT(IN) :: IWFR8
355 INTEGER :: PTRAR(NCMP)
356 INTEGER :: IW(:)
357 INTEGER :: IWL1(NCMP)
358 INTEGER, INTENT(OUT) :: IKEEP1(:)
359 INTEGER, INTENT(OUT) :: IKEEP2(:)
360 INTEGER, INTENT(INOUT) :: INFO(2)
361 INTEGER, INTENT(IN) :: LP
362 LOGICAL, INTENT(IN) :: LPOK
363 INTEGER, INTENT(OUT) :: WEIGHTUSED
364 INTEGER, INTENT(IN) :: WEIGHTREQUESTED
365 LOGICAL, INTENT(IN) :: SCOTCH_SYMBOLIC
366 INTEGER, DIMENSION(:), ALLOCATABLE :: IPE
367 INTEGER :: allocok
368 INTEGER :: PTHREAD_NUMBER, NOMP
369 IF (iwfr8 .GE. int(huge(iw),8)) THEN
370 info(1) = -51
371 CALL mumps_set_ierror(ipe8(ncmp+1), info(2))
372 RETURN
373 ENDIF
374 ALLOCATE(ipe(ncmp+1), stat=allocok)
375 IF (allocok > 0) THEN
376 IF (lpok) WRITE(lp,'(A)')
377 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto32"
378 info(1) = -7
379 info(2) = ncmp+1
380 RETURN
381 ENDIF
382 CALL mumps_icopy_64to32(ipe8(1),ncmp+1,ipe)
383 nomp=0
384!$ NOMP=omp_get_max_threads()
385 IF (nomp .GT. 0) THEN
386 CALL mumps_scotch_get_pthread_number (pthread_number)
387 CALL mumps_scotch_set_pthread_number (nomp)
388 ENDIF
389 IF (scotch_symbolic) THEN
390 CALL mumps_scotch( ncmp, int(liw8), ipe, int(iwfr8),
391 & ptrar, iw(1), iwl1, ikeep1(1),
392 & ikeep2(1), ncmpa,
393 & weightused, weightrequested )
394 ELSE
395 CALL mumps_scotch_ord ( ncmp, int(liw8), ipe, int(iwfr8),
396 & ptrar, iw(1), iwl1, ikeep1(1),
397 & ikeep2(1), ncmpa,
398 & weightused, weightrequested )
399 ENDIF
400 IF (nomp .GT. 0) THEN
401 CALL mumps_scotch_set_pthread_number (pthread_number)
402 ENDIF
403 IF (scotch_symbolic) THEN
404 parent(1:ncmp)=ipe(1:ncmp)
405 ENDIF
406 DEALLOCATE(ipe)
407 RETURN
408 END SUBROUTINE mumps_scotch_mixedto32
409 SUBROUTINE mumps_scotch_mixedto64(
410 & NCMP, LIW8, IPE8, PARENT, IWFR8,
411 & PTRAR, IW, IWL1, IKEEP1,
412 & IKEEP2, NCMPA, INFO, LP, LPOK, KEEP10,
413 & INPLACE64_GRAPH_COPY,
414 & WEIGHTUSED, WEIGHTREQUESTED, SCOTCH_SYMBOLIC)
415!$ USE OMP_LIB
416 IMPLICIT NONE
417 INTEGER, INTENT(IN) :: NCMP
418 INTEGER(8), INTENT(IN) :: LIW8
419 INTEGER, INTENT(OUT) :: NCMPA
420 INTEGER(8), INTENT(INOUT) :: IPE8(:)
421 INTEGER, INTENT(OUT) :: PARENT(NCMP)
422 INTEGER(8), INTENT(IN) :: IWFR8
423 INTEGER :: PTRAR(NCMP)
424 INTEGER :: IW(:)
425 INTEGER :: IWL1(NCMP)
426 INTEGER, INTENT(OUT) :: IKEEP1(:)
427 INTEGER, INTENT(OUT) :: IKEEP2(:)
428 INTEGER, INTENT(INOUT) :: INFO(2)
429 INTEGER, INTENT(IN) :: LP
430 LOGICAL, INTENT(IN) :: LPOK
431 INTEGER, INTENT(IN) :: KEEP10
432 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY
433 INTEGER, INTENT(OUT) :: WEIGHTUSED
434 INTEGER, INTENT(IN) :: WEIGHTREQUESTED
435 LOGICAL, INTENT(IN) :: SCOTCH_SYMBOLIC
436 INTEGER(8), DIMENSION(:), ALLOCATABLE ::
437 & PTRAR8, IW8, IWL18, IKEEP18,
438 & IKEEP28, IPE8_TEMP
439 INTEGER :: allocok
440 INTEGER :: PTHREAD_NUMBER, NOMP
441 ALLOCATE( IPE8_TEMP(NCMP+1), stat=allocok )
442 IF (allocok > 0) THEN
443 IF (lpok) WRITE(lp,*)
444 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto64"
445 info(1) = -7
446 info(2) = ncmp+1
447 RETURN
448 ENDIF
449 ipe8_temp(1:ncmp+1) = ipe8(1:ncmp+1)
450 nomp=0
451!$ NOMP=omp_get_max_threads()
452 IF (keep10.EQ.1) THEN
453 IF (nomp .GT. 0) THEN
454 CALL mumps_scotch_get_pthread_number (pthread_number)
455 CALL mumps_scotch_set_pthread_number (nomp)
456 ENDIF
457 IF (scotch_symbolic) THEN
458 CALL mumps_scotch_64( ncmp, liw8,
459 & ipe8_temp(1),
460 & iwfr8,
461 & ptrar, iw(1), iwl1, ikeep1(1),
462 & ikeep2(1), ncmpa,
463 & weightused, weightrequested)
464 parent(1:ncmp) = int(ipe8_temp(1:ncmp))
465 ELSE
466 CALL mumps_scotch_ord_64( ncmp, liw8,
467 & ipe8_temp(1),
468 & iwfr8,
469 & ptrar, iw(1), iwl1, ikeep1(1),
470 & ikeep2(1), ncmpa,
471 & weightused, weightrequested)
472 ENDIF
473 IF (nomp .GT. 0) THEN
474 CALL mumps_scotch_set_pthread_number (pthread_number)
475 ENDIF
476 ELSE
477 IF (inplace64_graph_copy) THEN
478 CALL mumps_icopy_32to64_64c_ip(iw(1), ipe8_temp(ncmp+1)-1_8)
479 ELSE
480 ALLOCATE( iw8(liw8), stat=allocok )
481 IF (allocok > 0) THEN
482 IF (lpok) WRITE(lp,*)
483 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto64"
484 info(1) = -7
485 CALL mumps_set_ierror( int(keep10,8) * liw8
486 & , info(2) )
487 GOTO 500
488 ENDIF
489 CALL mumps_icopy_32to64_64c(iw(1),liw8,iw8)
490 ENDIF
491 ALLOCATE(
492 & ptrar8(ncmp), iwl18(ncmp), ikeep18(ncmp), ikeep28(ncmp),
493 & stat=allocok )
494 IF (allocok > 0) THEN
495 IF (lpok) WRITE(lp,*)
496 & "ERROR memory allocation in MUMPS_SCOTCH_MIXEDto64"
497 info(1) = -7
498 CALL mumps_set_ierror( int(keep10,8) *
499 & ( int(ncmp,8)*4_8 )
500 & , info(2) )
501 GOTO 500
502 ENDIF
503 CALL mumps_icopy_32to64(ptrar,ncmp,ptrar8)
504 IF (weightrequested.EQ.1) THEN
505 CALL mumps_icopy_32to64(iwl1,ncmp,iwl18)
506 ENDIF
507 IF (nomp .GT. 0) THEN
508 CALL mumps_scotch_get_pthread_number (pthread_number)
509 CALL mumps_scotch_set_pthread_number (nomp)
510 ENDIF
511 IF (inplace64_graph_copy) THEN
512 IF (scotch_symbolic) THEN
513 CALL mumps_scotch_64(
514 & int(ncmp,8), liw8,
515 & ipe8_temp(1),
516 & iwfr8,
517 & ptrar8, iw(1), iwl18,
518 & ikeep1(1), ikeep2(1), ncmpa,
519 & weightused,
520 & weightrequested )
521 ELSE
522 CALL mumps_scotch_ord_64 (
523 & int(ncmp,8), liw8,
524 & ipe8_temp(1),
525 & iwfr8,
526 & ptrar8, iw(1), iwl18,
527 & ikeep1(1),
528 & ikeep2(1), ncmpa,
529 & weightused,
530 & weightrequested )
531 ENDIF
532 ELSE
533 IF (scotch_symbolic) THEN
534 CALL mumps_scotch_64(
535 & int(ncmp,8), liw8,
536 & ipe8_temp(1),
537 & iwfr8,
538 & ptrar8, iw8, iwl18,
539 & ikeep1(1), ikeep2(1), ncmpa,
540 & weightused,
541 & weightrequested )
542 ELSE
543 CALL mumps_scotch_ord_64(
544 & int(ncmp,8), liw8,
545 & ipe8_temp(1),
546 & iwfr8,
547 & ptrar8, iw8, iwl18,
548 & ikeep1(1),
549 & ikeep2(1), ncmpa,
550 & weightused,
551 & weightrequested )
552 ENDIF
553 ENDIF
554 IF (nomp .GT. 0) THEN
555 CALL mumps_scotch_set_pthread_number (pthread_number)
556 ENDIF
557 IF (ncmpa .LT. 0) THEN
558 IF (lpok) WRITE(lp,*)
559 & ' Error on output from SCOTCH, NCMPA=', ncmpa
560 info( 1 ) = -9999
561 info( 2 ) = 3
562 GOTO 500
563 ENDIF
564 CALL mumps_icopy_64to32(iwl18,ncmp,iwl1)
565 CALL mumps_icopy_64to32(ikeep18,ncmp,ikeep1(1))
566 CALL mumps_icopy_64to32(ikeep28,ncmp,ikeep2(1))
567 IF (scotch_symbolic) THEN
568 CALL mumps_icopy_64to32(ipe8_temp(1),ncmp,parent)
569 ENDIF
570 500 CONTINUE
571 IF (.NOT.inplace64_graph_copy) THEN
572 IF (ALLOCATED(iw8)) DEALLOCATE(iw8)
573 ENDIF
574 IF (ALLOCATED(ptrar8)) DEALLOCATE(ptrar8)
575 IF (ALLOCATED(iwl18)) DEALLOCATE(iwl18)
576 IF (ALLOCATED(ikeep18)) DEALLOCATE(ikeep18)
577 IF (ALLOCATED(ikeep28)) DEALLOCATE(ikeep28)
578 ENDIF
579 IF (ALLOCATED(ipe8_temp)) DEALLOCATE(ipe8_temp)
580 RETURN
581 END SUBROUTINE mumps_scotch_mixedto64
582#endif
583#if defined (scotch) || defined (ptscotch)
584 SUBROUTINE mumps_scotch_kway_mixedto32(NHALO, HALOEDGENBR,
585 & IPTRHALO, JCNHALO,
586 & NBGROUPS, PARTS, LP, LPOK, KEEP10,
587 & IFLAG, IERROR)
588 IMPLICIT NONE
589 include 'scotchf.h'
590 INTEGER(8) :: HALOEDGENBR
591 INTEGER :: NHALO, NBGROUPS
592 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO)
593 INTEGER(8) :: IPTRHALO(NHALO+1)
594 INTEGER, INTENT(IN) :: LP, KEEP10
595 LOGICAL, INTENT(IN) :: LPOK
596 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
597 DOUBLE PRECISION :: GRAFDAT(SCOTCH_GRAPHDIM)
598 DOUBLE PRECISION :: STRADAT(SCOTCH_STRATDIM)
599 INTEGER :: BASEVAL, IERR, EDGENBR
600 INTEGER, ALLOCATABLE :: IPTRHALO_I4(:)
601 INTEGER :: allocok
602 IF (iptrhalo(size(iptrhalo)) .GE. int(huge(lp),8)) THEN
603 iflag = -51
604 CALL mumps_set_ierror( iptrhalo(size(iptrhalo)),
605 & ierror )
606 RETURN
607 ENDIF
608 ALLOCATE(iptrhalo_i4(size(iptrhalo)), stat=allocok)
609 IF (allocok > 0) THEN
610 iflag = -7
611 ierror = size(iptrhalo)
612 IF (lpok) WRITE(lp,'(A)')
613 & "ERROR memory allocation in MUMPS_SCOTCH_KWAY_MIXEDto32"
614 RETURN
615 END IF
616 CALL mumps_icopy_64to32(iptrhalo,
617 & size(iptrhalo), iptrhalo_i4)
618 baseval = 1
619 edgenbr = iptrhalo_i4(nhalo+1)
620 CALL scotchfgraphbuild(grafdat(1), baseval, nhalo,
621 & iptrhalo_i4(1), iptrhalo_i4(2), iptrhalo_i4(1),
622 & iptrhalo_i4(1), edgenbr, jcnhalo(1), jcnhalo(1), ierr)
623 CALL scotchfstratinit(stradat, ierr)
624 CALL scotchfgraphpart(grafdat(1), nbgroups, stradat(1),
625 & parts(1), ierr)
626 CALL scotchfstratexit(stradat)
627 CALL scotchfgraphexit(grafdat)
628 parts(1:nhalo) = parts(1:nhalo)+1
629 DEALLOCATE(iptrhalo_i4)
630 RETURN
631 END SUBROUTINE mumps_scotch_kway_mixedto32
632 SUBROUTINE mumps_scotch_kway_mixedto64(NHALO, HALOEDGENBR,
633 & IPTRHALO, JCNHALO,
634 & NBGROUPS, PARTS, LP, LPOK, KEEP10,
635 & IFLAG, IERROR)
636 IMPLICIT NONE
637 include 'scotchf.h'
638 INTEGER(8) :: HALOEDGENBR
639 INTEGER :: NHALO, NBGROUPS
640 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO)
641 INTEGER(8) :: IPTRHALO(NHALO+1)
642 INTEGER, INTENT(IN) :: LP, KEEP10
643 LOGICAL, INTENT(IN) :: LPOK
644 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
645 DOUBLE PRECISION :: GRAFDAT(SCOTCH_GRAPHDIM)
646 DOUBLE PRECISION :: STRADAT(SCOTCH_STRATDIM)
647 INTEGER :: IERR
648 INTEGER(8), ALLOCATABLE :: JCNHALO_I8(:), PARTS_I8(:)
649 INTEGER(8) :: NHALO_I8, NBGROUPS_I8, EDGENBR_I8,
650 & baseval_i8
651 INTEGER :: allocok
652 ALLOCATE(jcnhalo_i8(iptrhalo(nhalo+1)-1_8),
653 & parts_i8(size(parts)), stat=allocok)
654 IF (allocok > 0) THEN
655 iflag =-7
656 CALL mumps_set_ierror(
657 & int(keep10,8)* (iptrhalo(nhalo+1)-1_8
658 & +int(size(parts),8)),
659 & ierror)
660 IF (lpok) WRITE(lp,'(A)')
661 & "ERROR memory allocation in MUMPS_SCOTCH_KWAY_MIXEDto64 "
662 ENDIF
663 CALL mumps_icopy_32to64_64c(jcnhalo,
664 & iptrhalo(nhalo+1)-1, jcnhalo_i8)
665 nhalo_i8 = int(nhalo,8)
666 nbgroups_i8 = int(nbgroups,8)
667 baseval_i8 = 1_8
668 edgenbr_i8 = iptrhalo(nhalo+1)
669 CALL scotchfgraphbuild(grafdat(1), baseval_i8, nhalo_i8,
670 & iptrhalo(1), iptrhalo(2), iptrhalo(1),
671 & iptrhalo(1), edgenbr_i8, jcnhalo_i8(1), jcnhalo_i8(1), ierr)
672 CALL scotchfstratinit(stradat, ierr)
673 CALL scotchfgraphpart(grafdat(1), nbgroups_i8, stradat(1),
674 & parts_i8(1), ierr)
675 CALL scotchfstratexit(stradat)
676 CALL scotchfgraphexit(grafdat)
677 CALL mumps_icopy_64to32(parts_i8,
678 & size(parts), parts)
679 DEALLOCATE(jcnhalo_i8, parts_i8)
680 parts(1:nhalo) = parts(1:nhalo)+1
681 RETURN
682 END SUBROUTINE mumps_scotch_kway_mixedto64
683#endif
684#if defined (metis) || defined (parmetis) || defined (metis4) || defined (parmetis3)
685 SUBROUTINE mumps_metis_kway_mixedto32(NHALO, HALOEDGENBR,
686 & IPTRHALO,
687 & JCNHALO, NBGROUPS, PARTS, LP, LPOK, KEEP10,
688 & IFLAG, IERROR)
689 IMPLICIT NONE
690 INTEGER(8) :: HALOEDGENBR
691 INTEGER :: NHALO, NBGROUPS
692 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO)
693 INTEGER(8) :: IPTRHALO(NHALO+1)
694 INTEGER, INTENT(IN) :: LP, KEEP10
695 LOGICAL, INTENT(IN) :: LPOK
696 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
697 INTEGER, ALLOCATABLE :: IPTRHALO_I4(:)
698 INTEGER :: allocok
699 IF (IPTRHALO(size(IPTRHALO)) .GE. int(huge(LP),8)) THEN
700 iflag = -51
701 CALL mumps_set_ierror( iptrhalo(size(iptrhalo)),
702 & ierror)
703 RETURN
704 ENDIF
705 ALLOCATE(iptrhalo_i4(size(iptrhalo)), stat=allocok)
706 IF (allocok > 0) THEN
707 iflag = -7
708 ierror = size(iptrhalo)
709 IF (lpok) WRITE(lp,'(A)')
710 & "ERROR memory allocation in MUMPS_METIS_KWAY_MIXEDto32"
711 RETURN
712 END IF
713 CALL mumps_icopy_64to32(iptrhalo,
714 & size(iptrhalo), iptrhalo_i4)
715 CALL mumps_metis_kway(nhalo, iptrhalo_i4(1),
716 & jcnhalo(1), nbgroups, parts(1))
717 DEALLOCATE(iptrhalo_i4)
718 RETURN
719 END SUBROUTINE mumps_metis_kway_mixedto32
720 SUBROUTINE mumps_metis_kway_mixedto64(NHALO, HALOEDGENBR,
721 & IPTRHALO,
722 & JCNHALO, NBGROUPS, PARTS, LP, LPOK, KEEP10,
723 & IFLAG, IERROR)
724 IMPLICIT NONE
725 INTEGER(8) :: HALOEDGENBR
726 INTEGER :: NHALO, NBGROUPS
727 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO)
728 INTEGER(8) :: IPTRHALO(NHALO+1)
729 INTEGER, INTENT(IN) :: LP, KEEP10
730 LOGICAL, INTENT(IN) :: LPOK
731 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
732 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: JCNHALO_I8, PARTS_I8
733 INTEGER(8) :: NHALO_I8, NBGROUPS_I8
734 INTEGER :: allocok
735 ALLOCATE(jcnhalo_i8(iptrhalo(nhalo+1)-1_8),
736 & parts_i8(size(parts)), stat=allocok)
737 IF (allocok > 0) THEN
738 iflag = -7
739 CALL mumps_set_ierror(
740 & int(keep10,8)* (iptrhalo(nhalo+1)-1_8+int(size(parts),8)),
741 & ierror)
742 IF (lpok) WRITE(lp,'(A)')
743 & "ERROR memory allocation in MUMPS_METIS_KWAY_MIXEDto64 "
744 ENDIF
745 nhalo_i8 = int(nhalo,8)
746 nbgroups_i8 = int(nbgroups,8)
747 CALL mumps_icopy_32to64_64c(jcnhalo,
748 & iptrhalo(nhalo+1)-1, jcnhalo_i8)
749 CALL mumps_metis_kway_64(nhalo_i8, iptrhalo(1),
750 & jcnhalo_i8(1), nbgroups_i8, parts_i8(1))
751 CALL mumps_icopy_64to32(parts_i8,
752 & size(parts), parts)
753 DEALLOCATE(jcnhalo_i8, parts_i8)
754 RETURN
755 END SUBROUTINE mumps_metis_kway_mixedto64
756 SUBROUTINE mumps_metis_kway_ab_mixedto32(NHALO, HALOEDGENBR,
757 & IPTRHALO,
758 & JCNHALO, NBGROUPS, PARTS, VWGT, LP, LPOK, KEEP10,
759 & IFLAG, IERROR)
760 IMPLICIT NONE
761 INTEGER(8) :: HALOEDGENBR
762 INTEGER :: NHALO, NBGROUPS
763 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO), VWGT(NHALO)
764 INTEGER(8) :: IPTRHALO(NHALO+1)
765 INTEGER, INTENT(IN) :: LP, KEEP10
766 LOGICAL, INTENT(IN) :: LPOK
767 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
768 INTEGER, ALLOCATABLE :: IPTRHALO_I4(:)
769 INTEGER :: allocok
770 IF (iptrhalo(size(iptrhalo)) .GE. int(huge(lp),8)) THEN
771 iflag = -51
772 CALL mumps_set_ierror( iptrhalo(size(iptrhalo)),
773 & ierror)
774 RETURN
775 ENDIF
776 ALLOCATE(iptrhalo_i4(size(iptrhalo)), stat=allocok)
777 IF (allocok > 0) THEN
778 iflag = -7
779 ierror = size(iptrhalo)
780 IF (lpok) WRITE(lp,'(A)')
781 & "ERROR memory allocation in MUMPS_METIS_KWAY_AB_MIXEDto32"
782 RETURN
783 END IF
784 CALL mumps_icopy_64to32(iptrhalo,
785 & size(iptrhalo), iptrhalo_i4)
786 CALL mumps_metis_kway_ab(nhalo, iptrhalo_i4(1),
787 & jcnhalo(1), nbgroups, parts(1), vwgt(1))
788 DEALLOCATE(iptrhalo_i4)
789 RETURN
790 END SUBROUTINE mumps_metis_kway_ab_mixedto32
791 SUBROUTINE mumps_metis_kway_ab_mixedto64(NHALO, HALOEDGENBR,
792 & IPTRHALO,
793 & JCNHALO, NBGROUPS, PARTS, VWGT, LP, LPOK, KEEP10,
794 & IFLAG, IERROR)
795 IMPLICIT NONE
796 INTEGER(8) :: HALOEDGENBR
797 INTEGER :: NHALO, NBGROUPS
798 INTEGER :: JCNHALO(HALOEDGENBR), PARTS(NHALO), VWGT(NHALO)
799 INTEGER(8) :: IPTRHALO(NHALO+1)
800 INTEGER, INTENT(IN) :: LP, KEEP10
801 LOGICAL, INTENT(IN) :: LPOK
802 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
803 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: JCNHALO_I8, PARTS_I8
804 INTEGER(8), ALLOCATABLE, DIMENSION(:) :: VWGT_I8
805 INTEGER(8) :: NHALO_I8, NBGROUPS_I8
806 INTEGER :: allocok
807 ALLOCATE(jcnhalo_i8(iptrhalo(nhalo+1)-1_8),
808 & parts_i8(size(parts)), vwgt_i8(nhalo), stat=allocok)
809 IF (allocok > 0) THEN
810 iflag = -7
811 CALL mumps_set_ierror(
812 & int(keep10,8)* (iptrhalo(nhalo+1)-1_8+int(size(parts),8))
813 & +int(nhalo,8), ierror)
814 IF (lpok) WRITE(lp,'(A)')
815 & "ERROR memory allocation in MUMPS_METIS_KWAY_AB_MIXEDto64 "
816 ENDIF
817 nhalo_i8 = int(nhalo,8)
818 nbgroups_i8 = int(nbgroups,8)
819 CALL mumps_icopy_32to64_64c(jcnhalo,
820 & iptrhalo(nhalo+1)-1, jcnhalo_i8)
821 CALL mumps_icopy_32to64_64c(vwgt,
822 & nhalo_i8, vwgt_i8)
823 CALL mumps_metis_kway_ab_64(nhalo_i8, iptrhalo(1),
824 & jcnhalo_i8(1), nbgroups_i8, parts_i8(1),
825 & vwgt_i8(1))
826 CALL mumps_icopy_64to32(parts_i8,
827 & size(parts), parts)
828 DEALLOCATE(jcnhalo_i8, parts_i8, vwgt_i8)
829 RETURN
830 END SUBROUTINE mumps_metis_kway_ab_mixedto64
831#endif
832#if defined(pord)
833 SUBROUTINE mumps_pordf_mixedto32( NVTX, NEDGES8, XADJ8, IW,
834 & NV, NCMPA, PARENT,
835 & INFO, LP, LPOK, KEEP10 )
836 IMPLICIT NONE
837 INTEGER, INTENT(IN) :: LP
838 LOGICAL, INTENT(IN) :: LPOK
839 INTEGER, INTENT(INOUT) :: INFO(2)
840 INTEGER, INTENT(IN) :: NVTX
841 INTEGER, INTENT(OUT) :: NCMPA
842 INTEGER(8), INTENT(IN) :: NEDGES8
843 INTEGER(8) :: XADJ8(:)
844 INTEGER, INTENT(OUT) :: NV(NVTX)
845 INTEGER :: IW(:)
846 INTEGER, INTENT(OUT) :: PARENT(NVTX)
847 INTEGER, INTENT(IN) :: KEEP10
848 INTEGER, DIMENSION(:), ALLOCATABLE :: XADJ
849 INTEGER :: I, allocok
850 IF (nedges8.GT. int(huge(iw),8)) THEN
851 info(1) = -51
852 CALL mumps_set_ierror(nedges8,info(2))
853 RETURN
854 ENDIF
855 ALLOCATE(xadj(nvtx+1), stat=allocok)
856 IF (allocok > 0) THEN
857 info(1)=-7
858 info(2)=nvtx+1
859 IF (lpok) WRITE(lp,'(A)')
860 & "ERROR memory allocation in MUMPS_PORD_MIXEDto32"
861 RETURN
862 ENDIF
863 CALL mumps_icopy_64to32(xadj8(1), nvtx+1, xadj)
864 CALL mumps_pordf( nvtx, int(nedges8), xadj, iw(1),
865 & nv, ncmpa )
866 DO i= 1, nvtx
867 parent(i) = xadj(i)
868 ENDDO
869 DEALLOCATE(xadj)
870 RETURN
871 END SUBROUTINE mumps_pordf_mixedto32
872 SUBROUTINE mumps_pordf_mixedto64( NVTX, NEDGES8, XADJ8, IW,
873 & NV, NCMPA, PARENT,
874 & INFO, LP, LPOK, KEEP10,
875 & INPLACE64_GRAPH_COPY )
876 IMPLICIT NONE
877 INTEGER, INTENT(IN) :: LP
878 LOGICAL, INTENT(IN) :: LPOK
879 INTEGER, INTENT(INOUT) :: INFO(2)
880 INTEGER, INTENT(IN) :: NVTX
881 INTEGER, INTENT(OUT) :: NCMPA
882 INTEGER(8), INTENT(IN) :: NEDGES8
883 INTEGER(8) :: XADJ8(:)
884 INTEGER, INTENT(OUT) :: NV(NVTX)
885 INTEGER, INTENT(IN) :: IW(:)
886 INTEGER, INTENT(OUT) :: PARENT(NVTX)
887 INTEGER, INTENT(IN) :: KEEP10
888 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY
889 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IW8, NV8
890 INTEGER :: I, allocok
891 IF (keep10.EQ.1) THEN
892 CALL mumps_pordf( int(nvtx,8), nedges8, xadj8(1), iw(1),
893 & nv, ncmpa )
894 DO i=1, nvtx
895 parent(i)=int(xadj8(i))
896 ENDDO
897 ELSE
898 IF (inplace64_graph_copy) THEN
899 CALL mumps_icopy_32to64_64c_ip(iw(1), nedges8)
900 ELSE
901 ALLOCATE(iw8(nedges8), stat=allocok)
902 IF (allocok > 0) THEN
903 info(1)=-7
904 CALL mumps_set_ierror(nedges8,info(2))
905 IF (lpok) WRITE(lp,'(A)')
906 & "ERROR memory allocation in MUMPS_PORD_MIXEDto64"
907 RETURN
908 ENDIF
909 CALL mumps_icopy_32to64_64c(iw(1), nedges8, iw8)
910 ENDIF
911 ALLOCATE(nv8(nvtx), stat=allocok)
912 IF (allocok > 0) THEN
913 info(1)=-7
914 CALL mumps_set_ierror(int(nvtx,8),info(2))
915 IF (lpok) WRITE(lp,'(A)')
916 & "ERROR memory allocation in MUMPS_PORD_MIXEDto64"
917 RETURN
918 ENDIF
919 IF (inplace64_graph_copy) THEN
920 CALL mumps_pordf( int(nvtx,8), nedges8, xadj8(1), iw(1),
921 & nv8, ncmpa )
922 ELSE
923 CALL mumps_pordf( int(nvtx,8), nedges8, xadj8(1), iw8,
924 & nv8, ncmpa )
925 DEALLOCATE(iw8)
926 ENDIF
927 CALL mumps_icopy_64to32(xadj8(1), nvtx, parent)
928 CALL mumps_icopy_64to32(nv8, nvtx, nv)
929 DEALLOCATE(nv8)
930 ENDIF
931 RETURN
932 END SUBROUTINE mumps_pordf_mixedto64
933 SUBROUTINE mumps_pordf_wnd_mixedto32( NVTX, NEDGES8,
934 & XADJ8, IW,
935 & NV, NCMPA, N, PARENT,
936 & INFO, LP, LPOK, KEEP10 )
937 IMPLICIT NONE
938 INTEGER, INTENT(IN) :: LP
939 LOGICAL, INTENT(IN) :: LPOK
940 INTEGER, INTENT(INOUT) :: INFO(2)
941 INTEGER, INTENT(IN) :: NVTX, N
942 INTEGER, INTENT(OUT) :: NCMPA
943 INTEGER, INTENT(INOUT) :: NV(NVTX)
944 INTEGER(8) :: XADJ8(:)
945 INTEGER(8), INTENT(IN) :: NEDGES8
946 INTEGER :: IW(:)
947 INTEGER, INTENT(OUT) :: PARENT(NVTX)
948 INTEGER, INTENT(IN) :: KEEP10
949 INTEGER, DIMENSION(:), ALLOCATABLE :: XADJ
950 INTEGER :: I, allocok
951 IF (nedges8.GT. int(huge(iw),8)) THEN
952 info(1) = -51
953 CALL mumps_set_ierror(nedges8,info(2))
954 RETURN
955 ENDIF
956 ALLOCATE(xadj(nvtx+1), stat=allocok)
957 IF (allocok > 0) THEN
958 info(1)=-7
959 info(2)=nvtx+1
960 IF (lpok) WRITE(lp,'(A)')
961 & "ERROR memory allocation in MUMPS_PORDF_WND_MIXEDto32"
962 RETURN
963 ENDIF
964 CALL mumps_icopy_64to32(xadj8(1),nvtx+1,xadj)
965 CALL mumps_pordf_wnd( nvtx, int(nedges8),
966 & xadj, iw(1),
967 & nv, ncmpa, n )
968 DO i= 1, nvtx
969 parent(i) = xadj(i)
970 ENDDO
971 DEALLOCATE(xadj)
972 RETURN
973 END SUBROUTINE mumps_pordf_wnd_mixedto32
974 SUBROUTINE mumps_pordf_wnd_mixedto64( NVTX, NEDGES8,
975 & XADJ8, IW,
976 & NV, NCMPA, N, PARENT,
977 & INFO, LP, LPOK, KEEP10,
978 & INPLACE64_GRAPH_COPY )
979 IMPLICIT NONE
980 INTEGER, INTENT(IN) :: LP
981 LOGICAL, INTENT(IN) :: LPOK
982 INTEGER, INTENT(INOUT) :: INFO(2)
983 INTEGER, INTENT(IN) :: NVTX, N
984 INTEGER, INTENT(OUT) :: NCMPA
985 INTEGER, INTENT(INOUT) :: NV(NVTX)
986 INTEGER(8) :: XADJ8(:)
987 INTEGER(8), INTENT(IN) :: NEDGES8
988 INTEGER :: IW(:)
989 INTEGER, INTENT(OUT) :: PARENT(NVTX)
990 INTEGER, INTENT(IN) :: KEEP10
991 LOGICAL, INTENT(IN) :: INPLACE64_GRAPH_COPY
992 INTEGER(8), DIMENSION(:), ALLOCATABLE :: IW8, NV8
993 INTEGER :: allocok
994 IF (keep10.EQ.1) THEN
995 CALL mumps_pordf_wnd( int(nvtx,8), nedges8,
996 & xadj8(1), iw(1),
997 & nv, ncmpa, int(n,8) )
998 CALL mumps_icopy_64to32(xadj8(1), nvtx, parent)
999 ELSE
1000 IF (inplace64_graph_copy) THEN
1001 CALL mumps_icopy_32to64_64c_ip(iw(1), nedges8)
1002 ELSE
1003 ALLOCATE(iw8(nedges8), stat=allocok)
1004 IF (allocok > 0) THEN
1005 info(1)=-7
1006 CALL mumps_set_ierror(nedges8,info(2))
1007 IF (lpok) WRITE(lp,'(A)')
1008 & "ERROR memory allocation in MUMPS_PORDF_WND_MIXEDto64"
1009 RETURN
1010 ENDIF
1011 CALL mumps_icopy_32to64_64c(iw(1), nedges8, iw8)
1012 ENDIF
1013 ALLOCATE(nv8(nvtx), stat=allocok)
1014 IF (allocok > 0) THEN
1015 info(1)=-7
1016 CALL mumps_set_ierror(int(nvtx,8),info(2))
1017 IF (lpok) WRITE(lp,'(A)')
1018 & "ERROR memory allocation in MUMPS_PORDF_WND_MIXEDto64"
1019 RETURN
1020 ENDIF
1021 CALL mumps_icopy_32to64(nv, nvtx, nv8)
1022 IF (inplace64_graph_copy) THEN
1023 CALL mumps_pordf_wnd( int(nvtx,8), nedges8,
1024 & xadj8(1), iw(1),
1025 & nv8, ncmpa, int(n,8) )
1026 ELSE
1027 CALL mumps_pordf_wnd( int(nvtx,8), nedges8,
1028 & xadj8(1), iw8,
1029 & nv8, ncmpa, int(n,8) )
1030 DEALLOCATE(iw8)
1031 ENDIF
1032 CALL mumps_icopy_64to32(xadj8(1), nvtx, parent)
1033 CALL mumps_icopy_64to32(nv8, nvtx, nv)
1034 DEALLOCATE(nv8)
1035 ENDIF
1036 RETURN
1037 END SUBROUTINE mumps_pordf_wnd_mixedto64
1038#endif
1039 SUBROUTINE mumps_ana_wrap_return()
1040 RETURN
1041 END SUBROUTINE mumps_ana_wrap_return
1042 END MODULE mumps_ana_ord_wrappers
mumps_ana_ord_wrappers
Definition ana_orderings_wrappers_m.F:19
mumps_ana_ord_wrappers::mumps_ana_wrap_return
subroutine mumps_ana_wrap_return()
Definition ana_orderings_wrappers_m.F:1040
mumps_icopy_32to64_64c
subroutine mumps_icopy_32to64_64c(intab, sizetab8, outtab8)
Definition tools_common.F:1159
mumps_icopy_64to32_64c_ip
subroutine mumps_icopy_64to32_64c_ip(in_out_tab48, sizetab)
Definition tools_common.F:1221
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_icopy_32to64_64c_ip
subroutine mumps_icopy_32to64_64c_ip(in_out_tab48, sizetab)
Definition tools_common.F:1174
mumps_icopy_64to32
subroutine mumps_icopy_64to32(intab8, sizetab, outtab)
Definition tools_common.F:1201
mumps_icopy_32to64
subroutine mumps_icopy_32to64(intab, sizetab, outtab8)
Definition tools_common.F:1149