From a5c6e4b17c21337dde6966ecf4dc2e1d5d176bc0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 28 May 2019 12:06:21 +0200 Subject: [PATCH] do not clutter the code with use statements --- src/DAMASK_interface.f90 | 7 +- src/HDF5_utilities.f90 | 10 +- src/damage_nonlocal.f90 | 399 ++++++++++++------------ src/homogenization.f90 | 24 +- src/kinematics_cleavage_opening.f90 | 298 +++++++++--------- src/list.f90 | 34 +- src/results.f90 | 16 +- src/source_damage_anisoBrittle.f90 | 465 +++++++++++++--------------- src/source_thermal_dissipation.f90 | 34 +- src/source_thermal_externalheat.f90 | 31 +- src/thermal_adiabatic.f90 | 77 +---- 11 files changed, 614 insertions(+), 781 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index b76813fe6..cb13bfaea 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -14,7 +14,11 @@ #define PETSC_MAJOR 3 #define PETSC_MINOR_MIN 10 #define PETSC_MINOR_MAX 11 + module DAMASK_interface + use, intrinsic :: iso_fortran_env + use PETScSys + use prec use system_routines @@ -50,9 +54,6 @@ contains !! information on computation to screen !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init - use, intrinsic :: iso_fortran_env - use PETScSys - #include #if defined(__GFORTRAN__) && __GNUC__ @details to be done !-------------------------------------------------------------------------------------------------- module damage_nonlocal - use prec - use material - use numerics - use config - use crystallite - use lattice - use mesh + use prec + use material + use numerics + use config + use crystallite + use lattice + use mesh + use source_damage_isoBrittle + use source_damage_isoDuctile + use source_damage_anisoBrittle + use source_damage_anisoDuctile - implicit none - private - - integer, dimension(:,:), allocatable, target, public :: & - damage_nonlocal_sizePostResult !< size of each post result output + implicit none + private + + integer, dimension(:,:), allocatable, target, public :: & + damage_nonlocal_sizePostResult !< size of each post result output - character(len=64), dimension(:,:), allocatable, target, public :: & - damage_nonlocal_output !< name of each post result output - - integer, dimension(:), allocatable, target, public :: & - damage_nonlocal_Noutput !< number of outputs per instance of this damage + character(len=64), dimension(:,:), allocatable, target, public :: & + damage_nonlocal_output !< name of each post result output + + integer, dimension(:), allocatable, target, public :: & + damage_nonlocal_Noutput !< number of outputs per instance of this damage - enum, bind(c) - enumerator :: undefined_ID, & - damage_ID - end enum + enum, bind(c) + enumerator :: undefined_ID, & + damage_ID + end enum - type :: tParameters - integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID - end type tParameters - - type(tparameters), dimension(:), allocatable :: & - param + type :: tParameters + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID + end type tParameters + + type(tparameters), dimension(:), allocatable :: & + param - public :: & - damage_nonlocal_init, & - damage_nonlocal_getSourceAndItsTangent, & - damage_nonlocal_getDiffusion33, & - damage_nonlocal_getMobility, & - damage_nonlocal_putNonLocalDamage, & - damage_nonlocal_postResults + public :: & + damage_nonlocal_init, & + damage_nonlocal_getSourceAndItsTangent, & + damage_nonlocal_getDiffusion33, & + damage_nonlocal_getMobility, & + damage_nonlocal_putNonLocalDamage, & + damage_nonlocal_postResults contains @@ -53,129 +57,122 @@ contains !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_init - integer :: maxNinstance,homog,instance,o,i - integer :: sizeState - integer :: NofMyHomog, h - integer(kind(undefined_ID)) :: & - outputID - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - character(len=65536), dimension(:), allocatable :: & - outputs + integer :: maxNinstance,homog,instance,o,i + integer :: sizeState + integer :: NofMyHomog, h + integer(kind(undefined_ID)) :: & + outputID + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + character(len=65536), dimension(:), allocatable :: & + outputs - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - - maxNinstance = count(damage_type == DAMAGE_nonlocal_ID) - if (maxNinstance == 0) return - - allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) - allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) - damage_nonlocal_output = '' - allocate(damage_nonlocal_Noutput (maxNinstance), source=0) - - allocate(param(maxNinstance)) + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - do h = 1, size(damage_type) - if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle - associate(prm => param(damage_typeInstance(h)), & - config => config_homogenization(h)) - - instance = damage_typeInstance(h) - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) + maxNinstance = count(damage_type == DAMAGE_nonlocal_ID) + if (maxNinstance == 0) return + + allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0) + allocate(damage_nonlocal_output (maxval(homogenization_Noutput),maxNinstance)) + damage_nonlocal_output = '' + allocate(damage_nonlocal_Noutput (maxNinstance), source=0) + + allocate(param(maxNinstance)) - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case ('damage') - damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i) - damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1 - damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1 - prm%outputID = [prm%outputID , damage_ID] - end select - - enddo + do h = 1, size(damage_type) + if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle + associate(prm => param(damage_typeInstance(h)), & + config => config_homogenization(h)) + + instance = damage_typeInstance(h) + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('damage') + damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i) + damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1 + damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1 + prm%outputID = [prm%outputID , damage_ID] + end select + + enddo - homog = h + homog = h - NofMyHomog = count(material_homogenizationAt == homog) - instance = damage_typeInstance(homog) + NofMyHomog = count(material_homogenizationAt == homog) + instance = damage_typeInstance(homog) -! allocate state arrays - sizeState = 1 - damageState(homog)%sizeState = sizeState - damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) - allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) - allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) - allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) +! allocate state arrays + sizeState = 1 + damageState(homog)%sizeState = sizeState + damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance)) + allocate(damageState(homog)%state0 (sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog)) + allocate(damageState(homog)%state (sizeState,NofMyHomog), source=damage_initialPhi(homog)) - nullify(damageMapping(homog)%p) - damageMapping(homog)%p => mappingHomogenization(1,:,:) - deallocate(damage(homog)%p) - damage(homog)%p => damageState(homog)%state(1,:) - - end associate - enddo + nullify(damageMapping(homog)%p) + damageMapping(homog)%p => mappingHomogenization(1,:,:) + deallocate(damage(homog)%p) + damage(homog)%p => damageState(homog)%state(1,:) + + end associate + enddo end subroutine damage_nonlocal_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates homogenized damage driving forces !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - use source_damage_isoBrittle, only: & - source_damage_isobrittle_getRateAndItsTangent - use source_damage_isoDuctile, only: & - source_damage_isoductile_getRateAndItsTangent - use source_damage_anisoBrittle, only: & - source_damage_anisobrittle_getRateAndItsTangent - use source_damage_anisoDuctile, only: & - source_damage_anisoductile_getRateAndItsTangent - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer :: & - phase, & - grain, & - source, & - constituent - real(pReal) :: & - phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer :: & + phase, & + grain, & + source, & + constituent + real(pReal) :: & + phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi - phiDot = 0.0_pReal - dPhiDot_dPhi = 0.0_pReal - do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) - phase = phaseAt(grain,ip,el) - constituent = phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) - case (SOURCE_damage_isoBrittle_ID) - call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + phiDot = 0.0_pReal + dPhiDot_dPhi = 0.0_pReal + do grain = 1, homogenization_Ngrains(material_homogenizationAt(el)) + phase = phaseAt(grain,ip,el) + constituent = phasememberAt(grain,ip,el) + do source = 1, phase_Nsources(phase) + select case(phase_source(source,phase)) + case (SOURCE_damage_isoBrittle_ID) + call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_isoDuctile_ID) - call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_isoDuctile_ID) + call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoBrittle_ID) - call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_anisoBrittle_ID) + call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoDuctile_ID) - call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) + case (SOURCE_damage_anisoDuctile_ID) + call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case default - localphiDot = 0.0_pReal - dLocalphiDot_dPhi = 0.0_pReal + case default + localphiDot = 0.0_pReal + dLocalphiDot_dPhi = 0.0_pReal - end select - phiDot = phiDot + localphiDot - dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi - enddo - enddo - - phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + end select + phiDot = phiDot + localphiDot + dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi + enddo + enddo + + phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) + dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal) end subroutine damage_nonlocal_getSourceAndItsTangent @@ -185,24 +182,24 @@ end subroutine damage_nonlocal_getSourceAndItsTangent !-------------------------------------------------------------------------------------------------- function damage_nonlocal_getDiffusion33(ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), dimension(3,3) :: & - damage_nonlocal_getDiffusion33 - integer :: & - homog, & - grain - - homog = material_homogenizationAt(el) - damage_nonlocal_getDiffusion33 = 0.0_pReal - do grain = 1, homogenization_Ngrains(homog) - damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & - crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) - enddo + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), dimension(3,3) :: & + damage_nonlocal_getDiffusion33 + integer :: & + homog, & + grain + + homog = material_homogenizationAt(el) + damage_nonlocal_getDiffusion33 = 0.0_pReal + do grain = 1, homogenization_Ngrains(homog) + damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + & + crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el))) + enddo - damage_nonlocal_getDiffusion33 = & - charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) + damage_nonlocal_getDiffusion33 = & + charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal) end function damage_nonlocal_getDiffusion33 @@ -212,20 +209,20 @@ end function damage_nonlocal_getDiffusion33 !-------------------------------------------------------------------------------------------------- real(pReal) function damage_nonlocal_getMobility(ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - integer :: & - ipc - - damage_nonlocal_getMobility = 0.0_pReal - - do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) - damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) - enddo + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + integer :: & + ipc + + damage_nonlocal_getMobility = 0.0_pReal + + do ipc = 1, homogenization_Ngrains(mesh_element(3,el)) + damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el)) + enddo - damage_nonlocal_getMobility = damage_nonlocal_getMobility/& - real(homogenization_Ngrains(mesh_element(3,el)),pReal) + damage_nonlocal_getMobility = damage_nonlocal_getMobility/& + real(homogenization_Ngrains(mesh_element(3,el)),pReal) end function damage_nonlocal_getMobility @@ -235,18 +232,18 @@ end function damage_nonlocal_getMobility !-------------------------------------------------------------------------------------------------- subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - integer :: & - homog, & - offset - - homog = material_homogenizationAt(el) - offset = damageMapping(homog)%p(ip,el) - damage(homog)%p(offset) = phi + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + real(pReal), intent(in) :: & + phi + integer :: & + homog, & + offset + + homog = material_homogenizationAt(el) + offset = damageMapping(homog)%p(ip,el) + damage(homog)%p(offset) = phi end subroutine damage_nonlocal_putNonLocalDamage @@ -256,31 +253,31 @@ end subroutine damage_nonlocal_putNonLocalDamage !-------------------------------------------------------------------------------------------------- function damage_nonlocal_postResults(ip,el) - integer, intent(in) :: & - ip, & !< integration point - el !< element - real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & - damage_nonlocal_postResults + integer, intent(in) :: & + ip, & !< integration point + el !< element + real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: & + damage_nonlocal_postResults - integer :: & - instance, homog, offset, o, c - - homog = material_homogenizationAt(el) - offset = damageMapping(homog)%p(ip,el) - instance = damage_typeInstance(homog) - associate(prm => param(instance)) - c = 0 + integer :: & + instance, homog, offset, o, c + + homog = material_homogenizationAt(el) + offset = damageMapping(homog)%p(ip,el) + instance = damage_typeInstance(homog) + associate(prm => param(instance)) + c = 0 - outputsLoop: do o = 1,size(prm%outputID) - select case(prm%outputID(o)) - - case (damage_ID) - damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) - c = c + 1 - end select - enddo outputsLoop + outputsLoop: do o = 1,size(prm%outputID) + select case(prm%outputID(o)) + + case (damage_ID) + damage_nonlocal_postResults(c+1) = damage(homog)%p(offset) + c = c + 1 + end select + enddo outputsLoop - end associate + end associate end function damage_nonlocal_postResults end module damage_nonlocal diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 3210f02d4..9287cc4bf 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,6 +16,12 @@ module homogenization use crystallite use mesh use FEsolving + use thermal_isothermal + use thermal_adiabatic + use thermal_conduction + use damage_none + use damage_local + use damage_nonlocal #if defined(PETSc) || defined(DAMASK_HDF5) use results use HDF5_utilities @@ -131,12 +137,6 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init - use thermal_isothermal - use thermal_adiabatic - use thermal_conduction - use damage_none - use damage_local - use damage_nonlocal integer, parameter :: FILEUNIT = 200 integer :: e,i,p @@ -668,10 +668,6 @@ end subroutine partitionDeformation !> "happy" with result !-------------------------------------------------------------------------------------------------- function updateState(ip,el) - use thermal_adiabatic, only: & - thermal_adiabatic_updateState - use damage_local, only: & - damage_local_updateState integer, intent(in) :: & ip, & !< integration point @@ -753,14 +749,6 @@ end subroutine averageStressAndItsTangent !> if homogenization_sizePostResults(i,e) > 0 !! !-------------------------------------------------------------------------------------------------- function postResults(ip,el) - use thermal_adiabatic, only: & - thermal_adiabatic_postResults - use thermal_conduction, only: & - thermal_conduction_postResults - use damage_local, only: & - damage_local_postResults - use damage_nonlocal, only: & - damage_nonlocal_postResults integer, intent(in) :: & ip, & !< integration point diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 60d9cb500..39bfbf340 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -13,43 +13,43 @@ module kinematics_cleavage_opening use lattice use material - implicit none - private + implicit none + private - integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance + integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance - type :: tParameters !< container type for internal constitutive parameters - integer :: & - totalNcleavage - integer, dimension(:), allocatable :: & - Ncleavage !< active number of cleavage systems per family - real(pReal) :: & - sdot0, & - n - real(pReal), dimension(:), allocatable :: & - critDisp, & - critLoad - end type + type :: tParameters !< container type for internal constitutive parameters + integer :: & + totalNcleavage + integer, dimension(:), allocatable :: & + Ncleavage !< active number of cleavage systems per family + real(pReal) :: & + sdot0, & + n + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + end type ! Begin Deprecated - integer, dimension(:), allocatable :: & - kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems - - integer, dimension(:,:), allocatable :: & - kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family - - real(pReal), dimension(:), allocatable :: & - kinematics_cleavage_opening_sdot_0, & - kinematics_cleavage_opening_N + integer, dimension(:), allocatable :: & + kinematics_cleavage_opening_totalNcleavage !< total number of cleavage systems + + integer, dimension(:,:), allocatable :: & + kinematics_cleavage_opening_Ncleavage !< number of cleavage systems per family + + real(pReal), dimension(:), allocatable :: & + kinematics_cleavage_opening_sdot_0, & + kinematics_cleavage_opening_N - real(pReal), dimension(:,:), allocatable :: & - kinematics_cleavage_opening_critDisp, & - kinematics_cleavage_opening_critLoad + real(pReal), dimension(:,:), allocatable :: & + kinematics_cleavage_opening_critDisp, & + kinematics_cleavage_opening_critLoad ! End Deprecated - public :: & - kinematics_cleavage_opening_init, & - kinematics_cleavage_opening_LiAndItsTangent + public :: & + kinematics_cleavage_opening_init, & + kinematics_cleavage_opening_LiAndItsTangent contains @@ -60,142 +60,142 @@ contains !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_init - integer, allocatable, dimension(:) :: tempInt - real(pReal), allocatable, dimension(:) :: tempFloat + integer, allocatable, dimension(:) :: tempInt + real(pReal), allocatable, dimension(:) :: tempFloat - integer :: maxNinstance,p,instance + integer :: maxNinstance,p,instance - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID) - if (maxNinstance == 0) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) - do p = 1, size(config_phase) - kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? - enddo - - allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) - allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) - allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) - allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) + maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID) + if (maxNinstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + + allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) + do p = 1, size(config_phase) + kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct? + enddo + + allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0) + allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance), source=0) + allocate(kinematics_cleavage_opening_sdot_0(maxNinstance), source=0.0_pReal) + allocate(kinematics_cleavage_opening_N(maxNinstance), source=0.0_pReal) - do p = 1, size(config_phase) - if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle - instance = kinematics_cleavage_opening_instance(p) - kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') - kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity') - tempInt = config_phase(p)%getInts('ncleavage') - kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt + do p = 1, size(config_phase) + if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle + instance = kinematics_cleavage_opening_instance(p) + kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0') + kinematics_cleavage_opening_N(instance) = config_phase(p)%getFloat('anisobrittle_ratesensitivity') + tempInt = config_phase(p)%getInts('ncleavage') + kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt - tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt)) - kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat + tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt)) + kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat - tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt)) - kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat + tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt)) + kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & - min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested - kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) - kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether - if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') - if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & - call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') - if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & - call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') - enddo + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = & + min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),& ! limit active cleavage systems per family to min of available and requested + kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance)) + kinematics_cleavage_opening_totalNcleavage(instance) = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether + if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')') + if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) & + call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')') + if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) & + call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')') + enddo end subroutine kinematics_cleavage_opening_init - + !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) - integer, intent(in) :: & - ipc, & !< grain number - ip, & !< integration point number - el !< element number - real(pReal), intent(in), dimension(3,3) :: & - S - real(pReal), intent(out), dimension(3,3) :: & - Ld !< damage velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) - integer :: & - instance, phase, & - homog, damageOffset, & - f, i, index_myFamily, k, l, m, n - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit, & - udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt + integer, intent(in) :: & + ipc, & !< grain number + ip, & !< integration point number + el !< element number + real(pReal), intent(in), dimension(3,3) :: & + S + real(pReal), intent(out), dimension(3,3) :: & + Ld !< damage velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) + integer :: & + instance, phase, & + homog, damageOffset, & + f, i, index_myFamily, k, l, m, n + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit, & + udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phase(ipc,ip,el) - instance = kinematics_cleavage_opening_instance(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - Ld = 0.0_pReal - dLd_dTstar = 0.0_pReal - do f = 1,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family - do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) - traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) - traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) - traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & - damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) - udotd = & - sign(1.0_pReal,traction_d)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udotd) > tol_math_check) then - Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) - dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_d) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,1,index_myFamily+i,phase) - endif + phase = material_phase(ipc,ip,el) + instance = kinematics_cleavage_opening_instance(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) + + Ld = 0.0_pReal + dLd_dTstar = 0.0_pReal + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance) ! process each (active) cleavage system in family + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) + traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + udotd = & + sign(1.0_pReal,traction_d)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotd) > tol_math_check) then + Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase) + dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_d) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,1,index_myFamily+i,phase) + endif - udott = & - sign(1.0_pReal,traction_t)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udott) > tol_math_check) then - Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) - dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_t) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,2,index_myFamily+i,phase) - endif + udott = & + sign(1.0_pReal,traction_t)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udott) > tol_math_check) then + Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase) + dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_t) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,2,index_myFamily+i,phase) + endif - udotn = & - sign(1.0_pReal,traction_n)* & - kinematics_cleavage_opening_sdot_0(instance)* & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) - if (abs(udotn) > tol_math_check) then - Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) - dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & - max(0.0_pReal, abs(traction_n) - traction_crit) - forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & - dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & - lattice_Scleavage(m,n,3,index_myFamily+i,phase) - endif - enddo - enddo + udotn = & + sign(1.0_pReal,traction_n)* & + kinematics_cleavage_opening_sdot_0(instance)* & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance) + if (abs(udotn) > tol_math_check) then + Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase) + dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ & + max(0.0_pReal, abs(traction_n) - traction_crit) + forall (k=1:3,l=1:3,m=1:3,n=1:3) & + dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + & + dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* & + lattice_Scleavage(m,n,3,index_myFamily+i,phase) + endif + enddo + enddo end subroutine kinematics_cleavage_opening_LiAndItsTangent diff --git a/src/list.f90 b/src/list.f90 index be80b151d..79eafc964 100644 --- a/src/list.f90 +++ b/src/list.f90 @@ -3,8 +3,8 @@ !> @brief linked list !-------------------------------------------------------------------------------------------------- module list - use prec, only: & - pReal + use prec + use IO implicit none private @@ -65,10 +65,6 @@ contains !! to lower case. The data is not stored in the new element but in the current. !-------------------------------------------------------------------------------------------------- subroutine add(this,string) - use IO, only: & - IO_isBlank, & - IO_lc, & - IO_stringPos class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string @@ -157,8 +153,6 @@ end subroutine finalizeArray !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- logical function keyExists(this,key) - use IO, only: & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -180,8 +174,6 @@ end function keyExists !> @details traverses list and counts each occurrence of specified key !-------------------------------------------------------------------------------------------------- integer function countKeys(this,key) - use IO, only: & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -205,10 +197,6 @@ end function countKeys !! error unless default is given !-------------------------------------------------------------------------------------------------- real(pReal) function getFloat(this,key,defaultVal) - use IO, only : & - IO_error, & - IO_stringValue, & - IO_FloatValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -241,10 +229,6 @@ end function getFloat !! error unless default is given !-------------------------------------------------------------------------------------------------- integer function getInt(this,key,defaultVal) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -278,9 +262,6 @@ end function getInt !! the individual chunks are returned !-------------------------------------------------------------------------------------------------- character(len=65536) function getString(this,key,defaultVal,raw) - use IO, only: & - IO_error, & - IO_stringValue class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key @@ -327,10 +308,6 @@ end function getString !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- function getFloats(this,key,defaultVal,requiredSize) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_FloatValue real(pReal), dimension(:), allocatable :: getFloats class(tPartitionedStringList), target, intent(in) :: this @@ -376,10 +353,6 @@ end function getFloats !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- function getInts(this,key,defaultVal,requiredSize) - use IO, only: & - IO_error, & - IO_stringValue, & - IO_IntValue integer, dimension(:), allocatable :: getInts class(tPartitionedStringList), target, intent(in) :: this @@ -426,9 +399,6 @@ end function getInts !! If raw is true, the the complete string is returned, otherwise the individual chunks are returned !-------------------------------------------------------------------------------------------------- function getStrings(this,key,defaultVal,raw) - use IO, only: & - IO_error, & - IO_StringValue character(len=65536),dimension(:), allocatable :: getStrings class(tPartitionedStringList),target, intent(in) :: this diff --git a/src/results.f90 b/src/results.f90 index 05db831f7..cee86c7da 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -5,6 +5,9 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- module results + use DAMASK_interface + use rotations + use numerics use HDF5_utilities #ifdef PETSc use PETSC @@ -55,8 +58,6 @@ module results contains subroutine results_init - use DAMASK_interface, only: & - getSolverJobName character(len=pStringLen) :: commandLine @@ -83,9 +84,6 @@ end subroutine results_init !> @brief opens the results file to append data !-------------------------------------------------------------------------------------------------- subroutine results_openJobFile - use DAMASK_interface, only: & - getSolverJobName - resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) @@ -396,8 +394,6 @@ end subroutine results_writeTensorDataset_int !> @brief stores a scalar dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure) - use rotations, only: & - rotation character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: lattice_structure @@ -428,9 +424,6 @@ end subroutine results_writeScalarDataset_rotation !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_constituent(phaseAt,memberAt,label) - use numerics, only: & - worldrank, & - worldsize integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element) integer, dimension(:,:,:), intent(in) :: memberAt !< phase member at (constituent,IP,element) @@ -566,9 +559,6 @@ end subroutine results_mapping_constituent !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label) - use numerics, only: & - worldrank, & - worldsize integer, dimension(:), intent(in) :: homogenizationAt !< homogenization section at (element) integer, dimension(:,:), intent(in) :: memberAt !< homogenization member at (IP,element) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 2f5fc119f..ccad7c6b0 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -5,55 +5,62 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_damage_anisoBrittle - use prec + use prec + use debug + use IO + use math + use material + use config + use lattice - implicit none - private - integer, dimension(:), allocatable, public, protected :: & - source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? - source_damage_anisoBrittle_instance !< instance of source mechanism + implicit none + private - integer, dimension(:,:), allocatable, target, public :: & - source_damage_anisoBrittle_sizePostResult !< size of each post result output + integer, dimension(:), allocatable, public, protected :: & + source_damage_anisoBrittle_offset, & !< which source is my current source mechanism? + source_damage_anisoBrittle_instance !< instance of source mechanism - character(len=64), dimension(:,:), allocatable, target, public :: & - source_damage_anisoBrittle_output !< name of each post result output - - integer, dimension(:,:), allocatable, private :: & - source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family + integer, dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_sizePostResult !< size of each post result output - enum, bind(c) - enumerator :: undefined_ID, & - damage_drivingforce_ID - end enum + character(len=64), dimension(:,:), allocatable, target, public :: & + source_damage_anisoBrittle_output !< name of each post result output + + integer, dimension(:,:), allocatable :: & + source_damage_anisoBrittle_Ncleavage !< number of cleavage systems per family + + enum, bind(c) + enumerator :: undefined_ID, & + damage_drivingforce_ID + end enum - type, private :: tParameters !< container type for internal constitutive parameters - real(pReal) :: & - aTol, & - sdot_0, & - N - real(pReal), dimension(:), allocatable :: & - critDisp, & - critLoad - real(pReal), dimension(:,:,:,:), allocatable :: & - cleavage_systems - integer :: & - totalNcleavage - integer, dimension(:), allocatable :: & - Ncleavage - integer(kind(undefined_ID)), allocatable, dimension(:) :: & - outputID !< ID of each post result output - end type tParameters + type :: tParameters !< container type for internal constitutive parameters + real(pReal) :: & + aTol, & + sdot_0, & + N + real(pReal), dimension(:), allocatable :: & + critDisp, & + critLoad + real(pReal), dimension(:,:,:,:), allocatable :: & + cleavage_systems + integer :: & + totalNcleavage + integer, dimension(:), allocatable :: & + Ncleavage + integer(kind(undefined_ID)), allocatable, dimension(:) :: & + outputID !< ID of each post result output + end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) - public :: & - source_damage_anisoBrittle_init, & - source_damage_anisoBrittle_dotState, & - source_damage_anisobrittle_getRateAndItsTangent, & - source_damage_anisoBrittle_postResults + public :: & + source_damage_anisoBrittle_init, & + source_damage_anisoBrittle_dotState, & + source_damage_anisobrittle_getRateAndItsTangent, & + source_damage_anisoBrittle_postResults contains @@ -63,266 +70,230 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use IO, only: & - IO_error - use math, only: & - math_expand - use material, only: & - material_allocateSourceState, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_damage_anisoBrittle_label, & - SOURCE_damage_anisoBrittle_ID, & - material_phase, & - sourceState - use config, only: & - config_phase, & - material_Nphase - use lattice, only: & - lattice_SchmidMatrix_cleavage, & - lattice_maxNcleavageFamily - integer :: Ninstance,phase,instance,source,sourceOffset - integer :: NofMyPhase,p ,i - integer, dimension(0), parameter :: emptyIntArray = [integer::] - character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - integer(kind(undefined_ID)) :: & - outputID + integer :: Ninstance,phase,instance,source,sourceOffset + integer :: NofMyPhase,p ,i + integer, dimension(0), parameter :: emptyIntArray = [integer::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + integer(kind(undefined_ID)) :: & + outputID - character(len=pStringLen) :: & - extmsg = '' - character(len=65536), dimension(:), allocatable :: & - outputs + character(len=pStringLen) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: & + outputs - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' - Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID) - if (Ninstance == 0) return - - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - - allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) - allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) - do phase = 1, material_Nphase - source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) - do source = 1, phase_Nsources(phase) - if (phase_source(source,phase) == source_damage_anisoBrittle_ID) & - source_damage_anisoBrittle_offset(phase) = source - enddo - enddo - - allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) - allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) - source_damage_anisoBrittle_output = '' + Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID) + if (Ninstance == 0) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) & + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance + + allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0) + allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0) + do phase = 1, material_Nphase + source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID) + do source = 1, phase_Nsources(phase) + if (phase_source(source,phase) == source_damage_anisoBrittle_ID) & + source_damage_anisoBrittle_offset(phase) = source + enddo + enddo + + allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0) + allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance)) + source_damage_anisoBrittle_output = '' - allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) + allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0) - allocate(param(Ninstance)) - - do p=1, size(config_phase) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle - associate(prm => param(source_damage_anisoBrittle_instance(p)), & - config => config_phase(p)) - - prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal) + allocate(param(Ninstance)) + + do p=1, size(config_phase) + if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle + associate(prm => param(source_damage_anisoBrittle_instance(p)), & + config => config_phase(p)) + + prm%aTol = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal) - prm%N = config%getFloat('anisobrittle_ratesensitivity') - prm%sdot_0 = config%getFloat('anisobrittle_sdot0') - - ! sanity checks - if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol' - - if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity' - if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' - - prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) + prm%N = config%getFloat('anisobrittle_ratesensitivity') + prm%sdot_0 = config%getFloat('anisobrittle_sdot0') + + ! sanity checks + if (prm%aTol < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol' + + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' + + prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray) - prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage)) - prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage)) - - prm%cleavage_systems = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage)) + prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(prm%Ncleavage)) + + prm%cleavage_systems = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) - ! expand: family => system - prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) - prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) - - if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload' - if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement' + ! expand: family => system + prm%critDisp = math_expand(prm%critDisp, prm%Ncleavage) + prm%critLoad = math_expand(prm%critLoad, prm%Ncleavage) + + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticalload' + if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') & - call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + if (extmsg /= '') & + call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') !-------------------------------------------------------------------------------------------------- ! output pararameters - outputs = config%getStrings('(output)',defaultVal=emptyStringArray) - allocate(prm%outputID(0)) - do i=1, size(outputs) - outputID = undefined_ID - select case(outputs(i)) - - case ('anisobrittle_drivingforce') - source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 - source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) - prm%outputID = [prm%outputID, damage_drivingforce_ID] + outputs = config%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + + case ('anisobrittle_drivingforce') + source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1 + source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i) + prm%outputID = [prm%outputID, damage_drivingforce_ID] - end select + end select - enddo + enddo - end associate - - phase = p - NofMyPhase=count(material_phase==phase) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) + end associate + + phase = p + NofMyPhase=count(material_phase==phase) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) - call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) - sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) - sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol + call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0) + sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance)) + sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol - source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage - enddo + source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage + enddo - end subroutine source_damage_anisoBrittle_init + !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) - use math, only: & - math_mul33xx33 - use material, only: & - phaseAt, phasememberAt, & - sourceState, & - material_homogenizationAt, & - damage, & - damageMapping - use lattice, only: & - lattice_Scleavage, & - lattice_maxNcleavageFamily, & - lattice_NcleavageSystem - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S - integer :: & - phase, & - constituent, & - instance, & - sourceOffset, & - damageOffset, & - homog, & - f, i, index_myFamily, index - real(pReal) :: & - traction_d, traction_t, traction_n, traction_crit + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S + integer :: & + phase, & + constituent, & + instance, & + sourceOffset, & + damageOffset, & + homog, & + f, i, index_myFamily, index + real(pReal) :: & + traction_d, traction_t, traction_n, traction_crit - phase = phaseAt(ipc,ip,el) - constituent = phasememberAt(ipc,ip,el) - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) - homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) - - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal - - index = 1 - do f = 1,lattice_maxNcleavageFamily - index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family - do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family + phase = phaseAt(ipc,ip,el) + constituent = phasememberAt(ipc,ip,el) + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) + homog = material_homogenizationAt(el) + damageOffset = damageMapping(homog)%p(ip,el) + + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + + index = 1 + do f = 1,lattice_maxNcleavageFamily + index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase)) ! at which index starts my family + do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance) ! process each (active) cleavage system in family - traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) - traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) - traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) - - traction_crit = param(instance)%critLoad(index)* & - damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) + traction_d = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)) + traction_t = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)) + traction_n = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)) + + traction_crit = param(instance)%critLoad(index)* & + damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & - param(instance)%sdot_0* & - ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & - (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & - (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & - param(instance)%critDisp(index) + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + & + param(instance)%sdot_0* & + ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + & + (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ & + param(instance)%critDisp(index) - index = index + 1 - enddo - enddo + index = index + 1 + enddo + enddo end subroutine source_damage_anisoBrittle_dotState + !-------------------------------------------------------------------------------------------------- !> @brief returns local part of nonlocal damage driving force !-------------------------------------------------------------------------------------------------- subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - use material, only: & - sourceState - integer, intent(in) :: & - phase, & - constituent - real(pReal), intent(in) :: & - phi - real(pReal), intent(out) :: & - localphiDot, & - dLocalphiDot_dPhi - integer :: & - sourceOffset + integer, intent(in) :: & + phase, & + constituent + real(pReal), intent(in) :: & + phi + real(pReal), intent(out) :: & + localphiDot, & + dLocalphiDot_dPhi + integer :: & + sourceOffset - sourceOffset = source_damage_anisoBrittle_offset(phase) - - localphiDot = 1.0_pReal & - - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi - - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + sourceOffset = source_damage_anisoBrittle_offset(phase) + + localphiDot = 1.0_pReal & + - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi + + dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) end subroutine source_damage_anisobrittle_getRateAndItsTangent - + + !-------------------------------------------------------------------------------------------------- !> @brief return array of local damage results !-------------------------------------------------------------------------------------------------- function source_damage_anisoBrittle_postResults(phase, constituent) - use material, only: & - sourceState - integer, intent(in) :: & - phase, & - constituent - real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & - source_damage_anisoBrittle_instance(phase)))) :: & - source_damage_anisoBrittle_postResults + integer, intent(in) :: & + phase, & + constituent - integer :: & - instance, sourceOffset, o, c - - instance = source_damage_anisoBrittle_instance(phase) - sourceOffset = source_damage_anisoBrittle_offset(phase) + real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, & + source_damage_anisoBrittle_instance(phase)))) :: & + source_damage_anisoBrittle_postResults - c = 0 + integer :: & + instance, sourceOffset, o, c + + instance = source_damage_anisoBrittle_instance(phase) + sourceOffset = source_damage_anisoBrittle_offset(phase) - do o = 1,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) - case (damage_drivingforce_ID) - source_damage_anisoBrittle_postResults(c+1) = & - sourceState(phase)%p(sourceOffset)%state(1,constituent) - c = c + 1 + c = 0 - end select - enddo + do o = 1,size(param(instance)%outputID) + select case(param(instance)%outputID(o)) + case (damage_drivingforce_ID) + source_damage_anisoBrittle_postResults(c+1) = & + sourceState(phase)%p(sourceOffset)%state(1,constituent) + c = c + 1 + + end select + enddo end function source_damage_anisoBrittle_postResults end module source_damage_anisoBrittle diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 94452eb47..e8464edd0 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -5,27 +5,30 @@ !> @details to be done !-------------------------------------------------------------------------------------------------- module source_thermal_dissipation - use prec, only: & - pReal + use prec + use debug + use material + use config implicit none private + integer, dimension(:), allocatable, public, protected :: & - source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? - source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism + source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? + source_thermal_dissipation_instance !< instance of thermal dissipation source mechanism integer, dimension(:,:), allocatable, target, public :: & - source_thermal_dissipation_sizePostResult !< size of each post result output + source_thermal_dissipation_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - source_thermal_dissipation_output !< name of each post result output + source_thermal_dissipation_output !< name of each post result output - type, private :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & kappa end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) public :: & @@ -40,21 +43,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_dissipation_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use material, only: & - material_allocateSourceState, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_thermal_dissipation_label, & - SOURCE_thermal_dissipation_ID, & - material_phase - use config, only: & - config_phase, & - material_Nphase integer :: Ninstance,instance,source,sourceOffset integer :: NofMyPhase,p diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 699902ad3..99d9a6f1f 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -5,11 +5,14 @@ !> @brief material subroutine for variable heat source !-------------------------------------------------------------------------------------------------- module source_thermal_externalheat - use prec, only: & - pReal + use prec + use debug + use material + use config implicit none private + integer, dimension(:), allocatable, public, protected :: & source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism @@ -23,7 +26,7 @@ module source_thermal_externalheat integer, dimension(:), allocatable, target, public :: & source_thermal_externalheat_Noutput !< number of outputs per instance of this source - type, private :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal), dimension(:), allocatable :: & time, & heat_rate @@ -31,7 +34,7 @@ module source_thermal_externalheat nIntervals end type tParameters - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) public :: & @@ -47,22 +50,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_init - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use material, only: & - material_allocateSourceState, & - material_phase, & - phase_source, & - phase_Nsources, & - phase_Noutput, & - SOURCE_thermal_externalheat_label, & - SOURCE_thermal_externalheat_ID - use config, only: & - config_phase, & - material_Nphase - integer :: maxNinstance,instance,source,sourceOffset,NofMyPhase,p @@ -116,8 +103,6 @@ end subroutine source_thermal_externalheat_init !> @details state only contains current time to linearly interpolate given heat powers !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_dotState(phase, of) - use material, only: & - sourceState integer, intent(in) :: & phase, & @@ -135,8 +120,6 @@ end subroutine source_thermal_externalheat_dotState !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) - use material, only: & - sourceState integer, intent(in) :: & phase, & diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index bfd5633d1..3c9fd0c6e 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -3,9 +3,16 @@ !> @brief material subroutine for adiabatic temperature evolution !-------------------------------------------------------------------------------------------------- module thermal_adiabatic - use prec, only: & - pReal - + use prec + use config + use numerics + use material + use source_thermal_dissipation + use source_thermal_externalheat + use crystallite + use lattice + use mesh + implicit none private @@ -21,7 +28,7 @@ module thermal_adiabatic enumerator :: undefined_ID, & temperature_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & + integer(kind(undefined_ID)), dimension(:,:), allocatable :: & thermal_adiabatic_outputID !< ID of each post result output @@ -41,21 +48,6 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init - use material, only: & - thermal_type, & - thermal_typeInstance, & - homogenization_Noutput, & - THERMAL_ADIABATIC_label, & - THERMAL_adiabatic_ID, & - material_homogenizationAt, & - mappingHomogenization, & - thermalState, & - thermalMapping, & - thermal_initialT, & - temperature, & - temperatureRate - use config, only: & - config_homogenization integer :: maxNinstance,section,instance,i,sizeState,NofMyHomog character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -112,16 +104,6 @@ end subroutine thermal_adiabatic_init !> @brief calculates adiabatic change in temperature based on local heat generation model !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_updateState(subdt, ip, el) - use numerics, only: & - err_thermal_tolAbs, & - err_thermal_tolRel - use material, only: & - material_homogenizationAt, & - mappingHomogenization, & - thermalState, & - temperature, & - temperatureRate, & - thermalMapping integer, intent(in) :: & ip, & !< integration point number @@ -156,27 +138,11 @@ function thermal_adiabatic_updateState(subdt, ip, el) end function thermal_adiabatic_updateState + !-------------------------------------------------------------------------------------------------- !> @brief returns heat generation rate !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - use material, only: & - homogenization_Ngrains, & - material_homogenizationAt, & - phaseAt, & - phasememberAt, & - thermal_typeInstance, & - phase_Nsources, & - phase_source, & - SOURCE_thermal_dissipation_ID, & - SOURCE_thermal_externalheat_ID - use source_thermal_dissipation, only: & - source_thermal_dissipation_getRateAndItsTangent - use source_thermal_externalheat, only: & - source_thermal_externalheat_getRateAndItsTangent - use crystallite, only: & - crystallite_S, & - crystallite_Lp integer, intent(in) :: & ip, & !< integration point number @@ -229,18 +195,12 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = dTdot_dT/real(homogenization_Ngrains(homog),pReal) end subroutine thermal_adiabatic_getSourceAndItsTangent - + + !-------------------------------------------------------------------------------------------------- !> @brief returns homogenized specific heat capacity !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_getSpecificHeat(ip,el) - use lattice, only: & - lattice_specificHeat - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element integer, intent(in) :: & ip, & !< integration point number @@ -269,13 +229,6 @@ end function thermal_adiabatic_getSpecificHeat !> @brief returns homogenized mass density !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_getMassDensity(ip,el) - use lattice, only: & - lattice_massDensity - use material, only: & - homogenization_Ngrains, & - material_phase - use mesh, only: & - mesh_element integer, intent(in) :: & ip, & !< integration point number @@ -303,8 +256,6 @@ end function thermal_adiabatic_getMassDensity !> @brief return array of thermal results !-------------------------------------------------------------------------------------------------- function thermal_adiabatic_postResults(homog,instance,of) result(postResults) - use material, only: & - temperature integer, intent(in) :: & homog, &