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

Minor beautifications.

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