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