diff --git a/examples/Makefile b/examples/Makefile
index 0e88dd4..5a1c619 100644
--- a/examples/Makefile
+++ b/examples/Makefile
@@ -1,243 +1,243 @@
#
# @file Makefile
#
# @brief Makefile for futils library examples
#
# @copyright
# Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
# SPC (Swiss Plasma Center)
#
# futils 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.
#
# futils 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 Sohrab Khosh Aghdam
# @author Paolo Angelino
# @author Trach-Minh Tran
#
F90 = mpif90
OPT = -g -traceback -CB
F90FLAGS = $(OPT) -I$(FUTILS)/include -I${HDF5}/include -I${HDF5}/lib
CC = cc
CFLAGS = -O2
LDFLAGS = $(OPT) -L$(FUTILS)/lib -L${HDF5}/lib
LIBS = -lfutils -lhdf5_fortran -lhdf5 -lz -lgcc_s -lcrypt -lssl
LIBS = -lfutils -lhdf5_fortran -lhdf5 -lz
MPIRUN = mpiexec -n 4
SERIAL = ex1 ex2 ex3 ex4 ex7 ex8 ex9 ex11 ex12 ex13 ex14 ex15 ex16
-PARA = pex1 pex3 pex3D pex4 pex5 pex6 pex7 pex8 pex9 ex10
+PARA = pex1 pex3 pex4 pex5 pex6 pex7 pex8 pex9 ex10
PARA_ALL = $(PARA) pex5r pex10 pex11 pex12 pex13 pex14 pex15 pex16
.SUFFIXES:
.SUFFIXES: .o .c .f90
.f90.o:
$(F90) $(F90FLAGS) -c $<
examples: $(SERIAL) ex6 ex5 $(PARA_ALL)
lib:
# make -C ../src -f Makefile_mac
# touch lib
ex1: ex1.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex2: ex2.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex3: ex3.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex4: ex4.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex5: ex5.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex6: ex6.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex7: ex7.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex8: ex8.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex9: ex9.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex10: ex10.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex11: ex11.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex12: ex12.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex13: ex13.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex14: ex14.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex15: ex15.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
ex16: ex16.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex1: pex1.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex3: pex3.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex3D: pex3D.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex4: pex4.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex5: pex5.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex5r: pex5r.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex6: pex6.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex7: pex7.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex8: pex8.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex9: pex9.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex10: pex10.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex11: pex11.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex12: pex12.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex14: pex14.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex13: pex13.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex15: pex15.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex16: pex16.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
pex17: pex17.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
getfile: getfile.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
testmem: testmem.o
$(F90) $(LDFLAGS) -o $@ $< $(LIBS)
test_s: $(SERIAL) ex5
@for x in $(SERIAL); do \
echo === Running $$x ===;\
./$$x ;\
echo ;\
done
@echo === Running ex5 ===;\
./ex5 < ex5.in ;\
echo ;\
test_p: $(PARA_ALL)
@for x in $(PARA); do \
echo === Running $$x ===;\
$(MPIRUN) ./$$x ;\
echo ;\
done ;\
echo === Running pex10 ===;\
mpiexec -n 12 ./pex10 ;\
echo ;\
echo === Running pex11 ===;\
mpiexec -n 8 ./pex11 ;\
echo ;\
echo === Running pex12 ===;\
mpiexec -n 4 ./pex12 2 2;\
echo ;\
echo === Running pex13 ===;\
mpiexec -n 6 ./pex13 3 2 ;\
echo ;\
echo === Running pex14 ===;\
mpiexec -n 4 ./pex14 2 2;\
echo ;\
echo === Running pex15 ===;\
mpiexec -n 6 ./pex15 3 2 ;\
echo ;\
echo === Running pex16 ===;\
mpiexec -n 4 ./pex16 ;\
echo ;\
ex1.o: lib
ex2.o: lib
ex3.o: lib
ex4.o: lib
ex5.o: lib
ex6.o: lib
ex7.o: lib
ex8.o: lib
ex9.o: lib
ex10.o: lib
ex11.o: lib
ex12.o: lib
ex13.o: lib
ex14.o: lib
ex15.o: lib
ex16.o: lib
pex1.o: lib
pex3.o: lib
pex3D.o : lib
pex4.o: lib
pex5.o: lib
pex5r.o: lib
pex6.o: lib
pex7.o: lib
pex8.o: lib
pex9.o: lib
pex10.o: lib
pex11.o: lib
pex12.o: lib
pex14.o: lib
pex13.o: lib
pex15.o: lib
pex16.o: lib
pex17.o: lib
getfile.o: lib
clean:
make -C ../src clean
rm -f *.o *~ a.out fort.* *.h5*
distclean: clean
make -C ../src distclean
rm -f lib
rm -f $(SERIAL) ex5 ex6 $(PARA_ALL) *.mod TAGS
diff --git a/examples/ex10.f90 b/examples/ex10.f90
index f03741d..46defaa 100644
--- a/examples/ex10.f90
+++ b/examples/ex10.f90
@@ -1,84 +1,84 @@
!>
!> @file ex10.f90
!>
!> @brief Test module HASTABLE
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
+ USE mpi
IMPLICIT NONE
- include 'mpif.h'
INTEGER :: ierr
CALL MPI_INIT(ierr)
CALL test_htable(.false.)
CALL test_htable(.true.)
CALL MPI_FINALIZE(ierr)
end program
subroutine test_htable(restart)
use futils
use hashtable
+ USE mpi
IMPLICIT NONE
- include 'mpif.h'
TYPE(BUFFER_TYPE) :: hbuf
LOGICAL, INTENT(IN) :: restart
INTEGER :: fresid
TYPE(lel), POINTER :: foundel
CHARACTER(len=32) :: text
CHARACTER(len=256) :: filename='htable.h5' ! Result file name
CHARACTER(len=256) :: groupname='/zero_dim'
INTEGER :: i,j,k
INTEGER :: nrun, ierr, me_world
nrun = 20
CALL mpi_comm_rank(MPI_COMM_WORLD, me_world, ierr)
IF(me_world==0) THEN
IF(.NOT.restart) THEN
CALL creatf(filename, fresid, 'Test of 0D buffer module htable')
PRINT *, 'Create HDF5 file ', TRIM(filename), ' :fresid: ',fresid
CALL creatg(fresid, groupname, 'Simulation results')
ELSE
CALL openf(filename, fresid)
PRINT *, 'Reopen HDF5 file ', TRIM(filename), ' :fresid: ',fresid
END IF
END IF
! BUFFER module does not need to know about restart.
CALL htable_init(hbuf,4)
CALL set_htable_fileid(hbuf,fresid,groupname)
DO i=1,nrun
CALL add_record(hbuf,"time", "Simulation time", (1.0d0*i) )
CALL add_record(hbuf,"time_add","Simulation time add", (1.0d0*i), MPI_COMM_WORLD,MPI_SUM )
CALL add_record(hbuf,"nnodes", "Number of processors", 1.0d0, MPI_COMM_WORLD )
CALL add_record(hbuf,"max", "MAX(3.0*me_world)", 3.0d0*me_world, MPI_COMM_WORLD,MPI_SUM )
CALL htable_endstep(hbuf)
END DO
CALL htable_hdf5_flush(hbuf)
IF(me_world==0) THEN
CALL closef(fresid)
END IF
end subroutine test_htable
diff --git a/examples/pex1.f90 b/examples/pex1.f90
index 8b3be4c..ce43b59 100644
--- a/examples/pex1.f90
+++ b/examples/pex1.f90
@@ -1,96 +1,96 @@
!>
!> @file pex1.f90
!>
!> @brief 2d array write with putarr
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel write a 2d array
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
INTEGER :: nx=5, ny=8
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
INTEGER :: start, nxp, nyp, i, j, n
DOUBLE PRECISION, ALLOCATABLE :: array(:,:)
!===========================================================================
! 1. Prologue
! 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 file collectively
IF( command_argument_count() > 0 ) THEN
CALL get_command_argument(1, file, n, ierr)
END IF
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=MPI_COMM_WORLD)
!
CALL putfile(fid, '/README.txt', &
& 'README.txt', ionode=0)
CALL putfile(fid, '/Makefile', &
& 'Makefile', ionode=1)
!===========================================================================
! 2. Parallel write file
!
! Define local array partitionned by columns
CALL dist1d(0, ny, start, nyp)
ALLOCATE(array(nx,nyp))
DO i=1,nx
DO j=1,nyp
array(i,j) = 10*i + (start+j)
END DO
END DO
CALL putarr(fid, "/array_col", array, pardim=2)
PRINT*, 'dataset /array_col created'
DEALLOCATE(array)
!===========================================================================
! 9. Epilogue
!
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex10.f90 b/examples/pex10.f90
index e794f46..cf19986 100644
--- a/examples/pex10.f90
+++ b/examples/pex10.f90
@@ -1,245 +1,245 @@
!>
!> @file pex10.f90
!>
!> @brief Parallel write/read of 2d and 3d arrays partionned on 2d processor grid
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel write/read of 2d and 3d arrays partionned on
! 2d processor grid
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
!
INTEGER, PARAMETER :: ndims=2
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
!
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n1=7, n2=9, n3=8
INTEGER :: i, j, k, iglob, jglob, kglob
DOUBLE PRECISION, ALLOCATABLE :: array2(:,:), array3(:,:,:), brray3(:,:,:)
DOUBLE COMPLEX, ALLOCATABLE :: carray2(:,:), carray3(:,:,:), cbrray3(:,:,:)
DOUBLE PRECISION :: a
DOUBLE COMPLEX :: za
INTEGER :: nerrors
!===========================================================================
! 1. Prologue
! 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(1) = 3; dims(2:ndims) = 0;
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_dims_create(npes, ndims, dims, ierr)
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartcol, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartrow, ierr)
IF( me .EQ. 0 ) WRITE(*,'(a,i2,i2)') 'Processor grid', dims(1), dims(2)
!
! Create file collectively
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=cart)
!===========================================================================
! 2. Parallel write file
!
! Define local 2d array
!
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
!
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
ALLOCATE(array2(np(1),np(2)))
ALLOCATE(carray2(np(1),np(2)))
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
array2(i,j) = 10*iglob + jglob
END DO
END DO
carray2 = CMPLX(array2, -array2, KIND(array2))
!
! Define local 3d array A(n1, n2/P1, n3/P2)
!
CALL dist1d(cartcol, 0, n2, offsets(1), np(1))
CALL dist1d(cartrow, 0, n3, offsets(2), np(2))
!
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
ALLOCATE(array3(n1,np(1),np(2)))
ALLOCATE(carray3(n1,np(1),np(2)))
DO i=1,n1
DO j=1,np(1)
jglob = offsets(1)+j
DO k=1,np(2)
kglob = offsets(2)+k
array3(i,j,k) = 100*i + 10*jglob + kglob
END DO
END DO
END DO
carray3 = CMPLX(-array3/10.0d0, array3, KIND(array3))
!
! Define local 3d array B(n1/P1, n2, n3/P2)
!
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n3, offsets(2), np(2))
!
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
ALLOCATE(brray3(np(1),n2,np(2)))
ALLOCATE(cbrray3(np(1),n2,np(2)))
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,n2
DO k=1,np(2)
kglob = offsets(2)+k
brray3(i,j,k) = 100*iglob + 10*j + kglob
END DO
END DO
END DO
cbrray3 = CMPLX(-brray3/10.0, brray3)
!
! Write to file
!
CALL putarrnd(fid, "/parray2", array2, (/1,2/))
CALL putarrnd(fid, "/pcarray2", carray2, (/1,2/))
!
CALL putarrnd(fid, "/parray3", array3, (/2,3/))
CALL putarrnd(fid, "/pcarray3", carray3, (/2,3/))
!
CALL putarrnd(fid, "/parray3b", brray3, (/1,3/))
CALL putarrnd(fid, "/pcarray3b", cbrray3, (/1,3/))
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
!===========================================================================
! 3. Parallel read file
!
! Close and reopen file
CALL closef(fid)
CALL openf(file, fid, mpicomm=cart)
!
! Read file
array2 = 0.0d0
array3 = 0.0d0
carray2 = (0.0d0, 0.0d0)
carray3 = (0.0d0, 0.0d0)
CALL getarrnd(fid, "/parray2", array2, (/1,2/))
CALL getarrnd(fid, "/pcarray2", carray2, (/1,2/))
CALL getarrnd(fid, "/parray3", array3, (/2,3/))
CALL getarrnd(fid, "/pcarray3", carray3, (/2,3/))
!
! Check read arrays
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
a = 10*iglob + jglob
IF( a .NE. array2(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a25,i5)') 'nerrors reading /parray2', nerrors
!
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
za = CMPLX(array2(i,j), -array2(i,j))
IF( za .NE. carray2(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a25,i5)') 'nerrors reading /pcarray2', nerrors
!
CALL dist1d(cartcol, 0, n2, offsets(1), np(1))
CALL dist1d(cartrow, 0, n3, offsets(2), np(2))
nerrors = 0
DO i=1,n1
DO j=1,np(1)
jglob = offsets(1)+j
DO k=1,np(2)
kglob = offsets(2)+k
a = 100*i + 10*jglob + kglob
IF( a .NE. array3(i,j,k) ) nerrors = nerrors+1
END DO
END DO
END DO
WRITE(*,'(a25,i5)') 'nerrors reading /parray3', nerrors
!
nerrors = 0
DO i=1,n1
DO j=1,np(1)
jglob = offsets(1)+j
DO k=1,np(2)
kglob = offsets(2)+k
za = CMPLX(-array3(i,j,k)/10.0, array3(i,j,k))
IF( za .NE. carray3(i,j,k) ) nerrors = nerrors+1
END DO
END DO
END DO
WRITE(*,'(a25,i5)') 'nerrors reading /pcarray3', nerrors
!===========================================================================
! 9. Epilogue
!
DEALLOCATE(array2, array3, brray3)
DEALLOCATE(carray2, carray3, cbrray3)
!
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex11.f90 b/examples/pex11.f90
index 497b679..439e1d6 100644
--- a/examples/pex11.f90
+++ b/examples/pex11.f90
@@ -1,130 +1,130 @@
!>
!> @file pex11.f90
!>
!> @brief Parallel write/read a 3d array partionned on 2d processor grid
!> A(n1/P1, n2/P2, n3), with GHOST CELLS on the partitionned dimensions
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel write/read a 3d array partionned on 2d processor grid
! A(n1/P1, n2/P2, n3), with GHOST CELLS on the partitionned dimensions.
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
INTEGER :: ierr, fid, me, npes
INTEGER, PARAMETER :: ndims=2
INTEGER, PARAMETER :: n1p=3, n2p=2, n3=2 ! Dimension of local array
REAL, DIMENSION(0:n1p+1,0:n2p+1,n3) :: arrayg ! Local array including ghost area
COMPLEX, DIMENSION(0:n1p+1,0:n2p+1,n3) :: carrayg
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, i, j, k, iglob, jglob, nerrors(2)
REAL :: a
COMPLEX :: ca
!===========================================================================
! 1. Prologue
!
! 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 = (/2, 4/)
periods = (/.FALSE., .TRUE./)
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
!
arrayg = me
DO i=1,n1p
iglob = coords(1)*n1p + i
DO j=1,n2p
jglob = coords(2)*n2p + j
DO k=1,n3
arrayg(i,j,k) = 100*iglob + 10*jglob + k
END DO
END DO
END DO
carrayg = CMPLX(arrayg, REAL(me+1))
!===========================================================================
! 2. Parallel write file
!
! Create file collectively, passing the comm. with cartesian topopily
CALL creatf(file, fid, mpicomm=cart)
!
! Write to file collectively using "nd" version of "putarr".
CALL putarrnd(fid, '/parray0', arrayg, (/1,2/), &
& desc='With ghost area')
CALL putarrnd(fid, '/parray', arrayg, (/1,2/), garea=(/1,1/), &
& desc='Without ghost area')
CALL putarrnd(fid, '/pcarray', carrayg, (/1,2/), garea=(/1,1/), &
& desc='Without ghost area')
!===========================================================================
! 3. Parallel read file
!
! Close and reopen file
CALL closef(fid)
CALL openf(file, fid, mpicomm=cart)
!
! Read file
arrayg = 0
carrayg = 0
CALL getarrnd(fid, '/parray', arrayg, (/1,2/), garea=(/1,1/))
CALL getarrnd(fid, '/pcarray', carrayg, (/1,2/), garea=(/1,1/))
!
! Check read arrays
nerrors = 0
DO i=1,n1p
iglob = coords(1)*n1p + i
DO j=1,n2p
jglob = coords(2)*n2p + j
DO k=1,n3
a = 100*iglob + 10*jglob + k
ca = CMPLX(a, REAL(me+1))
IF( a .NE. arrayg(i,j,k)) nerrors(1) = nerrors(1)+1
IF( ca .NE. carrayg(i,j,k)) nerrors(2) = nerrors(2)+1
END DO
END DO
END DO
WRITE(*,'(a,6i5)') 'nerrors reading /parray and /pcarray', nerrors
!
!===========================================================================
! 9. Epilogue
!
! Clean up and quit
CALL closef(fid)
CALL mpi_finalize(ierr)
!
END PROGRAM main
diff --git a/examples/pex12.f90 b/examples/pex12.f90
index d67dd2c..f0b9866 100644
--- a/examples/pex12.f90
+++ b/examples/pex12.f90
@@ -1,127 +1,127 @@
!>
!> @file pex12.f90
!>
!> @brief Create and write array with ghost cells, dynamic version
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Create and write array with ghost cells, dynamic version
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5', str
INTEGER :: ierr, fid, me, npes, lstr
INTEGER, PARAMETER :: ndims=2, comm=MPI_COMM_WORLD
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
!
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n1=7, n2=9, n3=3
INTEGER :: i, j, k, iglob, jglob
DOUBLE PRECISION, ALLOCATABLE :: array2(:,:,:)
!===========================================================================
! 1. Prologue
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! Read 2d processor grid P1xP2 from command line
IF( command_argument_count() .EQ. 2 ) THEN
CALL get_command_argument(1, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(1)
CALL get_command_argument(2, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(2)
ELSE
IF( me.EQ.0 ) PRINT*, 'Requires 2 arguments: P1, P2!'
CALL mpi_abort(MPI_COMM_WORLD, -1, ierr)
END IF
!
! Create cartesian topololy
IF( me .EQ. 0 ) WRITE(*,'(a,i3,i3)') '2d rocessor grid', dims
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartcol, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartrow, ierr)
!===========================================================================
! 2. Array parallel partition
!
! Local array offsets and sizes
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
! Allocate local arrays including ghost cells
ALLOCATE(array2(0:np(1)+1, 0:np(2)+1, n3))
!
! Fill local arrays, with ghost cells containing value of "me"
array2(:,:,:) = me
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
DO k=1,n3
array2(i,j, k) = 100*iglob + 10*jglob + k
END DO
END DO
END DO
!===========================================================================
! 3. Parallel write
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=cart)
!
CALL putarrnd(fid, "/parray2g", array2, (/1,2/), desc='With ghost cells')
CALL putarrnd(fid, "/parray2", array2, (/1,2/), garea=(/1,1/), &
& desc='Without ghost cells')
CALL closef(fid)
!===========================================================================
! 9. Epilogue
DEALLOCATE(array2)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex13.f90 b/examples/pex13.f90
index 43156d0..1fc1598 100644
--- a/examples/pex13.f90
+++ b/examples/pex13.f90
@@ -1,134 +1,134 @@
!>
!> @file pex13.f90
!>
!> @brief Read array from file created by pex12
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Read array from file created by pex12
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5', str
INTEGER :: ierr, fid, me, npes, lstr
INTEGER, PARAMETER :: ndims=2, comm=MPI_COMM_WORLD
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
!
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n1=7, n2=9, n3=3, lun
INTEGER :: i, j, iglob, jglob, k, nerrors
DOUBLE PRECISION, ALLOCATABLE :: array2(:,:,:)
DOUBLE PRECISION :: a
!===========================================================================
! 1. Prologue
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! Read 2d processor grid P1xP2 from command line
IF( command_argument_count() .EQ. 2 ) THEN
CALL get_command_argument(1, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(1)
CALL get_command_argument(2, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(2)
ELSE
IF( me.EQ.0 ) PRINT*, 'Requires 2 arguments: P1, P2!'
CALL mpi_abort(MPI_COMM_WORLD, -1, ierr)
END IF
!
! Create cartesian topololy
IF( me .EQ. 0 ) WRITE(*,'(a,i3,i3)') '2d rocessor grid', dims
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartcol, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartrow, ierr)
!===========================================================================
! 2. Array parallel partition
!
! Local array offsets and sizes
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
! Allocate local arrays including ghost cells
ALLOCATE(array2(0:np(1)+1, 0:np(2)+1, n3))
!
!===========================================================================
! 3. Parallel read
!
CALL openf(file, fid, mpicomm=cart)
array2=-1 ! Initialize with -1
CALL getarrnd(fid, "/parray2", array2, (/1,2/), garea=(/1,1/))
lun = 90+me
WRITE(lun,*) 'Matrice on proc,', me
DO k=1,n3
WRITE(lun,'(a,i2)') 'k =', k
DO i=0,np(1)+1
WRITE(lun,'(20f6.0)') array2(i,:, k)
END DO
END DO
!
! Check read array
!
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
DO k=1,n3
a = 100*iglob + 10*jglob + k
IF( a .NE. array2(i,j,k) ) nerrors = nerrors+1
END DO
END DO
END DO
WRITE(*,'(a,6i5)') 'nerrors reading /parray2', nerrors
CALL closef(fid)
!===========================================================================
! 9. Epilogue
DEALLOCATE(array2)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex14.f90 b/examples/pex14.f90
index 69fc984..330d3b3 100644
--- a/examples/pex14.f90
+++ b/examples/pex14.f90
@@ -1,130 +1,130 @@
!>
!> @file pex14.f90
!>
!> @brief Write 4d array with ghost cells with 2 dimensions distributed on
!> 2d processor grid
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Write 4d array with ghost cells with 2 dimensions distributed on
! 2d processor grid
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5', str
INTEGER :: ierr, fid, me, npes, lstr
INTEGER, PARAMETER :: ndims=2, comm=MPI_COMM_WORLD
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
!
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n0=2, n1=7, n2=9, n3=3
INTEGER :: i0, i, j, k, iglob, jglob
DOUBLE PRECISION, ALLOCATABLE :: array2(:,:,:,:)
!===========================================================================
! 1. Prologue
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! Read 2d processor grid P1xP2 from command line
IF( command_argument_count() .EQ. 2 ) THEN
CALL get_command_argument(1, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(1)
CALL get_command_argument(2, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(2)
ELSE
IF( me.EQ.0 ) PRINT*, 'Requires 2 arguments: P1, P2!'
CALL mpi_abort(MPI_COMM_WORLD, -1, ierr)
END IF
!
! Create cartesian topololy
IF( me .EQ. 0 ) WRITE(*,'(a,i3,i3)') '2d rocessor grid', dims
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartcol, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartrow, ierr)
!===========================================================================
! 2. Array parallel partition
!
! Local array offsets and sizes
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
! Allocate local arrays including ghost cells
ALLOCATE(array2(n0, 0:np(1)+1, 0:np(2)+1, n3))
!
! Fill local arrays, with ghost cells containing value of "me"
array2(:,:,:,:) = me
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
DO k=1,n3
DO i0=1,n0
array2(i0, i,j, k) = 1000*i0 + 100*iglob + 10*jglob + k
END DO
END DO
END DO
END DO
!===========================================================================
! 3. Parallel write
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=cart)
!
CALL putarrnd(fid, "/parray2", array2, (/2,3/), garea=(/1,1/), &
& desc='Without ghost cells')
CALL closef(fid)
!===========================================================================
! 9. Epilogue
DEALLOCATE(array2)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex15.f90 b/examples/pex15.f90
index bdbcb90..011cb59 100644
--- a/examples/pex15.f90
+++ b/examples/pex15.f90
@@ -1,138 +1,138 @@
!>
!> @file pex15.f90
!>
!> @brief Read 4d array from file created by pex14
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Read 4d array from file created by pex14
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5', str
INTEGER :: ierr, fid, me, npes, lstr
INTEGER, PARAMETER :: ndims=2, comm=MPI_COMM_WORLD
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
!
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n0=2, n1=7, n2=9, n3=3, lun
INTEGER :: i0, i, j, iglob, jglob, k, nerrors
DOUBLE PRECISION, ALLOCATABLE :: array2(:,:,:,:)
DOUBLE PRECISION :: a
!===========================================================================
! 1. Prologue
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! Read 2d processor grid P1xP2 from command line
IF( command_argument_count() .EQ. 2 ) THEN
CALL get_command_argument(1, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(1)
CALL get_command_argument(2, str, lstr, ierr)
READ(str(1:lstr),'(i3)') dims(2)
ELSE
IF( me.EQ.0 ) PRINT*, 'Requires 2 arguments: P1, P2!'
CALL mpi_abort(MPI_COMM_WORLD, -1, ierr)
END IF
!
! Create cartesian topololy
IF( me .EQ. 0 ) WRITE(*,'(a,i3,i3)') '2d rocessor grid', dims
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartcol, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartrow, ierr)
!===========================================================================
! 2. Array parallel partition
!
! Local array offsets and sizes
CALL dist1d(cartcol, 0, n1, offsets(1), np(1))
CALL dist1d(cartrow, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
!
! Allocate local arrays including ghost cells
ALLOCATE(array2(n0, 0:np(1)+1, 0:np(2)+1, n3))
!
!===========================================================================
! 3. Parallel read
!
CALL openf(file, fid, mpicomm=cart)
array2=-1 ! Initialize with -1
CALL getarrnd(fid, "/parray2", array2, (/2,3/), garea=(/1,1/))
lun = 90+me
WRITE(lun,*) 'Matrice on proc,', me
DO k=1,n3
DO i0=1,n0
WRITE(lun,'(a,2i2)') 'i0, k =', k, i0
DO i=0,np(1)+1
WRITE(lun,'(20f6.0)') array2(i0,i,:, k)
END DO
END DO
END DO
!
! Check read array
!
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
DO k=1,n3
DO i0=1,n0
a = 1000*i0 + 100*iglob + 10*jglob + k
IF( a .NE. array2(i0, i,j,k) ) nerrors = nerrors+1
END DO
END DO
END DO
END DO
WRITE(*,'(a,6i5)') 'nerrors reading /parray2', nerrors
CALL closef(fid)
!===========================================================================
! 9. Epilogue
DEALLOCATE(array2)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex16.f90 b/examples/pex16.f90
index c957f96..0880358 100644
--- a/examples/pex16.f90
+++ b/examples/pex16.f90
@@ -1,377 +1,377 @@
!>
!> @file pex16.f90
!>
!> @brief
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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 khosh
!> @author ttran
!>
PROGRAM main
! Parallel write/read of 1d and 2d arrays partionned on
! 2d processor grid. Opening and closing on different
! communicators
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
INTEGER, PARAMETER :: ndims=2
INTEGER, DIMENSION(ndims) :: dims, coords
LOGICAL :: periods(ndims), reorder
INTEGER :: cart, cartcol, cartrow
INTEGER, DIMENSION(ndims) :: offsets, np
INTEGER :: n1=7, n2=9
INTEGER :: i, j, k, iglob, jglob, kglob
DOUBLE PRECISION, ALLOCATABLE :: array11(:), array12(:), &
array20(:,:), array21(:,:), array22(:,:)
DOUBLE COMPLEX, ALLOCATABLE :: carray11(:), carray12(:), &
carray20(:,:), carray21(:,:), carray22(:,:)
DOUBLE PRECISION :: a
DOUBLE COMPLEX :: za
INTEGER :: nerrors
!===========================================================================
! 1. Prologue
! 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(1) = 2; dims(2) = 2;
periods = (/.FALSE., .FALSE./)
reorder = .FALSE.
CALL mpi_dims_create(npes, ndims, dims, ierr)
CALL mpi_cart_create(comm, ndims, dims, periods, reorder, cart, ierr)
CALL mpi_cart_coords(cart, me, ndims, coords, ierr)
CALL mpi_cart_sub(cart, (/.TRUE., .FALSE. /), cartrow, ierr)
CALL mpi_cart_sub(cart, (/.FALSE., .TRUE. /), cartcol, ierr)
IF( me .EQ. 0 ) WRITE(*,'(a,i2,i2)') 'Processor grid', dims(1), dims(2)
! Create file collectively
if(me.eq.0) then
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE.)
CALL closef(fid)
end if
call MPI_BARRIER(comm,ierr)
!===========================================================================
! 2. Parallel write file
! Define local 1d array : A(n1/P1)
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
ALLOCATE(array11(np(1)))
ALLOCATE(carray11(np(1)))
DO i=1,np(1)
iglob = offsets(1)+i
array11(i) = 10*iglob
END DO
carray11 = CMPLX(array11, -array11, KIND(array11))
! Define local 1d array : B(n2/P2)
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
ALLOCATE(array12(np(2)))
ALLOCATE(carray12(np(2)))
DO j=1,np(2)
jglob = offsets(2)+j
array12(j) = jglob
END DO
carray12 = CMPLX(array12, -array12, KIND(array12))
! Define local 2d array : C(n1/P1,n2/P2)
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
ALLOCATE(array20(np(1),np(2)))
ALLOCATE(carray20(np(1),np(2)))
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
array20(i,j) = 10*iglob + jglob
END DO
END DO
carray20 = CMPLX(array20, -array20, KIND(array20))
!
! Define local 2d array : D(n1/P1,n2)
!
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
!
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
ALLOCATE(array21(np(1),n2))
ALLOCATE(carray21(np(1),n2))
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,n2
array21(i,j) = 10*iglob + j
END DO
END DO
carray21 = CMPLX(array21, -array21, KIND(array21))
! Define local 2d array : E(n1,n2/P2)
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
WRITE(*,'(a,i3.3,a,10i5)') 'PE', me, ': coords, offsets, np', &
& coords, offsets, np
ALLOCATE(array22(n1,np(2)))
ALLOCATE(carray22(n1,np(2)))
DO i=1,n1
DO j=1,np(2)
jglob = offsets(2)+j
array22(i,j) = 10*i + jglob
END DO
END DO
carray22 = CMPLX(array22, -array22, KIND(array22))
! Write to file on different communicator and close
!! A and D
IF(coords(2).eq.0) THEN
CALL openf(file, fid, mpicomm=cartrow)
CALL putarr(fid, "/parray11", array11, pardim=1)
CALL putarr(fid, "/pcarray11", carray11, pardim=1)
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
CALL putarrnd(fid, "/parray21", array21, (/1/))
CALL putarrnd(fid, "/pcarray21", carray21, (/1/))
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
CALL closef(fid)
END IF
! B and E
IF(coords(1).eq.0) THEN
CALL openf(file, fid, mpicomm=cartcol)
CALL putarr(fid, "/parray12", array12, pardim=1)
CALL putarr(fid, "/pcarray12", carray12, pardim=1)
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
CALL putarrnd(fid, "/parray22", array22, (/2/))
CALL putarrnd(fid, "/pcarray22", carray22, (/2/))
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
CALL closef(fid)
END IF
! C
CALL openf(file, fid, mpicomm=cart)
CALL putarrnd(fid, "/parray20", array20, (/1,2/))
CALL putarrnd(fid, "/pcarray20", carray20, (/1,2/))
WRITE(*,'(a,i3.3,a)') 'PE', me, ': All write ok!'
CALL closef(fid)
!! 3. Parallel read file
!
! Initializing for check read arrays
!
array11 = 0.0d0
carray11 = (0.0d0, 0.0d0)
array12 = 0.0d0
carray12 = (0.0d0, 0.0d0)
array20 = 0.0d0
carray20 = (0.0d0, 0.0d0)
array21 = 0.0d0
carray21 = (0.0d0, 0.0d0)
array22 = 0.0d0
carray22 = (0.0d0, 0.0d0)
!! A and D
IF(coords(2).eq.0) THEN
CALL openf(file, fid, mpicomm=cartrow)
CALL getarr(fid, "/parray11", array11, pardim=1)
CALL getarr(fid, "/pcarray11", carray11, pardim=1)
! Check read arrays
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
a = 10*iglob
IF( a .NE. array11(i) ) nerrors = nerrors+1
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /parray11', nerrors
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
za = CMPLX(array11(i), -array11(i), KIND(array11))
IF( za .NE. carray11(i) ) nerrors = nerrors+1
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /pcarray11', nerrors
CALL getarrnd(fid, "/parray21", array21, (/1/))
CALL getarrnd(fid, "/pcarray21", carray21, (/1/))
! Check read arrays
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,n2
a = 10*iglob + j
IF( a .NE. array21(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /parray21', nerrors
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,n2
za = CMPLX(array21(i,j), -array21(i,j), KIND(array21))
IF( za .NE. carray21(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /pcarray21', nerrors
CALL closef(fid)
END IF
!! B and E
IF(coords(1).eq.0) THEN
CALL openf(file, fid, mpicomm=cartcol)
CALL getarr(fid, "/parray12", array12, pardim=1)
CALL getarr(fid, "/pcarray12", carray12, pardim=1)
! Check read arrays
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
nerrors = 0
DO j=1,np(2)
jglob = offsets(2)+j
a = jglob
IF( a .NE. array12(j) ) nerrors = nerrors+1
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /parray12', nerrors
nerrors = 0
DO j=1,np(2)
jglob = offsets(2)+j
za = CMPLX(array12(j), -array12(j), KIND(array12))
IF( za .NE. carray12(j) ) nerrors = nerrors+1
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /pcarray12', nerrors
CALL getarrnd(fid, "/parray22", array22, (/2/))
CALL getarrnd(fid, "/pcarray22", carray22, (/2/))
! Check read arrays
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
nerrors = 0
DO i=1,n1
DO j=1,np(2)
jglob = offsets(2)+j
a = 10*i + jglob
IF( a .NE. array22(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /parray22', nerrors
nerrors = 0
DO i=1,n1
DO j=1,np(2)
jglob = offsets(2)+j
za = CMPLX(array22(i,j), -array22(i,j), KIND(array22))
IF( za .NE. carray22(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /pcarray22', nerrors
CALL closef(fid)
END IF
!! C
CALL openf(file, fid, mpicomm=cart)
CALL getarrnd(fid, "/parray20", array20, (/1,2/))
CALL getarrnd(fid, "/pcarray20", carray20, (/1,2/))
! Check read arrays
CALL dist1d(cartrow, 0, n1, offsets(1), np(1))
CALL dist1d(cartcol, 0, n2, offsets(2), np(2))
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
a = 10*iglob + jglob
IF( a .NE. array20(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /parray20', nerrors
nerrors = 0
DO i=1,np(1)
iglob = offsets(1)+i
DO j=1,np(2)
jglob = offsets(2)+j
za = CMPLX(array20(i,j), -array20(i,j), KIND(array20))
IF( za .NE. carray20(i,j) ) nerrors = nerrors+1
END DO
END DO
WRITE(*,'(a27,i5)') 'nerrors reading /pcarray20', nerrors
CALL closef(fid)
!! 9. Epilogue
DEALLOCATE(array11, array12, array20, array21, array22)
DEALLOCATE(carray11, carray12, carray20, carray21, carray22)
CALL mpi_finalize(ierr)
END PROGRAM main
-SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ SUBROUTINE dist1d(comm, s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: comm, me, npes, ierr, naver, rem
CALL MPI_COMM_SIZE(comm, npes, ierr)
CALL MPI_COMM_RANK(comm, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
END SUBROUTINE dist1d
diff --git a/examples/pex3.f90 b/examples/pex3.f90
index 176457c..1bb820b 100644
--- a/examples/pex3.f90
+++ b/examples/pex3.f90
@@ -1,122 +1,122 @@
!>
!> @file pex3.f90
!>
!> @brief 1d/2d time-dependent profiles using "append" (parallel version)
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Multi-dim (+UNLIMITED time dim) profiles
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='pprof.h5'
INTEGER, PARAMETER :: nx=256, ny=512
INTEGER :: me, npes, offset, nyp
INTEGER :: fid, rank, dims(7)
INTEGER :: i, j, istep, ierr, n, nrun=50
DOUBLE PRECISION, ALLOCATABLE :: xg(:), yg(:), phi2(:,:)
DOUBLE PRECISION :: dx, dy, pi, time, x0, s
!===========================================================================
! 1. Prologue
!
! Init MPI
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
! 1D partition in Y-direction
CALL dist1d(0, ny, offset, nyp)
WRITE(*,'(a,i3.3,a,2i6)') 'PE', me, ': offset, nyp', offset, nyp
ALLOCATE(xg(nx), yg(nyp), phi2(nx,nyp))
!
! Init HDF5
CALL creatf(file, fid, 'A simple simulation', mpicomm=MPI_COMM_WORLD)
CALL creatg(fid, "/profile_2d", "1D profiles")
!
rank = 0
CALL creatd(fid, rank, dims, "/profile_2d/time", "Normalized Time")
!
rank = 2
dims(1) = nx; dims(2) = nyp
CALL creatd(fid, rank, dims, "/profile_2d/phi", "Potential", pardim=2)
IF( me .EQ. 0 ) WRITE(*,'(a)') 'extendible datasets in /profile_1d created'
!===========================================================================
! 2. Initialization
!
pi = 4*ATAN(1.0d0)
dx = 2.*pi/REAL(nx-1)
dy = pi/real(ny-1)
DO i=1,nx
xg(i) = (i-1)*dx
END DO
DO j=1,nyp
yg(j) = (j+offset-1)*dy
END DO
CALL putarr(fid, "/profile_2d/xg", xg, "x mesh")
IF( me .EQ. 0 ) WRITE(*,'(a)') 'x-mesh'
CALL putarr(fid, "/profile_2d/yg", yg, "y mesh", pardim=1)
IF( me .EQ. 0 ) WRITE(*,'(a)') 'y-mesh'
!===========================================================================
! 3. Time loop
!
x0 = 0.5
DO istep=1,nrun
!
time = istep-1
s = 0.1+0.1*time
DO i=1,nx
DO j=1,nyp
phi2(i,j) = SIN(xg(i)) * COS(yg(j)) * COS(0.04*pi*time)
END DO
END DO
!
CALL append(fid, "/profile_2d/time", time, ionode=0) ! Only rank=0 writes it
!!$ CALL append(fid, "/profile_2d/time", time)
CALL append(fid, "/profile_2d/phi", phi2, pardim=2)
IF( me .EQ. 0 ) WRITE(*,'(a,i5,a)') 'Step', istep, ' done'
!
END DO
!===========================================================================
! 9. Epilogue
!
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex4.f90 b/examples/pex4.f90
index 8131e80..ab5a9ad 100644
--- a/examples/pex4.f90
+++ b/examples/pex4.f90
@@ -1,132 +1,132 @@
!>
!> @file pex4.f90
!>
!> @brief Create particle arrays using "putarr" (paralle version)
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Particle array using fixed dims (parallel version)
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
CHARACTER(len=256) :: file='part.h5'
CHARACTER(len=32) :: name
!!$ INTEGER, PARAMETER :: npart=1024*100, nattrs=8
INTEGER, PARAMETER :: npart=1024, nattrs=2
INTEGER :: cart
INTEGER :: fid, istep, nrun=4
INTEGER :: me, npes, n, ierr, nptot, nploc(1), s0(1)
DOUBLE PRECISION :: r0=100.0, a=20.0, time, pi, dphi, s(npart), theta(npart)
DOUBLE PRECISION, ALLOCATABLE :: part(:,:) ! (r, z, phi) coordinates
DOUBLE PRECISION :: t0, t1, twrite, mb, mbs_write
!===========================================================================
! 1. Prologue
!
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
CALL mpi_cart_create(MPI_COMM_WORLD, 1, [npes], [.FALSE.], .FALSE., &
& cart, ierr)
!!$ PRINT*, 'cart created!'
!
IF( command_argument_count() > 0 ) THEN
CALL get_command_argument(1, file, n, ierr)
END IF
!
CALL creatf(file, fid, 'A simple simulation', &
& real_prec='d', mpicomm=cart)
CALL creatg(fid, "/part", "Particles Coordinates") ! Group
!===========================================================================
! 2. Time loop
!
nptot = npart
CALL dist1d(1, nptot, s0, nploc(1))
ALLOCATE(part(nattrs,nploc(1)))
CALL initp(nattrs, nploc(1), part, s0(1))
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
t0 = mpi_wtime()
!
DO istep=1,nrun
time = istep
WRITE(name,'(a,i3.3)') "/part/", istep
CALL creatg(fid, name) ! Group
CALL putarr(fid, TRIM(name)//'/s0', s0, pardim=1) ! Local scalar
CALL putarr(fid, TRIM(name)//'/nploc', nploc, pardim=1) ! Local scalar
CALL putarr(fid, TRIM(name)//'/part', part, pardim=2) ! local 2d array
CALL attach(fid, name, "time", time) ! Attr on dataset
CALL attach(fid, name, "step", istep)
END DO
nptot = npes*npart
CALL attach(fid, "/part", "nptot", nptot)
CALL attach(fid, "/part", "nattrs", nattrs)
CALL attach(fid, "/part", "nsteps", nrun)
!
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
twrite = mpi_wtime()-t0
mb = 8.0*REAL(SIZE(part))/1024.0/1024*npes*nrun
mbs_write = mb/twrite
IF( me.EQ. 0) THEN
WRITE(*,'(a,5(f8.3,a))') 'Write performance:', &
& twrite, ' s,',mb, ' MB,', mbs_write, ' MB/s'
END IF
!===========================================================================
! 9. Epilogue
!
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE initp(natts, n, p, s)
IMPLICIT NONE
INTEGER :: natts, n,s
DOUBLE PRECISION :: x, p(natts,n)
INTEGER :: i, j
x=s-1.0d0
DO j=1,n
x=x+1.0d0
DO i=1,natts
p(i,j) = 1.d0/x
END DO
END DO
END SUBROUTINE initp
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
PRINT*, 'me, ntot, npes ', me, ntot, npes
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex5.f90 b/examples/pex5.f90
index fca440d..72c527f 100644
--- a/examples/pex5.f90
+++ b/examples/pex5.f90
@@ -1,126 +1,126 @@
!>
!> @file pex5.f90
!>
!> @brief Parallel read particle arrays (created in pex4) using "getarr"
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel read of particle array
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
CHARACTER(len=256) :: file='part.h5'
CHARACTER(len=32) :: name
INTEGER :: nattrs, nptot, npart
INTEGER :: cart
INTEGER :: fidr
INTEGER :: me, npes, n, ierr, nrun, s, istep, nerrs, i
DOUBLE PRECISION, ALLOCATABLE :: part(:,:) ! (r, z, phi) coordinates
DOUBLE PRECISION :: t0, t1, tread, mb, mbs_read
!===========================================================================
!!
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
CALL mpi_cart_create(MPI_COMM_WORLD, 1, [npes], [.FALSE.], .FALSE., &
& cart, ierr)
!
! Parallel read of "part.h5"
CALL openf(file, fidr,real_prec='d', mpicomm=cart)
!
CALL getatt(fidr, '/part', 'nptot', nptot)
CALL getatt(fidr, '/part', 'nattrs', nattrs)
CALL getatt(fidr, '/part', 'nsteps', nrun)
PRINT*, 'nptot, nattrs, nrun ', nptot, nattrs, nrun
!
CALL dist1d(1, nptot, s, npart)
PRINT*,'s, part', s, npart
ALLOCATE(part(nattrs,npart))
!
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
t0 = mpi_wtime()
!
DO istep=1,nrun
WRITE(name,'(a,i3.3)') "/part/", istep
CALL getarr(fidr, TRIM(name)//'/part', part, pardim=2) ! local 2d array
!!$ CALL getarr(fidr, name, part, pardim=2)
END DO
!
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
tread = mpi_wtime()-t0
mb = 8.0*REAL(SIZE(part))/1024.0/1024*npes*nrun
mbs_read = mb/tread
IF( me.EQ. 0) THEN
WRITE(*,'(a,5(f8.3,a))') 'Read performance:', &
& tread, ' s,',mb, ' MB,', mbs_read, ' MB/s'
END IF
!
CALL check(nattrs, npart, part, nerrs, s)
n = nerrs
CALL mpi_reduce(n, nerrs, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr)
IF ( me .EQ. 0 ) THEN
WRITE(*, '(a,i12)' ) 'Number of errors return from CHECK:', nerrs
END IF
!
CALL closef(fidr)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
SUBROUTINE check(natts, n, p, nerrs, s)
IMPLICIT NONE
INTEGER :: natts, n, nerrs, s
DOUBLE PRECISION :: x, p(natts,n)
INTEGER :: i, j
nerrs = 0
x=s-1.0d0
DO j=1,n
x=x+1.0d0
DO i=1,natts
IF( p(i,j) .NE. 1.0d0/x ) THEN
nerrs=nerrs+1
IF(nerrs.LE.2) THEN
PRINT*, 'i, j, p(i,j), 1.0d0/x ', i, j, p(i,j), 1.0d0/x
END IF
END IF
END DO
END DO
END SUBROUTINE check
diff --git a/examples/pex5r.f90 b/examples/pex5r.f90
index 51efab3..279d9e4 100644
--- a/examples/pex5r.f90
+++ b/examples/pex5r.f90
@@ -1,75 +1,75 @@
!>
!> @file pex5r.f90
!>
!> @brief Serial version of pex5
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel read of particle array
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
CHARACTER(len=32) :: filein='part.h5'
CHARACTER(len=32) :: name
INTEGER :: nattrs, nptot, npart
INTEGER :: fidr
INTEGER :: me, npes, n, ierr, nrun, s, istep, nerrs
DOUBLE PRECISION, ALLOCATABLE :: part(:,:) ! (r, z, phi) coordinates
DOUBLE PRECISION :: t0, t1, tread, mb, mbs_read
!===========================================================================
!!
CALL openf(filein, fidr)
CALL getatt(fidr, '/part', 'nptot', nptot)
CALL getatt(fidr, '/part', 'nattrs', nattrs)
CALL getatt(fidr, '/part', 'nsteps', nrun)
!
npart = nptot
ALLOCATE(part(nattrs,npart))
WRITE(*,'(a,i3,2i8)') 'nattrs, npart, nrun =', nattrs, npart, nrun
!
DO istep=1,nrun
WRITE(name,'(a,i3.3)') "/part/", istep
CALL getarr(fidr, name, part)
CALL check(nattrs, npart, part, nerrs, 1)
WRITE(*, '(a,i12)' ) 'Number of errors return from CHECK:', nerrs
WRITE(*,'(a,i4,a)') 'Step', istep, ' done'
END DO
!
CALL closef(fidr)
END PROGRAM main
SUBROUTINE check(natts, n, p, nerrs, s)
IMPLICIT NONE
INTEGER :: natts, n, nerrs, s
DOUBLE PRECISION :: x, p(natts,n)
INTEGER :: i, j
nerrs = 0
x=0.0
DO j=1,n
x=x+1.0d0
DO i=1,natts
IF( p(i,j) .NE. 1.0d0/x ) nerrs=nerrs+1
END DO
END DO
END SUBROUTINE check
diff --git a/examples/pex6.f90 b/examples/pex6.f90
index 7f189c2..db684d2 100644
--- a/examples/pex6.f90
+++ b/examples/pex6.f90
@@ -1,90 +1,90 @@
!>
!> @file pex6.f90
!>
!> @brief Test of optionall "ionode" in parallel "getarr"
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parrallel read dataset created by pex1 with "getarr".
! Only "ionode" effectively reads it!
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
CHARACTER(len=32) :: name='/array_col'
INTEGER :: nx=5, ny=8
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
INTEGER :: start, nxp, nyp, i, j, k, n, ionode = 1
DOUBLE PRECISION, ALLOCATABLE :: array(:,:)
REAL, ALLOCATABLE :: garray(:,:)
!===========================================================================
!
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD, npes, ierr)
CALL mpi_comm_rank(MPI_COMM_WORLD, me, ierr)
!
CALL dist1d(0, ny, start, nyp)
!!$ PRINT*, 'PE', me, ' start, nx, nyp', start, nx, nyp
ALLOCATE(array(nx,nyp), garray(nx,ny))
array = 0.0
garray=0.0
!
CALL openf(file, fid, mpicomm=MPI_COMM_WORLD)
PRINT*, 'PE', me, file, 'Opened'
CALL getarr(fid, name, array, pardim=2)
PRINT*, 'PE', me, ' first getarr ok'
CALL getarr(fid, name, garray, ionode=ionode)
PRINT*, 'PE', me, ' second getarr ok'
!
DO j=0,npes-1
IF( me.EQ.j) THEN
WRITE(6,'(a,i3.3)') 'PE', me
DO i=1,nx
WRITE(6,'((10f6.0))') (garray(i,k), k=1,ny)
END DO
END IF
CALL mpi_barrier(comm, ierr)
END DO
!
DEALLOCATE(array)
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d
diff --git a/examples/pex7.f90 b/examples/pex7.f90
index a98ce37..eba56a8 100644
--- a/examples/pex7.f90
+++ b/examples/pex7.f90
@@ -1,90 +1,90 @@
!>
!> @file pex7.f90
!>
!> @brief Test of optionall "ionode" in parallel "putarr"
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! P-IO by selected nodes
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='para.h5'
INTEGER :: nx=5
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
INTEGER :: start, nxp, nyp, i, j, n
DOUBLE PRECISION, ALLOCATABLE :: array(:), parray(:)
REAL, ALLOCATABLE :: sarray(:), psarray(:)
INTEGER, ALLOCATABLE :: iarray(:), piarray(:)
INTEGER :: ionode
!===========================================================================
! 1. Prologue
! 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 file collectively
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpicomm=MPI_COMM_WORLD)
!
! *All* processors allocate array
!
ALLOCATE(array(nx), iarray(nx), sarray(nx))
!
! Only array from ionode will be written
!
ionode = npes-1
DO i=1,nx
array(i) = 10*me + i
END DO
iarray = -array
sarray = 1.0/array
CALL putarr(fid, "/array", array, ionode=ionode)
CALL putarr(fid, "/iarray", iarray, ionode=ionode)
CALL putarr(fid, "/sarray", sarray, ionode=ionode)
!
! Partitionned array
!
ALLOCATE(parray(nx), piarray(nx), psarray(nx))
DO i=1,nx
parray(i) = me*nx + i
END DO
piarray = -parray
psarray = 1.0/array
CALL putarr(fid, "/parray", parray, pardim=1)
CALL putarr(fid, "/piarray", piarray, pardim=1)
CALL putarr(fid, "/psarray", psarray, pardim=1)
!
!===========================================================================
! 9. Epilogue
!
DEALLOCATE(array)
DEALLOCATE(parray)
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
diff --git a/examples/pex8.f90 b/examples/pex8.f90
index 6a44b34..9bb64d8 100644
--- a/examples/pex8.f90
+++ b/examples/pex8.f90
@@ -1,119 +1,119 @@
!>
!> @file pex8.f90
!>
!> @brief Parallel append 0d vars (history 0d arrays)
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel append 0d vars (history 0d arrays)
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=256) :: file='sim.h5'
INTEGER :: ierr, fid, me, npes
INTEGER :: rank, dims(7), istep, ibuf, n, nrun=10
INTEGER, PARAMETER :: bufsize=1000
DOUBLE PRECISION :: buf(bufsize, 0:2) ! To store hist. arrays for scalars
DOUBLE PRECISION :: time, ekin, epot, t0, t1, mb, mbs
!===========================================================================
! 1. Prologue
! 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 file collectively
!
CALL creatf(file, fid, 'A simple simulation', &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=MPI_COMM_WORLD)
!
! Create datasets collectively
!
CALL creatg(fid, "/scalars", "Time evolution for Scalars")
WRITE(*,'(a)') 'group scalars created'
!
rank = 0
CALL creatd(fid, rank, dims, "/scalars/time", "Normalized Time")
CALL creatd(fid, rank, dims, "/scalars/ekin", "Kinetic Energy")
CALL creatd(fid, rank, dims, "/scalars/epot", "Potential Energy")
WRITE(*,'(a)') 'extendible datasets in /scalars created'
!
!===========================================================================
! 2. Time loop
!
nrun = MAX(nrun, bufsize)
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
t0 = mpi_wtime()
ibuf=0
DO istep=1,nrun
time = istep
ekin = COS(0.2*time)*EXP(0.001*time)
epot = SIN(0.2*time)*(1.0-EXP(0.001*time))
!
IF( bufsize .LE. 1 ) THEN
IF( me.EQ.0 ) PRINT*, 'Dump the buffers at istep = ', istep
CALL append(fid, "/scalars/time", time)
CALL append(fid, "/scalars/ekin", ekin)
CALL append(fid, "/scalars/epot", epot)
!!$ CALL append(fid, "/scalars/time", time, ionode=0)
!!$ CALL append(fid, "/scalars/ekin", ekin, ionode=0)
!!$ CALL append(fid, "/scalars/epot", epot, ionode=0)
ELSE
ibuf = ibuf+1
buf(ibuf,0) = time
buf(ibuf,1) = ekin
buf(ibuf,2) = epot
IF( ibuf.EQ.bufsize .OR. istep.EQ.nrun) THEN ! Dump the buffers to file
IF( me.EQ.0 ) PRINT*, 'Dump the buffers at istep = ', istep
CALL append(fid, "/scalars/time", buf(1:ibuf,0))
CALL append(fid, "/scalars/ekin", buf(1:ibuf,1))
CALL append(fid, "/scalars/epot", buf(1:ibuf,2))
!!$ CALL append(fid, "/scalars/time", buf(1:ibuf,0), ionode=0)
!!$ CALL append(fid, "/scalars/ekin", buf(1:ibuf,1), ionode=0)
!!$ CALL append(fid, "/scalars/epot", buf(1:ibuf,2), ionode=0)
ibuf = 0
END IF
END IF
END DO
CALL getsize(fid, "/scalars/time", n)
CALL mpi_barrier(MPI_COMM_WORLD, ierr)
t1 = mpi_wtime() - t0
mb = 4.*3.*n/1024.0/1024.0
mbs = mb/t1
IF( me .EQ. 0 ) THEN
WRITE(*,'(a, i6)') 'Number of steps =', n
WRITE(*,'(a, i6)') 'Buffer size =', bufsize
WRITE(*,'(a, f8.3)') 'Elapsed time (s) =', t1
WRITE(*,'(a, f8.3)') 'Size of file (MB)=', mb
WRITE(*,'(a, f8.3)') 'BW (MB/s) =', mbs
END IF
!
!===========================================================================
! 9. Epilogue
!
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
diff --git a/examples/pex9.f90 b/examples/pex9.f90
index 4f9c157..73803d7 100644
--- a/examples/pex9.f90
+++ b/examples/pex9.f90
@@ -1,96 +1,96 @@
!>
!> @file pex9.f90
!>
!> @brief Parallel write a 2d COMPLEX array (from pex1.f90)
!>
!> @copyright
!> Copyright (©) 2021 EPFL (Ecole Polytechnique Fédérale de Lausanne)
!> SPC (Swiss Plasma Center)
!>
!> futils 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.
!>
!> futils 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
!
! Parallel write a 2d complex array
!
USE futils
+ USE mpi
IMPLICIT NONE
- INCLUDE "mpif.h"
CHARACTER(len=32) :: file='cpara.h5'
INTEGER :: nx=5, ny=8
INTEGER :: ierr, fid, me, npes, comm=MPI_COMM_WORLD
INTEGER :: start, nxp, nyp, i, j, n
DOUBLE COMPLEX, ALLOCATABLE :: array(:,:)
!===========================================================================
! 1. Prologue
! 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 file collectively
IF( command_argument_count() > 0 ) THEN
CALL get_command_argument(1, file, n, ierr)
END IF
!
CALL creatf(file, fid, &
& desc="A parallel file", &
& real_prec='s', &
& mpiposix=.FALSE., &
& mpicomm=MPI_COMM_WORLD)
!
CALL putfile(fid, '/README.txt', &
& 'README.txt', ionode=0)
CALL putfile(fid, '/Makefile', &
& 'Makefile', ionode=1)
!===========================================================================
! 2. Parallel write file
!
! Define local array partitionned by columns
CALL dist1d(0, ny, start, nyp)
ALLOCATE(array(nx,nyp))
DO i=1,nx
DO j=1,nyp
array(i,j) = CMPLX(10*i + (start+j), me+1)
END DO
END DO
CALL putarr(fid, "/array_col", array, pardim=2)
PRINT*, 'dataset /array_col created'
DEALLOCATE(array)
!===========================================================================
! 9. Epilogue
!
CALL closef(fid)
CALL mpi_finalize(ierr)
END PROGRAM main
SUBROUTINE dist1d(s0, ntot, s, nloc)
+ USE mpi
IMPLICIT NONE
- INCLUDE 'mpif.h'
INTEGER, INTENT(in) :: s0, ntot
INTEGER, INTENT(out) :: s, nloc
INTEGER :: me, npes, ierr, naver, rem
!
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierr)
naver = ntot/npes
rem = MODULO(ntot,npes)
s = s0 + MIN(rem,me) + me*naver
nloc = naver
IF( me.LT.rem ) nloc = nloc+1
!
END SUBROUTINE dist1d