223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

allgather instead of allreduce+sum with contribution from 1 proc

This commit is contained in:
Martin Diehl 2023-07-16 06:35:38 +02:00
parent 09b0cc3101
commit b54cf03d6d
9 changed files with 75 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/HDF5_utilities.f90
View File

@ -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 integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel logical, intent(in) :: parallel
integer(HSIZE_T), intent(in), dimension(:) :: & integer(HSIZE_T), intent(in), dimension(:) :: localShape
localShape integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
integer(HSIZE_T), intent(out), dimension(size(localShape,1)):: &
myStart, & myStart, &
globalShape !< shape of the dataset (all processes) globalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(MPI_INTEGER_KIND), dimension(worldsize) :: & integer(MPI_INTEGER_KIND), dimension(worldsize) :: readSize !< contribution of all processes
readSize !< contribution of all processes
integer :: hdferr integer :: hdferr
integer(MPI_INTEGER_KIND) :: err_MPI 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 if (parallel) then
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call HDF5_chkerr(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' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if end if
#endif #endif
@ -1930,15 +1929,14 @@ end subroutine finalize_read
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, & 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 integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in) :: parallel logical, intent(in) :: parallel
integer(HID_T), intent(in) :: datatype integer(HID_T), intent(in) :: datatype
integer(HSIZE_T), intent(in), dimension(:) :: & integer(HSIZE_T), intent(in), dimension(:) :: localShape
myShape integer(HSIZE_T), intent(out), dimension(size(localShape)) :: &
integer(HSIZE_T), intent(out), dimension(size(myShape,1)):: &
myStart, & myStart, &
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
integer(HID_T), intent(out) :: dset_id, filespace_id, memspace_id, plist_id 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 ! determine the global data layout among all processes
writeSize = 0_MPI_INTEGER_KIND 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 #ifdef PETSC
if (parallel) then 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' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
end if end if
#endif #endif
myStart = int(0,HSIZE_T) myStart = int(0,HSIZE_T)
myStart(ubound(myStart)) = int(sum(writeSize(1:worldrank)),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 ! 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) ! 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 HDF5_chkerr(hdferr)
call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
call HDF5_chkerr(hdferr) 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) ! 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 H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
call HDF5_chkerr(hdferr) 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 HDF5_chkerr(hdferr)
call H5Pclose_f(dcpl , hdferr) call H5Pclose_f(dcpl , hdferr)

2
src/grid/DAMASK_grid.f90
View File

@ -366,7 +366,7 @@ program DAMASK_grid
end if end if
Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step 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 t = t + Delta_t ! just advance time, skip already performed calculation
guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference
else skipping else skipping

12
src/grid/discretization_grid.f90
View File

@ -68,7 +68,7 @@ subroutine discretization_grid_init(restart)
j j
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
integer(C_INTPTR_T) :: & integer(C_INTPTR_T) :: &
devNull, z, z_offset devNull, cells3_, cells3Offset_
integer, dimension(worldsize) :: & integer, dimension(worldsize) :: &
displs, sendcounts displs, sendcounts
character(len=:), allocatable :: & character(len=:), allocatable :: &
@ -113,12 +113,12 @@ subroutine discretization_grid_init(restart)
call fftw_mpi_init() 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), & 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, & PETSC_COMM_WORLD, &
z, & ! domain cells size along z cells3_, & ! domain cells size along z
z_offset) ! domain cells offset along z cells3Offset_) ! domain cells offset along z
if (z==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes') if (cells3_==0_C_INTPTR_T) call IO_error(894, ext_msg='Cannot distribute MPI processes')
cells3 = int(z) cells3 = int(cells3_)
cells3Offset = int(z_offset) cells3Offset = int(cells3Offset_)
size3 = geomSize(3)*real(cells3,pREAL) /real(cells(3),pREAL) size3 = geomSize(3)*real(cells3,pREAL) /real(cells(3),pREAL)
size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL) size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL)
myGrid = [cells(1:2),cells3] myGrid = [cells(1:2),cells3]

15
src/grid/grid_damage_spectral.f90
View File

@ -72,7 +72,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_init() 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 integer :: i, j, k, ce
DM :: damage_grid DM :: damage_grid
real(pREAL), dimension(:,:,:), pointer :: phi_PETSc real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
@ -129,17 +129,16 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_damage,'damage_',err_PETSc) call SNESSetOptionsPrefix(SNES_damage,'damage_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3D(PETSC_COMM_WORLD, & call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
1_pPetscInt, 0_pPetscInt, & ! #dof (phi, scalar), ghost boundary width (domain overlap) 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(cells3_global,pPETSCINT), & ! local cells
damage_grid,err_PETSc) ! handle, error damage_grid,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(damage_grid,err_PETSc) call DMsetFromOptions(damage_grid,err_PETSc)

