2012-03-09 01:55:28 +05:30
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
2013-06-11 22:05:04 +05:30
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
2018-06-26 22:39:46 +05:30
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
2013-01-18 17:00:52 +05:30
!> @brief Parses material config file, either solverJobName.materialConfig or material.config
!> @details reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config and parses the sections 'homogenization', 'crystallite',
!! 'phase', 'texture', and 'microstucture'
2012-03-09 01:55:28 +05:30
!--------------------------------------------------------------------------------------------------
module material
2013-01-18 17:00:52 +05:30
use prec , only : &
pReal , &
2013-02-25 18:43:52 +05:30
pInt , &
2014-04-15 14:50:38 +05:30
tState , &
2014-12-19 19:31:03 +05:30
tPlasticState , &
2015-05-28 22:32:23 +05:30
tSourceState , &
tHomogMapping , &
tPhaseMapping , &
2018-08-20 19:39:40 +05:30
group_float , &
2018-08-04 05:09:14 +05:30
group_int
2012-03-09 01:55:28 +05:30
implicit none
private
2013-12-16 16:26:56 +05:30
character ( len = * ) , parameter , public :: &
2015-05-28 22:32:23 +05:30
ELASTICITY_hooke_label = 'hooke' , &
PLASTICITY_none_label = 'none' , &
2016-01-09 01:15:20 +05:30
PLASTICITY_isotropic_label = 'isotropic' , &
2015-05-28 22:32:23 +05:30
PLASTICITY_phenopowerlaw_label = 'phenopowerlaw' , &
2017-09-30 04:06:28 +05:30
PLASTICITY_kinehardening_label = 'kinehardening' , &
2015-05-29 16:33:25 +05:30
PLASTICITY_dislotwin_label = 'dislotwin' , &
2015-05-28 22:32:23 +05:30
PLASTICITY_disloucla_label = 'disloucla' , &
PLASTICITY_nonlocal_label = 'nonlocal' , &
SOURCE_thermal_dissipation_label = 'thermal_dissipation' , &
2015-07-27 16:39:37 +05:30
SOURCE_thermal_externalheat_label = 'thermal_externalheat' , &
2015-05-28 22:32:23 +05:30
SOURCE_damage_isoBrittle_label = 'damage_isobrittle' , &
SOURCE_damage_isoDuctile_label = 'damage_isoductile' , &
SOURCE_damage_anisoBrittle_label = 'damage_anisobrittle' , &
SOURCE_damage_anisoDuctile_label = 'damage_anisoductile' , &
KINEMATICS_thermal_expansion_label = 'thermal_expansion' , &
KINEMATICS_cleavage_opening_label = 'cleavage_opening' , &
KINEMATICS_slipplane_opening_label = 'slipplane_opening' , &
STIFFNESS_DEGRADATION_damage_label = 'damage' , &
THERMAL_isothermal_label = 'isothermal' , &
THERMAL_adiabatic_label = 'adiabatic' , &
THERMAL_conduction_label = 'conduction' , &
DAMAGE_none_label = 'none' , &
DAMAGE_local_label = 'local' , &
DAMAGE_nonlocal_label = 'nonlocal' , &
HOMOGENIZATION_none_label = 'none' , &
HOMOGENIZATION_isostrain_label = 'isostrain' , &
2015-10-14 00:22:01 +05:30
HOMOGENIZATION_rgc_label = 'rgc'
2013-11-27 13:35:23 +05:30
2015-10-14 00:22:01 +05:30
enum , bind ( c )
2013-12-12 22:39:59 +05:30
enumerator :: ELASTICITY_undefined_ID , &
ELASTICITY_hooke_ID
end enum
enum , bind ( c )
enumerator :: PLASTICITY_undefined_ID , &
PLASTICITY_none_ID , &
2016-01-09 01:15:20 +05:30
PLASTICITY_isotropic_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_phenopowerlaw_ID , &
2017-09-30 04:06:28 +05:30
PLASTICITY_kinehardening_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_dislotwin_ID , &
2015-01-15 16:26:15 +05:30
PLASTICITY_disloucla_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_nonlocal_ID
2013-12-12 22:39:59 +05:30
end enum
2015-05-28 22:32:23 +05:30
2014-09-03 22:42:06 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: SOURCE_undefined_ID , &
SOURCE_thermal_dissipation_ID , &
2015-07-27 16:39:37 +05:30
SOURCE_thermal_externalheat_ID , &
2015-05-28 22:32:23 +05:30
SOURCE_damage_isoBrittle_ID , &
SOURCE_damage_isoDuctile_ID , &
SOURCE_damage_anisoBrittle_ID , &
2018-12-22 13:30:57 +05:30
SOURCE_damage_anisoDuctile_ID
2014-09-03 22:42:06 +05:30
end enum
2015-05-28 22:32:23 +05:30
2014-09-03 22:42:06 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: KINEMATICS_undefined_ID , &
KINEMATICS_cleavage_opening_ID , &
KINEMATICS_slipplane_opening_ID , &
2018-12-22 13:30:57 +05:30
KINEMATICS_thermal_expansion_ID
2014-09-03 22:42:06 +05:30
end enum
2015-05-28 22:32:23 +05:30
2014-10-11 02:25:09 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: STIFFNESS_DEGRADATION_undefined_ID , &
2018-12-30 15:11:11 +05:30
STIFFNESS_DEGRADATION_damage_ID
2014-10-11 02:25:09 +05:30
end enum
2014-09-03 22:42:06 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: THERMAL_isothermal_ID , &
THERMAL_adiabatic_ID , &
THERMAL_conduction_ID
2014-09-03 22:42:06 +05:30
end enum
2015-05-28 22:32:23 +05:30
2014-09-03 22:42:06 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: DAMAGE_none_ID , &
DAMAGE_local_ID , &
DAMAGE_nonlocal_ID
2014-09-03 22:42:06 +05:30
end enum
2015-05-28 22:32:23 +05:30
2013-12-12 22:39:59 +05:30
enum , bind ( c )
enumerator :: HOMOGENIZATION_undefined_ID , &
2014-03-14 04:50:50 +05:30
HOMOGENIZATION_none_ID , &
2013-12-12 22:39:59 +05:30
HOMOGENIZATION_isostrain_ID , &
2014-10-09 19:38:32 +05:30
HOMOGENIZATION_rgc_ID
2013-11-27 13:35:23 +05:30
end enum
2014-10-11 02:25:09 +05:30
integer ( kind ( ELASTICITY_undefined_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
phase_elasticity !< elasticity of each phase
2014-10-11 02:25:09 +05:30
integer ( kind ( PLASTICITY_undefined_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
phase_plasticity !< plasticity of each phase
2015-05-28 22:32:23 +05:30
integer ( kind ( THERMAL_isothermal_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
thermal_type !< thermal transport model
2015-05-28 22:32:23 +05:30
integer ( kind ( DAMAGE_none_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
damage_type !< nonlocal damage model
2015-05-28 22:32:23 +05:30
integer ( kind ( SOURCE_undefined_ID ) ) , dimension ( : , : ) , allocatable , public , protected :: &
phase_source , & !< active sources mechanisms of each phase
2015-10-14 00:22:01 +05:30
phase_kinematics , & !< active kinematic mechanisms of each phase
phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase
2014-07-02 17:57:39 +05:30
2013-12-13 19:44:17 +05:30
integer ( kind ( HOMOGENIZATION_undefined_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2013-11-27 13:35:23 +05:30
homogenization_type !< type of each homogenization
2013-01-18 17:00:52 +05:30
integer ( pInt ) , public , protected :: &
2018-06-10 21:31:52 +05:30
homogenization_maxNgrains !< max number of grains in any USED homogenization
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
phase_Nsources , & !< number of source mechanisms active in each phase
phase_Nkinematics , & !< number of kinematic mechanisms active in each phase
2015-07-24 20:23:50 +05:30
phase_NstiffnessDegradations , & !< number of stiffness degradation mechanisms active in each phase
phase_Noutput , & !< number of '(output)' items per phase
phase_elasticityInstance , & !< instance of particular elasticity of each phase
2018-10-14 15:57:42 +05:30
phase_plasticityInstance , & !< instance of particular plasticity of each phase
crystallite_Noutput , & !< number of '(output)' items per crystallite setting
2013-02-20 03:42:05 +05:30
homogenization_Ngrains , & !< number of grains in each homogenization
homogenization_Noutput , & !< number of '(output)' items per homogenization
homogenization_typeInstance , & !< instance of particular type of each homogenization
2015-05-28 22:32:23 +05:30
thermal_typeInstance , & !< instance of particular type of each thermal transport
damage_typeInstance , & !< instance of particular type of each nonlocal damage
2018-10-14 15:57:42 +05:30
microstructure_crystallite !< crystallite setting ID of each microstructure ! DEPRECATED !!!!
2012-03-09 01:55:28 +05:30
2015-07-24 20:23:50 +05:30
real ( pReal ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
thermal_initialT , & !< initial temperature per each homogenization
2018-12-30 15:11:11 +05:30
damage_initialPhi !< initial damage per each homogenization
2015-07-24 20:23:50 +05:30
2018-10-14 15:57:42 +05:30
! NEW MAPPINGS
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
material_homogenizationAt , & !< homogenization ID of each element (copy of mesh_homogenizationAt)
material_homogenizationMemberAt , & !< position of the element within its homogenization instance
material_aggregateAt , & !< aggregate ID of each element FUTURE USE FOR OUTPUT
material_aggregatMemberAt !< position of the element within its aggregate instance FUTURE USE FOR OUTPUT
integer ( pInt ) , dimension ( : , : ) , allocatable , public , protected :: &
material_phaseAt , & !< phase ID of each element
material_phaseMemberAt , & !< position of the element within its phase instance
material_crystalliteAt , & !< crystallite ID of each element CURRENTLY NOT PER CONSTITUTENT
material_crystalliteMemberAt !< position of the element within its crystallite instance CURRENTLY NOT PER CONSTITUTENT
! END NEW MAPPINGS
! DEPRECATED: use material_phaseAt
2014-03-12 13:03:51 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public :: &
2014-05-08 20:25:19 +05:30
material_phase !< phase (index) of each grain,IP,element
2018-10-14 15:57:42 +05:30
! DEPRECATED: use material_homogenizationAt
2014-08-21 23:18:20 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , public :: &
2015-10-14 00:22:01 +05:30
material_homog !< homogenization (index) of each IP,element
2018-10-04 10:09:03 +05:30
! END DEPRECATED
2018-10-14 15:57:42 +05:30
2014-12-19 19:31:03 +05:30
type ( tPlasticState ) , allocatable , dimension ( : ) , public :: &
plasticState
2015-05-28 22:32:23 +05:30
type ( tSourceState ) , allocatable , dimension ( : ) , public :: &
sourceState
type ( tState ) , allocatable , dimension ( : ) , public :: &
homogState , &
thermalState , &
2018-12-30 15:11:11 +05:30
damageState
2014-05-08 20:25:19 +05:30
2013-12-16 16:26:56 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public , protected :: &
2013-02-20 03:42:05 +05:30
material_texture !< texture (index) of each grain,IP,element
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable , public , protected :: &
2013-02-20 03:42:05 +05:30
material_EulerAngles !< initial orientation of each grain,IP,element
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
logical , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
microstructure_active , &
2013-02-20 03:42:05 +05:30
microstructure_elemhomo , & !< flag to indicate homogeneous microstructure distribution over element's IPs
phase_localPlasticity !< flags phases with local constitutive law
2012-03-09 01:55:28 +05:30
2013-12-16 16:26:56 +05:30
integer ( pInt ) , private :: &
2013-02-20 03:42:05 +05:30
microstructure_maxNconstituents , & !< max number of constituents in any phase
texture_maxNgauss , & !< max number of Gauss components in any texture
texture_maxNfiber !< max number of Fiber components in any texture
2012-03-09 01:55:28 +05:30
2013-12-16 16:26:56 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , private :: &
2013-02-20 03:42:05 +05:30
microstructure_Nconstituents , & !< number of constituents in each microstructure
texture_symmetry , & !< number of symmetric orientations per texture
texture_Ngauss , & !< number of Gauss components per texture
texture_Nfiber !< number of Fiber components per texture
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private :: &
2013-02-20 03:42:05 +05:30
microstructure_phase , & !< phase IDs of each microstructure
microstructure_texture !< texture IDs of each microstructure
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
2013-02-20 03:42:05 +05:30
microstructure_fraction !< vol fraction of each constituent in microstructure
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , private :: &
2013-02-20 03:42:05 +05:30
material_volume , & !< volume of each grain,IP,element
texture_Gauss , & !< data of each Gauss component
2013-05-02 14:05:37 +05:30
texture_Fiber , & !< data of each Fiber component
2013-07-24 16:39:39 +05:30
texture_transformation !< transformation for each texture
2015-10-14 00:22:01 +05:30
2013-12-16 16:26:56 +05:30
logical , dimension ( : ) , allocatable , private :: &
2012-03-09 01:55:28 +05:30
homogenization_active
2015-10-14 00:22:01 +05:30
2018-10-14 15:57:42 +05:30
! BEGIN DEPRECATED
2016-01-15 05:49:44 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public :: phaseAt !< phase ID of every material point (ipc,ip,el)
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public :: phasememberAt !< memberID of given phase at every material point (ipc,ip,el)
2018-10-14 15:57:42 +05:30
2016-01-15 05:49:44 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public , target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field
2018-10-14 15:57:42 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private , target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field
! END DEPRECATED
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
type ( tHomogMapping ) , allocatable , dimension ( : ) , public :: &
thermalMapping , & !< mapping for thermal state/fields
2018-12-30 15:11:11 +05:30
damageMapping !< mapping for damage state/fields
2015-10-14 00:22:01 +05:30
2018-08-20 19:39:40 +05:30
type ( group_float ) , allocatable , dimension ( : ) , public :: &
2015-05-28 22:32:23 +05:30
temperature , & !< temperature field
damage , & !< damage field
2018-12-22 13:30:57 +05:30
temperatureRate !< temperature change rate field
2014-09-18 20:57:52 +05:30
2013-10-16 18:34:59 +05:30
public :: &
2013-11-27 13:35:23 +05:30
material_init , &
2018-10-16 02:08:34 +05:30
material_allocatePlasticState , &
2013-12-16 16:26:56 +05:30
ELASTICITY_hooke_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_none_ID , &
2016-01-09 01:15:20 +05:30
PLASTICITY_isotropic_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_phenopowerlaw_ID , &
2017-09-30 04:06:28 +05:30
PLASTICITY_kinehardening_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_dislotwin_ID , &
2015-01-15 16:26:15 +05:30
PLASTICITY_disloucla_ID , &
2013-11-27 13:35:23 +05:30
PLASTICITY_nonlocal_ID , &
2015-05-28 22:32:23 +05:30
SOURCE_thermal_dissipation_ID , &
2015-07-27 16:39:37 +05:30
SOURCE_thermal_externalheat_ID , &
2015-05-28 22:32:23 +05:30
SOURCE_damage_isoBrittle_ID , &
SOURCE_damage_isoDuctile_ID , &
SOURCE_damage_anisoBrittle_ID , &
SOURCE_damage_anisoDuctile_ID , &
KINEMATICS_cleavage_opening_ID , &
KINEMATICS_slipplane_opening_ID , &
KINEMATICS_thermal_expansion_ID , &
STIFFNESS_DEGRADATION_damage_ID , &
THERMAL_isothermal_ID , &
THERMAL_adiabatic_ID , &
THERMAL_conduction_ID , &
DAMAGE_none_ID , &
DAMAGE_local_ID , &
DAMAGE_nonlocal_ID , &
2014-03-14 04:50:50 +05:30
HOMOGENIZATION_none_ID , &
2013-11-27 13:35:23 +05:30
HOMOGENIZATION_isostrain_ID , &
HOMOGENIZATION_RGC_ID
2013-10-16 18:34:59 +05:30
private :: &
material_parseHomogenization , &
material_parseMicrostructure , &
material_parseCrystallite , &
material_parsePhase , &
material_parseTexture , &
material_populateGrains
2012-03-09 01:55:28 +05:30
contains
2009-03-04 17:18:54 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief parses material configuration file
2015-10-14 00:22:01 +05:30
!> @details figures out if solverJobName.materialConfig is present, if not looks for
2013-01-18 17:00:52 +05:30
!> material.config
!--------------------------------------------------------------------------------------------------
2015-05-28 22:32:23 +05:30
subroutine material_init ( )
2018-02-02 17:06:09 +05:30
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
2017-10-05 20:05:34 +05:30
use , intrinsic :: iso_fortran_env , only : &
compiler_version , &
compiler_options
#endif
2013-01-18 17:00:52 +05:30
use IO , only : &
IO_error , &
2018-06-10 22:08:31 +05:30
IO_timeStamp
2013-01-18 17:00:52 +05:30
use debug , only : &
debug_level , &
debug_material , &
debug_levelBasic , &
debug_levelExtensive
2018-06-27 00:03:02 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_crystallite , &
config_homogenization , &
config_microstructure , &
config_phase , &
config_texture , &
2018-06-27 00:03:02 +05:30
homogenization_name , &
microstructure_name , &
phase_name , &
2018-08-22 15:21:23 +05:30
texture_name
2014-06-23 00:28:29 +05:30
use mesh , only : &
2018-10-04 09:33:48 +05:30
mesh_homogenizationAt , &
2018-09-24 00:23:35 +05:30
mesh_NipsPerElem , &
2014-06-23 00:28:29 +05:30
mesh_NcpElems , &
2015-10-14 00:22:01 +05:30
FE_geomtype
2009-03-04 17:18:54 +05:30
implicit none
2018-08-21 01:41:53 +05:30
integer ( pInt ) , parameter :: FILEUNIT = 210_pInt
2015-05-28 22:32:23 +05:30
integer ( pInt ) :: m , c , h , myDebug , myPhase , myHomog
2014-06-23 00:28:29 +05:30
integer ( pInt ) :: &
g , & !< grain number
i , & !< integration point number
2018-10-14 15:57:42 +05:30
e !< element number
integer ( pInt ) , dimension ( : ) , allocatable :: &
2018-11-24 14:23:18 +05:30
CounterPhase , &
CounterHomogenization
2014-09-23 02:06:55 +05:30
2012-07-05 15:24:50 +05:30
myDebug = debug_level ( debug_material )
2015-10-14 00:22:01 +05:30
2018-06-02 13:09:05 +05:30
write ( 6 , '(/,a)' ) ' <<<+- material init -+>>>'
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2012-02-01 00:48:55 +05:30
#include "compilation_info.f90"
2013-01-18 17:00:52 +05:30
2018-06-11 03:46:48 +05:30
call material_parsePhase ( )
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) write ( 6 , '(a)' ) ' Phase parsed' ; flush ( 6 )
call material_parseMicrostructure ( )
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) write ( 6 , '(a)' ) ' Microstructure parsed' ; flush ( 6 )
call material_parseCrystallite ( )
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) write ( 6 , '(a)' ) ' Crystallite parsed' ; flush ( 6 )
call material_parseHomogenization ( )
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) write ( 6 , '(a)' ) ' Homogenization parsed' ; flush ( 6 )
call material_parseTexture ( )
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) write ( 6 , '(a)' ) ' Texture parsed' ; flush ( 6 )
2018-06-02 22:57:03 +05:30
2018-06-27 00:24:54 +05:30
allocate ( plasticState ( size ( config_phase ) ) )
allocate ( sourceState ( size ( config_phase ) ) )
do myPhase = 1 , size ( config_phase )
2015-05-28 22:32:23 +05:30
allocate ( sourceState ( myPhase ) % p ( phase_Nsources ( myPhase ) ) )
2015-10-14 00:22:01 +05:30
enddo
2018-06-27 00:24:54 +05:30
allocate ( homogState ( size ( config_homogenization ) ) )
allocate ( thermalState ( size ( config_homogenization ) ) )
allocate ( damageState ( size ( config_homogenization ) ) )
allocate ( thermalMapping ( size ( config_homogenization ) ) )
allocate ( damageMapping ( size ( config_homogenization ) ) )
allocate ( temperature ( size ( config_homogenization ) ) )
allocate ( damage ( size ( config_homogenization ) ) )
allocate ( temperatureRate ( size ( config_homogenization ) ) )
do m = 1_pInt , size ( config_microstructure )
2013-11-27 13:35:23 +05:30
if ( microstructure_crystallite ( m ) < 1_pInt . or . &
2018-06-27 00:24:54 +05:30
microstructure_crystallite ( m ) > size ( config_crystallite ) ) &
2013-11-27 13:35:23 +05:30
call IO_error ( 150_pInt , m , ext_msg = 'crystallite' )
if ( minval ( microstructure_phase ( 1 : microstructure_Nconstituents ( m ) , m ) ) < 1_pInt . or . &
2018-06-27 00:24:54 +05:30
maxval ( microstructure_phase ( 1 : microstructure_Nconstituents ( m ) , m ) ) > size ( config_phase ) ) &
2013-11-27 13:35:23 +05:30
call IO_error ( 150_pInt , m , ext_msg = 'phase' )
if ( minval ( microstructure_texture ( 1 : microstructure_Nconstituents ( m ) , m ) ) < 1_pInt . or . &
2018-06-27 00:24:54 +05:30
maxval ( microstructure_texture ( 1 : microstructure_Nconstituents ( m ) , m ) ) > size ( config_texture ) ) &
2013-11-27 13:35:23 +05:30
call IO_error ( 150_pInt , m , ext_msg = 'texture' )
2015-10-14 00:22:01 +05:30
if ( microstructure_Nconstituents ( m ) < 1_pInt ) &
2013-11-27 13:35:23 +05:30
call IO_error ( 151_pInt , m )
2009-03-04 17:18:54 +05:30
enddo
2015-10-14 00:22:01 +05:30
2013-03-28 19:20:20 +05:30
debugOut : if ( iand ( myDebug , debug_levelExtensive ) / = 0_pInt ) then
2013-01-18 17:00:52 +05:30
write ( 6 , '(/,a,/)' ) ' MATERIAL configuration'
write ( 6 , '(a32,1x,a16,1x,a6)' ) 'homogenization ' , 'type ' , 'grains'
2018-06-27 00:24:54 +05:30
do h = 1_pInt , size ( config_homogenization )
2013-05-29 22:53:49 +05:30
write ( 6 , '(1x,a32,1x,a16,1x,i6)' ) homogenization_name ( h ) , homogenization_type ( h ) , homogenization_Ngrains ( h )
2013-01-18 17:00:52 +05:30
enddo
2013-05-29 22:53:49 +05:30
write ( 6 , '(/,a14,18x,1x,a11,1x,a12,1x,a13)' ) 'microstructure' , 'crystallite' , 'constituents' , 'homogeneous'
2018-06-27 00:24:54 +05:30
do m = 1_pInt , size ( config_microstructure )
2013-05-29 22:53:49 +05:30
write ( 6 , '(1x,a32,1x,i11,1x,i12,1x,l13)' ) microstructure_name ( m ) , &
2013-03-28 19:20:20 +05:30
microstructure_crystallite ( m ) , &
microstructure_Nconstituents ( m ) , &
microstructure_elemhomo ( m )
if ( microstructure_Nconstituents ( m ) > 0_pInt ) then
do c = 1_pInt , microstructure_Nconstituents ( m )
write ( 6 , '(a1,1x,a32,1x,a32,1x,f7.4)' ) '>' , phase_name ( microstructure_phase ( c , m ) ) , &
texture_name ( microstructure_texture ( c , m ) ) , &
microstructure_fraction ( c , m )
2013-01-18 17:00:52 +05:30
enddo
write ( 6 , * )
endif
enddo
2013-03-28 19:20:20 +05:30
endif debugOut
2015-10-14 00:22:01 +05:30
2012-03-09 01:55:28 +05:30
call material_populateGrains
2009-03-04 17:18:54 +05:30
2018-10-14 15:57:42 +05:30
! BEGIN DEPRECATED
2018-10-14 13:41:26 +05:30
allocate ( phaseAt ( homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( phasememberAt ( homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( mappingHomogenization ( 2 , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( mappingHomogenizationConst ( mesh_nIPsPerElem , mesh_NcpElems ) , source = 1_pInt )
2018-10-14 15:57:42 +05:30
! END DEPRECATED
2015-10-14 00:22:01 +05:30
2018-10-15 08:58:52 +05:30
allocate ( material_homogenizationAt , source = mesh_homogenizationAt )
2018-11-24 14:23:18 +05:30
allocate ( CounterPhase ( size ( config_phase ) ) , source = 0_pInt )
allocate ( CounterHomogenization ( size ( config_homogenization ) ) , source = 0_pInt )
2014-09-18 20:57:52 +05:30
2018-10-14 15:57:42 +05:30
! BEGIN DEPRECATED
do e = 1_pInt , mesh_NcpElems
2018-10-04 09:33:48 +05:30
myHomog = mesh_homogenizationAt ( e )
2018-10-14 15:57:42 +05:30
do i = 1_pInt , mesh_NipsPerElem
2018-11-24 14:23:18 +05:30
CounterHomogenization ( myHomog ) = CounterHomogenization ( myHomog ) + 1_pInt
mappingHomogenization ( 1 : 2 , i , e ) = [ CounterHomogenization ( myHomog ) , myHomog ]
2018-10-14 15:57:42 +05:30
do g = 1_pInt , homogenization_Ngrains ( myHomog )
myPhase = material_phase ( g , i , e )
2018-11-24 14:23:18 +05:30
CounterPhase ( myPhase ) = CounterPhase ( myPhase ) + 1_pInt ! not distinguishing between instances of same phase
2018-10-14 15:57:42 +05:30
phaseAt ( g , i , e ) = myPhase
2018-11-24 14:23:18 +05:30
phasememberAt ( g , i , e ) = CounterPhase ( myPhase )
2018-10-14 15:57:42 +05:30
enddo
enddo
enddo
! END DEPRECATED
2014-06-24 19:21:17 +05:30
2018-10-14 15:57:42 +05:30
! REMOVE !!!!!
2015-05-28 22:32:23 +05:30
! hack needed to initialize field values used during constitutive and crystallite initializations
2018-06-27 00:24:54 +05:30
do myHomog = 1 , size ( config_homogenization )
2015-05-28 22:32:23 +05:30
thermalMapping ( myHomog ) % p = > mappingHomogenizationConst
damageMapping ( myHomog ) % p = > mappingHomogenizationConst
2015-07-24 20:23:50 +05:30
allocate ( temperature ( myHomog ) % p ( 1 ) , source = thermal_initialT ( myHomog ) )
allocate ( damage ( myHomog ) % p ( 1 ) , source = damage_initialPhi ( myHomog ) )
2015-05-28 22:32:23 +05:30
allocate ( temperatureRate ( myHomog ) % p ( 1 ) , source = 0.0_pReal )
2014-09-23 02:06:55 +05:30
enddo
2018-10-14 15:57:42 +05:30
2012-03-09 01:55:28 +05:30
end subroutine material_init
2009-03-04 17:18:54 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2018-06-11 03:46:48 +05:30
!> @brief parses the homogenization part from the material configuration
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2018-06-10 21:31:52 +05:30
subroutine material_parseHomogenization
2018-06-14 10:09:49 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_homogenization
2018-09-24 00:23:35 +05:30
use mesh , only : &
2018-10-04 09:33:48 +05:30
mesh_homogenizationAt
2013-03-28 19:20:20 +05:30
use IO , only : &
2018-06-11 03:46:48 +05:30
IO_error
2015-10-14 00:22:01 +05:30
2009-03-04 17:18:54 +05:30
implicit none
2018-06-10 22:08:31 +05:30
integer ( pInt ) :: h
character ( len = 65536 ) :: tag
2018-06-02 22:57:03 +05:30
2018-06-27 00:24:54 +05:30
allocate ( homogenization_type ( size ( config_homogenization ) ) , source = HOMOGENIZATION_undefined_ID )
allocate ( thermal_type ( size ( config_homogenization ) ) , source = THERMAL_isothermal_ID )
allocate ( damage_type ( size ( config_homogenization ) ) , source = DAMAGE_none_ID )
allocate ( homogenization_typeInstance ( size ( config_homogenization ) ) , source = 0_pInt )
allocate ( thermal_typeInstance ( size ( config_homogenization ) ) , source = 0_pInt )
allocate ( damage_typeInstance ( size ( config_homogenization ) ) , source = 0_pInt )
allocate ( homogenization_Ngrains ( size ( config_homogenization ) ) , source = 0_pInt )
allocate ( homogenization_Noutput ( size ( config_homogenization ) ) , source = 0_pInt )
allocate ( homogenization_active ( size ( config_homogenization ) ) , source = . false . ) !!!!!!!!!!!!!!!
allocate ( thermal_initialT ( size ( config_homogenization ) ) , source = 30 0.0_pReal )
allocate ( damage_initialPhi ( size ( config_homogenization ) ) , source = 1.0_pReal )
2018-09-24 00:23:35 +05:30
forall ( h = 1_pInt : size ( config_homogenization ) ) &
2018-10-04 09:33:48 +05:30
homogenization_active ( h ) = any ( mesh_homogenizationAt == h )
2018-06-27 00:24:54 +05:30
do h = 1_pInt , size ( config_homogenization )
homogenization_Noutput ( h ) = config_homogenization ( h ) % countKeys ( '(output)' )
tag = config_homogenization ( h ) % getString ( 'mech' )
2018-06-11 03:46:48 +05:30
select case ( trim ( tag ) )
case ( HOMOGENIZATION_NONE_label )
homogenization_type ( h ) = HOMOGENIZATION_NONE_ID
homogenization_Ngrains ( h ) = 1_pInt
case ( HOMOGENIZATION_ISOSTRAIN_label )
homogenization_type ( h ) = HOMOGENIZATION_ISOSTRAIN_ID
2018-06-27 00:24:54 +05:30
homogenization_Ngrains ( h ) = config_homogenization ( h ) % getInt ( 'nconstituents' )
2018-06-11 03:46:48 +05:30
case ( HOMOGENIZATION_RGC_label )
homogenization_type ( h ) = HOMOGENIZATION_RGC_ID
2018-06-27 00:24:54 +05:30
homogenization_Ngrains ( h ) = config_homogenization ( h ) % getInt ( 'nconstituents' )
2018-06-11 03:46:48 +05:30
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
homogenization_typeInstance ( h ) = count ( homogenization_type == homogenization_type ( h ) )
2018-06-02 22:57:03 +05:30
2018-06-27 00:24:54 +05:30
if ( config_homogenization ( h ) % keyExists ( 'thermal' ) ) then
thermal_initialT ( h ) = config_homogenization ( h ) % getFloat ( 't0' , defaultVal = 30 0.0_pReal )
2018-06-11 03:46:48 +05:30
2018-06-27 00:24:54 +05:30
tag = config_homogenization ( h ) % getString ( 'thermal' )
2018-06-11 03:46:48 +05:30
select case ( trim ( tag ) )
case ( THERMAL_isothermal_label )
thermal_type ( h ) = THERMAL_isothermal_ID
case ( THERMAL_adiabatic_label )
thermal_type ( h ) = THERMAL_adiabatic_ID
case ( THERMAL_conduction_label )
thermal_type ( h ) = THERMAL_conduction_ID
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
endif
2015-05-28 22:32:23 +05:30
2018-06-27 00:24:54 +05:30
if ( config_homogenization ( h ) % keyExists ( 'damage' ) ) then
damage_initialPhi ( h ) = config_homogenization ( h ) % getFloat ( 'initialdamage' , defaultVal = 1.0_pReal )
2018-06-11 03:46:48 +05:30
2018-06-27 00:24:54 +05:30
tag = config_homogenization ( h ) % getString ( 'damage' )
2018-06-11 03:46:48 +05:30
select case ( trim ( tag ) )
case ( DAMAGE_NONE_label )
damage_type ( h ) = DAMAGE_none_ID
case ( DAMAGE_LOCAL_label )
damage_type ( h ) = DAMAGE_local_ID
case ( DAMAGE_NONLOCAL_label )
damage_type ( h ) = DAMAGE_nonlocal_ID
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
endif
2009-03-04 17:18:54 +05:30
enddo
2018-06-27 00:24:54 +05:30
do h = 1_pInt , size ( config_homogenization )
2018-06-02 22:57:03 +05:30
homogenization_typeInstance ( h ) = count ( homogenization_type ( 1 : h ) == homogenization_type ( h ) )
thermal_typeInstance ( h ) = count ( thermal_type ( 1 : h ) == thermal_type ( h ) )
damage_typeInstance ( h ) = count ( damage_type ( 1 : h ) == damage_type ( h ) )
2015-05-28 22:32:23 +05:30
enddo
2013-06-27 00:49:00 +05:30
homogenization_maxNgrains = maxval ( homogenization_Ngrains , homogenization_active )
2009-03-04 17:18:54 +05:30
2018-06-10 21:31:52 +05:30
end subroutine material_parseHomogenization
2009-03-04 17:18:54 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief parses the microstructure part in the material configuration file
!--------------------------------------------------------------------------------------------------
2018-06-10 21:31:52 +05:30
subroutine material_parseMicrostructure
2017-04-25 16:04:14 +05:30
use prec , only : &
dNeq
2018-06-11 03:46:48 +05:30
use IO , only : &
IO_floatValue , &
IO_intValue , &
IO_stringValue , &
2018-06-19 22:08:32 +05:30
IO_stringPos , &
2018-06-11 03:46:48 +05:30
IO_error
2018-06-27 00:03:02 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_microstructure , &
2018-06-27 00:03:02 +05:30
microstructure_name
2013-01-18 17:00:52 +05:30
use mesh , only : &
2018-10-04 09:33:48 +05:30
mesh_microstructureAt , &
2013-01-18 17:00:52 +05:30
mesh_NcpElems
2015-10-14 00:22:01 +05:30
2009-03-04 17:18:54 +05:30
implicit none
2018-06-11 03:46:48 +05:30
character ( len = 65536 ) , dimension ( : ) , allocatable :: &
2018-07-04 02:28:49 +05:30
strings
2018-06-19 22:08:32 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2018-06-11 03:46:48 +05:30
integer ( pInt ) :: e , m , c , i
2013-12-12 22:39:59 +05:30
character ( len = 65536 ) :: &
2018-06-11 03:46:48 +05:30
tag
2010-02-25 23:09:11 +05:30
2018-06-27 00:24:54 +05:30
allocate ( microstructure_crystallite ( size ( config_microstructure ) ) , source = 0_pInt )
allocate ( microstructure_Nconstituents ( size ( config_microstructure ) ) , source = 0_pInt )
allocate ( microstructure_active ( size ( config_microstructure ) ) , source = . false . )
allocate ( microstructure_elemhomo ( size ( config_microstructure ) ) , source = . false . )
2009-07-22 21:37:19 +05:30
2018-10-04 09:33:48 +05:30
if ( any ( mesh_microstructureAt > size ( config_microstructure ) ) ) &
2017-04-14 04:31:42 +05:30
call IO_error ( 155_pInt , ext_msg = 'More microstructures in geometry than sections in material.config' )
2014-05-15 15:10:43 +05:30
2018-09-24 00:23:35 +05:30
forall ( e = 1_pInt : mesh_NcpElems ) &
2018-10-04 09:33:48 +05:30
microstructure_active ( mesh_microstructureAt ( e ) ) = . true . ! current microstructure used in model? Elementwise view, maximum N operations for N elements
2015-10-14 00:22:01 +05:30
2018-06-27 00:24:54 +05:30
do m = 1_pInt , size ( config_microstructure )
microstructure_Nconstituents ( m ) = config_microstructure ( m ) % countKeys ( '(constituent)' )
microstructure_crystallite ( m ) = config_microstructure ( m ) % getInt ( 'crystallite' )
microstructure_elemhomo ( m ) = config_microstructure ( m ) % keyExists ( '/elementhomogeneous/' )
2018-06-02 16:53:42 +05:30
enddo
2015-10-14 00:22:01 +05:30
2018-06-02 16:53:42 +05:30
microstructure_maxNconstituents = maxval ( microstructure_Nconstituents )
2018-06-27 00:24:54 +05:30
allocate ( microstructure_phase ( microstructure_maxNconstituents , size ( config_microstructure ) ) , source = 0_pInt )
allocate ( microstructure_texture ( microstructure_maxNconstituents , size ( config_microstructure ) ) , source = 0_pInt )
allocate ( microstructure_fraction ( microstructure_maxNconstituents , size ( config_microstructure ) ) , source = 0.0_pReal )
2015-10-14 00:22:01 +05:30
2018-07-04 02:28:49 +05:30
allocate ( strings ( 1 ) ) ! Intel 16.0 Bug
2018-06-27 00:24:54 +05:30
do m = 1_pInt , size ( config_microstructure )
2018-07-04 02:28:49 +05:30
strings = config_microstructure ( m ) % getStrings ( '(constituent)' , raw = . true . )
do c = 1_pInt , size ( strings )
chunkPos = IO_stringPos ( strings ( c ) )
2018-06-19 22:08:32 +05:30
do i = 1_pInt , 5_pInt , 2_pInt
2018-07-04 02:28:49 +05:30
tag = IO_stringValue ( strings ( c ) , chunkPos , i )
2018-06-11 03:46:48 +05:30
select case ( tag )
case ( 'phase' )
2018-07-04 02:28:49 +05:30
microstructure_phase ( c , m ) = IO_intValue ( strings ( c ) , chunkPos , i + 1_pInt )
2018-06-11 03:46:48 +05:30
case ( 'texture' )
2018-07-04 02:28:49 +05:30
microstructure_texture ( c , m ) = IO_intValue ( strings ( c ) , chunkPos , i + 1_pInt )
2018-06-11 03:46:48 +05:30
case ( 'fraction' )
2018-07-04 02:28:49 +05:30
microstructure_fraction ( c , m ) = IO_floatValue ( strings ( c ) , chunkPos , i + 1_pInt )
2018-06-11 03:46:48 +05:30
end select
enddo
enddo
enddo
2009-03-04 17:18:54 +05:30
2018-06-27 00:24:54 +05:30
do m = 1_pInt , size ( config_microstructure )
2018-06-02 16:53:42 +05:30
if ( dNeq ( sum ( microstructure_fraction ( : , m ) ) , 1.0_pReal ) ) &
call IO_error ( 153_pInt , ext_msg = microstructure_name ( m ) )
enddo
2018-06-27 00:03:02 +05:30
2018-06-10 21:31:52 +05:30
end subroutine material_parseMicrostructure
2009-03-04 17:18:54 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief parses the crystallite part in the material configuration file
!--------------------------------------------------------------------------------------------------
2018-06-10 21:31:52 +05:30
subroutine material_parseCrystallite
2018-06-27 00:03:02 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_crystallite
2010-02-25 23:09:11 +05:30
2012-03-09 01:55:28 +05:30
implicit none
2018-06-02 16:53:42 +05:30
integer ( pInt ) :: c
2012-06-26 15:54:54 +05:30
2018-06-27 00:24:54 +05:30
allocate ( crystallite_Noutput ( size ( config_crystallite ) ) , source = 0_pInt )
do c = 1_pInt , size ( config_crystallite )
crystallite_Noutput ( c ) = config_crystallite ( c ) % countKeys ( '(output)' )
2018-06-02 16:53:42 +05:30
enddo
2018-06-10 21:31:52 +05:30
end subroutine material_parseCrystallite
2010-02-25 23:09:11 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief parses the phase part in the material configuration file
!--------------------------------------------------------------------------------------------------
2018-06-10 21:31:52 +05:30
subroutine material_parsePhase
2013-03-28 19:20:20 +05:30
use IO , only : &
IO_error , &
IO_getTag , &
2018-06-10 22:08:31 +05:30
IO_stringValue
2018-06-27 00:03:02 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_phase
2013-03-28 19:20:20 +05:30
2009-03-04 17:18:54 +05:30
implicit none
2018-06-02 16:53:42 +05:30
integer ( pInt ) :: sourceCtr , kinematicsCtr , stiffDegradationCtr , p
2018-06-22 02:09:18 +05:30
character ( len = 65536 ) , dimension ( : ) , allocatable :: str
2012-06-26 15:54:54 +05:30
2015-10-14 00:22:01 +05:30
2018-06-27 00:24:54 +05:30
allocate ( phase_elasticity ( size ( config_phase ) ) , source = ELASTICITY_undefined_ID )
allocate ( phase_plasticity ( size ( config_phase ) ) , source = PLASTICITY_undefined_ID )
allocate ( phase_Nsources ( size ( config_phase ) ) , source = 0_pInt )
allocate ( phase_Nkinematics ( size ( config_phase ) ) , source = 0_pInt )
allocate ( phase_NstiffnessDegradations ( size ( config_phase ) ) , source = 0_pInt )
allocate ( phase_Noutput ( size ( config_phase ) ) , source = 0_pInt )
allocate ( phase_localPlasticity ( size ( config_phase ) ) , source = . false . )
2018-06-02 16:53:42 +05:30
2018-06-27 00:24:54 +05:30
do p = 1_pInt , size ( config_phase )
phase_Noutput ( p ) = config_phase ( p ) % countKeys ( '(output)' )
phase_Nsources ( p ) = config_phase ( p ) % countKeys ( '(source)' )
phase_Nkinematics ( p ) = config_phase ( p ) % countKeys ( '(kinematics)' )
phase_NstiffnessDegradations ( p ) = config_phase ( p ) % countKeys ( '(stiffness_degradation)' )
phase_localPlasticity ( p ) = . not . config_phase ( p ) % KeyExists ( '/nonlocal/' )
2018-06-02 13:09:05 +05:30
2018-06-27 00:24:54 +05:30
select case ( config_phase ( p ) % getString ( 'elasticity' ) )
2018-06-02 13:09:05 +05:30
case ( ELASTICITY_HOOKE_label )
phase_elasticity ( p ) = ELASTICITY_HOOKE_ID
case default
2018-06-27 00:24:54 +05:30
call IO_error ( 200_pInt , ext_msg = trim ( config_phase ( p ) % getString ( 'elasticity' ) ) )
2018-06-02 13:09:05 +05:30
end select
2018-06-27 00:24:54 +05:30
select case ( config_phase ( p ) % getString ( 'plasticity' ) )
2018-06-02 13:09:05 +05:30
case ( PLASTICITY_NONE_label )
phase_plasticity ( p ) = PLASTICITY_NONE_ID
case ( PLASTICITY_ISOTROPIC_label )
phase_plasticity ( p ) = PLASTICITY_ISOTROPIC_ID
case ( PLASTICITY_PHENOPOWERLAW_label )
phase_plasticity ( p ) = PLASTICITY_PHENOPOWERLAW_ID
case ( PLASTICITY_KINEHARDENING_label )
phase_plasticity ( p ) = PLASTICITY_KINEHARDENING_ID
case ( PLASTICITY_DISLOTWIN_label )
phase_plasticity ( p ) = PLASTICITY_DISLOTWIN_ID
case ( PLASTICITY_DISLOUCLA_label )
phase_plasticity ( p ) = PLASTICITY_DISLOUCLA_ID
case ( PLASTICITY_NONLOCAL_label )
phase_plasticity ( p ) = PLASTICITY_NONLOCAL_ID
case default
2018-06-27 00:24:54 +05:30
call IO_error ( 201_pInt , ext_msg = trim ( config_phase ( p ) % getString ( 'plasticity' ) ) )
2018-06-02 13:09:05 +05:30
end select
enddo
2018-06-27 00:24:54 +05:30
allocate ( phase_source ( maxval ( phase_Nsources ) , size ( config_phase ) ) , source = SOURCE_undefined_ID )
allocate ( phase_kinematics ( maxval ( phase_Nkinematics ) , size ( config_phase ) ) , source = KINEMATICS_undefined_ID )
allocate ( phase_stiffnessDegradation ( maxval ( phase_NstiffnessDegradations ) , size ( config_phase ) ) , &
2018-06-02 13:09:05 +05:30
source = STIFFNESS_DEGRADATION_undefined_ID )
2018-06-27 00:24:54 +05:30
do p = 1_pInt , size ( config_phase )
2018-06-22 11:33:22 +05:30
#if defined(__GFORTRAN__)
str = [ 'GfortranBug86277' ]
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(source)' , defaultVal = str )
2018-06-22 11:33:22 +05:30
if ( str ( 1 ) == 'GfortranBug86277' ) str = [ character ( len = 65536 ) :: ]
#else
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(source)' , defaultVal = [ character ( len = 65536 ) :: ] )
2018-06-22 11:33:22 +05:30
#endif
2018-06-22 03:19:07 +05:30
do sourceCtr = 1_pInt , size ( str )
select case ( trim ( str ( sourceCtr ) ) )
case ( SOURCE_thermal_dissipation_label )
phase_source ( sourceCtr , p ) = SOURCE_thermal_dissipation_ID
case ( SOURCE_thermal_externalheat_label )
phase_source ( sourceCtr , p ) = SOURCE_thermal_externalheat_ID
case ( SOURCE_damage_isoBrittle_label )
phase_source ( sourceCtr , p ) = SOURCE_damage_isoBrittle_ID
case ( SOURCE_damage_isoDuctile_label )
phase_source ( sourceCtr , p ) = SOURCE_damage_isoDuctile_ID
case ( SOURCE_damage_anisoBrittle_label )
phase_source ( sourceCtr , p ) = SOURCE_damage_anisoBrittle_ID
case ( SOURCE_damage_anisoDuctile_label )
phase_source ( sourceCtr , p ) = SOURCE_damage_anisoDuctile_ID
end select
enddo
2018-06-22 11:33:22 +05:30
#if defined(__GFORTRAN__)
str = [ 'GfortranBug86277' ]
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(kinematics)' , defaultVal = str )
2018-06-22 11:33:22 +05:30
if ( str ( 1 ) == 'GfortranBug86277' ) str = [ character ( len = 65536 ) :: ]
#else
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(kinematics)' , defaultVal = [ character ( len = 65536 ) :: ] )
2018-06-22 11:33:22 +05:30
#endif
2018-06-22 03:19:07 +05:30
do kinematicsCtr = 1_pInt , size ( str )
select case ( trim ( str ( kinematicsCtr ) ) )
case ( KINEMATICS_cleavage_opening_label )
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_cleavage_opening_ID
case ( KINEMATICS_slipplane_opening_label )
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_slipplane_opening_ID
case ( KINEMATICS_thermal_expansion_label )
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_thermal_expansion_ID
end select
enddo
2018-06-22 11:33:22 +05:30
#if defined(__GFORTRAN__)
str = [ 'GfortranBug86277' ]
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(stiffness_degradation)' , defaultVal = str )
2018-06-22 11:33:22 +05:30
if ( str ( 1 ) == 'GfortranBug86277' ) str = [ character ( len = 65536 ) :: ]
#else
2018-06-27 00:24:54 +05:30
str = config_phase ( p ) % getStrings ( '(stiffness_degradation)' , defaultVal = [ character ( len = 65536 ) :: ] )
2018-06-22 11:33:22 +05:30
#endif
2018-06-22 03:19:07 +05:30
do stiffDegradationCtr = 1_pInt , size ( str )
select case ( trim ( str ( stiffDegradationCtr ) ) )
case ( STIFFNESS_DEGRADATION_damage_label )
phase_stiffnessDegradation ( stiffDegradationCtr , p ) = STIFFNESS_DEGRADATION_damage_ID
end select
enddo
2009-03-04 17:18:54 +05:30
enddo
2018-06-27 00:24:54 +05:30
allocate ( phase_plasticityInstance ( size ( config_phase ) ) , source = 0_pInt )
allocate ( phase_elasticityInstance ( size ( config_phase ) ) , source = 0_pInt )
2018-06-02 13:09:05 +05:30
2018-06-27 00:24:54 +05:30
do p = 1_pInt , size ( config_phase )
2015-05-28 22:32:23 +05:30
phase_elasticityInstance ( p ) = count ( phase_elasticity ( 1 : p ) == phase_elasticity ( p ) )
phase_plasticityInstance ( p ) = count ( phase_plasticity ( 1 : p ) == phase_plasticity ( p ) )
2014-10-15 17:52:09 +05:30
enddo
2009-03-04 17:18:54 +05:30
2018-06-10 21:31:52 +05:30
end subroutine material_parsePhase
2014-10-15 17:52:09 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief parses the texture part in the material configuration file
!--------------------------------------------------------------------------------------------------
2018-06-10 21:31:52 +05:30
subroutine material_parseTexture
2016-11-17 02:38:19 +05:30
use prec , only : &
dNeq
2013-03-28 19:20:20 +05:30
use IO , only : &
IO_error , &
2013-12-12 22:39:59 +05:30
IO_stringPos , &
2018-06-10 22:08:31 +05:30
IO_floatValue , &
IO_stringValue
2018-06-27 00:03:02 +05:30
use config , only : &
2018-08-22 18:00:51 +05:30
config_deallocate , &
2018-08-22 15:21:23 +05:30
config_texture
2013-01-18 17:00:52 +05:30
use math , only : &
inRad , &
2013-05-02 14:05:37 +05:30
math_sampleRandomOri , &
math_I3 , &
2018-06-11 03:53:43 +05:30
math_det33
2015-10-14 00:22:01 +05:30
2009-03-04 17:18:54 +05:30
implicit none
2018-06-10 22:08:31 +05:30
integer ( pInt ) :: section , gauss , fiber , j , t , i
2018-06-25 18:58:15 +05:30
character ( len = 65536 ) , dimension ( : ) , allocatable :: strings ! Values for given key in material config
2018-06-10 22:08:31 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: chunkPos
2018-06-03 14:14:20 +05:30
2018-06-27 00:24:54 +05:30
allocate ( texture_symmetry ( size ( config_texture ) ) , source = 1_pInt )
allocate ( texture_Ngauss ( size ( config_texture ) ) , source = 0_pInt )
allocate ( texture_Nfiber ( size ( config_texture ) ) , source = 0_pInt )
2010-02-25 23:09:11 +05:30
2018-06-27 00:24:54 +05:30
do t = 1_pInt , size ( config_texture )
texture_Ngauss ( t ) = config_texture ( t ) % countKeys ( '(gauss)' ) &
+ config_texture ( t ) % countKeys ( '(random)' )
texture_Nfiber ( t ) = config_texture ( t ) % countKeys ( '(fiber)' )
2018-06-03 14:14:20 +05:30
enddo
2009-03-04 17:18:54 +05:30
texture_maxNgauss = maxval ( texture_Ngauss )
texture_maxNfiber = maxval ( texture_Nfiber )
2018-06-27 00:24:54 +05:30
allocate ( texture_Gauss ( 5 , texture_maxNgauss , size ( config_texture ) ) , source = 0.0_pReal )
allocate ( texture_Fiber ( 6 , texture_maxNfiber , size ( config_texture ) ) , source = 0.0_pReal )
allocate ( texture_transformation ( 3 , 3 , size ( config_texture ) ) , source = 0.0_pReal )
texture_transformation = spread ( math_I3 , 3 , size ( config_texture ) )
2015-10-14 00:22:01 +05:30
2018-06-27 00:24:54 +05:30
do t = 1_pInt , size ( config_texture )
2018-06-03 14:14:20 +05:30
section = t
gauss = 0_pInt
fiber = 0_pInt
2018-06-19 22:46:03 +05:30
2018-06-27 00:24:54 +05:30
if ( config_texture ( t ) % keyExists ( 'axes' ) ) then
strings = config_texture ( t ) % getStrings ( 'axes' )
2018-06-19 22:46:03 +05:30
do j = 1_pInt , 3_pInt ! look for "x", "y", and "z" entries
2018-06-25 18:58:15 +05:30
select case ( strings ( j ) )
2018-06-19 22:46:03 +05:30
case ( 'x' , '+x' )
texture_transformation ( j , 1 : 3 , t ) = [ 1.0_pReal , 0.0_pReal , 0.0_pReal ] ! original axis is now +x-axis
case ( '-x' )
texture_transformation ( j , 1 : 3 , t ) = [ - 1.0_pReal , 0.0_pReal , 0.0_pReal ] ! original axis is now -x-axis
case ( 'y' , '+y' )
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 1.0_pReal , 0.0_pReal ] ! original axis is now +y-axis
case ( '-y' )
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , - 1.0_pReal , 0.0_pReal ] ! original axis is now -y-axis
case ( 'z' , '+z' )
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 0.0_pReal , 1.0_pReal ] ! original axis is now +z-axis
case ( '-z' )
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 0.0_pReal , - 1.0_pReal ] ! original axis is now -z-axis
case default
call IO_error ( 157_pInt , t )
end select
enddo
if ( dNeq ( math_det33 ( texture_transformation ( 1 : 3 , 1 : 3 , t ) ) , 1.0_pReal ) ) call IO_error ( 157_pInt , t )
endif
2018-06-27 00:24:54 +05:30
if ( config_texture ( t ) % keyExists ( 'symmetry' ) ) then
select case ( config_texture ( t ) % getString ( 'symmetry' ) )
2018-06-19 22:46:03 +05:30
case ( 'orthotropic' )
texture_symmetry ( t ) = 4_pInt
case ( 'monoclinic' )
texture_symmetry ( t ) = 2_pInt
case default
texture_symmetry ( t ) = 1_pInt
end select
endif
2018-06-27 00:24:54 +05:30
if ( config_texture ( t ) % keyExists ( '(random)' ) ) then
strings = config_texture ( t ) % getStrings ( '(random)' , raw = . true . )
2018-06-25 18:58:15 +05:30
do i = 1_pInt , size ( strings )
2018-06-19 22:46:03 +05:30
gauss = gauss + 1_pInt
texture_Gauss ( 1 : 3 , gauss , t ) = math_sampleRandomOri ( )
2018-06-25 18:58:15 +05:30
chunkPos = IO_stringPos ( strings ( i ) )
2018-06-19 22:46:03 +05:30
do j = 1_pInt , 3_pInt , 2_pInt
2018-06-25 18:58:15 +05:30
select case ( IO_stringValue ( strings ( i ) , chunkPos , j ) )
2018-06-19 22:46:03 +05:30
case ( 'scatter' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 4 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2018-06-19 22:46:03 +05:30
case ( 'fraction' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 5 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt )
2018-06-19 22:46:03 +05:30
end select
enddo
enddo
endif
2018-06-25 18:58:15 +05:30
2018-06-27 00:24:54 +05:30
if ( config_texture ( t ) % keyExists ( '(gauss)' ) ) then
2018-06-25 18:58:15 +05:30
gauss = gauss + 1_pInt
2018-06-27 00:24:54 +05:30
strings = config_texture ( t ) % getStrings ( '(gauss)' , raw = . true . )
2018-06-25 18:58:15 +05:30
do i = 1_pInt , size ( strings )
chunkPos = IO_stringPos ( strings ( i ) )
do j = 1_pInt , 9_pInt , 2_pInt
select case ( IO_stringValue ( strings ( i ) , chunkPos , j ) )
2009-03-04 17:18:54 +05:30
case ( 'phi1' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 1 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'phi' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 2 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'phi2' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 3 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'scatter' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 4 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'fraction' )
2018-06-25 18:58:15 +05:30
texture_Gauss ( 5 , gauss , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt )
end select
enddo
enddo
endif
2018-06-27 00:24:54 +05:30
if ( config_texture ( t ) % keyExists ( '(fiber)' ) ) then
2018-06-26 11:50:40 +05:30
fiber = fiber + 1_pInt
2018-06-27 00:24:54 +05:30
strings = config_texture ( t ) % getStrings ( '(fiber)' , raw = . true . )
2018-06-25 18:58:15 +05:30
do i = 1_pInt , size ( strings )
chunkPos = IO_stringPos ( strings ( i ) )
do j = 1_pInt , 11_pInt , 2_pInt
select case ( IO_stringValue ( strings ( i ) , chunkPos , j ) )
2009-04-28 15:15:52 +05:30
case ( 'alpha1' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 1 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'alpha2' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 2 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'beta1' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 3 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'beta2' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 4 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'scatter' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 5 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'fraction' )
2018-06-25 18:58:15 +05:30
texture_Fiber ( 6 , fiber , t ) = IO_floatValue ( strings ( i ) , chunkPos , j + 1_pInt )
end select
enddo
enddo
endif
enddo
2018-06-27 00:20:06 +05:30
2018-08-22 18:00:51 +05:30
call config_deallocate ( 'material.config/texture' )
2009-03-04 17:18:54 +05:30
2018-06-10 21:31:52 +05:30
end subroutine material_parseTexture
2009-03-04 17:18:54 +05:30
2018-10-14 23:46:30 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief allocates the plastic state of a phase
!--------------------------------------------------------------------------------------------------
2019-01-25 05:15:25 +05:30
subroutine material_allocatePlasticState ( phase , NofMyPhase , &
sizeState , sizeDotState , sizeDeltaState , &
2018-10-14 23:46:30 +05:30
Nslip , Ntwin , Ntrans )
use numerics , only : &
numerics_integrator2 = > numerics_integrator ! compatibility hack
implicit none
integer ( pInt ) , intent ( in ) :: &
phase , &
NofMyPhase , &
sizeState , &
sizeDotState , &
sizeDeltaState , &
Nslip , &
Ntwin , &
Ntrans
integer ( pInt ) :: numerics_integrator ! compatibility hack
numerics_integrator = numerics_integrator2 ( 1 ) ! compatibility hack
2019-01-25 05:15:25 +05:30
plasticState ( phase ) % sizeState = sizeState
plasticState ( phase ) % sizeDotState = sizeDotState
plasticState ( phase ) % sizeDeltaState = sizeDeltaState
plasticState ( phase ) % offsetDeltaState = sizeState - sizeDeltaState ! deltaState occupies latter part of state by definition
2018-10-14 23:46:30 +05:30
plasticState ( phase ) % Nslip = Nslip
plasticState ( phase ) % Ntwin = Ntwin
plasticState ( phase ) % Ntrans = Ntrans
allocate ( plasticState ( phase ) % aTolState ( sizeState ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % state0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % partionedState0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % subState0 ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % state ( sizeState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % dotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
if ( numerics_integrator == 1_pInt ) then
allocate ( plasticState ( phase ) % previousDotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % previousDotState2 ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
endif
if ( numerics_integrator == 4_pInt ) &
allocate ( plasticState ( phase ) % RK4dotState ( sizeDotState , NofMyPhase ) , source = 0.0_pReal )
if ( numerics_integrator == 5_pInt ) &
allocate ( plasticState ( phase ) % RKCK45dotState ( 6 , sizeDotState , NofMyPhase ) , source = 0.0_pReal )
allocate ( plasticState ( phase ) % deltaState ( sizeDeltaState , NofMyPhase ) , source = 0.0_pReal )
end subroutine material_allocatePlasticState
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief populates the grains
!> @details populates the grains by identifying active microstructure/homogenization pairs,
2018-10-14 13:41:26 +05:30
!! calculates the volume of the grains and deals with texture components
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2012-03-09 01:55:28 +05:30
subroutine material_populateGrains
2016-05-27 15:16:34 +05:30
use prec , only : &
dEq
2013-01-18 17:00:52 +05:30
use math , only : &
2013-05-29 22:53:49 +05:30
math_RtoEuler , &
math_EulerToR , &
math_mul33x33 , &
math_range , &
2013-01-18 17:00:52 +05:30
math_sampleRandomOri , &
math_sampleGaussOri , &
math_sampleFiberOri , &
math_symmetricEulers
use mesh , only : &
2018-09-24 00:23:35 +05:30
mesh_NipsPerElem , &
mesh_elemType , &
2018-10-04 09:33:48 +05:30
mesh_homogenizationAt , &
mesh_microstructureAt , &
2013-01-18 17:00:52 +05:30
mesh_NcpElems , &
mesh_ipVolume , &
FE_geomtype
2018-06-27 00:03:02 +05:30
use config , only : &
2018-06-27 00:24:54 +05:30
config_homogenization , &
config_microstructure , &
2018-08-22 18:00:51 +05:30
config_deallocate , &
2018-06-27 00:03:02 +05:30
homogenization_name , &
microstructure_name
2013-01-18 17:00:52 +05:30
use IO , only : &
2018-10-14 13:41:26 +05:30
IO_error
2013-01-18 17:00:52 +05:30
use debug , only : &
debug_level , &
debug_material , &
debug_levelBasic
2015-10-14 00:22:01 +05:30
2009-03-04 17:18:54 +05:30
implicit none
integer ( pInt ) , dimension ( : , : ) , allocatable :: Ngrains
2013-05-29 22:53:49 +05:30
integer ( pInt ) , dimension ( microstructure_maxNconstituents ) :: &
NgrainsOfConstituent , &
currentGrainOfConstituent , &
randomOrder
real ( pReal ) , dimension ( microstructure_maxNconstituents ) :: &
rndArray
2010-02-18 21:24:10 +05:30
real ( pReal ) , dimension ( : ) , allocatable :: volumeOfGrain
2009-03-04 17:18:54 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable :: orientationOfGrain
2012-03-09 01:55:28 +05:30
real ( pReal ) , dimension ( 3 ) :: orientation
real ( pReal ) , dimension ( 3 , 3 ) :: symOrientation
2011-03-22 19:10:27 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: phaseOfGrain , textureOfGrain
2014-09-23 02:06:55 +05:30
integer ( pInt ) :: t , e , i , g , j , m , c , r , homog , micro , sgn , hme , myDebug , &
2013-05-29 22:53:49 +05:30
phaseID , textureID , dGrains , myNgrains , myNorientations , myNconstituents , &
2014-09-23 02:06:55 +05:30
grain , constituentGrain , ipGrain , symExtension , ip
2016-04-08 20:46:20 +05:30
real ( pReal ) :: deviation , extreme , rnd
2018-08-04 05:09:14 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable :: Nelems ! counts number of elements in homog, micro array
type ( group_int ) , dimension ( : , : ) , allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array
2009-03-04 17:18:54 +05:30
2012-07-05 15:24:50 +05:30
myDebug = debug_level ( debug_material )
2015-10-14 00:22:01 +05:30
2018-10-14 13:41:26 +05:30
allocate ( material_volume ( homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( material_phase ( homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( material_homog ( mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( material_texture ( homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0_pInt )
allocate ( material_EulerAngles ( 3 , homogenization_maxNgrains , mesh_nIPsPerElem , mesh_NcpElems ) , source = 0.0_pReal )
2015-10-14 00:22:01 +05:30
2018-06-27 00:24:54 +05:30
allocate ( Ngrains ( size ( config_homogenization ) , size ( config_microstructure ) ) , source = 0_pInt )
allocate ( Nelems ( size ( config_homogenization ) , size ( config_microstructure ) ) , source = 0_pInt )
2015-10-14 00:22:01 +05:30
2014-08-21 23:18:20 +05:30
! populating homogenization schemes in each
!--------------------------------------------------------------------------------------------------
do e = 1_pInt , mesh_NcpElems
2018-10-04 09:33:48 +05:30
material_homog ( 1_pInt : mesh_NipsPerElem , e ) = mesh_homogenizationAt ( e )
2014-08-21 23:18:20 +05:30
enddo
2015-10-14 00:22:01 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2012-01-12 22:01:23 +05:30
! precounting of elements for each homog/micro pair
2012-02-16 00:28:38 +05:30
do e = 1_pInt , mesh_NcpElems
2018-10-04 09:33:48 +05:30
homog = mesh_homogenizationAt ( e )
micro = mesh_microstructureAt ( e )
2012-01-12 22:01:23 +05:30
Nelems ( homog , micro ) = Nelems ( homog , micro ) + 1_pInt
2012-01-12 16:06:17 +05:30
enddo
2018-06-27 00:24:54 +05:30
allocate ( elemsOfHomogMicro ( size ( config_homogenization ) , size ( config_microstructure ) ) )
do homog = 1 , size ( config_homogenization )
do micro = 1 , size ( config_microstructure )
2013-02-25 18:43:52 +05:30
if ( Nelems ( homog , micro ) > 0_pInt ) then
allocate ( elemsOfHomogMicro ( homog , micro ) % p ( Nelems ( homog , micro ) ) )
elemsOfHomogMicro ( homog , micro ) % p = 0_pInt
endif
enddo
enddo
2012-01-12 22:01:23 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2012-01-12 22:01:23 +05:30
! identify maximum grain count per IP (from element) and find grains per homog/micro pair
2013-01-18 17:00:52 +05:30
Nelems = 0_pInt ! reuse as counter
2013-03-28 19:20:20 +05:30
elementLooping : do e = 1_pInt , mesh_NcpElems
2018-09-24 00:23:35 +05:30
t = mesh_elemType
2018-10-04 09:33:48 +05:30
homog = mesh_homogenizationAt ( e )
micro = mesh_microstructureAt ( e )
2018-06-27 00:24:54 +05:30
if ( homog < 1_pInt . or . homog > size ( config_homogenization ) ) & ! out of bounds
2012-02-13 23:11:27 +05:30
call IO_error ( 154_pInt , e , 0_pInt , 0_pInt )
2018-06-27 00:24:54 +05:30
if ( micro < 1_pInt . or . micro > size ( config_microstructure ) ) & ! out of bounds
2012-02-13 23:11:27 +05:30
call IO_error ( 155_pInt , e , 0_pInt , 0_pInt )
2013-05-29 22:53:49 +05:30
if ( microstructure_elemhomo ( micro ) ) then ! how many grains are needed at this element?
dGrains = homogenization_Ngrains ( homog ) ! only one set of Ngrains (other IPs are plain copies)
2009-11-24 20:30:25 +05:30
else
2018-09-24 00:23:35 +05:30
dGrains = homogenization_Ngrains ( homog ) * mesh_NipsPerElem ! each IP has Ngrains
2009-11-24 20:30:25 +05:30
endif
2013-05-29 22:53:49 +05:30
Ngrains ( homog , micro ) = Ngrains ( homog , micro ) + dGrains ! total grain count
Nelems ( homog , micro ) = Nelems ( homog , micro ) + 1_pInt ! total element count
2013-02-25 18:43:52 +05:30
elemsOfHomogMicro ( homog , micro ) % p ( Nelems ( homog , micro ) ) = e ! remember elements active in this homog/micro pair
2013-03-28 19:20:20 +05:30
enddo elementLooping
2015-10-14 00:22:01 +05:30
2013-12-13 04:33:37 +05:30
allocate ( volumeOfGrain ( maxval ( Ngrains ) ) , source = 0.0_pReal ) ! reserve memory for maximum case
allocate ( phaseOfGrain ( maxval ( Ngrains ) ) , source = 0_pInt ) ! reserve memory for maximum case
allocate ( textureOfGrain ( maxval ( Ngrains ) ) , source = 0_pInt ) ! reserve memory for maximum case
allocate ( orientationOfGrain ( 3 , maxval ( Ngrains ) ) , source = 0.0_pReal ) ! reserve memory for maximum case
2015-10-14 00:22:01 +05:30
2012-03-09 01:55:28 +05:30
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) then
2013-03-28 19:20:20 +05:30
write ( 6 , '(/,a/)' ) ' MATERIAL grain population'
2012-10-02 18:23:25 +05:30
write ( 6 , '(a32,1x,a32,1x,a6)' ) 'homogenization_name' , 'microstructure_name' , 'grain#'
2011-03-21 16:01:17 +05:30
endif
2018-06-27 00:24:54 +05:30
homogenizationLoop : do homog = 1_pInt , size ( config_homogenization )
2013-01-18 17:00:52 +05:30
dGrains = homogenization_Ngrains ( homog ) ! grain number per material point
2018-06-27 00:24:54 +05:30
microstructureLoop : do micro = 1_pInt , size ( config_microstructure ) ! all pairs of homog and micro
2016-07-13 19:55:27 +05:30
activePair : if ( Ngrains ( homog , micro ) > 0_pInt ) then
2013-01-18 17:00:52 +05:30
myNgrains = Ngrains ( homog , micro ) ! assign short name for total number of grains to populate
2013-05-29 22:53:49 +05:30
myNconstituents = microstructure_Nconstituents ( micro ) ! assign short name for number of constituents
2018-06-11 03:46:48 +05:30
if ( iand ( myDebug , debug_levelBasic ) / = 0_pInt ) &
write ( 6 , '(/,a32,1x,a32,1x,i6)' ) homogenization_name ( homog ) , microstructure_name ( micro ) , myNgrains
2013-05-29 22:53:49 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
! calculate volume of each grain
2013-05-29 22:53:49 +05:30
2009-05-26 22:54:42 +05:30
volumeOfGrain = 0.0_pReal
2012-01-12 16:06:17 +05:30
grain = 0_pInt
2013-05-29 22:53:49 +05:30
2012-01-12 22:01:23 +05:30
do hme = 1_pInt , Nelems ( homog , micro )
2013-05-29 22:53:49 +05:30
e = elemsOfHomogMicro ( homog , micro ) % p ( hme ) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
2018-09-24 00:23:35 +05:30
t = mesh_elemType
2013-01-18 17:00:52 +05:30
if ( microstructure_elemhomo ( micro ) ) then ! homogeneous distribution of grains over each element's IPs
2018-09-24 00:23:35 +05:30
volumeOfGrain ( grain + 1_pInt : grain + dGrains ) = sum ( mesh_ipVolume ( 1 : mesh_NipsPerElem , e ) ) / &
2013-05-29 22:53:49 +05:30
real ( dGrains , pReal ) ! each grain combines size of all IPs in that element
grain = grain + dGrains ! wind forward by Ngrains@IP
2012-01-12 16:06:17 +05:30
else
2018-09-24 00:23:35 +05:30
forall ( i = 1_pInt : mesh_NipsPerElem ) & ! loop over IPs
2012-02-16 00:28:38 +05:30
volumeOfGrain ( grain + ( i - 1 ) * dGrains + 1_pInt : grain + i * dGrains ) = &
2016-05-25 11:22:56 +05:30
mesh_ipVolume ( i , e ) / real ( dGrains , pReal ) ! assign IPvolume/Ngrains@IP to all grains of IP
2018-09-24 00:23:35 +05:30
grain = grain + mesh_NipsPerElem * dGrains ! wind forward by Nips*Ngrains@IP
2009-03-04 17:18:54 +05:30
endif
enddo
2013-05-29 22:53:49 +05:30
if ( grain / = myNgrains ) &
2013-09-18 19:37:55 +05:30
call IO_error ( 0 , el = homog , ip = micro , ext_msg = 'inconsistent grain count after volume calc' )
2013-05-29 22:53:49 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
! divide myNgrains as best over constituents
2013-05-29 22:53:49 +05:30
!
! example: three constituents with fractions of 0.25, 0.25, and 0.5 distributed over 20 (microstructure) grains
!
! ***** ***** **********
! NgrainsOfConstituent: 5, 5, 10
! counters:
! |-----> grain (if constituent == 2)
! |--> constituentGrain (of constituent 2)
!
NgrainsOfConstituent = 0_pInt ! reset counter of grains per constituent
forall ( i = 1_pInt : myNconstituents ) &
2016-05-25 11:22:56 +05:30
NgrainsOfConstituent ( i ) = nint ( microstructure_fraction ( i , micro ) * real ( myNgrains , pReal ) , pInt ) ! do rounding integer conversion
2013-03-28 19:20:20 +05:30
do while ( sum ( NgrainsOfConstituent ) / = myNgrains ) ! total grain count over constituents wrong?
sgn = sign ( 1_pInt , myNgrains - sum ( NgrainsOfConstituent ) ) ! direction of required change
2009-03-04 17:18:54 +05:30
extreme = 0.0_pReal
t = 0_pInt
2013-05-29 22:53:49 +05:30
do i = 1_pInt , myNconstituents ! find largest deviator
2016-04-08 20:46:20 +05:30
deviation = real ( sgn , pReal ) * log ( microstructure_fraction ( i , micro ) / &
!-------------------------------- &
( real ( NgrainsOfConstituent ( i ) , pReal ) / real ( myNgrains , pReal ) ) )
if ( deviation > extreme ) then
extreme = deviation
2009-03-04 17:18:54 +05:30
t = i
endif
enddo
2013-03-28 19:20:20 +05:30
NgrainsOfConstituent ( t ) = NgrainsOfConstituent ( t ) + sgn ! change that by one
2009-06-15 18:41:21 +05:30
enddo
2013-01-18 17:00:52 +05:30
2013-05-29 22:53:49 +05:30
!--------------------------------------------------------------------------------------------------
! assign phase and texture info
2009-03-04 17:18:54 +05:30
phaseOfGrain = 0_pInt
2011-03-22 19:10:27 +05:30
textureOfGrain = 0_pInt
2009-03-04 17:18:54 +05:30
orientationOfGrain = 0.0_pReal
2013-05-29 22:53:49 +05:30
texture : do i = 1_pInt , myNconstituents ! loop over constituents
2014-10-31 16:09:02 +05:30
grain = sum ( NgrainsOfConstituent ( 1_pInt : i - 1_pInt ) ) ! set microstructure grain index of current constituent
2013-05-29 22:53:49 +05:30
! "grain" points to start of this constituent's grain population
constituentGrain = 0_pInt ! constituent grain index
2009-03-04 17:18:54 +05:30
phaseID = microstructure_phase ( i , micro )
textureID = microstructure_texture ( i , micro )
2013-05-29 22:53:49 +05:30
phaseOfGrain ( grain + 1_pInt : grain + NgrainsOfConstituent ( i ) ) = phaseID ! assign resp. phase
2013-03-28 19:20:20 +05:30
textureOfGrain ( grain + 1_pInt : grain + NgrainsOfConstituent ( i ) ) = textureID ! assign resp. texture
2009-03-04 17:18:54 +05:30
2012-02-10 17:26:05 +05:30
myNorientations = ceiling ( real ( NgrainsOfConstituent ( i ) , pReal ) / &
2013-03-28 19:20:20 +05:30
real ( texture_symmetry ( textureID ) , pReal ) , pInt ) ! max number of unique orientations (excl. symmetry)
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2018-10-14 13:41:26 +05:30
! has texture components
gauss : do t = 1_pInt , texture_Ngauss ( textureID ) ! loop over Gauss components
do g = 1_pInt , int ( real ( myNorientations , pReal ) * texture_Gauss ( 5 , t , textureID ) , pInt ) ! loop over required grain count
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleGaussOri ( texture_Gauss ( 1 : 3 , t , textureID ) , &
texture_Gauss ( 4 , t , textureID ) )
enddo
constituentGrain = &
constituentGrain + int ( real ( myNorientations , pReal ) * texture_Gauss ( 5 , t , textureID ) ) ! advance counter for grains of current constituent
enddo gauss
fiber : do t = 1_pInt , texture_Nfiber ( textureID ) ! loop over fiber components
do g = 1_pInt , int ( real ( myNorientations , pReal ) * texture_Fiber ( 6 , t , textureID ) , pInt ) ! loop over required grain count
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleFiberOri ( texture_Fiber ( 1 : 2 , t , textureID ) , &
texture_Fiber ( 3 : 4 , t , textureID ) , &
texture_Fiber ( 5 , t , textureID ) )
enddo
constituentGrain = &
constituentGrain + int ( real ( myNorientations , pReal ) * texture_fiber ( 6 , t , textureID ) , pInt ) ! advance counter for grains of current constituent
enddo fiber
random : do constituentGrain = constituentGrain + 1_pInt , myNorientations ! fill remainder with random
orientationOfGrain ( : , grain + constituentGrain ) = math_sampleRandomOri ( )
enddo random
2013-03-28 19:20:20 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-24 16:39:39 +05:30
! ...texture transformation
2013-05-29 22:53:49 +05:30
do j = 1_pInt , myNorientations ! loop over each "real" orientation
orientationOfGrain ( 1 : 3 , grain + j ) = math_RtoEuler ( & ! translate back to Euler angles
math_mul33x33 ( & ! pre-multiply
math_EulertoR ( orientationOfGrain ( 1 : 3 , grain + j ) ) , & ! face-value orientation
2013-07-24 16:39:39 +05:30
texture_transformation ( 1 : 3 , 1 : 3 , textureID ) & ! and transformation matrix
2013-05-29 22:53:49 +05:30
) &
)
enddo
!--------------------------------------------------------------------------------------------------
! ...sample symmetry
2013-01-18 17:00:52 +05:30
2009-03-04 17:18:54 +05:30
symExtension = texture_symmetry ( textureID ) - 1_pInt
2013-05-29 22:53:49 +05:30
if ( symExtension > 0_pInt ) then ! sample symmetry (number of additional equivalent orientations)
constituentGrain = myNorientations ! start right after "real" orientations
2013-01-18 17:00:52 +05:30
do j = 1_pInt , myNorientations ! loop over each "real" orientation
2013-05-29 22:53:49 +05:30
symOrientation = math_symmetricEulers ( texture_symmetry ( textureID ) , &
orientationOfGrain ( 1 : 3 , grain + j ) ) ! get symmetric equivalents
e = min ( symExtension , NgrainsOfConstituent ( i ) - constituentGrain ) ! do not overshoot end of constituent grain array
2009-03-04 17:18:54 +05:30
if ( e > 0_pInt ) then
2013-05-29 22:53:49 +05:30
orientationOfGrain ( 1 : 3 , grain + constituentGrain + 1 : &
grain + constituentGrain + e ) = &
symOrientation ( 1 : 3 , 1 : e )
constituentGrain = constituentGrain + e ! remainder shrinks by e
2009-03-04 17:18:54 +05:30
endif
enddo
endif
2013-01-18 17:00:52 +05:30
2013-03-28 19:20:20 +05:30
!--------------------------------------------------------------------------------------------------
2013-05-29 22:53:49 +05:30
! shuffle grains within current constituent
do j = 1_pInt , NgrainsOfConstituent ( i ) - 1_pInt ! walk thru grains of current constituent
2011-03-22 19:10:27 +05:30
call random_number ( rnd )
2016-05-27 15:16:34 +05:30
t = nint ( rnd * real ( NgrainsOfConstituent ( i ) - j , pReal ) + real ( j , pReal ) + 0.5_pReal , pInt ) ! select a grain in remaining list
2013-05-29 22:53:49 +05:30
m = phaseOfGrain ( grain + t ) ! exchange current with random
phaseOfGrain ( grain + t ) = phaseOfGrain ( grain + j )
phaseOfGrain ( grain + j ) = m
m = textureOfGrain ( grain + t ) ! exchange current with random
textureOfGrain ( grain + t ) = textureOfGrain ( grain + j )
textureOfGrain ( grain + j ) = m
orientation = orientationOfGrain ( 1 : 3 , grain + t ) ! exchange current with random
orientationOfGrain ( 1 : 3 , grain + t ) = orientationOfGrain ( 1 : 3 , grain + j )
orientationOfGrain ( 1 : 3 , grain + j ) = orientation
2011-03-22 19:10:27 +05:30
enddo
2015-10-14 00:22:01 +05:30
2013-05-29 22:53:49 +05:30
enddo texture
2013-06-11 12:58:08 +05:30
!< @todo calc fraction after weighing with volumePerGrain, exchange in MC steps to improve result (humbug at the moment)
2015-10-14 00:22:01 +05:30
2013-05-29 22:53:49 +05:30
!--------------------------------------------------------------------------------------------------
! distribute grains of all constituents as accurately as possible to given constituent fractions
ip = 0_pInt
currentGrainOfConstituent = 0_pInt
2012-01-12 22:01:23 +05:30
do hme = 1_pInt , Nelems ( homog , micro )
2013-02-25 18:43:52 +05:30
e = elemsOfHomogMicro ( homog , micro ) % p ( hme ) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
2018-09-24 00:23:35 +05:30
t = mesh_elemType
2013-01-18 17:00:52 +05:30
if ( microstructure_elemhomo ( micro ) ) then ! homogeneous distribution of grains over each element's IPs
2013-05-29 22:53:49 +05:30
m = 1_pInt ! process only first IP
2012-01-12 16:06:17 +05:30
else
2018-09-24 00:23:35 +05:30
m = mesh_NipsPerElem
2009-03-04 17:18:54 +05:30
endif
2013-05-29 22:53:49 +05:30
do i = 1_pInt , m ! loop over necessary IPs
ip = ip + 1_pInt ! keep track of total ip count
ipGrain = 0_pInt ! count number of grains assigned at this IP
randomOrder = math_range ( microstructure_maxNconstituents ) ! start out with ordered sequence of constituents
call random_number ( rndArray ) ! as many rnd numbers as (max) constituents
do j = 1_pInt , myNconstituents - 1_pInt ! loop over constituents ...
2016-05-27 15:16:34 +05:30
r = nint ( rndArray ( j ) * real ( myNconstituents - j , pReal ) + real ( j , pReal ) + 0.5_pReal , pInt ) ! ... select one in remaining list
2013-05-29 22:53:49 +05:30
c = randomOrder ( r ) ! ... call it "c"
randomOrder ( r ) = randomOrder ( j ) ! ... and exchange with present position in constituent list
grain = sum ( NgrainsOfConstituent ( 1 : c - 1_pInt ) ) ! figure out actual starting index in overall/consecutive grain population
do g = 1_pInt , min ( dGrains - ipGrain , & ! leftover number of grains at this IP
max ( 0_pInt , & ! no negative values
nint ( real ( ip * dGrains * NgrainsOfConstituent ( c ) ) / & ! fraction of grains scaled to this constituent...
real ( myNgrains ) , pInt ) - & ! ...minus those already distributed
currentGrainOfConstituent ( c ) ) )
ipGrain = ipGrain + 1_pInt ! advance IP grain counter
currentGrainOfConstituent ( c ) = currentGrainOfConstituent ( c ) + 1_pInt ! advance index of grain population for constituent c
material_volume ( ipGrain , i , e ) = volumeOfGrain ( grain + currentGrainOfConstituent ( c ) ) ! assign properties
material_phase ( ipGrain , i , e ) = phaseOfGrain ( grain + currentGrainOfConstituent ( c ) )
material_texture ( ipGrain , i , e ) = textureOfGrain ( grain + currentGrainOfConstituent ( c ) )
material_EulerAngles ( 1 : 3 , ipGrain , i , e ) = orientationOfGrain ( 1 : 3 , grain + currentGrainOfConstituent ( c ) )
enddo ; enddo
c = randomOrder ( microstructure_Nconstituents ( micro ) ) ! look up constituent remaining after random shuffling
grain = sum ( NgrainsOfConstituent ( 1 : c - 1_pInt ) ) ! figure out actual starting index in overall/consecutive grain population
do ipGrain = ipGrain + 1_pInt , dGrains ! ensure last constituent fills up to dGrains
currentGrainOfConstituent ( c ) = currentGrainOfConstituent ( c ) + 1_pInt
material_volume ( ipGrain , i , e ) = volumeOfGrain ( grain + currentGrainOfConstituent ( c ) )
material_phase ( ipGrain , i , e ) = phaseOfGrain ( grain + currentGrainOfConstituent ( c ) )
material_texture ( ipGrain , i , e ) = textureOfGrain ( grain + currentGrainOfConstituent ( c ) )
material_EulerAngles ( 1 : 3 , ipGrain , i , e ) = orientationOfGrain ( 1 : 3 , grain + currentGrainOfConstituent ( c ) )
enddo
enddo
2018-09-24 00:23:35 +05:30
do i = i , mesh_NipsPerElem ! loop over IPs to (possibly) distribute copies from first IP
2013-05-29 22:53:49 +05:30
material_volume ( 1_pInt : dGrains , i , e ) = material_volume ( 1_pInt : dGrains , 1 , e )
material_phase ( 1_pInt : dGrains , i , e ) = material_phase ( 1_pInt : dGrains , 1 , e )
material_texture ( 1_pInt : dGrains , i , e ) = material_texture ( 1_pInt : dGrains , 1 , e )
material_EulerAngles ( 1 : 3 , 1_pInt : dGrains , i , e ) = material_EulerAngles ( 1 : 3 , 1_pInt : dGrains , 1 , e )
enddo
2009-03-04 17:18:54 +05:30
enddo
2016-07-13 19:55:27 +05:30
endif activePair
enddo microstructureLoop
enddo homogenizationLoop
2015-10-14 00:22:01 +05:30
2016-11-10 11:23:47 +05:30
deallocate ( texture_transformation )
2012-01-12 22:01:23 +05:30
deallocate ( elemsOfHomogMicro )
2018-08-22 18:00:51 +05:30
call config_deallocate ( 'material.config/microstructure' )
2009-03-04 17:18:54 +05:30
2012-03-09 01:55:28 +05:30
end subroutine material_populateGrains
2009-03-04 17:18:54 +05:30
2013-02-20 03:42:05 +05:30
end module material