From 7754a1ea56d231e0b4ac5513a59fbc4a03f83d8b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Sat, 15 Aug 2020 16:02:10 +0200 Subject: [PATCH] Restructuring for material.yaml --- PRIVATE | 2 +- .../Polycrystal/material.config | 126 ---- .../SpectralMethod/Polycrystal/material.yaml | 123 ++++ src/CPFEM.f90 | 5 +- src/CPFEM2.f90 | 5 +- src/DAMASK_marc.f90 | 3 +- src/HDF5_utilities.f90 | 2 +- src/IO.f90 | 10 +- src/YAML_parse.f90 | 50 +- src/YAML_types.f90 | 130 +++- src/commercialFEM_fileList.f90 | 5 +- src/config.f90 | 331 +++------ src/constitutive.f90 | 238 ++++++- src/constitutive_damage.f90 | 90 ++- src/constitutive_plastic.f90 | 134 ++-- ...=> constitutive_plastic_disloTungsten.f90} | 176 ++--- src/constitutive_plastic_dislotwin.f90 | 276 ++++---- src/constitutive_plastic_isotropic.f90 | 83 ++- src/constitutive_plastic_kinehardening.f90 | 123 ++-- src/constitutive_plastic_none.f90 | 38 +- src/constitutive_plastic_nonlocal.f90 | 365 +++++----- src/constitutive_plastic_phenopowerlaw.f90 | 156 ++-- src/constitutive_thermal.f90 | 31 +- src/crystallite.f90 | 70 +- src/damage_local.f90 | 26 +- src/damage_none.f90 | 4 +- src/damage_nonlocal.f90 | 25 +- src/debug.f90 | 50 -- src/grid/DAMASK_grid.f90 | 1 - src/grid/discretization_grid.f90 | 3 +- src/grid/grid_damage_spectral.f90 | 2 +- src/grid/grid_mech_FEM.f90 | 3 +- src/grid/grid_mech_spectral_basic.f90 | 2 - src/grid/grid_mech_spectral_polarisation.f90 | 2 - src/grid/grid_thermal_spectral.f90 | 2 +- src/grid/spectral_utilities.f90 | 2 - src/homogenization.f90 | 7 +- src/homogenization_mech_RGC.f90 | 56 +- src/homogenization_mech_isostrain.f90 | 24 +- src/homogenization_mech_none.f90 | 2 +- src/kinematics_cleavage_opening.f90 | 83 ++- src/kinematics_slipplane_opening.f90 | 101 +-- src/kinematics_thermal_expansion.f90 | 69 +- src/lattice.f90 | 64 +- src/marc/discretization_marc.f90 | 3 +- src/material.f90 | 670 +++++------------- src/math.f90 | 5 +- src/mesh/DAMASK_mesh.f90 | 2 +- src/mesh/FEM_utilities.f90 | 3 +- src/mesh/discretization_mesh.f90 | 3 +- src/mesh/mesh_mech_FEM.f90 | 3 +- src/numerics.f90 | 82 --- src/results.f90 | 2 +- src/rotations.f90 | 2 +- src/source_damage_anisoBrittle.f90 | 125 ++-- src/source_damage_anisoDuctile.f90 | 99 +-- src/source_damage_isoBrittle.f90 | 88 ++- src/source_damage_isoDuctile.f90 | 88 ++- src/source_thermal_dissipation.f90 | 58 +- src/source_thermal_externalheat.f90 | 66 +- src/thermal_adiabatic.f90 | 30 +- src/thermal_conduction.f90 | 24 +- src/thermal_isothermal.f90 | 4 +- 63 files changed, 2291 insertions(+), 2166 deletions(-) delete mode 100644 examples/SpectralMethod/Polycrystal/material.config create mode 100644 examples/SpectralMethod/Polycrystal/material.yaml rename src/{constitutive_plastic_disloUCLA.f90 => constitutive_plastic_disloTungsten.f90} (81%) delete mode 100644 src/debug.f90 delete mode 100644 src/numerics.f90 diff --git a/PRIVATE b/PRIVATE index a52584687..a16d1e45a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a52584687a93b9f007cf019861fce68eb31451ab +Subproject commit a16d1e45a2ed925e12244b0879b9d7e5a58d973b diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config deleted file mode 100644 index ca2824301..000000000 --- a/examples/SpectralMethod/Polycrystal/material.config +++ /dev/null @@ -1,126 +0,0 @@ -#-------------------# - -#-------------------# - -[SX] -mech none - -#-------------------# - -#-------------------# -[Aluminum_phenopowerlaw] -elasticity hooke -plasticity phenopowerlaw - -(output) resistance_slip -(output) orientation # quaternion -(output) F # deformation gradient tensor -(output) Fe # elastic deformation gradient tensor -(output) Fp # plastic deformation gradient tensor -(output) P # first Piola-Kichhoff stress tensor -(output) Lp # plastic velocity gradient tensor - - -lattice_structure fcc -Nslip 12 # per family - -c11 106.75e9 -c12 60.41e9 -c44 28.34e9 - -gdot0_slip 0.001 -n_slip 20 -tau0_slip 31e6 # per family -tausat_slip 63e6 # per family -a_slip 2.25 -h0_slipslip 75e6 -interaction_slipslip 1 1 1.4 1.4 1.4 1.4 - -#-------------------# - -#-------------------# -[Grain01] -(constituent) phase 1 texture 01 fraction 1.0 -[Grain02] -(constituent) phase 1 texture 02 fraction 1.0 -[Grain03] -(constituent) phase 1 texture 03 fraction 1.0 -[Grain04] -(constituent) phase 1 texture 04 fraction 1.0 -[Grain05] -(constituent) phase 1 texture 05 fraction 1.0 -[Grain06] -(constituent) phase 1 texture 06 fraction 1.0 -[Grain07] -(constituent) phase 1 texture 07 fraction 1.0 -[Grain08] -(constituent) phase 1 texture 08 fraction 1.0 -[Grain09] -(constituent) phase 1 texture 09 fraction 1.0 -[Grain10] -(constituent) phase 1 texture 10 fraction 1.0 -[Grain11] -(constituent) phase 1 texture 11 fraction 1.0 -[Grain12] -(constituent) phase 1 texture 12 fraction 1.0 -[Grain13] -(constituent) phase 1 texture 13 fraction 1.0 -[Grain14] -(constituent) phase 1 texture 14 fraction 1.0 -[Grain15] -(constituent) phase 1 texture 15 fraction 1.0 -[Grain16] -(constituent) phase 1 texture 16 fraction 1.0 -[Grain17] -(constituent) phase 1 texture 17 fraction 1.0 -[Grain18] -(constituent) phase 1 texture 18 fraction 1.0 -[Grain19] -(constituent) phase 1 texture 19 fraction 1.0 -[Grain20] -(constituent) phase 1 texture 20 fraction 1.0 - - -#-------------------# - -#-------------------# -[Grain01] -(gauss) phi1 0.0 Phi 0.0 phi2 0.0 -[Grain02] -(gauss) phi1 257.468172 Phi 53.250534 phi2 157.331503 -[Grain03] -(gauss) phi1 216.994815 Phi 94.418518 phi2 251.147231 -[Grain04] -(gauss) phi1 196.157946 Phi 55.870978 phi2 21.68117 -[Grain05] -(gauss) phi1 152.515728 Phi 139.769395 phi2 240.036018 -[Grain06] -(gauss) phi1 232.521881 Phi 73.749222 phi2 241.429633 -[Grain07] -(gauss) phi1 157.531396 Phi 135.503513 phi2 75.737722 -[Grain08] -(gauss) phi1 321.03828 Phi 27.209843 phi2 46.413467 -[Grain09] -(gauss) phi1 346.918594 Phi 87.495569 phi2 113.554206 -[Grain10] -(gauss) phi1 138.038947 Phi 99.827132 phi2 130.935878 -[Grain11] -(gauss) phi1 285.021014 Phi 118.092004 phi2 205.270837 -[Grain12] -(gauss) phi1 190.402171 Phi 56.738068 phi2 157.896545 -[Grain13] -(gauss) phi1 204.496042 Phi 95.031265 phi2 355.814582 -[Grain14] -(gauss) phi1 333.21479 Phi 82.133355 phi2 36.736132 -[Grain15] -(gauss) phi1 25.572981 Phi 164.242648 phi2 75.195632 -[Grain16] -(gauss) phi1 31.366548 Phi 76.392403 phi2 58.071426 -[Grain17] -(gauss) phi1 7.278623 Phi 77.044663 phi2 235.118997 -[Grain18] -(gauss) phi1 299.743144 Phi 76.475096 phi2 91.184977 -[Grain19] -(gauss) phi1 280.13643 Phi 27.439718 phi2 167.871878 -[Grain20] -(gauss) phi1 313.204373 Phi 68.676053 phi2 87.993213 diff --git a/examples/SpectralMethod/Polycrystal/material.yaml b/examples/SpectralMethod/Polycrystal/material.yaml new file mode 100644 index 000000000..16c6042a6 --- /dev/null +++ b/examples/SpectralMethod/Polycrystal/material.yaml @@ -0,0 +1,123 @@ +homogenization: + SX: + mech: {type: none} +microstructure: +- constituents: + - fraction: 1.0 + orientation: [1.0, 0.0, 0.0, 0.0] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.7936696712125002, -0.28765777461664166, -0.3436487135089419, 0.4113964260949434] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.3986143167493579, -0.7014883552495493, 0.2154871765709027, 0.5500781677772945] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.28645844315788244, -0.022571491243423537, -0.467933059311115, -0.8357456192708106] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.33012772942625784, -0.6781865350268957, 0.6494525351030648, 0.09638521992649676] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.43596817439583935, -0.5982537129781701, 0.046599032277502436, 0.6707106499919265] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.169734823419553, -0.699615227367322, -0.6059581215838098, -0.33844257746495854] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.9698864809294915, 0.1729052643205874, -0.15948307917616958, 0.06315956884687175] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.46205660912967883, 0.3105054068891252, -0.617849551030653, 0.555294529545738] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.4512443497461787, -0.7636045534540555, -0.04739348426715133, -0.45939142396805815] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.2161856212656443, -0.6581450184826598, -0.5498086209601588, 0.4667112513346289] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.8753220715350803, -0.4561599367657419, -0.13298279533852678, -0.08969369719975541] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.11908260752431069, 0.18266024809834172, -0.7144822594012615, -0.664807992845101] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.751104669484278, 0.5585633382623958, -0.34579336397009175, 0.06538900566860861] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.08740438971703973, 0.8991264096610437, -0.4156704205935976, 0.10559485570696363] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.5584325870096193, 0.6016408353068798, -0.14280340445801173, 0.5529814994483859] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.4052725440888093, 0.25253073423599154, 0.5693263597910454, -0.669215876471182] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.7570164606888676, 0.15265448024694664, -0.5998021466848317, 0.20942796551297105] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.6987659297138081, -0.132172211261028, -0.19693254724422338, 0.6748883269678543] + phase: Aluminum + homogenization: SX +- constituents: + - fraction: 1.0 + orientation: [0.7729330445886478, 0.21682179052722322, -0.5207379472917645, 0.2905078484066341] + phase: Aluminum + homogenization: SX +phase: + Aluminum: + elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} + generic: + output: [F, P, Fe, Fp, Lp] + lattice: fcc + plasticity: + N_sl: [12] + a_sl: 2.25 + atol_xi: 1.0 + dot_gamma_0_sl: 0.001 + h_0_sl_sl: 75e6 + h_sl_sl: [1, 1, 1.4, 1.4, 1.4, 1.4] + n_sl: 20 + output: [xi_sl] + xi_0_sl: [31e6] + xi_inf_sl: [63e6] + type: phenopowerlaw + diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index f2b906b89..8d31ea078 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -5,7 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM use prec - use debug use FEsolving use math use rotations @@ -19,7 +18,6 @@ module CPFEM use IO use discretization use DAMASK_interface - use numerics use HDF5_utilities use results use lattice @@ -79,8 +77,6 @@ subroutine CPFEM_initAll call DAMASK_interface_init call prec_init call IO_init - call numerics_init - call debug_init call config_init call math_init call rotations_init @@ -95,6 +91,7 @@ subroutine CPFEM_initAll call crystallite_init call homogenization_init call CPFEM_init + call config_deallocate end subroutine CPFEM_initAll diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 027c6dfad..b26ad65fd 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -5,8 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM2 use prec - use numerics - use debug use config use FEsolving use math @@ -47,8 +45,6 @@ subroutine CPFEM_initAll #ifdef Mesh call FEM_quadrature_init #endif - call numerics_init - call debug_init call config_init call math_init call rotations_init @@ -67,6 +63,7 @@ subroutine CPFEM_initAll call crystallite_init call homogenization_init call CPFEM_init + call config_deallocate end subroutine CPFEM_initAll diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 8f170f05d..78203ffa2 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -175,10 +175,9 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & jtype,lclass,ifr,ifu) use prec use DAMASK_interface - use numerics + use config use YAML_types use FEsolving - use debug use discretization_marc use homogenization use CPFEM diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index f099b0542..0ac32fd2e 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -13,7 +13,7 @@ module HDF5_utilities use prec use IO use rotations - use numerics + use config implicit none public diff --git a/src/IO.f90 b/src/IO.f90 index aca887a22..d4533f47c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -392,9 +392,9 @@ logical function IO_stringAsBool(string) character(len=*), intent(in) :: string !< string for conversion to int value - if (trim(adjustl(string)) == 'True') then + if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then IO_stringAsBool = .true. - elseif (trim(adjustl(string)) == 'False') then + elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then IO_stringAsBool = .false. else IO_stringAsBool = .false. @@ -568,8 +568,6 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'Incorrect indent/Null value not allowed' case (702) msg = 'Invalid use of flow yaml' - case (703) - msg = 'Space expected after a list indicator - ' case (704) msg = 'Space expected after a colon for : pair' case (705) @@ -751,9 +749,9 @@ subroutine selfTest if(-3112019 /= IO_stringAsInt('-3112019')) call IO_error(0,ext_msg='IO_stringAsInt') if(3112019 /= IO_stringAsInt('+3112019 ')) call IO_error(0,ext_msg='IO_stringAsInt') - if(.not. IO_stringAsBool(' True')) call IO_error(0,ext_msg='IO_stringAsBool') + if(.not. IO_stringAsBool(' true')) call IO_error(0,ext_msg='IO_stringAsBool') if(.not. IO_stringAsBool(' True ')) call IO_error(0,ext_msg='IO_stringAsBool') - if( IO_stringAsBool(' False')) call IO_error(0,ext_msg='IO_stringAsBool') + if( IO_stringAsBool(' false')) call IO_error(0,ext_msg='IO_stringAsBool') if( IO_stringAsBool('False')) call IO_error(0,ext_msg='IO_stringAsBool') if(any([1,1,1] /= IO_stringPos('a'))) call IO_error(0,ext_msg='IO_stringPos') diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index 01e383b05..88f49c060 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -4,19 +4,18 @@ !> @brief Parser for YAML files !> @details module converts a YAML input file to an equivalent YAML flow style which is then parsed. !---------------------------------------------------------------------------------------------------- - module YAML_parse - use prec use IO use YAML_types implicit none - private - public :: YAML_init - public :: parse_flow,to_flow + public :: & + YAML_init, & + parse_flow, & + to_flow contains @@ -34,19 +33,22 @@ end subroutine YAML_init !> @brief reads the flow style string and stores it in the form of dictionaries, lists and scalars. !> @details A node type pointer can either point to a dictionary, list or scalar type entities. !-------------------------------------------------------------------------------------------------- -recursive function parse_flow(flow_string) result(node) +recursive function parse_flow(YAML_flow) result(node) - character(len=*), intent(inout) :: flow_string !< YAML file in flow style + character(len=*), intent(in) :: YAML_flow !< YAML file in flow style class (tNode), pointer :: node - class (tNode), pointer :: myVal - character(len=pStringLen) :: key - - integer :: e, & ! end position of dictionary or list - s, & ! start position of dictionary or list - d ! position of key: value separator (':') - - flow_string = trim(adjustl(flow_string(:))) + class (tNode), pointer :: & + myVal + character(len=:), allocatable :: & + flow_string, & + key + integer :: & + e, & ! end position of dictionary or list + s, & ! start position of dictionary or list + d ! position of key: value separator (':') + + flow_string = trim(adjustl(YAML_flow(:))) if (len_trim(flow_string) == 0) then node => emptyDict return @@ -166,7 +168,12 @@ logical function isListItem(line) character(len=*), intent(in) :: line - isListItem = index(adjustl(line),'-') == 1 + isListItem = .false. + if(len_trim(adjustl(line))> 2 .and. index(trim(adjustl(line)), '-') == 1) then + isListItem = scan(trim(adjustl(line)),' ') == 2 + else + isListItem = trim(adjustl(line)) == '-' + endif end function isListItem @@ -337,7 +344,7 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset) integer, intent(inout) :: s_blck, & !< start position in blck s_flow, & !< start position in flow offset !< stores leading '- ' in nested lists - character(len=pStringLen) :: line + character(len=:), allocatable :: line integer :: e_blck,indent indent = indentDepth(blck(s_blck:),offset) @@ -373,8 +380,6 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset) offset = 0 endif else ! list item in the same line - if(line(indentDepth(line)+2:indentDepth(line)+2) /= ' ') & - call IO_error(703,ext_msg=line) line = line(indentDepth(line)+3:) if(isScalar(line)) then call line_toFlow(flow,s_flow,line) @@ -419,7 +424,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset) s_flow, & !< start position in flow offset - character(len=pStringLen) :: line + character(len=:), allocatable :: line integer :: e_blck,indent logical :: previous_isKey @@ -490,7 +495,7 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset) s_flow, & !< start position in flow offset integer :: e_blck - character(len=pStringLen) :: line + character(len=:), allocatable :: line if(s_blck <= len(blck)) then e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 @@ -564,8 +569,9 @@ subroutine selfTest() if (.not. isFlow(' [')) call IO_error(0,ext_msg='isFlow') if ( isListItem(' a')) call IO_error(0,ext_msg='isListItem') + if ( isListItem(' -b')) call IO_error(0,ext_msg='isListItem') if (.not. isListItem('- a ')) call IO_error(0,ext_msg='isListItem') - if (.not. isListItem(' -b')) call IO_error(0,ext_msg='isListItem') + if (.not. isListItem('- -a ')) call IO_error(0,ext_msg='isListItem') if ( isKeyValue(' a')) call IO_error(0,ext_msg='isKeyValue') if ( isKeyValue(' a: ')) call IO_error(0,ext_msg='isKeyValue') diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index ad3db9d47..9f82e622a 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -8,12 +8,10 @@ !-------------------------------------------------------------------------------------------------- module YAML_types - use IO use prec implicit none - private type, abstract, public :: tNode @@ -74,7 +72,7 @@ module YAML_types getKey => tNode_getKey_byIndex procedure :: & contains => tNode_contains - + generic :: & get => tNode_get_byIndex, & tNode_get_byKey @@ -181,6 +179,7 @@ module YAML_types public :: & YAML_types_init, & + output_asStrings, & !ToDo: Hack for GNU. Remove later assignment(=) contains @@ -210,9 +209,9 @@ subroutine selfTest s1 = '1' if(s1%asInt() /= 1) call IO_error(0,ext_msg='tScalar_asInt') if(dNeq(s1%asFloat(),1.0_pReal)) call IO_error(0,ext_msg='tScalar_asFloat') - s1 = 'True' + s1 = 'true' if(.not. s1%asBool()) call IO_error(0,ext_msg='tScalar_asBool') - if(s1%asString() /= 'True') call IO_error(0,ext_msg='tScalar_asString') + if(s1%asString() /= 'true') call IO_error(0,ext_msg='tScalar_asString') end select block @@ -259,7 +258,7 @@ subroutine selfTest allocate(tScalar::s2) s3 => s1%asScalar() s4 => s2%asScalar() - s3 = 'True' + s3 = 'true' s4 = 'False' call l1%append(s1) @@ -267,9 +266,9 @@ subroutine selfTest n => l1 if(any(l1%asBools() .neqv. [.true., .false.])) call IO_error(0,ext_msg='tList_asBools') - if(any(l1%asStrings() /= ['True ','False'])) call IO_error(0,ext_msg='tList_asStrings') + if(any(l1%asStrings() /= ['true ','False'])) call IO_error(0,ext_msg='tList_asStrings') if(n%get_asBool(2)) call IO_error(0,ext_msg='byIndex_asBool') - if(n%get_asString(1) /= 'True') call IO_error(0,ext_msg='byIndex_asString') + if(n%get_asString(1) /= 'true') call IO_error(0,ext_msg='byIndex_asString') end block end subroutine selfTest @@ -710,7 +709,6 @@ function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat) else call IO_error(143,ext_msg=k) endif - end function tNode_get_byKey_asFloat @@ -764,7 +762,6 @@ function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool) call IO_error(143,ext_msg=k) endif - end function tNode_get_byKey_asBool @@ -791,25 +788,37 @@ function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString) call IO_error(143,ext_msg=k) endif - end function tNode_get_byKey_asString !-------------------------------------------------------------------------------------------------- !> @brief Access by key and convert to float array !-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asFloats(self,k) result(nodeAsFloats) +function tNode_get_byKey_asFloats(self,k,defaultVal,requiredSize) result(nodeAsFloats) + + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + real(pReal), intent(in), dimension(:), optional :: defaultVal + integer, intent(in), optional :: requiredSize - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k real(pReal), dimension(:), allocatable :: nodeAsFloats class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) - list => node%asList() - nodeAsFloats = list%asFloats() + if(self%contains(k)) then + node => self%get(k) + list => node%asList() + nodeAsFloats = list%asFloats() + elseif(present(defaultVal)) then + nodeAsFloats = defaultVal + else + call IO_error(143,ext_msg=k) + endif + + if(present(requiredSize)) then + if(requiredSize /= size(nodeAsFloats)) call IO_error(146,ext_msg=k) + endif end function tNode_get_byKey_asFloats @@ -817,18 +826,30 @@ end function tNode_get_byKey_asFloats !-------------------------------------------------------------------------------------------------- !> @brief Access by key and convert to int array !-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asInts(self,k) result(nodeAsInts) +function tNode_get_byKey_asInts(self,k,defaultVal,requiredSize) result(nodeAsInts) - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + integer, dimension(:), intent(in), optional :: defaultVal + integer, intent(in), optional :: requiredSize integer, dimension(:), allocatable :: nodeAsInts class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) - list => node%asList() - nodeAsInts = list%asInts() + if(self%contains(k)) then + node => self%get(k) + list => node%asList() + nodeAsInts = list%asInts() + elseif(present(defaultVal)) then + nodeAsInts = defaultVal + else + call IO_error(143,ext_msg=k) + endif + + if(present(requiredSize)) then + if(requiredSize /= size(nodeAsInts)) call IO_error(146,ext_msg=k) + endif end function tNode_get_byKey_asInts @@ -836,18 +857,25 @@ end function tNode_get_byKey_asInts !-------------------------------------------------------------------------------------------------- !> @brief Access by key and convert to bool array !-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asBools(self,k) result(nodeAsBools) +function tNode_get_byKey_asBools(self,k,defaultVal) result(nodeAsBools) - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k - logical, dimension(:), allocatable :: nodeAsBools + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + logical, dimension(:), intent(in), optional :: defaultVal + logical, dimension(:), allocatable :: nodeAsBools class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) - list => node%asList() - nodeAsBools = list%asBools() + if(self%contains(k)) then + node => self%get(k) + list => node%asList() + nodeAsBools = list%asBools() + elseif(present(defaultVal)) then + nodeAsBools = defaultVal + else + call IO_error(143,ext_msg=k) + endif end function tNode_get_byKey_asBools @@ -855,22 +883,50 @@ end function tNode_get_byKey_asBools !-------------------------------------------------------------------------------------------------- !> @brief Access by key and convert to string array !-------------------------------------------------------------------------------------------------- -function tNode_get_byKey_asStrings(self,k) result(nodeAsStrings) +function tNode_get_byKey_asStrings(self,k,defaultVal) result(nodeAsStrings) - class(tNode), intent(in), target :: self - character(len=*), intent(in) :: k - character(len=:), allocatable, dimension(:) :: nodeAsStrings + class(tNode), intent(in), target :: self + character(len=*), intent(in) :: k + character(len=*), intent(in), dimension(:), optional :: defaultVal + character(len=:), allocatable, dimension(:) :: nodeAsStrings class(tNode), pointer :: node type(tList), pointer :: list - node => self%get(k) - list => node%asList() - nodeAsStrings = list%asStrings() + if(self%contains(k)) then + node => self%get(k) + list => node%asList() + nodeAsStrings = list%asStrings() + elseif(present(defaultVal)) then + nodeAsStrings = defaultVal + else + call IO_error(143,ext_msg=k) + endif end function tNode_get_byKey_asStrings +!-------------------------------------------------------------------------------------------------- +!> @brief Returns string output array (hack for GNU) +!-------------------------------------------------------------------------------------------------- +function output_asStrings(self) result(output) !ToDo: SR: Remove whenever GNU works + + class(tNode), pointer,intent(in) :: self + character(len=pStringLen), allocatable, dimension(:) :: output + + class(tNode), pointer :: output_list + integer :: o + + output_list => self%get('output',defaultVal=emptyList) + allocate(output(output_list%length)) + do o = 1, output_list%length + output(o) = output_list%get_asString(o) + enddo + + +end function output_asStrings + + !-------------------------------------------------------------------------------------------------- !> @brief Returns the index of a key in a dictionary !-------------------------------------------------------------------------------------------------- diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index e98631fe4..0e5066268 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -6,9 +6,6 @@ #include "IO.f90" #include "YAML_types.f90" #include "YAML_parse.f90" -#include "numerics.f90" -#include "debug.f90" -#include "list.f90" #include "future.f90" #include "config.f90" #include "LAPACK_interface.f90" @@ -33,7 +30,7 @@ #include "constitutive_plastic_phenopowerlaw.f90" #include "constitutive_plastic_kinehardening.f90" #include "constitutive_plastic_dislotwin.f90" -#include "constitutive_plastic_disloUCLA.f90" +#include "constitutive_plastic_disloTungsten.f90" #include "constitutive_plastic_nonlocal.f90" #include "constitutive_thermal.f90" #include "source_thermal_dissipation.f90" diff --git a/src/config.f90 b/src/config.f90 index 7cc40b7b2..c6c69ed48 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -1,35 +1,36 @@ !-------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Reads in the material configuration from file -!> @details Reads the material configuration file, where solverJobName.materialConfig takes -!! precedence over material.config. Stores the raw strings and the positions of delimiters for the -!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture' +!> @brief Reads in the material, numerics & debug configuration from their respective file +!> @details Reads the material configuration file, where solverJobName.yaml takes +!! precedence over material.yaml. !-------------------------------------------------------------------------------------------------- module config use prec use DAMASK_interface use IO - use debug - use list use YAML_parse use YAML_types +#ifdef PETSc +#include + use petscsys +#endif +!$ use OMP_LIB + implicit none private - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & - config_phase, & - config_microstructure, & - config_homogenization, & - config_texture, & - config_crystallite + class(tNode), pointer, public :: & + material_root, & + numerics_root, & + debug_root + + integer, protected, public :: & + worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only) + worldsize = 1 !< MPI worldsize (/=1 for MPI simulations only) + integer(4), protected, public :: & + DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive - character(len=pStringLen), public, protected, allocatable, dimension(:) :: & - config_name_phase, & !< name of each phase - config_name_homogenization, & !< name of each homogenization - config_name_crystallite, & !< name of each crystallite setting - config_name_microstructure, & !< name of each microstructure - config_name_texture !< name of each texture public :: & config_init, & @@ -38,227 +39,117 @@ module config contains !-------------------------------------------------------------------------------------------------- -!> @brief reads material.config and stores its content per part +!> @brief calls subroutines that reads material, numerics and debug configuration files !-------------------------------------------------------------------------------------------------- subroutine config_init - integer :: i - logical :: verbose - - character(len=pStringLen) :: & - line, & - part - character(len=pStringLen), dimension(:), allocatable :: fileContent - class(tNode), pointer :: & - debug_material - logical :: fileExists - write(6,'(/,a)') ' <<<+- config init -+>>>'; flush(6) - - debug_material => debug_root%get('material',defaultVal=emptyList) - verbose = debug_material%contains('basic') - - inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists) - if(fileExists) then - write(6,'(/,a)') ' reading '//trim(getSolverJobName())//'.materialConfig'; flush(6) - fileContent = read_materialConfig(trim(getSolverJobName())//'.materialConfig') - else - inquire(file='material.config',exist=fileExists) - if(.not. fileExists) call IO_error(100,ext_msg='material.config') - write(6,'(/,a)') ' reading material.config'; flush(6) - fileContent = read_materialConfig('material.config') - endif - - do i = 1, size(fileContent) - line = trim(fileContent(i)) - part = IO_lc(IO_getTag(line,'<','>')) - select case (trim(part)) - - case (trim('phase')) - call parse_materialConfig(config_name_phase,config_phase,line,fileContent(i+1:)) - if (verbose) write(6,'(a)') ' Phase parsed'; flush(6) - - case (trim('microstructure')) - call parse_materialConfig(config_name_microstructure,config_microstructure,line,fileContent(i+1:)) - if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6) - - case (trim('crystallite')) - call parse_materialConfig(config_name_crystallite,config_crystallite,line,fileContent(i+1:)) - if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6) - deallocate(config_crystallite) - - case (trim('homogenization')) - call parse_materialConfig(config_name_homogenization,config_homogenization,line,fileContent(i+1:)) - if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6) - - case (trim('texture')) - call parse_materialConfig(config_name_texture,config_texture,line,fileContent(i+1:)) - if (verbose) write(6,'(a)') ' Texture parsed'; flush(6) - - end select - - enddo - - if (.not. allocated(config_homogenization) .or. size(config_homogenization) < 1) & - call IO_error(160,ext_msg='') - if (.not. allocated(config_microstructure) .or. size(config_microstructure) < 1) & - call IO_error(160,ext_msg='') - if (.not. allocated(config_phase) .or. size(config_phase) < 1) & - call IO_error(160,ext_msg='') - if (.not. allocated(config_texture) .or. size(config_texture) < 1) & - call IO_error(160,ext_msg='') - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief reads material.config -!! Recursion is triggered by "{path/to/inputfile}" in a line -!-------------------------------------------------------------------------------------------------- -recursive function read_materialConfig(fileName,cnt) result(fileContent) - - character(len=*), intent(in) :: fileName !< name of the material configuration file - integer, intent(in), optional :: cnt !< recursion counter - character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines - character(len=pStringLen), dimension(:), allocatable :: includedContent - character(len=pStringLen) :: line - character(len=pStringLen), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array - character(len=:), allocatable :: rawData - integer :: & - startPos, endPos, & - myTotalLines, & !< # lines read from file without include statements - l,i - logical :: warned - if (present(cnt)) then - if (cnt>10) call IO_error(106,ext_msg=trim(fileName)) - endif - - rawData = IO_read(fileName) ! read data as stream - -!-------------------------------------------------------------------------------------------------- -! count lines to allocate string array - myTotalLines = 1 - do l=1, len(rawData) - if (rawData(l:l) == IO_EOL) myTotalLines = myTotalLines+1 - enddo - allocate(fileContent(myTotalLines)) - -!-------------------------------------------------------------------------------------------------- -! split raw data at end of line and handle includes - warned = .false. - startPos = 1 - l = 1 - do while (l <= myTotalLines) - endPos = merge(startPos + scan(rawData(startPos:),IO_EOL) - 2,len(rawData),l /= myTotalLines) - if (endPos - startPos > pStringLen -1) then - line = rawData(startPos:startPos+pStringLen-1) - if (.not. warned) then - call IO_warning(207,ext_msg=trim(fileName),el=l) - warned = .true. - endif - else - line = rawData(startPos:endpos) - endif - startPos = endPos + 2 ! jump to next line start - - recursion: if (scan(trim(adjustl(line)),'{') == 1 .and. scan(trim(line),'}') > 2) then - includedContent = read_materialConfig(trim(line(scan(line,'{')+1:scan(line,'}')-1)), & - merge(cnt,1,present(cnt))) ! to track recursion depth - fileContent = [ fileContent(1:l-1), includedContent, [(dummy,i=1,myTotalLines-l)] ] ! add content and grow array - myTotalLines = myTotalLines - 1 + size(includedContent) - l = l - 1 + size(includedContent) - else recursion - fileContent(l) = line - l = l + 1 - endif recursion - - enddo - -end function read_materialConfig - - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the material.config file -!-------------------------------------------------------------------------------------------------- -subroutine parse_materialConfig(sectionNames,part,line, & - fileContent) - - character(len=pStringLen), allocatable, dimension(:), intent(out) :: sectionNames - type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part - character(len=pStringLen), intent(inout) :: line - character(len=pStringLen), dimension(:), intent(in) :: fileContent - - integer, allocatable, dimension(:) :: partPosition !< position of [] tags + last line in section - integer :: i, j - logical :: echo - character(len=pStringLen) :: sectionName - - echo = .false. - - if (allocated(part)) call IO_error(161,ext_msg=trim(line)) - allocate(partPosition(0)) - - do i = 1, size(fileContent) - line = trim(fileContent(i)) - if (IO_getTag(line,'<','>') /= '') exit - nextSection: if (IO_getTag(line,'[',']') /= '') then - partPosition = [partPosition, i] - cycle - endif nextSection - if (size(partPosition) < 1) & - echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo - enddo - - allocate(sectionNames(size(partPosition))) - allocate(part(size(partPosition))) - - partPosition = [partPosition, i] ! needed when actually storing content - - do i = 1, size(partPosition) -1 - write(sectionName,'(i0,a,a)') i,'_',trim(IO_getTag(fileContent(partPosition(i)),'[',']')) - sectionNames(i) = sectionName - do j = partPosition(i) + 1, partPosition(i+1) -1 - call part(i)%add(trim(adjustl(fileContent(j)))) - enddo - if (echo) then - write(6,*) 'section',i, '"'//trim(sectionNames(i))//'"' - call part(i)%show() - endif - enddo - -end subroutine parse_materialConfig + call parse_material + call parse_numerics + call parse_debug + end subroutine config_init !-------------------------------------------------------------------------------------------------- -!> @brief deallocates the linked lists that store the content of the configuration files +!> @brief reads material.yaml !-------------------------------------------------------------------------------------------------- -subroutine config_deallocate(what) +subroutine parse_material - character(len=*), intent(in) :: what + logical :: fileExists + character(len=:), allocatable :: fname,flow - select case(trim(what)) + fname = getSolverJobName()//'.yaml' + inquire(file=fname,exist=fileExists) + if(.not. fileExists) then + fname = 'material.yaml' + inquire(file=fname,exist=fileExists) + if(.not. fileExists) call IO_error(100,ext_msg=fname) + endif - case('material.config/phase') - deallocate(config_phase) + write(6,'(/,a)') ' reading '//fname; flush(6) + flow = to_flow(IO_read(fname)) + material_root => parse_flow(flow) - case('material.config/microstructure') - deallocate(config_microstructure) +end subroutine parse_material - case('material.config/homogenization') - deallocate(config_homogenization) - case('material.config/texture') - deallocate(config_texture) - - case default - call IO_error(0,ext_msg='config_deallocate') +!-------------------------------------------------------------------------------------------------- +!> @brief reads in parameters from numerics.yaml and sets openMP related parameters. Also does +! a sanity check +!-------------------------------------------------------------------------------------------------- +subroutine parse_numerics - end select +!$ integer :: gotDAMASK_NUM_THREADS = 1 + integer :: ierr + character(len=:), allocatable :: & + numerics_inFlow + logical :: fexist +!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS +#ifdef PETSc + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) +#endif + +!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS... +!$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1 +!$ call IO_warning(35,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END') +!$ DAMASK_NumThreadsInt = 1_4 +!$ else +!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer +!$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one +!$ endif +!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution + + numerics_root => emptyDict + inquire(file='numerics.yaml', exist=fexist) + + if (fexist) then + write(6,'(a,/)') ' using values from config.yaml file' + flush(6) + numerics_inFlow = to_flow(IO_read('numerics.yaml')) + numerics_root => parse_flow(numerics_inFlow) + endif + +!-------------------------------------------------------------------------------------------------- +! openMP parameter + !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt + +end subroutine parse_numerics + + +!-------------------------------------------------------------------------------------------------- +!> @brief reads in parameters from debug.yaml +!-------------------------------------------------------------------------------------------------- +subroutine parse_debug + + character(len=:), allocatable :: debug_inFlow + logical :: fexist + +#ifdef DEBUG + write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' +#endif + + debug_root => emptyDict + inquire(file='debug.yaml', exist=fexist) + fileExists: if (fexist) then + debug_inFlow = to_flow(IO_read('debug.yaml')) + debug_root => parse_flow(debug_inFlow) + endif fileExists + +end subroutine parse_debug + + +!-------------------------------------------------------------------------------------------------- +!> @brief deallocates material.yaml structure +!-------------------------------------------------------------------------------------------------- +subroutine config_deallocate + + deallocate(material_root) !ToDo: deallocation of numerics and debug (slightly different for optional files) + end subroutine config_deallocate end module config diff --git a/src/constitutive.f90 b/src/constitutive.f90 index feff4af86..4ecae8e01 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -7,8 +7,6 @@ module constitutive use prec use math use rotations - use debug - use numerics use IO use config use material @@ -21,6 +19,33 @@ module constitutive implicit none private + integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, protected :: & + phase_elasticity !< elasticity of each phase + + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & !ToDo: old intel compiler complains about protected + phase_plasticity !< plasticity of each phase + + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & ! ToDo: old intel compiler complains about protected + phase_source, & !< active sources mechanisms of each phase + phase_kinematics, & !< active kinematic mechanisms of each phase + phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + + integer, dimension(:), allocatable, public :: & ! ToDo: old intel compiler complains about protected + phase_Nsources, & !< number of source mechanisms active in each phase + phase_Nkinematics, & !< number of kinematic mechanisms active in each phase + phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase + phase_plasticityInstance, & !< instance of particular plasticity of each phase + phase_elasticityInstance !< instance of particular elasticity of each phase + + logical, dimension(:), allocatable, public :: & ! ToDo: old intel compiler complains about protected + phase_localPlasticity !< flags phases with local constitutive law + + type(tPlasticState), allocatable, dimension(:), public :: & + plasticState + type(tSourceState), allocatable, dimension(:), public :: & + sourceState + + integer, public, protected :: & constitutive_plasticity_maxSizeDotState, & constitutive_source_maxSizeDotState @@ -37,6 +62,23 @@ module constitutive end subroutine thermal_init + module function plastic_active(plastic_label) result(active_plastic) + character(len=*), intent(in) :: plastic_label + logical, dimension(:), allocatable :: active_plastic + end function plastic_active + + module function source_active(source_label,src_length) result(active_source) + character(len=*), intent(in) :: source_label + integer, intent(in) :: src_length + logical, dimension(:,:), allocatable :: active_source + end function source_active + + module function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) + character(len=*), intent(in) :: kinematics_label + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: active_kinematics + end function kinematics_active + module subroutine plastic_isotropic_dotState(Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -71,7 +113,7 @@ module constitutive of end subroutine plastic_dislotwin_dotState - module subroutine plastic_disloUCLA_dotState(Mp,T,instance,of) + module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress real(pReal), intent(in) :: & @@ -79,7 +121,7 @@ module constitutive integer, intent(in) :: & instance, & of - end subroutine plastic_disloUCLA_dotState + end subroutine plastic_disloTungsten_dotState module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & instance,of,ip,el) @@ -286,7 +328,6 @@ module constitutive end subroutine constitutive_plastic_LpAndItsTangents end interface constitutive_LpAndItsTangents - interface constitutive_dependentState @@ -326,11 +367,14 @@ module constitutive constitutive_SandItsTangents, & constitutive_collectDotState, & constitutive_deltaState, & - plastic_nonlocal_updateCompatibility, & constitutive_damage_getRateAndItsTangents, & constitutive_thermal_getRateAndItsTangents, & - constitutive_results - + constitutive_results, & + constitutive_allocateState, & + plastic_nonlocal_updateCompatibility, & + plastic_active, & + source_active, & + kinematics_active contains @@ -340,10 +384,15 @@ contains subroutine constitutive_init integer :: & - ph, & !< counter in phase loop - s !< counter in source loop + p, & !< counter in phase loop + s, & !< counter in source loop + stiffDegradationCtr class (tNode), pointer :: & - debug_constitutive + debug_constitutive, & + phases, & + phase, & + elastic, & + stiffDegradation debug_constitutive => debug_root%get('constitutive', defaultVal=emptyList) debugConstitutive%basic = debug_constitutive%contains('basic') @@ -353,7 +402,46 @@ subroutine constitutive_init debugConstitutive%ip = debug_root%get_asInt('integrationpoint',defaultVal = 1) debugConstitutive%grain = debug_root%get_asInt('grain',defaultVal = 1) +!------------------------------------------------------------------------------------------------- +! initialize elasticity (hooke) !ToDO: Maybe move to elastic submodule along with function homogenizedC? + phases => material_root%get('phase') + allocate(phase_elasticity(phases%length), source = ELASTICITY_undefined_ID) + allocate(phase_elasticityInstance(phases%length), source = 0) + allocate(phase_NstiffnessDegradations(phases%length),source=0) + do p = 1, phases%length + phase => phases%get(p) + elastic => phase%get('elasticity') + if(elastic%get_asString('type') == 'hooke') then + phase_elasticity(p) = ELASTICITY_HOOKE_ID + else + call IO_error(200,ext_msg=elastic%get_asString('type')) + endif + stiffDegradation => phase%get('stiffness_degradation',defaultVal=emptyList) ! check for stiffness degradation mechanisms + phase_NstiffnessDegradations(p) = stiffDegradation%length + enddo + + allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),phases%length), & + source=STIFFNESS_DEGRADATION_undefined_ID) + + if(maxVal(phase_NstiffnessDegradations)/=0) then + do p = 1, phases%length + phase => phases%get(p) + stiffDegradation => phase%get('stiffness_degradation',defaultVal=emptyList) + do stiffDegradationCtr = 1, stiffDegradation%length + if(stiffDegradation%get_asString(stiffDegradationCtr) == 'damage') & + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID + enddo + enddo + endif + + do p = 1, phases%length + phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) + enddo + + +!-------------------------------------------------------------------------------------------------- +! initialize constitutive laws call plastic_init call damage_init call thermal_init @@ -361,23 +449,87 @@ subroutine constitutive_init write(6,'(/,a)') ' <<<+- constitutive init -+>>>'; flush(6) constitutive_source_maxSizeDotState = 0 - PhaseLoop2:do ph = 1,material_Nphase + PhaseLoop2:do p = 1,phases%length !-------------------------------------------------------------------------------------------------- ! partition and initialize state - plasticState(ph)%partionedState0 = plasticState(ph)%state0 - plasticState(ph)%state = plasticState(ph)%partionedState0 - forall(s = 1:phase_Nsources(ph)) - sourceState(ph)%p(s)%partionedState0 = sourceState(ph)%p(s)%state0 - sourceState(ph)%p(s)%state = sourceState(ph)%p(s)%partionedState0 + plasticState(p)%partionedState0 = plasticState(p)%state0 + plasticState(p)%state = plasticState(p)%partionedState0 + forall(s = 1:phase_Nsources(p)) + sourceState(p)%p(s)%partionedState0 = sourceState(p)%p(s)%state0 + sourceState(p)%p(s)%state = sourceState(p)%p(s)%partionedState0 end forall constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(ph)%p%sizeDotState)) + maxval(sourceState(p)%p%sizeDotState)) enddo PhaseLoop2 constitutive_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) end subroutine constitutive_init + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +module function source_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: p,s + + phases => material_root%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + sources => phase%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + if(src%get_asString('type') == source_label) active_source(s,p) = .true. + enddo + enddo + + +end function source_active + + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a kinematic mechanism is active or not +!-------------------------------------------------------------------------------------------------- + +module function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) + + character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism + integer, intent(in) :: kinematics_length !< max. number of kinematics in system + logical, dimension(:,:), allocatable :: active_kinematics + + class(tNode), pointer :: & + phases, & + phase, & + kinematics, & + kinematics_type + integer :: p,k + + phases => material_root%get('phase') + allocate(active_kinematics(kinematics_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + kinematics => phase%get('kinematics',defaultVal=emptyList) + do k = 1, kinematics%length + kinematics_type => kinematics%get(k) + if(kinematics_type%get_asString('type') == kinematics_label) active_kinematics(k,p) = .true. + enddo + enddo + + +end function kinematics_active + + !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenize elasticity matrix !> ToDo: homogenizedC66 would be more consistent @@ -626,7 +778,7 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el plasticityType: select case (phase_plasticity(phase)) case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_dotState (Mp,instance,of) + call plastic_isotropic_dotState(Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_dotState(Mp,instance,of) @@ -635,13 +787,13 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el call plastic_kinehardening_dotState(Mp,instance,of) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dotState (Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_dotState(Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType + call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & + call plastic_nonlocal_dotState(Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) @@ -651,13 +803,13 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el sourceType: select case (phase_source(i,phase)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState (S, ipc, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(S, ipc, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState ( ipc, ip, el) + call source_damage_isoDuctile_dotState(ipc, ip, el) case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState ( ipc, ip, el) + call source_damage_anisoDuctile_dotState(ipc, ip, el) case (SOURCE_thermal_externalheat_ID) sourceType call source_thermal_externalheat_dotState(phase,of) @@ -749,6 +901,39 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke end function constitutive_deltaState +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate the components of the state structure for a given phase +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_allocateState(state, & + NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) + + class(tState), intent(out) :: & + state + integer, intent(in) :: & + NipcMyPhase, & + sizeState, & + sizeDotState, & + sizeDeltaState + + state%sizeState = sizeState + state%sizeDotState = sizeDotState + state%sizeDeltaState = sizeDeltaState + state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition + + allocate(state%atol (sizeState), source=0.0_pReal) + allocate(state%state0 (sizeState,NipcMyPhase), source=0.0_pReal) + allocate(state%partionedState0(sizeState,NipcMyPhase), source=0.0_pReal) + allocate(state%subState0 (sizeState,NipcMyPhase), source=0.0_pReal) + allocate(state%state (sizeState,NipcMyPhase), source=0.0_pReal) + + allocate(state%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + + allocate(state%deltaState(sizeDeltaState,NipcMyPhase), source=0.0_pReal) + + +end subroutine constitutive_allocateState + + !-------------------------------------------------------------------------------------------------- !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- @@ -759,4 +944,5 @@ subroutine constitutive_results end subroutine constitutive_results + end module constitutive diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 9e0c686b0..83b2c2384 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -5,23 +5,35 @@ submodule(constitutive) constitutive_damage interface - module subroutine source_damage_anisoBrittle_init - end subroutine source_damage_anisoBrittle_init + module function source_damage_anisoBrittle_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_damage_anisoBrittle_init - module subroutine source_damage_anisoDuctile_init - end subroutine source_damage_anisoDuctile_init + module function source_damage_anisoDuctile_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_damage_anisoDuctile_init - module subroutine source_damage_isoBrittle_init - end subroutine source_damage_isoBrittle_init + module function source_damage_isoBrittle_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_damage_isoBrittle_init - module subroutine source_damage_isoDuctile_init - end subroutine source_damage_isoDuctile_init + module function source_damage_isoDuctile_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_damage_isoDuctile_init - module subroutine kinematics_cleavage_opening_init - end subroutine kinematics_cleavage_opening_init + module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function kinematics_cleavage_opening_init - module subroutine kinematics_slipplane_opening_init - end subroutine kinematics_slipplane_opening_init + module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function kinematics_slipplane_opening_init module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) @@ -97,16 +109,51 @@ contains !---------------------------------------------------------------------------------------------- module subroutine damage_init + integer :: & + ph !< counter in phase loop + class(tNode), pointer :: & + phases, & + phase, & + sources, & + kinematics + + phases => material_root%get('phase') + + allocate(sourceState (phases%length)) + allocate(phase_Nsources(phases%length),source = 0) ! same for kinematics + + do ph = 1,phases%length + phase => phases%get(ph) + sources => phase%get('source',defaultVal=emptyList) + phase_Nsources(ph) = sources%length + allocate(sourceState(ph)%p(phase_Nsources(ph))) + enddo + + allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) + ! initialize source mechanisms - if (any(phase_source == SOURCE_damage_isoBrittle_ID)) call source_damage_isoBrittle_init - if (any(phase_source == SOURCE_damage_isoDuctile_ID)) call source_damage_isoDuctile_init - if (any(phase_source == SOURCE_damage_anisoBrittle_ID)) call source_damage_anisoBrittle_init - if (any(phase_source == SOURCE_damage_anisoDuctile_ID)) call source_damage_anisoDuctile_init + if(maxval(phase_Nsources) /= 0) then + where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID + where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID + where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID + where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID + endif !-------------------------------------------------------------------------------------------------- ! initialize kinematic mechanisms - if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID)) call kinematics_cleavage_opening_init - if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init + allocate(phase_Nkinematics(phases%length),source = 0) + do ph = 1,phases%length + phase => phases%get(ph) + kinematics => phase%get('kinematics',defaultVal=emptyList) + phase_Nkinematics(ph) = kinematics%length + enddo + + allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID) + + if(maxval(phase_Nkinematics) /= 0) then + where(kinematics_cleavage_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_cleavage_opening_ID + where(kinematics_slipplane_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_slipplane_opening_ID + endif end subroutine damage_init @@ -168,16 +215,17 @@ end subroutine constitutive_damage_getRateAndItsTangents !---------------------------------------------------------------------------------------------- -!< @brief writes damage sources resultsvto HDF5 output file +!< @brief writes damage sources results to HDF5 output file !---------------------------------------------------------------------------------------------- module subroutine damage_results integer :: p,i character(len=pStringLen) :: group - do p = 1, size(config_name_phase) + do p = 1, size(material_name_phase) + sourceLoop: do i = 1, phase_Nsources(p) - group = trim('current/constituent')//'/'//trim(config_name_phase(p)) + group = trim('current/constituent')//'/'//trim(material_name_phase(p)) group = trim(group)//'/sources' call results_closeGroup(results_addGroup(group)) diff --git a/src/constitutive_plastic.f90 b/src/constitutive_plastic.f90 index f7b1569d2..628a98d1a 100644 --- a/src/constitutive_plastic.f90 +++ b/src/constitutive_plastic.f90 @@ -5,26 +5,40 @@ submodule(constitutive) constitutive_plastic interface - module subroutine plastic_none_init - end subroutine plastic_none_init + module function plastic_none_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_none_init - module subroutine plastic_isotropic_init - end subroutine plastic_isotropic_init + module function plastic_isotropic_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_isotropic_init - module subroutine plastic_phenopowerlaw_init - end subroutine plastic_phenopowerlaw_init + module function plastic_phenopowerlaw_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_phenopowerlaw_init - module subroutine plastic_kinehardening_init - end subroutine plastic_kinehardening_init + module function plastic_kinehardening_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_kinehardening_init - module subroutine plastic_dislotwin_init - end subroutine plastic_dislotwin_init + module function plastic_dislotwin_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_dislotwin_init - module subroutine plastic_disloUCLA_init - end subroutine plastic_disloUCLA_init + module function plastic_disloTungsten_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_disloTungsten_init - module subroutine plastic_nonlocal_init - end subroutine plastic_nonlocal_init + module function plastic_nonlocal_init() result(myPlasticity) + logical, dimension(:), allocatable :: & + myPlasticity + end function plastic_nonlocal_init module subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -80,7 +94,7 @@ submodule(constitutive) constitutive_plastic of end subroutine plastic_dislotwin_LpAndItsTangent - pure module subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) + pure module subroutine plastic_disloTungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(3,3,3,3), intent(out) :: & @@ -93,7 +107,7 @@ submodule(constitutive) constitutive_plastic integer, intent(in) :: & instance, & of - end subroutine plastic_disloUCLA_LpAndItsTangent + end subroutine plastic_disloTungsten_LpAndItsTangent module subroutine plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp, & Mp,Temperature,instance,of,ip,el) @@ -122,11 +136,11 @@ submodule(constitutive) constitutive_plastic T end subroutine plastic_dislotwin_dependentState - module subroutine plastic_disloUCLA_dependentState(instance,of) + module subroutine plastic_disloTungsten_dependentState(instance,of) integer, intent(in) :: & instance, & of - end subroutine plastic_disloUCLA_dependentState + end subroutine plastic_disloTungsten_dependentState module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) real(pReal), dimension(3,3), intent(in) :: & @@ -159,10 +173,10 @@ submodule(constitutive) constitutive_plastic character(len=*), intent(in) :: group end subroutine plastic_dislotwin_results - module subroutine plastic_disloUCLA_results(instance,group) + module subroutine plastic_disloTungsten_results(instance,group) integer, intent(in) :: instance character(len=*), intent(in) :: group - end subroutine plastic_disloUCLA_results + end subroutine plastic_disloTungsten_results module subroutine plastic_nonlocal_results(instance,group) integer, intent(in) :: instance @@ -181,21 +195,57 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine plastic_init - if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init - if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init - if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init - if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init - if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then - call plastic_nonlocal_init - else - call geometry_plastic_nonlocal_disable - endif + integer :: p + class(tNode), pointer :: phases + + phases => material_root%get('phase') + + allocate(plasticState(phases%length)) + allocate(phase_plasticity(phases%length),source = PLASTICITY_undefined_ID) + allocate(phase_plasticityInstance(phases%length),source = 0) + allocate(phase_localPlasticity(phases%length), source=.true.) + + where(plastic_none_init()) phase_plasticity = PLASTICITY_NONE_ID + where(plastic_isotropic_init()) phase_plasticity = PLASTICITY_ISOTROPIC_ID + where(plastic_phenopowerlaw_init()) phase_plasticity = PLASTICITY_PHENOPOWERLAW_ID + where(plastic_kinehardening_init()) phase_plasticity = PLASTICITY_KINEHARDENING_ID + where(plastic_dislotwin_init()) phase_plasticity = PLASTICITY_DISLOTWIN_ID + where(plastic_disloTungsten_init()) phase_plasticity = PLASTICITY_DISLOTUNGSTEN_ID + where(plastic_nonlocal_init()) phase_plasticity = PLASTICITY_NONLOCAL_ID + + do p = 1, phases%length + phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) + enddo + end subroutine plastic_init +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a plastic module is active or not +!-------------------------------------------------------------------------------------------------- +module function plastic_active(plastic_label) result(active_plastic) + + character(len=*), intent(in) :: plastic_label !< type of plasticity model + logical, dimension(:), allocatable :: active_plastic + + class(tNode), pointer :: & + phases, & + phase, & + pl + integer :: p + + phases => material_root%get('phase') + allocate(active_plastic(phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + pl => phase%get('plasticity') + if(pl%get_asString('type') == plastic_label) active_plastic(p) = .true. + enddo + +end function plastic_active + + !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different plasticity constitutive models !-------------------------------------------------------------------------------------------------- @@ -222,8 +272,8 @@ module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloUCLA_dependentState(instance,of) + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType + call plastic_disloTungsten_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el) end select plasticityType @@ -275,7 +325,7 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMp,Mp,instance,of) + call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) @@ -284,13 +334,13 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,of,ip,el) + call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,of,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) - case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType + call plastic_disloTungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) end select plasticityType @@ -311,8 +361,8 @@ module subroutine plastic_results integer :: p character(len=pStringLen) :: group - plasticityLoop: do p=1,size(config_name_phase) - group = trim('current/constituent')//'/'//trim(config_name_phase(p)) + plasticityLoop: do p=1,size(material_name_phase) + group = trim('current/constituent')//'/'//trim(material_name_phase(p)) call results_closeGroup(results_addGroup(group)) group = trim(group)//'/plastic' @@ -332,8 +382,8 @@ module subroutine plastic_results case(PLASTICITY_DISLOTWIN_ID) call plastic_dislotwin_results(phase_plasticityInstance(p),group) - case(PLASTICITY_DISLOUCLA_ID) - call plastic_disloUCLA_results(phase_plasticityInstance(p),group) + case(PLASTICITY_DISLOTUNGSTEN_ID) + call plastic_disloTungsten_results(phase_plasticityInstance(p),group) case(PLASTICITY_NONLOCAL_ID) call plastic_nonlocal_results(phase_plasticityInstance(p),group) diff --git a/src/constitutive_plastic_disloUCLA.f90 b/src/constitutive_plastic_disloTungsten.f90 similarity index 81% rename from src/constitutive_plastic_disloUCLA.f90 rename to src/constitutive_plastic_disloTungsten.f90 index 71f8f4a27..a5cb45654 100644 --- a/src/constitutive_plastic_disloUCLA.f90 +++ b/src/constitutive_plastic_disloTungsten.f90 @@ -5,7 +5,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief crystal plasticity model for bcc metals, especially Tungsten !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_plastic) plastic_disloUCLA +submodule(constitutive:constitutive_plastic) plastic_disloTungsten real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin @@ -20,8 +20,8 @@ submodule(constitutive:constitutive_plastic) plastic_disloUCLA b_sl, & !< magnitude of burgers vector [m] D_a, & i_sl, & !< Adj. parameter for distance between 2 forest dislocations - atomicVolume, & - tau_0, & + atomicVolume, & !< factor to calculate atomic volume + tau_0, & !< Peierls stress !* mobility law parameters delta_F, & !< activation energy for glide [J] v0, & !< dislocation velocity prefactor [m/s] @@ -46,26 +46,26 @@ submodule(constitutive:constitutive_plastic) plastic_disloUCLA dipoleFormation !< flag indicating consideration of dipole formation end type !< container type for internal constitutive parameters - type :: tDisloUCLAState + type :: tDisloTungstenState real(pReal), dimension(:,:), pointer :: & rho_mob, & rho_dip, & gamma_sl - end type tDisloUCLAState + end type tDisloTungstenState - type :: tDisloUCLAdependentState + type :: tDisloTungstendependentState real(pReal), dimension(:,:), allocatable :: & Lambda_sl, & threshold_stress - end type tDisloUCLAdependentState + end type tDisloTungstendependentState !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:) :: param - type(tDisloUCLAState), allocatable, dimension(:) :: & + type(tDisloTungstenState), allocatable, dimension(:) :: & dotState, & state - type(tDisloUCLAdependentState), allocatable, dimension(:) :: dependentState + type(tDisloTungstendependentState), allocatable, dimension(:) :: dependentState contains @@ -74,8 +74,9 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_init +module function plastic_disloTungsten_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & p, i, & @@ -90,43 +91,59 @@ module subroutine plastic_disloUCLA_init a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_DISLOUCLA_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- plastic_disloTungsten init -+>>>' write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78:242–256, 2016' write(6,'(a)') ' https://dx.doi.org/10.1016/j.ijplas.2015.09.002' - Ninstance = count(phase_plasticity == PLASTICITY_DISLOUCLA_ID) + myPlasticity = plastic_active('disloTungsten') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) allocate(dependentState(Ninstance)) - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_DISLOUCLA_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - dst => dependentState(phase_plasticityInstance(p)), & - config => config_phase(p)) + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + stt => state(i), & + dst => dependentState(i)) + pl => phase%get('plasticity') + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif ! This data is read in already in lattice prm%mu = lattice_mu(p) !-------------------------------------------------------------------------------------------------- ! slip related parameters - N_sl = config%getInts('nslip',defaultVal=emptyIntArray) + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%P_sl = lattice_SchmidMatrix_slip(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - if(trim(config%getString('lattice_structure')) == 'bcc') then - a = config%getFloats('nonschmid_coefficients',defaultVal = emptyRealArray) + if(trim(phase%get_asString('lattice')) == 'bcc') then + a = pl%get_asFloats('nonSchmid_coefficients',defaultVal = emptyRealArray) prm%nonSchmid_pos = lattice_nonSchmidMatrix(N_sl,a,+1) prm%nonSchmid_neg = lattice_nonSchmidMatrix(N_sl,a,-1) else @@ -134,35 +151,36 @@ module subroutine plastic_disloUCLA_init prm%nonSchmid_neg = prm%P_sl endif - prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) - prm%forestProjection = lattice_forestProjection_edge(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_asFloats('h_sl_sl'), & + phase%get_asString('lattice')) + prm%forestProjection = lattice_forestProjection_edge(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) prm%forestProjection = transpose(prm%forestProjection) - rho_mob_0 = config%getFloats('rhoedge0', requiredSize=size(N_sl)) - rho_dip_0 = config%getFloats('rhoedgedip0', requiredSize=size(N_sl)) - prm%v0 = config%getFloats('v0', requiredSize=size(N_sl)) - prm%b_sl = config%getFloats('slipburgers', requiredSize=size(N_sl)) - prm%delta_F = config%getFloats('qedge', requiredSize=size(N_sl)) + rho_mob_0 = pl%get_asFloats('rho_mob_0', requiredSize=size(N_sl)) + rho_dip_0 = pl%get_asFloats('rho_dip_0', requiredSize=size(N_sl)) + prm%v0 = pl%get_asFloats('v_0', requiredSize=size(N_sl)) + prm%b_sl = pl%get_asFloats('b_sl', requiredSize=size(N_sl)) + prm%delta_F = pl%get_asFloats('Q_s', requiredSize=size(N_sl)) - prm%i_sl = config%getFloats('clambdaslip', requiredSize=size(N_sl)) - prm%tau_0 = config%getFloats('tau_peierls', requiredSize=size(N_sl)) - prm%p = config%getFloats('p_slip', requiredSize=size(N_sl), & + prm%i_sl = pl%get_asFloats('i_sl', requiredSize=size(N_sl)) + prm%tau_0 = pl%get_asFloats('tau_peierls', requiredSize=size(N_sl)) + prm%p = pl%get_asFloats('p_sl', requiredSize=size(N_sl), & defaultVal=[(1.0_pReal,i=1,size(N_sl))]) - prm%q = config%getFloats('q_slip', requiredSize=size(N_sl), & + prm%q = pl%get_asFloats('q_sl', requiredSize=size(N_sl), & defaultVal=[(1.0_pReal,i=1,size(N_sl))]) - prm%kink_height = config%getFloats('kink_height', requiredSize=size(N_sl)) - prm%w = config%getFloats('kink_width', requiredSize=size(N_sl)) - prm%omega = config%getFloats('omega', requiredSize=size(N_sl)) - prm%B = config%getFloats('friction_coeff', requiredSize=size(N_sl)) + prm%kink_height = pl%get_asFloats('h', requiredSize=size(N_sl)) + prm%w = pl%get_asFloats('w', requiredSize=size(N_sl)) + prm%omega = pl%get_asFloats('omega', requiredSize=size(N_sl)) + prm%B = pl%get_asFloats('B', requiredSize=size(N_sl)) - prm%D = config%getFloat('grainsize') - prm%D_0 = config%getFloat('d0') - prm%Q_cl = config%getFloat('qsd') - prm%atomicVolume = config%getFloat('catomicvolume') * prm%b_sl**3.0_pReal - prm%D_a = config%getFloat('cedgedipmindistance') * prm%b_sl - prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-type key + prm%D = pl%get_asFloat('D') + prm%D_0 = pl%get_asFloat('D_0') + prm%Q_cl = pl%get_asFloat('Q_cl') + prm%atomicVolume = pl%get_asFloat('f_at') * prm%b_sl**3.0_pReal + prm%D_a = pl%get_asFloat('D_a') * prm%b_sl + + prm%dipoleformation = pl%get_asBool('dipole_formation_factor', defaultVal = .true.) ! expand: family => system rho_mob_0 = math_expand(rho_mob_0, N_sl) @@ -184,14 +202,14 @@ module subroutine plastic_disloUCLA_init ! sanity checks if ( prm%D_0 <= 0.0_pReal) extmsg = trim(extmsg)//' D_0' if ( prm%Q_cl <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl' - if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedge0' - if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoedgedip0' - if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' + if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0' + if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0' + if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v_0' if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl' - if (any(prm%delta_F <= 0.0_pReal)) extmsg = trim(extmsg)//' qedge' - if (any(prm%tau_0 < 0.0_pReal)) extmsg = trim(extmsg)//' tau_0' - if (any(prm%D_a <= 0.0_pReal)) extmsg = trim(extmsg)//' cedgedipmindistance or b_sl' - if (any(prm%atomicVolume <= 0.0_pReal)) extmsg = trim(extmsg)//' catomicvolume or b_sl' + if (any(prm%delta_F <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s' + if (any(prm%tau_0 < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' + if (any(prm%D_a <= 0.0_pReal)) extmsg = trim(extmsg)//' D_a or b_sl' + if (any(prm%atomicVolume <= 0.0_pReal)) extmsg = trim(extmsg)//' f_at or b_sl' else slipActive rho_mob_0= emptyRealArray; rho_dip_0 = emptyRealArray @@ -208,7 +226,7 @@ module subroutine plastic_disloUCLA_init sizeDotState = size(['rho_mob ','rho_dip ','gamma_sl']) * prm%sum_N_sl sizeState = sizeDotState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization @@ -217,7 +235,7 @@ module subroutine plastic_disloUCLA_init stt%rho_mob => plasticState(p)%state(startIndex:endIndex,:) stt%rho_mob = spread(rho_mob_0,2,NipcMyPhase) dot%rho_mob => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_rho',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' startIndex = endIndex + 1 @@ -225,7 +243,7 @@ module subroutine plastic_disloUCLA_init stt%rho_dip => plasticState(p)%state(startIndex:endIndex,:) stt%rho_dip = spread(rho_dip_0,2,NipcMyPhase) dot%rho_dip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_rho',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl @@ -244,17 +262,17 @@ module subroutine plastic_disloUCLA_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_DISLOUCLA_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(disloTungsten)') enddo -end subroutine plastic_disloUCLA_init +end function plastic_disloTungsten_init !-------------------------------------------------------------------------------------------------- !> @brief Calculate plastic velocity gradient and its tangent. !-------------------------------------------------------------------------------------------------- -pure module subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp, & +pure module subroutine plastic_disloTungsten_LpAndItsTangent(Lp,dLp_dMp, & Mp,T,instance,of) real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient @@ -291,13 +309,13 @@ pure module subroutine plastic_disloUCLA_LpAndItsTangent(Lp,dLp_dMp, & end associate -end subroutine plastic_disloUCLA_LpAndItsTangent +end subroutine plastic_disloTungsten_LpAndItsTangent !-------------------------------------------------------------------------------------------------- !> @brief Calculate the rate of change of microstructure. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_dotState(Mp,T,instance,of) +module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress @@ -351,13 +369,13 @@ module subroutine plastic_disloUCLA_dotState(Mp,T,instance,of) end associate -end subroutine plastic_disloUCLA_dotState +end subroutine plastic_disloTungsten_dotState !-------------------------------------------------------------------------------------------------- !> @brief Calculate derived quantities from state. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_dependentState(instance,of) +module subroutine plastic_disloTungsten_dependentState(instance,of) integer, intent(in) :: & instance, & @@ -376,13 +394,13 @@ module subroutine plastic_disloUCLA_dependentState(instance,of) end associate -end subroutine plastic_disloUCLA_dependentState +end subroutine plastic_disloTungsten_dependentState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_disloUCLA_results(instance,group) +module subroutine plastic_disloTungsten_results(instance,group) integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -392,26 +410,26 @@ module subroutine plastic_disloUCLA_results(instance,group) associate(prm => param(instance), stt => state(instance), dst => dependentState(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('edge_density') ! ToDo: should be rho_mob - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_mob,'rho_mob',& + case('rho_mob') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_mob,trim(prm%output(o)), & 'mobile dislocation density','1/m²') - case('dipole_density') ! ToDo: should be rho_dip - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip,'rho_dip',& + case('rho_dip') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip,trim(prm%output(o)), & 'dislocation dipole density''1/m²') - case('shear_rate_slip') ! should be gamma - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_sl,'dot_gamma_sl',& ! this is not dot!! + case('gamma_sl') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_sl,trim(prm%output(o)), & 'plastic shear','1') - case('mfp_slip') !ToDo: should be Lambda - if(prm%sum_N_sl>0) call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',& + case('Lambda_sl') + if(prm%sum_N_sl>0) call results_writeDataset(group,dst%Lambda_sl,trim(prm%output(o)), & 'mean free path for slip','m') - case('threshold_stress_slip') !ToDo: should be tau_pass - if(prm%sum_N_sl>0) call results_writeDataset(group,dst%threshold_stress,'tau_pass',& + case('tau_pass') + if(prm%sum_N_sl>0) call results_writeDataset(group,dst%threshold_stress,trim(prm%output(o)), & 'threshold stress for slip','Pa') end select enddo outputsLoop end associate -end subroutine plastic_disloUCLA_results +end subroutine plastic_disloTungsten_results !-------------------------------------------------------------------------------------------------- @@ -529,4 +547,4 @@ pure subroutine kinetics(Mp,T,instance,of, & end subroutine kinetics -end submodule plastic_disloUCLA +end submodule plastic_disloTungsten diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/constitutive_plastic_dislotwin.f90 index c9550ecd6..0f473b760 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -22,8 +22,8 @@ submodule(constitutive:constitutive_plastic) plastic_dislotwin D = 1.0_pReal, & !< grain size p_sb = 1.0_pReal, & !< p-exponent in shear band velocity q_sb = 1.0_pReal, & !< q-exponent in shear band velocity - CEdgeDipMinDistance = 1.0_pReal, & !< - i_tw = 1.0_pReal, & !< + CEdgeDipMinDistance = 1.0_pReal, & !< adjustment parameter to calculate minimum dipole distance + i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning tau_0 = 1.0_pReal, & !< strength due to elements in solid solution L_tw = 1.0_pReal, & !< Length of twin nuclei in Burgers vectors L_tr = 1.0_pReal, & !< Length of trans nuclei in Burgers vectors @@ -36,7 +36,7 @@ submodule(constitutive:constitutive_plastic) plastic_dislotwin SFE_0K = 1.0_pReal, & !< stacking fault energy at zero K dSFE_dT = 1.0_pReal, & !< temperature dependence of stacking fault energy gamma_fcc_hex = 1.0_pReal, & !< Free energy difference between austensite and martensite - i_tr = 1.0_pReal, & !< + i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation h = 1.0_pReal !< Stack height of hex nucleus real(pReal), allocatable, dimension(:) :: & b_sl, & !< absolute length of burgers vector [m] for each slip system @@ -56,11 +56,11 @@ submodule(constitutive:constitutive_plastic) plastic_dislotwin gamma_char, & !< characteristic shear for twins B !< drag coefficient real(pReal), allocatable, dimension(:,:) :: & - h_sl_sl, & !< - h_sl_tw, & !< - h_tw_tw, & !< - h_sl_tr, & !< - h_tr_tr, & !< + h_sl_sl, & !< components of slip-slip interaction matrix + h_sl_tw, & !< components of slip-twin interaction matrix + h_tw_tw, & !< components of twin-twin interaction matrix + h_sl_tr, & !< components of slip-trans interaction matrix + h_tr_tr, & !< components of trans-trans interaction matrix n0_sl, & !< slip system normal forestProjection, & C66 @@ -98,9 +98,9 @@ submodule(constitutive:constitutive_plastic) plastic_dislotwin Lambda_sl, & !< mean free path between 2 obstacles seen by a moving dislocation Lambda_tw, & !< mean free path between 2 obstacles seen by a growing twin Lambda_tr, & !< mean free path between 2 obstacles seen by a growing martensite - tau_pass, & - tau_hat_tw, & - tau_hat_tr, & + tau_pass, & !< threshold stress for slip + tau_hat_tw, & !< threshold stress for twinning + tau_hat_tr, & !< threshold stress for transformation V_tw, & !< volume of a new twin V_tr, & !< volume of a new martensite disc tau_r_tw, & !< stress to bring partials close together (twin) @@ -122,8 +122,9 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_init +module function plastic_dislotwin_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & p, i, & @@ -137,8 +138,12 @@ module subroutine plastic_dislotwin_init rho_dip_0 !< initial dipole dislocation density per slip system character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- constitutive_dislotwin init -+>>>' write(6,'(/,a)') ' Ma and Roters, Acta Materialia 52(12):3603–3612, 2004' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' @@ -149,23 +154,35 @@ module subroutine plastic_dislotwin_init write(6,'(/,a)') ' Wong et al., Acta Materialia 118:140–151, 2016' write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' - Ninstance = count(phase_plasticity == PLASTICITY_DISLOTWIN_ID) + myPlasticity = plastic_active('dislotwin') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) allocate(dependentState(Ninstance)) - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_DISLOTWIN_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - dst => dependentState(phase_plasticityInstance(p)), & - config => config_phase(p)) + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) - prm%output = config%getStrings('(output)', defaultVal=emptyStringArray) + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + stt => state(i), & + dst => dependentState(i)) + pl => phase%get('plasticity') + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif ! This data is read in already in lattice prm%mu = lattice_mu(p) @@ -174,49 +191,49 @@ module subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! slip related parameters - N_sl = config%getInts('nslip',defaultVal=emptyIntArray) + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%P_sl = lattice_SchmidMatrix_slip(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) - prm%forestProjection = lattice_forestProjection_edge(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_asFloats('h_sl_sl'), & + phase%get_asString('lattice')) + prm%forestProjection = lattice_forestProjection_edge(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) prm%forestProjection = transpose(prm%forestProjection) - prm%n0_sl = lattice_slip_normal(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%n0_sl = lattice_slip_normal(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) prm%fccTwinTransNucleation = merge(.true., .false., lattice_structure(p) == lattice_FCC_ID) & .and. (N_sl(1) == 12) if(prm%fccTwinTransNucleation) prm%fcc_twinNucleationSlipPair = lattice_FCC_TWINNUCLEATIONSLIPPAIR - rho_mob_0 = config%getFloats('rhoedge0', requiredSize=size(N_sl)) - rho_dip_0 = config%getFloats('rhoedgedip0',requiredSize=size(N_sl)) - prm%v0 = config%getFloats('v0', requiredSize=size(N_sl)) - prm%b_sl = config%getFloats('slipburgers',requiredSize=size(N_sl)) - prm%Delta_F = config%getFloats('qedge', requiredSize=size(N_sl)) - prm%CLambdaSlip = config%getFloats('clambdaslip',requiredSize=size(N_sl)) - prm%p = config%getFloats('p_slip', requiredSize=size(N_sl)) - prm%q = config%getFloats('q_slip', requiredSize=size(N_sl)) - prm%B = config%getFloats('b', requiredSize=size(N_sl), & + rho_mob_0 = pl%get_asFloats('rho_mob_0', requiredSize=size(N_sl)) + rho_dip_0 = pl%get_asFloats('rho_dip_0', requiredSize=size(N_sl)) + prm%v0 = pl%get_asFloats('v_0', requiredSize=size(N_sl)) + prm%b_sl = pl%get_asFloats('b_sl', requiredSize=size(N_sl)) + prm%Delta_F = pl%get_asFloats('Q_s', requiredSize=size(N_sl)) + prm%CLambdaSlip = pl%get_asFloats('i_sl', requiredSize=size(N_sl)) + prm%p = pl%get_asFloats('p_sl', requiredSize=size(N_sl)) + prm%q = pl%get_asFloats('q_sl', requiredSize=size(N_sl)) + prm%B = pl%get_asFloats('B', requiredSize=size(N_sl), & defaultVal=[(0.0_pReal, i=1,size(N_sl))]) - prm%tau_0 = config%getFloat('solidsolutionstrength') - prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') - prm%D0 = config%getFloat('d0') - prm%Qsd = config%getFloat('qsd') - prm%ExtendedDislocations = config%keyExists('/extend_dislocations/') + prm%tau_0 = pl%get_asFloat('tau_0') + prm%CEdgeDipMinDistance = pl%get_asFloat('D_a') + prm%D0 = pl%get_asFloat('D_0') + prm%Qsd = pl%get_asFloat('Q_cl') + prm%ExtendedDislocations = pl%get_asBool('extend_dislocations',defaultVal = .false.) if (prm%ExtendedDislocations) then - prm%SFE_0K = config%getFloat('sfe_0k') - prm%dSFE_dT = config%getFloat('dsfe_dt') + prm%SFE_0K = pl%get_asFloat('Gamma_sf_0K') + prm%dSFE_dT = pl%get_asFloat('dGamma_sf_dT') endif - prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') + prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation',defaultVal = .false.) ! multiplication factor according to crystal structure (nearest neighbors bcc vs fcc/hex) ! details: Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981 - prm%omega = config%getFloat('omega', defaultVal = 1000.0_pReal) & + prm%omega = pl%get_asFloat('omega', defaultVal = 1000.0_pReal) & * merge(12.0_pReal,8.0_pReal,any(lattice_structure(p) == [lattice_FCC_ID,lattice_HEX_ID])) ! expand: family => system @@ -231,17 +248,17 @@ module subroutine plastic_dislotwin_init prm%B = math_expand(prm%B, N_sl) ! sanity checks - if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' D0' - if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' Qsd' + if ( prm%D0 <= 0.0_pReal) extmsg = trim(extmsg)//' D_0' + if ( prm%Qsd <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl' if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0' if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0' - if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v0' + if (any(prm%v0 < 0.0_pReal)) extmsg = trim(extmsg)//' v_0' if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl' - if (any(prm%Delta_F <= 0.0_pReal)) extmsg = trim(extmsg)//' Delta_F' - if (any(prm%CLambdaSlip <= 0.0_pReal)) extmsg = trim(extmsg)//' CLambdaSlip' + if (any(prm%Delta_F <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s' + if (any(prm%CLambdaSlip <= 0.0_pReal)) extmsg = trim(extmsg)//' i_sl' if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B' - if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p' - if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q' + if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p_sl' + if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q_sl' else slipActive rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray allocate(prm%b_sl,prm%Delta_F,prm%v0,prm%CLambdaSlip,prm%p,prm%q,prm%B,source=emptyRealArray) @@ -250,31 +267,31 @@ module subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! twin related parameters - N_tw = config%getInts('ntwin', defaultVal=emptyIntArray) + N_tw = pl%get_asInts('N_tw', defaultVal=emptyIntArray) prm%sum_N_tw = sum(abs(N_tw)) twinActive: if (prm%sum_N_tw > 0) then - prm%P_tw = lattice_SchmidMatrix_twin(N_tw,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,& - config%getFloats('interaction_twintwin'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_tw_tw'), & + phase%get_asString('lattice')) - prm%b_tw = config%getFloats('twinburgers', requiredSize=size(N_tw)) - prm%t_tw = config%getFloats('twinsize', requiredSize=size(N_tw)) - prm%r = config%getFloats('r_twin', requiredSize=size(N_tw)) + prm%b_tw = pl%get_asFloats('b_tw', requiredSize=size(N_tw)) + prm%t_tw = pl%get_asFloats('t_tw', requiredSize=size(N_tw)) + prm%r = pl%get_asFloats('p_tw', requiredSize=size(N_tw)) - prm%xc_twin = config%getFloat('xc_twin') - prm%L_tw = config%getFloat('l0_twin') - prm%i_tw = config%getFloat('cmfptwin') + prm%xc_twin = pl%get_asFloat('x_c_tw') + prm%L_tw = pl%get_asFloat('L_tw') + prm%i_tw = pl%get_asFloat('i_tw') - prm%gamma_char= lattice_characteristicShear_Twin(N_tw,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%gamma_char= lattice_characteristicShear_Twin(N_tw,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - prm%C66_tw = lattice_C66_twin(N_tw,prm%C66,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%C66_tw = lattice_C66_twin(N_tw,prm%C66,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) if (.not. prm%fccTwinTransNucleation) then - prm%dot_N_0_tw = config%getFloats('ndot0_twin') + prm%dot_N_0_tw = pl%get_asFloats('dot_N_0_tw') prm%dot_N_0_tw = math_expand(prm%dot_N_0_tw,N_tw) endif @@ -284,12 +301,12 @@ module subroutine plastic_dislotwin_init prm%r = math_expand(prm%r,N_tw) ! sanity checks - if ( prm%xc_twin < 0.0_pReal) extmsg = trim(extmsg)//' xc_twin' + if ( prm%xc_twin < 0.0_pReal) extmsg = trim(extmsg)//' x_c_twin' if ( prm%L_tw < 0.0_pReal) extmsg = trim(extmsg)//' L_tw' if ( prm%i_tw < 0.0_pReal) extmsg = trim(extmsg)//' i_tw' if (any(prm%b_tw < 0.0_pReal)) extmsg = trim(extmsg)//' b_tw' if (any(prm%t_tw < 0.0_pReal)) extmsg = trim(extmsg)//' t_tw' - if (any(prm%r < 0.0_pReal)) extmsg = trim(extmsg)//' r' + if (any(prm%r < 0.0_pReal)) extmsg = trim(extmsg)//' p_tw' if (.not. prm%fccTwinTransNucleation) then if (any(prm%dot_N_0_tw < 0.0_pReal)) extmsg = trim(extmsg)//' dot_N_0_tw' endif @@ -300,46 +317,46 @@ module subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! transformation related parameters - N_tr = config%getInts('ntrans', defaultVal=emptyIntArray) + N_tr = pl%get_asInts('N_tr', defaultVal=emptyIntArray) prm%sum_N_tr = sum(abs(N_tr)) transActive: if (prm%sum_N_tr > 0) then - prm%b_tr = config%getFloats('transburgers') + prm%b_tr = pl%get_asFloats('b_tr') prm%b_tr = math_expand(prm%b_tr,N_tr) - prm%h = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%i_tr = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%gamma_fcc_hex = config%getFloat('deltag') - prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%L_tr = config%getFloat('l0_trans') + prm%h = pl%get_asFloat('h', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%i_tr = pl%get_asFloat('i_tr', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%gamma_fcc_hex = pl%get_asFloat('delta_G') + prm%xc_trans = pl%get_asFloat('x_c_tr', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%L_tr = pl%get_asFloat('L_tr') - prm%h_tr_tr = lattice_interaction_TransByTrans(N_tr,config%getFloats('interaction_transtrans'), & - config%getString('lattice_structure')) + prm%h_tr_tr = lattice_interaction_TransByTrans(N_tr,pl%get_asFloats('h_tr_tr'), & + phase%get_asString('lattice')) - prm%C66_tr = lattice_C66_trans(N_tr,prm%C66,config%getString('trans_lattice_structure'), & + prm%C66_tr = lattice_C66_trans(N_tr,prm%C66,pl%get_asString('trans_lattice_structure'), & 0.0_pReal, & - config%getFloat('a_bcc', defaultVal=0.0_pReal), & - config%getFloat('a_fcc', defaultVal=0.0_pReal)) + pl%get_asFloat('a_bcc', defaultVal=0.0_pReal), & + pl%get_asFloat('a_fcc', defaultVal=0.0_pReal)) - prm%P_tr = lattice_SchmidMatrix_trans(N_tr,config%getString('trans_lattice_structure'), & + prm%P_tr = lattice_SchmidMatrix_trans(N_tr,pl%get_asString('trans_lattice_structure'), & 0.0_pReal, & - config%getFloat('a_bcc', defaultVal=0.0_pReal), & - config%getFloat('a_fcc', defaultVal=0.0_pReal)) + pl%get_asFloat('a_bcc', defaultVal=0.0_pReal), & + pl%get_asFloat('a_fcc', defaultVal=0.0_pReal)) if (lattice_structure(p) /= lattice_FCC_ID) then - prm%dot_N_0_tr = config%getFloats('ndot0_trans') + prm%dot_N_0_tr = pl%get_asFloats('dot_N_0_tr') prm%dot_N_0_tr = math_expand(prm%dot_N_0_tr,N_tr) endif - prm%t_tr = config%getFloats('lamellarsize') + prm%t_tr = pl%get_asFloats('t_tr') prm%t_tr = math_expand(prm%t_tr,N_tr) - prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) + prm%s = pl%get_asFloats('p_tr',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,N_tr) ! sanity checks - if ( prm%xc_trans < 0.0_pReal) extmsg = trim(extmsg)//' xc_trans' + if ( prm%xc_trans < 0.0_pReal) extmsg = trim(extmsg)//' x_c_trans' if ( prm%L_tr < 0.0_pReal) extmsg = trim(extmsg)//' L_tr' if ( prm%i_tr < 0.0_pReal) extmsg = trim(extmsg)//' i_tr' if (any(prm%t_tr < 0.0_pReal)) extmsg = trim(extmsg)//' t_tr' - if (any(prm%s < 0.0_pReal)) extmsg = trim(extmsg)//' s' + if (any(prm%s < 0.0_pReal)) extmsg = trim(extmsg)//' p_tr' if (lattice_structure(p) /= lattice_FCC_ID) then if (any(prm%dot_N_0_tr < 0.0_pReal)) extmsg = trim(extmsg)//' dot_N_0_tr' endif @@ -350,42 +367,42 @@ module subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! shearband related parameters - prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) + prm%sbVelocity = pl%get_asFloat('v_sb',defaultVal=0.0_pReal) if (prm%sbVelocity > 0.0_pReal) then - prm%sbResistance = config%getFloat('shearbandresistance') - prm%E_sb = config%getFloat('qedgepersbsystem') - prm%p_sb = config%getFloat('p_shearband') - prm%q_sb = config%getFloat('q_shearband') + prm%sbResistance = pl%get_asFloat('xi_sb') + prm%E_sb = pl%get_asFloat('Q_sb') + prm%p_sb = pl%get_asFloat('p_sb') + prm%q_sb = pl%get_asFloat('q_sb') ! sanity checks - if (prm%sbResistance < 0.0_pReal) extmsg = trim(extmsg)//' shearbandresistance' - if (prm%E_sb < 0.0_pReal) extmsg = trim(extmsg)//' qedgepersbsystem' - if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_shearband' - if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_shearband' + if (prm%sbResistance < 0.0_pReal) extmsg = trim(extmsg)//' xi_sb' + if (prm%E_sb < 0.0_pReal) extmsg = trim(extmsg)//' Q_sb' + if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb' + if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb' endif !-------------------------------------------------------------------------------------------------- ! parameters required for several mechanisms and their interactions if(prm%sum_N_sl + prm%sum_N_tw + prm%sum_N_tw > 0) & - prm%D = config%getFloat('grainsize') + prm%D = pl%get_asFloat('D') twinOrSlipActive: if (prm%sum_N_tw + prm%sum_N_tr > 0) then - prm%SFE_0K = config%getFloat('sfe_0k') - prm%dSFE_dT = config%getFloat('dsfe_dt') - prm%V_cs = config%getFloat('vcrossslip') + prm%SFE_0K = pl%get_asFloat('Gamma_sf_0K') + prm%dSFE_dT = pl%get_asFloat('dGamma_sf_dT') + prm%V_cs = pl%get_asFloat('V_cs') endif twinOrSlipActive slipAndTwinActive: if (prm%sum_N_sl * prm%sum_N_tw > 0) then prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,N_tw,& - config%getFloats('interaction_sliptwin'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_tw'), & + phase%get_asString('lattice')) if (prm%fccTwinTransNucleation .and. size(N_tw) /= 1) extmsg = trim(extmsg)//' interaction_sliptwin' endif slipAndTwinActive slipAndTransActive: if (prm%sum_N_sl * prm%sum_N_tr > 0) then prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,N_tr,& - config%getFloats('interaction_sliptrans'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_tr'), & + phase%get_asString('lattice')) if (prm%fccTwinTransNucleation .and. size(N_tr) /= 1) extmsg = trim(extmsg)//' interaction_sliptrans' endif slipAndTransActive @@ -397,7 +414,8 @@ module subroutine plastic_dislotwin_init + size(['f_tr']) * prm%sum_N_tr sizeState = sizeDotState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) + + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and atol @@ -406,7 +424,7 @@ module subroutine plastic_dislotwin_init stt%rho_mob=>plasticState(p)%state(startIndex:endIndex,:) stt%rho_mob= spread(rho_mob_0,2,NipcMyPhase) dot%rho_mob=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_rho',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho' startIndex = endIndex + 1 @@ -414,7 +432,7 @@ module subroutine plastic_dislotwin_init stt%rho_dip=>plasticState(p)%state(startIndex:endIndex,:) stt%rho_dip= spread(rho_dip_0,2,NipcMyPhase) dot%rho_dip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_rho',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl @@ -428,14 +446,14 @@ module subroutine plastic_dislotwin_init endIndex = endIndex + prm%sum_N_tw stt%f_tw=>plasticState(p)%state(startIndex:endIndex,:) dot%f_tw=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('f_twin',defaultVal=1.0e-7_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('f_twin',defaultVal=1.0e-7_pReal) if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' f_twin' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_tr stt%f_tr=>plasticState(p)%state(startIndex:endIndex,:) dot%f_tr=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('f_trans',defaultVal=1.0e-6_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('f_trans',defaultVal=1.0e-6_pReal) if (any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' f_trans' allocate(dst%Lambda_sl (prm%sum_N_sl,NipcMyPhase),source=0.0_pReal) @@ -457,11 +475,11 @@ module subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_DISLOTWIN_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotwin)') enddo -end subroutine plastic_dislotwin_init +end function plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- @@ -824,33 +842,33 @@ module subroutine plastic_dislotwin_results(instance,group) select case(trim(prm%output(o))) case('rho_mob') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_mob,'rho_mob',& + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_mob,trim(prm%output(o)), & 'mobile dislocation density','1/m²') case('rho_dip') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip,'rho_dip',& + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip,trim(prm%output(o)), & 'dislocation dipole density','1/m²') case('gamma_sl') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_sl,'gamma_sl',& + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_sl,trim(prm%output(o)), & 'plastic shear','1') - case('lambda_sl') - if(prm%sum_N_sl>0) call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',& + case('Lambda_sl') + if(prm%sum_N_sl>0) call results_writeDataset(group,dst%Lambda_sl,trim(prm%output(o)), & 'mean free path for slip','m') case('tau_pass') - if(prm%sum_N_sl>0) call results_writeDataset(group,dst%tau_pass,'tau_pass',& + if(prm%sum_N_sl>0) call results_writeDataset(group,dst%tau_pass,trim(prm%output(o)), & 'passing stress for slip','Pa') case('f_tw') - if(prm%sum_N_tw>0) call results_writeDataset(group,stt%f_tw,'f_tw',& + if(prm%sum_N_tw>0) call results_writeDataset(group,stt%f_tw,trim(prm%output(o)), & 'twinned volume fraction','m³/m³') - case('lambda_tw') - if(prm%sum_N_tw>0) call results_writeDataset(group,dst%Lambda_tw,'Lambda_tw',& + case('Lambda_tw') + if(prm%sum_N_tw>0) call results_writeDataset(group,dst%Lambda_tw,trim(prm%output(o)), & 'mean free path for twinning','m') case('tau_hat_tw') - if(prm%sum_N_tw>0) call results_writeDataset(group,dst%tau_hat_tw,'tau_hat_tw',& + if(prm%sum_N_tw>0) call results_writeDataset(group,dst%tau_hat_tw,trim(prm%output(o)), & 'threshold stress for twinning','Pa') case('f_tr') - if(prm%sum_N_tr>0) call results_writeDataset(group,stt%f_tr,'f_tr',& + if(prm%sum_N_tr>0) call results_writeDataset(group,stt%f_tr,trim(prm%output(o)), & 'martensite volume fraction','m³/m³') end select diff --git a/src/constitutive_plastic_isotropic.f90 b/src/constitutive_plastic_isotropic.f90 index 3484b6f64..adb87c0b1 100644 --- a/src/constitutive_plastic_isotropic.f90 +++ b/src/constitutive_plastic_isotropic.f90 @@ -49,58 +49,78 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_init +module function plastic_isotropic_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & p, & + i, & NipcMyPhase, & sizeState, sizeDotState real(pReal) :: & xi_0 !< initial critical stress character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_ISOTROPIC_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- plastic_isotropic init -+>>>' write(6,'(/,a)') ' Maiti and Eisenlohr, Scripta Materialia 145:37–40, 2018' write(6,'(a)') ' https://doi.org/10.1016/j.scriptamat.2017.09.047' - Ninstance = count(phase_plasticity == PLASTICITY_ISOTROPIC_ID) + + myPlasticity = plastic_active('isotropic') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_ISOTROPIC_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - config => config_phase(p)) + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + stt => state(i)) + pl => phase%get('plasticity') + + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif #ifdef DEBUG if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) & prm%of_debug = material_phasememberAt(debugConstitutive%grain,debugConstitutive%ip,debugConstitutive%element) #endif - xi_0 = config%getFloat('tau0') - prm%xi_inf = config%getFloat('tausat') - prm%dot_gamma_0 = config%getFloat('gdot0') - prm%n = config%getFloat('n') - prm%h0 = config%getFloat('h0') - prm%M = config%getFloat('m') - prm%h_ln = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal) - prm%c_1 = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal) - prm%c_4 = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal) - prm%c_3 = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal) - prm%c_2 = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal) - prm%a = config%getFloat('a') + xi_0 = pl%get_asFloat('xi_0') + prm%xi_inf = pl%get_asFloat('xi_inf') + prm%dot_gamma_0 = pl%get_asFloat('dot_gamma_0') + prm%n = pl%get_asFloat('n') + prm%h0 = pl%get_asFloat('h_0') + prm%M = pl%get_asFloat('M') + prm%h_ln = pl%get_asFloat('h_ln', defaultVal=0.0_pReal) + prm%c_1 = pl%get_asFloat('c_1', defaultVal=0.0_pReal) + prm%c_4 = pl%get_asFloat('c_4', defaultVal=0.0_pReal) + prm%c_3 = pl%get_asFloat('c_3', defaultVal=0.0_pReal) + prm%c_2 = pl%get_asFloat('c_2', defaultVal=0.0_pReal) + prm%a = pl%get_asFloat('a') - prm%dilatation = config%keyExists('/dilatation/') + prm%dilatation = pl%get_AsBool('dilatation',defaultVal = .false.) !-------------------------------------------------------------------------------------------------- ! sanity checks @@ -113,22 +133,22 @@ module subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phaseAt == p) * discretization_nIP - sizeDotState = size(['xi ','accumulated_shear']) + sizeDotState = size(['xi ','gamma']) sizeState = sizeDotState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization stt%xi => plasticState(p)%state (1,:) stt%xi = xi_0 dot%xi => plasticState(p)%dotState(1,:) - plasticState(p)%atol(1) = config%getFloat('atol_xi',defaultVal=1.0_pReal) + plasticState(p)%atol(1) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) if (plasticState(p)%atol(1) < 0.0_pReal) extmsg = trim(extmsg)//' atol_xi' stt%gamma => plasticState(p)%state (2,:) dot%gamma => plasticState(p)%dotState(2,:) - plasticState(p)%atol(2) = config%getFloat('atol_gamma',defaultVal=1.0e-6_pReal) + plasticState(p)%atol(2) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) if (plasticState(p)%atol(2) < 0.0_pReal) extmsg = trim(extmsg)//' atol_gamma' ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(2:2,:) @@ -139,11 +159,11 @@ module subroutine plastic_isotropic_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(isotropic)') enddo -end subroutine plastic_isotropic_init +end function plastic_isotropic_init !-------------------------------------------------------------------------------------------------- @@ -319,8 +339,9 @@ module subroutine plastic_isotropic_results(instance,group) associate(prm => param(instance), stt => state(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case ('flowstress') ! ToDo: should be 'xi' - call results_writeDataset(group,stt%xi,'xi','resistance against plastic flow','Pa') + case ('xi') + call results_writeDataset(group,stt%xi,trim(prm%output(o)), & + 'resistance against plastic flow','Pa') end select enddo outputsLoop end associate diff --git a/src/constitutive_plastic_kinehardening.f90 b/src/constitutive_plastic_kinehardening.f90 index 163b5794a..ffbfb6a13 100644 --- a/src/constitutive_plastic_kinehardening.f90 +++ b/src/constitutive_plastic_kinehardening.f90 @@ -58,11 +58,12 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_init +module function plastic_kinehardening_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & - p, o, & + p, i, o, & NipcMyPhase, & sizeState, sizeDeltaState, sizeDotState, & startIndex, endIndex @@ -73,26 +74,42 @@ module subroutine plastic_kinehardening_init a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_KINEHARDENING_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- plastic_kinehardening init -+>>>' - Ninstance = count(phase_plasticity == PLASTICITY_KINEHARDENING_ID) + myPlasticity = plastic_active('kinehardening') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) allocate(deltaState(Ninstance)) - do p = 1, size(phase_plasticityInstance) - if (phase_plasticity(p) /= PLASTICITY_KINEHARDENING_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - dlt => deltaState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)),& - config => config_phase(p)) + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + dlt => deltaState(i), & + stt => state(i)) + pl => phase%get('plasticity') + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif #ifdef DEBUG if (p==material_phaseAt(debugConstitutive%grain,debugConstitutive%element)) then @@ -102,14 +119,14 @@ module subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! slip related parameters - N_sl = config%getInts('nslip',defaultVal=emptyIntArray) + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%P = lattice_SchmidMatrix_slip(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P = lattice_SchmidMatrix_slip(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - if(trim(config%getString('lattice_structure')) == 'bcc') then - a = config%getFloats('nonschmid_coefficients',defaultVal = emptyRealArray) + if(trim(phase%get_asString('lattice')) == 'bcc') then + a = pl%get_asFloats('nonSchmid_coefficients',defaultVal = emptyRealArray) if(size(a) > 0) prm%nonSchmidActive = .true. prm%nonSchmid_pos = lattice_nonSchmidMatrix(N_sl,a,+1) prm%nonSchmid_neg = lattice_nonSchmidMatrix(N_sl,a,-1) @@ -118,19 +135,19 @@ module subroutine plastic_kinehardening_init prm%nonSchmid_neg = prm%P endif prm%interaction_SlipSlip = lattice_interaction_SlipBySlip(N_sl, & - config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_sl'), & + phase%get_asString('lattice')) - xi_0 = config%getFloats('crss0', requiredSize=size(N_sl)) - prm%tau1 = config%getFloats('tau1', requiredSize=size(N_sl)) - prm%tau1_b = config%getFloats('tau1_b', requiredSize=size(N_sl)) - prm%theta0 = config%getFloats('theta0', requiredSize=size(N_sl)) - prm%theta1 = config%getFloats('theta1', requiredSize=size(N_sl)) - prm%theta0_b = config%getFloats('theta0_b', requiredSize=size(N_sl)) - prm%theta1_b = config%getFloats('theta1_b', requiredSize=size(N_sl)) + xi_0 = pl%get_asFloats('xi_0', requiredSize=size(N_sl)) + prm%tau1 = pl%get_asFloats('xi_inf_f', requiredSize=size(N_sl)) + prm%tau1_b = pl%get_asFloats('xi_inf_b', requiredSize=size(N_sl)) + prm%theta0 = pl%get_asFloats('h_0_f', requiredSize=size(N_sl)) + prm%theta1 = pl%get_asFloats('h_inf_f', requiredSize=size(N_sl)) + prm%theta0_b = pl%get_asFloats('h_0_b', requiredSize=size(N_sl)) + prm%theta1_b = pl%get_asFloats('h_inf_b', requiredSize=size(N_sl)) - prm%gdot0 = config%getFloat('gdot0') - prm%n = config%getFloat('n_slip') + prm%gdot0 = pl%get_asFloat('dot_gamma_0') + prm%n = pl%get_asFloat('n') ! expand: family => system xi_0 = math_expand(xi_0, N_sl) @@ -143,11 +160,11 @@ module subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! sanity checks - if ( prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0' - if ( prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' - if (any(xi_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' crss0' - if (any(prm%tau1 <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1' - if (any(prm%tau1_b <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1_b' + if ( prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0' + if ( prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n' + if (any(xi_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_0' + if (any(prm%tau1 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_inf_f' + if (any(prm%tau1_b <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_inf_b' !ToDo: Any sensible checks for theta? else slipActive @@ -159,11 +176,11 @@ module subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! allocate state arrays NipcMyPhase = count(material_phaseAt == p) * discretization_nIP - sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%sum_N_sl - sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%sum_N_sl + sizeDotState = size(['crss ','crss_back', 'accshear ']) * prm%sum_N_sl!ToDo: adjust names, ask Philip + sizeDeltaState = size(['sense ', 'chi0 ', 'gamma0' ]) * prm%sum_N_sl !ToDo: adjust names sizeState = sizeDotState + sizeDeltaState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization @@ -172,20 +189,20 @@ module subroutine plastic_kinehardening_init stt%crss => plasticState(p)%state (startIndex:endIndex,:) stt%crss = spread(xi_0, 2, NipcMyPhase) dot%crss => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_xi',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl stt%crss_back => plasticState(p)%state (startIndex:endIndex,:) dot%crss_back => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_xi',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl stt%accshear => plasticState(p)%state (startIndex:endIndex,:) dot%accshear => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_gamma',defaultVal=1.0e-6_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) @@ -212,12 +229,12 @@ module subroutine plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_KINEHARDENING_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(kinehardening)') enddo -end subroutine plastic_kinehardening_init +end function plastic_kinehardening_init !-------------------------------------------------------------------------------------------------- @@ -364,23 +381,23 @@ module subroutine plastic_kinehardening_results(instance,group) associate(prm => param(instance), stt => state(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('resistance') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%crss,'xi_sl', & + case('xi') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%crss,trim(prm%output(o)), & 'resistance against plastic slip','Pa') - case('backstress') ! ToDo: should be 'tau_back' - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%crss_back,'tau_back', & + case('tau_b') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%crss_back,trim(prm%output(o)), & 'back stress against plastic slip','Pa') - case ('sense') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%sense,'sense_of_shear', & + case ('sgn(gamma)') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%sense,trim(prm%output(o)), & ! ToDo: could be int 'tbd','1') - case ('chi0') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%chi0,'chi0', & + case ('chi_0') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%chi0,trim(prm%output(o)), & 'tbd','Pa') - case ('gamma0') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma0,'gamma0', & + case ('gamma_0') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma0,trim(prm%output(o)), & 'tbd','1') - case ('accumulatedshear') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%accshear,'gamma_sl', & + case ('gamma') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%accshear,trim(prm%output(o)), & 'plastic shear','1') end select enddo outputsLoop diff --git a/src/constitutive_plastic_none.f90 b/src/constitutive_plastic_none.f90 index 4e6033499..283dac75b 100644 --- a/src/constitutive_plastic_none.f90 +++ b/src/constitutive_plastic_none.f90 @@ -12,26 +12,40 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_none_init +module function plastic_none_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & p, & NipcMyPhase + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_NONE_LABEL//' init -+>>>' - - Ninstance = count(phase_plasticity == PLASTICITY_NONE_ID) - write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) - - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle - - NipcMyPhase = count(material_phaseAt == p) * discretization_nIP - call material_allocateState(plasticState(p),NipcMyPhase,0,0,0) + write(6,'(/,a)') ' <<<+- plastic_none init -+>>>' + phases => material_root%get('phase') + allocate(myPlasticity(phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + pl => phase%get('plasticity') + if(pl%get_asString('type') == 'none') myPlasticity(p) = .true. enddo -end subroutine plastic_none_init + Ninstance = count(myPlasticity) + write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return + + do p = 1, phases%length + phase => phases%get(p) + if(.not. myPlasticity(p)) cycle + NipcMyPhase = count(material_phaseAt == p) * discretization_nIP + call constitutive_allocateState(plasticState(p),NipcMyPhase,0,0,0) + enddo + +end function plastic_none_init + end submodule plastic_none diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 4971b48f5..f16dbbf1a 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -163,11 +163,12 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_init +module function plastic_nonlocal_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & - p, & + p, i, & NipcMyPhase, & sizeState, sizeDotState, sizeDependentState, sizeDeltaState, & s1, s2, & @@ -178,8 +179,12 @@ module subroutine plastic_nonlocal_init extmsg = '' type(tInitialParameters) :: & ini - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONLOCAL_LABEL//' init -+>>>' + class(tNode), pointer :: & + phases, & + phase, & + pl + + write(6,'(/,a)') ' <<<+- plastic_nonlocal init -+>>>' write(6,'(/,a)') ' Reuber et al., Acta Materialia 71:333–348, 2014' write(6,'(a)') ' https://doi.org/10.1016/j.actamat.2014.03.012' @@ -187,8 +192,15 @@ module subroutine plastic_nonlocal_init write(6,'(/,a)') ' Kords, Dissertation RWTH Aachen, 2014' write(6,'(a)') ' http://publications.rwth-aachen.de/record/229993' - Ninstance = count(phase_plasticity == PLASTICITY_NONLOCAL_ID) + myPlasticity = plastic_active('nonlocal') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) then + call geometry_plastic_nonlocal_disable + return + endif + allocate(param(Ninstance)) allocate(state(Ninstance)) @@ -197,33 +209,43 @@ module subroutine plastic_nonlocal_init allocate(deltaState(Ninstance)) allocate(microstructure(Ninstance)) - do p=1, size(config_phase) - if (phase_plasticity(p) /= PLASTICITY_NONLOCAL_ID) cycle + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - st0 => state0(phase_plasticityInstance(p)), & - del => deltaState(phase_plasticityInstance(p)), & - dst => microstructure(phase_plasticityInstance(p)), & - config => config_phase(p)) + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + stt => state(i), & + st0 => state0(i), & + del => deltaState(i), & + dst => microstructure(i)) + pl => phase%get('plasticity') - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + phase_localPlasticity(p) = .not. pl%contains('nonlocal') - prm%atol_rho = config%getFloat('atol_rho',defaultVal=1.0e4_pReal) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + prm%atol_rho = pl%get_asFloat('atol_rho',defaultVal=1.0e4_pReal) ! This data is read in already in lattice prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) - ini%N_sl = config%getInts('nslip',defaultVal=emptyIntArray) + ini%N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(ini%N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%Schmid = lattice_SchmidMatrix_slip(ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%Schmid = lattice_SchmidMatrix_slip(ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - if(trim(config%getString('lattice_structure')) == 'bcc') then - a = config%getFloats('nonschmid_coefficients',defaultVal = emptyRealArray) + if(trim(phase%get_asString('lattice')) == 'bcc') then + a = pl%get_asFloats('nonSchmid_coefficients',defaultVal = emptyRealArray) if(size(a) > 0) prm%nonSchmidActive = .true. prm%nonSchmid_pos = lattice_nonSchmidMatrix(ini%N_sl,a,+1) prm%nonSchmid_neg = lattice_nonSchmidMatrix(ini%N_sl,a,-1) @@ -233,20 +255,20 @@ module subroutine plastic_nonlocal_init endif prm%interactionSlipSlip = lattice_interaction_SlipBySlip(ini%N_sl, & - config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_sl'), & + phase%get_asString('lattice')) - prm%forestProjection_edge = lattice_forestProjection_edge (ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%forestProjection_screw = lattice_forestProjection_screw(ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%forestProjection_edge = lattice_forestProjection_edge (ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + prm%forestProjection_screw = lattice_forestProjection_screw(ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_direction = lattice_slip_direction (ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_transverse = lattice_slip_transverse(ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%slip_normal = lattice_slip_normal (ini%N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_direction = lattice_slip_direction (ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_transverse = lattice_slip_transverse(ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + prm%slip_normal = lattice_slip_normal (ini%N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) ! collinear systems (only for octahedral slip systems in fcc) allocate(prm%colinearSystem(prm%sum_N_sl), source = -1) @@ -258,113 +280,113 @@ module subroutine plastic_nonlocal_init enddo enddo - ini%rhoSglEdgePos0 = config%getFloats('rhosgledgepos0', requiredSize=size(ini%N_sl)) - ini%rhoSglEdgeNeg0 = config%getFloats('rhosgledgeneg0', requiredSize=size(ini%N_sl)) - ini%rhoSglScrewPos0 = config%getFloats('rhosglscrewpos0', requiredSize=size(ini%N_sl)) - ini%rhoSglScrewNeg0 = config%getFloats('rhosglscrewneg0', requiredSize=size(ini%N_sl)) - ini%rhoDipEdge0 = config%getFloats('rhodipedge0', requiredSize=size(ini%N_sl)) - ini%rhoDipScrew0 = config%getFloats('rhodipscrew0', requiredSize=size(ini%N_sl)) + ini%rhoSglEdgePos0 = pl%get_asFloats('rho_u_ed_pos_0', requiredSize=size(ini%N_sl)) + ini%rhoSglEdgeNeg0 = pl%get_asFloats('rho_u_ed_neg_0', requiredSize=size(ini%N_sl)) + ini%rhoSglScrewPos0 = pl%get_asFloats('rho_u_sc_pos_0', requiredSize=size(ini%N_sl)) + ini%rhoSglScrewNeg0 = pl%get_asFloats('rho_u_sc_neg_0', requiredSize=size(ini%N_sl)) + ini%rhoDipEdge0 = pl%get_asFloats('rho_d_ed_0', requiredSize=size(ini%N_sl)) + ini%rhoDipScrew0 = pl%get_asFloats('rho_d_sc_0', requiredSize=size(ini%N_sl)) - prm%lambda0 = config%getFloats('lambda0', requiredSize=size(ini%N_sl)) - prm%burgers = config%getFloats('burgers', requiredSize=size(ini%N_sl)) + prm%lambda0 = pl%get_asFloats('i_sl', requiredSize=size(ini%N_sl)) + prm%burgers = pl%get_asFloats('b_sl', requiredSize=size(ini%N_sl)) prm%lambda0 = math_expand(prm%lambda0,ini%N_sl) prm%burgers = math_expand(prm%burgers,ini%N_sl) - prm%minDipoleHeight_edge = config%getFloats('minimumdipoleheightedge', requiredSize=size(ini%N_sl)) - prm%minDipoleHeight_screw = config%getFloats('minimumdipoleheightscrew', requiredSize=size(ini%N_sl)) + prm%minDipoleHeight_edge = pl%get_asFloats('d_ed', requiredSize=size(ini%N_sl)) + prm%minDipoleHeight_screw = pl%get_asFloats('d_sc', requiredSize=size(ini%N_sl)) prm%minDipoleHeight_edge = math_expand(prm%minDipoleHeight_edge, ini%N_sl) prm%minDipoleHeight_screw = math_expand(prm%minDipoleHeight_screw,ini%N_sl) allocate(prm%minDipoleHeight(prm%sum_N_sl,2)) prm%minDipoleHeight(:,1) = prm%minDipoleHeight_edge prm%minDipoleHeight(:,2) = prm%minDipoleHeight_screw - prm%peierlsstress_edge = config%getFloats('peierlsstressedge', requiredSize=size(ini%N_sl)) - prm%peierlsstress_screw = config%getFloats('peierlsstressscrew', requiredSize=size(ini%N_sl)) + prm%peierlsstress_edge = pl%get_asFloats('tau_peierls_ed', requiredSize=size(ini%N_sl)) + prm%peierlsstress_screw = pl%get_asFloats('tau_peierls_sc', requiredSize=size(ini%N_sl)) prm%peierlsstress_edge = math_expand(prm%peierlsstress_edge, ini%N_sl) prm%peierlsstress_screw = math_expand(prm%peierlsstress_screw,ini%N_sl) allocate(prm%peierlsstress(prm%sum_N_sl,2)) prm%peierlsstress(:,1) = prm%peierlsstress_edge prm%peierlsstress(:,2) = prm%peierlsstress_screw - prm%significantRho = config%getFloat('significantrho') - prm%significantN = config%getFloat('significantn', 0.0_pReal) - prm%CFLfactor = config%getFloat('cflfactor',defaultVal=2.0_pReal) + prm%significantRho = pl%get_asFloat('rho_significant') + prm%significantN = pl%get_asFloat('rho_num_significant', 0.0_pReal) + prm%CFLfactor = pl%get_asFloat('f_c',defaultVal=2.0_pReal) - prm%atomicVolume = config%getFloat('atomicvolume') - prm%Dsd0 = config%getFloat('selfdiffusionprefactor') !,'dsd0' - prm%selfDiffusionEnergy = config%getFloat('selfdiffusionenergy') !,'qsd' - prm%linetensionEffect = config%getFloat('linetension') - prm%edgeJogFactor = config%getFloat('edgejog')!,'edgejogs' - prm%doublekinkwidth = config%getFloat('doublekinkwidth') - prm%solidSolutionEnergy = config%getFloat('solidsolutionenergy') - prm%solidSolutionSize = config%getFloat('solidsolutionsize') - prm%solidSolutionConcentration = config%getFloat('solidsolutionconcentration') + prm%atomicVolume = pl%get_asFloat('V_at') + prm%Dsd0 = pl%get_asFloat('D_0') !,'dsd0' + prm%selfDiffusionEnergy = pl%get_asFloat('Q_cl') !,'qsd' + prm%linetensionEffect = pl%get_asFloat('f_F') + prm%edgeJogFactor = pl%get_asFloat('f_ed') !,'edgejogs' + prm%doublekinkwidth = pl%get_asFloat('w') + prm%solidSolutionEnergy = pl%get_asFloat('Q_sol') + prm%solidSolutionSize = pl%get_asFloat('f_sol') + prm%solidSolutionConcentration = pl%get_asFloat('c_sol') - prm%p = config%getFloat('p') - prm%q = config%getFloat('q') - prm%viscosity = config%getFloat('viscosity') - prm%fattack = config%getFloat('attackfrequency') + prm%p = pl%get_asFloat('p_sl') + prm%q = pl%get_asFloat('q_sl') + prm%viscosity = pl%get_asFloat('eta') + prm%fattack = pl%get_asFloat('nu_a') ! ToDo: discuss logic - ini%rhoSglScatter = config%getFloat('rhosglscatter') - ini%rhoSglRandom = config%getFloat('rhosglrandom',0.0_pReal) - if (config%keyExists('/rhosglrandom/')) & - ini%rhoSglRandomBinning = config%getFloat('rhosglrandombinning',0.0_pReal) !ToDo: useful default? + ini%rhoSglScatter = pl%get_asFloat('sigma_rho_u') + ini%rhoSglRandom = pl%get_asFloat('random_rho_u',defaultVal= 0.0_pReal) + if (pl%contains('random_rho_u')) & + ini%rhoSglRandomBinning = pl%get_asFloat('random_rho_u_binning',defaultVal=0.0_pReal) !ToDo: useful default? ! if (rhoSglRandom(instance) < 0.0_pReal) & ! if (rhoSglRandomBinning(instance) <= 0.0_pReal) & - prm%surfaceTransmissivity = config%getFloat('surfacetransmissivity',defaultVal=1.0_pReal) - prm%grainboundaryTransmissivity = config%getFloat('grainboundarytransmissivity',defaultVal=-1.0_pReal) - prm%fEdgeMultiplication = config%getFloat('edgemultiplication') - prm%shortRangeStressCorrection = config%keyExists('/shortrangestresscorrection/') + prm%surfaceTransmissivity = pl%get_asFloat('chi_surface',defaultVal=1.0_pReal) + prm%grainboundaryTransmissivity = pl%get_asFloat('chi_GB', defaultVal=-1.0_pReal) + prm%fEdgeMultiplication = pl%get_asFloat('f_ed_mult') + prm%shortRangeStressCorrection = pl%get_asBool('short_range_stress_correction', defaultVal = .false.) !-------------------------------------------------------------------------------------------------- ! sanity checks - if (any(prm%burgers < 0.0_pReal)) extmsg = trim(extmsg)//' burgers' - if (any(prm%lambda0 <= 0.0_pReal)) extmsg = trim(extmsg)//' lambda0' + if (any(prm%burgers < 0.0_pReal)) extmsg = trim(extmsg)//' b_sl' + if (any(prm%lambda0 <= 0.0_pReal)) extmsg = trim(extmsg)//' i_sl' - if (any(ini%rhoSglEdgePos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgePos0' - if (any(ini%rhoSglEdgeNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglEdgeNeg0' - if (any(ini%rhoSglScrewPos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewPos0' - if (any(ini%rhoSglScrewNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoSglScrewNeg0' - if (any(ini%rhoDipEdge0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipEdge0' - if (any(ini%rhoDipScrew0 < 0.0_pReal)) extmsg = trim(extmsg)//' rhoDipScrew0' + if (any(ini%rhoSglEdgePos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_ed_pos_0' + if (any(ini%rhoSglEdgeNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_ed_neg_0' + if (any(ini%rhoSglScrewPos0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_sc_pos_0' + if (any(ini%rhoSglScrewNeg0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_sc_neg_0' + if (any(ini%rhoDipEdge0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_d_ed_0' + if (any(ini%rhoDipScrew0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_d_sc_0' - if (any(prm%peierlsstress < 0.0_pReal)) extmsg = trim(extmsg)//' peierlsstress' - if (any(prm%minDipoleHeight < 0.0_pReal)) extmsg = trim(extmsg)//' minDipoleHeight' + if (any(prm%peierlsstress < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls' + if (any(prm%minDipoleHeight < 0.0_pReal)) extmsg = trim(extmsg)//' d_ed or d_sc' - if (prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' viscosity' - if (prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' selfDiffusionEnergy' - if (prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' fattack' - if (prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' doublekinkwidth' - if (prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' Dsd0' - if (prm%atomicVolume <= 0.0_pReal) extmsg = trim(extmsg)//' atomicVolume' ! ToDo: in disloUCLA, the atomic volume is given as a factor + if (prm%viscosity <= 0.0_pReal) extmsg = trim(extmsg)//' eta' + if (prm%selfDiffusionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl' + if (prm%fattack <= 0.0_pReal) extmsg = trim(extmsg)//' nu_a' + if (prm%doublekinkwidth <= 0.0_pReal) extmsg = trim(extmsg)//' w' + if (prm%Dsd0 < 0.0_pReal) extmsg = trim(extmsg)//' D_0' + if (prm%atomicVolume <= 0.0_pReal) extmsg = trim(extmsg)//' V_at' ! ToDo: in disloTungsten, the atomic volume is given as a factor - if (prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' significantN' - if (prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' significantrho' + if (prm%significantN < 0.0_pReal) extmsg = trim(extmsg)//' rho_num_significant' + if (prm%significantrho < 0.0_pReal) extmsg = trim(extmsg)//' rho_significant' if (prm%atol_rho < 0.0_pReal) extmsg = trim(extmsg)//' atol_rho' - if (prm%CFLfactor < 0.0_pReal) extmsg = trim(extmsg)//' CFLfactor' + if (prm%CFLfactor < 0.0_pReal) extmsg = trim(extmsg)//' f_c' - if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p' - if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p_sl' + if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q_sl' if (prm%linetensionEffect < 0.0_pReal .or. prm%linetensionEffect > 1.0_pReal) & - extmsg = trim(extmsg)//' linetensionEffect' + extmsg = trim(extmsg)//' f_F' if (prm%edgeJogFactor < 0.0_pReal .or. prm%edgeJogFactor > 1.0_pReal) & - extmsg = trim(extmsg)//' edgeJogFactor' + extmsg = trim(extmsg)//' f_ed' - if (prm%solidSolutionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionEnergy' - if (prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionSize' - if (prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' solidSolutionConcentration' + if (prm%solidSolutionEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' Q_sol' + if (prm%solidSolutionSize <= 0.0_pReal) extmsg = trim(extmsg)//' f_sol' + if (prm%solidSolutionConcentration <= 0.0_pReal) extmsg = trim(extmsg)//' c_sol' - if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' grainboundaryTransmissivity' + if (prm%grainboundaryTransmissivity > 1.0_pReal) extmsg = trim(extmsg)//' chi_GB' if (prm%surfaceTransmissivity < 0.0_pReal .or. prm%surfaceTransmissivity > 1.0_pReal) & - extmsg = trim(extmsg)//' surfaceTransmissivity' + extmsg = trim(extmsg)//' chi_surface' if (prm%fEdgeMultiplication < 0.0_pReal .or. prm%fEdgeMultiplication > 1.0_pReal) & - extmsg = trim(extmsg)//' fEdgeMultiplication' + extmsg = trim(extmsg)//' f_ed_mult' endif slipActive @@ -384,14 +406,14 @@ module subroutine plastic_nonlocal_init 'maxDipoleHeightEdge ','maxDipoleHeightScrew' ]) * prm%sum_N_sl !< other dependent state variables that are not updated by microstructure sizeDeltaState = sizeDotState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) - plasticState(p)%nonlocal = config%KeyExists('/nonlocal/') + plasticState(p)%nonlocal = pl%get_asBool('nonlocal') if(plasticState(p)%nonlocal .and. .not. allocated(IPneighborhood)) & call IO_error(212,ext_msg='IPneighborhood does not exist') - plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention + plasticState(p)%offsetDeltaState = 0 ! ToDo: state structure does not follow convention st0%rho => plasticState(p)%state0 (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) stt%rho => plasticState(p)%state (0*prm%sum_N_sl+1:10*prm%sum_N_sl,:) @@ -458,7 +480,7 @@ module subroutine plastic_nonlocal_init stt%gamma => plasticState(p)%state (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:NipcMyPhase) dot%gamma => plasticState(p)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:NipcMyPhase) del%gamma => plasticState(p)%deltaState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:NipcMyPhase) - plasticState(p)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = config%getFloat('atol_gamma', defaultVal = 1.0e-2_pReal) + plasticState(p)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asFloat('atol_gamma', defaultVal = 1.0e-2_pReal) if(any(plasticState(p)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) & extmsg = trim(extmsg)//' atol_gamma' plasticState(p)%slipRate => plasticState(p)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:NipcMyPhase) @@ -474,12 +496,12 @@ module subroutine plastic_nonlocal_init allocate(dst%tau_back(prm%sum_N_sl,NipcMyPhase),source=0.0_pReal) end associate - if (NipcMyPhase > 0) call stateInit(ini,p,NipcMyPhase) + if (NipcMyPhase > 0) call stateInit(ini,p,NipcMyPhase,i) plasticState(p)%state0 = plasticState(p)%state !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_NONLOCAL_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(nonlocal)') enddo @@ -491,35 +513,39 @@ module subroutine plastic_nonlocal_init allocate(iV(maxval(param%sum_N_sl),4,Ninstance), source=0) allocate(iD(maxval(param%sum_N_sl),2,Ninstance), source=0) - initializeInstances: do p = 1, size(phase_plasticity) - NipcMyPhase = count(material_phaseAt==p) * discretization_nIP - myPhase2: if (phase_plasticity(p) == PLASTICITY_NONLOCAL_ID) then - l = 0 - do t = 1,4 - do s = 1,param(phase_plasticityInstance(p))%sum_N_sl - l = l + 1 - iRhoU(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - l = l + (4+2+1+1)*param(phase_plasticityInstance(p))%sum_N_sl ! immobile(4), dipole(2), shear, forest - do t = 1,4 - do s = 1,param(phase_plasticityInstance(p))%sum_N_sl - l = l + 1 - iV(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - do t = 1,2 - do s = 1,param(phase_plasticityInstance(p))%sum_N_sl - l = l + 1 - iD(s,t,phase_plasticityInstance(p)) = l - enddo - enddo - if (iD(param(phase_plasticityInstance(p))%sum_N_sl,2,phase_plasticityInstance(p)) /= plasticState(p)%sizeState) & - call IO_error(0, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_LABEL//')') - endif myPhase2 - enddo initializeInstances + i = 0 + do p = 1, phases%length + phase => phases%get(p) -end subroutine plastic_nonlocal_init + if(.not. myPlasticity(p)) cycle + i = i + 1 + + NipcMyPhase = count(material_phaseAt==p) * discretization_nIP + l = 0 + do t = 1,4 + do s = 1,param(i)%sum_N_sl + l = l + 1 + iRhoU(s,t,i) = l + enddo + enddo + l = l + (4+2+1+1)*param(i)%sum_N_sl ! immobile(4), dipole(2), shear, forest + do t = 1,4 + do s = 1,param(i)%sum_N_sl + l = l + 1 + iV(s,t,i) = l + enddo + enddo + do t = 1,2 + do s = 1,param(i)%sum_N_sl + l = l + 1 + iD(s,t,i) = l + enddo + enddo + if (iD(param(i)%sum_N_sl,2,i) /= plasticState(p)%sizeState) & + call IO_error(0, ext_msg = 'state indices not properly set (nonlocal)') + enddo + +end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- @@ -1447,7 +1473,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) elseif (prm%grainboundaryTransmissivity >= 0.0_pReal) then !* GRAIN BOUNDARY ! !* fixed transmissivity for adjacent ips with different texture (only if explicitly given in material.config) - if (material_texture(1,i,e) /= material_texture(1,neighbor_i,neighbor_e) .and. & + if (any(dNeq(material_orientation0(1,i,e)%asQuaternion(), & + material_orientation0(1,neighbor_i,neighbor_e)%asQuaternion())) .and. & (.not. phase_localPlasticity(neighbor_phase))) & forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = sqrt(prm%grainboundaryTransmissivity) else @@ -1514,56 +1541,56 @@ module subroutine plastic_nonlocal_results(instance,group) associate(prm => param(instance),dst => microstructure(instance),stt=>state(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('rho_sgl_mob_edg_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_edg_pos, 'rho_sgl_mob_edg_pos', & + case('rho_u_ed_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_edg_pos, trim(prm%output(o)), & 'positive mobile edge density','1/m²') - case('rho_sgl_imm_edg_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_edg_pos, 'rho_sgl_imm_edg_pos',& + case('rho_b_ed_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_edg_pos, trim(prm%output(o)), & 'positive immobile edge density','1/m²') - case('rho_sgl_mob_edg_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_edg_neg, 'rho_sgl_mob_edg_neg',& + case('rho_u_ed_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_edg_neg, trim(prm%output(o)), & 'negative mobile edge density','1/m²') - case('rho_sgl_imm_edg_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_edg_neg, 'rho_sgl_imm_edg_neg',& + case('rho_b_ed_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_edg_neg, trim(prm%output(o)), & 'negative immobile edge density','1/m²') - case('rho_dip_edg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip_edg, 'rho_dip_edg',& + case('rho_d_ed') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip_edg, trim(prm%output(o)), & 'edge dipole density','1/m²') - case('rho_sgl_mob_scr_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_scr_pos, 'rho_sgl_mob_scr_pos',& + case('rho_u_sc_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_scr_pos, trim(prm%output(o)), & 'positive mobile screw density','1/m²') - case('rho_sgl_imm_scr_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_scr_pos, 'rho_sgl_imm_scr_pos',& + case('rho_b_sc_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_scr_pos, trim(prm%output(o)), & 'positive immobile screw density','1/m²') - case('rho_sgl_mob_scr_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_scr_neg, 'rho_sgl_mob_scr_neg',& + case('rho_u_sc_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_mob_scr_neg, trim(prm%output(o)), & 'negative mobile screw density','1/m²') - case('rho_sgl_imm_scr_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_scr_neg, 'rho_sgl_imm_scr_neg',& + case('rho_b_sc_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_sgl_imm_scr_neg, trim(prm%output(o)), & 'negative immobile screw density','1/m²') - case('rho_dip_scr') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip_scr, 'rho_dip_scr',& + case('rho_d_sc') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_dip_scr, trim(prm%output(o)), & 'screw dipole density','1/m²') - case('rho_forest') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_forest, 'rho_forest',& + case('rho_f') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%rho_forest, trim(prm%output(o)), & 'forest density','1/m²') - case('v_edg_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_edg_pos, 'v_edg_pos',& + case('v_ed_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_edg_pos, trim(prm%output(o)), & 'positive edge velocity','m/s') - case('v_edg_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_edg_neg, 'v_edg_neg',& + case('v_ed_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_edg_neg, trim(prm%output(o)), & 'negative edge velocity','m/s') - case('v_scr_pos') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_scr_pos, 'v_scr_pos',& + case('v_sc_pos') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_scr_pos, trim(prm%output(o)), & 'positive srew velocity','m/s') - case('v_scr_neg') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_scr_neg, 'v_scr_neg',& + case('v_sc_neg') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%v_scr_neg, trim(prm%output(o)), & 'negative screw velocity','m/s') case('gamma') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma,'gamma',& + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma, trim(prm%output(o)), & 'plastic shear','1') case('tau_pass') - if(prm%sum_N_sl>0) call results_writeDataset(group,dst%tau_pass,'tau_pass',& + if(prm%sum_N_sl>0) call results_writeDataset(group,dst%tau_pass, trim(prm%output(o)), & 'passing stress for slip','Pa') end select enddo outputsLoop @@ -1575,13 +1602,14 @@ end subroutine plastic_nonlocal_results !-------------------------------------------------------------------------------------------------- !> @brief populates the initial dislocation density !-------------------------------------------------------------------------------------------------- -subroutine stateInit(ini,phase,NipcMyPhase) +subroutine stateInit(ini,phase,NipcMyPhase,instance) type(tInitialParameters) :: & ini integer,intent(in) :: & phase, & - NipcMyPhase + NipcMyPhase, & + instance integer :: & e, & i, & @@ -1589,7 +1617,6 @@ subroutine stateInit(ini,phase,NipcMyPhase) from, & upto, & s, & - instance, & phasemember real(pReal), dimension(2) :: & noise, & @@ -1602,7 +1629,7 @@ subroutine stateInit(ini,phase,NipcMyPhase) real(pReal), dimension(NipcMyPhase) :: & volume - instance = phase_plasticityInstance(phase) + associate(stt => state(instance)) if (ini%rhoSglRandom > 0.0_pReal) then ! randomly distribute dislocation segments on random slip system and of random type in the volume diff --git a/src/constitutive_plastic_phenopowerlaw.f90 b/src/constitutive_plastic_phenopowerlaw.f90 index 3f6ade8d2..992949016 100644 --- a/src/constitutive_plastic_phenopowerlaw.f90 +++ b/src/constitutive_plastic_phenopowerlaw.f90 @@ -66,8 +66,9 @@ contains !> @brief Perform module initialization. !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_init +module function plastic_phenopowerlaw_init() result(myPlasticity) + logical, dimension(:), allocatable :: myPlasticity integer :: & Ninstance, & p, i, & @@ -82,33 +83,46 @@ module subroutine plastic_phenopowerlaw_init a !< non-Schmid coefficients character(len=pStringLen) :: & extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl - write(6,'(/,a)') ' <<<+- plastic_'//PLASTICITY_PHENOPOWERLAW_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- plastic_phenopowerlaw init -+>>>' - Ninstance = count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID) + + myPlasticity = plastic_active('phenopowerlaw') + + Ninstance = count(myPlasticity) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) - + if(Ninstance == 0) return + allocate(param(Ninstance)) allocate(state(Ninstance)) allocate(dotState(Ninstance)) - do p = 1, size(phase_plasticity) - if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle - associate(prm => param(phase_plasticityInstance(p)), & - dot => dotState(phase_plasticityInstance(p)), & - stt => state(phase_plasticityInstance(p)), & - config => config_phase(p)) + phases => material_root%get('phase') + i = 0 + do p = 1, phases%length + phase => phases%get(p) + + if(.not. myPlasticity(p)) cycle + i = i + 1 + associate(prm => param(i), & + dot => dotState(i), & + stt => state(i)) + pl => phase%get('plasticity') !-------------------------------------------------------------------------------------------------- ! slip related parameters - N_sl = config%getInts('nslip',defaultVal=emptyIntArray) + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%P_sl = lattice_SchmidMatrix_slip(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - if(trim(config%getString('lattice_structure')) == 'bcc') then - a = config%getFloats('nonschmid_coefficients',defaultVal = emptyRealArray) + if(phase%get_asString('lattice') == 'bcc') then + a = pl%get_asFloats('nonSchmid_coefficients',defaultVal=emptyRealArray) if(size(a) > 0) prm%nonSchmidActive = .true. prm%nonSchmid_pos = lattice_nonSchmidMatrix(N_sl,a,+1) prm%nonSchmid_neg = lattice_nonSchmidMatrix(N_sl,a,-1) @@ -117,18 +131,18 @@ module subroutine plastic_phenopowerlaw_init prm%nonSchmid_neg = prm%P_sl endif prm%interaction_SlipSlip = lattice_interaction_SlipBySlip(N_sl, & - config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_sl'), & + phase%get_asString('lattice')) - xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(N_sl)) - prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(N_sl)) - prm%H_int = config%getFloats('h_int', requiredSize=size(N_sl), & + xi_slip_0 = pl%get_asFloats('xi_0_sl', requiredSize=size(N_sl)) + prm%xi_slip_sat = pl%get_asFloats('xi_inf_sl', requiredSize=size(N_sl)) + prm%H_int = pl%get_asFloats('h_int', requiredSize=size(N_sl), & defaultVal=[(0.0_pReal,i=1,size(N_sl))]) - prm%gdot0_slip = config%getFloat('gdot0_slip') - prm%n_slip = config%getFloat('n_slip') - prm%a_slip = config%getFloat('a_slip') - prm%h0_SlipSlip = config%getFloat('h0_slipslip') + prm%gdot0_slip = pl%get_asFloat('dot_gamma_0_sl') + prm%n_slip = pl%get_asFloat('n_sl') + prm%a_slip = pl%get_asFloat('a_sl') + prm%h0_SlipSlip = pl%get_asFloat('h_0_sl_sl') ! expand: family => system xi_slip_0 = math_expand(xi_slip_0, N_sl) @@ -136,11 +150,11 @@ module subroutine plastic_phenopowerlaw_init prm%H_int = math_expand(prm%H_int, N_sl) ! sanity checks - if ( prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_slip' - if ( prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_slip' - if ( prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' - if (any(xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_0' - if (any(prm%xi_slip_sat <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_slip_sat' + if ( prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0_sl' + if ( prm%a_slip <= 0.0_pReal) extmsg = trim(extmsg)//' a_sl' + if ( prm%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_sl' + if (any(xi_slip_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_0_sl' + if (any(prm%xi_slip_sat <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_inf_sl' else slipActive xi_slip_0 = emptyRealArray @@ -150,34 +164,34 @@ module subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! twin related parameters - N_tw = config%getInts('ntwin', defaultVal=emptyIntArray) + N_tw = pl%get_asInts('N_tw', defaultVal=emptyIntArray) prm%sum_N_tw = sum(abs(N_tw)) twinActive: if (prm%sum_N_tw > 0) then - prm%P_tw = lattice_SchmidMatrix_twin(N_tw,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinByTwin(N_tw,& - config%getFloats('interaction_twintwin'), & - config%getString('lattice_structure')) - prm%gamma_twin_char = lattice_characteristicShear_twin(N_tw,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + pl%get_asFloats('h_tw_tw'), & + phase%get_asString('lattice')) + prm%gamma_twin_char = lattice_characteristicShear_twin(N_tw,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - xi_twin_0 = config%getFloats('tau0_twin',requiredSize=size(N_tw)) + xi_twin_0 = pl%get_asFloats('xi_0_tw',requiredSize=size(N_tw)) - prm%c_1 = config%getFloat('twin_c',defaultVal=0.0_pReal) - prm%c_2 = config%getFloat('twin_b',defaultVal=1.0_pReal) - prm%c_3 = config%getFloat('twin_e',defaultVal=0.0_pReal) - prm%c_4 = config%getFloat('twin_d',defaultVal=0.0_pReal) - prm%gdot0_twin = config%getFloat('gdot0_twin') - prm%n_twin = config%getFloat('n_twin') - prm%spr = config%getFloat('s_pr') - prm%h0_TwinTwin = config%getFloat('h0_twintwin') + prm%c_1 = pl%get_asFloat('c_1',defaultVal=0.0_pReal) + prm%c_2 = pl%get_asFloat('c_2',defaultVal=1.0_pReal) + prm%c_3 = pl%get_asFloat('c_3',defaultVal=0.0_pReal) + prm%c_4 = pl%get_asFloat('c_4',defaultVal=0.0_pReal) + prm%gdot0_twin = pl%get_asFloat('dot_gamma_0_tw') + prm%n_twin = pl%get_asFloat('n_tw') + prm%spr = pl%get_asFloat('f_sl_sat_tw') + prm%h0_TwinTwin = pl%get_asFloat('h_0_tw_tw') ! expand: family => system xi_twin_0 = math_expand(xi_twin_0,N_tw) ! sanity checks - if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0_twin' - if (prm%n_twin <= 0.0_pReal) extmsg = trim(extmsg)//' n_twin' + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0_tw' + if (prm%n_twin <= 0.0_pReal) extmsg = trim(extmsg)//' n_tw' else twinActive xi_twin_0 = emptyRealArray @@ -188,13 +202,13 @@ module subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! slip-twin related parameters slipAndTwinActive: if (prm%sum_N_sl > 0 .and. prm%sum_N_tw > 0) then - prm%h0_TwinSlip = config%getFloat('h0_twinslip') + prm%h0_TwinSlip = pl%get_asFloat('h_0_tw_sl') prm%interaction_SlipTwin = lattice_interaction_SlipByTwin(N_sl,N_tw,& - config%getFloats('interaction_sliptwin'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_sl_tw'), & + phase%get_asString('lattice')) prm%interaction_TwinSlip = lattice_interaction_TwinBySlip(N_tw,N_sl,& - config%getFloats('interaction_twinslip'), & - config%getString('lattice_structure')) + pl%get_asFloats('h_tw_sl'), & + phase%get_asString('lattice')) else slipAndTwinActive allocate(prm%interaction_SlipTwin(prm%sum_N_sl,prm%sum_N_tw)) ! at least one dimension is 0 allocate(prm%interaction_TwinSlip(prm%sum_N_tw,prm%sum_N_sl)) ! at least one dimension is 0 @@ -203,7 +217,12 @@ module subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! output pararameters - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(pl) +#else + prm%output = pl%get_asStrings('output',defaultVal=emptyStringArray) +#endif !-------------------------------------------------------------------------------------------------- ! allocate state arrays @@ -212,7 +231,8 @@ module subroutine plastic_phenopowerlaw_init + size(['xi_tw ','gamma_tw']) * prm%sum_N_tw sizeState = sizeDotState - call material_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) + + call constitutive_allocateState(plasticState(p),NipcMyPhase,sizeState,sizeDotState,0) !-------------------------------------------------------------------------------------------------- ! state aliases and initialization @@ -221,7 +241,7 @@ module subroutine plastic_phenopowerlaw_init stt%xi_slip => plasticState(p)%state (startIndex:endIndex,:) stt%xi_slip = spread(xi_slip_0, 2, NipcMyPhase) dot%xi_slip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_xi',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 @@ -229,14 +249,14 @@ module subroutine plastic_phenopowerlaw_init stt%xi_twin => plasticState(p)%state (startIndex:endIndex,:) stt%xi_twin = spread(xi_twin_0, 2, NipcMyPhase) dot%xi_twin => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_xi',defaultVal=1.0_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi' startIndex = endIndex + 1 endIndex = endIndex + prm%sum_N_sl stt%gamma_slip => plasticState(p)%state (startIndex:endIndex,:) dot%gamma_slip => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_gamma',defaultVal=1.0e-6_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) @@ -245,7 +265,7 @@ module subroutine plastic_phenopowerlaw_init endIndex = endIndex + prm%sum_N_tw stt%gamma_twin => plasticState(p)%state (startIndex:endIndex,:) dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%atol(startIndex:endIndex) = config%getFloat('atol_gamma',defaultVal=1.0e-6_pReal) + plasticState(p)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal) if(any(plasticState(p)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma' plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally @@ -254,11 +274,11 @@ module subroutine plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(phenopowerlaw)') enddo -end subroutine plastic_phenopowerlaw_init +end function plastic_phenopowerlaw_init !-------------------------------------------------------------------------------------------------- @@ -384,18 +404,18 @@ module subroutine plastic_phenopowerlaw_results(instance,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('resistance_slip') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%xi_slip, 'xi_sl', & + case('xi_sl') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%xi_slip, trim(prm%output(o)), & 'resistance against plastic slip','Pa') - case('accumulatedshear_slip') - if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_slip,'gamma_sl', & + case('gamma_sl') + if(prm%sum_N_sl>0) call results_writeDataset(group,stt%gamma_slip,trim(prm%output(o)), & 'plastic shear','1') - case('resistance_twin') - if(prm%sum_N_tw>0) call results_writeDataset(group,stt%xi_twin, 'xi_tw', & + case('xi_tw') + if(prm%sum_N_tw>0) call results_writeDataset(group,stt%xi_twin, trim(prm%output(o)), & 'resistance against twinning','Pa') - case('accumulatedshear_twin') - if(prm%sum_N_tw>0) call results_writeDataset(group,stt%gamma_twin,'gamma_tw', & + case('gamma_tw') + if(prm%sum_N_tw>0) call results_writeDataset(group,stt%gamma_twin,trim(prm%output(o)), & 'twinning shear','1') end select diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 96d4c03ee..3aefb99a7 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -5,14 +5,20 @@ submodule(constitutive) constitutive_thermal interface - module subroutine source_thermal_dissipation_init - end subroutine source_thermal_dissipation_init + module function source_thermal_dissipation_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_thermal_dissipation_init + + module function source_thermal_externalheat_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + end function source_thermal_externalheat_init - module subroutine source_thermal_externalheat_init - end subroutine source_thermal_externalheat_init - - module subroutine kinematics_thermal_expansion_init - end subroutine kinematics_thermal_expansion_init + module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics) + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + end function kinematics_thermal_expansion_init module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) @@ -46,12 +52,15 @@ contains module subroutine thermal_init ! initialize source mechanisms - if (any(phase_source == SOURCE_thermal_dissipation_ID)) call source_thermal_dissipation_init - if (any(phase_source == SOURCE_thermal_externalheat_ID)) call source_thermal_externalheat_init - + if(maxval(phase_Nsources) /= 0) then + where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID + where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID + endif + !-------------------------------------------------------------------------------------------------- !initialize kinematic mechanisms - if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init + if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & + phase_kinematics = KINEMATICS_thermal_expansion_ID end subroutine thermal_init diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ee825d4ea..9d2d534d7 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -14,7 +14,6 @@ module crystallite use HDF5_utilities use DAMASK_interface use config - use debug use rotations use math use FEsolving @@ -143,7 +142,10 @@ subroutine crystallite_init class(tNode), pointer :: & num_crystallite, & - debug_crystallite ! pointer to debug options for crystallite + debug_crystallite, & ! pointer to debug options for crystallite + phases, & + phase, & + generic_param write(6,'(/,a)') ' <<<+- crystallite init -+>>>' @@ -233,19 +235,19 @@ subroutine crystallite_init call IO_error(301,ext_msg='integrator') end select - allocate(output_constituent(size(config_phase))) - do c = 1, size(config_phase) + phases => material_root%get('phase') + + allocate(output_constituent(phases%length)) + do c = 1, phases%length + phase => phases%get(c) + generic_param => phase%get('generic',defaultVal = emptyDict) #if defined(__GFORTRAN__) - allocate(output_constituent(c)%label(1)) - output_constituent(c)%label(1)= 'GfortranBug86277' - output_constituent(c)%label = config_phase(c)%getStrings('(output)',defaultVal=output_constituent(c)%label ) - if (output_constituent(c)%label (1) == 'GfortranBug86277') output_constituent(c)%label = [character(len=pStringLen)::] + output_constituent(c)%label = output_asStrings(generic_param) #else - output_constituent(c)%label = config_phase(c)%getStrings('(output)',defaultVal=[character(len=pStringLen)::]) + output_constituent(c)%label = generic_param%get_asStrings('output',defaultVal=emptyStringArray) #endif enddo - call config_deallocate('material.config/phase') !-------------------------------------------------------------------------------------------------- ! initialize @@ -681,46 +683,46 @@ subroutine crystallite_results type(rotation), allocatable, dimension(:) :: selected_rotations character(len=pStringLen) :: group,structureLabel - do p=1,size(config_name_phase) - group = trim('current/constituent')//'/'//trim(config_name_phase(p))//'/generic' + do p=1,size(material_name_phase) + group = trim('current/constituent')//'/'//trim(material_name_phase(p))//'/generic' call results_closeGroup(results_addGroup(group)) do o = 1, size(output_constituent(p)%label) select case (output_constituent(p)%label(o)) - case('f') + case('F') selected_tensors = select_tensors(crystallite_partionedF,p) - call results_writeDataset(group,selected_tensors,'F',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'deformation gradient','1') - case('fe') + case('Fe') selected_tensors = select_tensors(crystallite_Fe,p) - call results_writeDataset(group,selected_tensors,'Fe',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'elastic deformation gradient','1') - case('fp') + case('Fp') selected_tensors = select_tensors(crystallite_Fp,p) - call results_writeDataset(group,selected_tensors,'Fp',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'plastic deformation gradient','1') - case('fi') + case('Fi') selected_tensors = select_tensors(crystallite_Fi,p) - call results_writeDataset(group,selected_tensors,'Fi',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'inelastic deformation gradient','1') - case('lp') + case('Lp') selected_tensors = select_tensors(crystallite_Lp,p) - call results_writeDataset(group,selected_tensors,'Lp',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'plastic velocity gradient','1/s') - case('li') + case('Li') selected_tensors = select_tensors(crystallite_Li,p) - call results_writeDataset(group,selected_tensors,'Li',& + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'inelastic velocity gradient','1/s') - case('p') + case('P') selected_tensors = select_tensors(crystallite_P,p) - call results_writeDataset(group,selected_tensors,'P',& - 'First Piola-Kirchhoff stress','Pa') - case('s') + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'First Piola-Kirchoff stress','Pa') + case('S') selected_tensors = select_tensors(crystallite_S,p) - call results_writeDataset(group,selected_tensors,'S',& - 'Second Piola-Kirchhoff stress','Pa') - case('orientation') + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'Second Piola-Kirchoff stress','Pa') + case('O') select case(lattice_structure(p)) case(lattice_ISO_ID) structureLabel = 'iso' @@ -736,7 +738,7 @@ subroutine crystallite_results structureLabel = 'ort' end select selected_rotations = select_rotations(crystallite_orientation,p) - call results_writeDataset(group,selected_rotations,'orientation',& + call results_writeDataset(group,selected_rotations,output_constituent(p)%label(o),& 'crystal orientation as quaternion',structureLabel) end select enddo @@ -1575,7 +1577,7 @@ subroutine crystallite_restartWrite call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'constituent') - do i = 1,size(phase_plasticity) + do i = 1,size(material_name_phase) write(datasetName,'(i0,a)') i,'_omega_plastic' call HDF5_write(groupHandle,plasticState(i)%state,datasetName) enddo @@ -1616,7 +1618,7 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'constituent') - do i = 1,size(phase_plasticity) + do i = 1,size(material_name_phase) write(datasetName,'(i0,a)') i,'_omega_plastic' call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) enddo diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 66b50064b..296617039 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -7,7 +7,6 @@ module damage_local use IO use material use config - use numerics use YAML_types use constitutive use results @@ -44,9 +43,13 @@ contains subroutine damage_local_init integer :: Ninstance,NofMyHomog,h - class(tNode), pointer :: num_generic + class(tNode), pointer :: & + num_generic, & + material_homogenization, & + homog, & + homogDamage - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- damage_local init -+>>>'; flush(6) !---------------------------------------------------------------------------------------------- ! read numerics parameter and do sanity check @@ -57,11 +60,18 @@ subroutine damage_local_init Ninstance = count(damage_type == DAMAGE_local_ID) allocate(param(Ninstance)) - do h = 1, size(config_homogenization) + material_homogenization => material_root%get('homogenization') + do h = 1, material_homogenization%length if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle - associate(prm => param(damage_typeInstance(h)),config => config_homogenization(h)) + homog => material_homogenization%get(h) + homogDamage => homog%get('damage') + associate(prm => param(damage_typeInstance(h))) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(homogDamage) +#else + prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray) +#endif NofMyHomog = count(material_homogenizationAt == h) damageState(h)%sizeState = 1 @@ -152,8 +162,8 @@ subroutine damage_local_results(homog,group) associate(prm => param(damage_typeInstance(homog))) outputsLoop: do o = 1,size(prm%output) select case(prm%output(o)) - case ('damage') - call results_writeDataset(group,damage(homog)%p,'phi',& + case ('phi') + call results_writeDataset(group,damage(homog)%p,prm%output(o),& 'damage indicator','-') end select enddo outputsLoop diff --git a/src/damage_none.f90 b/src/damage_none.f90 index b8a9bd7b5..00e3e132d 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -18,9 +18,9 @@ subroutine damage_none_init integer :: h,NofMyHomog - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_NONE_LABEL//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- damage_none init -+>>>'; flush(6) - do h = 1, size(config_homogenization) + do h = 1, material_Nhomogenization if (damage_type(h) /= DAMAGE_NONE_ID) cycle NofMyHomog = count(material_homogenizationAt == h) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 914133de7..93f8ab721 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -6,7 +6,6 @@ module damage_nonlocal use prec use material use config - use numerics use YAML_types use crystallite use lattice @@ -49,9 +48,12 @@ subroutine damage_nonlocal_init integer :: Ninstance,NofMyHomog,h class(tNode), pointer :: & - num_generic + num_generic, & + material_homogenization, & + homog, & + homogDamage - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- damage_nonlocal init -+>>>'; flush(6) !------------------------------------------------------------------------------------ ! read numerics parameter @@ -61,11 +63,18 @@ subroutine damage_nonlocal_init Ninstance = count(damage_type == DAMAGE_nonlocal_ID) allocate(param(Ninstance)) - do h = 1, size(config_homogenization) + material_homogenization => material_root%get('homogenization') + do h = 1, material_homogenization%length if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle - associate(prm => param(damage_typeInstance(h)),config => config_homogenization(h)) + homog => material_homogenization%get(h) + homogDamage => homog%get('damage') + associate(prm => param(damage_typeInstance(h))) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(homogDamage) +#else + prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray) +#endif NofMyHomog = count(material_homogenizationAt == h) damageState(h)%sizeState = 1 @@ -191,8 +200,8 @@ subroutine damage_nonlocal_results(homog,group) associate(prm => param(damage_typeInstance(homog))) outputsLoop: do o = 1,size(prm%output) select case(prm%output(o)) - case ('damage') - call results_writeDataset(group,damage(homog)%p,'phi',& + case ('phi') + call results_writeDataset(group,damage(homog)%p,prm%output(o),& 'damage indicator','-') end select enddo outputsLoop diff --git a/src/debug.f90 b/src/debug.f90 deleted file mode 100644 index c26277f12..000000000 --- a/src/debug.f90 +++ /dev/null @@ -1,50 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Reading in and interpretating the debugging settings for the various modules -!-------------------------------------------------------------------------------------------------- -module debug - use prec - use IO - use YAML_types - use YAML_parse - - implicit none - private - - class(tNode), pointer, protected, public :: & - debug_root !< root pointer storing the debug YAML structure - - public :: debug_init - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief reads in parameters from debug.config and allocates arrays -!-------------------------------------------------------------------------------------------------- -subroutine debug_init - - character(len=:), allocatable :: & - debug_input, & - debug_inFlow - logical :: fexist - - write(6,'(/,a)') ' <<<+- debug init -+>>>' -#ifdef DEBUG - write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' -#endif - - debug_root => emptyDict - inquire(file='debug.yaml', exist=fexist) - fileExists: if (fexist) then - debug_input = IO_read('debug.yaml') - debug_inFlow = to_flow(debug_input) - debug_root => parse_flow(debug_inFlow) - endif fileExists - -end subroutine debug_init - -end module debug diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 7c0f87078..0e30025d8 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -13,7 +13,6 @@ program DAMASK_grid use DAMASK_interface use IO use config - use debug use math use CPFEM2 use material diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index ce1c07fc2..6d128eb0b 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -12,8 +12,7 @@ module discretization_grid use system_routines use DAMASK_interface use IO - use debug - use numerics + use config use results use discretization use geometry_plastic_nonlocal diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 65ca9b1dd..e7bbbff7f 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -15,7 +15,7 @@ module grid_damage_spectral use spectral_utilities use discretization_grid use damage_nonlocal - use numerics + use config use YAML_types implicit none diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 43dbca00e..e8e1345ef 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -16,11 +16,10 @@ module grid_mech_FEM use math use spectral_utilities use FEsolving - use numerics + use config use homogenization use discretization use discretization_grid - use debug implicit none private diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ccbeb3c42..66694e516 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -17,10 +17,8 @@ module grid_mech_spectral_basic use spectral_utilities use FEsolving use config - use numerics use homogenization use discretization_grid - use debug implicit none private diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 347a2a832..f6d1b9ebb 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -18,10 +18,8 @@ module grid_mech_spectral_polarisation use spectral_utilities use FEsolving use config - use numerics use homogenization use discretization_grid - use debug implicit none private diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 0b66ef3f0..58c89fdc4 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -16,7 +16,7 @@ module grid_thermal_spectral use discretization_grid use thermal_conduction use YAML_types - use numerics + use config use material implicit none diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 7f2066e4b..f1daf8f08 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -14,8 +14,6 @@ module spectral_utilities use rotations use IO use discretization_grid - use numerics - use debug use config use discretization use homogenization diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d54e1f390..b2d75d9ee 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -8,10 +8,8 @@ module homogenization use prec use IO use config - use debug use math use material - use numerics use constitutive use crystallite use FEsolving @@ -180,7 +178,6 @@ subroutine homogenization_init if (any(damage_type == DAMAGE_local_ID)) call damage_local_init if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init - call config_deallocate('material.config/homogenization') !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables @@ -607,8 +604,8 @@ subroutine homogenization_results !real(pReal), dimension(:,:,:), allocatable :: temp - do p=1,size(config_name_homogenization) - group_base = 'current/materialpoint/'//trim(config_name_homogenization(p)) + do p=1,size(material_name_homogenization) + group_base = 'current/materialpoint/'//trim(material_name_homogenization(p)) call results_closeGroup(results_addGroup(group_base)) group = trim(group_base)//'/generic' diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 3993cd609..1d1348d69 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -87,9 +87,12 @@ module subroutine mech_RGC_init(num_homogMech) sizeState, nIntFaceTot class (tNode), pointer :: & - num_RGC ! pointer to RGC numerics data + num_RGC, & ! pointer to RGC numerics data + material_homogenization, & + homog, & + homogMech - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- homogenization_mech_rgc init -+>>>' write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009' write(6,'(a)') ' https://doi.org/10.1007/s12289-009-0619-1' @@ -135,13 +138,16 @@ module subroutine mech_RGC_init(num_homogMech) if (num%volDiscrMod < 0.0_pReal) call IO_error(301,ext_msg='volDiscrMod_RGC') if (num%volDiscrPow <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC') + + material_homogenization => material_root%get('homogenization') do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle + homog => material_homogenization%get(h) + homogMech => homog%get('mech') associate(prm => param(homogenization_typeInstance(h)), & stt => state(homogenization_typeInstance(h)), & st0 => state0(homogenization_typeInstance(h)), & - dst => dependentState(homogenization_typeInstance(h)), & - config => config_homogenization(h)) + dst => dependentState(homogenization_typeInstance(h))) #ifdef DEBUG if (h==material_homogenizationAt(debugHomog%element)) then @@ -149,17 +155,21 @@ module subroutine mech_RGC_init(num_homogMech) endif #endif - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(homogMech) +#else + prm%output = homogMech%get_asStrings('output',defaultVal=emptyStringArray) +#endif - prm%Nconstituents = config%getInts('clustersize',requiredSize=3) + prm%Nconstituents = homogMech%get_asInts('cluster_size',requiredSize=3) if (homogenization_Ngrains(h) /= product(prm%Nconstituents)) & - call IO_error(211,ext_msg='clustersize ('//HOMOGENIZATION_RGC_label//')') + call IO_error(211,ext_msg='clustersize (mech_rgc)') - prm%xiAlpha = config%getFloat('scalingparameter') - prm%ciAlpha = config%getFloat('overproportionality') + prm%xiAlpha = homogMech%get_asFloat('xi_alpha') + prm%ciAlpha = homogMech%get_asFloat('c_alpha') - prm%dAlpha = config%getFloats('grainsize', requiredSize=3) - prm%angles = config%getFloats('clusterorientation',requiredSize=3) + prm%dAlpha = homogMech%get_asFloats('D_alpha', requiredSize=3) + prm%angles = homogMech%get_asFloats('a_g', requiredSize=3) NofMyHomog = count(material_homogenizationAt == h) nIntFaceTot = 3*( (prm%Nconstituents(1)-1)*prm%Nconstituents(2)*prm%Nconstituents(3) & @@ -946,23 +956,23 @@ module subroutine mech_RGC_results(instance,group) associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('constitutivework') - call results_writeDataset(group,stt%work,'W',& + case('W') + call results_writeDataset(group,stt%work,trim(prm%output(o)), & 'work density','J/m³') - case('magnitudemismatch') - call results_writeDataset(group,dst%mismatch,'N',& + case('M') + call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), & 'average mismatch tensor','1') - case('penaltyenergy') - call results_writeDataset(group,stt%penaltyEnergy,'R',& + case('R') + call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), & 'mismatch penalty density','J/m³') - case('volumediscrepancy') - call results_writeDataset(group,dst%volumeDiscrepancy,'Delta_V',& + case('Delta_V') + call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), & 'volume discrepancy','m³') - case('maximumrelaxrate') - call results_writeDataset(group,dst%relaxationrate_max,'max_alpha_dot',& + case('max_a_dot') + call results_writeDataset(group,dst%relaxationrate_max,trim(prm%output(o)), & 'maximum relaxation rate','m/s') - case('averagerelaxrate') - call results_writeDataset(group,dst%relaxationrate_avg,'avg_alpha_dot',& + case('avg_a_dot') + call results_writeDataset(group,dst%relaxationrate_avg,trim(prm%output(o)), & 'average relaxation rate','m/s') end select enddo outputsLoop diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index f85621804..91350e6b0 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -32,31 +32,33 @@ module subroutine mech_isostrain_init Ninstance, & h, & NofMyHomog - character(len=pStringLen) :: & - tag = '' + class(tNode), pointer :: & + material_homogenization, & + homog, & + homogMech - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- homogenization_mech_isostrain init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) allocate(param(Ninstance)) ! one container of parameters per instance - + + material_homogenization => material_root%get('homogenization') do h = 1, size(homogenization_type) if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle - - associate(prm => param(homogenization_typeInstance(h)),& - config => config_homogenization(h)) + homog => material_homogenization%get(h) + homogMech => homog%get('mech') + associate(prm => param(homogenization_typeInstance(h))) - prm%Nconstituents = config_homogenization(h)%getInt('nconstituents') - tag = 'sum' - select case(trim(config%getString('mapping',defaultVal = tag))) + prm%Nconstituents = homogMech%get_asInt('N_constituents') + select case(homogMech%get_asString('mapping',defaultVal = 'sum')) case ('sum') prm%mapping = parallel_ID case ('avg') prm%mapping = average_ID case default - call IO_error(211,ext_msg=trim(tag)//' ('//HOMOGENIZATION_ISOSTRAIN_LABEL//')') + call IO_error(211,ext_msg='sum'//' (mech_isostrain)') end select NofMyHomog = count(material_homogenizationAt == h) diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 0633f9b8c..b3886bfba 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -18,7 +18,7 @@ module subroutine mech_none_init h, & NofMyHomog - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- homogenization_mech_none init -+>>>' Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 2e314024c..c682fd401 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -10,10 +10,10 @@ submodule(constitutive:constitutive_damage) kinematics_cleavage_opening type :: tParameters !< container type for internal constitutive parameters integer :: & - sum_N_cl + sum_N_cl !< total number of cleavage planes real(pReal) :: & - sdot0, & - n + sdot0, & !< opening rate of cleavage planes + n !< damage rate sensitivity real(pReal), dimension(:), allocatable :: & critLoad real(pReal), dimension(:,:,:,:), allocatable :: & @@ -30,54 +30,73 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_cleavage_opening_init +module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) + + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics - integer :: Ninstance,p + integer :: Ninstance,p,k integer, dimension(:), allocatable :: N_cl !< active number of cleavage systems per family character(len=pStringLen) :: extmsg = '' + class(tNode), pointer :: & + phases, & + phase, & + pl, & + kinematics, & + kinematic_type + + write(6,'(/,a)') ' <<<+- kinematics_cleavage_opening init -+>>>' - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_CLEAVAGE_OPENING_LABEL//' init -+>>>' - - Ninstance = count(phase_kinematics == KINEMATICS_CLEAVAGE_OPENING_ID) + myKinematics = kinematics_active('cleavage_opening',kinematics_length) + + Ninstance = count(myKinematics) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(kinematics_cleavage_opening_instance(phases%length), source=0) - do p = 1, size(config_phase) - kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == KINEMATICS_CLEAVAGE_OPENING_ID) - if (all(phase_kinematics(:,p) /= KINEMATICS_CLEAVAGE_OPENING_ID)) cycle + do p = 1, phases%length + if(any(myKinematics(:,p))) kinematics_cleavage_opening_instance(p) = count(myKinematics(:,1:p)) + phase => phases%get(p) + pl => phase%get('plasticity') + if(count(myKinematics(:,p)) == 0) cycle + kinematics => phase%get('kinematics') + do k = 1, kinematics%length + if(myKinematics(k,p)) then + associate(prm => param(kinematics_cleavage_opening_instance(p))) + kinematic_type => kinematics%get(k) - associate(prm => param(kinematics_cleavage_opening_instance(p)), & - config => config_phase(p)) + N_cl = kinematic_type%get_asInts('N_cl') + prm%sum_N_cl = sum(abs(N_cl)) - N_cl = config%getInts('ncleavage') - prm%sum_N_cl = sum(abs(N_cl)) + prm%n = kinematic_type%get_asFloat('q') + prm%sdot0 = kinematic_type%get_asFloat('dot_o') - prm%n = config%getFloat('anisobrittle_ratesensitivity') - prm%sdot0 = config%getFloat('anisobrittle_sdot0') + prm%critLoad = kinematic_type%get_asFloats('g_crit',requiredSize=size(N_cl)) - prm%critLoad = config%getFloats('anisobrittle_criticalload',requiredSize=size(N_cl)) + prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) - prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) + ! expand: family => system + prm%critLoad = math_expand(prm%critLoad,N_cl) - ! expand: family => system - prm%critLoad = math_expand(prm%critLoad,N_cl) - - ! sanity checks - if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_n' - if (prm%sdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' - if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_critLoad' + ! sanity checks + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%sdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_o' + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//KINEMATICS_CLEAVAGE_OPENING_LABEL//')') - - end associate + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(cleavage_opening)') + end associate + endif + enddo enddo -end subroutine kinematics_cleavage_opening_init + +end function kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index b15d206d3..406e8dce5 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -10,10 +10,10 @@ submodule(constitutive:constitutive_damage) kinematics_slipplane_opening type :: tParameters !< container type for internal constitutive parameters integer :: & - sum_N_sl + sum_N_sl !< total number of cleavage planes real(pReal) :: & - sdot0, & - n + sdot0, & !< opening rate of cleavage planes + n !< damage rate sensitivity real(pReal), dimension(:), allocatable :: & critLoad real(pReal), dimension(:,:,:), allocatable :: & @@ -32,64 +32,85 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_slipplane_opening_init +module function kinematics_slipplane_opening_init(kinematics_length) result(myKinematics) - integer :: Ninstance,p,i + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + + integer :: Ninstance,p,i,k character(len=pStringLen) :: extmsg = '' integer, dimension(:), allocatable :: N_sl real(pReal), dimension(:,:), allocatable :: d,n,t + class(tNode), pointer :: & + phases, & + phase, & + pl, & + kinematics, & + kinematic_type + + write(6,'(/,a)') ' <<<+- kinematics_slipplane init -+>>>' - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_SLIPPLANE_OPENING_LABEL//' init -+>>>' - - Ninstance = count(phase_kinematics == KINEMATICS_SLIPPLANE_OPENING_ID) + myKinematics = kinematics_active('slipplane_opening',kinematics_length) + + Ninstance = count(myKinematics) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0) + phases => material_root%get('phase') + allocate(kinematics_slipplane_opening_instance(phases%length), source=0) allocate(param(Ninstance)) - do p = 1, size(config_phase) - kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == KINEMATICS_SLIPPLANE_OPENING_ID) - if (all(phase_kinematics(:,p) /= KINEMATICS_SLIPPLANE_OPENING_ID)) cycle - associate(prm => param(kinematics_slipplane_opening_instance(p)), & - config => config_phase(p)) + do p = 1, phases%length + if(any(myKinematics(:,p))) kinematics_slipplane_opening_instance(p) = count(myKinematics(:,1:p)) + phase => phases%get(p) + pl => phase%get('plasticity') + if(count(myKinematics(:,p)) == 0) cycle + kinematics => phase%get('kinematics') + do k = 1, kinematics%length + if(myKinematics(k,p)) then + associate(prm => param(kinematics_slipplane_opening_instance(p))) + kinematic_type => kinematics%get(k) - prm%sdot0 = config%getFloat('anisoductile_sdot0') - prm%n = config%getFloat('anisoductile_ratesensitivity') - N_sl = config%getInts('nslip') - prm%sum_N_sl = sum(abs(N_sl)) + prm%sdot0 = kinematic_type%get_asFloat('dot_o') + prm%n = kinematic_type%get_asFloat('q') + N_sl = pl%get_asInts('N_sl') + prm%sum_N_sl = sum(abs(N_sl)) - d = lattice_slip_direction (N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - t = lattice_slip_transverse(N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - n = lattice_slip_normal (N_sl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - allocate(prm%P_d(3,3,size(d,2)),prm%P_t(3,3,size(t,2)),prm%P_n(3,3,size(n,2))) + d = lattice_slip_direction (N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + t = lattice_slip_transverse(N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + n = lattice_slip_normal (N_sl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + allocate(prm%P_d(3,3,size(d,2)),prm%P_t(3,3,size(t,2)),prm%P_n(3,3,size(n,2))) - do i=1, size(n,2) - prm%P_d(1:3,1:3,i) = math_outer(d(1:3,i), n(1:3,i)) - prm%P_t(1:3,1:3,i) = math_outer(t(1:3,i), n(1:3,i)) - prm%P_n(1:3,1:3,i) = math_outer(n(1:3,i), n(1:3,i)) - enddo + do i=1, size(n,2) + prm%P_d(1:3,1:3,i) = math_outer(d(1:3,i), n(1:3,i)) + prm%P_t(1:3,1:3,i) = math_outer(t(1:3,i), n(1:3,i)) + prm%P_n(1:3,1:3,i) = math_outer(n(1:3,i), n(1:3,i)) + enddo - prm%critLoad = config%getFloats('anisoductile_criticalload',requiredSize=size(N_sl)) + prm%critLoad = kinematic_type%get_asFloats('g_crit',requiredSize=size(N_sl)) - ! expand: family => system - prm%critLoad = math_expand(prm%critLoad,N_sl) + ! expand: family => system + prm%critLoad = math_expand(prm%critLoad,N_sl) - ! sanity checks - if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' anisoDuctile_n' - if (prm%sdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoDuctile_sdot0' - if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisoDuctile_critLoad' + ! sanity checks + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' anisoDuctile_n' + if (prm%sdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisoDuctile_sdot0' + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisoDuctile_critLoad' !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//KINEMATICS_SLIPPLANE_OPENING_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(slipplane_opening)') - end associate + end associate + endif + enddo enddo -end subroutine kinematics_slipplane_opening_init + +end function kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 8fc2dc704..3c345f148 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,43 +24,64 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_thermal_expansion_init +module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics) - integer :: Ninstance,p,i + integer, intent(in) :: kinematics_length + logical, dimension(:,:), allocatable :: myKinematics + + integer :: Ninstance,p,i,k real(pReal), dimension(:), allocatable :: temp + class(tNode), pointer :: & + phases, & + phase, & + pl, & + kinematics, & + kinematic_type + + write(6,'(/,a)') ' <<<+- kinematics_thermal_expansion init -+>>>' - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - - Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID) + myKinematics = kinematics_active('thermal_expansion',kinematics_length) + + Ninstance = count(myKinematics) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(kinematics_thermal_expansion_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(kinematics_thermal_expansion_instance(phases%length), source=0) - do p = 1, size(config_phase) - kinematics_thermal_expansion_instance(p) = count(phase_kinematics(:,1:p) == KINEMATICS_thermal_expansion_ID) - if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle + do p = 1, phases%length + if(any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p)) + phase => phases%get(p) + pl => phase%get('plasticity') + if(count(myKinematics(:,p)) == 0) cycle + kinematics => phase%get('kinematics') + do k = 1, kinematics%length + if(myKinematics(k,p)) then + associate(prm => param(kinematics_thermal_expansion_instance(p))) + kinematic_type => kinematics%get(k) - associate(prm => param(kinematics_thermal_expansion_instance(p)), & - config => config_phase(p)) + prm%T_ref = kinematic_type%get_asFloat('T_ref', defaultVal=0.0_pReal) - prm%T_ref = config%getFloat('reference_temperature', defaultVal=0.0_pReal) + ! read up to three parameters (constant, linear, quadratic with T) + temp = kinematic_type%get_asFloats('A_11') + prm%expansion(1,1,1:size(temp)) = temp + temp = kinematic_type%get_asFloats('A_22',defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) + prm%expansion(2,2,1:size(temp)) = temp + temp = kinematic_type%get_asFloats('A_33',defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) + prm%expansion(3,3,1:size(temp)) = temp + do i=1, size(prm%expansion,3) + prm%expansion(1:3,1:3,i) = lattice_applyLatticeSymmetry33(prm%expansion(1:3,1:3,i),& + phase%get_asString('lattice')) + enddo - ! read up to three parameters (constant, linear, quadratic with T) - temp = config%getFloats('thermal_expansion11') - prm%expansion(1,1,1:size(temp)) = temp - temp = config%getFloats('thermal_expansion22',defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) - prm%expansion(2,2,1:size(temp)) = temp - temp = config%getFloats('thermal_expansion33',defaultVal=[(0.0_pReal, i=1,size(temp))],requiredSize=size(temp)) - prm%expansion(3,3,1:size(temp)) = temp - do i=1, size(prm%expansion,3) - prm%expansion(1:3,1:3,i) = lattice_applyLatticeSymmetry33(prm%expansion(1:3,1:3,i),config%getString('lattice_structure')) + end associate + endif enddo - - end associate enddo -end subroutine kinematics_thermal_expansion_init + +end function kinematics_thermal_expansion_init !-------------------------------------------------------------------------------------------------- diff --git a/src/lattice.f90 b/src/lattice.f90 index 7a732d2fd..503293237 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -452,11 +452,15 @@ contains subroutine lattice_init integer :: Nphases, p,i - character(len=pStringLen) :: structure = '' - + class(tNode), pointer :: & + phases, & + phase, & + elasticity + write(6,'(/,a)') ' <<<+- lattice init -+>>>'; flush(6) - Nphases = size(config_phase) + phases => material_root%get('phase') + Nphases = phases%length allocate(lattice_structure(Nphases),source = lattice_UNDEFINED_ID) allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) @@ -469,21 +473,21 @@ subroutine lattice_init lattice_mu, lattice_nu,& source=[(0.0_pReal,i=1,Nphases)]) - do p = 1, size(config_phase) + do p = 1, phases%length + phase => phases%get(p) + elasticity => phase%get('elasticity') + lattice_C66(1,1,p) = elasticity%get_asFloat('C_11') + lattice_C66(1,2,p) = elasticity%get_asFloat('C_12') - lattice_C66(1,1,p) = config_phase(p)%getFloat('c11') - lattice_C66(1,2,p) = config_phase(p)%getFloat('c12') + lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) + lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) + lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) + lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) + lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) + lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) + lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) - lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) - lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) - lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) - lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) - lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) - lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) - lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - - structure = config_phase(p)%getString('lattice_structure') - select case(trim(structure)) + select case(phase%get_asString('lattice')) case('iso') lattice_structure(p) = lattice_ISO_ID case('fcc') @@ -497,10 +501,10 @@ subroutine lattice_init case('ort') lattice_structure(p) = lattice_ORT_ID case default - call IO_error(130,ext_msg='lattice_init: '//trim(structure)) + call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice')) end select - lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),structure) + lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') @@ -513,20 +517,22 @@ subroutine lattice_init ! SHOULD NOT BE PART OF LATTICE BEGIN - lattice_thermalConductivity(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) - lattice_thermalConductivity(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) - lattice_thermalConductivity(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) - lattice_thermalConductivity(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_thermalConductivity(1:3,1:3,p),structure) + lattice_thermalConductivity(1,1,p) = phase%get_asFloat('K_11',defaultVal=0.0_pReal) + lattice_thermalConductivity(2,2,p) = phase%get_asFloat('K_22',defaultVal=0.0_pReal) + lattice_thermalConductivity(3,3,p) = phase%get_asFloat('K_33',defaultVal=0.0_pReal) + lattice_thermalConductivity(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_thermalConductivity(1:3,1:3,p), & + phase%get_asString('lattice')) - lattice_specificHeat(p) = config_phase(p)%getFloat('specific_heat',defaultVal=0.0_pReal) - lattice_massDensity(p) = config_phase(p)%getFloat('mass_density', defaultVal=0.0_pReal) + lattice_specificHeat(p) = phase%get_asFloat('c_p',defaultVal=0.0_pReal) + lattice_massDensity(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal) - lattice_DamageDiffusion(1,1,p) = config_phase(p)%getFloat('damage_diffusion11',defaultVal=0.0_pReal) - lattice_DamageDiffusion(2,2,p) = config_phase(p)%getFloat('damage_diffusion22',defaultVal=0.0_pReal) - lattice_DamageDiffusion(3,3,p) = config_phase(p)%getFloat('damage_diffusion33',defaultVal=0.0_pReal) - lattice_DamageDiffusion(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_DamageDiffusion(1:3,1:3,p),structure) + lattice_DamageDiffusion(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) + lattice_DamageDiffusion(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) + lattice_DamageDiffusion(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) + lattice_DamageDiffusion(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_DamageDiffusion(1:3,1:3,p), & + phase%get_asString('lattice')) - lattice_DamageMobility(p) = config_phase(p)%getFloat('damage_mobility',defaultVal=0.0_pReal) + lattice_DamageMobility(p) = phase%get_asFloat('M',defaultVal=0.0_pReal) ! SHOULD NOT BE PART OF LATTICE END call selfTest diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index d53dccf75..e5c382fe1 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -11,8 +11,7 @@ module discretization_marc use math use DAMASK_interface use IO - use debug - use numerics + use config use FEsolving use element use discretization diff --git a/src/material.f90 b/src/material.f90 index ca2b0d49a..c89113311 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -10,52 +10,22 @@ module material use config use results use IO - use debug use rotations use discretization implicit none private - character(len=*), parameter, public :: & - ELASTICITY_hooke_label = 'hooke', & - PLASTICITY_none_label = 'none', & - PLASTICITY_isotropic_label = 'isotropic', & - PLASTICITY_phenopowerlaw_label = 'phenopowerlaw', & - PLASTICITY_kinehardening_label = 'kinehardening', & - PLASTICITY_dislotwin_label = 'dislotwin', & - PLASTICITY_disloucla_label = 'disloucla', & - PLASTICITY_nonlocal_label = 'nonlocal', & - SOURCE_thermal_dissipation_label = 'thermal_dissipation', & - SOURCE_thermal_externalheat_label = 'thermal_externalheat', & - SOURCE_damage_isoBrittle_label = 'damage_isobrittle', & - SOURCE_damage_isoDuctile_label = 'damage_isoductile', & - SOURCE_damage_anisoBrittle_label = 'damage_anisobrittle', & - SOURCE_damage_anisoDuctile_label = 'damage_anisoductile', & - KINEMATICS_thermal_expansion_label = 'thermal_expansion', & - KINEMATICS_cleavage_opening_label = 'cleavage_opening', & - KINEMATICS_slipplane_opening_label = 'slipplane_opening', & - STIFFNESS_DEGRADATION_damage_label = 'damage', & - THERMAL_isothermal_label = 'isothermal', & - THERMAL_adiabatic_label = 'adiabatic', & - THERMAL_conduction_label = 'conduction', & - DAMAGE_none_label = 'none', & - DAMAGE_local_label = 'local', & - DAMAGE_nonlocal_label = 'nonlocal', & - HOMOGENIZATION_none_label = 'none', & - HOMOGENIZATION_isostrain_label = 'isostrain', & - HOMOGENIZATION_rgc_label = 'rgc' - enum, bind(c); enumerator :: & - ELASTICITY_UNDEFINED_ID ,& - ELASTICITY_HOOKE_ID ,& - PLASTICITY_UNDEFINED_ID ,& + ELASTICITY_UNDEFINED_ID, & + ELASTICITY_HOOKE_ID, & + PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & PLASTICITY_KINEHARDENING_ID, & PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOUCLA_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & PLASTICITY_NONLOCAL_ID, & SOURCE_UNDEFINED_ID ,& SOURCE_THERMAL_DISSIPATION_ID, & @@ -82,10 +52,10 @@ module material HOMOGENIZATION_RGC_ID end enum - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & - phase_elasticity !< elasticity of each phase - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & - phase_plasticity !< plasticity of each phase + character(len=pStringLen), public, protected, allocatable, dimension(:) :: & + material_name_phase, & !< name of each phase + material_name_homogenization !< name of each homogenization + integer(kind(THERMAL_isothermal_ID)), dimension(:), allocatable, public, protected :: & thermal_type !< thermal transport model integer(kind(DAMAGE_none_ID)), dimension(:), allocatable, public, protected :: & @@ -94,23 +64,12 @@ module material homogenization_type !< type of each homogenization integer, public, protected :: & - material_Nphase, & !< number of phases material_Nhomogenization !< number of homogenizations - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable, public, protected :: & - phase_source, & !< active sources mechanisms of each phase - phase_kinematics, & !< active kinematic mechanisms of each phase - phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase - integer, public, protected :: & homogenization_maxNgrains !< max number of grains in any USED homogenization integer, dimension(:), allocatable, public, protected :: & - phase_Nsources, & !< number of source mechanisms active in each phase - phase_Nkinematics, & !< number of kinematic mechanisms active in each phase - phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase - phase_elasticityInstance, & !< instance of particular elasticity of each phase - phase_plasticityInstance, & !< instance of particular plasticity of each phase homogenization_Ngrains, & !< number of grains in each homogenization homogenization_typeInstance, & !< instance of particular type of each homogenization thermal_typeInstance, & !< instance of particular type of each thermal transport @@ -129,33 +88,17 @@ module material integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,elem) material_phaseMemberAt !< position of the element within its phase instance - type(tPlasticState), allocatable, dimension(:), public :: & - plasticState - type(tSourceState), allocatable, dimension(:), public :: & - sourceState type(tState), allocatable, dimension(:), public :: & homogState, & thermalState, & damageState - integer, dimension(:,:,:), allocatable, public, protected :: & - material_texture !< texture (index) of each grain,IP,element. Only used by plastic_nonlocal - type(Rotation), dimension(:,:,:), allocatable, public, protected :: & material_orientation0 !< initial orientation of each grain,IP,element - logical, dimension(:), allocatable, public, protected :: & - phase_localPlasticity !< flags phases with local constitutive law - integer, dimension(:), allocatable, private :: & microstructure_Nconstituents !< number of constituents in each microstructure - integer, dimension(:,:), allocatable, private :: & - microstructure_phase, & !< phase IDs of each microstructure - microstructure_texture !< texture IDs of each microstructure - - type(Rotation), dimension(:), allocatable, private :: & - texture_orientation !< Euler angles in material.config (possibly rotated for alignment) ! BEGIN DEPRECATED @@ -173,24 +116,28 @@ module material public :: & material_init, & - material_allocateState, & - ELASTICITY_HOOKE_ID ,& + ELASTICITY_UNDEFINED_ID, & + ELASTICITY_HOOKE_ID, & + PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & PLASTICITY_KINEHARDENING_ID, & PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOUCLA_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & PLASTICITY_NONLOCAL_ID, & + SOURCE_UNDEFINED_ID ,& SOURCE_THERMAL_DISSIPATION_ID, & SOURCE_THERMAL_EXTERNALHEAT_ID, & SOURCE_DAMAGE_ISOBRITTLE_ID, & SOURCE_DAMAGE_ISODUCTILE_ID, & SOURCE_DAMAGE_ANISOBRITTLE_ID, & SOURCE_DAMAGE_ANISODUCTILE_ID, & + KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & KINEMATICS_THERMAL_EXPANSION_ID, & + STIFFNESS_DEGRADATION_UNDEFINED_ID, & STIFFNESS_DEGRADATION_DAMAGE_ID, & THERMAL_ISOTHERMAL_ID, & THERMAL_ADIABATIC_ID, & @@ -211,18 +158,30 @@ subroutine material_init(restart) logical, intent(in) :: restart - integer :: i,e,m,c,h, myDebug, myPhase, myHomog, myMicro - integer, dimension(:), allocatable :: & - CounterPhase, & - CounterHomogenization + integer :: ph, myHomog class(tNode), pointer :: & - debug_material ! pointer to material debug options - + debug_material, & ! pointer to material debug options + phases, & + material_homogenization + character(len=pStringLen) :: sectionName + write(6,'(/,a)') ' <<<+- material init -+>>>'; flush(6) + phases => material_root%get('phase') + allocate(material_name_phase(phases%length)) + do ph = 1, phases%length + write(sectionName,'(i0,a)') ph,'_' + material_name_phase(ph) = trim(adjustl(sectionName))//phases%getKey(ph) !ToDO: No reason to do. Update damage tests + enddo + + material_homogenization => material_root%get('homogenization') + allocate(material_name_homogenization(material_homogenization%length)) + do myHomog = 1, material_homogenization%length + write(sectionName,'(i0,a)') myHomog,'_' + material_name_homogenization(myHomog) = trim(adjustl(sectionName))//material_homogenization%getKey(myHomog) + enddo + debug_material => debug_root%get('material',defaultVal=emptyList) - call material_parsePhase() - if (debug_material%contains('basic')) write(6,'(a)') ' Phase parsed'; flush(6) call material_parseMicrostructure() if (debug_material%contains('basic')) write(6,'(a)') ' Microstructure parsed'; flush(6) @@ -230,18 +189,8 @@ subroutine material_init(restart) call material_parseHomogenization() if (debug_material%contains('basic')) write(6,'(a)') ' Homogenization parsed'; flush(6) - call material_parseTexture() - if (debug_material%contains('basic')) write(6,'(a)') ' Texture parsed'; flush(6) - material_Nphase = size(config_phase) - material_Nhomogenization = size(config_homogenization) - - - allocate(plasticState(material_Nphase)) - allocate(sourceState (material_Nphase)) - do myPhase = 1,material_Nphase - allocate(sourceState(myPhase)%p(phase_Nsources(myPhase))) - enddo + if(homogenization_maxNgrains > size(material_phaseAt,1)) call IO_error(148) allocate(homogState (material_Nhomogenization)) allocate(thermalState (material_Nhomogenization)) @@ -255,97 +204,11 @@ subroutine material_init(restart) allocate(temperatureRate (material_Nhomogenization)) - do m = 1,size(config_microstructure) - if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. & - maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & - call IO_error(150,m,ext_msg='phase') - if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1 .or. & - maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) & - call IO_error(150,m,ext_msg='texture') - if(microstructure_Nconstituents(m) < 1) & - call IO_error(151,m) - enddo - if(homogenization_maxNgrains > size(microstructure_phase,1)) call IO_error(148) - - debugOut: if (debug_material%contains('extensive')) then - write(6,'(/,a,/)') ' MATERIAL configuration' - write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1,size(config_homogenization) - write(6,'(1x,a32,1x,a16,1x,i6)') config_name_homogenization(h),homogenization_type(h),homogenization_Ngrains(h) - enddo - write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','constituents' - do m = 1,size(config_microstructure) - write(6,'(1x,a32,1x,i12)') config_name_microstructure(m), microstructure_Nconstituents(m) - if (microstructure_Nconstituents(m) > 0) then - do c = 1,microstructure_Nconstituents(m) - write(6,'(a1,1x,a32,1x,a32)') '>',config_name_phase(microstructure_phase(c,m)),& - config_name_texture(microstructure_texture(c,m)) - enddo - write(6,*) - endif - enddo - endif debugOut - - allocate(material_phaseAt(homogenization_maxNgrains,discretization_nElem), source=0) - allocate(material_texture(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) !this is only needed by plasticity nonlocal - allocate(material_orientation0(homogenization_maxNgrains,discretization_nIP,discretization_nElem)) - - do e = 1, discretization_nElem - do i = 1, discretization_nIP - myMicro = discretization_microstructureAt(e) - do c = 1, homogenization_Ngrains(discretization_homogenizationAt(e)) - if(microstructure_phase(c,myMicro) > 0) then - material_phaseAt(c,e) = microstructure_phase(c,myMicro) - else - call IO_error(150,ext_msg='phase') - endif - if(microstructure_texture(c,myMicro) > 0) then - material_texture(c,i,e) = microstructure_texture(c,myMicro) - material_orientation0(c,i,e) = texture_orientation(material_texture(c,i,e)) - else - call IO_error(150,ext_msg='texture') - endif - enddo - enddo - enddo - - deallocate(microstructure_phase) - deallocate(microstructure_texture) - deallocate(texture_orientation) - - - allocate(material_homogenizationAt,source=discretization_homogenizationAt) - allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0) - - allocate(CounterHomogenization(size(config_homogenization)),source=0) - do e = 1, discretization_nElem - do i = 1, discretization_nIP - CounterHomogenization(material_homogenizationAt(e)) = & - CounterHomogenization(material_homogenizationAt(e)) + 1 - material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e)) - enddo - enddo - - allocate(material_phaseMemberAt(homogenization_maxNgrains,discretization_nIP,discretization_nElem),source=0) - - allocate(CounterPhase(size(config_phase)),source=0) - do e = 1, discretization_nElem - do i = 1, discretization_nIP - do c = 1, homogenization_maxNgrains - CounterPhase(material_phaseAt(c,e)) = & - CounterPhase(material_phaseAt(c,e)) + 1 - material_phaseMemberAt(c,i,e) = CounterPhase(material_phaseAt(c,e)) - enddo - enddo - enddo - - call config_deallocate('material.config/microstructure') - call config_deallocate('material.config/texture') if (.not. restart) then call results_openJobFile - call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,config_name_phase) - call results_mapping_materialpoint(material_homogenizationAt,material_homogenizationMemberAt,config_name_homogenization) + call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,material_name_phase) + call results_mapping_materialpoint(material_homogenizationAt,material_homogenizationMemberAt,material_name_homogenization) call results_closeJobFile endif @@ -354,7 +217,7 @@ subroutine material_init(restart) allocate(mappingHomogenizationConst( discretization_nIP,discretization_nElem),source=1) ! hack needed to initialize field values used during constitutive initialization - do myHomog = 1,size(config_homogenization) + do myHomog = 1,material_Nhomogenization thermalMapping (myHomog)%p => mappingHomogenizationConst damageMapping (myHomog)%p => mappingHomogenizationConst allocate(temperature (myHomog)%p(1), source=thermal_initialT(myHomog)) @@ -370,82 +233,85 @@ end subroutine material_init !-------------------------------------------------------------------------------------------------- subroutine material_parseHomogenization - integer :: h - character(len=pStringLen) :: tag + class(tNode), pointer :: & + material_homogenization, & + homog, & + homogMech, & + homogThermal, & + homogDamage + integer :: h logical, dimension(:), allocatable :: homogenization_active - allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) - allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) - allocate(homogenization_typeInstance(size(config_homogenization)), source=0) - allocate(thermal_typeInstance(size(config_homogenization)), source=0) - allocate(damage_typeInstance(size(config_homogenization)), source=0) - allocate(homogenization_Ngrains(size(config_homogenization)), source=0) - allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! - allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) - allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) + material_homogenization => material_root%get('homogenization') + material_Nhomogenization = material_homogenization%length - forall (h = 1:size(config_homogenization)) & - homogenization_active(h) = any(discretization_homogenizationAt == h) + 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(homogenization_typeInstance(material_Nhomogenization), source=0) + allocate(thermal_typeInstance(material_Nhomogenization), source=0) + allocate(damage_typeInstance(material_Nhomogenization), source=0) + allocate(homogenization_Ngrains(material_Nhomogenization), source=0) + allocate(homogenization_active(material_Nhomogenization), source=.false.) !!!!!!!!!!!!!!! + allocate(thermal_initialT(material_Nhomogenization), source=300.0_pReal) + allocate(damage_initialPhi(material_Nhomogenization), source=1.0_pReal) + forall (h = 1:material_Nhomogenization) & + homogenization_active(h) = any(discretization_homogenizationAt == h) !ToDo: SR: needed?? - do h=1, size(config_homogenization) - - tag = config_homogenization(h)%getString('mech') - select case (trim(tag)) - case(HOMOGENIZATION_NONE_label) + do h=1, material_Nhomogenization + homog => material_homogenization%get(h) + homogMech => homog%get('mech') + select case (homogMech%get_asString('type')) + case('none') homogenization_type(h) = HOMOGENIZATION_NONE_ID homogenization_Ngrains(h) = 1 - case(HOMOGENIZATION_ISOSTRAIN_label) + case('isostrain') homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID - homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') - case(HOMOGENIZATION_RGC_label) + homogenization_Ngrains(h) = homogMech%get_asInt('N_constituents') + case('RGC') homogenization_type(h) = HOMOGENIZATION_RGC_ID - homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') + homogenization_Ngrains(h) = homogMech%get_asInt('N_constituents') case default - call IO_error(500,ext_msg=trim(tag)) + call IO_error(500,ext_msg=homogMech%get_asString('type')) end select homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) - if (config_homogenization(h)%keyExists('thermal')) then - thermal_initialT(h) = config_homogenization(h)%getFloat('t0',defaultVal=300.0_pReal) - - tag = config_homogenization(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,ext_msg=trim(tag)) - end select + if(homog%contains('thermal')) then + homogThermal => homog%get('thermal') + thermal_initialT(h) = homogThermal%get_asFloat('T_0',defaultVal=300.0_pReal) + select case (homogThermal%get_asString('type')) + case('isothermal') + thermal_type(h) = THERMAL_isothermal_ID + case('adiabatic') + thermal_type(h) = THERMAL_adiabatic_ID + case('conduction') + thermal_type(h) = THERMAL_conduction_ID + case default + call IO_error(500,ext_msg=homogThermal%get_asString('type')) + end select endif - if (config_homogenization(h)%keyExists('damage')) then - damage_initialPhi(h) = config_homogenization(h)%getFloat('initialdamage',defaultVal=1.0_pReal) - - tag = config_homogenization(h)%getString('damage') - 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,ext_msg=trim(tag)) - end select - + if(homog%contains('damage')) then + homogDamage => homog%get('damage') + damage_initialPhi(h) = homogDamage%get_asFloat('phi_0',defaultVal=1.0_pReal) + select case (homogDamage%get_asString('type')) + case('none') + damage_type(h) = DAMAGE_none_ID + case('local') + damage_type(h) = DAMAGE_local_ID + case('nonlocal') + damage_type(h) = DAMAGE_nonlocal_ID + case default + call IO_error(500,ext_msg=homogDamage%get_asString('type')) + end select endif - enddo - do h=1, size(config_homogenization) + do h=1, 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)) @@ -453,6 +319,7 @@ subroutine material_parseHomogenization homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) + end subroutine material_parseHomogenization @@ -461,276 +328,101 @@ end subroutine material_parseHomogenization !-------------------------------------------------------------------------------------------------- subroutine material_parseMicrostructure - character(len=pStringLen), dimension(:), allocatable :: & - strings - integer, allocatable, dimension(:) :: chunkPos - integer :: m, c, i - character(len=pStringLen) :: & - tag + class(tNode), pointer :: microstructure, & !> pointer to microstructure list + constituentsInMicrostructure, & !> pointer to a microstructure list item + constituents, & !> pointer to constituents list + constituent, & !> pointer to each constituent + phases, & + homogenization + + integer, dimension(:), allocatable :: & + CounterPhase, & + CounterHomogenization + + real(pReal), dimension(:,:), allocatable :: & - microstructure_fraction !< vol fraction of each constituent in microstructure + microstructure_fraction !< vol fraction of each constituent in microstrcuture + integer :: & - maxNconstituents !< max number of constituents in any phase + e, & + i, & + m, & + c, & + microstructure_maxNconstituents - allocate(microstructure_Nconstituents(size(config_microstructure)), source=0) + real(pReal), dimension(4) :: phase_orientation - if(any(discretization_microstructureAt > size(config_microstructure))) & - call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config') + homogenization => material_root%get('homogenization') + phases => material_root%get('phase') + microstructure => material_root%get('microstructure') + allocate(microstructure_Nconstituents(microstructure%length), source = 0) + + if(any(discretization_microstructureAt > microstructure%length)) & + call IO_error(155,ext_msg='More microstructures in geometry than sections in material.yaml') - do m=1, size(config_microstructure) - microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') + do m = 1, microstructure%length + constituentsInMicrostructure => microstructure%get(m) + constituents => constituentsInMicrostructure%get('constituents') + microstructure_Nconstituents(m) = constituents%length + enddo + + microstructure_maxNconstituents = maxval(microstructure_Nconstituents) + allocate(microstructure_fraction(microstructure_maxNconstituents,microstructure%length), source =0.0_pReal) + allocate(material_phaseAt(microstructure_maxNconstituents,discretization_nElem), source =0) + allocate(material_orientation0(microstructure_maxNconstituents,discretization_nIP,discretization_nElem)) + allocate(material_homogenizationAt(discretization_nElem)) + allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0) + allocate(material_phaseMemberAt(microstructure_maxNconstituents,discretization_nIP,discretization_nElem),source=0) + + allocate(CounterPhase(phases%length),source=0) + allocate(CounterHomogenization(homogenization%length),source=0) + + do m = 1, microstructure%length + constituentsInMicrostructure => microstructure%get(m) + constituents => constituentsInMicrostructure%get('constituents') + do c = 1, constituents%length + constituent => constituents%get(c) + microstructure_fraction(c,m) = constituent%get_asFloat('fraction') + enddo + if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg='constituent') enddo - maxNconstituents = maxval(microstructure_Nconstituents) - allocate(microstructure_phase (maxNconstituents,size(config_microstructure)),source=0) - allocate(microstructure_texture (maxNconstituents,size(config_microstructure)),source=0) - allocate(microstructure_fraction(maxNconstituents,size(config_microstructure)),source=0.0_pReal) - - allocate(strings(1)) ! Intel 16.0 Bug - do m=1, size(config_microstructure) - strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.) - do c = 1, size(strings) - chunkPos = IO_stringPos(strings(c)) - - do i = 1,5,2 - tag = IO_stringValue(strings(c),chunkPos,i) - - select case (tag) - case('phase') - microstructure_phase(c,m) = IO_intValue(strings(c),chunkPos,i+1) - case('texture') - microstructure_texture(c,m) = IO_intValue(strings(c),chunkPos,i+1) - case('fraction') - microstructure_fraction(c,m) = IO_floatValue(strings(c),chunkPos,i+1) - end select - + do e = 1, discretization_nElem + do i = 1, discretization_nIP + constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e)) + constituents => constituentsInMicrostructure%get('constituents') + do c = 1, constituents%length + constituent => constituents%get(c) + material_phaseAt(c,e) = phases%getIndex(constituent%get_asString('phase')) + phase_orientation = constituent%get_asFloats('orientation') + call material_orientation0(c,i,e)%fromQuaternion(phase_orientation) + enddo + enddo + enddo + + do e = 1, discretization_nElem + do i = 1, discretization_nIP + constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e)) + material_homogenizationAt(e) = homogenization%getIndex(constituentsInMicrostructure%get_asString('homogenization')) + CounterHomogenization(material_homogenizationAt(e)) = CounterHomogenization(material_homogenizationAt(e)) + 1 + material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e)) + enddo + enddo + + do e = 1, discretization_nElem + do i = 1, discretization_nIP + constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e)) + constituents => constituentsInMicrostructure%get('constituents') + do c = 1, constituents%length + CounterPhase(material_phaseAt(c,e)) = & + CounterPhase(material_phaseAt(c,e)) + 1 + material_phaseMemberAt(c,i,e) = CounterPhase(material_phaseAt(c,e)) enddo enddo - if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg=config_name_microstructure(m)) enddo end subroutine material_parseMicrostructure - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the phase part in the material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine material_parsePhase - - integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p - character(len=pStringLen), dimension(:), allocatable :: str - - - allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID) - allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID) - allocate(phase_Nsources(size(config_phase)), source=0) - allocate(phase_Nkinematics(size(config_phase)), source=0) - allocate(phase_NstiffnessDegradations(size(config_phase)),source=0) - allocate(phase_localPlasticity(size(config_phase)), source=.false.) - - do p=1, size(config_phase) - phase_Nsources(p) = config_phase(p)%countKeys('(source)') - phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)') - phase_NstiffnessDegradations(p) = config_phase(p)%countKeys('(stiffness_degradation)') - phase_localPlasticity(p) = .not. config_phase(p)%KeyExists('/nonlocal/') - - select case (config_phase(p)%getString('elasticity')) - case (ELASTICITY_HOOKE_label) - phase_elasticity(p) = ELASTICITY_HOOKE_ID - case default - call IO_error(200,ext_msg=trim(config_phase(p)%getString('elasticity'))) - end select - - select case (config_phase(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,ext_msg=trim(config_phase(p)%getString('plasticity'))) - end select - - enddo - - allocate(phase_source(maxval(phase_Nsources),size(config_phase)), source=SOURCE_undefined_ID) - allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID) - allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & - source=STIFFNESS_DEGRADATION_undefined_ID) - do p=1, size(config_phase) -#if defined(__GFORTRAN__) || defined(__PGI) - str = ['GfortranBug86277'] - str = config_phase(p)%getStrings('(source)',defaultVal=str) - if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::] -#else - str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=pStringLen)::]) -#endif - do sourceCtr = 1, size(str) - select case (trim(str(sourceCtr))) - case (SOURCE_thermal_dissipation_label) - phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID - case (SOURCE_thermal_externalheat_label) - phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID - case (SOURCE_damage_isoBrittle_label) - phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID - case (SOURCE_damage_isoDuctile_label) - phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID - case (SOURCE_damage_anisoBrittle_label) - phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID - case (SOURCE_damage_anisoDuctile_label) - phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID - end select - enddo - -#if defined(__GFORTRAN__) || defined(__PGI) - str = ['GfortranBug86277'] - str = config_phase(p)%getStrings('(kinematics)',defaultVal=str) - if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::] -#else - str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=pStringLen)::]) -#endif - do kinematicsCtr = 1, size(str) - select case (trim(str(kinematicsCtr))) - case (KINEMATICS_cleavage_opening_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID - case (KINEMATICS_slipplane_opening_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID - case (KINEMATICS_thermal_expansion_label) - phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID - end select - enddo -#if defined(__GFORTRAN__) || defined(__PGI) - str = ['GfortranBug86277'] - str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=str) - if (str(1) == 'GfortranBug86277') str = [character(len=pStringLen)::] -#else - str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=pStringLen)::]) -#endif - do stiffDegradationCtr = 1, size(str) - select case (trim(str(stiffDegradationCtr))) - case (STIFFNESS_DEGRADATION_damage_label) - phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID - end select - enddo - enddo - - allocate(phase_plasticityInstance(size(config_phase)),source=0) - allocate(phase_elasticityInstance(size(config_phase)),source=0) - - do p=1, size(config_phase) - phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) - phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) - enddo - -end subroutine material_parsePhase - - -!-------------------------------------------------------------------------------------------------- -!> @brief parses the texture part in the material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine material_parseTexture - - integer :: j,t - character(len=pStringLen), dimension(:), allocatable :: strings ! Values for given key in material config - integer, dimension(:), allocatable :: chunkPos - real(pReal), dimension(3,3) :: transformation ! maps texture to microstructure coordinate system - real(pReal), dimension(3) :: Eulers ! Euler angles in degrees from file - type(rotation) :: transformation_ - - do t=1, size(config_texture) - if (config_texture(t)%countKeys('(gauss)') /= 1) call IO_error(147,ext_msg='count((gauss)) != 1') - if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry') - if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)') - if (config_texture(t)%keyExists('(fiber)')) call IO_error(147,ext_msg='(fiber)') - enddo - - allocate(texture_orientation(size(config_texture))) - - do t=1, size(config_texture) - - strings = config_texture(t)%getStrings('(gauss)',raw= .true.) - chunkPos = IO_stringPos(strings(1)) - do j = 1,5,2 - select case (IO_stringValue(strings(1),chunkPos,j)) - case('phi1') - Eulers(1) = IO_floatValue(strings(1),chunkPos,j+1) - case('phi') - Eulers(2) = IO_floatValue(strings(1),chunkPos,j+1) - case('phi2') - Eulers(3) = IO_floatValue(strings(1),chunkPos,j+1) - end select - enddo - call texture_orientation(t)%fromEulers(Eulers,degrees=.true.) - - if (config_texture(t)%keyExists('axes')) then - strings = config_texture(t)%getStrings('axes') - do j = 1, 3 ! look for "x", "y", and "z" entries - select case (strings(j)) - case('x', '+x') - transformation(j,1:3) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis - case('-x') - transformation(j,1:3) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis - case('y', '+y') - transformation(j,1:3) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis - case('-y') - transformation(j,1:3) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis - case('z', '+z') - transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis - case('-z') - transformation(j,1:3) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis - case default - call IO_error(157,t) - end select - enddo - call transformation_%fromMatrix(transformation) - texture_orientation(t) = texture_orientation(t) * transformation_ - endif - - enddo - -end subroutine material_parseTexture - - -!-------------------------------------------------------------------------------------------------- -!> @brief Allocate the components of the state structure for a given phase -!-------------------------------------------------------------------------------------------------- -subroutine material_allocateState(state, & - NipcMyPhase,sizeState,sizeDotState,sizeDeltaState) - - class(tState), intent(out) :: & - state - integer, intent(in) :: & - NipcMyPhase, & - sizeState, & - sizeDotState, & - sizeDeltaState - - state%sizeState = sizeState - state%sizeDotState = sizeDotState - state%sizeDeltaState = sizeDeltaState - state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - - allocate(state%atol (sizeState), source=0.0_pReal) - allocate(state%state0 (sizeState,NipcMyPhase), source=0.0_pReal) - allocate(state%partionedState0(sizeState,NipcMyPhase), source=0.0_pReal) - allocate(state%subState0 (sizeState,NipcMyPhase), source=0.0_pReal) - allocate(state%state (sizeState,NipcMyPhase), source=0.0_pReal) - - allocate(state%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - - allocate(state%deltaState(sizeDeltaState,NipcMyPhase), source=0.0_pReal) - -end subroutine material_allocateState - - + end module material diff --git a/src/math.f90 b/src/math.f90 index c6e609c63..d485f2e4a 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -8,7 +8,7 @@ module math use prec use IO - use numerics + use config use YAML_types use LAPACK_interface @@ -18,8 +18,7 @@ module math ! do not make use associated entities available to other modules private :: & prec, & - IO, & - numerics + IO #endif real(pReal), parameter :: PI = acos(-1.0_pReal) !< ratio of a circle's circumference to its diameter diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index b6cb4b2d1..05339a280 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -15,7 +15,7 @@ program DAMASK_mesh use math use CPFEM2 use FEsolving - use numerics + use config use discretization_mesh use FEM_Utilities use mesh_mech_FEM diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index b66c1dfb0..b850c20e9 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -14,8 +14,7 @@ module FEM_utilities use prec use FEsolving use homogenization - use numerics - use debug + use config use math use discretization_mesh diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 68c34be1f..7964e1220 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -14,9 +14,8 @@ module discretization_mesh use DAMASK_interface use IO - use debug + use config use discretization - use numerics use FEsolving use FEM_quadrature use YAML_types diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 235039112..4d843b7a0 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -18,7 +18,8 @@ module mesh_mech_FEM use FEM_utilities use discretization_mesh use DAMASK_interface - use numerics + use config + use IO use FEM_quadrature use homogenization use math diff --git a/src/numerics.f90 b/src/numerics.f90 deleted file mode 100644 index 35436296c..000000000 --- a/src/numerics.f90 +++ /dev/null @@ -1,82 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Sharan Roongta, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Managing of parameters related to numerics -!-------------------------------------------------------------------------------------------------- -module numerics - use prec - use IO - use YAML_types - use YAML_parse - -#ifdef PETSc -#include - use petscsys -#endif -!$ use OMP_LIB - - implicit none - private - - class(tNode), pointer, protected, public :: & - numerics_root !< root pointer storing the numerics YAML structure - integer, protected, public :: & - worldrank = 0, & !< MPI worldrank (/=0 for MPI simulations only) - worldsize = 1 !< MPI worldsize (/=1 for MPI simulations only) - integer(4), protected, public :: & - DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive - - public :: numerics_init - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief reads in parameters from numerics.config and sets openMP related parameters. Also does -! a sanity check -!-------------------------------------------------------------------------------------------------- -subroutine numerics_init - -!$ integer :: gotDAMASK_NUM_THREADS = 1 - integer :: ierr - character(len=:), allocatable :: & - numerics_input, & - numerics_inFlow - logical :: fexist -!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS - -#ifdef PETSc - call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) - call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) -#endif - write(6,'(/,a)') ' <<<+- numerics init -+>>>' - -!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS... -!$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1 -!$ call IO_warning(35,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END') -!$ DAMASK_NumThreadsInt = 1_4 -!$ else -!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! read as integer -!$ if (DAMASK_NumThreadsInt < 1_4) DAMASK_NumThreadsInt = 1_4 ! in case of string conversion fails, set it to one -!$ endif -!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution - - numerics_root => emptyDict - inquire(file='numerics.yaml', exist=fexist) - - if (fexist) then - write(6,'(a,/)') ' using values from config file' - flush(6) - numerics_input = IO_read('numerics.yaml') - numerics_inFlow = to_flow(numerics_input) - numerics_root => parse_flow(numerics_inFlow) - endif - -!-------------------------------------------------------------------------------------------------- -! openMP parameter - !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt - -end subroutine numerics_init - -end module numerics diff --git a/src/results.f90 b/src/results.f90 index 21173c512..45c6263e4 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -7,7 +7,7 @@ module results use DAMASK_interface use rotations - use numerics + use config use HDF5_utilities #ifdef PETSc use PETSC diff --git a/src/rotations.f90 b/src/rotations.f90 index 85f901f5d..fc523e813 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -56,7 +56,7 @@ module rotations private type, public :: rotation - type(quaternion), private :: q + type(quaternion) :: q contains procedure, public :: asQuaternion procedure, public :: asEulers diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 20cf3a914..65aedacd6 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -12,15 +12,15 @@ submodule (constitutive:constitutive_damage) source_damage_anisoBrittle type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & - sdot_0, & - n + sdot_0, & !< opening rate of cleavage planes + n !< damage rate sensitivity real(pReal), dimension(:), allocatable :: & - critDisp, & - critLoad + critDisp, & !< critical displacement + critLoad !< critical load real(pReal), dimension(:,:,:,:), allocatable :: & cleavage_systems integer :: & - sum_N_cl + sum_N_cl !< total number of cleavage planes character(len=pStringLen), allocatable, dimension(:) :: & output end type tParameters @@ -35,72 +35,87 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoBrittle_init +module function source_damage_anisoBrittle_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_cl character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_damage_anisoBrittle init -+>>>' - Ninstance = count(phase_source == SOURCE_DAMAGE_ANISOBRITTLE_ID) + mySources = source_active('damage_anisoBrittle',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(source_damage_anisoBrittle_offset (size(config_phase)), source=0) - allocate(source_damage_anisoBrittle_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_damage_anisoBrittle_offset (phases%length), source=0) + allocate(source_damage_anisoBrittle_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_damage_anisoBrittle_instance(p) = count(phase_source(:,1:p) == SOURCE_DAMAGE_ANISOBRITTLE_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_DAMAGE_ANISOBRITTLE_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(any(mySources(:,p))) source_damage_anisoBrittle_instance(p) = count(mySources(:,1:p)) + if(count(mySources(:,p)) == 0) cycle + sources => phase%get('source') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_damage_anisoBrittle_offset(p) = sourceOffset - exit - endif - enddo + associate(prm => param(source_damage_anisoBrittle_instance(p))) + src => sources%get(sourceOffset) + + N_cl = src%get_asInts('N_cl',defaultVal=emptyIntArray) + prm%sum_N_cl = sum(abs(N_cl)) + + prm%n = src%get_asFloat('q') + prm%sdot_0 = src%get_asFloat('dot_o') + + prm%critDisp = src%get_asFloats('s_crit', requiredSize=size(N_cl)) + prm%critLoad = src%get_asFloats('g_crit', requiredSize=size(N_cl)) + + prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase%get_asString('lattice'),& + phase%get_asFloat('c/a',defaultVal=0.0_pReal)) + + ! expand: family => system + prm%critDisp = math_expand(prm%critDisp,N_cl) + prm%critLoad = math_expand(prm%critLoad,N_cl) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle - associate(prm => param(source_damage_anisoBrittle_instance(p)), & - config => config_phase(p)) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_o' + if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit' + if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + NipcMyPhase = count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) + sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) + if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' - N_cl = config%getInts('ncleavage',defaultVal=emptyIntArray) - prm%sum_N_cl = sum(abs(N_cl)) - - prm%n = config%getFloat('anisobrittle_ratesensitivity') - prm%sdot_0 = config%getFloat('anisobrittle_sdot0') - - prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(N_cl)) - prm%critLoad = config%getFloats('anisobrittle_criticalload', requiredSize=size(N_cl)) - - prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - - ! expand: family => system - prm%critDisp = math_expand(prm%critDisp,N_cl) - prm%critLoad = math_expand(prm%critLoad,N_cl) - - ! sanity checks - if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_n' - if (prm%sdot_0 <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0' - if (any(prm%critLoad < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_critLoad' - if (any(prm%critDisp < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_critDisp' - - NipcMyPhase = count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) - sourceState(p)%p(sourceOffset)%atol = config%getFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' - - end associate + end associate !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoBrittle)') + endif + enddo + enddo -enddo - -end subroutine source_damage_anisoBrittle_init +end function source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -193,8 +208,8 @@ module subroutine source_damage_anisoBrittle_results(phase,group) stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case ('anisobrittle_drivingforce') - call results_writeDataset(group,stt,'tbd','driving force','tbd') + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') end select enddo outputsLoop end associate diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 3722f8b1c..26b653c3d 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -10,16 +10,16 @@ submodule(constitutive:constitutive_damage) source_damage_anisoDuctile source_damage_anisoDuctile_offset, & !< which source is my current damage mechanism? source_damage_anisoDuctile_instance !< instance of damage source mechanism - type :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & - n + n !< damage rate sensitivity real(pReal), dimension(:), allocatable :: & - critPlasticStrain + critPlasticStrain !< critical plastic strain per slip system character(len=pStringLen), allocatable, dimension(:) :: & output end type tParameters - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) contains @@ -28,61 +28,80 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoDuctile_init +module function source_damage_anisoDuctile_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + pl, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p integer, dimension(:), allocatable :: N_sl character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_damage_anisoDuctile init -+>>>' - Ninstance = count(phase_source == SOURCE_DAMAGE_ANISODUCTILE_ID) + mySources = source_active('damage_anisoDuctile',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) - allocate(source_damage_anisoDuctile_offset (size(config_phase)), source=0) - allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0) + if(Ninstance == 0) return + + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_damage_anisoDuctile_offset (phases%length), source=0) + allocate(source_damage_anisoDuctile_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_damage_anisoDuctile_instance(p) = count(phase_source(:,1:p) == SOURCE_DAMAGE_ANISODUCTILE_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_DAMAGE_ANISODUCTILE_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(any(mySources(:,p))) source_damage_anisoDuctile_instance(p) = count(mySources(:,1:p)) + if(count(mySources(:,p)) == 0) cycle + sources => phase%get('source') + pl => phase%get('plasticity') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_damage_anisoDuctile_offset(p) = sourceOffset - exit - endif - enddo + associate(prm => param(source_damage_anisoDuctile_instance(p))) + src => sources%get(sourceOffset) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISODUCTILE_ID)) cycle - associate(prm => param(source_damage_anisoDuctile_instance(p)), & - config => config_phase(p)) + N_sl = pl%get_asInts('N_sl',defaultVal=emptyIntArray) + prm%n = src%get_asFloat('q') + prm%critPlasticStrain = src%get_asFloats('gamma_crit',requiredSize=size(N_sl)) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + ! expand: family => system + prm%critPlasticStrain = math_expand(prm%critPlasticStrain,N_sl) - N_sl = config%getInts('nslip',defaultVal=emptyIntArray) - prm%n = config%getFloat('anisoductile_ratesensitivity') - prm%critPlasticStrain = config%getFloats('anisoductile_criticalplasticstrain',requiredSize=size(N_sl)) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' - ! expand: family => system - prm%critPlasticStrain = math_expand(prm%critPlasticStrain,N_sl) + NipcMyPhase=count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) + sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' - ! sanity checks - if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' anisoductile_ratesensitivity' - if (any(prm%critPlasticStrain < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_criticalplasticstrain' - - NipcMyPhase=count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) - sourceState(p)%p(sourceOffset)%atol = config%getFloat('anisoductile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' - - end associate + end associate !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoDuctile)') + endif + enddo + enddo -enddo -end subroutine source_damage_anisoDuctile_init +end function source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -157,8 +176,8 @@ module subroutine source_damage_anisoDuctile_results(phase,group) stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case ('anisoductile_drivingforce') - call results_writeDataset(group,stt,'tbd','driving force','tbd') + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') end select enddo outputsLoop end associate diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 00704fe26..b1abcf14d 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -10,10 +10,10 @@ submodule(constitutive:constitutive_damage) source_damage_isoBrittle source_damage_isoBrittle_offset, & source_damage_isoBrittle_instance - type :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & - critStrainEnergy, & - N + critStrainEnergy, & !< critical elastic strain energy + N character(len=pStringLen), allocatable, dimension(:) :: & output end type tParameters @@ -27,56 +27,72 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoBrittle_init +module function source_damage_isoBrittle_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_damage_isoBrittle init -+>>>' - Ninstance = count(phase_source == SOURCE_DAMAGE_ISOBRITTLE_ID) + mySources = source_active('damage_isoBrittle',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(source_damage_isoBrittle_offset (size(config_phase)), source=0) - allocate(source_damage_isoBrittle_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_damage_isoBrittle_offset (phases%length), source=0) + allocate(source_damage_isoBrittle_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_damage_isoBrittle_instance(p) = count(phase_source(:,1:p) == SOURCE_DAMAGE_ISOBRITTLE_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_DAMAGE_ISOBRITTLE_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(any(mySources(:,p))) source_damage_isoBrittle_instance(p) = count(mySources(:,1:p)) + if(count(mySources(:,p)) == 0) cycle + sources => phase%get('source') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_damage_isoBrittle_offset(p) = sourceOffset - exit - endif - enddo + associate(prm => param(source_damage_isoBrittle_instance(p))) + src => sources%get(sourceOffset) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISOBRITTLE_ID)) cycle - associate(prm => param(source_damage_isoBrittle_instance(p)), & - config => config_phase(p)) + prm%N = src%get_asFloat('m') + prm%critStrainEnergy = src%get_asFloat('W_crit') - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' m' + if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' - prm%N = config%getFloat('isobrittle_n') - prm%critStrainEnergy = config%getFloat('isobrittle_criticalstrainenergy') + NipcMyPhase = count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,1) + sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) + if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' - ! sanity checks - if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_n' - if (prm%critStrainEnergy <= 0.0_pReal) extmsg = trim(extmsg)//' isobrittle_criticalstrainenergy' - - NipcMyPhase = count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,1) - sourceState(p)%p(sourceOffset)%atol = config%getFloat('isobrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' - - end associate + end associate !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoBrittle)') + endif + enddo + enddo -enddo -end subroutine source_damage_isoBrittle_init +end function source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- @@ -168,8 +184,8 @@ module subroutine source_damage_isoBrittle_results(phase,group) stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case ('isobrittle_drivingforce') - call results_writeDataset(group,stt,'tbd','driving force','tbd') + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') end select enddo outputsLoop end associate diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 517332316..dc102f539 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -10,15 +10,15 @@ submodule (constitutive:constitutive_damage) source_damage_isoDuctile source_damage_isoDuctile_offset, & !< which source is my current damage mechanism? source_damage_isoDuctile_instance !< instance of damage source mechanism - type:: tParameters !< container type for internal constitutive parameters + type:: tParameters !< container type for internal constitutive parameters real(pReal) :: & - critPlasticStrain, & + critPlasticStrain, & !< critical plastic strain N character(len=pStringLen), allocatable, dimension(:) :: & output end type tParameters - type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) + type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) contains @@ -28,56 +28,72 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoDuctile_init +module function source_damage_isoDuctile_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p character(len=pStringLen) :: extmsg = '' - write(6,'(/,a)') ' <<<+- source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_damage_isoDuctile init -+>>>' - Ninstance = count(phase_source == SOURCE_DAMAGE_ISODUCTILE_ID) + mySources = source_active('damage_isoDuctile',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(source_damage_isoDuctile_offset (size(config_phase)), source=0) - allocate(source_damage_isoDuctile_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_damage_isoDuctile_offset (phases%length), source=0) + allocate(source_damage_isoDuctile_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_damage_isoDuctile_instance(p) = count(phase_source(:,1:p) == SOURCE_DAMAGE_ISODUCTILE_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_DAMAGE_ISODUCTILE_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(count(mySources(:,p)) == 0) cycle + if(any(mySources(:,p))) source_damage_isoDuctile_instance(p) = count(mySources(:,1:p)) + sources => phase%get('source') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_damage_isoDuctile_offset(p) = sourceOffset - exit - endif - enddo + associate(prm => param(source_damage_isoDuctile_instance(p))) + src => sources%get(sourceOffset) - if (all(phase_source(:,p) /= SOURCE_DAMAGE_ISODUCTILE_ID)) cycle - associate(prm => param(source_damage_isoDuctile_instance(p)), & - config => config_phase(p)) + prm%N = src%get_asFloat('q') + prm%critPlasticStrain = src%get_asFloat('gamma_crit') - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(src) +#else + prm%output = src%get_asStrings('output',defaultVal=emptyStringArray) +#endif + + ! sanity checks + if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' q' + if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' - prm%N = config%getFloat('isoductile_ratesensitivity') - prm%critPlasticStrain = config%getFloat('isoductile_criticalplasticstrain') + NipcMyPhase=count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) + sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' - ! sanity checks - if (prm%N <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_ratesensitivity' - if (prm%critPlasticStrain <= 0.0_pReal) extmsg = trim(extmsg)//' isoductile_criticalplasticstrain' - - NipcMyPhase=count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) - sourceState(p)%p(sourceOffset)%atol = config%getFloat('isoductile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' - - end associate + end associate !-------------------------------------------------------------------------------------------------- ! exit if any parameter is out of range - if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')') + if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isoDuctile)') + endif + enddo + enddo -enddo -end subroutine source_damage_isoDuctile_init +end function source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- @@ -152,8 +168,8 @@ module subroutine source_damage_isoDuctile_results(phase,group) stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case ('isoductile_drivingforce') - call results_writeDataset(group,stt,'tbd','driving force','tbd') + case ('f_phi') + call results_writeDataset(group,stt,trim(prm%output(o)),'driving force','J/m³') end select enddo outputsLoop end associate diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 58a0c6b3c..d75e7f654 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -12,7 +12,7 @@ submodule(constitutive:constitutive_thermal) source_thermal_dissipation type :: tParameters !< container type for internal constitutive parameters real(pReal) :: & - kappa + kappa !< TAYLOR-QUINNEY factor end type tParameters type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstance) @@ -25,41 +25,53 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_init +module function source_thermal_dissipation_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p - write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_dissipation_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_thermal_dissipation init -+>>>' - Ninstance = count(phase_source == SOURCE_THERMAL_DISSIPATION_ID) + mySources = source_active('thermal_dissipation',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(source_thermal_dissipation_offset (size(config_phase)), source=0) - allocate(source_thermal_dissipation_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_thermal_dissipation_offset (phases%length), source=0) + allocate(source_thermal_dissipation_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_thermal_dissipation_instance(p) = count(phase_source(:,1:p) == SOURCE_THERMAL_DISSIPATION_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_THERMAL_DISSIPATION_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(count(mySources(:,p)) == 0) cycle + if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p)) + sources => phase%get('source') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_thermal_dissipation_offset(p) = sourceOffset - exit + associate(prm => param(source_thermal_dissipation_instance(p))) + + src => sources%get(sourceOffset) + prm%kappa = src%get_asFloat('kappa') + NipcMyPhase = count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,0,0,0) + + end associate endif enddo - - if (all(phase_source(:,p) /= SOURCE_THERMAL_DISSIPATION_ID)) cycle - associate(prm => param(source_thermal_dissipation_instance(p)), & - config => config_phase(p)) - - prm%kappa = config%getFloat('dissipation_coldworkcoeff') - - NipcMyPhase = count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,0,0,0) - - end associate enddo -end subroutine source_thermal_dissipation_init + +end function source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 8ffc7a4fb..45ed2086f 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -11,9 +11,9 @@ submodule(constitutive:constitutive_thermal) source_thermal_externalheat source_thermal_externalheat_offset, & !< which source is my current thermal dissipation mechanism? source_thermal_externalheat_instance !< instance of thermal dissipation source mechanism - type :: tParameters !< container type for internal constitutive parameters + type :: tParameters !< container type for internal constitutive parameters real(pReal), dimension(:), allocatable :: & - time, & + time, & heat_rate integer :: & nIntervals @@ -29,44 +29,56 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_init +module function source_thermal_externalheat_init(source_length) result(mySources) + integer, intent(in) :: source_length + logical, dimension(:,:), allocatable :: mySources + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src integer :: Ninstance,sourceOffset,NipcMyPhase,p - write(6,'(/,a)') ' <<<+- source_'//SOURCE_thermal_externalheat_label//' init -+>>>' + write(6,'(/,a)') ' <<<+- source_thermal_externalHeat init -+>>>' - Ninstance = count(phase_source == SOURCE_thermal_externalheat_ID) + mySources = source_active('thermal_externalheat',source_length) + + Ninstance = count(mySources) write(6,'(a16,1x,i5,/)') '# instances:',Ninstance; flush(6) + if(Ninstance == 0) return - allocate(source_thermal_externalheat_offset (size(config_phase)), source=0) - allocate(source_thermal_externalheat_instance(size(config_phase)), source=0) + phases => material_root%get('phase') allocate(param(Ninstance)) + allocate(source_thermal_externalheat_offset (phases%length), source=0) + allocate(source_thermal_externalheat_instance(phases%length), source=0) - do p = 1, size(config_phase) - source_thermal_externalheat_instance(p) = count(phase_source(:,1:p) == SOURCE_thermal_externalheat_ID) - do sourceOffset = 1, phase_Nsources(p) - if (phase_source(sourceOffset,p) == SOURCE_thermal_externalheat_ID) then + do p = 1, phases%length + phase => phases%get(p) + if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p)) + if(count(mySources(:,p)) == 0) cycle + sources => phase%get('source') + do sourceOffset = 1, sources%length + if(mySources(sourceOffset,p)) then source_thermal_externalheat_offset(p) = sourceOffset - exit + associate(prm => param(source_thermal_externalheat_instance(p))) + src => sources%get(sourceOffset) + + prm%time = src%get_asFloats('t_n') + prm%nIntervals = size(prm%time) - 1 + + prm%heat_rate = src%get_asFloats('f_T',requiredSize = size(prm%time)) + + NipcMyPhase = count(material_phaseAt==p) * discretization_nIP + call constitutive_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) + end associate + endif enddo - - if (all(phase_source(:,p) /= SOURCE_thermal_externalheat_ID)) cycle - associate(prm => param(source_thermal_externalheat_instance(p)), & - config => config_phase(p)) - - prm%time = config%getFloats('externalheat_time') - prm%nIntervals = size(prm%time) - 1 - - prm%heat_rate = config%getFloats('externalheat_rate',requiredSize = size(prm%time)) - - NipcMyPhase = count(material_phaseAt==p) * discretization_nIP - call material_allocateState(sourceState(p)%p(sourceOffset),NipcMyPhase,1,1,0) - - end associate enddo -end subroutine source_thermal_externalheat_init +end function source_thermal_externalheat_init !-------------------------------------------------------------------------------------------------- diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index c52f0a3d0..bd4a5f12c 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -5,10 +5,10 @@ module thermal_adiabatic use prec use config - use numerics use material use results use constitutive + use YAML_types use crystallite use lattice @@ -40,20 +40,32 @@ contains !-------------------------------------------------------------------------------------------------- subroutine thermal_adiabatic_init - integer :: maxNinstance,h,NofMyHomog - - write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>'; flush(6) + integer :: maxNinstance,h,NofMyHomog + class(tNode), pointer :: & + material_homogenization, & + homog, & + homogThermal + + write(6,'(/,a)') ' <<<+- thermal_adiabatic init -+>>>'; flush(6) maxNinstance = count(thermal_type == THERMAL_adiabatic_ID) if (maxNinstance == 0) return allocate(param(maxNinstance)) - do h = 1, size(thermal_type) + material_homogenization => material_root%get('homogenization') + do h = 1, material_Nhomogenization if (thermal_type(h) /= THERMAL_adiabatic_ID) cycle - associate(prm => param(thermal_typeInstance(h)),config => config_homogenization(h)) - - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) + homog => material_homogenization%get(h) + homogThermal => homog%get('thermal') + + associate(prm => param(thermal_typeInstance(h))) + +#if defined (__GFORTRAN__) + prm%output = output_asStrings(homogThermal) +#else + prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) +#endif NofMyHomog=count(material_homogenizationAt==h) thermalState(h)%sizeState = 1 @@ -205,7 +217,7 @@ subroutine thermal_adiabatic_results(homog,group) associate(prm => param(damage_typeInstance(homog))) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('temperature') ! ToDo: should be 'T' + case('T') call results_writeDataset(group,temperature(homog)%p,'T',& 'temperature','K') end select diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 60766710d..9075c6d64 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -10,6 +10,7 @@ module thermal_conduction use results use crystallite use constitutive + use YAML_types implicit none private @@ -41,17 +42,28 @@ contains subroutine thermal_conduction_init integer :: Ninstance,NofMyHomog,h - - write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>'; flush(6) + class(tNode), pointer :: & + material_homogenization, & + homog, & + homogThermal + + write(6,'(/,a)') ' <<<+- thermal_conduction init -+>>>'; flush(6) Ninstance = count(thermal_type == THERMAL_conduction_ID) allocate(param(Ninstance)) - do h = 1, size(config_homogenization) + material_homogenization => material_root%get('homogenization') + do h = 1, material_Nhomogenization if (thermal_type(h) /= THERMAL_conduction_ID) cycle - associate(prm => param(thermal_typeInstance(h)),config => config_homogenization(h)) + homog => material_homogenization%get(h) + homogThermal => homog%get('thermal') + associate(prm => param(thermal_typeInstance(h))) - prm%output = config%getStrings('(output)',defaultVal=emptyStringArray) +#if defined (__GFORTRAN__) + prm%output = output_asStrings(homogThermal) +#else + prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) +#endif NofMyHomog=count(material_homogenizationAt==h) thermalState(h)%sizeState = 0 @@ -213,7 +225,7 @@ subroutine thermal_conduction_results(homog,group) associate(prm => param(damage_typeInstance(homog))) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('temperature') ! ToDo: should be 'T' + case('T') call results_writeDataset(group,temperature(homog)%p,'T',& 'temperature','K') end select diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index ceb714740..38aa99136 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -18,9 +18,9 @@ subroutine thermal_isothermal_init integer :: h,NofMyHomog - write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'; flush(6) + write(6,'(/,a)') ' <<<+- thermal_isothermal init -+>>>'; flush(6) - do h = 1, size(config_homogenization) + do h = 1, material_Nhomogenization if (thermal_type(h) /= THERMAL_isothermal_ID) cycle NofMyHomog = count(material_homogenizationAt == h)