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

avoid code (loop) duplication

This commit is contained in:
Martin Diehl 2023-07-20 23:33:43 +02:00
parent 535ccf1378
commit 1fdc5443b2
5 changed files with 33 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/grid/grid_damage_spectral.f90
View File

@ -75,7 +75,6 @@ subroutine grid_damage_spectral_init(num_grid)
type(tDict), pointer, intent(in) :: num_grid
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer :: i, j, k, ce
DM :: DM_damage
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
Vec :: uBound, lBound
@ -139,7 +138,7 @@ subroutine grid_damage_spectral_init(num_grid)
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
DM_damage,err_PETSc) ! handle, error
DM_damage,err_PETSc) ! handle, error
CHKERRQ(err_PETSc)
call DMsetFromOptions(DM_damage,err_PETSc)
CHKERRQ(err_PETSc)
@ -193,11 +192,7 @@ subroutine grid_damage_spectral_init(num_grid)
phi_stagInc = phi_lastInc
end if restartRead
ce = 0
do k = 0, cells3-1; do j = 0, cells(2)-1; do i = 0, cells(1)-1
ce = ce + 1
call homogenization_set_phi(phi(i,j,k),ce)
end do; end do; end do
call homogenization_set_phi(reshape(phi,[product(cells(1:2))*cells3]))
call DMDAVecRestoreArrayF90(DM_damage,phi_PETSc,phi,err_PETSc)
CHKERRQ(err_PETSc)
@ -215,7 +210,6 @@ function grid_damage_spectral_solution(Delta_t) result(solution)
real(pREAL), intent(in) :: &
Delta_t !< increment in time for current solution
integer :: i, j, k, ce
type(tSolutionState) :: solution
PetscInt :: devNull
PetscReal :: phi_min, phi_max, stagNorm
@ -253,13 +247,7 @@ function grid_damage_spectral_solution(Delta_t) result(solution)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
phi_stagInc = phi
!--------------------------------------------------------------------------------------------------
! updating damage state
ce = 0
do k = 0, cells3-1; do j = 0, cells(2)-1; do i = 0,cells(1)-1
ce = ce + 1
call homogenization_set_phi(phi(i,j,k),ce)
end do; end do; end do
call homogenization_set_phi(reshape(phi,[product(cells(1:2))*cells3]))
call DMDAVecRestoreArrayF90(DM_damage,phi_PETSc,phi,err_PETSc)
CHKERRQ(err_PETSc)
@ -280,7 +268,6 @@ subroutine grid_damage_spectral_forward(cutBack)
logical, intent(in) :: cutBack
integer :: i, j, k, ce
DM :: DM_damage
real(pREAL), dimension(:,:,:), pointer :: phi ! 0-indexed
PetscErrorCode :: err_PETSc
@ -292,11 +279,7 @@ subroutine grid_damage_spectral_forward(cutBack)
CHKERRQ(err_PETSc)
if (cutBack) then
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_set_phi(phi_lastInc(i,j,k),ce)
end do; end do; end do
call homogenization_set_phi(reshape(phi_lastInc,[product(cells(1:2))*cells3]))
phi = phi_lastInc
phi_stagInc = phi_lastInc
else

26
src/grid/grid_thermal_spectral.f90
View File

