From d45aea4467224e0d986f789471678315434df57e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Feb 2014 14:31:19 +0000 Subject: [PATCH] moved reading in of lattice stru --- code/constitutive_dislotwin.f90 | 28 +-- code/constitutive_j2.f90 | 184 ++++++--------- code/constitutive_phenopowerlaw.f90 | 353 ++++++++++++---------------- code/crystallite.f90 | 8 +- code/lattice.f90 | 170 ++++++++++++-- 5 files changed, 377 insertions(+), 366 deletions(-) diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index b461fb767..e151580a3 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -39,7 +39,7 @@ module constitutive_dislotwin constitutive_dislotwin_sizePostResults !< cumulative size of post results integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_dislotwin_structureID !< ID of the lattice structure !< name of the lattice structure + constitutive_dislotwin_structureID !< ID of the lattice structure integer(pInt), dimension(:,:), allocatable, target, public :: & constitutive_dislotwin_sizePostResult !< size of each post result output @@ -171,7 +171,7 @@ module constitutive_dislotwin sb_eigenvectors_ID end enum integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - constitutive_dislotwin_outputID !< ID of each post result output + constitutive_dislotwin_outputID !< ID of each post result output public :: & @@ -205,18 +205,18 @@ subroutine constitutive_dislotwin_init(fileUnit) mesh_maxNips, & mesh_NcpElems use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & - IO_warning, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF use material, only: & homogenization_maxNgrains, & phase_plasticity, & diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index 40dad5a4f..45bc31247 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -30,8 +30,6 @@ module constitutive_j2 use prec, only: & pReal,& pInt - use lattice, only: & - LATTICE_undefined_ID implicit none private @@ -46,9 +44,6 @@ module constitutive_j2 character(len=64), dimension(:,:), allocatable, target, public :: & constitutive_j2_output !< name of each post result output - integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_j2_structureID !< ID of the lattice structure - integer(pInt), dimension(:), allocatable, private :: & constitutive_j2_Noutput !< number of outputs per instance @@ -134,8 +129,6 @@ subroutine constitutive_j2_init(fileUnit) integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions integer(pInt) :: section = 0_pInt, maxNinstance, i,o, mySize - character(len=32) :: & - structure = '' character(len=65536) :: & tag = '', & line = '' @@ -159,7 +152,6 @@ subroutine constitutive_j2_init(fileUnit) constitutive_j2_output = '' allocate(constitutive_j2_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) allocate(constitutive_j2_Noutput(maxNinstance), source=0_pInt) - allocate(constitutive_j2_structureID(maxNinstance), source=LATTICE_undefined_ID) allocate(constitutive_j2_Cslip_66(6,6,maxNinstance), source=0.0_pReal) allocate(constitutive_j2_fTaylor(maxNinstance), source=0.0_pReal) allocate(constitutive_j2_tau0(maxNinstance), source=0.0_pReal) @@ -189,104 +181,75 @@ subroutine constitutive_j2_init(fileUnit) endif if (IO_getTag(line,'[',']') /= '') then ! next section section = section + 1_pInt ! advance section counter + if (phase_plasticity(section) == PLASTICITY_J2_ID) then + i = phase_plasticityInstance(section) + constitutive_j2_Cslip_66(1:6,1:6,i) = lattice_Cslip_66(1:6,1:6,section) + endif cycle ! skip to next line endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran - if (phase_plasticity(section) == PLASTICITY_J2_ID) then ! one of my sections - i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - select case(tag) - case ('plasticity','elasticity') - case ('(output)') - constitutive_j2_Noutput(i) = constitutive_j2_Noutput(i) + 1_pInt - constitutive_j2_output(constitutive_j2_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) - case ('flowstress') - constitutive_j2_outputID(constitutive_j2_Noutput(i),i) = flowstress_ID - case ('strainrate') - constitutive_j2_outputID(constitutive_j2_Noutput(i),i) = strainrate_ID - case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_J2_label//')') - end select - case ('lattice_structure') - structure = IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(structure(1:3)) - case(LATTICE_iso_label) - constitutive_j2_structureID(i) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_j2_structureID(i) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_j2_structureID(i) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_j2_structureID(i) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_j2_structureID(i) = LATTICE_ort_ID - end select - case ('c11') - constitutive_j2_Cslip_66(1,1,i) = IO_floatValue(line,positions,2_pInt) - case ('c12') - constitutive_j2_Cslip_66(1,2,i) = IO_floatValue(line,positions,2_pInt) - case ('c13') - constitutive_j2_Cslip_66(1,3,i) = IO_floatValue(line,positions,2_pInt) - case ('c22') - constitutive_j2_Cslip_66(2,2,i) = IO_floatValue(line,positions,2_pInt) - case ('c23') - constitutive_j2_Cslip_66(2,3,i) = IO_floatValue(line,positions,2_pInt) - case ('c33') - constitutive_j2_Cslip_66(3,3,i) = IO_floatValue(line,positions,2_pInt) - case ('c44') - constitutive_j2_Cslip_66(4,4,i) = IO_floatValue(line,positions,2_pInt) - case ('c55') - constitutive_j2_Cslip_66(5,5,i) = IO_floatValue(line,positions,2_pInt) - case ('c66') - constitutive_j2_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt) - case ('tau0') - constitutive_j2_tau0(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_tau0(i) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('gdot0') - constitutive_j2_gdot0(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_gdot0(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('n') - constitutive_j2_n(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_n(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('h0') - constitutive_j2_h0(i) = IO_floatValue(line,positions,2_pInt) - case ('h0_slope','slopelnrate') - constitutive_j2_h0_slopeLnRate(i) = IO_floatValue(line,positions,2_pInt) - case ('tausat') - constitutive_j2_tausat(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_tausat(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('tausat_sinhfita') - constitutive_j2_tausat_SinhFitA(i) = IO_floatValue(line,positions,2_pInt) - case ('tausat_sinhfitb') - constitutive_j2_tausat_SinhFitB(i) = IO_floatValue(line,positions,2_pInt) - case ('tausat_sinhfitc') - constitutive_j2_tausat_SinhFitC(i) = IO_floatValue(line,positions,2_pInt) - case ('tausat_sinhfitd') - constitutive_j2_tausat_SinhFitD(i) = IO_floatValue(line,positions,2_pInt) - case ('a', 'w0') - constitutive_j2_a(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_a(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('taylorfactor') - constitutive_j2_fTaylor(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_fTaylor(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case ('atol_resistance') - constitutive_j2_aTolResistance(i) = IO_floatValue(line,positions,2_pInt) - if (constitutive_j2_aTolResistance(i) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') - end select - endif - endif + if (section > 0_pInt ) then; if (phase_plasticity(section) == PLASTICITY_J2_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase + positions = IO_stringPos(line,MAXNCHUNKS) + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + select case(tag) + case ('plasticity','elasticity','lattice_structure',& + 'c11','c12','c13','c22','c23','c33','c44','c55','c66') + case ('(output)') + constitutive_j2_Noutput(i) = constitutive_j2_Noutput(i) + 1_pInt + constitutive_j2_output(constitutive_j2_Noutput(i),i) = & + IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + case ('flowstress') + constitutive_j2_outputID(constitutive_j2_Noutput(i),i) = flowstress_ID + case ('strainrate') + constitutive_j2_outputID(constitutive_j2_Noutput(i),i) = strainrate_ID + case default + call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_J2_label//')') + end select + case ('tau0') + constitutive_j2_tau0(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_tau0(i) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('gdot0') + constitutive_j2_gdot0(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_gdot0(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('n') + constitutive_j2_n(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_n(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('h0') + constitutive_j2_h0(i) = IO_floatValue(line,positions,2_pInt) + case ('h0_slope','slopelnrate') + constitutive_j2_h0_slopeLnRate(i) = IO_floatValue(line,positions,2_pInt) + case ('tausat') + constitutive_j2_tausat(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_tausat(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('tausat_sinhfita') + constitutive_j2_tausat_SinhFitA(i) = IO_floatValue(line,positions,2_pInt) + case ('tausat_sinhfitb') + constitutive_j2_tausat_SinhFitB(i) = IO_floatValue(line,positions,2_pInt) + case ('tausat_sinhfitc') + constitutive_j2_tausat_SinhFitC(i) = IO_floatValue(line,positions,2_pInt) + case ('tausat_sinhfitd') + constitutive_j2_tausat_SinhFitD(i) = IO_floatValue(line,positions,2_pInt) + case ('a', 'w0') + constitutive_j2_a(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_a(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('taylorfactor') + constitutive_j2_fTaylor(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_fTaylor(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case ('atol_resistance') + constitutive_j2_aTolResistance(i) = IO_floatValue(line,positions,2_pInt) + if (constitutive_j2_aTolResistance(i) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + case default + call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') + end select + endif; endif enddo instancesLoop: do i = 1_pInt,maxNinstance @@ -302,12 +265,7 @@ subroutine constitutive_j2_init(fileUnit) constitutive_j2_sizePostResults(i) = & constitutive_j2_sizePostResults(i) + mySize endif - enddo outputsLoop - - constitutive_j2_Cslip_66(1:6,1:6,i) = & - lattice_symmetrizeC66(constitutive_j2_structureID(i),constitutive_j2_Cslip_66(1:6,1:6,i)) - constitutive_j2_Cslip_66(1:6,1:6,i) = & ! Literature data is Voigt, DAMASK uses Mandel - math_Mandel3333to66(math_Voigt66to3333(constitutive_j2_Cslip_66(1:6,1:6,i))) + enddo outputsLoop enddo instancesLoop end subroutine constitutive_j2_init @@ -321,7 +279,7 @@ pure function constitutive_j2_stateInit(matID) implicit none real(pReal), dimension(1) :: constitutive_j2_stateInit - integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity constitutive_j2_stateInit = constitutive_j2_tau0(matID) @@ -334,7 +292,7 @@ end function constitutive_j2_stateInit pure function constitutive_j2_aTolState(matID) implicit none - integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: matID !< number specifying the instance of the plasticity real(pReal), dimension(constitutive_j2_sizeState(matID)) :: & constitutive_j2_aTolState @@ -394,7 +352,7 @@ pure subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,state,ip real(pReal), dimension(3,3), intent(out) :: & Lp !< plastic velocity gradient real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress + dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress real(pReal), dimension(6), intent(in) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index b156c6992..05085c56d 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -28,8 +28,6 @@ module constitutive_phenopowerlaw use prec, only: & pReal,& pInt - use lattice, only: & - LATTICE_undefined_ID implicit none private @@ -44,9 +42,6 @@ module constitutive_phenopowerlaw character(len=64), dimension(:,:), allocatable, target, public :: & constitutive_phenopowerlaw_output !< name of each post result output - - integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_phenopowerlaw_structureID !< ID of the lattice structure integer(pInt), dimension(:), allocatable, private :: & constitutive_phenopowerlaw_Noutput, & !< number of outputs per instance of this constitution @@ -208,7 +203,6 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) constitutive_phenopowerlaw_output = '' allocate(constitutive_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) allocate(constitutive_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) - allocate(constitutive_phenopowerlaw_structureID(maxNinstance), source=LATTICE_undefined_ID) allocate(constitutive_phenopowerlaw_structure(maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) @@ -264,205 +258,154 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) endif if (IO_getTag(line,'[',']') /= '') then ! next section section = section + 1_pInt ! advance section counter + if (phase_plasticity(section) == PLASTICITY_PHENOPOWERLAW_ID) then + i = phase_plasticityInstance(section) + constitutive_phenopowerlaw_Cslip_66(1:6,1:6,i) = lattice_Cslip_66(1:6,1:6,section) + constitutive_phenopowerlaw_structure(i) = lattice_structure(section) + configNchunks = lattice_configNchunks(lattice_structureID(section)) + Nchunks_SlipFamilies = configNchunks(1) + Nchunks_TwinFamilies = configNchunks(2) + Nchunks_SlipSlip = configNchunks(3) + Nchunks_SlipTwin = configNchunks(4) + Nchunks_TwinSlip = configNchunks(5) + Nchunks_TwinTwin = configNchunks(6) + Nchunks_nonSchmid = configNchunks(7) + endif cycle ! skip to next line endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran - if (phase_plasticity(section) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my sections - i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase - positions = IO_stringPos(line,MAXNCHUNKS) - tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key - select case(tag) - case ('plasticity','elasticity') - case ('(output)') - constitutive_phenopowerlaw_Noutput(i) = constitutive_phenopowerlaw_Noutput(i) + 1_pInt - constitutive_phenopowerlaw_output(constitutive_phenopowerlaw_Noutput(i),i) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) - case ('resistance_slip') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resistance_slip_ID - case ('accumulatedshear_slip') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = accumulatedshear_slip_ID - case ('shearrate_slip') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = shearrate_slip_ID - case ('resolvedstress_slip') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resolvedstress_slip_ID - case ('totalshear') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = totalshear_ID - case ('resistance_twin') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resistance_twin_ID - case ('accumulatedshear_twin') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = accumulatedshear_twin_ID - case ('shearrate_twin') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = shearrate_twin_ID - case ('resolvedstress_twin') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resolvedstress_twin_ID - case ('totalvolfrac') - constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = totalvolfrac_ID - case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - end select - case ('lattice_structure') - structure = IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(structure(1:3)) - case(LATTICE_iso_label) - constitutive_phenopowerlaw_structureID(i) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_phenopowerlaw_structureID(i) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_phenopowerlaw_structureID(i) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_phenopowerlaw_structureID(i) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_phenopowerlaw_structureID(i) = LATTICE_ort_ID - end select - configNchunks = lattice_configNchunks(constitutive_phenopowerlaw_structureID(i)) - Nchunks_SlipFamilies = configNchunks(1) - Nchunks_TwinFamilies = configNchunks(2) - Nchunks_SlipSlip = configNchunks(3) - Nchunks_SlipTwin = configNchunks(4) - Nchunks_TwinSlip = configNchunks(5) - Nchunks_TwinTwin = configNchunks(6) - Nchunks_nonSchmid = configNchunks(7) - case ('covera_ratio') - constitutive_phenopowerlaw_CoverA(i) = IO_floatValue(line,positions,2_pInt) - case ('c11') - constitutive_phenopowerlaw_Cslip_66(1,1,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(1,1,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c12') - constitutive_phenopowerlaw_Cslip_66(1,2,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(1,2,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c13') - constitutive_phenopowerlaw_Cslip_66(1,3,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(1,3,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c22') - constitutive_phenopowerlaw_Cslip_66(2,2,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(2,2,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c23') - constitutive_phenopowerlaw_Cslip_66(2,3,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(2,3,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c33') - constitutive_phenopowerlaw_Cslip_66(3,3,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(3,3,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c44') - constitutive_phenopowerlaw_Cslip_66(4,4,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(4,4,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c55') - constitutive_phenopowerlaw_Cslip_66(5,5,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(5,5,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('c66') - constitutive_phenopowerlaw_Cslip_66(6,6,i) = IO_floatValue(line,positions,2_pInt) - if (abs(constitutive_phenopowerlaw_Cslip_66(6,6,i)) < tol_math_check) & - call IO_error(214_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_phenopowerlaw_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('gdot0_slip') - constitutive_phenopowerlaw_gdot0_slip(i) = IO_floatValue(line,positions,2_pInt) - case ('n_slip') - constitutive_phenopowerlaw_n_slip(i) = IO_floatValue(line,positions,2_pInt) - case ('tau0_slip') - do j = 1_pInt,Nchunks_SlipFamilies - constitutive_phenopowerlaw_tau0_slip(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('tausat_slip') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_phenopowerlaw_tausat_slip(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('a_slip', 'w0_slip') - constitutive_phenopowerlaw_a_slip(i) = IO_floatValue(line,positions,2_pInt) - case ('ntwin') - if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_phenopowerlaw_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('gdot0_twin') - constitutive_phenopowerlaw_gdot0_twin(i) = IO_floatValue(line,positions,2_pInt) - case ('n_twin') - constitutive_phenopowerlaw_n_twin(i) = IO_floatValue(line,positions,2_pInt) - case ('tau0_twin') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_phenopowerlaw_tau0_twin(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('s_pr') - constitutive_phenopowerlaw_spr(i) = IO_floatValue(line,positions,2_pInt) - case ('twin_b') - constitutive_phenopowerlaw_twinB(i) = IO_floatValue(line,positions,2_pInt) - case ('twin_c') - constitutive_phenopowerlaw_twinC(i) = IO_floatValue(line,positions,2_pInt) - case ('twin_d') - constitutive_phenopowerlaw_twinD(i) = IO_floatValue(line,positions,2_pInt) - case ('twin_e') - constitutive_phenopowerlaw_twinE(i) = IO_floatValue(line,positions,2_pInt) - case ('h0_slipslip') - constitutive_phenopowerlaw_h0_SlipSlip(i) = IO_floatValue(line,positions,2_pInt) - case ('h0_sliptwin') - constitutive_phenopowerlaw_h0_SlipTwin(i) = IO_floatValue(line,positions,2_pInt) - call IO_warning(42_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - case ('h0_twinslip') - constitutive_phenopowerlaw_h0_TwinSlip(i) = IO_floatValue(line,positions,2_pInt) - case ('h0_twintwin') - constitutive_phenopowerlaw_h0_TwinTwin(i) = IO_floatValue(line,positions,2_pInt) - case ('atol_resistance') - constitutive_phenopowerlaw_aTolResistance(i) = IO_floatValue(line,positions,2_pInt) - case ('atol_shear') - constitutive_phenopowerlaw_aTolShear(i) = IO_floatValue(line,positions,2_pInt) - case ('atol_twinfrac') - constitutive_phenopowerlaw_aTolTwinfrac(i) = IO_floatValue(line,positions,2_pInt) - case ('interaction_slipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_SlipSlip - constitutive_phenopowerlaw_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_sliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_SlipTwin - constitutive_phenopowerlaw_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_TwinSlip - constitutive_phenopowerlaw_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_TwinTwin - constitutive_phenopowerlaw_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt,Nchunks_nonSchmid - constitutive_phenopowerlaw_nonSchmidCoeff(j,i) = IO_floatValue(line,positions,1_pInt+j) - enddo - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - end select - endif - endif + if (section > 0_pInt ) then; if (phase_plasticity(section) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + i = phase_plasticityInstance(section) ! which instance of my plasticity is present phase + positions = IO_stringPos(line,MAXNCHUNKS) + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + select case(tag) + case ('plasticity','elasticity','lattice_structure',& + 'c11','c12','c13','c22','c23','c33','c44','c55','c66') + case ('(output)') + constitutive_phenopowerlaw_Noutput(i) = constitutive_phenopowerlaw_Noutput(i) + 1_pInt + constitutive_phenopowerlaw_output(constitutive_phenopowerlaw_Noutput(i),i) = & + IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + case ('resistance_slip') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resistance_slip_ID + case ('accumulatedshear_slip') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = accumulatedshear_slip_ID + case ('shearrate_slip') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = shearrate_slip_ID + case ('resolvedstress_slip') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resolvedstress_slip_ID + case ('totalshear') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = totalshear_ID + case ('resistance_twin') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resistance_twin_ID + case ('accumulatedshear_twin') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = accumulatedshear_twin_ID + case ('shearrate_twin') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = shearrate_twin_ID + case ('resolvedstress_twin') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = resolvedstress_twin_ID + case ('totalvolfrac') + constitutive_phenopowerlaw_outputID(constitutive_phenopowerlaw_Noutput(i),i) = totalvolfrac_ID + case default + call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + end select + case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + Nchunks_SlipFamilies = positions(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_phenopowerlaw_Nslip(j,i) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('gdot0_slip') + constitutive_phenopowerlaw_gdot0_slip(i) = IO_floatValue(line,positions,2_pInt) + case ('n_slip') + constitutive_phenopowerlaw_n_slip(i) = IO_floatValue(line,positions,2_pInt) + case ('tau0_slip') + do j = 1_pInt,Nchunks_SlipFamilies + constitutive_phenopowerlaw_tau0_slip(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('tausat_slip') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_phenopowerlaw_tausat_slip(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('a_slip', 'w0_slip') + constitutive_phenopowerlaw_a_slip(i) = IO_floatValue(line,positions,2_pInt) + case ('ntwin') + if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + Nchunks_TwinFamilies = positions(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_phenopowerlaw_Ntwin(j,i) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('gdot0_twin') + constitutive_phenopowerlaw_gdot0_twin(i) = IO_floatValue(line,positions,2_pInt) + case ('n_twin') + constitutive_phenopowerlaw_n_twin(i) = IO_floatValue(line,positions,2_pInt) + case ('tau0_twin') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_phenopowerlaw_tau0_twin(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('s_pr') + constitutive_phenopowerlaw_spr(i) = IO_floatValue(line,positions,2_pInt) + case ('twin_b') + constitutive_phenopowerlaw_twinB(i) = IO_floatValue(line,positions,2_pInt) + case ('twin_c') + constitutive_phenopowerlaw_twinC(i) = IO_floatValue(line,positions,2_pInt) + case ('twin_d') + constitutive_phenopowerlaw_twinD(i) = IO_floatValue(line,positions,2_pInt) + case ('twin_e') + constitutive_phenopowerlaw_twinE(i) = IO_floatValue(line,positions,2_pInt) + case ('h0_slipslip') + constitutive_phenopowerlaw_h0_SlipSlip(i) = IO_floatValue(line,positions,2_pInt) + case ('h0_sliptwin') + constitutive_phenopowerlaw_h0_SlipTwin(i) = IO_floatValue(line,positions,2_pInt) + call IO_warning(42_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + case ('h0_twinslip') + constitutive_phenopowerlaw_h0_TwinSlip(i) = IO_floatValue(line,positions,2_pInt) + case ('h0_twintwin') + constitutive_phenopowerlaw_h0_TwinTwin(i) = IO_floatValue(line,positions,2_pInt) + case ('atol_resistance') + constitutive_phenopowerlaw_aTolResistance(i) = IO_floatValue(line,positions,2_pInt) + case ('atol_shear') + constitutive_phenopowerlaw_aTolShear(i) = IO_floatValue(line,positions,2_pInt) + case ('atol_twinfrac') + constitutive_phenopowerlaw_aTolTwinfrac(i) = IO_floatValue(line,positions,2_pInt) + case ('interaction_slipslip') + if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_SlipSlip + constitutive_phenopowerlaw_interaction_SlipSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_sliptwin') + if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_SlipTwin + constitutive_phenopowerlaw_interaction_SlipTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twinslip') + if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_TwinSlip + constitutive_phenopowerlaw_interaction_TwinSlip(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twintwin') + if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt, Nchunks_TwinTwin + constitutive_phenopowerlaw_interaction_TwinTwin(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('nonschmid_coefficients') + if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + do j = 1_pInt,Nchunks_nonSchmid + constitutive_phenopowerlaw_nonSchmidCoeff(j,i) = IO_floatValue(line,positions,1_pInt+j) + enddo + case default + call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') + end select + endif; endif enddo - sanityChecks: do i = 1_pInt,maxNinstance - constitutive_phenopowerlaw_structure(i) = & - lattice_initializeStructure(constitutive_phenopowerlaw_structureID(i), constitutive_phenopowerlaw_CoverA(i)) ! get structure - + sanityChecks: do i = 1_pInt,maxNinstance constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,i) = & min(lattice_NslipSystem(1:lattice_maxNslipFamily,constitutive_phenopowerlaw_structure(i)),& ! limit active slip systems per family to min of available and requested constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,i)) @@ -472,7 +415,6 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) constitutive_phenopowerlaw_totalNslip(i) = sum(constitutive_phenopowerlaw_Nslip(:,i)) ! how many slip systems altogether constitutive_phenopowerlaw_totalNtwin(i) = sum(constitutive_phenopowerlaw_Ntwin(:,i)) ! how many twin systems altogether - if (constitutive_phenopowerlaw_structure(i) < 1 ) call IO_error(205_pInt,el=i) if (any(constitutive_phenopowerlaw_tau0_slip(:,i) < 0.0_pReal .and. & constitutive_phenopowerlaw_Nslip(:,i) > 0)) call IO_error(211_pInt,el=i,ext_msg='tau0_slip (' & //PLASTICITY_PHENOPOWERLAW_label//')') @@ -556,13 +498,6 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) structID = constitutive_phenopowerlaw_structure(i) - constitutive_phenopowerlaw_Cslip_66(1:6,1:6,i) = & - lattice_symmetrizeC66(constitutive_phenopowerlaw_structureID(i),& - constitutive_phenopowerlaw_Cslip_66(:,:,i)) ! assign elasticity tensor - - constitutive_phenopowerlaw_Cslip_66(1:6,1:6,i) = & - math_Mandel3333to66(math_Voigt66to3333(constitutive_phenopowerlaw_Cslip_66(:,:,i))) - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X index_myFamily = sum(constitutive_phenopowerlaw_Nslip(1:f-1_pInt,i)) do j = 1_pInt,constitutive_phenopowerlaw_Nslip(f,i) ! loop over (active) systems in my family (slip) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 000c4426c..9e04c9233 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -189,11 +189,10 @@ subroutine crystallite_init(temperature) IO_EOF use material use lattice, only: & - lattice_symmetryType + lattice_symmetryType, & + lattice_structureID use constitutive, only: & constitutive_microstructure - use constitutive_phenopowerlaw, only: & - constitutive_phenopowerlaw_structureID use constitutive_dislotwin, only: & constitutive_dislotwin_structureID use constitutive_titanmod, only: & @@ -445,8 +444,7 @@ subroutine crystallite_init(temperature) myMat = phase_plasticityInstance(myPhase) select case (phase_plasticity(myPhase)) case (PLASTICITY_PHENOPOWERLAW_ID) - crystallite_symmetryID(g,i,e) = & - lattice_symmetryType(constitutive_phenopowerlaw_structureID(myMat)) + crystallite_symmetryID(g,i,e) = lattice_symmetryType(lattice_structureID(myPhase)) case (PLASTICITY_TITANMOD_ID) crystallite_symmetryID(g,i,e) = & lattice_symmetryType(constitutive_titanmod_structureID(myMat)) diff --git a/code/lattice.f90 b/code/lattice.f90 index 9bf6ee9e6..d4db6d4bd 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -698,6 +698,12 @@ module lattice LATTICE_hex_ID, & LATTICE_ort_ID end enum + integer(pInt), dimension(:), allocatable, public, protected :: & + lattice_structure + integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public, protected :: & + lattice_structureID + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + lattice_Cslip_66 character(len=*), parameter, public :: & LATTICE_iso_label = 'iso', & LATTICE_fcc_label = 'fcc', & @@ -725,13 +731,25 @@ contains !-------------------------------------------------------------------------------------------------- subroutine lattice_init use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + tol_math_check use IO, only: & IO_open_file,& IO_open_jobFile_stat, & IO_countSections, & IO_countTagInPart, & IO_error, & - IO_timeStamp + IO_timeStamp, & + IO_stringPos, & + IO_EOF, & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_EOF use material, only: & material_configfile, & material_localFileExt, & @@ -740,10 +758,23 @@ subroutine lattice_init debug_level, & debug_lattice, & debug_levelBasic + use math, only: & + math_Mandel3333to66, & + math_Voigt66to3333 + implicit none integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: Nsections + character(len=32) :: & + structure = '' + character(len=65536) :: & + tag = '', & + line = '' + integer(pInt), parameter :: MAXNCHUNKS = 2_pInt + integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions + integer(pInt) :: section = 0_pInt,i + real(pReal), dimension(:), allocatable :: CoverA write(6,'(/,a)') ' <<<+- lattice init -+>>>' write(6,'(a)') ' $Id$' @@ -754,40 +785,129 @@ subroutine lattice_init call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file Nsections = IO_countSections(FILEUNIT,material_partPhase) lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(FILEUNIT,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex - close(FILEUNIT) + + allocate(lattice_structure(Nsections), source=0_pInt) + allocate(lattice_structureID(Nsections), source=LATTICE_undefined_ID) + allocate(lattice_Cslip_66(6,6,Nsections),source=0.0_pReal) + allocate(CoverA(Nsections), source=0.0_pReal) + + + rewind(fileUnit) + line = '' ! to have it initialized + section = 0_pInt ! - " - + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + do while (trim(line) /= IO_EOF) ! read through sections of material part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next section + section = section + 1_pInt + endif + if (section > 0_pInt) then + positions = IO_stringPos(line,MAXNCHUNKS) + tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key + select case(tag) + case ('lattice_structure') + structure = IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(structure(1:3)) + case(LATTICE_iso_label) + lattice_structureID(section) = LATTICE_iso_ID + case(LATTICE_fcc_label) + lattice_structureID(section) = LATTICE_fcc_ID + case(LATTICE_bcc_label) + lattice_structureID(section) = LATTICE_bcc_ID + case(LATTICE_hex_label) + lattice_structureID(section) = LATTICE_hex_ID + case(LATTICE_ort_label) + lattice_structureID(section) = LATTICE_ort_ID + case default + !there should be an error here + end select + case ('c11') + lattice_Cslip_66(1,1,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C11)') + case ('c12') + lattice_Cslip_66(1,2,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C12)') + case ('c13') + lattice_Cslip_66(1,3,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C13)') + case ('c22') + lattice_Cslip_66(2,2,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C22)') + case ('c23') + lattice_Cslip_66(2,3,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C23)') + case ('c33') + lattice_Cslip_66(3,3,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C33)') + case ('c44') + lattice_Cslip_66(4,4,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C44)') + case ('c55') + lattice_Cslip_66(5,5,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C55)') + case ('c66') + lattice_Cslip_66(6,6,section) = IO_floatValue(line,positions,2_pInt) + if (abs(lattice_Cslip_66(1,1,section)) < tol_math_check) & + call IO_error(214_pInt,ext_msg=trim(tag)//' (C66)') + case ('covera_ratio') + CoverA(section) = IO_floatValue(line,positions,2_pInt) + end select + endif + enddo if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then write(6,'(a16,1x,i5)') ' # phases:',Nsections write(6,'(a16,1x,i5,/)') ' # structures:',lattice_Nstructure endif - allocate(lattice_NnonSchmid(lattice_Nstructure)); lattice_NnonSchmid = 0_pInt - allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,lattice_Nstructure)); lattice_Sslip = 0.0_pReal - allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,lattice_Nstructure)); lattice_Sslip_v = 0.0_pReal - allocate(lattice_sd(3,lattice_maxNslip,lattice_Nstructure)); lattice_sd = 0.0_pReal - allocate(lattice_st(3,lattice_maxNslip,lattice_Nstructure)); lattice_st = 0.0_pReal - allocate(lattice_sn(3,lattice_maxNslip,lattice_Nstructure)); lattice_sn = 0.0_pReal + allocate(lattice_NnonSchmid(lattice_Nstructure), source=0_pInt) + allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,lattice_Nstructure),source = 0.0_pReal) + allocate(lattice_sd(3,lattice_maxNslip,lattice_Nstructure),source=0.0_pReal) + allocate(lattice_st(3,lattice_maxNslip,lattice_Nstructure),source=0.0_pReal) + allocate(lattice_sn(3,lattice_maxNslip,lattice_Nstructure),source=0.0_pReal) - allocate(lattice_Qtwin(3,3,lattice_maxNtwin,lattice_Nstructure)); lattice_Qtwin = 0.0_pReal - allocate(lattice_Stwin(3,3,lattice_maxNtwin,lattice_Nstructure)); lattice_Stwin = 0.0_pReal - allocate(lattice_Stwin_v(6,lattice_maxNtwin,lattice_Nstructure)); lattice_Stwin_v = 0.0_pReal - allocate(lattice_td(3,lattice_maxNtwin,lattice_Nstructure)); lattice_td = 0.0_pReal - allocate(lattice_tt(3,lattice_maxNtwin,lattice_Nstructure)); lattice_tt = 0.0_pReal - allocate(lattice_tn(3,lattice_maxNtwin,lattice_Nstructure)); lattice_tn = 0.0_pReal + allocate(lattice_Qtwin(3,3,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_Stwin(3,3,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_Stwin_v(6,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_td(3,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_tt(3,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) + allocate(lattice_tn(3,lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) - allocate(lattice_shearTwin(lattice_maxNtwin,lattice_Nstructure)); lattice_shearTwin = 0.0_pReal + allocate(lattice_shearTwin(lattice_maxNtwin,lattice_Nstructure),source= 0.0_pReal) - allocate(lattice_NslipSystem(lattice_maxNslipFamily,lattice_Nstructure)); lattice_NslipSystem = 0_pInt - allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,lattice_Nstructure)); lattice_NtwinSystem = 0_pInt + allocate(lattice_NslipSystem(lattice_maxNslipFamily,lattice_Nstructure), source=0_pInt) + allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,lattice_Nstructure), source=0_pInt) - allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)) - lattice_interactionSlipSlip = 0_pInt ! other:me - allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,lattice_Nstructure)) - lattice_interactionSlipTwin = 0_pInt ! other:me - allocate(lattice_interactionTwinSlip(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure)) - lattice_interactionTwinSlip = 0_pInt ! other:me - allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,lattice_Nstructure)) - lattice_interactionTwinTwin = 0_pInt ! other:me + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure), source=0_pInt)! other:me + allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,lattice_Nstructure), source=0_pInt)! other:me + allocate(lattice_interactionTwinSlip(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure), source=0_pInt)! other:me + allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,lattice_Nstructure), source=0_pInt)! other:me + + do i = 1_pInt,Nsections + lattice_structure(i) = lattice_initializeStructure(lattice_structureID(i), CoverA(i)) ! get structure + if (lattice_structure(i) < 1_pInt) call IO_error(205_pInt,el=i) + lattice_Cslip_66(1:6,1:6,i) = lattice_symmetrizeC66(lattice_structure(i),lattice_Cslip_66(1:6,1:6,i)) + lattice_Cslip_66(1:6,1:6,i) = math_Mandel3333to66(math_Voigt66to3333(lattice_Cslip_66(1:6,1:6,i))) ! Literature data is Voigt, DAMASK uses Mandel + enddo + + deallocate(CoverA) end subroutine lattice_init