From 1fdc5443b295589bb05ca383a70b132316f7cf75 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 20 Jul 2023 23:33:43 +0200 Subject: [PATCH] avoid code (loop) duplication --- src/grid/grid_damage_spectral.f90 | 25 ++++--------------------- src/grid/grid_thermal_spectral.f90 | 26 +++++++------------------- src/homogenization.f90 | 11 ++++------- src/homogenization_damage.f90 | 19 +++++++++---------- src/homogenization_thermal.f90 | 15 +++++++++------ 5 files changed, 33 insertions(+), 63 deletions(-) diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 31aec3912..48023cc54 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -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 diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index a03af881b..86d8e04f3 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -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 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c85547917..63eacdf9d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -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 diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 466b8b47b..233425ebe 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -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 diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 789ac994b..791286912 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -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