@ -74,7 +74,7 @@ subroutine grid_thermal_spectral_init(num_grid)
type(tDict), pointer, intent(in) :: num_grid
integer(MPI_INTEGER_KIND), dimension(0:worldsize-1) :: cells3_global
integer :: i, j, k, ce
integer :: ce
DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
integer(MPI_INTEGER_KIND) :: err_MPI
@ -170,11 +170,8 @@ subroutine grid_thermal_spectral_init(num_grid)
dotT_lastInc = 0.0_pREAL * T_lastInc
end if restartRead
ce = 0
do k = 0, cells3-1; do j = 0, cells(2)-1; do i = 0, cells(1)-1
ce = ce + 1
call homogenization_thermal_setField(T(i,j,k),0.0_pREAL,ce)
end do; end do; end do
call homogenization_thermal_setField(reshape(T,[product(cells(1:2))*cells3]), &
[(0.0_pReal, ce = 1,product(cells(1:2))*cells3)])
call DMDAVecRestoreArrayF90(DM_thermal,T_PETSc,T,err_PETSc)
CHKERRQ(err_PETSc)
@ -230,13 +227,8 @@ function grid_thermal_spectral_solution(Delta_t) result(solution)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
T_stagInc = T
!--------------------------------------------------------------------------------------------------
! updating thermal state
ce = 0
do k = 0, cells3-1; do j = 0, cells(2)-1; do i = 0, cells(1)-1
ce = ce + 1
call homogenization_thermal_setField(T(i,j,k),(T(i,j,k)-T_lastInc(i+1,j+1,k+1))/params%Delta_t,ce)
end do; end do; end do
call homogenization_thermal_setField(reshape(T,[product(cells(1:2))*cells3]), &
reshape(T-T_lastInc,[product(cells(1:2))*cells3])/params%Delta_t)
call DMDAVecRestoreArrayF90(DM_thermal,T_PETSc,T,err_PETSc)
CHKERRQ(err_PETSc)
@ -257,7 +249,6 @@ subroutine grid_thermal_spectral_forward(cutBack)
logical, intent(in) :: cutBack
integer :: i, j, k, ce
DM :: DM_thermal
real(pREAL), dimension(:,:,:), pointer :: T ! 0-indexed
PetscErrorCode :: err_PETSc
@ -269,11 +260,8 @@ subroutine grid_thermal_spectral_forward(cutBack)
CHKERRQ(err_PETSc)
if (cutBack) then
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1,cells(1)
ce = ce + 1
call homogenization_thermal_setField(T_lastInc(i,j,k),dotT_lastInc(i,j,k),ce)
end do; end do; end do
call homogenization_thermal_setField(reshape(T_lastInc,[product(cells(1:2))*cells3]), &
reshape(dotT_lastInc,[product(cells(1:2))*cells3]))
T = T_lastInc
T_stagInc = T_lastInc
else

11
src/homogenization.f90
View File

@ -145,9 +145,8 @@ module homogenization
real(pREAL) :: f
end function homogenization_f_T
module subroutine homogenization_thermal_setField(T,dot_T, ce)
integer, intent(in) :: ce
real(pREAL), intent(in) :: T, dot_T
module subroutine homogenization_thermal_setField(T,dot_T)
real(pREAL), dimension(:), intent(in) :: T, dot_T
end subroutine homogenization_thermal_setField
module function homogenization_damage_active() result(active)
@ -170,10 +169,8 @@ module homogenization
real(pREAL) :: f
end function homogenization_f_phi
module subroutine homogenization_set_phi(phi,ce)
integer, intent(in) :: ce
real(pREAL), intent(in) :: &
phi
module subroutine homogenization_set_phi(phi)
real(pREAL), dimension(:), intent(in) :: phi
end subroutine homogenization_set_phi
end interface

19
src/homogenization_damage.f90
View File

@ -151,20 +151,19 @@ end function homogenization_f_phi
!--------------------------------------------------------------------------------------------------
!> @brief Set damage field.
!--------------------------------------------------------------------------------------------------
module subroutine homogenization_set_phi(phi,ce)
module subroutine homogenization_set_phi(phi)
integer, intent(in) :: ce
real(pREAL), intent(in) :: phi
real(pREAL), dimension(:), intent(in) :: phi
integer :: &
ho, &
en
integer :: ho, en, ce
ho = material_ID_homogenization(ce)
en = material_entry_homogenization(ce)
damagestate_h(ho)%state(1,en) = phi
current(ho)%phi(en) = phi
do ce=1, ubound(phi,1)
ho = material_ID_homogenization(ce)
en = material_entry_homogenization(ce)
damagestate_h(ho)%state(1,en) = phi(ce)
current(ho)%phi(en) = phi(ce)
end do
end subroutine homogenization_set_phi

15
src/homogenization_thermal.f90
View File

@ -173,15 +173,18 @@ end function homogenization_f_T
!--------------------------------------------------------------------------------------------------
!> @brief Set thermal field and its rate (T and dot_T).
!--------------------------------------------------------------------------------------------------
module subroutine homogenization_thermal_setField(T,dot_T, ce)
module subroutine homogenization_thermal_setField(T,dot_T)
integer, intent(in) :: ce
real(pREAL), intent(in) :: T, dot_T
real(pREAL), dimension(:), intent(in) :: T, dot_T
integer :: ce
current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T
current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) = dot_T
call thermal_partition(ce)
do ce=1, min(ubound(T,1),ubound(dot_T,1))
current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T(ce)
current(material_ID_homogenization(ce))%dot_T(material_entry_homogenization(ce)) = dot_T(ce)
call thermal_partition(ce)
end do
end subroutine homogenization_thermal_setField