some more renaming or thermal related routines
This commit is contained in:
parent
31cccdcebf
commit
590eb31ed0
|
@ -85,7 +85,7 @@ end module DAMASK_interface
|
|||
#include "damage_none.f90"
|
||||
#include "damage_brittle.f90"
|
||||
#include "thermal_isothermal.f90"
|
||||
#include "thermal_adiabatic.f90"
|
||||
#include "thermal_heatGen.f90"
|
||||
#include "constitutive_none.f90"
|
||||
#include "constitutive_j2.f90"
|
||||
#include "constitutive_phenopowerlaw.f90"
|
||||
|
|
|
@ -85,7 +85,7 @@ end module DAMASK_interface
|
|||
#include "damage_none.f90"
|
||||
#include "damage_brittle.f90"
|
||||
#include "thermal_isothermal.f90"
|
||||
#include "thermal_adiabatic.f90"
|
||||
#include "thermal_heatGen.f90"
|
||||
#include "constitutive_none.f90"
|
||||
#include "constitutive_j2.f90"
|
||||
#include "constitutive_phenopowerlaw.f90"
|
||||
|
|
|
@ -114,7 +114,7 @@ end module DAMASK_interface
|
|||
#include "damage_none.f90"
|
||||
#include "damage_brittle.f90"
|
||||
#include "thermal_isothermal.f90"
|
||||
#include "thermal_adiabatic.f90"
|
||||
#include "thermal_heatGen.f90"
|
||||
#include "constitutive_none.f90"
|
||||
#include "constitutive_j2.f90"
|
||||
#include "constitutive_phenopowerlaw.f90"
|
||||
|
|
|
@ -357,7 +357,7 @@ DAMAGE_FILES = \
|
|||
damage_none.o damage_brittle.o damage_ductile.o
|
||||
|
||||
THERMAL_FILES = \
|
||||
thermal_isothermal.o thermal_adiabatic.o
|
||||
thermal_isothermal.o thermal_heatGen.o
|
||||
|
||||
CONSTITUTIVE_FILES = \
|
||||
constitutive_dislotwin.o constitutive_dislokmc.o constitutive_j2.o constitutive_phenopowerlaw.o \
|
||||
|
@ -516,7 +516,7 @@ damage_ductile.o: damage_ductile.f90 \
|
|||
thermal_isothermal.o: thermal_isothermal.f90 \
|
||||
lattice.o
|
||||
|
||||
thermal_adiabatic.o: thermal_adiabatic.f90 \
|
||||
thermal_heatGen.o: thermal_heatGen.f90 \
|
||||
lattice.o
|
||||
|
||||
lattice.o: lattice.f90 \
|
||||
|
|
|
@ -29,10 +29,10 @@ module constitutive
|
|||
constitutive_collectDeltaState, &
|
||||
constitutive_getLocalDamage, &
|
||||
constitutive_putLocalDamage, &
|
||||
constitutive_getNonLocalDamage, &
|
||||
constitutive_getAdiabaticThermal, &
|
||||
constitutive_putAdiabaticThermal, &
|
||||
constitutive_getConductionThermal, &
|
||||
constitutive_getDamage, &
|
||||
constitutive_getAdiabaticTemperature, &
|
||||
constitutive_putAdiabaticTemperature, &
|
||||
constitutive_getTemperature, &
|
||||
constitutive_postResults
|
||||
|
||||
private :: &
|
||||
|
@ -133,7 +133,7 @@ subroutine constitutive_init
|
|||
use damage_brittle
|
||||
use damage_ductile
|
||||
use thermal_isothermal
|
||||
use thermal_adiabatic
|
||||
use thermal_heatGen
|
||||
implicit none
|
||||
integer(pInt), parameter :: FILEUNIT = 200_pInt
|
||||
integer(pInt) :: &
|
||||
|
@ -178,7 +178,7 @@ subroutine constitutive_init
|
|||
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
|
||||
call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file
|
||||
if (any(phase_thermal == LOCAL_THERMAL_ISOTHERMAL_ID)) call thermal_isothermal_init(FILEUNIT)
|
||||
! if (any(phase_thermal == LOCAL_THERMAL_HEATGEN_ID)) call thermal_heatgen_init(FILEUNIT)
|
||||
if (any(phase_thermal == LOCAL_THERMAL_HEATGEN_ID)) call thermal_heatGen_init(FILEUNIT)
|
||||
close(FILEUNIT)
|
||||
|
||||
write(6,'(/,a)') ' <<<+- constitutive init -+>>>'
|
||||
|
@ -280,9 +280,9 @@ subroutine constitutive_init
|
|||
thisSize => null()
|
||||
case (LOCAL_THERMAL_heatgen_ID)
|
||||
outputName = LOCAL_THERMAL_HEATGEN_label
|
||||
thisNoutput => null()
|
||||
thisOutput => null()
|
||||
thisSize => null()
|
||||
thisNoutput => thermal_heatGen_Noutput
|
||||
thisOutput => thermal_heatGen_output
|
||||
thisSize => thermal_heatGen_sizePostResult
|
||||
case default
|
||||
knownThermal = .false.
|
||||
end select
|
||||
|
@ -450,7 +450,7 @@ subroutine constitutive_microstructure(temperature, Tstar_v, Fe, Fp, ipc, ip, el
|
|||
Fp !< plastic deformation gradient
|
||||
real(pReal) :: damage, Tstar_v_effective(6)
|
||||
|
||||
damage = constitutive_getNonlocalDamage(ipc,ip,el)
|
||||
damage = constitutive_getDamage(ipc,ip,el)
|
||||
Tstar_v_effective = Tstar_v/(damage*damage)
|
||||
|
||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||
|
@ -525,7 +525,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, temperature, ip
|
|||
dLp_dTstar !< derivative of Lp with respect to Tstar (4th-order tensor)
|
||||
real(pReal) :: damage, Tstar_v_effective(6)
|
||||
|
||||
damage = constitutive_getNonlocalDamage(ipc,ip,el)
|
||||
damage = constitutive_getDamage(ipc,ip,el)
|
||||
Tstar_v_effective = Tstar_v/(damage*damage)
|
||||
select case (phase_plasticity(material_phase(ipc,ip,el)))
|
||||
|
||||
|
@ -615,11 +615,11 @@ subroutine constitutive_hooke_TandItsTangent(T, dT_dFe, Fe, ipc, ip, el)
|
|||
real(pReal) :: damage
|
||||
real(pReal), dimension(3,3,3,3) :: C
|
||||
|
||||
damage = constitutive_getNonlocalDamage(ipc,ip,el)
|
||||
damage = constitutive_getDamage(ipc,ip,el)
|
||||
C = damage*damage*math_Mandel66to3333(constitutive_homogenizedC(ipc,ip,el))
|
||||
T = math_mul3333xx33(C,0.5_pReal*(math_mul33x33(math_transpose33(Fe),Fe)-math_I3) - &
|
||||
lattice_thermalExpansion33(1:3,1:3,mappingConstitutive(2,ipc,ip,el))* &
|
||||
(constitutive_getConductionThermal(ipc,ip,el) - &
|
||||
(constitutive_getTemperature(ipc,ip,el) - &
|
||||
lattice_referenceTemperature(mappingConstitutive(2,ipc,ip,el))))
|
||||
|
||||
dT_dFe = 0.0_pReal
|
||||
|
@ -678,8 +678,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, Temperature,
|
|||
damage_brittle_dotState
|
||||
use damage_ductile, only: &
|
||||
damage_ductile_dotState
|
||||
use thermal_adiabatic, only: &
|
||||
thermal_adiabatic_dotState
|
||||
use thermal_heatGen, only: &
|
||||
thermal_heatGen_dotState
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
|
@ -730,7 +730,7 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, Temperature,
|
|||
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_HEATGEN_ID)
|
||||
! call thermal_adiabatic_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
!call thermal_heatGen_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
end select
|
||||
|
||||
if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
|
||||
|
@ -879,7 +879,7 @@ end subroutine constitutive_putLocalDamage
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns nonlocal (regularised) damage
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_getNonlocalDamage(ipc, ip, el)
|
||||
function constitutive_getDamage(ipc, ip, el)
|
||||
use prec, only: &
|
||||
pReal
|
||||
use material, only: &
|
||||
|
@ -895,24 +895,24 @@ function constitutive_getNonlocalDamage(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal) :: constitutive_getNonlocalDamage
|
||||
real(pReal) :: constitutive_getDamage
|
||||
|
||||
select case(field_damage_type(material_homog(ip,el)))
|
||||
|
||||
case (FIELD_DAMAGE_LOCAL_ID)
|
||||
constitutive_getNonlocalDamage = constitutive_getLocalDamage(ipc, ip, el)
|
||||
constitutive_getDamage = constitutive_getLocalDamage(ipc, ip, el)
|
||||
|
||||
case (FIELD_DAMAGE_NONLOCAL_ID)
|
||||
constitutive_getNonlocalDamage = fieldDamage(material_homog(ip,el))% &
|
||||
constitutive_getDamage = fieldDamage(material_homog(ip,el))% &
|
||||
field(1,mappingHomogenization(1,ip,el)) ! Taylor type
|
||||
|
||||
end select
|
||||
|
||||
end function constitutive_getNonlocalDamage
|
||||
end function constitutive_getDamage
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns local (unregularised) temperature
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_getAdiabaticThermal(ipc, ip, el)
|
||||
function constitutive_getAdiabaticTemperature(ipc, ip, el)
|
||||
use prec, only: &
|
||||
pReal
|
||||
use material, only: &
|
||||
|
@ -920,8 +920,8 @@ function constitutive_getAdiabaticThermal(ipc, ip, el)
|
|||
LOCAL_THERMAL_ISOTHERMAL_ID, &
|
||||
LOCAL_THERMAL_HEATGEN_ID, &
|
||||
phase_thermal
|
||||
use thermal_adiabatic, only: &
|
||||
constitutive_heatgen_getThermal
|
||||
use thermal_heatGen, only: &
|
||||
thermal_heatGen_getTemperature
|
||||
use lattice, only: &
|
||||
lattice_referenceTemperature
|
||||
|
||||
|
@ -930,30 +930,30 @@ function constitutive_getAdiabaticThermal(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal) :: constitutive_getAdiabaticThermal
|
||||
real(pReal) :: constitutive_getAdiabaticTemperature
|
||||
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_ISOTHERMAL_ID)
|
||||
constitutive_getAdiabaticThermal = lattice_referenceTemperature(material_phase(ipc,ip,el))
|
||||
constitutive_getAdiabaticTemperature = lattice_referenceTemperature(material_phase(ipc,ip,el))
|
||||
|
||||
case (LOCAL_THERMAL_HEATGEN_ID)
|
||||
constitutive_getAdiabaticThermal = constitutive_heatgen_getThermal(ipc, ip, el)
|
||||
constitutive_getAdiabaticTemperature = thermal_heatGen_getTemperature(ipc, ip, el)
|
||||
end select
|
||||
|
||||
end function constitutive_getAdiabaticThermal
|
||||
end function constitutive_getAdiabaticTemperature
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief Returns the local(unregularised) damage
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_putAdiabaticThermal(ipc, ip, el, localTemperature)
|
||||
subroutine constitutive_putAdiabaticTemperature(ipc, ip, el, localTemperature)
|
||||
use prec, only: &
|
||||
pReal
|
||||
use material, only: &
|
||||
material_phase, &
|
||||
LOCAL_THERMAL_HEATGEN_ID, &
|
||||
phase_thermal
|
||||
use thermal_adiabatic, only: &
|
||||
constitutive_heatgen_putThermal
|
||||
use thermal_heatGen, only: &
|
||||
thermal_heatGen_putTemperature
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
|
@ -965,16 +965,16 @@ subroutine constitutive_putAdiabaticThermal(ipc, ip, el, localTemperature)
|
|||
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_HEATGEN_ID)
|
||||
call constitutive_heatgen_putThermal(ipc, ip, el, localTemperature)
|
||||
call thermal_heatGen_putTemperature(ipc, ip, el, localTemperature)
|
||||
|
||||
end select
|
||||
|
||||
end subroutine constitutive_putAdiabaticThermal
|
||||
end subroutine constitutive_putAdiabaticTemperature
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns nonlocal (regularised) temperature
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_getConductionThermal(ipc, ip, el)
|
||||
function constitutive_getTemperature(ipc, ip, el)
|
||||
use prec, only: &
|
||||
pReal
|
||||
use material, only: &
|
||||
|
@ -992,20 +992,20 @@ function constitutive_getConductionThermal(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal) :: constitutive_getConductionThermal
|
||||
real(pReal) :: constitutive_getTemperature
|
||||
|
||||
select case(field_thermal_type(material_homog(ip,el)))
|
||||
|
||||
case (FIELD_THERMAL_ADIABATIC_ID)
|
||||
constitutive_getConductionThermal = constitutive_getAdiabaticThermal(ipc, ip, el)
|
||||
constitutive_getTemperature = constitutive_getAdiabaticTemperature(ipc, ip, el)
|
||||
|
||||
case (FIELD_THERMAL_CONDUCTION_ID)
|
||||
constitutive_getConductionThermal = fieldThermal(material_homog(ip,el))% &
|
||||
constitutive_getTemperature = fieldThermal(material_homog(ip,el))% &
|
||||
field(1,mappingHomogenization(1,ip,el)) ! Taylor type
|
||||
|
||||
end select
|
||||
|
||||
end function constitutive_getConductionThermal
|
||||
end function constitutive_getTemperature
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns array of constitutive results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
@ -1054,8 +1054,8 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el)
|
|||
damage_brittle_postResults
|
||||
use damage_ductile, only: &
|
||||
damage_ductile_postResults
|
||||
! use thermal_adiabatic, only: &
|
||||
! thermal_adiabatic_postResults
|
||||
use thermal_heatGen, only: &
|
||||
thermal_heatGen_postResults
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
@ -1081,7 +1081,7 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el)
|
|||
real(pReal) :: damage, Tstar_v_effective(6)
|
||||
integer(pInt) :: startPos, endPos
|
||||
|
||||
damage = constitutive_getNonlocalDamage(ipc,ip,el)
|
||||
damage = constitutive_getDamage(ipc,ip,el)
|
||||
Tstar_v_effective = damage*damage*Tstar_v
|
||||
|
||||
constitutive_postResults = 0.0_pReal
|
||||
|
@ -1121,7 +1121,7 @@ function constitutive_postResults(Tstar_v, FeArray, temperature, ipc, ip, el)
|
|||
endPos = endPos + thermalState(material_phase(ipc,ip,el))%sizePostResults
|
||||
select case (phase_thermal(material_phase(ipc,ip,el)))
|
||||
case (LOCAL_THERMAL_HEATGEN_ID)
|
||||
! constitutive_postResults(startPos:endPos) = thermal_adiabatic_postResults(ipc, ip, el)
|
||||
constitutive_postResults(startPos:endPos) = thermal_heatGen_postResults(ipc, ip, el)
|
||||
end select
|
||||
#endif
|
||||
|
||||
|
|
|
@ -1152,7 +1152,7 @@ real(pReal) function field_getLocalDamage(ip,el)
|
|||
field_getLocalDamage = field_getLocalDamage + constitutive_getLocalDamage(ipc,ip,el)
|
||||
enddo
|
||||
|
||||
field_getLocalDamage = field_getLocalDamage /homogenization_Ngrains(mesh_element(3,el))
|
||||
field_getLocalDamage = field_getLocalDamage/homogenization_Ngrains(mesh_element(3,el))
|
||||
|
||||
end function field_getLocalDamage
|
||||
|
||||
|
@ -1192,7 +1192,7 @@ real(pReal) function field_getLocalTemperature(ip,el)
|
|||
use material, only: &
|
||||
homogenization_Ngrains
|
||||
use constitutive, only: &
|
||||
constitutive_getAdiabaticThermal
|
||||
constitutive_getAdiabaticTemperature
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: &
|
||||
|
@ -1204,9 +1204,10 @@ real(pReal) function field_getLocalTemperature(ip,el)
|
|||
|
||||
field_getLocalTemperature = 0.0_pReal
|
||||
do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
field_getLocalTemperature = field_getLocalTemperature + constitutive_getAdiabaticThermal(ipc,ip,el) ! array/function/subroutine which is faster
|
||||
field_getLocalTemperature = field_getLocalTemperature + &
|
||||
constitutive_getAdiabaticTemperature(ipc,ip,el) ! array/function/subroutine which is faster
|
||||
enddo
|
||||
field_getLocalTemperature = field_getLocalTemperature /homogenization_Ngrains(mesh_element(3,el))
|
||||
field_getLocalTemperature = field_getLocalTemperature/homogenization_Ngrains(mesh_element(3,el))
|
||||
|
||||
end function field_getLocalTemperature
|
||||
|
||||
|
|
|
@ -1,12 +1,12 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! $Id: thermal_adiabatic.f90 3210 2014-06-17 15:24:44Z MPIE\m.diehl $
|
||||
! $Id: thermal_heatGen.f90 3210 2014-06-17 15:24:44Z MPIE\m.diehl $
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
||||
!> @brief material subroutine incoprorating dislocation and twinning physics
|
||||
!> @details to be done
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
module thermal_adiabatic
|
||||
module thermal_heatGen
|
||||
use prec, only: &
|
||||
pReal, &
|
||||
pInt
|
||||
|
@ -14,36 +14,36 @@ module thermal_adiabatic
|
|||
implicit none
|
||||
private
|
||||
integer(pInt), dimension(:), allocatable, public, protected :: &
|
||||
thermal_adiabatic_sizePostResults !< cumulative size of post results
|
||||
thermal_heatGen_sizePostResults !< cumulative size of post results
|
||||
|
||||
integer(pInt), dimension(:,:), allocatable, target, public :: &
|
||||
thermal_adiabatic_sizePostResult !< size of each post result output
|
||||
thermal_heatGen_sizePostResult !< size of each post result output
|
||||
|
||||
character(len=64), dimension(:,:), allocatable, target, public :: &
|
||||
thermal_adiabatic_output !< name of each post result output
|
||||
thermal_heatGen_output !< name of each post result output
|
||||
|
||||
integer(pInt), dimension(:), allocatable, private :: &
|
||||
thermal_adiabatic_Noutput !< number of outputs per instance of this damage
|
||||
integer(pInt), dimension(:), allocatable, target, public :: &
|
||||
thermal_heatGen_Noutput !< number of outputs per instance of this damage
|
||||
|
||||
real(pReal), dimension(:), allocatable, public :: &
|
||||
thermal_adiabatic_aTol
|
||||
thermal_heatGen_aTol
|
||||
|
||||
enum, bind(c)
|
||||
enumerator :: undefined_ID, &
|
||||
temperature_ID
|
||||
end enum
|
||||
integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: &
|
||||
thermal_adiabatic_outputID !< ID of each post result output
|
||||
thermal_heatGen_outputID !< ID of each post result output
|
||||
|
||||
|
||||
public :: &
|
||||
thermal_adiabatic_init, &
|
||||
thermal_adiabatic_stateInit, &
|
||||
thermal_adiabatic_aTolState, &
|
||||
thermal_adiabatic_dotState, &
|
||||
constitutive_heatgen_getThermal, &
|
||||
constitutive_heatgen_putThermal, &
|
||||
thermal_adiabatic_postResults
|
||||
thermal_heatGen_init, &
|
||||
thermal_heatGen_stateInit, &
|
||||
thermal_heatGen_aTolState, &
|
||||
thermal_heatGen_dotState, &
|
||||
thermal_heatgen_getTemperature, &
|
||||
thermal_heatgen_putTemperature, &
|
||||
thermal_heatGen_postResults
|
||||
|
||||
contains
|
||||
|
||||
|
@ -52,7 +52,7 @@ contains
|
|||
!> @brief module initialization
|
||||
!> @details reads in material parameters, allocates arrays, and does sanity checks
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_init(fileUnit)
|
||||
subroutine thermal_heatGen_init(fileUnit)
|
||||
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
|
@ -100,7 +100,7 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
line = ''
|
||||
|
||||
write(6,'(/,a)') ' <<<+- thermal_'//LOCAL_THERMAL_HEATGEN_label//' init -+>>>'
|
||||
write(6,'(a)') ' $Id: thermal_adiabatic.f90 3210 2014-06-17 15:24:44Z MPIE\m.diehl $'
|
||||
write(6,'(a)') ' $Id: thermal_heatGen.f90 3210 2014-06-17 15:24:44Z MPIE\m.diehl $'
|
||||
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
|
||||
#include "compilation_info.f90"
|
||||
|
||||
|
@ -109,13 +109,13 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
|
||||
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
|
||||
|
||||
allocate(thermal_adiabatic_sizePostResults(maxNinstance), source=0_pInt)
|
||||
allocate(thermal_adiabatic_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
|
||||
allocate(thermal_adiabatic_output(maxval(phase_Noutput),maxNinstance))
|
||||
thermal_adiabatic_output = ''
|
||||
allocate(thermal_adiabatic_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
|
||||
allocate(thermal_adiabatic_Noutput(maxNinstance), source=0_pInt)
|
||||
allocate(thermal_adiabatic_aTol(maxNinstance), source=0.0_pReal)
|
||||
allocate(thermal_heatGen_sizePostResults(maxNinstance), source=0_pInt)
|
||||
allocate(thermal_heatGen_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
|
||||
allocate(thermal_heatGen_output(maxval(phase_Noutput),maxNinstance))
|
||||
thermal_heatGen_output = ''
|
||||
allocate(thermal_heatGen_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID)
|
||||
allocate(thermal_heatGen_Noutput(maxNinstance), source=0_pInt)
|
||||
allocate(thermal_heatGen_aTol(maxNinstance), source=0.0_pReal)
|
||||
|
||||
rewind(fileUnit)
|
||||
phase = 0_pInt
|
||||
|
@ -144,14 +144,14 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
case ('(output)')
|
||||
select case(IO_lc(IO_stringValue(line,positions,2_pInt)))
|
||||
case ('temperature')
|
||||
thermal_adiabatic_Noutput(instance) = thermal_adiabatic_Noutput(instance) + 1_pInt
|
||||
thermal_adiabatic_outputID(thermal_adiabatic_Noutput(instance),instance) = temperature_ID
|
||||
thermal_adiabatic_output(thermal_adiabatic_Noutput(instance),instance) = &
|
||||
thermal_heatGen_Noutput(instance) = thermal_heatGen_Noutput(instance) + 1_pInt
|
||||
thermal_heatGen_outputID(thermal_heatGen_Noutput(instance),instance) = temperature_ID
|
||||
thermal_heatGen_output(thermal_heatGen_Noutput(instance),instance) = &
|
||||
IO_lc(IO_stringValue(line,positions,2_pInt))
|
||||
end select
|
||||
|
||||
case ('atol_adiabatic')
|
||||
thermal_adiabatic_aTol(instance) = IO_floatValue(line,positions,2_pInt)
|
||||
case ('atol_heatGen')
|
||||
thermal_heatGen_aTol(instance) = IO_floatValue(line,positions,2_pInt)
|
||||
|
||||
end select
|
||||
endif; endif
|
||||
|
@ -164,15 +164,15 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! Determine size of postResults array
|
||||
outputsLoop: do o = 1_pInt,thermal_adiabatic_Noutput(instance)
|
||||
select case(thermal_adiabatic_outputID(o,instance))
|
||||
outputsLoop: do o = 1_pInt,thermal_heatGen_Noutput(instance)
|
||||
select case(thermal_heatGen_outputID(o,instance))
|
||||
case(temperature_ID)
|
||||
mySize = 1_pInt
|
||||
end select
|
||||
|
||||
if (mySize > 0_pInt) then ! any meaningful output found
|
||||
thermal_adiabatic_sizePostResult(o,instance) = mySize
|
||||
thermal_adiabatic_sizePostResults(instance) = thermal_adiabatic_sizePostResults(instance) + mySize
|
||||
thermal_heatGen_sizePostResult(o,instance) = mySize
|
||||
thermal_heatGen_sizePostResults(instance) = thermal_heatGen_sizePostResults(instance) + mySize
|
||||
endif
|
||||
enddo outputsLoop
|
||||
! Determine size of state array
|
||||
|
@ -180,7 +180,7 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
sizeState = 1_pInt
|
||||
thermalState(phase)%sizeState = sizeState
|
||||
thermalState(phase)%sizeDotState = sizeDotState
|
||||
thermalState(phase)%sizePostResults = thermal_adiabatic_sizePostResults(instance)
|
||||
thermalState(phase)%sizePostResults = thermal_heatGen_sizePostResults(instance)
|
||||
allocate(thermalState(phase)%aTolState (sizeState), source=0.0_pReal)
|
||||
allocate(thermalState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal)
|
||||
allocate(thermalState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal)
|
||||
|
@ -200,17 +200,17 @@ subroutine thermal_adiabatic_init(fileUnit)
|
|||
if (any(numerics_integrator == 5_pInt)) &
|
||||
allocate(thermalState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal)
|
||||
|
||||
call thermal_adiabatic_stateInit(phase,instance)
|
||||
call thermal_adiabatic_aTolState(phase,instance)
|
||||
call thermal_heatGen_stateInit(phase,instance)
|
||||
call thermal_heatGen_aTolState(phase,instance)
|
||||
endif
|
||||
|
||||
enddo initializeInstances
|
||||
end subroutine thermal_adiabatic_init
|
||||
end subroutine thermal_heatGen_init
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief sets the relevant NEW state values for a given instance of this thermal
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_stateInit(phase,instance)
|
||||
subroutine thermal_heatGen_stateInit(phase,instance)
|
||||
use material, only: &
|
||||
thermalState
|
||||
use lattice, only: &
|
||||
|
@ -226,12 +226,12 @@ subroutine thermal_adiabatic_stateInit(phase,instance)
|
|||
thermalState(phase)%state = spread(tempState,2,size(thermalState(phase)%state(1,:)))
|
||||
thermalState(phase)%state0 = thermalState(phase)%state
|
||||
thermalState(phase)%partionedState0 = thermalState(phase)%state
|
||||
end subroutine thermal_adiabatic_stateInit
|
||||
end subroutine thermal_heatGen_stateInit
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief sets the relevant state values for a given instance of this thermal
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_aTolState(phase,instance)
|
||||
subroutine thermal_heatGen_aTolState(phase,instance)
|
||||
use material, only: &
|
||||
thermalState
|
||||
|
||||
|
@ -241,14 +241,14 @@ subroutine thermal_adiabatic_aTolState(phase,instance)
|
|||
instance ! number specifying the current instance of the thermal
|
||||
real(pReal), dimension(thermalState(phase)%sizeState) :: tempTol
|
||||
|
||||
tempTol = thermal_adiabatic_aTol
|
||||
tempTol = thermal_heatGen_aTol
|
||||
thermalState(phase)%aTolState = tempTol
|
||||
end subroutine thermal_adiabatic_aTolState
|
||||
end subroutine thermal_heatGen_aTolState
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates derived quantities from state
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine thermal_adiabatic_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
subroutine thermal_heatGen_dotState(Tstar_v, Lp, ipc, ip, el)
|
||||
use lattice, only: &
|
||||
lattice_massDensity, &
|
||||
lattice_specificHeat
|
||||
|
@ -280,12 +280,12 @@ subroutine thermal_adiabatic_dotState(Tstar_v, Lp, ipc, ip, el)
|
|||
* sum(abs(math_Mandel6to33(Tstar_v)*Lp)) &
|
||||
/ (lattice_massDensity(phase)*lattice_specificHeat(phase))
|
||||
|
||||
end subroutine thermal_adiabatic_dotState
|
||||
end subroutine thermal_heatGen_dotState
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns temperature based on local damage model state layout
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function constitutive_heatgen_getThermal(ipc, ip, el)
|
||||
function thermal_heatgen_getTemperature(ipc, ip, el)
|
||||
use material, only: &
|
||||
mappingConstitutive, &
|
||||
ThermalState
|
||||
|
@ -295,17 +295,17 @@ function constitutive_heatgen_getThermal(ipc, ip, el)
|
|||
ipc, & !< grain number
|
||||
ip, & !< integration point number
|
||||
el !< element number
|
||||
real(pReal) :: constitutive_heatgen_getThermal
|
||||
real(pReal) :: thermal_heatgen_getTemperature
|
||||
|
||||
constitutive_heatgen_getThermal = &
|
||||
thermal_heatgen_getTemperature = &
|
||||
thermalState(mappingConstitutive(2,ipc,ip,el))%state(1,mappingConstitutive(1,ipc,ip,el))
|
||||
|
||||
end function constitutive_heatgen_getThermal
|
||||
end function thermal_heatgen_getTemperature
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief returns temperature based on local damage model state layout
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine constitutive_heatgen_putThermal(ipc, ip, el, localTemperature)
|
||||
subroutine thermal_heatgen_putTemperature(ipc, ip, el, localTemperature)
|
||||
use material, only: &
|
||||
mappingConstitutive, &
|
||||
ThermalState
|
||||
|
@ -321,12 +321,12 @@ subroutine constitutive_heatgen_putThermal(ipc, ip, el, localTemperature)
|
|||
thermalState(mappingConstitutive(2,ipc,ip,el))%state(1,mappingConstitutive(1,ipc,ip,el))= &
|
||||
localTemperature
|
||||
|
||||
end subroutine constitutive_heatgen_putThermal
|
||||
end subroutine thermal_heatgen_putTemperature
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief return array of constitutive results
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
function thermal_adiabatic_postResults(ipc,ip,el)
|
||||
function thermal_heatGen_postResults(ipc,ip,el)
|
||||
use material, only: &
|
||||
mappingConstitutive, &
|
||||
phase_thermalInstance, &
|
||||
|
@ -337,8 +337,8 @@ function thermal_adiabatic_postResults(ipc,ip,el)
|
|||
ipc, & !< component-ID of integration point
|
||||
ip, & !< integration point
|
||||
el !< element
|
||||
real(pReal), dimension(thermal_adiabatic_sizePostResults(phase_thermalInstance(mappingConstitutive(2,ipc,ip,el)))) :: &
|
||||
thermal_adiabatic_postResults
|
||||
real(pReal), dimension(thermal_heatGen_sizePostResults(phase_thermalInstance(mappingConstitutive(2,ipc,ip,el)))) :: &
|
||||
thermal_heatGen_postResults
|
||||
|
||||
integer(pInt) :: &
|
||||
instance, phase, constituent, o, c
|
||||
|
@ -348,16 +348,16 @@ function thermal_adiabatic_postResults(ipc,ip,el)
|
|||
instance = phase_thermalInstance(phase)
|
||||
|
||||
c = 0_pInt
|
||||
thermal_adiabatic_postResults = 0.0_pReal
|
||||
thermal_heatGen_postResults = 0.0_pReal
|
||||
|
||||
do o = 1_pInt,thermal_adiabatic_Noutput(instance)
|
||||
select case(thermal_adiabatic_outputID(o,instance))
|
||||
do o = 1_pInt,thermal_heatGen_Noutput(instance)
|
||||
select case(thermal_heatGen_outputID(o,instance))
|
||||
|
||||
case (temperature_ID)
|
||||
thermal_adiabatic_postResults(c+1_pInt) = thermalState(phase)%state(1,constituent)
|
||||
thermal_heatGen_postResults(c+1_pInt) = thermalState(phase)%state(1,constituent)
|
||||
c = c + 1
|
||||
end select
|
||||
enddo
|
||||
end function thermal_adiabatic_postResults
|
||||
end function thermal_heatGen_postResults
|
||||
|
||||
end module thermal_adiabatic
|
||||
end module thermal_heatGen
|
Loading…
Reference in New Issue