17
src/grid/grid_mech_FEM.f90
View File

@ -115,7 +115,7 @@ subroutine grid_mechanical_FEM_init
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
PetscScalar, pointer, dimension(:,:,:,:) :: & PetscScalar, pointer, dimension(:,:,:,:) :: &
u,u_lastInc u,u_lastInc
PetscInt, dimension(0:worldsize-1) :: localK integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid num_grid
@ -167,17 +167,16 @@ subroutine grid_mechanical_FEM_init
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, & DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, &
DMDA_STENCIL_BOX, & DMDA_STENCIL_BOX, &
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
3_pPetscInt, 1_pPetscInt, & ! #dof (u, vector), ghost boundary width (domain overlap) 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(cells3_global,pPETSCINT), & ! local cells
mechanical_grid,err_PETSc) mechanical_grid,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(mechanical_grid,err_PETSc) call DMsetFromOptions(mechanical_grid,err_PETSc)
@ -198,7 +197,7 @@ subroutine grid_mechanical_FEM_init
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "_converged" call SNESSetConvergenceTest(SNES_mechanical,converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,err_PETSc) ! specify custom convergence check function "_converged"
CHKERRQ(err_PETSc) 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) CHKERRQ(err_PETSc)
call SNESSetDM(SNES_mechanical,mechanical_grid,err_PETSc) call SNESSetDM(SNES_mechanical,mechanical_grid,err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)

15
src/grid/grid_mech_spectral_basic.f90
View File

@ -110,7 +110,7 @@ subroutine grid_mechanical_spectral_basic_init()
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
real(pREAL), pointer, dimension(:,:,:,:) :: & real(pREAL), pointer, dimension(:,:,:,:) :: &
F ! pointer to solution data 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 real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
@ -166,17 +166,16 @@ subroutine grid_mechanical_spectral_basic_init()
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
9_pPetscInt, 0_pPetscInt, & ! #dof (F, tensor), ghost boundary width (domain overlap) 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(cells3_global,pPETSCINT), & ! local cells
da,err_PETSc) ! handle, error da,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc) call DMsetFromOptions(da,err_PETSc)

15
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -123,7 +123,7 @@ subroutine grid_mechanical_spectral_polarisation_init()
FandF_tau, & ! overall pointer to solution data FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer F, & ! specific (sub)pointer
F_tau ! 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 real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: & type(tDict), pointer :: &
@ -187,17 +187,16 @@ subroutine grid_mechanical_spectral_polarisation_init()
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc) call SNESSetOptionsPrefix(SNES_mechanical,'mechanical_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,pPetscInt),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
18_pPetscInt, 0_pPetscInt, & ! #dof (2xtensor), ghost boundary width (domain overlap) 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(cells3_global,pPETSCINT), & ! local cells
da,err_PETSc) ! handle, error da,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(da,err_PETSc) call DMsetFromOptions(da,err_PETSc)

17
src/grid/grid_thermal_spectral.f90
View File

