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
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
2018-06-10 21:31:52 +05:30
use config_material
2018-06-01 13:44:46 +05:30
use chained_list
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 , &
p_vec , &
2013-02-25 18:43:52 +05:30
p_intvec
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' , &
SOURCE_vacancy_phenoplasticity_label = 'vacancy_phenoplasticity' , &
SOURCE_vacancy_irradiation_label = 'vacancy_irradiation' , &
SOURCE_vacancy_thermalfluc_label = 'vacancy_thermalfluctuation' , &
KINEMATICS_thermal_expansion_label = 'thermal_expansion' , &
KINEMATICS_cleavage_opening_label = 'cleavage_opening' , &
KINEMATICS_slipplane_opening_label = 'slipplane_opening' , &
KINEMATICS_vacancy_strain_label = 'vacancy_strain' , &
KINEMATICS_hydrogen_strain_label = 'hydrogen_strain' , &
STIFFNESS_DEGRADATION_damage_label = 'damage' , &
STIFFNESS_DEGRADATION_porosity_label = 'porosity' , &
THERMAL_isothermal_label = 'isothermal' , &
THERMAL_adiabatic_label = 'adiabatic' , &
THERMAL_conduction_label = 'conduction' , &
DAMAGE_none_label = 'none' , &
DAMAGE_local_label = 'local' , &
DAMAGE_nonlocal_label = 'nonlocal' , &
VACANCYFLUX_isoconc_label = 'isoconcentration' , &
VACANCYFLUX_isochempot_label = 'isochemicalpotential' , &
VACANCYFLUX_cahnhilliard_label = 'cahnhilliard' , &
POROSITY_none_label = 'none' , &
POROSITY_phasefield_label = 'phasefield' , &
HYDROGENFLUX_isoconc_label = 'isoconcentration' , &
HYDROGENFLUX_cahnhilliard_label = 'cahnhilliard' , &
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 , &
SOURCE_damage_anisoDuctile_ID , &
SOURCE_vacancy_phenoplasticity_ID , &
SOURCE_vacancy_irradiation_ID , &
SOURCE_vacancy_thermalfluc_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 , &
KINEMATICS_thermal_expansion_ID , &
KINEMATICS_vacancy_strain_ID , &
KINEMATICS_hydrogen_strain_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 , &
STIFFNESS_DEGRADATION_damage_ID , &
STIFFNESS_DEGRADATION_porosity_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
2014-10-11 02:25:09 +05:30
enum , bind ( c )
2015-05-28 22:32:23 +05:30
enumerator :: VACANCYFLUX_isoconc_ID , &
VACANCYFLUX_isochempot_ID , &
VACANCYFLUX_cahnhilliard_ID
2014-10-11 02:25:09 +05:30
end enum
2015-05-28 22:32:23 +05:30
enum , bind ( c )
enumerator :: POROSITY_none_ID , &
POROSITY_phasefield_ID
end enum
enum , bind ( c )
enumerator :: HYDROGENFLUX_isoconc_ID , &
HYDROGENFLUX_cahnhilliard_ID
end enum
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 ( VACANCYFLUX_isoconc_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
vacancyflux_type !< vacancy transport model
2015-05-28 22:32:23 +05:30
integer ( kind ( POROSITY_none_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
porosity_type !< porosity evolution model
2015-05-28 22:32:23 +05:30
integer ( kind ( HYDROGENFLUX_isoconc_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2015-10-14 00:22:01 +05:30
hydrogenflux_type !< hydrogen transport 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
phase_plasticityInstance !< instance of particular plasticity of each phase
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
crystallite_Noutput !< number of '(output)' items per crystallite setting
2015-05-28 22:32:23 +05:30
2013-12-16 16:26:56 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
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
vacancyflux_typeInstance , & !< instance of particular type of each vacancy flux
porosity_typeInstance , & !< instance of particular type of each porosity model
hydrogenflux_typeInstance , & !< instance of particular type of each hydrogen flux
2013-02-20 03:42:05 +05:30
microstructure_crystallite !< crystallite setting ID of each microstructure
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
2015-07-24 20:23:50 +05:30
damage_initialPhi , & !< initial damage per each homogenization
2015-10-14 00:22:01 +05:30
vacancyflux_initialCv , & !< initial vacancy concentration per each homogenization
2015-07-24 20:23:50 +05:30
porosity_initialPhi , & !< initial posority per each homogenization
2015-10-14 00:22:01 +05:30
hydrogenflux_initialCh !< initial hydrogen concentration per each homogenization
2015-07-24 20:23:50 +05:30
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
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
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 , &
2014-06-23 00:28:29 +05:30
damageState , &
2015-05-28 22:32:23 +05:30
vacancyfluxState , &
porosityState , &
hydrogenfluxState
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
character ( len = 256 ) , dimension ( : ) , allocatable , private :: &
2015-10-14 00:22:01 +05:30
texture_ODFfile !< name of each ODF file
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
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)
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public , target :: mappingCrystallite
integer ( pInt ) , dimension ( : , : , : ) , allocatable , public , target :: mappingHomogenization !< mapping from material points to offset in heterogenous state/field
integer ( pInt ) , dimension ( : , : ) , allocatable , public , target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field
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
damageMapping , & !< mapping for damage state/fields
vacancyfluxMapping , & !< mapping for vacancy conc state/fields
porosityMapping , & !< mapping for porosity state/fields
hydrogenfluxMapping !< mapping for hydrogen conc state/fields
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
type ( p_vec ) , allocatable , dimension ( : ) , public :: &
temperature , & !< temperature field
damage , & !< damage field
vacancyConc , & !< vacancy conc field
porosity , & !< porosity field
hydrogenConc , & !< hydrogen conc field
2015-10-14 00:22:01 +05:30
temperatureRate , & !< temperature change rate field
2015-05-28 22:32:23 +05:30
vacancyConcRate , & !< vacancy conc change field
hydrogenConcRate !< hydrogen conc change 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 , &
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 , &
SOURCE_vacancy_phenoplasticity_ID , &
SOURCE_vacancy_irradiation_ID , &
SOURCE_vacancy_thermalfluc_ID , &
KINEMATICS_cleavage_opening_ID , &
KINEMATICS_slipplane_opening_ID , &
KINEMATICS_thermal_expansion_ID , &
KINEMATICS_vacancy_strain_ID , &
KINEMATICS_hydrogen_strain_ID , &
STIFFNESS_DEGRADATION_damage_ID , &
STIFFNESS_DEGRADATION_porosity_ID , &
THERMAL_isothermal_ID , &
THERMAL_adiabatic_ID , &
THERMAL_conduction_ID , &
DAMAGE_none_ID , &
DAMAGE_local_ID , &
DAMAGE_nonlocal_ID , &
VACANCYFLUX_isoconc_ID , &
VACANCYFLUX_isochempot_ID , &
VACANCYFLUX_cahnhilliard_ID , &
POROSITY_none_ID , &
POROSITY_phasefield_ID , &
HYDROGENFLUX_isoconc_ID , &
HYDROGENFLUX_cahnhilliard_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
2014-06-23 00:28:29 +05:30
use mesh , only : &
mesh_maxNips , &
mesh_NcpElems , &
mesh_element , &
FE_Nips , &
2015-10-14 00:22:01 +05:30
FE_geomtype
2009-03-04 17:18:54 +05:30
implicit none
2013-12-12 22:39:59 +05:30
integer ( pInt ) , parameter :: FILEUNIT = 200_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
e , & !< element number
2015-05-28 22:32:23 +05:30
phase
2014-09-23 02:06:55 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: ConstitutivePosition
integer ( pInt ) , dimension ( : ) , allocatable :: CrystallitePosition
integer ( pInt ) , dimension ( : ) , allocatable :: HomogenizationPosition
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
2015-05-28 22:32:23 +05:30
allocate ( plasticState ( material_Nphase ) )
allocate ( sourceState ( material_Nphase ) )
do myPhase = 1 , material_Nphase
allocate ( sourceState ( myPhase ) % p ( phase_Nsources ( myPhase ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
allocate ( homogState ( material_Nhomogenization ) )
allocate ( thermalState ( material_Nhomogenization ) )
allocate ( damageState ( material_Nhomogenization ) )
allocate ( vacancyfluxState ( material_Nhomogenization ) )
allocate ( porosityState ( material_Nhomogenization ) )
allocate ( hydrogenfluxState ( material_Nhomogenization ) )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
allocate ( thermalMapping ( material_Nhomogenization ) )
allocate ( damageMapping ( material_Nhomogenization ) )
allocate ( vacancyfluxMapping ( material_Nhomogenization ) )
allocate ( porosityMapping ( material_Nhomogenization ) )
allocate ( hydrogenfluxMapping ( material_Nhomogenization ) )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
allocate ( temperature ( material_Nhomogenization ) )
allocate ( damage ( material_Nhomogenization ) )
allocate ( vacancyConc ( material_Nhomogenization ) )
allocate ( porosity ( material_Nhomogenization ) )
allocate ( hydrogenConc ( material_Nhomogenization ) )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
allocate ( temperatureRate ( material_Nhomogenization ) )
allocate ( vacancyConcRate ( material_Nhomogenization ) )
allocate ( hydrogenConcRate ( material_Nhomogenization ) )
2015-10-14 00:22:01 +05:30
2013-03-28 19:20:20 +05:30
do m = 1_pInt , material_Nmicrostructure
2013-11-27 13:35:23 +05:30
if ( microstructure_crystallite ( m ) < 1_pInt . or . &
2015-10-14 00:22:01 +05:30
microstructure_crystallite ( m ) > material_Ncrystallite ) &
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 . &
maxval ( microstructure_phase ( 1 : microstructure_Nconstituents ( m ) , m ) ) > material_Nphase ) &
call IO_error ( 150_pInt , m , ext_msg = 'phase' )
if ( minval ( microstructure_texture ( 1 : microstructure_Nconstituents ( m ) , m ) ) < 1_pInt . or . &
maxval ( microstructure_texture ( 1 : microstructure_Nconstituents ( m ) , m ) ) > material_Ntexture ) &
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'
2013-03-28 19:20:20 +05:30
do h = 1_pInt , material_Nhomogenization
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'
2013-03-28 19:20:20 +05:30
do m = 1_pInt , material_Nmicrostructure
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
2016-01-15 05:49:44 +05:30
allocate ( phaseAt ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
allocate ( phasememberAt ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
2015-05-28 22:32:23 +05:30
allocate ( mappingHomogenization ( 2 , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
allocate ( mappingCrystallite ( 2 , homogenization_maxNgrains , mesh_NcpElems ) , source = 0_pInt )
allocate ( mappingHomogenizationConst ( mesh_maxNips , mesh_NcpElems ) , source = 1_pInt )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
allocate ( ConstitutivePosition ( material_Nphase ) , source = 0_pInt )
2014-08-21 23:18:20 +05:30
allocate ( HomogenizationPosition ( material_Nhomogenization ) , source = 0_pInt )
2015-05-28 22:32:23 +05:30
allocate ( CrystallitePosition ( material_Nphase ) , source = 0_pInt )
2014-09-18 20:57:52 +05:30
2016-07-13 19:55:27 +05:30
ElemLoop : do e = 1_pInt , mesh_NcpElems
2014-09-03 22:42:06 +05:30
myHomog = mesh_element ( 3 , e )
2016-07-13 19:55:27 +05:30
IPloop : do i = 1_pInt , FE_Nips ( FE_geomtype ( mesh_element ( 2 , e ) ) )
2014-09-18 20:57:52 +05:30
HomogenizationPosition ( myHomog ) = HomogenizationPosition ( myHomog ) + 1_pInt
mappingHomogenization ( 1 : 2 , i , e ) = [ HomogenizationPosition ( myHomog ) , myHomog ]
2016-07-13 19:55:27 +05:30
GrainLoop : do g = 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) )
2014-06-24 19:21:17 +05:30
phase = material_phase ( g , i , e )
ConstitutivePosition ( phase ) = ConstitutivePosition ( phase ) + 1_pInt ! not distinguishing between instances of same phase
2016-01-15 05:49:44 +05:30
phaseAt ( g , i , e ) = phase
phasememberAt ( g , i , e ) = ConstitutivePosition ( phase )
2014-06-24 19:21:17 +05:30
enddo GrainLoop
enddo IPloop
enddo ElemLoop
2015-05-28 22:32:23 +05:30
! hack needed to initialize field values used during constitutive and crystallite initializations
do myHomog = 1 , material_Nhomogenization
thermalMapping ( myHomog ) % p = > mappingHomogenizationConst
damageMapping ( myHomog ) % p = > mappingHomogenizationConst
vacancyfluxMapping ( myHomog ) % p = > mappingHomogenizationConst
porosityMapping ( myHomog ) % p = > mappingHomogenizationConst
hydrogenfluxMapping ( 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 ) )
allocate ( vacancyConc ( myHomog ) % p ( 1 ) , source = vacancyflux_initialCv ( myHomog ) )
allocate ( porosity ( myHomog ) % p ( 1 ) , source = porosity_initialPhi ( myHomog ) )
allocate ( hydrogenConc ( myHomog ) % p ( 1 ) , source = hydrogenflux_initialCh ( myHomog ) )
2015-05-28 22:32:23 +05:30
allocate ( temperatureRate ( myHomog ) % p ( 1 ) , source = 0.0_pReal )
allocate ( vacancyConcRate ( myHomog ) % p ( 1 ) , source = 0.0_pReal )
allocate ( hydrogenConcRate ( myHomog ) % p ( 1 ) , source = 0.0_pReal )
2014-09-23 02:06:55 +05:30
enddo
2018-06-02 22:57:03 +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
use config_material , only : &
homogenizationConfig
2013-03-28 19:20:20 +05:30
use IO , only : &
2018-06-11 03:46:48 +05:30
IO_error
2013-01-18 17:00:52 +05:30
use mesh , only : &
mesh_element
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
allocate ( homogenization_type ( material_Nhomogenization ) , source = HOMOGENIZATION_undefined_ID )
allocate ( thermal_type ( material_Nhomogenization ) , source = THERMAL_isothermal_ID )
allocate ( damage_type ( material_Nhomogenization ) , source = DAMAGE_none_ID )
allocate ( vacancyflux_type ( material_Nhomogenization ) , source = VACANCYFLUX_isoconc_ID )
allocate ( porosity_type ( material_Nhomogenization ) , source = POROSITY_none_ID )
allocate ( hydrogenflux_type ( material_Nhomogenization ) , source = HYDROGENFLUX_isoconc_ID )
allocate ( homogenization_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( thermal_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( damage_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( vacancyflux_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( porosity_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( hydrogenflux_typeInstance ( material_Nhomogenization ) , source = 0_pInt )
allocate ( homogenization_Ngrains ( material_Nhomogenization ) , source = 0_pInt )
allocate ( homogenization_Noutput ( material_Nhomogenization ) , source = 0_pInt )
allocate ( homogenization_active ( material_Nhomogenization ) , source = . false . ) !!!!!!!!!!!!!!!
allocate ( thermal_initialT ( material_Nhomogenization ) , source = 30 0.0_pReal )
allocate ( damage_initialPhi ( material_Nhomogenization ) , source = 1.0_pReal )
allocate ( vacancyflux_initialCv ( material_Nhomogenization ) , source = 0.0_pReal )
allocate ( porosity_initialPhi ( material_Nhomogenization ) , source = 1.0_pReal )
allocate ( hydrogenflux_initialCh ( material_Nhomogenization ) , source = 0.0_pReal )
forall ( h = 1_pInt : material_Nhomogenization ) homogenization_active ( h ) = any ( mesh_element ( 3 , : ) == h )
do h = 1_pInt , material_Nhomogenization
2018-06-03 04:06:34 +05:30
homogenization_Noutput ( h ) = homogenizationConfig ( h ) % countKeys ( '(output)' )
2018-06-11 03:46:48 +05:30
2018-06-02 22:57:03 +05:30
tag = homogenizationConfig ( 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
homogenization_Ngrains ( h ) = homogenizationConfig ( h ) % getInt ( 'nconstituents' )
case ( HOMOGENIZATION_RGC_label )
homogenization_type ( h ) = HOMOGENIZATION_RGC_ID
homogenization_Ngrains ( h ) = homogenizationConfig ( h ) % getInt ( 'nconstituents' )
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
if ( homogenizationConfig ( h ) % keyExists ( 'thermal' ) ) then
2018-06-11 03:46:48 +05:30
thermal_initialT ( h ) = homogenizationConfig ( h ) % getFloat ( 't0' )
tag = homogenizationConfig ( h ) % getString ( 'thermal' )
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-03 04:06:34 +05:30
if ( homogenizationConfig ( h ) % keyExists ( 'damage' ) ) then
2018-06-11 03:46:48 +05:30
damage_initialPhi ( h ) = homogenizationConfig ( h ) % getFloat ( 'initialdamage' )
tag = homogenizationConfig ( h ) % getString ( 'thermal' )
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
2018-06-03 04:06:34 +05:30
if ( homogenizationConfig ( h ) % keyExists ( 'vacancyflux' ) ) then
2018-06-11 03:46:48 +05:30
vacancyflux_initialCv ( h ) = homogenizationConfig ( h ) % getFloat ( 'cv0' )
tag = homogenizationConfig ( h ) % getString ( 'vacancyflux' )
select case ( trim ( tag ) )
case ( VACANCYFLUX_isoconc_label )
vacancyflux_type ( h ) = VACANCYFLUX_isoconc_ID
case ( VACANCYFLUX_isochempot_label )
vacancyflux_type ( h ) = VACANCYFLUX_isochempot_ID
case ( VACANCYFLUX_cahnhilliard_label )
vacancyflux_type ( h ) = VACANCYFLUX_cahnhilliard_ID
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
endif
2018-06-03 04:06:34 +05:30
if ( homogenizationConfig ( h ) % keyExists ( 'porosity' ) ) then
2018-06-11 03:46:48 +05:30
!ToDo?
tag = homogenizationConfig ( h ) % getString ( 'porosity' )
select case ( trim ( tag ) )
case ( POROSITY_NONE_label )
porosity_type ( h ) = POROSITY_none_ID
case ( POROSITY_phasefield_label )
porosity_type ( h ) = POROSITY_phasefield_ID
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
endif
2018-06-03 04:06:34 +05:30
if ( homogenizationConfig ( h ) % keyExists ( 'hydrogenflux' ) ) then
2018-06-11 03:46:48 +05:30
hydrogenflux_initialCh ( h ) = homogenizationConfig ( h ) % getFloat ( 'ch0' )
tag = homogenizationConfig ( h ) % getString ( 'hydrogenflux' )
select case ( trim ( tag ) )
case ( HYDROGENFLUX_isoconc_label )
hydrogenflux_type ( h ) = HYDROGENFLUX_isoconc_ID
case ( HYDROGENFLUX_cahnhilliard_label )
hydrogenflux_type ( h ) = HYDROGENFLUX_cahnhilliard_ID
case default
call IO_error ( 500_pInt , ext_msg = trim ( tag ) )
end select
2009-03-04 17:18:54 +05:30
endif
2018-06-11 03:46:48 +05:30
2009-03-04 17:18:54 +05:30
enddo
2018-06-02 22:57:03 +05:30
do h = 1_pInt , material_Nhomogenization
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 ) )
vacancyflux_typeInstance ( h ) = count ( vacancyflux_type ( 1 : h ) == vacancyflux_type ( h ) )
porosity_typeInstance ( h ) = count ( porosity_type ( 1 : h ) == porosity_type ( h ) )
hydrogenflux_typeInstance ( h ) = count ( hydrogenflux_type ( 1 : h ) == hydrogenflux_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 , &
IO_error
2013-01-18 17:00:52 +05:30
use mesh , only : &
mesh_element , &
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-06-02 16:53:42 +05:30
str
integer ( pInt ) , allocatable , dimension ( : , : ) :: chunkPoss
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-02 16:53:42 +05:30
allocate ( microstructure_crystallite ( material_Nmicrostructure ) , source = 0_pInt )
allocate ( microstructure_Nconstituents ( material_Nmicrostructure ) , source = 0_pInt )
allocate ( microstructure_active ( material_Nmicrostructure ) , source = . false . )
allocate ( microstructure_elemhomo ( material_Nmicrostructure ) , source = . false . )
2009-07-22 21:37:19 +05:30
2018-06-02 16:53:42 +05:30
if ( any ( mesh_element ( 4 , 1 : mesh_NcpElems ) > material_Nmicrostructure ) ) &
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
2013-01-18 17:00:52 +05:30
forall ( e = 1_pInt : mesh_NcpElems ) microstructure_active ( mesh_element ( 4 , 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-02 16:53:42 +05:30
do m = 1_pInt , material_Nmicrostructure
microstructure_Nconstituents ( m ) = microstructureConfig ( m ) % countKeys ( '(constituent)' )
microstructure_crystallite ( m ) = microstructureConfig ( m ) % getInt ( 'crystallite' )
2018-06-03 00:30:26 +05:30
microstructure_elemhomo ( m ) = microstructureConfig ( 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 )
allocate ( microstructure_phase ( microstructure_maxNconstituents , material_Nmicrostructure ) , source = 0_pInt )
allocate ( microstructure_texture ( microstructure_maxNconstituents , material_Nmicrostructure ) , source = 0_pInt )
allocate ( microstructure_fraction ( microstructure_maxNconstituents , material_Nmicrostructure ) , source = 0.0_pReal )
2015-10-14 00:22:01 +05:30
2018-06-02 16:53:42 +05:30
do m = 1_pInt , material_Nmicrostructure
2018-06-11 03:46:48 +05:30
call microstructureConfig ( m ) % getRaws ( '(constituent)' , str , chunkPoss )
do c = 1_pInt , size ( str )
do i = 2_pInt , 6_pInt , 2_pInt
tag = IO_stringValue ( str ( c ) , chunkPoss ( : , c ) , i )
select case ( tag )
case ( 'phase' )
microstructure_phase ( c , m ) = IO_intValue ( str ( c ) , chunkPoss ( : , c ) , i + 1_pInt )
case ( 'texture' )
microstructure_texture ( c , m ) = IO_intValue ( str ( c ) , chunkPoss ( : , c ) , i + 1_pInt )
case ( 'fraction' )
microstructure_fraction ( c , m ) = IO_floatValue ( str ( c ) , chunkPoss ( : , c ) , i + 1_pInt )
end select
enddo
enddo
enddo
2009-03-04 17:18:54 +05:30
2018-06-02 16:53:42 +05:30
do m = 1_pInt , material_Nmicrostructure
if ( dNeq ( sum ( microstructure_fraction ( : , m ) ) , 1.0_pReal ) ) &
call IO_error ( 153_pInt , ext_msg = microstructure_name ( m ) )
enddo
2017-04-25 16:04:14 +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
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-10 22:08:31 +05:30
allocate ( crystallite_Noutput ( material_Ncrystallite ) , source = 0_pInt )
2018-06-02 16:53:42 +05:30
do c = 1_pInt , material_Ncrystallite
crystallite_Noutput ( c ) = crystalliteConfig ( c ) % countKeys ( '(output)' )
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
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-10 22:08:31 +05:30
character ( len = 256 ) , dimension ( : ) , allocatable :: str
2012-06-26 15:54:54 +05:30
2015-10-14 00:22:01 +05:30
2018-06-02 16:53:42 +05:30
allocate ( phase_elasticity ( material_Nphase ) , source = ELASTICITY_undefined_ID )
allocate ( phase_plasticity ( material_Nphase ) , source = PLASTICITY_undefined_ID )
allocate ( phase_Nsources ( material_Nphase ) , source = 0_pInt )
allocate ( phase_Nkinematics ( material_Nphase ) , source = 0_pInt )
allocate ( phase_NstiffnessDegradations ( material_Nphase ) , source = 0_pInt )
allocate ( phase_Noutput ( material_Nphase ) , source = 0_pInt )
allocate ( phase_localPlasticity ( material_Nphase ) , source = . false . )
do p = 1_pInt , material_Nphase
2018-06-02 13:09:05 +05:30
phase_Noutput ( p ) = phaseConfig ( p ) % countKeys ( '(output)' )
phase_Nsources ( p ) = phaseConfig ( p ) % countKeys ( '(source)' )
phase_Nkinematics ( p ) = phaseConfig ( p ) % countKeys ( '(kinematics)' )
phase_NstiffnessDegradations ( p ) = phaseConfig ( p ) % countKeys ( '(stiffness_degradation)' )
2018-06-03 00:30:26 +05:30
phase_localPlasticity ( p ) = . not . phaseConfig ( p ) % KeyExists ( '/nonlocal/' )
2018-06-02 13:09:05 +05:30
select case ( phaseConfig ( p ) % getString ( 'elasticity' ) )
case ( ELASTICITY_HOOKE_label )
phase_elasticity ( p ) = ELASTICITY_HOOKE_ID
case default
call IO_error ( 200_pInt , ext_msg = trim ( phaseConfig ( p ) % getString ( 'elasticity' ) ) )
end select
select case ( phaseConfig ( p ) % getString ( 'plasticity' ) )
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
call IO_error ( 201_pInt , ext_msg = trim ( phaseConfig ( p ) % getString ( 'plasticity' ) ) )
end select
enddo
2018-06-02 16:53:42 +05:30
allocate ( phase_source ( maxval ( phase_Nsources ) , material_Nphase ) , source = SOURCE_undefined_ID )
allocate ( phase_kinematics ( maxval ( phase_Nkinematics ) , material_Nphase ) , source = KINEMATICS_undefined_ID )
allocate ( phase_stiffnessDegradation ( maxval ( phase_NstiffnessDegradations ) , material_Nphase ) , &
2018-06-02 13:09:05 +05:30
source = STIFFNESS_DEGRADATION_undefined_ID )
2018-06-02 16:53:42 +05:30
do p = 1_pInt , material_Nphase
2018-06-02 13:09:05 +05:30
if ( phase_Nsources ( p ) / = 0_pInt ) then
str = phaseConfig ( p ) % getStrings ( '(source)' )
do sourceCtr = 1_pInt , size ( str )
select case ( trim ( str ( sourceCtr ) ) )
case ( SOURCE_thermal_dissipation_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_thermal_dissipation_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_thermal_externalheat_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_thermal_externalheat_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_damage_isoBrittle_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_damage_isoBrittle_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_damage_isoDuctile_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_damage_isoDuctile_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_damage_anisoBrittle_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_damage_anisoBrittle_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_damage_anisoDuctile_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_damage_anisoDuctile_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_vacancy_phenoplasticity_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_vacancy_phenoplasticity_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_vacancy_irradiation_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_vacancy_irradiation_ID
2018-06-02 13:09:05 +05:30
case ( SOURCE_vacancy_thermalfluc_label )
2018-06-02 16:53:42 +05:30
phase_source ( sourceCtr , p ) = SOURCE_vacancy_thermalfluc_ID
2018-06-02 13:09:05 +05:30
end select
enddo
endif
if ( phase_Nkinematics ( p ) / = 0_pInt ) then
str = phaseConfig ( p ) % getStrings ( '(kinematics)' )
do kinematicsCtr = 1_pInt , size ( str )
select case ( trim ( str ( kinematicsCtr ) ) )
case ( KINEMATICS_cleavage_opening_label )
2018-06-02 16:53:42 +05:30
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_cleavage_opening_ID
2018-06-02 13:09:05 +05:30
case ( KINEMATICS_slipplane_opening_label )
2018-06-02 16:53:42 +05:30
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_slipplane_opening_ID
2018-06-02 13:09:05 +05:30
case ( KINEMATICS_thermal_expansion_label )
2018-06-02 16:53:42 +05:30
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_thermal_expansion_ID
2018-06-02 13:09:05 +05:30
case ( KINEMATICS_vacancy_strain_label )
2018-06-02 16:53:42 +05:30
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_vacancy_strain_ID
2018-06-02 13:09:05 +05:30
case ( KINEMATICS_hydrogen_strain_label )
2018-06-02 16:53:42 +05:30
phase_kinematics ( kinematicsCtr , p ) = KINEMATICS_hydrogen_strain_ID
2018-06-02 13:09:05 +05:30
end select
enddo
endif
if ( phase_NstiffnessDegradations ( p ) / = 0_pInt ) then
str = phaseConfig ( p ) % getStrings ( '(stiffness_degradation)' )
do stiffDegradationCtr = 1_pInt , size ( str )
select case ( trim ( str ( stiffDegradationCtr ) ) )
case ( STIFFNESS_DEGRADATION_damage_label )
2018-06-02 16:53:42 +05:30
phase_stiffnessDegradation ( stiffDegradationCtr , p ) = STIFFNESS_DEGRADATION_damage_ID
2018-06-02 13:09:05 +05:30
case ( STIFFNESS_DEGRADATION_porosity_label )
2018-06-02 16:53:42 +05:30
phase_stiffnessDegradation ( stiffDegradationCtr , p ) = STIFFNESS_DEGRADATION_porosity_ID
2018-06-02 13:09:05 +05:30
end select
enddo
2009-03-04 17:18:54 +05:30
endif
enddo
2018-06-02 16:53:42 +05:30
allocate ( phase_plasticityInstance ( material_Nphase ) , source = 0_pInt )
allocate ( phase_elasticityInstance ( material_Nphase ) , source = 0_pInt )
2018-06-02 13:09:05 +05:30
2018-06-02 16:53:42 +05:30
do p = 1_pInt , material_Nphase
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
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-11 03:53:43 +05:30
character ( len = 65536 ) , dimension ( : ) , allocatable :: lines
2018-06-10 22:08:31 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: chunkPos
2018-06-11 03:53:43 +05:30
character ( len = 65536 ) :: tag
2018-06-03 14:14:20 +05:30
2018-06-10 22:08:31 +05:30
allocate ( texture_ODFfile ( material_Ntexture ) ) ; texture_ODFfile = ''
allocate ( texture_symmetry ( material_Ntexture ) , source = 1_pInt )
allocate ( texture_Ngauss ( material_Ntexture ) , source = 0_pInt )
allocate ( texture_Nfiber ( material_Ntexture ) , source = 0_pInt )
2010-02-25 23:09:11 +05:30
2018-06-03 14:14:20 +05:30
do t = 1_pInt , material_Ntexture
texture_Ngauss ( t ) = textureConfig ( t ) % countKeys ( '(gauss)' ) &
+ textureConfig ( t ) % countKeys ( '(random)' )
texture_Nfiber ( t ) = textureConfig ( t ) % countKeys ( '(fiber)' )
enddo
2009-03-04 17:18:54 +05:30
texture_maxNgauss = maxval ( texture_Ngauss )
texture_maxNfiber = maxval ( texture_Nfiber )
2018-06-03 14:14:20 +05:30
allocate ( texture_Gauss ( 5 , texture_maxNgauss , material_Ntexture ) , source = 0.0_pReal )
allocate ( texture_Fiber ( 6 , texture_maxNfiber , material_Ntexture ) , source = 0.0_pReal )
allocate ( texture_transformation ( 3 , 3 , material_Ntexture ) , source = 0.0_pReal )
texture_transformation = spread ( math_I3 , 3 , material_Ntexture )
2015-10-14 00:22:01 +05:30
2018-06-03 14:14:20 +05:30
do t = 1_pInt , material_Ntexture
section = t
gauss = 0_pInt
fiber = 0_pInt
2018-06-11 03:53:43 +05:30
lines = textureConfig ( t ) % getStringsRaw ( )
2018-06-03 14:14:20 +05:30
2018-06-11 03:53:43 +05:30
do i = 1_pInt , size ( lines )
2009-03-04 17:18:54 +05:30
2018-06-11 03:53:43 +05:30
chunkPos = IO_stringPos ( lines ( i ) )
tag = IO_stringValue ( lines ( i ) , chunkPos , 1_pInt ) ! extract key
2013-03-28 19:20:20 +05:30
textureType : select case ( tag )
2009-03-04 17:18:54 +05:30
2013-07-24 16:39:39 +05:30
case ( 'axes' , 'rotation' ) textureType
2013-05-29 22:53:49 +05:30
do j = 1_pInt , 3_pInt ! look for "x", "y", and "z" entries
2018-06-11 03:53:43 +05:30
tag = IO_stringValue ( lines ( i ) , chunkPos , j + 1_pInt )
2013-05-02 14:05:37 +05:30
select case ( tag )
case ( 'x' , '+x' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ 1.0_pReal , 0.0_pReal , 0.0_pReal ] ! original axis is now +x-axis
2013-05-02 14:05:37 +05:30
case ( '-x' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ - 1.0_pReal , 0.0_pReal , 0.0_pReal ] ! original axis is now -x-axis
2013-05-02 14:05:37 +05:30
case ( 'y' , '+y' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 1.0_pReal , 0.0_pReal ] ! original axis is now +y-axis
2013-05-02 14:05:37 +05:30
case ( '-y' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , - 1.0_pReal , 0.0_pReal ] ! original axis is now -y-axis
2013-05-02 14:05:37 +05:30
case ( 'z' , '+z' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 0.0_pReal , 1.0_pReal ] ! original axis is now +z-axis
2013-05-02 14:05:37 +05:30
case ( '-z' )
2018-06-11 03:46:48 +05:30
texture_transformation ( j , 1 : 3 , t ) = [ 0.0_pReal , 0.0_pReal , - 1.0_pReal ] ! original axis is now -z-axis
2013-05-02 14:05:37 +05:30
case default
2018-06-11 03:46:48 +05:30
call IO_error ( 157_pInt , t )
2013-05-02 14:05:37 +05:30
end select
enddo
2015-10-14 00:22:01 +05:30
2018-06-11 03:46:48 +05:30
if ( dNeq ( math_det33 ( texture_transformation ( 1 : 3 , 1 : 3 , t ) ) , 1.0_pReal ) ) &
call IO_error ( 157_pInt , t )
2016-11-17 02:38:19 +05:30
2013-03-28 19:20:20 +05:30
case ( 'hybridia' ) textureType
2018-06-11 03:53:43 +05:30
texture_ODFfile ( t ) = IO_stringValue ( lines ( i ) , chunkPos , 2_pInt )
2009-03-04 17:18:54 +05:30
2013-03-28 19:20:20 +05:30
case ( 'symmetry' ) textureType
2018-06-11 03:53:43 +05:30
tag = IO_stringValue ( lines ( i ) , chunkPos , 2_pInt )
2009-03-04 17:18:54 +05:30
select case ( tag )
case ( 'orthotropic' )
2018-06-11 03:46:48 +05:30
texture_symmetry ( t ) = 4_pInt
2009-03-04 17:18:54 +05:30
case ( 'monoclinic' )
2018-06-11 03:46:48 +05:30
texture_symmetry ( t ) = 2_pInt
2009-03-04 17:18:54 +05:30
case default
2018-06-11 03:46:48 +05:30
texture_symmetry ( t ) = 1_pInt
2009-03-04 17:18:54 +05:30
end select
2015-10-14 00:22:01 +05:30
2013-03-28 19:20:20 +05:30
case ( '(random)' ) textureType
2012-02-16 00:28:38 +05:30
gauss = gauss + 1_pInt
2018-06-11 03:46:48 +05:30
texture_Gauss ( 1 : 3 , gauss , t ) = math_sampleRandomOri ( )
2013-03-28 19:20:20 +05:30
do j = 2_pInt , 4_pInt , 2_pInt
2018-06-11 03:53:43 +05:30
tag = IO_stringValue ( lines ( i ) , chunkPos , j )
2011-05-28 15:14:43 +05:30
select case ( tag )
case ( 'scatter' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 4 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2011-05-28 15:14:43 +05:30
case ( 'fraction' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 5 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt )
2011-05-28 15:14:43 +05:30
end select
enddo
2013-03-28 19:20:20 +05:30
case ( '(gauss)' ) textureType
2012-02-16 00:28:38 +05:30
gauss = gauss + 1_pInt
2013-03-28 19:20:20 +05:30
do j = 2_pInt , 10_pInt , 2_pInt
2018-06-11 03:53:43 +05:30
tag = IO_stringValue ( lines ( i ) , chunkPos , j )
2009-03-04 17:18:54 +05:30
select case ( tag )
case ( 'phi1' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 1 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'phi' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 2 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'phi2' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 3 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'scatter' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 4 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'fraction' )
2018-06-11 03:53:43 +05:30
texture_Gauss ( 5 , gauss , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt )
2009-03-04 17:18:54 +05:30
end select
enddo
2011-05-28 15:14:43 +05:30
2013-03-28 19:20:20 +05:30
case ( '(fiber)' ) textureType
2012-02-16 00:28:38 +05:30
fiber = fiber + 1_pInt
2013-03-28 19:20:20 +05:30
do j = 2_pInt , 12_pInt , 2_pInt
2018-06-11 03:53:43 +05:30
tag = IO_stringValue ( lines ( i ) , chunkPos , j )
2009-03-04 17:18:54 +05:30
select case ( tag )
2009-04-28 15:15:52 +05:30
case ( 'alpha1' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 1 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'alpha2' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 2 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'beta1' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 3 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'beta2' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 4 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'scatter' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 5 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt ) * inRad
2009-03-04 17:18:54 +05:30
case ( 'fraction' )
2018-06-11 03:53:43 +05:30
texture_Fiber ( 6 , fiber , t ) = IO_floatValue ( lines ( i ) , chunkPos , j + 1_pInt )
2009-03-04 17:18:54 +05:30
end select
enddo
2013-03-28 19:20:20 +05:30
end select textureType
2018-06-11 03:53:43 +05:30
enddo
2009-03-04 17:18:54 +05:30
enddo
2018-06-10 21:31:52 +05:30
end subroutine material_parseTexture
2009-03-04 17:18:54 +05:30
2013-01-18 17:00:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief populates the grains
!> @details populates the grains by identifying active microstructure/homogenization pairs,
!! calculates the volume of the grains and deals with texture components and hybridIA
!--------------------------------------------------------------------------------------------------
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 : &
mesh_element , &
mesh_maxNips , &
mesh_NcpElems , &
mesh_ipVolume , &
FE_Nips , &
FE_geomtype
use IO , only : &
IO_error , &
IO_hybridIA
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
2014-05-08 20:25:19 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable :: Nelems ! counts number of elements in homog, micro array
2013-02-25 18:43:52 +05:30
type ( p_intvec ) , 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
2013-12-13 04:33:37 +05:30
allocate ( material_volume ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( material_phase ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
2014-08-21 23:18:20 +05:30
allocate ( material_homog ( mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
2013-12-13 04:33:37 +05:30
allocate ( material_texture ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
allocate ( material_EulerAngles ( 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
2015-10-14 00:22:01 +05:30
2013-12-13 04:33:37 +05:30
allocate ( Ngrains ( material_Nhomogenization , material_Nmicrostructure ) , source = 0_pInt )
allocate ( Nelems ( material_Nhomogenization , material_Nmicrostructure ) , 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
2014-09-18 20:57:52 +05:30
material_homog ( 1_pInt : FE_Nips ( FE_geomtype ( mesh_element ( 2 , e ) ) ) , e ) = mesh_element ( 3 , 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
2012-01-12 22:01:23 +05:30
homog = mesh_element ( 3 , e )
micro = mesh_element ( 4 , e )
Nelems ( homog , micro ) = Nelems ( homog , micro ) + 1_pInt
2012-01-12 16:06:17 +05:30
enddo
2013-02-25 18:43:52 +05:30
allocate ( elemsOfHomogMicro ( material_Nhomogenization , material_Nmicrostructure ) )
do homog = 1 , material_Nhomogenization
do micro = 1 , material_Nmicrostructure
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
2013-05-29 22:53:49 +05:30
t = FE_geomtype ( mesh_element ( 2 , e ) )
2009-03-04 17:18:54 +05:30
homog = mesh_element ( 3 , e )
micro = mesh_element ( 4 , e )
2013-01-18 17:00:52 +05:30
if ( homog < 1_pInt . or . homog > material_Nhomogenization ) & ! out of bounds
2012-02-13 23:11:27 +05:30
call IO_error ( 154_pInt , e , 0_pInt , 0_pInt )
2013-01-18 17:00:52 +05:30
if ( micro < 1_pInt . or . micro > material_Nmicrostructure ) & ! 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
2013-05-29 22:53:49 +05:30
dGrains = homogenization_Ngrains ( homog ) * FE_Nips ( t ) ! 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
2016-07-13 19:55:27 +05:30
homogenizationLoop : do homog = 1_pInt , material_Nhomogenization
2013-01-18 17:00:52 +05:30
dGrains = homogenization_Ngrains ( homog ) ! grain number per material point
2016-07-13 19:55:27 +05:30
microstructureLoop : do micro = 1_pInt , material_Nmicrostructure ! all pairs of homog and micro
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
2012-11-16 04:15:20 +05:30
t = FE_geomtype ( mesh_element ( 2 , e ) )
2013-01-18 17:00:52 +05:30
if ( microstructure_elemhomo ( micro ) ) then ! homogeneous distribution of grains over each element's IPs
2012-11-16 04:15:20 +05:30
volumeOfGrain ( grain + 1_pInt : grain + dGrains ) = sum ( mesh_ipVolume ( 1 : FE_Nips ( t ) , 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
2013-01-18 17:00:52 +05:30
forall ( i = 1_pInt : FE_Nips ( t ) ) & ! 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
2013-05-29 22:53:49 +05:30
grain = grain + FE_Nips ( t ) * 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
!--------------------------------------------------------------------------------------------------
2013-05-29 22:53:49 +05:30
! ...has texture components
2013-01-18 17:00:52 +05:30
if ( texture_ODFfile ( textureID ) == '' ) then
2013-05-29 22:53:49 +05:30
gauss : do t = 1_pInt , texture_Ngauss ( textureID ) ! loop over Gauss components
2016-05-25 11:22:56 +05:30
do g = 1_pInt , int ( real ( myNorientations , pReal ) * texture_Gauss ( 5 , t , textureID ) , pInt ) ! loop over required grain count
2009-03-04 17:18:54 +05:30
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleGaussOri ( texture_Gauss ( 1 : 3 , t , textureID ) , &
texture_Gauss ( 4 , t , textureID ) )
enddo
2013-05-29 22:53:49 +05:30
constituentGrain = &
2016-05-25 11:22:56 +05:30
constituentGrain + int ( real ( myNorientations , pReal ) * texture_Gauss ( 5 , t , textureID ) ) ! advance counter for grains of current constituent
2013-05-29 22:53:49 +05:30
enddo gauss
2009-03-04 17:18:54 +05:30
2013-05-29 22:53:49 +05:30
fiber : do t = 1_pInt , texture_Nfiber ( textureID ) ! loop over fiber components
2016-05-25 11:22:56 +05:30
do g = 1_pInt , int ( real ( myNorientations , pReal ) * texture_Fiber ( 6 , t , textureID ) , pInt ) ! loop over required grain count
2009-03-04 17:18:54 +05:30
orientationOfGrain ( : , grain + constituentGrain + g ) = &
math_sampleFiberOri ( texture_Fiber ( 1 : 2 , t , textureID ) , &
texture_Fiber ( 3 : 4 , t , textureID ) , &
texture_Fiber ( 5 , t , textureID ) )
enddo
2013-05-29 22:53:49 +05:30
constituentGrain = &
2016-05-27 15:16:34 +05:30
constituentGrain + int ( real ( myNorientations , pReal ) * texture_fiber ( 6 , t , textureID ) , pInt ) ! advance counter for grains of current constituent
2013-05-29 22:53:49 +05:30
enddo fiber
2009-03-04 17:18:54 +05:30
2013-05-29 22:53:49 +05:30
random : do constituentGrain = constituentGrain + 1_pInt , myNorientations ! fill remainder with random
orientationOfGrain ( : , grain + constituentGrain ) = math_sampleRandomOri ( )
enddo random
!--------------------------------------------------------------------------------------------------
! ...has hybrid IA
2013-01-18 17:00:52 +05:30
else
2013-05-29 22:53:49 +05:30
orientationOfGrain ( 1 : 3 , grain + 1_pInt : grain + myNorientations ) = &
IO_hybridIA ( myNorientations , texture_ODFfile ( textureID ) )
2016-05-27 15:16:34 +05:30
if ( all ( dEq ( orientationOfGrain ( 1 : 3 , grain + 1_pInt ) , - 1.0_pReal ) ) ) call IO_error ( 156_pInt )
2013-05-29 22:53:49 +05:30
endif
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
2012-11-21 22:27:57 +05:30
t = FE_geomtype ( mesh_element ( 2 , e ) )
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
2013-05-29 22:53:49 +05:30
m = FE_Nips ( t ) ! process all IPs
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
do i = i , FE_Nips ( t ) ! loop over IPs to (possibly) distribute copies from first IP
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
2009-05-26 22:54:42 +05:30
deallocate ( volumeOfGrain )
2009-03-04 17:18:54 +05:30
deallocate ( phaseOfGrain )
2011-03-22 19:10:27 +05:30
deallocate ( textureOfGrain )
2009-03-04 17:18:54 +05:30
deallocate ( orientationOfGrain )
2016-11-10 11:23:47 +05:30
deallocate ( texture_transformation )
2012-01-12 22:01:23 +05:30
deallocate ( Nelems )
deallocate ( elemsOfHomogMicro )
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