From 62bce163cd10d6ee1be65e96f62129b4a31aee8d Mon Sep 17 00:00:00 2001
From: Martin Diehl <mail@martin-diehl.net>
Date: Tue, 9 Jan 2024 12:55:02 +0100
Subject: [PATCH] better status propagation

---
 src/constants.f90                  |  3 ++-
 src/grid/grid_thermal_spectral.f90 |  5 ++++-
 src/homogenization.f90             | 15 +++++++--------
 3 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/src/constants.f90 b/src/constants.f90
index 7d33d38d8..a7b0a1877 100644
--- a/src/constants.f90
+++ b/src/constants.f90
@@ -28,7 +28,8 @@ module constants
     STATUS_FAILED_DAMAGE_STATE, &
     STATUS_FAILED_DAMAGE_DELTASTATE, &
     STATUS_FAILED_DAMAGE, &
-    STATUS_FAILED_MECHANICAL
+    STATUS_FAILED_MECHANICAL, &
+    STATUS_PHASE_THERMAL
   end enum
 
 end module constants
diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90
index 35f2b47b4..f86280b2c 100644
--- a/src/grid/grid_thermal_spectral.f90
+++ b/src/grid/grid_thermal_spectral.f90
@@ -25,6 +25,7 @@ module grid_thermal_spectral
   use homogenization
   use YAML_types
   use config
+  use constants
 
 #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
   implicit none(type,external)
@@ -322,9 +323,11 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
 
   integer :: i, j, k, ce
   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)
     vectorField = utilities_ScalarGradient(T)
diff --git a/src/homogenization.f90 b/src/homogenization.f90
index 553387ea0..d02162650 100644
--- a/src/homogenization.f90
+++ b/src/homogenization.f90
@@ -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))])
 
     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
     end if
   end do
@@ -281,10 +281,10 @@ end subroutine homogenization_mechanical_response
 !--------------------------------------------------------------------------------------------------
 !> @brief
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_thermal_response(broken, &
+subroutine homogenization_thermal_response(status, &
                                            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
   integer, intent(in) :: &
     cell_start, cell_end
@@ -293,20 +293,19 @@ subroutine homogenization_thermal_response(broken, &
     co, ce, ho
 
 
-  broken = .false.
+  status = STATUS_OK
   !$OMP PARALLEL DO PRIVATE(ho)
   do ce = cell_start, cell_end
-    if (broken) continue
+    if (STATUS_OK /= status) continue
     ho = material_ID_homogenization(ce)
     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. broken) print*, ' Cell ', ce, ' failed (thermal)'
-        broken = .true.
+        if (STATUS_OK == status) print*, ' Cell ', ce, ' failed (thermal)'
+        status = STATUS_PHASE_THERMAL
       end if
     end do
   end do
   !$OMP END PARALLEL DO
-  broken = broken
 
 end subroutine homogenization_thermal_response