better status propagation

This commit is contained in:
Martin Diehl 2024-01-09 12:55:02 +01:00
parent 845d3eed33
commit 62bce163cd
No known key found for this signature in database
GPG Key ID: 1FD50837275A0A9B
3 changed files with 13 additions and 10 deletions

View File

@ -28,7 +28,8 @@ module constants
STATUS_FAILED_DAMAGE_STATE, & STATUS_FAILED_DAMAGE_STATE, &
STATUS_FAILED_DAMAGE_DELTASTATE, & STATUS_FAILED_DAMAGE_DELTASTATE, &
STATUS_FAILED_DAMAGE, & STATUS_FAILED_DAMAGE, &
STATUS_FAILED_MECHANICAL STATUS_FAILED_MECHANICAL, &
STATUS_PHASE_THERMAL
end enum end enum
end module constants end module constants

View File

@ -25,6 +25,7 @@ module grid_thermal_spectral
use homogenization use homogenization
use YAML_types use YAML_types
use config use config
use constants
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
implicit none(type,external) implicit none(type,external)
@ -322,9 +323,11 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
integer :: i, j, k, ce integer :: i, j, k, ce
real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
integer(kind(STATUS_OK)) :: status
call homogenization_thermal_response(broken,Delta_t_,1,product(cells(1:2))*cells3) call homogenization_thermal_response(status,Delta_t_,1,product(cells(1:2))*cells3)
broken = STATUS_OK /= status
associate(T => x_scal) associate(T => x_scal)
vectorField = utilities_ScalarGradient(T) vectorField = utilities_ScalarGradient(T)

View File

@ -257,7 +257,7 @@ subroutine homogenization_mechanical_response(status,Delta_t,cell_start,cell_end
converged = converged .and. all([(phase_damage_constitutive(Delta_t,co,ce),co=1,homogenization_Nconstituents(ho))]) converged = converged .and. all([(phase_damage_constitutive(Delta_t,co,ce),co=1,homogenization_Nconstituents(ho))])
if (.not. converged) then if (.not. converged) then
if (status == STATUS_OK) print*, ' Cell ', ce, ' failed (damage)' if (STATUS_OK == status) print*, ' Cell ', ce, ' failed (damage)'
status = STATUS_FAILED_DAMAGE status = STATUS_FAILED_DAMAGE
end if end if
end do end do
@ -281,10 +281,10 @@ end subroutine homogenization_mechanical_response
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief !> @brief
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine homogenization_thermal_response(broken, & subroutine homogenization_thermal_response(status, &
Delta_t,cell_start,cell_end) Delta_t,cell_start,cell_end)
logical, intent(out) :: broken integer(kind(STATUS_OK)), intent(out) :: status
real(pREAL), intent(in) :: Delta_t !< time increment real(pREAL), intent(in) :: Delta_t !< time increment
integer, intent(in) :: & integer, intent(in) :: &
cell_start, cell_end cell_start, cell_end
@ -293,20 +293,19 @@ subroutine homogenization_thermal_response(broken, &
co, ce, ho co, ce, ho
broken = .false. status = STATUS_OK
!$OMP PARALLEL DO PRIVATE(ho) !$OMP PARALLEL DO PRIVATE(ho)
do ce = cell_start, cell_end do ce = cell_start, cell_end
if (broken) continue if (STATUS_OK /= status) continue
ho = material_ID_homogenization(ce) ho = material_ID_homogenization(ce)
do co = 1, homogenization_Nconstituents(ho) do co = 1, homogenization_Nconstituents(ho)
if (.not. phase_thermal_constitutive(Delta_t,material_ID_phase(co,ce),material_entry_phase(co,ce))) then if (.not. phase_thermal_constitutive(Delta_t,material_ID_phase(co,ce),material_entry_phase(co,ce))) then
if (.not. broken) print*, ' Cell ', ce, ' failed (thermal)' if (STATUS_OK == status) print*, ' Cell ', ce, ' failed (thermal)'
broken = .true. status = STATUS_PHASE_THERMAL
end if end if
end do end do
end do end do
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
broken = broken
end subroutine homogenization_thermal_response end subroutine homogenization_thermal_response