@ -70,7 +70,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_init() 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 integer :: i, j, k, ce
DM :: DM_thermal DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
@ -113,17 +113,16 @@ subroutine grid_thermal_spectral_init()
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call SNESSetOptionsPrefix(SNES_thermal,'thermal_',err_PETSc) call SNESSetOptionsPrefix(SNES_thermal,'thermal_',err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
localK = 0_pPetscInt call MPI_Allgather(int(cells3,pPETSCINT),1_MPI_INTEGER_KIND,MPI_INTEGER,&
localK(worldrank) = int(cells3,pPetscInt) cells3_global,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call DMDACreate3D(PETSC_COMM_WORLD, & call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
int(cells(1),pPetscInt),int(cells(2),pPetscInt),int(cells(3),pPetscInt), & ! global cells int(cells(1),pPETSCINT),int(cells(2),pPETSCINT),int(cells(3),pPETSCINT), & ! global cells
1_pPetscInt, 1_pPetscInt, int(worldsize,pPetscInt), & 1_pPETSCINT, 1_pPETSCINT, int(worldsize,pPETSCINT), &
1_pPetscInt, 0_pPetscInt, & ! #dof (T, scalar), ghost boundary width (domain overlap) 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(cells3_global,pPETSCINT), & ! local cells
DM_thermal,err_PETSc) ! handle, error DM_thermal,err_PETSc) ! handle, error
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
call DMsetFromOptions(DM_thermal,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 call DMDAVecGetArrayF90(DM_thermal,T_PETSc,T,err_PETSc) ! returns 0-indexed T
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
stagNorm = maxval(abs(T - T_stagInc))
T_min = minval(T) T_min = minval(T)
T_max = maxval(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) 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' 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) solution%stagConverged = stagNorm < max(num%eps_thermal_atol, num%eps_thermal_rtol*T_max)

40
src/result.f90
View File

@ -495,10 +495,9 @@ subroutine result_mapping_phase(ID,entry,label)
integer, dimension(:,:), intent(in) :: entry !< phase entry at (co,ce) integer, dimension(:,:), intent(in) :: entry !< phase entry at (co,ce)
character(len=*), dimension(:), intent(in) :: label !< label of each phase section character(len=*), dimension(:), intent(in) :: label !< label of each phase section
integer(pI64), dimension(size(entry,1),size(entry,2)) :: & integer(pI64), dimension(size(entry,1),size(entry,2)) :: entryGlobal
entryGlobal
integer(pI64), dimension(size(label),0:worldsize-1) :: entryOffset !< offset in entry counting per process 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) :: & integer(HSIZE_T), dimension(2) :: &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
myOffset, & myOffset, &
@ -521,21 +520,19 @@ subroutine result_mapping_phase(ID,entry,label)
integer(MPI_INTEGER_KIND) :: err_MPI 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 H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
#ifndef PETSC #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 #else
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! MPI settings and communication ! MPI settings and communication
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call MPI_Allgather(size(entry,dim=2,kind=MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call parallelization_chkerr(err_MPI) call parallelization_chkerr(err_MPI)
entryOffset = 0_pI64 entryOffset = 0_pI64
@ -554,9 +551,9 @@ subroutine result_mapping_phase(ID,entry,label)
end do end do
#endif #endif
myShape = int([size(ID,1),writeSize(worldrank)], HSIZE_T) myShape = int([size(ID,1,MPI_INTEGER_KIND),writeSize(worldrank)], HSIZE_T)
myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T) myOffset = int([0_MPI_INTEGER_KIND,sum(writeSize(0:worldrank-1))], HSIZE_T)
totalShape = int([size(ID,1),sum(writeSize)], HSIZE_T) totalShape = int([size(ID,1,MPI_INTEGER_KIND),sum(writeSize)], HSIZE_T)
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
! compound type: label(ID) + entry ! 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) integer, dimension(:), intent(in) :: entry !< homogenization entry at (ce)
character(len=*), dimension(:), intent(in) :: label !< label of each homogenization section character(len=*), dimension(:), intent(in) :: label !< label of each homogenization section
integer(pI64), dimension(size(entry,1)) :: & integer(pI64), dimension(size(entry,1)) :: entryGlobal
entryGlobal
integer(pI64), dimension(size(label),0:worldsize-1) :: entryOffset !< offset in entry counting per process 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) :: & integer(HSIZE_T), dimension(1) :: &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
myOffset, & myOffset, &
@ -677,31 +673,29 @@ subroutine result_mapping_homogenization(ID,entry,label)
integer(MPI_INTEGER_KIND) :: err_MPI 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 H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
#ifndef PETSC #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 #else
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! MPI settings and communication ! MPI settings and communication
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call HDF5_chkerr(hdferr) call HDF5_chkerr(hdferr)
call MPI_Allgather(size(entry,kind=MPI_INTEGER_KIND),1_MPI_INTEGER_KIND,MPI_INTEGER,&
call MPI_Allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,err_MPI) ! get output at each process writeSize,1_MPI_INTEGER_KIND,MPI_INTEGER,MPI_COMM_WORLD,err_MPI)
call parallelization_chkerr(err_MPI) call parallelization_chkerr(err_MPI)
entryOffset = 0_pI64 entryOffset = 0_pI64
do ce = 1, size(ID,1) do ce = 1, size(ID)
entryOffset(ID(ce),worldrank) = entryOffset(ID(ce),worldrank) +1_pI64 entryOffset(ID(ce),worldrank) = entryOffset(ID(ce),worldrank) +1_pI64
end do 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 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) call parallelization_chkerr(err_MPI)
entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2) 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) entryGlobal(ce) = int(entry(ce),pI64) -1_pI64 + entryOffset(ID(ce),worldrank)
end do end do
#endif #endif