Homec4science
Diffusion SPClibs (feature/refactoring) Browse

spclibs/pputils2/ex1.f90
8a373078a934feature/refactoring

Last Change
Raw File

ex1.f90
View Options

!>
!> @file ex1.f90
!>
!> @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>
!>
PROGRAM main
!
! Tranpsose of 2d matrix partitionned on a 1d proc grid:
! - A(n1,n2/P1) -> AT(n2,n1/P1) -> B(n1,n2/P1)
!
USE pputils2
USE futils
IMPLICIT NONE
INCLUDE "mpif.h"
CHARACTER(len=32) :: file='ex1.h5'
INTEGER :: fid
!
INTEGER, PARAMETER :: ndims=1 ! N. of dims of proc. grid
INTEGER :: ierr, me, npes
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart
!
INTEGER :: n1, n2, n1p, n2p
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: a, atr, b
DOUBLE PRECISION :: x
INTEGER :: i, j, iglob, jglob, kerrors, nerrors
!================================================================================
!
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! Create cartesian topololy
dims = npes
periods = (/.FALSE./)
reorder = .FALSE.
IF( PRODUCT(dims) .NE. npes ) THEN
IF( me .EQ. 0 ) THEN
PRINT*, PRODUCT(dims), " processors required!"
CALL mpi_abort(MPI_COMM_WORLD, -1, ierr)
END IF
END IF
CALL mpi_cart_create(MPI_COMM_WORLD, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
!
! Define local array
n1p=2; n1=n1p*dims(1)
n2p=2; n2=n2p*dims(1)
ALLOCATE( a(n1,n2p), atr(n2,n1p), b(n1,n2p) )
a = 0
atr = 0
b = 0
DO i=1,n1
DO j=1,n2p
jglob = coords(1)*n2p + j
a(i,j) = 10*i + jglob
END DO
END DO
IF( me.EQ. 0 ) THEN
WRITE(*,'(a,3i4)') 'Global dimension of matrix a', n1, n2
END IF
!
! Tranpose A(n1,n2/P1) -> AT(n2,n1/P1) -> B(n1,n2/P1)
CALL pptransp(cart, a, atr)
CALL pptransp(cart, atr, b)
!
! Check ATR
kerrors = 0
DO i=1,n1p
iglob = coords(1)*n1p + i
DO j=1,n2
x = 10*iglob + j
IF( x .NE. atr(j,i) ) kerrors = kerrors+1
END DO
END DO
CALL mpi_reduce(kerrors, nerrors, 1, MPI_INTEGER, MPI_SUM, 0, &
& MPI_COMM_WORLD, ierr)
IF( me .EQ. 0 ) WRITE(*,'(a,i6)') 'nerrors checking ATR', nerrors
!
! Write to file
!
CALL creatf(file, fid, mpicomm=cart)
CALL putarrnd(fid, '/arraya', a, (/2/) )
CALL putarrnd(fid, '/arrayat', atr, (/2/) )
CALL putarrnd(fid, '/arrayb', b, (/2/) )
!
! Clean up and quit
DEALLOCATE(a, atr)
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
c4science · Help