Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Thomas Jahns
PPM
Commits
22dac3d1
Commit
22dac3d1
authored
Mar 02, 2021
by
Thomas Jahns
🤸
Browse files
Take adjustable type into account.
parent
e39bc4a2
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/ppm/ppm_graph_partition_mpi.f90
View file @
22dac3d1
...
...
@@ -105,8 +105,9 @@ CONTAINS
INTEGER
(
ppm_metis_idx
),
OPTIONAL
,
TARGET
,
INTENT
(
in
)
::
edge_weights
(
*
)
INTEGER
(
ppm_metis_int
)
::
wgtflag
INTEGER
::
part_comm
,
comm_size
,
comm_rank
,
ierror
,
i
,
ierror_
INTEGER
,
ALLOCATABLE
::
vtxdist
(:)
INTEGER
(
ppm_metis_int
)
::
metis_options
(
0
:
2
),
edge_cut
,
ncon
,
num_parts
INTEGER
(
ppm_metis_idx
),
ALLOCATABLE
::
vtxdist
(:)
INTEGER
(
ppm_metis_int
)
::
metis_options
(
0
:
2
),
edge_cut
,
ncon
,
num_parts
,
&
accum
INTEGER
::
msg_len
CHARACTER
(
len
=
mpi_max_error_string
)
::
msg
TYPE
(
c_ptr
)
::
vwgt
,
adjwgt
...
...
@@ -114,6 +115,7 @@ CONTAINS
#ifndef HAVE_PARMETIS_V3
REAL
(
ppm_metis_real
),
ALLOCATABLE
,
TARGET
::
tpwgts_balance
(:,
:)
#endif
INTEGER
::
ppm_metis_idx_mpidt
=
mpi_datatype_null
IF
(
PRESENT
(
comm
))
THEN
;
part_comm
=
comm
;
ELSE
;
part_comm
=
mpi_comm_world
END
IF
...
...
@@ -131,19 +133,28 @@ CONTAINS
! build table of node distribution
ALLOCATE
(
vtxdist
(
0
:
comm_size
))
i
=
INT
(
num_vertices
)
CALL
mpi_allgather
(
i
,
1
,
MPI_INTEGER
,
&
vtxdist
(
1
:
comm_size
),
1
,
MPI_INTEGER
,
part_comm
,
ierror
)
IF
(
ppm_metis_idx_mpidt
==
mpi_datatype_null
)
THEN
CALL
mpi_type_create_f90_integer
(
RANGE
(
num_vertices
),
&
&
ppm_metis_idx_mpidt
,
ierror
)
IF
(
ierror
/
=
MPI_SUCCESS
)
THEN
CALL
mpi_error_string
(
ierror
,
msg
,
msg_len
,
ierror_
)
CALL
abort_ppm
(
msg
(
1
:
msg_len
),
filename
,
__
LINE__
,
comm
)
END
IF
END
IF
CALL
mpi_allgather
(
num_vertices
,
1
,
ppm_metis_idx_mpidt
,
&
vtxdist
(
1
),
1
,
ppm_metis_idx_mpidt
,
part_comm
,
ierror
)
IF
(
ierror
/
=
MPI_SUCCESS
)
then
CALL
mpi_error_string
(
ierror
,
msg
,
msg_len
,
ierror_
)
CALL
abort_ppm
(
msg
(
1
:
msg_len
),
filename
,
__
LINE__
,
comm
)
END
IF
vtxdist
(
0
)
=
1
vtxdist
(
comm_rank
+
1
)
=
i
DO
i
=
1
,
comm_size
vtxdist
(
i
)
=
vtxdist
(
i
)
+
vtxdist
(
i
-
1
)
! compute partial sums of vertices over ranks
accum
=
1_ppm_metis_idx
DO
i
=
0
,
comm_size
-1
vtxdist
(
i
)
=
accum
accum
=
accum
+
vtxdist
(
i
+1
)
END
DO
vtxdist
(
comm_size
)
=
accum
wgtflag
=
0
IF
(
PRESENT
(
vertex_weights
))
wgtflag
=
2
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment