Commit 4e882a5d authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Minor beautifications.

parent 563f9795
......@@ -262,8 +262,7 @@ CONTAINS
xmap = xt_xmap_all2all_new(src_idxlist, dst_idxlist, mpi_comm_world)
! redist_p2p with extents of offsets
redist = xt_redist_p2p_ext_new(xmap, &
src_pos, dst_pos, xt_int_mpidt)
redist = xt_redist_p2p_ext_new(xmap, src_pos, dst_pos, xt_int_mpidt)
! test communicator of redist
IF (.NOT. communicators_are_congruent(xt_redist_get_MPI_Comm(redist), &
mpi_comm_world)) &
......
......@@ -191,8 +191,7 @@ CONTAINS
! test redist with blocks
SUBROUTINE block_redist_test
! gvol_size: volume of deep ocean
INTEGER :: ngdom, gvol_size, i, nwin, ig0, ig, j, p, qa, qb, &
a_vol_size, b_vol_size
INTEGER :: ngdom, gvol_size, i, nwin, ig0, ig, j, p, qa, qb
! gdepth: ocean depth of an one dim. ocean
INTEGER, ALLOCATABLE :: gdoma(:), gdomb(:), gsurfdata(:), &
gdepth(:), ig2col_off(:), b_surfdata_ref(:), gvoldata(:), &
......@@ -274,8 +273,6 @@ CONTAINS
! generate blocks
ALLOCATE(src_block_offsets(nwin), src_block_sizes(nwin), &
dst_block_offsets(nwin), dst_block_sizes(nwin))
a_vol_size = 0 ! state a volume of my proc
b_vol_size = 0 ! state b volume of my proc
! we only need local size but simply oversize here
ALLOCATE(a_voldata(gvol_size), b_voldata(gvol_size), &
b_voldata_ref(gvol_size))
......@@ -295,7 +292,6 @@ CONTAINS
a_voldata(qa + j) = gvoldata(p + j)
END DO
qa = qa + gdepth_i
a_vol_size = a_vol_size + src_block_sizes(i)
END DO
qb = 0
......@@ -311,7 +307,6 @@ CONTAINS
b_voldata_ref(qb + j) = gvoldata(p + j)
END DO
qb = qb + gdepth_i
b_vol_size = b_vol_size + dst_block_sizes(i)
END DO
! redist with blocks
......@@ -331,7 +326,7 @@ CONTAINS
src_block_sizes, nwin, dst_block_sizes, nwin, mpi_integer)
! test communicator of redist
IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(block_redist2), &
IF (.NOT. communicators_are_congruent(xt_redist_get_mpi_comm(block_redist2),&
mpi_comm_world)) &
CALL test_abort("error in xt_redist_get_mpi_comm", filename, __LINE__)
......
......@@ -82,8 +82,7 @@ CONTAINS
SUBROUTINE test_round_robin
TYPE(xt_redist_msg) :: send_msgs(1)
TYPE(xt_redist_msg) :: recv_msgs(1)
TYPE(xt_redist_msg) :: send_msgs(1), recv_msgs(1)
INTEGER, PARAMETER :: num_elem = 1
DOUBLE PRECISION :: src_data(num_elem)
......@@ -117,14 +116,13 @@ CONTAINS
send_msgs(i)%datatype = MPI_DOUBLE_PRECISION
recv_msgs(i)%rank = i - 1
CALL MPI_Type_create_indexed_block( &
1, 1, (/i - 1/), MPI_DOUBLE_PRECISION, recv_msgs(i)%datatype, ierror)
1, 1, (/i - 1/), MPI_DOUBLE_PRECISION, recv_msgs(i)%datatype, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("error calling mpi_type_create_indexed_block", &
filename, __LINE__)
CALL MPI_Type_commit(recv_msgs(i)%datatype, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("error calling mpi_type_commit", &
filename, __LINE__)
CALL test_abort("error calling mpi_type_commit", filename, __LINE__)
END DO
src_data(1) = DBLE(comm_rank)
......@@ -166,8 +164,7 @@ CONTAINS
filename, __LINE__)
CALL MPI_Type_commit(send_msgs(i)%datatype, ierror)
IF (ierror /= mpi_success) &
CALL test_abort("error calling mpi_type_commit", &
filename, __LINE__)
CALL test_abort("error calling mpi_type_commit", filename, __LINE__)
END DO
recv_msgs(1)%rank = 0
recv_msgs(1)%datatype = MPI_DOUBLE_PRECISION
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment