Homec4science
Diffusion SPClibs (feature/refactoring) Browse

spclibs/src/p2p_mat.tpl
8a373078a934feature/refactoring

Last Change
Raw File

p2p_mat.tpl
View Options

!>
!> @file p2p_mat.tpl
!>
!> @brief
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> SPClibs is free software: you can redistribute it and/or modify it under
!> the terms of the GNU Lesser General Public License as published by the Free
!> Software Foundation, either version 3 of the License, or (at your option)
!> any later version.
!>
!> SPClibs is distributed in the hope that it will be useful, but WITHOUT ANY
!> WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
!> FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
!>
!> You should have received a copy of the GNU Lesser General Public License
!> along with this program. If not, see <https://www.gnu.org/licenses/>.
!>
!> @author
!> (in alphabetical order)
!> @author Trach-Minh Tran <trach-minh.tran@epfl.ch>
!>
INTEGER, INTENT(in) :: dest
CHARACTER(len=*), INTENT(in) :: extyp ! ('send', 'recv', 'sendrecv')
CHARACTER(len=*), INTENT(in) :: op ! ('put', 'updt')
INTEGER, INTENT(in) :: comm
!
INTEGER :: ierr
INTEGER :: nrank, nnz, nnz_rem
INTEGER :: i, s, idx, bufsize, position
CHARACTER(len=1), ALLOCATABLE :: sbuf(:), rbuf(:)
INTEGER, ALLOCATABLE :: irow(:), cols(:)
!--------------------------------------------------------------------------
! 1.0 Prologue
!
nrank = mat%rank
nnz = get_count(mat)
CALL mpi_sendrecv(nnz, 1, MPI_INTEGER, dest, 0, &
& nnz_rem, 1, MPI_INTEGER, dest, 0, &
& comm, MPI_STATUS_IGNORE, ierr)
!--------------------------------------------------------------------------
! 2.0 Send or sendrecv
!
IF(extyp.EQ.'send' .OR. extyp.EQ.'sendrecv') THEN
!
! Allocate packed send buffer
bufsize = 0
CALL mpi_pack_size(nrank+1, MPI_INTEGER, comm, s, ierr); bufsize=bufsize+s
CALL mpi_pack_size(nnz, MPI_INTEGER, comm, s, ierr); bufsize=bufsize+s
CALL mpi_pack_size(nnz, mpi_type, comm, s, ierr); bufsize=bufsize+s
ALLOCATE(sbuf(bufsize))
!
! Obtain matrix CSR arrays and pack
CALL to_mat(mat, nlkeep=.TRUE.)
position = 0
CALL mpi_pack(mat%irow, nrank+1, MPI_INTEGER, sbuf, bufsize, position, comm, ierr)
CALL mpi_pack(mat%cols, nnz, MPI_INTEGER, sbuf, bufsize, position, comm, ierr)
CALL mpi_pack(mat%val, nnz, mpi_type, sbuf, bufsize, position, comm, ierr)
DEALLOCATE(mat%irow)
DEALLOCATE(mat%cols)
DEALLOCATE(mat%val)
!
! Communicate packed buffer
IF(extyp.EQ.'send') THEN
CALL mpi_send(sbuf, position, MPI_PACKED, dest, 0, comm, ierr)
DEALLOCATE(sbuf)
END IF
END IF
!--------------------------------------------------------------------------
! 3.0 Sendrecv or recv
!
IF(extyp.EQ.'recv' .OR. extyp.EQ.'sendrecv') THEN
!
! Allocate unpacked received buffer
bufsize = 0
CALL mpi_pack_size(nrank+1, MPI_INTEGER, comm, s, ierr); bufsize=bufsize+s
CALL mpi_pack_size(nnz_rem, MPI_INTEGER, comm, s, ierr); bufsize=bufsize+s
CALL mpi_pack_size(nnz_rem, mpi_type, comm, s, ierr); bufsize=bufsize+s
ALLOCATE(rbuf(bufsize))
!
! Communicate packed buffer
IF(extyp.EQ.'recv') THEN
CALL mpi_recv(rbuf, bufsize, MPI_PACKED, dest, 0, comm, MPI_STATUS_IGNORE, ierr)
ELSE IF(extyp.EQ.'sendrecv') THEN
CALL mpi_sendrecv(sbuf, position, MPI_PACKED, dest, 0, &
& rbuf, bufsize, MPI_PACKED, dest, 0, &
& comm, MPI_STATUS_IGNORE, ierr)
DEALLOCATE(sbuf)
END IF
!
! Unpacked rbuf
ALLOCATE(irow(nrank+1))
ALLOCATE(cols(nnz_rem))
ALLOCATE(val(nnz_rem))
position = 0
CALL mpi_unpack(rbuf, bufsize, position, irow, nrank+1, MPI_INTEGER, comm, ierr)
CALL mpi_unpack(rbuf, bufsize, position, cols, nnz_rem, MPI_INTEGER, comm, ierr)
CALL mpi_unpack(rbuf, bufsize, position, val, nnz_rem, mpi_type, comm, ierr)
DEALLOCATE(rbuf)
!
! Update/replace sparse matrix
DO i=1,nrank
DO idx=irow(i),irow(i+1)-1
IF(op.EQ.'updt') THEN
CALL updtmat(mat, i, cols(idx), val(idx))
ELSE IF(op.EQ.'put') THEN
CALL putele(mat, i, cols(idx), val(idx))
END IF
END DO
END DO
DEALLOCATE(irow)
DEALLOCATE(cols)
DEALLOCATE(val)
!
END IF
!--------------------------------------------------------------------------
c4science · Help