From d97f515b77bb4a7226449538e5886c9d29ff438c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 13:56:24 +0100 Subject: [PATCH 01/12] polishing RGC numerics is still annoying (and was probably never used in the last 10 years) --- src/homogenization.f90 | 36 ++++++++++++-------------- src/homogenization_mechanical.f90 | 37 ++++++++++----------------- src/homogenization_mechanical_RGC.f90 | 15 ++++++----- 3 files changed, 39 insertions(+), 49 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8539df994..c9212e764 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -66,15 +66,13 @@ module homogenization !-------------------------------------------------------------------------------------------------- interface - module subroutine mechanical_init(num_homog) - class(tNode), pointer, intent(in) :: & - num_homog !< pointer to mechanical homogenization numerics data + module subroutine mechanical_init() end subroutine mechanical_init - module subroutine thermal_init + module subroutine thermal_init() end subroutine thermal_init - module subroutine damage_init + module subroutine damage_init() end subroutine damage_init module subroutine mechanical_partition(subF,ce) @@ -204,15 +202,15 @@ subroutine homogenization_init() allocate(homogState (size(material_name_homogenization))) allocate(damageState_h (size(material_name_homogenization))) - call material_parseHomogenization() + call parseHomogenization() num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) - num%nMPstate = num_homogGeneric%get_asInt('nMPstate',defaultVal=10) + num%nMPstate = num_homogGeneric%get_asInt('nMPstate',defaultVal=10) if (num%nMPstate < 1) call IO_error(301,ext_msg='nMPstate') - call mechanical_init(num_homog) + call mechanical_init() call thermal_init() call damage_init() @@ -323,13 +321,13 @@ subroutine homogenization_mechanical_response2(Delta_t,FEsolving_execIP,FEsolvin elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) ce = (el-1)*discretization_nIPs + ip - ho = material_homogenizationID(ce) - do co = 1, homogenization_Nconstituents(ho) - call crystallite_orientations(co,ip,el) - enddo - call mechanical_homogenize(Delta_t,ce) - enddo IpLooping3 - enddo elementLooping3 + ho = material_homogenizationID(ce) + do co = 1, homogenization_Nconstituents(ho) + call crystallite_orientations(co,ip,el) + end do + call mechanical_homogenize(Delta_t,ce) + end do IpLooping3 + end do elementLooping3 !$OMP END PARALLEL DO @@ -447,7 +445,7 @@ end subroutine homogenization_restartRead !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part from the material configuration !-------------------------------------------------------------------------------------------------- -subroutine material_parseHomogenization +subroutine parseHomogenization class(tNode), pointer :: & material_homogenization, & @@ -459,8 +457,8 @@ subroutine material_parseHomogenization material_homogenization => config_material%get('homogenization') - allocate(thermal_type(size(material_name_homogenization)), source=THERMAL_isothermal_ID) - allocate(damage_type (size(material_name_homogenization)), source=DAMAGE_none_ID) + allocate(thermal_type(size(material_name_homogenization)),source=THERMAL_isothermal_ID) + allocate(damage_type (size(material_name_homogenization)),source=DAMAGE_none_ID) do h=1, size(material_name_homogenization) homog => material_homogenization%get(h) @@ -486,7 +484,7 @@ subroutine material_parseHomogenization endif enddo -end subroutine material_parseHomogenization +end subroutine parseHomogenization end module homogenization diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index 1280a9cf3..55ca8c920 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -7,15 +7,13 @@ submodule(homogenization) mechanical interface - module subroutine pass_init + module subroutine pass_init() end subroutine pass_init - module subroutine isostrain_init + module subroutine isostrain_init() end subroutine isostrain_init - module subroutine RGC_init(num_homogMech) - class(tNode), pointer, intent(in) :: & - num_homogMech !< pointer to mechanical homogenization numerics data + module subroutine RGC_init() end subroutine RGC_init @@ -60,27 +58,20 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief Allocate variables and set parameters. !-------------------------------------------------------------------------------------------------- -module subroutine mechanical_init(num_homog) - - class(tNode), pointer, intent(in) :: & - num_homog - - class(tNode), pointer :: & - num_homogMech +module subroutine mechanical_init() print'(/,1x,a)', '<<<+- homogenization:mechanical init -+>>>' - call material_parseHomogenization2() + call parseMechanical() - allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) - homogenization_F0 = spread(math_I3,3,discretization_nIPs*discretization_Nelems) ! initialize to identity - homogenization_F = homogenization_F0 ! initialize to identity - allocate(homogenization_P(3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) + allocate(homogenization_dPdF(3,3,3,3,discretization_Ncells), source=0.0_pReal) + homogenization_F0 = spread(math_I3,3,discretization_Ncells) + homogenization_F = homogenization_F0 + allocate(homogenization_P(3,3,discretization_Ncells),source=0.0_pReal) - num_homogMech => num_homog%get('mech',defaultVal=emptyDict) - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call pass_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call RGC_init(num_homogMech) + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call pass_init() + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call isostrain_init() + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call RGC_init() end subroutine mechanical_init @@ -210,7 +201,7 @@ end subroutine mechanical_results !-------------------------------------------------------------------------------------------------- !> @brief parses the homogenization part from the material configuration !-------------------------------------------------------------------------------------------------- -subroutine material_parseHomogenization2() +subroutine parseMechanical() class(tNode), pointer :: & material_homogenization, & @@ -238,7 +229,7 @@ subroutine material_parseHomogenization2() end select end do -end subroutine material_parseHomogenization2 +end subroutine parseMechanical end submodule mechanical diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 76ff8cab5..2bf4671ad 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -71,10 +71,7 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -module subroutine RGC_init(num_homogMech) - - class(tNode), pointer, intent(in) :: & - num_homogMech !< pointer to mechanical homogenization numerics data +module subroutine RGC_init() integer :: & ho, & @@ -82,6 +79,8 @@ module subroutine RGC_init(num_homogMech) sizeState, nIntFaceTot class (tNode), pointer :: & + num_homogenization, & + num_mechanical, & num_RGC, & ! pointer to RGC numerics data material_homogenization, & homog, & @@ -105,7 +104,9 @@ module subroutine RGC_init(num_homogMech) allocate(state0(material_homogenization%length)) allocate(dependentState(material_homogenization%length)) - num_RGC => num_homogMech%get('RGC',defaultVal=emptyDict) + num_homogenization => config_numerics%get('homogenization',defaultVal=emptyDict) + num_mechanical => num_homogenization%get('mechanical',defaultVal=emptyDict) + num_RGC => num_mechanical%get('RGC',defaultVal=emptyDict) num%atol = num_RGC%get_asFloat('atol', defaultVal=1.0e+4_pReal) num%rtol = num_RGC%get_asFloat('rtol', defaultVal=1.0e-3_pReal) @@ -171,8 +172,8 @@ module subroutine RGC_init(num_homogMech) allocate(homogState(ho)%state0 (sizeState,Nmembers), source=0.0_pReal) allocate(homogState(ho)%state (sizeState,Nmembers), source=0.0_pReal) - stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:) - st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:) + stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:) + st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:) allocate(dst%volumeDiscrepancy( Nmembers), source=0.0_pReal) allocate(dst%relaxationRate_avg( Nmembers), source=0.0_pReal) From b44a862a8a5acfa2704f3e5116445fb6584cecfc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 14:19:11 +0100 Subject: [PATCH 02/12] data structures to output mechanical results (homogenization) --- src/homogenization.f90 | 2 +- src/homogenization_mechanical.f90 | 33 +++++++++++++++++++++---------- src/phase_mechanical.f90 | 25 ++++++++++++----------- 3 files changed, 37 insertions(+), 23 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c9212e764..c259825c3 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -32,7 +32,7 @@ module homogenization HOMOGENIZATION_RGC_ID end enum - type(tState), allocatable, dimension(:), public :: & + type(tState), allocatable, dimension(:), public :: & homogState, & damageState_h diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index 55ca8c920..6a42e6a87 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -50,6 +50,12 @@ submodule(homogenization) mechanical end interface + type :: tOutput !< requested output (per phase) + character(len=pStringLen), allocatable, dimension(:) :: & + label + end type tOutput + type(tOutput), allocatable, dimension(:) :: output_mechanical + integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable :: & homogenization_type !< type of each homogenization @@ -206,26 +212,33 @@ subroutine parseMechanical() class(tNode), pointer :: & material_homogenization, & homog, & - homogMech + mechanical + + integer :: ho - integer :: h material_homogenization => config_material%get('homogenization') allocate(homogenization_type(size(material_name_homogenization)), source=HOMOGENIZATION_undefined_ID) + allocate(output_mechanical(size(material_name_homogenization))) - do h=1, size(material_name_homogenization) - homog => material_homogenization%get(h) - homogMech => homog%get('mechanical') - select case (homogMech%get_asString('type')) + do ho=1, size(material_name_homogenization) + homog => material_homogenization%get(ho) + mechanical => homog%get('mechanical') +#if defined(__GFORTRAN__) + output_mechanical(ho)%label = output_as1dString(mechanical) +#else + output_mechanical(ho)%label = mechanical%get_as1dString('output',defaultVal=emptyStringArray) +#endif + select case (mechanical%get_asString('type')) case('pass') - homogenization_type(h) = HOMOGENIZATION_NONE_ID + homogenization_type(ho) = HOMOGENIZATION_NONE_ID case('isostrain') - homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID + homogenization_type(ho) = HOMOGENIZATION_ISOSTRAIN_ID case('RGC') - homogenization_type(h) = HOMOGENIZATION_RGC_ID + homogenization_type(ho) = HOMOGENIZATION_RGC_ID case default - call IO_error(500,ext_msg=homogMech%get_asString('type')) + call IO_error(500,ext_msg=mechanical%get_asString('type')) end select end do diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 05866a3e1..37a183b27 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -180,11 +180,12 @@ submodule(phase) mechanical end function elastic_nu end interface - type :: tOutput !< new requested output (per phase) + + type :: tOutput !< requested output (per phase) character(len=pStringLen), allocatable, dimension(:) :: & label end type tOutput - type(tOutput), allocatable, dimension(:) :: output_constituent + type(tOutput), allocatable, dimension(:) :: output_mechanical procedure(integrateStateFPI), pointer :: integrateState @@ -216,7 +217,7 @@ module subroutine mechanical_init(phases) print'(/,1x,a)', '<<<+- phase:mechanical init -+>>>' !------------------------------------------------------------------------------------------------- - allocate(output_constituent(phases%length)) + allocate(output_mechanical(phases%length)) allocate(phase_mechanical_Fe(phases%length)) allocate(phase_mechanical_Fi(phases%length)) @@ -251,12 +252,12 @@ module subroutine mechanical_init(phases) allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal) allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal) - phase => phases%get(ph) - mech => phase%get('mechanical') + phase => phases%get(ph) + mech => phase%get('mechanical') #if defined(__GFORTRAN__) - output_constituent(ph)%label = output_as1dString(mech) + output_mechanical(ph)%label = output_as1dString(mech) #else - output_constituent(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray) + output_mechanical(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray) #endif enddo @@ -891,9 +892,9 @@ subroutine crystallite_results(group,ph) call results_closeGroup(results_addGroup(group//'/mechanical')) - do ou = 1, size(output_constituent(ph)%label) + do ou = 1, size(output_mechanical(ph)%label) - select case (output_constituent(ph)%label(ou)) + select case (output_mechanical(ph)%label(ou)) case('F') call results_writeDataset(phase_mechanical_F(ph)%data,group//'/mechanical/','F',& 'deformation gradient','1') @@ -919,11 +920,11 @@ subroutine crystallite_results(group,ph) call results_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', & 'second Piola-Kirchhoff stress','Pa') case('O') - call results_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical',output_constituent(ph)%label(ou),& + call results_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical',output_mechanical(ph)%label(ou),& 'crystal orientation as quaternion','q_0 (q_1 q_2 q_3)') - call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/'//output_constituent(ph)%label(ou)) + call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/'//output_mechanical(ph)%label(ou)) if (any(phase_lattice(ph) == ['hP', 'tI'])) & - call results_addAttribute('c/a',phase_cOverA(ph),group//'/mechanical/'//output_constituent(ph)%label(ou)) + call results_addAttribute('c/a',phase_cOverA(ph),group//'/mechanical/'//output_mechanical(ph)%label(ou)) end select enddo From 968e55b0bcb35178c93a18c320d16e525b82acf5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 15:35:38 +0100 Subject: [PATCH 03/12] output homogogenized F and P was disabled for historic reasons only --- PRIVATE | 2 +- src/homogenization_mechanical.f90 | 19 +++++++++++++------ src/phase_mechanical.f90 | 8 ++++---- 3 files changed, 18 insertions(+), 11 deletions(-) diff --git a/PRIVATE b/PRIVATE index 857b994fb..0f9076b0b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 857b994fb7222ab15a2b8c4ded2bba8787d7feb6 +Subproject commit 0f9076b0b589f5134b0304f6676e0076b99d887f diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index 6a42e6a87..c4b74a15d 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -182,8 +182,10 @@ module subroutine mechanical_results(group_base,ho) character(len=*), intent(in) :: group_base integer, intent(in) :: ho + integer :: ou character(len=:), allocatable :: group + group = trim(group_base)//'/mechanical' call results_closeGroup(results_addGroup(group)) @@ -194,12 +196,17 @@ module subroutine mechanical_results(group_base,ho) end select - !temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems]) - !call results_writeDataset(group,temp,'F',& - ! 'deformation gradient','1') - !temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems]) - !call results_writeDataset(group,temp,'P',& - ! '1st Piola-Kirchhoff stress','Pa') + do ou = 1, size(output_mechanical(1)%label) + + select case (output_mechanical(ho)%label(ou)) + case('F') + call results_writeDataset(reshape(homogenization_F,[3,3,discretization_nCells]),group,'F', & + 'deformation gradient','1') + case('P') + call results_writeDataset(reshape(homogenization_P,[3,3,discretization_nCells]),group,'P', & + 'deformation gradient','1') + end select + end do end subroutine mechanical_results diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 37a183b27..882110bc3 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -331,7 +331,7 @@ module subroutine mechanical_results(group,ph) integer, intent(in) :: ph - call crystallite_results(group,ph) + call results(group,ph) select case(phase_plasticity(ph)) @@ -882,7 +882,7 @@ end function integrateStateRK !-------------------------------------------------------------------------------------------------- !> @brief writes crystallite results to HDF5 output file !-------------------------------------------------------------------------------------------------- -subroutine crystallite_results(group,ph) +subroutine results(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph @@ -926,7 +926,7 @@ subroutine crystallite_results(group,ph) if (any(phase_lattice(ph) == ['hP', 'tI'])) & call results_addAttribute('c/a',phase_cOverA(ph),group//'/mechanical/'//output_mechanical(ph)%label(ou)) end select - enddo + end do contains @@ -948,7 +948,7 @@ subroutine crystallite_results(group,ph) end function to_quaternion -end subroutine crystallite_results +end subroutine results !-------------------------------------------------------------------------------------------------- From dce8f9e635084ee0f663ab280253169d82c2e269 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 18:56:41 +0100 Subject: [PATCH 04/12] enable output of temperature per phase --- PRIVATE | 2 +- src/homogenization.f90 | 2 +- src/homogenization_thermal.f90 | 12 +++++- src/homogenization_thermal_isotemperature.f90 | 5 ++- src/homogenization_thermal_pass.f90 | 5 ++- src/phase.f90 | 6 +++ src/phase_damage.f90 | 2 +- src/phase_mechanical.f90 | 3 +- src/phase_thermal.f90 | 37 +++++++++++++++++++ 9 files changed, 65 insertions(+), 9 deletions(-) diff --git a/PRIVATE b/PRIVATE index 0f9076b0b..0ef96051a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 0f9076b0b589f5134b0304f6676e0076b99d887f +Subproject commit 0ef96051aa5bda4f8e3c22d6a2e0be3853e4ca7d diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c259825c3..ff31447d5 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -466,7 +466,7 @@ subroutine parseHomogenization if (homog%contains('thermal')) then homogThermal => homog%get('thermal') select case (homogThermal%get_asString('type')) - case('pass') + case('pass','isotemperature') thermal_type(h) = THERMAL_conduction_ID case default call IO_error(500,ext_msg=homogThermal%get_asString('type')) diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 9aa727041..db15a355e 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -56,6 +56,7 @@ module subroutine thermal_init() allocate(current(ho)%dot_T(count(material_homogenizationID==ho)), source=0.0_pReal) configHomogenization => configHomogenizations%get(ho) associate(prm => param(ho)) + if (configHomogenization%contains('thermal')) then configHomogenizationThermal => configHomogenization%get('thermal') #if defined (__GFORTRAN__) @@ -63,13 +64,22 @@ module subroutine thermal_init() #else prm%output = configHomogenizationThermal%get_as1dString('output',defaultVal=emptyStringArray) #endif + select case (configHomogenizationThermal%get_asString('type')) + + case ('pass') + call pass_init() + + case ('isothermal') + call isotemperature_init() + + end select else prm%output = emptyStringArray end if + end associate end do - call pass_init() end subroutine thermal_init diff --git a/src/homogenization_thermal_isotemperature.f90 b/src/homogenization_thermal_isotemperature.f90 index 7358ecf08..9733890d3 100644 --- a/src/homogenization_thermal_isotemperature.f90 +++ b/src/homogenization_thermal_isotemperature.f90 @@ -1,13 +1,14 @@ !-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, KU Leuven -!> @brief Dummy homogenization scheme for 1 constituent per material point +!> @brief Isotemperature homogenization !-------------------------------------------------------------------------------------------------- submodule(homogenization:thermal) isotemperature contains -module subroutine isotemperature_init +module subroutine isotemperature_init() + print'(/,1x,a)', '<<<+- homogenization:thermal:isotemperature init -+>>>' end subroutine isotemperature_init diff --git a/src/homogenization_thermal_pass.f90 b/src/homogenization_thermal_pass.f90 index 2673c2789..ac12aa0b1 100644 --- a/src/homogenization_thermal_pass.f90 +++ b/src/homogenization_thermal_pass.f90 @@ -7,9 +7,12 @@ submodule(homogenization:thermal) thermal_pass contains module subroutine pass_init() - + print'(/,1x,a)', '<<<+- homogenization:thermal:pass init -+>>>' + if (homogenization_Nconstituents(1) /= 1) & + call IO_error(211,ext_msg='N_constituents (pass)') + end subroutine pass_init end submodule thermal_pass diff --git a/src/phase.f90 b/src/phase.f90 index c161fb48c..9987a5252 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -91,6 +91,11 @@ module phase integer, intent(in) :: ph end subroutine damage_results + module subroutine thermal_results(group,ph) + character(len=*), intent(in) :: group + integer, intent(in) :: ph + end subroutine thermal_results + module subroutine mechanical_forward() end subroutine mechanical_forward @@ -487,6 +492,7 @@ subroutine phase_results() call mechanical_results(group,ph) call damage_results(group,ph) + call thermal_results(group,ph) end do diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index e4700938f..9022131e2 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -336,7 +336,7 @@ end subroutine damage_results !-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!> @brief Constitutive equation for calculating the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- function phase_damage_collectDotState(ph,en) result(broken) diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 882110bc3..4c4e703f0 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -880,7 +880,7 @@ end function integrateStateRK !-------------------------------------------------------------------------------------------------- -!> @brief writes crystallite results to HDF5 output file +!> @brief Write mechanical results to HDF5 output file. !-------------------------------------------------------------------------------------------------- subroutine results(group,ph) @@ -1336,5 +1336,4 @@ module subroutine phase_set_F(F,co,ce) end subroutine phase_set_F - end submodule mechanical diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index 11314531e..924ae2f5d 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -6,6 +6,7 @@ submodule(phase) thermal type :: tThermalParameters real(pReal) :: C_p = 0.0_pReal !< heat capacity real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity + character(len=pStringLen), allocatable, dimension(:) :: output end type tThermalParameters integer, dimension(:), allocatable :: & @@ -108,6 +109,11 @@ module subroutine thermal_init(phases) if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%K(3,3) = thermal%get_asFloat('K_33') param(ph)%K = lattice_symmetrize_33(param(ph)%K,phase_lattice(ph)) +#if defined(__GFORTRAN__) + param(ph)%output = output_as1dString(thermal) +#else + param(ph)%output = thermal%get_as1dString('output',defaultVal=emptyStringArray) +#endif sources => thermal%get('source',defaultVal=emptyList) thermal_Nsources(ph) = sources%length else @@ -381,4 +387,35 @@ function thermal_active(source_label,src_length) result(active_source) end function thermal_active +!---------------------------------------------------------------------------------------------- +!< @brief writes damage sources results to HDF5 output file +!---------------------------------------------------------------------------------------------- +module subroutine thermal_results(group,ph) + + character(len=*), intent(in) :: group + integer, intent(in) :: ph + + + integer :: ou + + if (allocated(param(ph)%output)) then + call results_closeGroup(results_addGroup(group//'thermal')) + else + return + endif + + do ou = 1, size(param(ph)%output) + + select case(trim(param(ph)%output(ou))) + + case ('T') + call results_writeDataset(current(ph)%T,group//'thermal','T', 'temperature','T') + + end select + + end do + +end subroutine thermal_results + + end submodule thermal From 2f08624c18c00b395bbf3da886a9c8cf37b17a85 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 21:42:38 +0100 Subject: [PATCH 05/12] Use centrally defined room temperature --- src/homogenization.f90 | 3 ++- src/homogenization_thermal.f90 | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ff31447d5..107a6ba8b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -6,9 +6,10 @@ !-------------------------------------------------------------------------------------------------- module homogenization use prec + use math + use constants use IO use config - use math use material use phase use discretization diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index db15a355e..b7110a6f9 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -52,7 +52,7 @@ module subroutine thermal_init() allocate(current(configHomogenizations%length)) do ho = 1, configHomogenizations%length - allocate(current(ho)%T(count(material_homogenizationID==ho)), source=300.0_pReal) + allocate(current(ho)%T(count(material_homogenizationID==ho)), source=T_ROOM) allocate(current(ho)%dot_T(count(material_homogenizationID==ho)), source=0.0_pReal) configHomogenization => configHomogenizations%get(ho) associate(prm => param(ho)) From 4cc7f94eefd32770f29a757a2c89e2a84dfd718f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 23:10:05 +0100 Subject: [PATCH 06/12] guide the user --- .../homogenization/Homogenization_Isostrain_Parallel3.config | 4 ---- examples/config/phase/thermal/Al.yaml | 2 ++ examples/config/phase/thermal/Cu.yaml | 2 ++ examples/config/phase/thermal/Fe.yaml | 2 ++ examples/config/phase/thermal/Ni.yaml | 2 ++ examples/config/phase/thermal/Sn-beta.yaml | 2 ++ examples/config/phase/thermal/W.yaml | 2 ++ 7 files changed, 12 insertions(+), 4 deletions(-) delete mode 100644 examples/config/homogenization/Homogenization_Isostrain_Parallel3.config diff --git a/examples/config/homogenization/Homogenization_Isostrain_Parallel3.config b/examples/config/homogenization/Homogenization_Isostrain_Parallel3.config deleted file mode 100644 index 29c9d2238..000000000 --- a/examples/config/homogenization/Homogenization_Isostrain_Parallel3.config +++ /dev/null @@ -1,4 +0,0 @@ -[Parallel3] -mech isostrain -nconstituents 3 -mapping sum # or 'parallel' diff --git a/examples/config/phase/thermal/Al.yaml b/examples/config/phase/thermal/Al.yaml index d2015a5b2..1276f9a3f 100644 --- a/examples/config/phase/thermal/Al.yaml +++ b/examples/config/phase/thermal/Al.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 3.4.1 (RRR=1000, T_min=200K, T_max=900K) - https://www.engineeringtoolbox.com/specific-heat-metals-d_152.html +output: [T] + K_11: 2.380e+2 K_11,T: 2.068e-3 K_11,T^2: -7.765e-5 diff --git a/examples/config/phase/thermal/Cu.yaml b/examples/config/phase/thermal/Cu.yaml index 332ef7cc0..3875dc8ef 100644 --- a/examples/config/phase/thermal/Cu.yaml +++ b/examples/config/phase/thermal/Cu.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 2.4.1 (RRR=1000, T_min=200K, T_max=1000K) - https://www.mit.edu/~6.777/matprops/copper.htm +output: [T] + K_11: 4.039e+2 K_11,T: -8.119e-2 K_11,T^2: 1.454e-5 diff --git a/examples/config/phase/thermal/Fe.yaml b/examples/config/phase/thermal/Fe.yaml index a8e06ed04..b569683f0 100644 --- a/examples/config/phase/thermal/Fe.yaml +++ b/examples/config/phase/thermal/Fe.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 4.4.1 (RRR=300, T_min=200K, T_max=1000K) - https://www.engineeringtoolbox.com/specific-heat-metals-d_152.html +output: [T] + K_11: 8.055e+1 K_11,T: -1.051e-1 K_11,T^2: 5.464e-5 diff --git a/examples/config/phase/thermal/Ni.yaml b/examples/config/phase/thermal/Ni.yaml index d71c15a3f..6544c197b 100644 --- a/examples/config/phase/thermal/Ni.yaml +++ b/examples/config/phase/thermal/Ni.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 35R (T_min=150K, T_max=500K) - https://www.engineeringtoolbox.com/specific-heat-metals-d_152.html +output: [T] + K_11: 9.132e+1 K_11,T: -1.525e-1 K_11,T^2: 3.053e-4 diff --git a/examples/config/phase/thermal/Sn-beta.yaml b/examples/config/phase/thermal/Sn-beta.yaml index a4d16cd98..99f2c3cee 100644 --- a/examples/config/phase/thermal/Sn-beta.yaml +++ b/examples/config/phase/thermal/Sn-beta.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 61R (T_min=100K, T_max=400K) - https://www.engineeringtoolbox.com/specific-heat-metals-d_152.html +output: [T] + K_11: 7.414e+1 K_11,T: -6.465e-2 K_11,T^2: 2.066e-4 diff --git a/examples/config/phase/thermal/W.yaml b/examples/config/phase/thermal/W.yaml index fb01c285a..5a9cb475f 100644 --- a/examples/config/phase/thermal/W.yaml +++ b/examples/config/phase/thermal/W.yaml @@ -5,6 +5,8 @@ references: fit to Tab. 5.4.1 (RRR=300, T_min=200K, T_max=1000K) - https://www.mit.edu/~6.777/matprops/tungsten.htm +output: [T] + K_11: 1.758e+2 K_11,T: -1.605e-1 K_11,T^2: 1.160e-4 From 909e1461b94dfd262511670df8d9ad96d5e6fdf3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Feb 2022 23:11:10 +0100 Subject: [PATCH 07/12] show thermal options --- .../config/homogenization/mechanical/isostrain_Taylor2.yaml | 4 +++- examples/config/homogenization/mechanical/pass_SX.yaml | 5 +++++ .../homogenization/thermal/isotemperature_2constituents.yaml | 5 +++++ examples/config/homogenization/thermal/pass_SX.yaml | 5 +++++ 4 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 examples/config/homogenization/mechanical/pass_SX.yaml create mode 100644 examples/config/homogenization/thermal/isotemperature_2constituents.yaml create mode 100644 examples/config/homogenization/thermal/pass_SX.yaml diff --git a/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml b/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml index 3dc20fd87..72b372e72 100644 --- a/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml +++ b/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml @@ -1,3 +1,5 @@ Taylor2: N_constituents: 2 - mechanical: {type: isostrain} + mechanical: + type: isostrain + output: ['F','P'] diff --git a/examples/config/homogenization/mechanical/pass_SX.yaml b/examples/config/homogenization/mechanical/pass_SX.yaml new file mode 100644 index 000000000..f326a8486 --- /dev/null +++ b/examples/config/homogenization/mechanical/pass_SX.yaml @@ -0,0 +1,5 @@ +SX: + N_constituents: 1 + mechanical: + type: pass + output: ['F','P'] diff --git a/examples/config/homogenization/thermal/isotemperature_2constituents.yaml b/examples/config/homogenization/thermal/isotemperature_2constituents.yaml new file mode 100644 index 000000000..e26563d78 --- /dev/null +++ b/examples/config/homogenization/thermal/isotemperature_2constituents.yaml @@ -0,0 +1,5 @@ +2constituents: + N_constituents: 2 + thermal: + type: isotemperature + output: ['T'] diff --git a/examples/config/homogenization/thermal/pass_SX.yaml b/examples/config/homogenization/thermal/pass_SX.yaml new file mode 100644 index 000000000..e79e88df0 --- /dev/null +++ b/examples/config/homogenization/thermal/pass_SX.yaml @@ -0,0 +1,5 @@ +SX: + N_constituents: 1 + thermal: + type: pass + output: ['T'] From 692b6d66ec8dbd80ab036e65e7ec8cca0efab4ac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Feb 2022 06:30:36 +0100 Subject: [PATCH 08/12] following hierarchical structure --- PRIVATE | 2 +- examples/config/homogenization/8grains.yaml | 1 + examples/config/homogenization/bicrystal.yaml | 1 + .../homogenization/damage/pass_direct.yaml | 3 +++ examples/config/homogenization/direct.yaml | 1 + .../homogenization/mechanical/RGC_8grains.yaml | 18 ++++++++---------- .../mechanical/isostrain_Taylor2.yaml | 5 ----- .../mechanical/isostrain_polycrystal.yaml | 3 +++ .../homogenization/mechanical/pass_SX.yaml | 5 ----- .../homogenization/mechanical/pass_direct.yaml | 3 +++ .../thermal/isotemperature_2constituents.yaml | 5 ----- .../thermal/isotemperature_polycrystal.yaml | 3 +++ .../config/homogenization/thermal/pass_SX.yaml | 5 ----- .../homogenization/thermal/pass_direct.yaml | 3 +++ 14 files changed, 27 insertions(+), 31 deletions(-) create mode 100644 examples/config/homogenization/8grains.yaml create mode 100644 examples/config/homogenization/bicrystal.yaml create mode 100644 examples/config/homogenization/damage/pass_direct.yaml create mode 100644 examples/config/homogenization/direct.yaml delete mode 100644 examples/config/homogenization/mechanical/isostrain_Taylor2.yaml create mode 100644 examples/config/homogenization/mechanical/isostrain_polycrystal.yaml delete mode 100644 examples/config/homogenization/mechanical/pass_SX.yaml create mode 100644 examples/config/homogenization/mechanical/pass_direct.yaml delete mode 100644 examples/config/homogenization/thermal/isotemperature_2constituents.yaml create mode 100644 examples/config/homogenization/thermal/isotemperature_polycrystal.yaml delete mode 100644 examples/config/homogenization/thermal/pass_SX.yaml create mode 100644 examples/config/homogenization/thermal/pass_direct.yaml diff --git a/PRIVATE b/PRIVATE index 0ef96051a..7218e3a52 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 0ef96051aa5bda4f8e3c22d6a2e0be3853e4ca7d +Subproject commit 7218e3a52b863665544a541ef1f1ad6ef7bca98c diff --git a/examples/config/homogenization/8grains.yaml b/examples/config/homogenization/8grains.yaml new file mode 100644 index 000000000..a2c0ca391 --- /dev/null +++ b/examples/config/homogenization/8grains.yaml @@ -0,0 +1 @@ +N_constituents: 8 diff --git a/examples/config/homogenization/bicrystal.yaml b/examples/config/homogenization/bicrystal.yaml new file mode 100644 index 000000000..143d0be63 --- /dev/null +++ b/examples/config/homogenization/bicrystal.yaml @@ -0,0 +1 @@ +N_constituents: 2 diff --git a/examples/config/homogenization/damage/pass_direct.yaml b/examples/config/homogenization/damage/pass_direct.yaml new file mode 100644 index 000000000..dd74a4b0d --- /dev/null +++ b/examples/config/homogenization/damage/pass_direct.yaml @@ -0,0 +1,3 @@ +# For single point calculations, requires N_constituents = 1 +type: pass +output: ['T'] diff --git a/examples/config/homogenization/direct.yaml b/examples/config/homogenization/direct.yaml new file mode 100644 index 000000000..5765a29e7 --- /dev/null +++ b/examples/config/homogenization/direct.yaml @@ -0,0 +1 @@ +N_constituents: 1 diff --git a/examples/config/homogenization/mechanical/RGC_8grains.yaml b/examples/config/homogenization/mechanical/RGC_8grains.yaml index 9b70e3645..2506a9bcf 100644 --- a/examples/config/homogenization/mechanical/RGC_8grains.yaml +++ b/examples/config/homogenization/mechanical/RGC_8grains.yaml @@ -1,10 +1,8 @@ -8Grains: - N_constituents: 8 - mechanical: - type: RGC - D_alpha: [4.0e-06, 4.0e-06, 2.0e-06] - a_g: [0.0, 0.0, 0.0] - c_alpha: 2.0 - cluster_size: [2, 2, 2] - output: [M, Delta_V, avg_dot_a, max_dot_a] - xi_alpha: 10.0 +# For Relaxed Grain Cluster homogenization, requires N_constituents = 8 +type: RGC +D_alpha: [4.0e-06, 4.0e-06, 2.0e-06] +a_g: [0.0, 0.0, 0.0] +c_alpha: 2.0 +cluster_size: [2, 2, 2] +output: [M, Delta_V, avg_dot_a, max_dot_a] +xi_alpha: 10.0 diff --git a/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml b/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml deleted file mode 100644 index 72b372e72..000000000 --- a/examples/config/homogenization/mechanical/isostrain_Taylor2.yaml +++ /dev/null @@ -1,5 +0,0 @@ -Taylor2: - N_constituents: 2 - mechanical: - type: isostrain - output: ['F','P'] diff --git a/examples/config/homogenization/mechanical/isostrain_polycrystal.yaml b/examples/config/homogenization/mechanical/isostrain_polycrystal.yaml new file mode 100644 index 000000000..3aed72468 --- /dev/null +++ b/examples/config/homogenization/mechanical/isostrain_polycrystal.yaml @@ -0,0 +1,3 @@ +# For Taylor homogenization with N_constituents > 1 +type: isostrain +output: ['F', 'P'] diff --git a/examples/config/homogenization/mechanical/pass_SX.yaml b/examples/config/homogenization/mechanical/pass_SX.yaml deleted file mode 100644 index f326a8486..000000000 --- a/examples/config/homogenization/mechanical/pass_SX.yaml +++ /dev/null @@ -1,5 +0,0 @@ -SX: - N_constituents: 1 - mechanical: - type: pass - output: ['F','P'] diff --git a/examples/config/homogenization/mechanical/pass_direct.yaml b/examples/config/homogenization/mechanical/pass_direct.yaml new file mode 100644 index 000000000..5e6f0bcd9 --- /dev/null +++ b/examples/config/homogenization/mechanical/pass_direct.yaml @@ -0,0 +1,3 @@ +# For single point calculations, requires N_constituents = 1 +type: pass +output: ['F', 'P'] diff --git a/examples/config/homogenization/thermal/isotemperature_2constituents.yaml b/examples/config/homogenization/thermal/isotemperature_2constituents.yaml deleted file mode 100644 index e26563d78..000000000 --- a/examples/config/homogenization/thermal/isotemperature_2constituents.yaml +++ /dev/null @@ -1,5 +0,0 @@ -2constituents: - N_constituents: 2 - thermal: - type: isotemperature - output: ['T'] diff --git a/examples/config/homogenization/thermal/isotemperature_polycrystal.yaml b/examples/config/homogenization/thermal/isotemperature_polycrystal.yaml new file mode 100644 index 000000000..1e2ca447b --- /dev/null +++ b/examples/config/homogenization/thermal/isotemperature_polycrystal.yaml @@ -0,0 +1,3 @@ +# For homogenization with N_constituents > 1 +type: isotemperature +output: ['T'] diff --git a/examples/config/homogenization/thermal/pass_SX.yaml b/examples/config/homogenization/thermal/pass_SX.yaml deleted file mode 100644 index e79e88df0..000000000 --- a/examples/config/homogenization/thermal/pass_SX.yaml +++ /dev/null @@ -1,5 +0,0 @@ -SX: - N_constituents: 1 - thermal: - type: pass - output: ['T'] diff --git a/examples/config/homogenization/thermal/pass_direct.yaml b/examples/config/homogenization/thermal/pass_direct.yaml new file mode 100644 index 000000000..dd74a4b0d --- /dev/null +++ b/examples/config/homogenization/thermal/pass_direct.yaml @@ -0,0 +1,3 @@ +# For single point calculations, requires N_constituents = 1 +type: pass +output: ['T'] From e82738e067c4d1c3d73d3ceee3dcdb2faacb28f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Feb 2022 21:21:47 +0100 Subject: [PATCH 09/12] testing mesh in parallel works, at least for small examples --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 857b994fb..142be5919 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 857b994fb7222ab15a2b8c4ded2bba8787d7feb6 +Subproject commit 142be5919d4a4e61e9ad909b6ad7a1ca334fc652 From 3a078db6f187a6fca4d6c44d979e5cd0e19f733c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Feb 2022 06:40:17 +0100 Subject: [PATCH 10/12] some guidance for users --- python/damask/_crystal.py | 42 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 40 insertions(+), 2 deletions(-) diff --git a/python/damask/_crystal.py b/python/damask/_crystal.py index 35977af28..1d77b1a09 100644 --- a/python/damask/_crystal.py +++ b/python/damask/_crystal.py @@ -29,7 +29,29 @@ lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = { class Crystal(): - """Crystal lattice.""" + """ + Representation of crystal in terms of crystal family or Bravais lattice. + + Examples + -------- + Cubic crystal family: + + >>> import damask + >>> cubic = damask.Crystal(family='cubic') + >>> cubic + Crystal family: cubic + + Body centered cubic Bravais lattice with parameters of iron: + + >>> import damask + >>> Fe = damask.Crystal(lattice='cI', a=0.287e-9) + >>> Fe + Crystal family: cubic + Bravais lattice: cI + a=2.87e-10m, b=2.87e-10m, c=2.87e-10m + α=90°, β=90°, γ=90° + + """ def __init__(self, *, family: CrystalFamily = None, @@ -38,7 +60,7 @@ class Crystal(): alpha: float = None, beta: float = None, gamma: float = None, degrees: bool = False): """ - Representation of crystal in terms of crystal family or Bravais lattice. + New representation of a crystal. Parameters ---------- @@ -356,6 +378,22 @@ class Crystal(): vector : numpy.ndarray, shape (...,3) Crystal frame vector along [uvw] direction or (hkl) plane normal. + Examples + -------- + Crystal frame vector of Magnesium along [1,0,0] direction: + + >>> import damask + >>> Mg = damask.Crystal(lattice='hP', a=0.321e-9, c=0.521e-9) + >>> Mg.to_frame(uvw=[1, 0, 0]) + array([3.21e-10, 0.00e+00, 0.00e+00]) + + Crystal frame vector of Titanium along (1,0,0) direction: + + >>> import damask + >>> Ti = damask.Crystal(lattice='hP', a=0.295e-9, c=0.469e-9) + >>> Ti.to_frame(hkl=(1, 0, 0)) + array([ 3.38983051e+09, 1.95711956e+09, -4.15134508e-07]) + """ if (uvw is not None) ^ (hkl is None): raise KeyError('specify either "uvw" or "hkl"') From 744f5755ff1529821ee4406c27067a2fa77044ff Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 22 Feb 2022 14:44:56 +0100 Subject: [PATCH 11/12] [skip ci] updated version information after successful test of v3.0.0-alpha6-14-g3657b2316 --- python/damask/VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/damask/VERSION b/python/damask/VERSION index 69fd9e269..940841ff2 100644 --- a/python/damask/VERSION +++ b/python/damask/VERSION @@ -1 +1 @@ -v3.0.0-alpha6-4-gca6a3e786 +v3.0.0-alpha6-14-g3657b2316 From 3d554e40b9196696edd0e7115db387bb9b885811 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 22 Feb 2022 09:12:58 -0500 Subject: [PATCH 12/12] clarify real/reciprocal space coordinates --- python/damask/_crystal.py | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/python/damask/_crystal.py b/python/damask/_crystal.py index 1d77b1a09..984a8549c 100644 --- a/python/damask/_crystal.py +++ b/python/damask/_crystal.py @@ -30,7 +30,7 @@ lattice_symmetries: Dict[CrystalLattice, CrystalFamily] = { class Crystal(): """ - Representation of crystal in terms of crystal family or Bravais lattice. + Representation of a crystal as (general) crystal family or (more specific) as a scaled Bravais lattice. Examples -------- @@ -41,14 +41,14 @@ class Crystal(): >>> cubic Crystal family: cubic - Body centered cubic Bravais lattice with parameters of iron: + Body-centered cubic Bravais lattice with parameters of iron: >>> import damask - >>> Fe = damask.Crystal(lattice='cI', a=0.287e-9) + >>> Fe = damask.Crystal(lattice='cI', a=287e-12) >>> Fe Crystal family: cubic Bravais lattice: cI - a=2.87e-10m, b=2.87e-10m, c=2.87e-10m + a=2.87e-10 m, b=2.87e-10 m, c=2.87e-10 m α=90°, β=90°, γ=90° """ @@ -136,10 +136,10 @@ class Crystal(): """Represent.""" family = f'Crystal family: {self.family}' return family if self.lattice is None else \ - '\n'.join([family, - f'Bravais lattice: {self.lattice}', - 'a={:.5g}m, b={:.5g}m, c={:.5g}m'.format(*self.parameters[:3]), - 'α={:.5g}°, β={:.5g}°, γ={:.5g}°'.format(*np.degrees(self.parameters[3:]))]) + util.srepr([family, + f'Bravais lattice: {self.lattice}', + 'a={:.5g} m, b={:.5g} m, c={:.5g} m'.format(*self.parameters[:3]), + 'α={:.5g}°, β={:.5g}°, γ={:.5g}°'.format(*np.degrees(self.parameters[3:]))]) def __eq__(self, @@ -345,7 +345,8 @@ class Crystal(): Parameters ---------- direction|plane : numpy.ndarray, shape (...,3) - Vector along direction or plane normal. + Real space vector along direction or + reciprocal space vector along plane normal. Returns ------- @@ -366,7 +367,7 @@ class Crystal(): uvw: FloatSequence = None, hkl: FloatSequence = None) -> np.ndarray: """ - Calculate crystal frame vector along lattice direction [uvw] or plane normal (hkl). + Calculate crystal frame vector corresponding to lattice direction [uvw] or plane normal (hkl). Parameters ---------- @@ -376,18 +377,19 @@ class Crystal(): Returns ------- vector : numpy.ndarray, shape (...,3) - Crystal frame vector along [uvw] direction or (hkl) plane normal. + Crystal frame vector in real space along [uvw] direction or + in reciprocal space along (hkl) plane normal. Examples -------- - Crystal frame vector of Magnesium along [1,0,0] direction: + Crystal frame vector (real space) of Magnesium corresponding to [1,1,0] direction: >>> import damask - >>> Mg = damask.Crystal(lattice='hP', a=0.321e-9, c=0.521e-9) - >>> Mg.to_frame(uvw=[1, 0, 0]) - array([3.21e-10, 0.00e+00, 0.00e+00]) + >>> Mg = damask.Crystal(lattice='hP', a=321e-12, c=521e-12) + >>> Mg.to_frame(uvw=[1, 1, 0]) + array([1.60500000e-10, 2.77994155e-10, 0.00000000e+00]) - Crystal frame vector of Titanium along (1,0,0) direction: + Crystal frame vector (reciprocal space) of Titanium along (1,0,0) plane normal: >>> import damask >>> Ti = damask.Crystal(lattice='hP', a=0.295e-9, c=0.469e-9)