!> !> @file ex3.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 . !> !> @authors !> (in alphabetical order) !> @author Trach-Minh Tran !> PROGRAM main ! ! Tranpsose of 2d matrix partitionned on a 1d proc grid ! - A(n1,n2/P1) -> AT(n2,n1/P1) ! n1, n2 NOT REQUIRED to be divided evenly by NPES ! USE pputils2 USE futils IMPLICIT NONE INCLUDE "mpif.h" CHARACTER(len=32) :: file='ex3.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=9, n2=8, s1, s2, n1p, n2p DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: a, atr 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) ! ! Partition array CALL dist1d(cart, 0, n1, s1, n1p) CALL dist1d(cart, 0, n2, s2, n2p) ALLOCATE( a(n1,n2p), atr(n2,n1p) ) a = 0 atr = 0 DO i=1,n1 DO j=1,n2p jglob = s2 + 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) -> ATR(n2,n1/P1) CALL pptransp(cart, a, atr) ! ! Check ATR kerrors = 0 DO i=1,n1p iglob = s1 + 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/) ) ! ! Clean up and quit DEALLOCATE(a, atr) CALL closef(fid) CALL mpi_finalize(ierr) END PROGRAM main