From b54cf03d6d018c5841066c750268343f9583bb14 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 16 Jul 2023 06:35:38 +0200 Subject: [PATCH] allgather instead of allreduce+sum with contribution from 1 proc --- src/HDF5_utilities.f90 | 29 +++++++------- src/grid/DAMASK_grid.f90 | 2 +- src/grid/discretization_grid.f90 | 12 +++--- src/grid/grid_damage_spectral.f90 | 15 ++++---- src/grid/grid_mech_FEM.f90 | 17 ++++----- src/grid/grid_mech_spectral_basic.f90 | 15 ++++---- src/grid/grid_mech_spectral_polarisation.f90 | 15 ++++---- src/grid/grid_thermal_spectral.f90 | 17 ++++----- src/result.f90 | 40 +++++++++----------- 9 files changed, 75 insertions(+), 87 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 857fd30d1..b87dbad3d 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1836,15 +1836,13 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in) :: parallel - integer(HSIZE_T), intent(in), dimension(:) :: & - localShape - integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: & + integer(HSIZE_T), intent(in), dimension(:) :: localShape + integer(HSIZE_T), intent(out), dimension(size(localShape)) :: & myStart, & globalShape !< shape of the dataset (all processes) integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id - integer(MPI_INTEGER_KIND), dimension(worldsize) :: & - readSize !< contribution of all processes + integer(MPI_INTEGER_KIND), dimension(worldsize) :: readSize !< contribution of all processes integer :: hdferr integer(MPI_INTEGER_KIND) :: err_MPI @@ -1860,7 +1858,8 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ if (parallel) then call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call HDF5_chkerr(hdferr) - call MPI_Allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get total output size over each process + call MPI_Allgather(int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + readSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' end if #endif @@ -1930,15 +1929,14 @@ end subroutine finalize_read !-------------------------------------------------------------------------------------------------- subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, totalShape, & - loc_id,myShape,datasetName,datatype,parallel) + loc_id,localShape,datasetName,datatype,parallel) integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in) :: parallel integer(HID_T), intent(in) :: datatype - integer(HSIZE_T), intent(in), dimension(:) :: & - myShape - integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: & + integer(HSIZE_T), intent(in), dimension(:) :: localShape + integer(HSIZE_T), intent(out), dimension(size(localShape)) :: & myStart, & totalShape !< shape of the dataset (all processes) integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id @@ -1964,16 +1962,17 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & !-------------------------------------------------------------------------------------------------- ! determine the global data layout among all processes writeSize = 0_MPI_INTEGER_KIND - writeSize(worldrank+1) = int(myShape(ubound(myShape,1)),MPI_INTEGER_KIND) + writeSize(worldrank+1) = int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND) #ifdef PETSC if (parallel) then - call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get total output size over each process + call MPI_Allgather(int(localShape(ubound(localShape,1)),MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' end if #endif myStart = int(0,HSIZE_T) myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),HSIZE_T) - totalShape = [myShape(1:ubound(myShape,1)-1),int(sum(writeSize),HSIZE_T)] + totalShape = [localShape(1:ubound(localShape,1)-1),int(sum(writeSize),HSIZE_T)] !-------------------------------------------------------------------------------------------------- ! chunk dataset, enable compression for larger datasets @@ -2001,7 +2000,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) and in file (global shape) - call H5Screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape) + call H5Screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) call HDF5_chkerr(hdferr) call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) call HDF5_chkerr(hdferr) @@ -2010,7 +2009,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & ! create dataset in the file and select a hyperslab from it (the portion of the current process) call H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl) call HDF5_chkerr(hdferr) - call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr) + call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) call HDF5_chkerr(hdferr) call H5Pclose_f(dcpl , hdferr) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 443f69f9c..8efb2358a 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -366,7 +366,7 @@ program DAMASK_grid end if Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step - skipping: if (totalIncsCounter <= CLI_restartInc) then ! not yet at restart inc? + skipping: if (totalIncsCounter <= CLI_restartInc) then ! not yet at restart inc? t = t + Delta_t ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference else skipping diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index e77a173e3..2cb5dbf9f 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -68,7 +68,7 @@ subroutine discretization_grid_init(restart) j integer(MPI_INTEGER_KIND) :: err_MPI integer(C_INTPTR_T) :: & - devNull, z, z_offset + devNull, cells3_, cells3Offset_ integer, dimension(worldsize) :: & displs, sendcounts character(len=:), allocatable :: & @@ -113,12 +113,12 @@ subroutine discretization_grid_init(restart) call fftw_mpi_init() devNull = fftw_mpi_local_size_3d(int(cells(3),C_INTPTR_T),int(cells(2),C_INTPTR_T),int(cells(1)/2+1,C_INTPTR_T), & PETSC_COMM_WORLD, & - z, & ! domain cells size along z - z_offset) ! domain cells offset along z - if (z==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes') + cells3_, & ! domain cells size along z + cells3Offset_) ! domain cells offset along z + if (cells3_==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes') - cells3 = int(z) - cells3Offset = int(z_offset) + cells3 = int(cells3_) + cells3Offset = int(cells3Offset_) size3 = geomSize(3)*real(cells3,pREAL) /real(cells(3),pREAL) size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL) myGrid = [cells(1:2),cells3] diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 90680daea..a2e60cb01 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -72,7 +72,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine grid_damage_spectral_init() - PetscInt, dimension(0:worldsize-1) :: localK + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global integer :: i, j, k, ce DM :: damage_grid real(pREAL), dimension(:,:,:), pointer :: phi_PETSc @@ -129,17 +129,16 @@ subroutine grid_damage_spectral_init() CHKERRQ(err_PETSc) call SNESSetOptionsPrefix(SNES_damage,'damage_',err_PETSc) CHKERRQ(err_PETSc) - localK = 0_pPetscInt - localK(worldrank) = int(cells3,pPetscInt) - call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) + call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call DMDACreate3D(PETSC_COMM_WORLD, & DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells - 1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & - 1_pPetscInt, 0_pPetscInt, & ! #dof (phi, scalar), ghost boundary width (domain overlap) - [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells + int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells + 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), & + 1_pPETSCINT, 0_pPETSCINT, & ! #dof (phi, scalar), ghost boundary width (domain overlap) + [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],int(cells3_global,pPETSCINT), & ! local cells damage_grid,err_PETSc) ! handle, error CHKERRQ(err_PETSc) call DMsetFromOptions(damage_grid,err_PETSc) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 17bf01ac0..14f750d73 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -115,7 +115,7 @@ subroutine grid_mechanical_FEM_init integer(MPI_INTEGER_KIND) :: err_MPI PetscScalar, pointer, dimension(:,:,:,:) :: & u,u_lastInc - PetscInt, dimension(0:worldsize-1) :: localK + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global integer(HID_T) :: fileHandle, groupHandle type(tDict), pointer :: & num_grid @@ -167,17 +167,16 @@ subroutine grid_mechanical_FEM_init CHKERRQ(err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) CHKERRQ(err_PETSc) - localK = 0_pPetscInt - localK(worldrank) = int(cells3,pPetscInt) - call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) + call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call DMDACreate3d(PETSC_COMM_WORLD, & DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, & DMDA_STENCIL_BOX, & - int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells - 1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & - 3_pPetscInt, 1_pPetscInt, & ! #dof (u, vector), ghost boundary width (domain overlap) - [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells + int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells + 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), & + 3_pPETSCINT, 1_pPETSCINT, & ! #dof (u, vector), ghost boundary width (domain overlap) + [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells mechanical_grid,err_PETSc) CHKERRQ(err_PETSc) call DMsetFromOptions(mechanical_grid,err_PETSc) @@ -198,7 +197,7 @@ subroutine grid_mechanical_FEM_init CHKERRQ(err_PETSc) call SNESSetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "_converged" CHKERRQ(err_PETSc) - call SNESSetMaxLinearSolveFailures(SNES_mechanical, huge(1_pPetscInt), err_PETSc) ! ignore linear solve failures + call SNESSetMaxLinearSolveFailures(SNES_mechanical, huge(1_pPETSCINT), err_PETSc) ! ignore linear solve failures CHKERRQ(err_PETSc) call SNESSetDM(SNES_mechanical,mechanical_grid,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 4bd9c5a96..0ada208c1 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -110,7 +110,7 @@ subroutine grid_mechanical_spectral_basic_init() integer(MPI_INTEGER_KIND) :: err_MPI real(pREAL), pointer, dimension(:,:,:,:) :: & F ! pointer to solution data - PetscInt, dimension(0:worldsize-1) :: localK + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n integer(HID_T) :: fileHandle, groupHandle type(tDict), pointer :: & @@ -166,17 +166,16 @@ subroutine grid_mechanical_spectral_basic_init() CHKERRQ(err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) CHKERRQ(err_PETSc) - localK = 0_pPetscInt - localK(worldrank) = int(cells3,pPetscInt) - call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) + call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call DMDACreate3d(PETSC_COMM_WORLD, & DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells - 1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & - 9_pPetscInt, 0_pPetscInt, & ! #dof (F, tensor), ghost boundary width (domain overlap) - [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells + int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells + 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), & + 9_pPETSCINT, 0_pPETSCINT, & ! #dof (F, tensor), ghost boundary width (domain overlap) + [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells da,err_PETSc) ! handle, error CHKERRQ(err_PETSc) call DMsetFromOptions(da,err_PETSc) diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 60e7d676e..bc1c0484c 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -123,7 +123,7 @@ subroutine grid_mechanical_spectral_polarisation_init() FandF_tau, & ! overall pointer to solution data F, & ! specific (sub)pointer F_tau ! specific (sub)pointer - PetscInt, dimension(0:worldsize-1) :: localK + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n integer(HID_T) :: fileHandle, groupHandle type(tDict), pointer :: & @@ -187,17 +187,16 @@ subroutine grid_mechanical_spectral_polarisation_init() CHKERRQ(err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) CHKERRQ(err_PETSc) - localK = 0_pPetscInt - localK(worldrank) = int(cells3,pPetscInt) - call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) + call MPI_Allgather(int(cells3,pPetscInt),1_MPI_INTEGER_KIND,MPI_INTEGER,& + cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call DMDACreate3d(PETSC_COMM_WORLD, & DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells - 1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & - 18_pPetscInt, 0_pPetscInt, & ! #dof (2xtensor), ghost boundary width (domain overlap) - [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells + int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells + 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), & + 18_pPETSCINT, 0_pPETSCINT, & ! #dof (2xtensor), ghost boundary width (domain overlap) + [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells da,err_PETSc) ! handle, error CHKERRQ(err_PETSc) call DMsetFromOptions(da,err_PETSc) diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 0c7cf3a54..e8fd0c914 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -70,7 +70,7 @@ contains !-------------------------------------------------------------------------------------------------- subroutine grid_thermal_spectral_init() - PetscInt, dimension(0:worldsize-1) :: localK + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global integer :: i, j, k, ce DM :: DM_thermal real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed @@ -113,17 +113,16 @@ subroutine grid_thermal_spectral_init() CHKERRQ(err_PETSc) call SNESSetOptionsPrefix(SNES_thermal,'thermal_',err_PETSc) CHKERRQ(err_PETSc) - localK = 0_pPetscInt - localK(worldrank) = int(cells3,pPetscInt) - call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) + call MPI_Allgather(int(cells3,pPETSCINT),1_MPI_INTEGER_KIND,MPI_INTEGER,& + cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' call DMDACreate3D(PETSC_COMM_WORLD, & DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells - 1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & - 1_pPetscInt, 0_pPetscInt, & ! #dof (T, scalar), ghost boundary width (domain overlap) - [int(cells(1),pPetscInt)],[int(cells(2),pPetscInt)],localK, & ! local cells + int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells + 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), & + 1_pPETSCINT, 0_pPETSCINT, & ! #dof (T, scalar), ghost boundary width (domain overlap) + [int(cells(1),pPETSCINT)],[int(cells(2),pPETSCINT)],int(cells3_global,pPETSCINT), & ! local cells DM_thermal,err_PETSc) ! handle, error CHKERRQ(err_PETSc) call DMsetFromOptions(DM_thermal,err_PETSc) @@ -214,9 +213,9 @@ function grid_thermal_spectral_solution(Delta_t) result(solution) call DMDAVecGetArrayF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T CHKERRQ(err_PETSc) - stagNorm = maxval(abs(T - T_stagInc)) T_min = minval(T) T_max = maxval(T) + stagNorm = maxval(abs(T - T_stagInc)) call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_MAX,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' solution%stagConverged = stagNorm < max(num%eps_thermal_atol, num%eps_thermal_rtol*T_max) diff --git a/src/result.f90 b/src/result.f90 index de9db4091..242bdbe28 100644 --- a/src/result.f90 +++ b/src/result.f90 @@ -495,10 +495,9 @@ subroutine result_mapping_phase(ID,entry,label) integer, dimension(:,:), intent(in) :: entry !< phase entry at (co,ce) character(len=*), dimension(:), intent(in) :: label !< label of each phase section - integer(pI64), dimension(size(entry,1),size(entry,2)) :: & - entryGlobal + integer(pI64), dimension(size(entry,1),size(entry,2)) :: entryGlobal integer(pI64), dimension(size(label),0:worldsize-1) :: entryOffset !< offset in entry counting per process - integer, dimension(0:worldsize-1) :: writeSize !< amount of data written per process + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: writeSize !< amount of data written per process integer(HSIZE_T), dimension(2) :: & myShape, & !< shape of the dataset (this process) myOffset, & @@ -521,21 +520,19 @@ subroutine result_mapping_phase(ID,entry,label) integer(MPI_INTEGER_KIND) :: err_MPI - writeSize = 0 - writeSize(worldrank) = size(entry(1,:)) ! total number of entries of this process - call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) call HDF5_chkerr(hdferr) #ifndef PETSC - entryGlobal = int(entry -1,pI64) ! 0-based + entryGlobal = int(entry-1,pI64) ! 0-based + writeSize(0) = size(entry,dim=2,kind=MPI_INTEGER_KIND) ! total number of entries of this process #else !-------------------------------------------------------------------------------------------------- ! MPI settings and communication call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call HDF5_chkerr(hdferr) - - call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process + call MPI_Allgather(size(entry,dim=2,kind=MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) call parallelization_chkerr(err_MPI) entryOffset = 0_pI64 @@ -554,9 +551,9 @@ subroutine result_mapping_phase(ID,entry,label) end do #endif - myShape = int([size(ID,1),writeSize(worldrank)], HSIZE_T) - myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T) - totalShape = int([size(ID,1),sum(writeSize)], HSIZE_T) + myShape = int([size(ID,1,MPI_INTEGER_KIND),writeSize(worldrank)], HSIZE_T) + myOffset = int([0_MPI_INTEGER_KIND,sum(writeSize(0:worldrank-1))], HSIZE_T) + totalShape = int([size(ID,1,MPI_INTEGER_KIND),sum(writeSize)], HSIZE_T) !--------------------------------------------------------------------------------------------------- ! compound type: label(ID) + entry @@ -651,10 +648,9 @@ subroutine result_mapping_homogenization(ID,entry,label) integer, dimension(:), intent(in) :: entry !< homogenization entry at (ce) character(len=*), dimension(:), intent(in) :: label !< label of each homogenization section - integer(pI64), dimension(size(entry,1)) :: & - entryGlobal + integer(pI64), dimension(size(entry,1)) :: entryGlobal integer(pI64), dimension(size(label),0:worldsize-1) :: entryOffset !< offset in entry counting per process - integer, dimension(0:worldsize-1) :: writeSize !< amount of data written per process + integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: writeSize !< amount of data written per process integer(HSIZE_T), dimension(1) :: & myShape, & !< shape of the dataset (this process) myOffset, & @@ -677,31 +673,29 @@ subroutine result_mapping_homogenization(ID,entry,label) integer(MPI_INTEGER_KIND) :: err_MPI - writeSize = 0 - writeSize(worldrank) = size(entry) ! total number of entries of this process - call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) call HDF5_chkerr(hdferr) #ifndef PETSC - entryGlobal = int(entry -1,pI64) ! 0-based + entryGlobal = int(entry-1,pI64) + writeSize(0) = size(entry,kind=MPI_INTEGER_KIND) ! total number of entries of this process ! 0-based #else !-------------------------------------------------------------------------------------------------- ! MPI settings and communication call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call HDF5_chkerr(hdferr) - - call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process + call MPI_Allgather(size(entry,kind=MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,& + writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI) call parallelization_chkerr(err_MPI) entryOffset = 0_pI64 - do ce = 1, size(ID,1) + do ce = 1, size(ID) entryOffset(ID(ce),worldrank) = entryOffset(ID(ce),worldrank) +1_pI64 end do call MPI_Allreduce(MPI_IN_PLACE,entryOffset,size(entryOffset),MPI_INTEGER8,MPI_SUM,MPI_COMM_WORLD,err_MPI)! get offset at each process call parallelization_chkerr(err_MPI) entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2) - do ce = 1, size(ID,1) + do ce = 1, size(ID) entryGlobal(ce) = int(entry(ce),pI64) -1_pI64 + entryOffset(ID(ce),worldrank) end do #endif