Allreduce better suited than Bcast
This commit is contained in:
Martin Diehl
parent
a5dad0ca5c
commit
6f3771f6c4
|
|
@ -11,14 +11,9 @@ module spectral_damage
|
|||
use prec, only: &
|
||||
pInt, &
|
||||
pReal
|
||||
use math, only: &
|
||||
math_I3
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -42,7 +37,7 @@ module spectral_damage
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reference diffusion tensor, mobility etc.
|
||||
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
|
||||
integer(pInt), private :: totalIter = 0 !< total iteration in current increment
|
||||
real(pReal), dimension(3,3), private :: D_ref
|
||||
real(pReal), private :: mobility_ref
|
||||
|
||||
|
|
@ -67,11 +62,13 @@ subroutine spectral_damage_init()
|
|||
use damage_nonlocal, only: &
|
||||
damage_nonlocal_getDiffusion33, &
|
||||
damage_nonlocal_getMobility
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize
|
||||
|
||||
implicit none
|
||||
PetscInt, dimension(:), allocatable :: localK
|
||||
integer(pInt) :: proc
|
||||
integer(pInt) :: i, j, k, cell
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
integer :: i, j, k, cell
|
||||
DM :: damage_grid
|
||||
Vec :: uBound, lBound
|
||||
PetscErrorCode :: ierr
|
||||
|
|
@ -85,10 +82,9 @@ subroutine spectral_damage_init()
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,damage_snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(damage_snes,'damage_',ierr);CHKERRQ(ierr)
|
||||
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
|
||||
do proc = 1, worldsize
|
||||
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
|
||||
enddo
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
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
|
||||
|
|
@ -135,8 +131,8 @@ subroutine spectral_damage_init()
|
|||
cell = 0_pInt
|
||||
D_ref = 0.0_pReal
|
||||
mobility_ref = 0.0_pReal
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
D_ref = D_ref + damage_nonlocal_getDiffusion33(1,cell)
|
||||
mobility_ref = mobility_ref + damage_nonlocal_getMobility(1,cell)
|
||||
enddo; enddo; enddo
|
||||
|
|
@ -162,19 +158,14 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC
|
|||
damage_nonlocal_putNonLocalDamage
|
||||
|
||||
implicit none
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! input data for solution
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc, & !< increment in time for current solution
|
||||
timeinc_old, & !< increment in time of last increment
|
||||
loadCaseTime !< remaining time of current load case
|
||||
integer(pInt) :: i, j, k, cell
|
||||
|
||||
integer :: i, j, k, cell
|
||||
PetscInt ::position
|
||||
PetscReal :: minDamage, maxDamage, stagNorm, solnNorm
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! PETSc Data
|
||||
PetscErrorCode :: ierr
|
||||
SNESConvergedReason :: reason
|
||||
|
||||
|
|
@ -205,9 +196,9 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! updating damage state
|
||||
cell = 0_pInt !< material point = 0
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt !< material point increase
|
||||
cell = 0
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
call damage_nonlocal_putNonLocalDamage(damage_current(i,j,k),1,cell)
|
||||
enddo; enddo; enddo
|
||||
|
||||
|
|
|
|||
|
|
@ -108,8 +108,8 @@ subroutine basic_init
|
|||
|
||||
PetscErrorCode :: ierr
|
||||
PetscScalar, pointer, dimension(:,:,:,:) :: F
|
||||
PetscInt, dimension(:), allocatable :: localK
|
||||
integer :: proc, fileUnit
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
integer :: fileUnit
|
||||
character(len=1024) :: rankStr
|
||||
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
|
||||
|
|
@ -125,10 +125,9 @@ subroutine basic_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
|
||||
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
|
||||
do proc = 1, worldsize !ToDo: there are smarter options in MPI
|
||||
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
|
||||
enddo
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -118,8 +118,8 @@ subroutine Polarisation_init
|
|||
FandF_tau, & ! overall pointer to solution data
|
||||
F, & ! specific (sub)pointer
|
||||
F_tau ! specific (sub)pointer
|
||||
PetscInt, dimension(:), allocatable :: localK
|
||||
integer :: proc, fileUnit
|
||||
PetscInt, dimension(worldsize) :: localK
|
||||
integer :: fileUnit
|
||||
character(len=1024) :: rankStr
|
||||
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>'
|
||||
|
|
@ -137,10 +137,9 @@ subroutine Polarisation_init
|
|||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
|
||||
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
|
||||
do proc = 1, worldsize !ToDo: there are smarter options in MPI
|
||||
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
|
||||
enddo
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -9,16 +9,10 @@ module spectral_thermal
|
|||
use PETScdmda
|
||||
use PETScsnes
|
||||
use prec, only: &
|
||||
pInt, &
|
||||
pReal
|
||||
use math, only: &
|
||||
math_I3
|
||||
use spectral_utilities, only: &
|
||||
tSolutionState, &
|
||||
tSolutionParams
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize
|
||||
|
||||
implicit none
|
||||
private
|
||||
|
|
@ -42,7 +36,7 @@ module spectral_thermal
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reference diffusion tensor, mobility etc.
|
||||
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
|
||||
integer, private :: totalIter = 0 !< total iteration in current increment
|
||||
real(pReal), dimension(3,3), private :: D_ref
|
||||
real(pReal), private :: mobility_ref
|
||||
|
||||
|
|
@ -57,13 +51,6 @@ contains
|
|||
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine spectral_thermal_init
|
||||
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
|
||||
use, intrinsic :: iso_fortran_env, only: &
|
||||
compiler_version, &
|
||||
compiler_options
|
||||
#endif
|
||||
use IO, only: &
|
||||
IO_timeStamp
|
||||
use spectral_utilities, only: &
|
||||
wgt
|
||||
use mesh, only: &
|
||||
|
|
@ -77,11 +64,13 @@ subroutine spectral_thermal_init
|
|||
mappingHomogenization, &
|
||||
temperature, &
|
||||
thermalMapping
|
||||
use numerics, only: &
|
||||
worldrank, &
|
||||
worldsize
|
||||
|
||||
implicit none
|
||||
integer(pInt), dimension(:), allocatable :: localK
|
||||
integer(pInt) :: proc
|
||||
integer(pInt) :: i, j, k, cell
|
||||
integer, dimension(worldsize) :: localK
|
||||
integer :: i, j, k, cell
|
||||
DM :: thermal_grid
|
||||
PetscScalar, dimension(:,:,:), pointer :: x_scal
|
||||
PetscErrorCode :: ierr
|
||||
|
|
@ -89,17 +78,14 @@ subroutine spectral_thermal_init
|
|||
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
|
||||
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,'
|
||||
write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018'
|
||||
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
|
||||
#include "compilation_info.f90"
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! initialize solver specific parts of PETSc
|
||||
call SNESCreate(PETSC_COMM_WORLD,thermal_snes,ierr); CHKERRQ(ierr)
|
||||
call SNESSetOptionsPrefix(thermal_snes,'thermal_',ierr);CHKERRQ(ierr)
|
||||
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
|
||||
do proc = 1, worldsize
|
||||
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
|
||||
enddo
|
||||
localK = 0
|
||||
localK(worldrank+1) = grid3
|
||||
call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
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
|
||||
|
|
@ -128,9 +114,9 @@ subroutine spectral_thermal_init
|
|||
allocate(temperature_current(grid(1),grid(2),grid3), source=0.0_pReal)
|
||||
allocate(temperature_lastInc(grid(1),grid(2),grid3), source=0.0_pReal)
|
||||
allocate(temperature_stagInc(grid(1),grid(2),grid3), source=0.0_pReal)
|
||||
cell = 0_pInt
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
cell = 0
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
temperature_current(i,j,k) = temperature(mappingHomogenization(2,1,cell))% &
|
||||
p(thermalMapping(mappingHomogenization(2,1,cell))%p(1,cell))
|
||||
temperature_lastInc(i,j,k) = temperature_current(i,j,k)
|
||||
|
|
@ -142,11 +128,11 @@ subroutine spectral_thermal_init
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! thermal reference diffusion update
|
||||
cell = 0_pInt
|
||||
cell = 0
|
||||
D_ref = 0.0_pReal
|
||||
mobility_ref = 0.0_pReal
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
D_ref = D_ref + thermal_conduction_getConductivity33(1,cell)
|
||||
mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* &
|
||||
thermal_conduction_getSpecificHeat(1,cell)
|
||||
|
|
@ -174,18 +160,14 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load
|
|||
|
||||
implicit none
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! input data for solution
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc, & !< increment in time for current solution
|
||||
timeinc_old, & !< increment in time of last increment
|
||||
loadCaseTime !< remaining time of current load case
|
||||
integer(pInt) :: i, j, k, cell
|
||||
integer :: i, j, k, cell
|
||||
PetscInt :: position
|
||||
PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! PETSc Data
|
||||
PetscErrorCode :: ierr
|
||||
SNESConvergedReason :: reason
|
||||
|
||||
|
|
@ -216,9 +198,9 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! updating thermal state
|
||||
cell = 0_pInt !< material point = 0
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt !< material point increase
|
||||
cell = 0
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), &
|
||||
(temperature_current(i,j,k)-temperature_lastInc(i,j,k))/params%timeinc, &
|
||||
1,cell)
|
||||
|
|
@ -272,7 +254,7 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr)
|
|||
f_scal
|
||||
PetscObject :: dummy
|
||||
PetscErrorCode :: ierr
|
||||
integer(pInt) :: i, j, k, cell
|
||||
integer :: i, j, k, cell
|
||||
real(pReal) :: Tdot, dTdot_dT
|
||||
|
||||
temperature_current = x_scal
|
||||
|
|
@ -283,18 +265,18 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr)
|
|||
call utilities_FFTscalarForward()
|
||||
call utilities_fourierScalarGradient() !< calculate gradient of damage field
|
||||
call utilities_FFTvectorBackward()
|
||||
cell = 0_pInt
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
cell = 0
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
vectorField_real(1:3,i,j,k) = math_mul33x3(thermal_conduction_getConductivity33(1,cell) - D_ref, &
|
||||
vectorField_real(1:3,i,j,k))
|
||||
enddo; enddo; enddo
|
||||
call utilities_FFTvectorForward()
|
||||
call utilities_fourierVectorDivergence() !< calculate damage divergence in fourier field
|
||||
call utilities_FFTscalarBackward()
|
||||
cell = 0_pInt
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
cell = 0
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, temperature_current(i,j,k), 1, cell)
|
||||
scalarField_real(i,j,k) = params%timeinc*scalarField_real(i,j,k) + &
|
||||
params%timeinc*Tdot + &
|
||||
|
|
@ -333,7 +315,7 @@ subroutine spectral_thermal_forward()
|
|||
thermal_conduction_getSpecificHeat
|
||||
|
||||
implicit none
|
||||
integer(pInt) :: i, j, k, cell
|
||||
integer :: i, j, k, cell
|
||||
DM :: dm_local
|
||||
PetscScalar, dimension(:,:,:), pointer :: x_scal
|
||||
PetscErrorCode :: ierr
|
||||
|
|
@ -344,13 +326,13 @@ subroutine spectral_thermal_forward()
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reverting thermal field state
|
||||
cell = 0_pInt !< material point = 0
|
||||
cell = 0
|
||||
call SNESGetDM(thermal_snes,dm_local,ierr); CHKERRQ(ierr)
|
||||
call DMDAVecGetArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with
|
||||
x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current
|
||||
call DMDAVecRestoreArrayF90(dm_local,solution,x_scal,ierr); CHKERRQ(ierr)
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt !< material point increase
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
call thermal_conduction_putTemperatureAndItsRate(temperature_current(i,j,k), &
|
||||
(temperature_current(i,j,k) - &
|
||||
temperature_lastInc(i,j,k))/params%timeinc, &
|
||||
|
|
@ -360,11 +342,11 @@ subroutine spectral_thermal_forward()
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! update rate and forward last inc
|
||||
temperature_lastInc = temperature_current
|
||||
cell = 0_pInt
|
||||
cell = 0
|
||||
D_ref = 0.0_pReal
|
||||
mobility_ref = 0.0_pReal
|
||||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt,grid(1)
|
||||
cell = cell + 1_pInt
|
||||
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
|
||||
cell = cell + 1
|
||||
D_ref = D_ref + thermal_conduction_getConductivity33(1,cell)
|
||||
mobility_ref = mobility_ref + thermal_conduction_getMassDensity(1,cell)* &
|
||||
thermal_conduction_getSpecificHeat(1,cell)
|
||||
|
|
|
|||
Loading…
Reference in New Issue