From 2b589c3d7194f60d8bf1ee923f315d28ed613652 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 8 Mar 2014 20:50:31 +0000 Subject: [PATCH] moved reading in of lattice type and elastic constants to lattice module removed structure type for hex, fcc, bcc, now defining slip/twin systems for each phase found in material.config constitutive modules will only be initialized if needed homogenizedC function is only needed for models incorporating twinning in a physical way (titanmod and dislotwin) --- code/constitutive.f90 | 55 +- code/constitutive_dislotwin.f90 | 1229 +++++++++--------- code/constitutive_j2.f90 | 56 +- code/constitutive_none.f90 | 145 +-- code/constitutive_nonlocal.f90 | 1808 +++++++++++++-------------- code/constitutive_phenopowerlaw.f90 | 464 ++++--- code/constitutive_titanmod.f90 | 1193 +++++++++--------- code/crystallite.f90 | 56 +- code/lattice.f90 | 617 ++++----- 9 files changed, 2510 insertions(+), 3113 deletions(-) diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 9c9ac833a..91e2ea6ff 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -154,12 +154,12 @@ subroutine constitutive_init ! parse plasticities from config file if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file - call constitutive_none_init(FILEUNIT) - call constitutive_j2_init(FILEUNIT) - call constitutive_phenopowerlaw_init(FILEUNIT) - call constitutive_titanmod_init(FILEUNIT) - call constitutive_dislotwin_init(FILEUNIT) - call constitutive_nonlocal_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_NONE_ID)) call constitutive_none_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_J2_ID)) call constitutive_j2_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call constitutive_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_TITANMOD_ID)) call constitutive_titanmod_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call constitutive_dislotwin_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) call constitutive_nonlocal_init(FILEUNIT) close(FILEUNIT) write(6,'(/,a)') ' <<<+- constitutive init -+>>>' @@ -352,7 +352,7 @@ subroutine constitutive_init allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_dislotwin_sizeDotState(instance))) enddo endif - constitutive_state0(g,i,e)%p = constitutive_dislotwin_stateInit(instance) + constitutive_state0(g,i,e)%p = constitutive_dislotwin_stateInit(instance,material_phase(g,i,e)) constitutive_aTolState(g,i,e)%p = constitutive_dislotwin_aTolState(instance) constitutive_sizeState(g,i,e) = constitutive_dislotwin_sizeState(instance) constitutive_sizeDotState(g,i,e) = constitutive_dislotwin_sizeDotState(instance) @@ -379,11 +379,11 @@ subroutine constitutive_init allocate(constitutive_RKCK45dotState(s,g,i,e)%p(constitutive_titanmod_sizeDotState(instance))) enddo endif - constitutive_state0(g,i,e)%p = constitutive_titanmod_stateInit(instance) - constitutive_aTolState(g,i,e)%p = constitutive_titanmod_aTolState(instance) - constitutive_sizeState(g,i,e) = constitutive_titanmod_sizeState(instance) - constitutive_sizeDotState(g,i,e) = constitutive_titanmod_sizeDotState(instance) - constitutive_sizePostResults(g,i,e) = constitutive_titanmod_sizePostResults(instance) + constitutive_state0(g,i,e)%p = constitutive_titanmod_stateInit(instance,material_phase(g,i,e)) + constitutive_aTolState(g,i,e)%p = constitutive_titanmod_aTolState(instance) + constitutive_sizeState(g,i,e) = constitutive_titanmod_sizeState(instance) + constitutive_sizeDotState(g,i,e) = constitutive_titanmod_sizeDotState(instance) + constitutive_sizePostResults(g,i,e) = constitutive_titanmod_sizePostResults(instance) case (PLASTICITY_NONLOCAL_ID) nonlocalConstitutionPresent = .true. if(myNgrains/=1_pInt) call IO_error(252_pInt, e,i,g) @@ -465,25 +465,15 @@ pure function constitutive_homogenizedC(ipc,ip,el) use material, only: & phase_plasticity, & material_phase, & - PLASTICITY_NONE_ID, & - PLASTICITY_J2_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_DISLOTWIN_ID, & PLASTICITY_TITANMOD_ID, & - PLASTICITY_NONLOCAL_ID - use constitutive_none, only: & - constitutive_none_homogenizedC - use constitutive_j2, only: & - constitutive_j2_homogenizedC - use constitutive_phenopowerlaw, only: & - constitutive_phenopowerlaw_homogenizedC + PLASTICITY_DISLOTWIN_ID use constitutive_dislotwin, only: & constitutive_dislotwin_homogenizedC use constitutive_titanmod, only: & constitutive_titanmod_homogenizedC - use constitutive_nonlocal, only: & - constitutive_nonlocal_homogenizedC - + use lattice, only: & + lattice_C66 + implicit none real(pReal), dimension(6,6) :: constitutive_homogenizedC integer(pInt), intent(in) :: & @@ -493,23 +483,14 @@ pure function constitutive_homogenizedC(ipc,ip,el) select case (phase_plasticity(material_phase(ipc,ip,el))) - case (PLASTICITY_NONE_ID) - constitutive_homogenizedC = constitutive_none_homogenizedC(ipc,ip,el) - - case (PLASTICITY_J2_ID) - constitutive_homogenizedC = constitutive_j2_homogenizedC(ipc,ip,el) - - case (PLASTICITY_PHENOPOWERLAW_ID) - constitutive_homogenizedC = constitutive_phenopowerlaw_homogenizedC(ipc,ip,el) - case (PLASTICITY_DISLOTWIN_ID) constitutive_homogenizedC = constitutive_dislotwin_homogenizedC(constitutive_state,ipc,ip,el) case (PLASTICITY_TITANMOD_ID) constitutive_homogenizedC = constitutive_titanmod_homogenizedC(constitutive_state,ipc,ip,el) - case (PLASTICITY_NONLOCAL_ID) - constitutive_homogenizedC = constitutive_nonlocal_homogenizedC(ipc,ip,el) + case default + constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase(ipc,ip,el)) end select diff --git a/code/constitutive_dislotwin.f90 b/code/constitutive_dislotwin.f90 index f595f0ce2..ed2f4834b 100644 --- a/code/constitutive_dislotwin.f90 +++ b/code/constitutive_dislotwin.f90 @@ -28,8 +28,6 @@ module constitutive_dislotwin use prec, only: & pReal, & pInt - use lattice, only: & - LATTICE_undefined_ID implicit none private @@ -38,9 +36,6 @@ module constitutive_dislotwin constitutive_dislotwin_sizeState, & !< total number of microstructural state variables constitutive_dislotwin_sizePostResults !< cumulative size of post results - integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_dislotwin_structureID !< ID of the lattice structure - integer(pInt), dimension(:,:), allocatable, target, public :: & constitutive_dislotwin_sizePostResult !< size of each post result output @@ -70,7 +65,6 @@ module constitutive_dislotwin constitutive_dislotwin_Noutput !< number of outputs per instance of this plasticity integer(pInt), dimension(:), allocatable, private :: & - constitutive_dislotwin_structure, & !< number representing the kind of lattice structure constitutive_dislotwin_totalNslip, & !< total number of active slip systems for each instance constitutive_dislotwin_totalNtwin !< total number of active twin systems for each instance @@ -79,9 +73,6 @@ module constitutive_dislotwin constitutive_dislotwin_Ntwin !< number of active twin systems for each family and instance real(pReal), dimension(:), allocatable, private :: & - constitutive_dislotwin_CoverA, & !< c/a ratio for hex type lattice - constitutive_dislotwin_Gmod, & !< shear modulus - constitutive_dislotwin_nu, & !< poisson's ratio constitutive_dislotwin_CAtomicVolume, & !< atomic volume in Bugers vector unit constitutive_dislotwin_D0, & !< prefactor for self-diffusion coefficient constitutive_dislotwin_Qsd, & !< activation energy for dislocation climb @@ -105,14 +96,8 @@ module constitutive_dislotwin constitutive_dislotwin_aTolRho, & !< absolute tolerance for integration of dislocation density constitutive_dislotwin_aTolTwinFrac !< absolute tolerance for integration of twin volume fraction - real(pReal), dimension(:,:,:), allocatable, private :: & - constitutive_dislotwin_Cslip_66 !< elasticity matrix in Mandel notation for each instance - real(pReal), dimension(:,:,:,:), allocatable, private :: & constitutive_dislotwin_Ctwin_66 !< twin elasticity matrix in Mandel notation for each instance - - real(pReal), dimension(:,:,:,:,:), allocatable, private :: & - constitutive_dislotwin_Cslip_3333 !< elasticity matrix for each instance real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & constitutive_dislotwin_Ctwin_3333 !< twin elasticity matrix for each instance @@ -171,7 +156,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 :: & @@ -192,7 +177,7 @@ contains !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- subroutine constitutive_dislotwin_init(fileUnit) - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use debug, only: & debug_level,& debug_constitutive,& @@ -232,14 +217,11 @@ subroutine constitutive_dislotwin_init(fileUnit) integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt integer(pInt), dimension(1+2*MAXNCHUNKS) :: positions - integer(pInt), dimension(7) :: configNchunks - integer(pInt) :: section = 0_pInt, maxNinstance,mySize=0_pInt,structID,maxTotalNslip,maxTotalNtwin,& + integer(pInt) :: maxNinstance,mySize=0_pInt,phase,maxTotalNslip,maxTotalNtwin,& f,instance,j,k,l,m,n,o,p,q,r,s,ns,nt, & Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & index_myFamily, index_otherFamily - character(len=32) :: & - structure = '' character(len=65536) :: & tag = '', & line = '' @@ -253,16 +235,8 @@ subroutine constitutive_dislotwin_init(fileUnit) if (maxNinstance == 0_pInt) return if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & - write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance + write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - Nchunks_SlipFamilies = lattice_maxNslipFamily - Nchunks_TwinFamilies = lattice_maxNtwinFamily - Nchunks_SlipSlip = lattice_maxNinteraction - Nchunks_SlipTwin = lattice_maxNinteraction - Nchunks_TwinSlip = lattice_maxNinteraction - Nchunks_TwinTwin = lattice_maxNinteraction - - !* Space allocation for global variables allocate(constitutive_dislotwin_sizeDotState(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_sizeState(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_sizePostResults(maxNinstance), source=0_pInt) @@ -271,15 +245,10 @@ subroutine constitutive_dislotwin_init(fileUnit) constitutive_dislotwin_output = '' allocate(constitutive_dislotwin_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) allocate(constitutive_dislotwin_Noutput(maxNinstance), source=0_pInt) - allocate(constitutive_dislotwin_structureID(maxNinstance), source=LATTICE_undefined_ID) - allocate(constitutive_dislotwin_structure(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_totalNslip(maxNinstance), source=0_pInt) allocate(constitutive_dislotwin_totalNtwin(maxNinstance), source=0_pInt) - allocate(constitutive_dislotwin_CoverA(maxNinstance), source=0.0_pReal) - allocate(constitutive_dislotwin_Gmod(maxNinstance), source=0.0_pReal) - allocate(constitutive_dislotwin_nu(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_CAtomicVolume(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_D0(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_Qsd(maxNinstance), source=0.0_pReal) @@ -297,8 +266,6 @@ subroutine constitutive_dislotwin_init(fileUnit) allocate(constitutive_dislotwin_VcrossSlip(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_aTolRho(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_aTolTwinFrac(maxNinstance), source=0.0_pReal) - allocate(constitutive_dislotwin_Cslip_66(6,6,maxNinstance), source=0.0_pReal) - allocate(constitutive_dislotwin_Cslip_3333(3,3,3,3,maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_sbResistance(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_sbVelocity(maxNinstance), source=0.0_pReal) allocate(constitutive_dislotwin_sbQedge(maxNinstance), source=0.0_pReal) @@ -333,293 +300,258 @@ subroutine constitutive_dislotwin_init(fileUnit) rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + phase = 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 phase part + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase 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 + 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 ! advance section counter - cycle ! skip to next line - endif - if (section > 0_pInt ) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran - if (phase_plasticity(section) == PLASTICITY_DISLOTWIN_ID) then ! one of my sections - instance = 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') - cycle - case ('(output)') - constitutive_dislotwin_Noutput(instance) = constitutive_dislotwin_Noutput(instance) + 1_pInt - constitutive_dislotwin_output(constitutive_dislotwin_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) - case ('edge_density') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = edge_density_ID - case ('dipole_density') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = dipole_density_ID - case ('shear_rate_slip') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_slip_ID - case ('accumulated_shear_slip') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = accumulated_shear_slip_ID - case ('mfp_slip') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = mfp_slip_ID - case ('resolved_stress_slip') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_slip_ID - case ('edge_dipole_distance') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = edge_dipole_distance_ID - case ('stress_exponent') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = stress_exponent_ID - case ('twin_fraction') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = twin_fraction_ID - case ('shear_rate_twin') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_twin_ID - case ('accumulated_shear_twin') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = accumulated_shear_twin_ID - case ('mfp_twin') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = mfp_twin_ID - case ('resolved_stress_twin') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_twin_ID - case ('threshold_stress_twin') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = threshold_stress_twin_ID - case ('resolved_stress_shearband') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_shearband_ID - case ('shear_rate_shearband') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_shearband_ID - case ('sb_eigenvalues') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = sb_eigenvalues_ID - case ('sb_eigenvectors') - constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = sb_eigenvectors_ID - case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_DISLOTWIN_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_dislotwin_structureID(instance) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_dislotwin_structureID(instance) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_dislotwin_structureID(instance) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_dislotwin_structureID(instance) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_dislotwin_structureID(instance) = LATTICE_ort_ID - end select - configNchunks = lattice_configNchunks(constitutive_dislotwin_structureID(instance)) - Nchunks_SlipFamilies = configNchunks(1) - Nchunks_TwinFamilies = configNchunks(2) - Nchunks_SlipSlip = configNchunks(3) - Nchunks_SlipTwin = configNchunks(4) - Nchunks_TwinSlip = configNchunks(5) - Nchunks_TwinTwin = configNchunks(6) - case ('covera_ratio') - constitutive_dislotwin_CoverA(instance) = IO_floatValue(line,positions,2_pInt) - case ('c11') - constitutive_dislotwin_Cslip_66(1,1,instance) = IO_floatValue(line,positions,2_pInt) - case ('c12') - constitutive_dislotwin_Cslip_66(1,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c13') - constitutive_dislotwin_Cslip_66(1,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c22') - constitutive_dislotwin_Cslip_66(2,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c23') - constitutive_dislotwin_Cslip_66(2,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c33') - constitutive_dislotwin_Cslip_66(3,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c44') - constitutive_dislotwin_Cslip_66(4,4,instance) = IO_floatValue(line,positions,2_pInt) - case ('c55') - constitutive_dislotwin_Cslip_66(5,5,instance) = IO_floatValue(line,positions,2_pInt) - case ('c66') - constitutive_dislotwin_Cslip_66(6,6,instance) = IO_floatValue(line,positions,2_pInt) - case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('ntwin') - if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - Nchunks_TwinFamilies = positions(1) - 1_pInt - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_dislotwin_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('rhoedge0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_rhoEdge0(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('rhoedgedip0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_rhoEdgeDip0(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('slipburgers') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_burgersPerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinburgers') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_dislotwin_burgersPerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('qedge') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_QedgePerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('v0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_v0PerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('ndot0') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_dislotwin_Ndot0PerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinsize') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_dislotwin_twinsizePerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('clambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_dislotwin_CLambdaSlipPerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('grainsize') - constitutive_dislotwin_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) - case ('maxtwinfraction') - constitutive_dislotwin_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) - case ('pexponent') - constitutive_dislotwin_p(instance) = IO_floatValue(line,positions,2_pInt) - case ('qexponent') - constitutive_dislotwin_q(instance) = IO_floatValue(line,positions,2_pInt) - case ('rexponent') - constitutive_dislotwin_r(instance) = IO_floatValue(line,positions,2_pInt) - case ('d0') - constitutive_dislotwin_D0(instance) = IO_floatValue(line,positions,2_pInt) - case ('qsd') - constitutive_dislotwin_Qsd(instance) = IO_floatValue(line,positions,2_pInt) - case ('atol_rho') - constitutive_dislotwin_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) - case ('atol_twinfrac') - constitutive_dislotwin_aTolTwinFrac(instance) = IO_floatValue(line,positions,2_pInt) - case ('cmfptwin') - constitutive_dislotwin_Cmfptwin(instance) = IO_floatValue(line,positions,2_pInt) - case ('cthresholdtwin') - constitutive_dislotwin_Cthresholdtwin(instance) = IO_floatValue(line,positions,2_pInt) - case ('solidsolutionstrength') - constitutive_dislotwin_SolidSolutionStrength(instance) = IO_floatValue(line,positions,2_pInt) - case ('l0') - constitutive_dislotwin_L0(instance) = IO_floatValue(line,positions,2_pInt) - case ('xc') - constitutive_dislotwin_xc(instance) = IO_floatValue(line,positions,2_pInt) - case ('vcrossslip') - constitutive_dislotwin_VcrossSlip(instance) = IO_floatValue(line,positions,2_pInt) - case ('cedgedipmindistance') - constitutive_dislotwin_CEdgeDipMinDistance(instance) = IO_floatValue(line,positions,2_pInt) - case ('catomicvolume') - constitutive_dislotwin_CAtomicVolume(instance) = IO_floatValue(line,positions,2_pInt) - case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - do j = 1_pInt, Nchunks_SlipSlip - constitutive_dislotwin_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - do j = 1_pInt, Nchunks_SlipTwin - constitutive_dislotwin_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - do j = 1_pInt, Nchunks_TwinSlip - constitutive_dislotwin_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - do j = 1_pInt, Nchunks_TwinTwin - constitutive_dislotwin_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('sfe_0k') - constitutive_dislotwin_SFE_0K(instance) = IO_floatValue(line,positions,2_pInt) - case ('dsfe_dt') - constitutive_dislotwin_dSFE_dT(instance) = IO_floatValue(line,positions,2_pInt) - case ('shearbandresistance') - constitutive_dislotwin_sbResistance(instance) = IO_floatValue(line,positions,2_pInt) - case ('shearbandvelocity') - constitutive_dislotwin_sbVelocity(instance) = IO_floatValue(line,positions,2_pInt) - case ('qedgepersbsystem') - constitutive_dislotwin_sbQedge(instance) = IO_floatValue(line,positions,2_pInt) - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') - end select + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase section + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) endif + cycle ! skip to next line endif - enddo + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_DISLOTWIN_ID) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran + instance = phase_plasticityInstance(phase) ! 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', & ! already known + 'covera_ratio','c/a_ratio','c/a', & + 'c11','c12','c13','c22','c23','c33','c44','c55','c66') + cycle + case ('(output)') + constitutive_dislotwin_Noutput(instance) = constitutive_dislotwin_Noutput(instance) + 1_pInt + constitutive_dislotwin_output(constitutive_dislotwin_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + case ('edge_density') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = edge_density_ID + case ('dipole_density') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = dipole_density_ID + case ('shear_rate_slip') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_slip_ID + case ('accumulated_shear_slip') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = accumulated_shear_slip_ID + case ('mfp_slip') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = mfp_slip_ID + case ('resolved_stress_slip') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_slip_ID + case ('edge_dipole_distance') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = edge_dipole_distance_ID + case ('stress_exponent') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = stress_exponent_ID + case ('twin_fraction') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = twin_fraction_ID + case ('shear_rate_twin') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_twin_ID + case ('accumulated_shear_twin') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = accumulated_shear_twin_ID + case ('mfp_twin') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = mfp_twin_ID + case ('resolved_stress_twin') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_twin_ID + case ('threshold_stress_twin') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = threshold_stress_twin_ID + case ('resolved_stress_shearband') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = resolved_stress_shearband_ID + case ('shear_rate_shearband') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = shear_rate_shearband_ID + case ('sb_eigenvalues') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = sb_eigenvalues_ID + case ('sb_eigenvectors') + constitutive_dislotwin_outputID(constitutive_dislotwin_Noutput(instance),instance) = sb_eigenvectors_ID + case default + call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_DISLOTWIN_label//')') + end select + case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + Nchunks_SlipFamilies = positions(1) - 1_pInt + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('ntwin') + if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + Nchunks_TwinFamilies = positions(1) - 1_pInt + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_dislotwin_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('rhoedge0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_rhoEdge0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('rhoedgedip0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_rhoEdgeDip0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('slipburgers') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_burgersPerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinburgers') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_dislotwin_burgersPerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('qedge') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_QedgePerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('v0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_v0PerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('ndot0') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_dislotwin_Ndot0PerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinsize') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_dislotwin_twinsizePerTwinFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('clambdaslip') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_dislotwin_CLambdaSlipPerSlipFamily(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('grainsize') + constitutive_dislotwin_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + case ('maxtwinfraction') + constitutive_dislotwin_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + case ('pexponent') + constitutive_dislotwin_p(instance) = IO_floatValue(line,positions,2_pInt) + case ('qexponent') + constitutive_dislotwin_q(instance) = IO_floatValue(line,positions,2_pInt) + case ('rexponent') + constitutive_dislotwin_r(instance) = IO_floatValue(line,positions,2_pInt) + case ('d0') + constitutive_dislotwin_D0(instance) = IO_floatValue(line,positions,2_pInt) + case ('qsd') + constitutive_dislotwin_Qsd(instance) = IO_floatValue(line,positions,2_pInt) + case ('atol_rho') + constitutive_dislotwin_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + case ('atol_twinfrac') + constitutive_dislotwin_aTolTwinFrac(instance) = IO_floatValue(line,positions,2_pInt) + case ('cmfptwin') + constitutive_dislotwin_Cmfptwin(instance) = IO_floatValue(line,positions,2_pInt) + case ('cthresholdtwin') + constitutive_dislotwin_Cthresholdtwin(instance) = IO_floatValue(line,positions,2_pInt) + case ('solidsolutionstrength') + constitutive_dislotwin_SolidSolutionStrength(instance) = IO_floatValue(line,positions,2_pInt) + case ('l0') + constitutive_dislotwin_L0(instance) = IO_floatValue(line,positions,2_pInt) + case ('xc') + constitutive_dislotwin_xc(instance) = IO_floatValue(line,positions,2_pInt) + case ('vcrossslip') + constitutive_dislotwin_VcrossSlip(instance) = IO_floatValue(line,positions,2_pInt) + case ('cedgedipmindistance') + constitutive_dislotwin_CEdgeDipMinDistance(instance) = IO_floatValue(line,positions,2_pInt) + case ('catomicvolume') + constitutive_dislotwin_CAtomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + case ('interaction_slipslip','interactionslipslip') + if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_SlipSlip + constitutive_dislotwin_interaction_SlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_sliptwin','interactionsliptwin') + if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_SlipTwin + constitutive_dislotwin_interaction_SlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twinslip','interactiontwinslip') + if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TwinSlip + constitutive_dislotwin_interaction_TwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twintwin','interactiontwintwin') + if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + do j = 1_pInt, Nchunks_TwinTwin + constitutive_dislotwin_interaction_TwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('sfe_0k') + constitutive_dislotwin_SFE_0K(instance) = IO_floatValue(line,positions,2_pInt) + case ('dsfe_dt') + constitutive_dislotwin_dSFE_dT(instance) = IO_floatValue(line,positions,2_pInt) + case ('shearbandresistance') + constitutive_dislotwin_sbResistance(instance) = IO_floatValue(line,positions,2_pInt) + case ('shearbandvelocity') + constitutive_dislotwin_sbVelocity(instance) = IO_floatValue(line,positions,2_pInt) + case ('qedgepersbsystem') + constitutive_dislotwin_sbQedge(instance) = IO_floatValue(line,positions,2_pInt) + case default + call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_DISLOTWIN_label//')') + end select + endif; endif + enddo parsingFile - sanityChecks: do instance = 1_pInt,maxNinstance - constitutive_dislotwin_structure(instance) = & - lattice_initializeStructure(constitutive_dislotwin_structureID(instance),constitutive_dislotwin_CoverA(instance)) - structID = constitutive_dislotwin_structure(instance) - - if (structID < 1_pInt) & - call IO_error(205_pInt,el=instance) - if (sum(constitutive_dislotwin_Nslip(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOTWIN_label//')') - if (sum(constitutive_dislotwin_Ntwin(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='Ntwin ('//PLASTICITY_DISLOTWIN_label//')') - do f = 1_pInt,lattice_maxNslipFamily - if (constitutive_dislotwin_Nslip(f,instance) > 0_pInt) then - if (constitutive_dislotwin_rhoEdge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_rhoEdgeDip0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_v0PerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOTWIN_label//')') - endif - enddo - do f = 1_pInt,lattice_maxNtwinFamily - if (constitutive_dislotwin_Ntwin(f,instance) > 0_pInt) then - if (constitutive_dislotwin_burgersPerTwinFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_Ndot0PerTwinFamily(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='ndot0 ('//PLASTICITY_DISLOTWIN_label//')') - endif - enddo - if (constitutive_dislotwin_CAtomicVolume(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_D0(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_Qsd(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_SFE_0K(instance) == 0.0_pReal .and. constitutive_dislotwin_dSFE_dT(instance) == 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='SFE ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_aTolTwinFrac(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_sbResistance(instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sbResistance ('//PLASTICITY_DISLOTWIN_label//')') - if (constitutive_dislotwin_sbVelocity(instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='sbVelocity ('//PLASTICITY_DISLOTWIN_label//')') - - !* Determine total number of active slip or twin systems - constitutive_dislotwin_Nslip(:,instance) = min(lattice_NslipSystem(:,structID),constitutive_dislotwin_Nslip(:,instance)) - constitutive_dislotwin_Ntwin(:,instance) = min(lattice_NtwinSystem(:,structID),constitutive_dislotwin_Ntwin(:,instance)) - constitutive_dislotwin_totalNslip(instance) = sum(constitutive_dislotwin_Nslip(:,instance)) - constitutive_dislotwin_totalNtwin(instance) = sum(constitutive_dislotwin_Ntwin(:,instance)) - enddo sanityChecks + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then + instance = phase_plasticityInstance(phase) + if (sum(constitutive_dislotwin_Nslip(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Nslip ('//PLASTICITY_DISLOTWIN_label//')') + if (sum(constitutive_dislotwin_Ntwin(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='Ntwin ('//PLASTICITY_DISLOTWIN_label//')') + do f = 1_pInt,lattice_maxNslipFamily + if (constitutive_dislotwin_Nslip(f,instance) > 0_pInt) then + if (constitutive_dislotwin_rhoEdge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdge0 ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_rhoEdgeDip0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rhoEdgeDip0 ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='slipBurgers ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_v0PerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0 ('//PLASTICITY_DISLOTWIN_label//')') + endif + enddo + do f = 1_pInt,lattice_maxNtwinFamily + if (constitutive_dislotwin_Ntwin(f,instance) > 0_pInt) then + if (constitutive_dislotwin_burgersPerTwinFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_Ndot0PerTwinFamily(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='ndot0 ('//PLASTICITY_DISLOTWIN_label//')') + endif + enddo + if (constitutive_dislotwin_CAtomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='cAtomicVolume ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_D0(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='D0 ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_Qsd(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_SFE_0K(instance) == 0.0_pReal .and. constitutive_dislotwin_dSFE_dT(instance) == 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='SFE ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_aTolTwinFrac(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_sbResistance(instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sbResistance ('//PLASTICITY_DISLOTWIN_label//')') + if (constitutive_dislotwin_sbVelocity(instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='sbVelocity ('//PLASTICITY_DISLOTWIN_label//')') +!-------------------------------------------------------------------------------------------------- +! Determine total number of active slip or twin systems + constitutive_dislotwin_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),constitutive_dislotwin_Nslip(:,instance)) + constitutive_dislotwin_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),constitutive_dislotwin_Ntwin(:,instance)) + constitutive_dislotwin_totalNslip(instance) = sum(constitutive_dislotwin_Nslip(:,instance)) + constitutive_dislotwin_totalNtwin(instance) = sum(constitutive_dislotwin_Ntwin(:,instance)) + endif myPhase + enddo sanityChecks !-------------------------------------------------------------------------------------------------- ! allocation of variables whose size depends on the total number of active slip systems @@ -645,25 +577,24 @@ subroutine constitutive_dislotwin_init(fileUnit) source=0.0_pReal) allocate(constitutive_dislotwin_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), & source=0.0_pReal) + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_dislotwin_ID) then + instance = phase_plasticityInstance(phase) - allocate(constitutive_dislotwin_Ctwin_66(6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(constitutive_dislotwin_Ctwin_3333(3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) - - instancesLoop: do instance = 1_pInt,maxNinstance - structID = constitutive_dislotwin_structure(instance) - - ns = constitutive_dislotwin_totalNslip(instance) - nt = constitutive_dislotwin_totalNtwin(instance) - - !* Determine size of state array - constitutive_dislotwin_sizeDotState(instance) = int(size(CONSTITUTIVE_DISLOTWIN_listBasicSlipStates),pInt) * ns & - + int(size(CONSTITUTIVE_DISLOTWIN_listBasicTwinStates),pInt) * nt - constitutive_dislotwin_sizeState(instance) = constitutive_dislotwin_sizeDotState(instance) & + ns = constitutive_dislotwin_totalNslip(instance) + nt = constitutive_dislotwin_totalNtwin(instance) + +!-------------------------------------------------------------------------------------------------- +! Determine size of state array + constitutive_dislotwin_sizeDotState(instance) = int(size(CONSTITUTIVE_DISLOTWIN_listBasicSlipStates),pInt) * ns & + + int(size(CONSTITUTIVE_DISLOTWIN_listBasicTwinStates),pInt) * nt + constitutive_dislotwin_sizeState(instance) = constitutive_dislotwin_sizeDotState(instance) & + int(size(CONSTITUTIVE_DISLOTWIN_listDependentSlipStates),pInt) * ns & + int(size(CONSTITUTIVE_DISLOTWIN_listDependentTwinStates),pInt) * nt - - !* Determine size of postResults array - outputsLoop: do o = 1_pInt,constitutive_dislotwin_Noutput(instance) + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + outputsLoop: do o = 1_pInt,constitutive_dislotwin_Noutput(instance) select case(constitutive_dislotwin_outputID(o,instance)) case(edge_density_ID, & dipole_density_ID, & @@ -675,7 +606,7 @@ subroutine constitutive_dislotwin_init(fileUnit) edge_dipole_distance_ID, & stress_exponent_ID & ) - mySize = ns + mySize = ns case(twin_fraction_ID, & shear_rate_twin_ID, & accumulated_shear_twin_ID, & @@ -683,156 +614,137 @@ subroutine constitutive_dislotwin_init(fileUnit) resolved_stress_twin_ID, & threshold_stress_twin_ID & ) - mySize = nt + mySize = nt case(resolved_stress_shearband_ID, & shear_rate_shearband_ID & ) - mySize = 6_pInt + mySize = 6_pInt case(sb_eigenvalues_ID) - mySize = 3_pInt + mySize = 3_pInt case(sb_eigenvectors_ID) - mySize = 9_pInt + mySize = 9_pInt end select - if (mySize > 0_pInt) then ! any meaningful output found - constitutive_dislotwin_sizePostResult(o,instance) = mySize - constitutive_dislotwin_sizePostResults(instance) = constitutive_dislotwin_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - - !* Elasticity matrix and shear modulus according to material.config - constitutive_dislotwin_Cslip_66(1:6,1:6,instance) = lattice_symmetrizeC66(constitutive_dislotwin_structureID(instance),& - constitutive_dislotwin_Cslip_66(:,:,instance)) - constitutive_dislotwin_Gmod(instance) = & - 0.2_pReal*(constitutive_dislotwin_Cslip_66(1,1,instance)-constitutive_dislotwin_Cslip_66(1,2,instance)) & - +0.6_pReal*constitutive_dislotwin_Cslip_66(4,4,instance) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 - constitutive_dislotwin_nu(instance) = ( constitutive_dislotwin_Cslip_66(1,1,instance) & - + 4.0_pReal*constitutive_dislotwin_Cslip_66(1,2,instance) & - - 2.0_pReal*constitutive_dislotwin_Cslip_66(1,2,instance) ) & - / ( 4.0_pReal*constitutive_dislotwin_Cslip_66(1,1,instance) & - +6.0_pReal*constitutive_dislotwin_Cslip_66(1,2,instance) & - + 2.0_pReal*constitutive_dislotwin_Cslip_66(4,4,instance) ) - constitutive_dislotwin_Cslip_66(1:6,1:6,instance) = & - math_Mandel3333to66(math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,instance))) - constitutive_dislotwin_Cslip_3333(1:3,1:3,1:3,1:3,instance) = & - math_Voigt66to3333(constitutive_dislotwin_Cslip_66(1:6,1:6,instance)) - - + if (mySize > 0_pInt) then ! any meaningful output found + constitutive_dislotwin_sizePostResult(o,instance) = mySize + constitutive_dislotwin_sizePostResults(instance) = constitutive_dislotwin_sizePostResults(instance) + mySize + endif + enddo outputsLoop + !* Process slip related parameters ------------------------------------------------ - slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list - slipSystemsLoop: do j = 1_pInt,constitutive_dislotwin_Nslip(f,instance) + slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(constitutive_dislotwin_Nslip(1:f-1_pInt,instance)) ! index in truncated slip system list + slipSystemsLoop: do j = 1_pInt,constitutive_dislotwin_Nslip(f,instance) !* Burgers vector, ! dislocation velocity prefactor, ! mean free path prefactor, ! and minimum dipole distance - constitutive_dislotwin_burgersPerSlipSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_burgersPerSlipFamily(f,instance) - - constitutive_dislotwin_QedgePerSlipSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_QedgePerSlipFamily(f,instance) - - constitutive_dislotwin_v0PerSlipSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_v0PerSlipFamily(f,instance) - - constitutive_dislotwin_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_CLambdaSlipPerSlipFamily(f,instance) + constitutive_dislotwin_burgersPerSlipSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_burgersPerSlipFamily(f,instance) - !* Calculation of forest projections for edge dislocations - !* Interaction matrices + constitutive_dislotwin_QedgePerSlipSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_QedgePerSlipFamily(f,instance) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) - constitutive_dislotwin_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & - abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,structID))+j,structID), & - lattice_st(:,sum(lattice_NslipSystem(1:o-1,structID))+k,structID))) - constitutive_dislotwin_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_dislotwin_interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,structID))+j, & - sum(lattice_NslipSystem(1:o-1,structID))+k, & - structID), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - constitutive_dislotwin_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_dislotwin_interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo - - enddo slipSystemsLoop - enddo slipFamiliesLoop + constitutive_dislotwin_v0PerSlipSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_v0PerSlipFamily(f,instance) + constitutive_dislotwin_CLambdaSlipPerSlipSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_CLambdaSlipPerSlipFamily(f,instance) + + !* Calculation of forest projections for edge dislocations + !* Interaction matrices + + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) + constitutive_dislotwin_forestProjectionEdge(index_myFamily+j,index_otherFamily+k,instance) = & + abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,phase))+j,phase), & + lattice_st(:,sum(lattice_NslipSystem(1:o-1,phase))+k,phase))) + constitutive_dislotwin_interactionMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_dislotwin_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + constitutive_dislotwin_interactionMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_dislotwin_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo slipSystemsLoop + enddo slipFamiliesLoop + !* Process twin related parameters ------------------------------------------------ - twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(constitutive_dislotwin_Ntwin(1:f-1_pInt,instance)) ! index in truncated twin system list - twinSystemsLoop: do j = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) + twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily + index_myFamily = sum(constitutive_dislotwin_Ntwin(1:f-1_pInt,instance)) ! index in truncated twin system list + twinSystemsLoop: do j = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) - !* Burgers vector, - ! nucleation rate prefactor, - ! and twin size + !* Burgers vector, + ! nucleation rate prefactor, + ! and twin size - constitutive_dislotwin_burgersPerTwinSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_burgersPerTwinFamily(f,instance) + constitutive_dislotwin_burgersPerTwinSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_burgersPerTwinFamily(f,instance) - constitutive_dislotwin_Ndot0PerTwinSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_Ndot0PerTwinFamily(f,instance) + constitutive_dislotwin_Ndot0PerTwinSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_Ndot0PerTwinFamily(f,instance) - constitutive_dislotwin_twinsizePerTwinSystem(index_myFamily+j,instance) = & - constitutive_dislotwin_twinsizePerTwinFamily(f,instance) + constitutive_dislotwin_twinsizePerTwinSystem(index_myFamily+j,instance) = & + constitutive_dislotwin_twinsizePerTwinFamily(f,instance) - !* Rotate twin elasticity matrices + !* Rotate twin elasticity matrices - index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! index in full lattice twin list - do l = 1_pInt,3_pInt ; do m = 1_pInt,3_pInt ; do n = 1_pInt,3_pInt ; do o = 1_pInt,3_pInt - do p = 1_pInt,3_pInt ; do q = 1_pInt,3_pInt ; do r = 1_pInt,3_pInt ; do s = 1_pInt,3_pInt - constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,instance) = & - constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,instance) + & - constitutive_dislotwin_Cslip_3333(p,q,r,s,instance) * & - lattice_Qtwin(l,p,index_otherFamily+j,structID) * & - lattice_Qtwin(m,q,index_otherFamily+j,structID) * & - lattice_Qtwin(n,r,index_otherFamily+j,structID) * & - lattice_Qtwin(o,s,index_otherFamily+j,structID) - enddo ; enddo ; enddo ; enddo - enddo ; enddo ; enddo ; enddo - constitutive_dislotwin_Ctwin_66(1:6,1:6,index_myFamily+j,instance) = & - math_Mandel3333to66(constitutive_dislotwin_Ctwin_3333(1:3,1:3,1:3,1:3,index_myFamily+j,instance)) + index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! index in full lattice twin list + do l = 1_pInt,3_pInt ; do m = 1_pInt,3_pInt ; do n = 1_pInt,3_pInt ; do o = 1_pInt,3_pInt + do p = 1_pInt,3_pInt ; do q = 1_pInt,3_pInt ; do r = 1_pInt,3_pInt ; do s = 1_pInt,3_pInt + constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,instance) = & + constitutive_dislotwin_Ctwin_3333(l,m,n,o,index_myFamily+j,instance) + & + lattice_C3333(p,q,r,s,instance) * & + lattice_Qtwin(l,p,index_otherFamily+j,phase) * & + lattice_Qtwin(m,q,index_otherFamily+j,phase) * & + lattice_Qtwin(n,r,index_otherFamily+j,phase) * & + lattice_Qtwin(o,s,index_otherFamily+j,phase) + enddo ; enddo ; enddo ; enddo + enddo ; enddo ; enddo ; enddo + constitutive_dislotwin_Ctwin_66(1:6,1:6,index_myFamily+j,instance) = & + math_Mandel3333to66(constitutive_dislotwin_Ctwin_3333(1:3,1:3,1:3,1:3,index_myFamily+j,instance)) - !* Interaction matrices + !* Interaction matrices + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) + constitutive_dislotwin_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_dislotwin_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(constitutive_dislotwin_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_dislotwin_Nslip(o,instance) ! loop over (active) systems in other family (slip) - constitutive_dislotwin_interactionMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_dislotwin_interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + constitutive_dislotwin_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_dislotwin_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(constitutive_dislotwin_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_dislotwin_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - constitutive_dislotwin_interactionMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_dislotwin_interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo + enddo twinSystemsLoop + enddo twinFamiliesLoop + endif - enddo twinSystemsLoop - enddo twinFamiliesLoop - - enddo instancesLoop + enddo initializeInstances end subroutine constitutive_dislotwin_init @@ -840,15 +752,16 @@ end subroutine constitutive_dislotwin_init !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -function constitutive_dislotwin_stateInit(instance) +function constitutive_dislotwin_stateInit(instance,phase) use math, only: & pi use lattice, only: & - lattice_maxNslipFamily + lattice_maxNslipFamily, & + lattice_mu implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - + integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity real(pReal), dimension(constitutive_dislotwin_sizeState(instance)) :: & constitutive_dislotwin_stateInit @@ -895,7 +808,7 @@ function constitutive_dislotwin_stateInit(instance) forall (i = 1_pInt:ns) & tauSlipThreshold0(i) = constitutive_dislotwin_SolidSolutionStrength(instance) + & - constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerSlipSystem(i,instance) * & + lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(i,instance) * & sqrt(dot_product((rhoEdge0+rhoEdgeDip0),constitutive_dislotwin_interactionMatrix_SlipSlip(i,1:ns,instance))) constitutive_dislotwin_stateInit(6_pInt*ns+4_pInt*nt+1:7_pInt*ns+4_pInt*nt) = tauSlipThreshold0 @@ -960,22 +873,25 @@ pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) homogenization_maxNgrains, & material_phase, & phase_plasticityInstance + use lattice, only: & + lattice_C66 implicit none real(pReal), dimension(6,6) :: & constitutive_dislotwin_homogenizedC integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - state !< microstructure state + state !< microstructure state - integer(pInt) :: instance,ns,nt,i + integer(pInt) :: instance,ns,nt,i,phase real(pReal) :: sumf !* Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) @@ -983,10 +899,10 @@ pure function constitutive_dislotwin_homogenizedC(state,ipc,ip,el) sumf = sum(state(ipc,ip,el)%p((3_pInt*ns+1_pInt):(3_pInt*ns+nt))) ! safe for nt == 0 !* Homogenized elasticity matrix - constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*constitutive_dislotwin_Cslip_66(1:6,1:6,instance) + constitutive_dislotwin_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,phase) do i=1_pInt,nt constitutive_dislotwin_homogenizedC = & - constitutive_dislotwin_homogenizedC + state(ipc,ip,el)%p(3_pInt*ns+i)*constitutive_dislotwin_Ctwin_66(1:6,1:6,i,instance) + constitutive_dislotwin_homogenizedC + state(ipc,ip,el)%p(3_pInt*ns+i)*lattice_C66(1:6,1:6,phase) enddo end function constitutive_dislotwin_homogenizedC @@ -1006,6 +922,9 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) homogenization_maxNgrains, & material_phase, & phase_plasticityInstance + use lattice, only: & + lattice_mu, & + lattice_nu implicit none integer(pInt), intent(in) :: & @@ -1018,15 +937,15 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) state !< microstructure state integer(pInt) :: & - instance,structID,& + instance,phase,& ns,nt,s,t real(pReal) :: & sumf,sfe,x0 real(pReal), dimension(constitutive_dislotwin_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: fOverStacksize !* Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_dislotwin_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) !* State: 1 : ns rho_edge @@ -1099,7 +1018,7 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) !* threshold stress for dislocation motion forall (s = 1_pInt:ns) & state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+s) = constitutive_dislotwin_SolidSolutionStrength(instance)+ & - constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerSlipSystem(s,instance)*& + lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(s,instance)*& sqrt(dot_product((state(ipc,ip,el)%p(1:ns)+state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),& constitutive_dislotwin_interactionMatrix_SlipSlip(s,1:ns,instance))) @@ -1108,7 +1027,7 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) state(ipc,ip,el)%p(7_pInt*ns+4_pInt*nt+t) = & constitutive_dislotwin_Cthresholdtwin(instance)*& (sfe/(3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance))+& - 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance)*constitutive_dislotwin_Gmod(instance)/& + 3.0_pReal*constitutive_dislotwin_burgersPerTwinSystem(t,instance)*lattice_mu(phase)/& (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(t,instance))) !* final twin volume after growth @@ -1118,10 +1037,10 @@ subroutine constitutive_dislotwin_microstructure(temperature,state,ipc,ip,el) !* equilibrium seperation of partial dislocations do t = 1_pInt,nt - x0 = constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& - (sfe*8.0_pReal*pi)*(2.0_pReal+constitutive_dislotwin_nu(instance))/(1.0_pReal-constitutive_dislotwin_nu(instance)) + x0 = lattice_mu(phase)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)**(2.0_pReal)/& + (sfe*8.0_pReal*pi)*(2.0_pReal+lattice_nu(phase))/(1.0_pReal-lattice_nu(phase)) constitutive_dislotwin_tau_r(t,instance)= & - constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& + lattice_mu(phase)*constitutive_dislotwin_burgersPerTwinSystem(t,instance)/(2.0_pReal*pi)*& (1/(x0+constitutive_dislotwin_xc(instance))+cos(pi/3.0_pReal)/x0) enddo @@ -1159,7 +1078,8 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin, & - lattice_fcc_corellationTwinSlip, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & LATTICE_fcc_ID implicit none @@ -1170,7 +1090,7 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat real(pReal), dimension(3,3), intent(out) :: Lp real(pReal), dimension(9,9), intent(out) :: dLp_dTstar - integer(pInt) :: instance,structID,ns,nt,f,i,j,k,l,m,n,index_myFamily,s1,s2 + integer(pInt) :: instance,phase,ns,nt,f,i,j,k,l,m,n,index_myFamily,s1,s2 real(pReal) :: sumf,StressRatio_p,StressRatio_pminus1,StressRatio_r,BoltzmannRatio,DotGamma0,Ndot0 real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & @@ -1202,8 +1122,8 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat logical error !* Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_dislotwin_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) @@ -1219,13 +1139,13 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat dgdot_dtauslip = 0.0_pReal j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family slipSystemsLoop: do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) !* Stress ratios StressRatio_p = (abs(tau_slip(j))/state(ipc,ip,el)%p(6*ns+4*nt+j))**constitutive_dislotwin_p(instance) @@ -1249,14 +1169,14 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat StressRatio_pminus1*(1-StressRatio_p)**(constitutive_dislotwin_q(instance)-1.0_pReal) !* Plastic velocity gradient for dislocation glide - Lp = Lp + gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,structID) + Lp = Lp + gdot_slip(j)*lattice_Sslip(:,:,1,index_myFamily+i,phase) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,structID)*& - lattice_Sslip(m,n,1,index_myFamily+i,structID) + lattice_Sslip(k,l,1,index_myFamily+i,phase)*& + lattice_Sslip(m,n,1,index_myFamily+i,phase) enddo slipSystemsLoop enddo slipFamiliesLoop @@ -1312,23 +1232,23 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat dgdot_dtautwin = 0.0_pReal j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family twinSystemsLoop: do i = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) !* Stress ratios StressRatio_r = (state(ipc,ip,el)%p(7*ns+4*nt+j)/tau_twin(j))**constitutive_dislotwin_r(instance) !* Shear rates and their derivatives due to twin if ( tau_twin(j) > 0.0_pReal ) then - select case(constitutive_dislotwin_structureID(instance)) + select case(lattice_structure(phase)) case (LATTICE_fcc_ID) - s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i) - s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) if (tau_twin(j) < constitutive_dislotwin_tau_r(j,instance)) then Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+& abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/& @@ -1342,20 +1262,20 @@ subroutine constitutive_dislotwin_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperat Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) end select gdot_twin(j) = & - (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*& + (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& state(ipc,ip,el)%p(7*ns+5*nt+j)*Ndot0*exp(-StressRatio_r) dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_dislotwin_r(instance))/tau_twin(j))*StressRatio_r endif !* Plastic velocity gradient for mechanical twinning - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID) + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& - lattice_Stwin(k,l,index_myFamily+i,structID)*& - lattice_Stwin(m,n,index_myFamily+i,structID) + lattice_Stwin(k,l,index_myFamily+i,phase)*& + lattice_Stwin(m,n,index_myFamily+i,phase) enddo twinSystemsLoop enddo twinFamiliesLoop @@ -1387,7 +1307,9 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e lattice_NslipSystem, & lattice_NtwinSystem, & lattice_sheartwin, & - lattice_fcc_corellationTwinSlip, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & LATTICE_fcc_ID implicit none @@ -1404,8 +1326,8 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e real(pReal), dimension(constitutive_dislotwin_sizeDotState(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & constitutive_dislotwin_dotState - integer(pInt) instance,structID,ns,nt,f,i,j,index_myFamily,s1,s2 - real(pReal) sumf,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,& + integer(pInt) :: instance,phase,ns,nt,f,i,j,index_myFamily,s1,s2 + real(pReal) :: sumf,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,& EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r,Ndot0 real(pReal), dimension(constitutive_dislotwin_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_slip,tau_slip,DotRhoMultiplication,EdgeDipDistance,DotRhoEdgeEdgeAnnihilation,DotRhoEdgeDipAnnihilation,& @@ -1414,8 +1336,8 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e tau_twin !* Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_dislotwin_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) @@ -1428,129 +1350,126 @@ pure function constitutive_dislotwin_dotState(Tstar_v,Temperature,state,ipc,ip,e gdot_slip = 0.0_pReal j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family - j = j+1_pInt + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j+1_pInt - !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) - !* Stress ratios - StressRatio_p = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& - constitutive_dislotwin_p(instance) - StressRatio_pminus1 = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& - (constitutive_dislotwin_p(instance)-1.0_pReal) - !* Boltzmann ratio - BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) - !* Initial shear rates - DotGamma0 = & - state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& - constitutive_dislotwin_v0PerSlipSystem(j,instance) + !* Resolved shear stress on slip system + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + !* Stress ratios + StressRatio_p = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& + constitutive_dislotwin_p(instance) + StressRatio_pminus1 = (abs(tau_slip(j))/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& + (constitutive_dislotwin_p(instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)*& + constitutive_dislotwin_v0PerSlipSystem(j,instance) - !* Shear rates due to slip - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(instance))*& - sign(1.0_pReal,tau_slip(j)) + !* Shear rates due to slip + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**constitutive_dislotwin_q(instance))*& + sign(1.0_pReal,tau_slip(j)) - !* Multiplication - DotRhoMultiplication(j) = abs(gdot_slip(j))/& - (constitutive_dislotwin_burgersPerSlipSystem(j,instance)*state(ipc,ip,el)%p(5*ns+3*nt+j)) + !* Multiplication + DotRhoMultiplication(j) = abs(gdot_slip(j))/& + (constitutive_dislotwin_burgersPerSlipSystem(j,instance)*state(ipc,ip,el)%p(5*ns+3*nt+j)) - !* Dipole formation - EdgeDipMinDistance = & - constitutive_dislotwin_CEdgeDipMinDistance(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance) - if (tau_slip(j) == 0.0_pReal) then - DotRhoDipFormation(j) = 0.0_pReal - else - EdgeDipDistance(j) = & - (3.0_pReal*constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(tau_slip(j))) - if (EdgeDipDistance(j)>state(ipc,ip,el)%p(5*ns+3*nt+j)) EdgeDipDistance(j)=state(ipc,ip,el)%p(5*ns+3*nt+j) - if (EdgeDipDistance(j)state(ipc,ip,el)%p(5*ns+3*nt+j)) EdgeDipDistance(j)=state(ipc,ip,el)%p(5*ns+3*nt+j) + if (EdgeDipDistance(j) 0.0_pReal ) then - select case(constitutive_dislotwin_structureID(instance)) - case (LATTICE_fcc_ID) - s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i) - s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i) - if (tau_twin(j) < constitutive_dislotwin_tau_r(j,instance)) then - Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+& - abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/& - (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))*& - (1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& - (constitutive_dislotwin_tau_r(j,instance)-tau_twin(j)))) - else - Ndot0=0.0_pReal - end if - case default - Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) - end select - constitutive_dislotwin_dotState(3_pInt*ns+j) = & - (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*& - state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r) - - !* Dotstate for accumulated shear due to twin - constitutive_dislotwin_dotstate(3_pInt*ns+nt+j) = constitutive_dislotwin_dotState(3_pInt*ns+j) * & - lattice_sheartwin(index_myfamily+i,structID) - - endif - - enddo + !* Shear rates and their derivatives due to twin + if ( tau_twin(j) > 0.0_pReal ) then + select case(lattice_structure(phase)) + case (LATTICE_fcc_ID) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) + if (tau_twin(j) < constitutive_dislotwin_tau_r(j,instance)) then + Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+& + abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/& + (constitutive_dislotwin_L0(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))*& + (1.0_pReal-exp(-constitutive_dislotwin_VcrossSlip(instance)/(kB*Temperature)*& + (constitutive_dislotwin_tau_r(j,instance)-tau_twin(j)))) + else + Ndot0=0.0_pReal + end if + case default + Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) + end select + constitutive_dislotwin_dotState(3_pInt*ns+j) = & + (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*& + state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r) + !* Dotstate for accumulated shear due to twin + constitutive_dislotwin_dotstate(3_pInt*ns+nt+j) = constitutive_dislotwin_dotState(3_pInt*ns+j) * & + lattice_sheartwin(index_myfamily+i,phase) + endif + enddo enddo end function constitutive_dislotwin_dotState @@ -1582,7 +1501,9 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) lattice_NslipSystem, & lattice_NtwinSystem, & lattice_shearTwin, & - lattice_fcc_corellationTwinSlip, & + lattice_mu, & + lattice_structure, & + lattice_fcc_twinNucleationSlipPair, & LATTICE_fcc_ID implicit none @@ -1601,7 +1522,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) constitutive_dislotwin_postResults integer(pInt) :: & - instance,structID,& + instance,phase,& ns,nt,& f,o,i,c,j,index_myFamily,& s1,s2 @@ -1613,8 +1534,8 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) logical :: error !* Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_dislotwin_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_dislotwin_totalNslip(instance) nt = constitutive_dislotwin_totalNtwin(instance) @@ -1640,12 +1561,12 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) case (shear_rate_slip_ID) j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) !* Stress ratios StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& constitutive_dislotwin_p(instance) @@ -1675,11 +1596,11 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) case (resolved_stress_slip_ID) j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_dislotwin_postResults(c+j) =& - dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) enddo; enddo c = c + ns case (threshold_stress_slip_ID) @@ -1689,12 +1610,12 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) case (edge_dipole_distance_ID) j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_dislotwin_postResults(c+j) = & - (3.0_pReal*constitutive_dislotwin_Gmod(instance)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& - (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)))) + (3.0_pReal*lattice_mu(phase)*constitutive_dislotwin_burgersPerSlipSystem(j,instance))/& + (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)))) constitutive_dislotwin_postResults(c+j) = min(constitutive_dislotwin_postResults(c+j),state(ipc,ip,el)%p(5*ns+3*nt+j)) ! constitutive_dislotwin_postResults(c+j) = max(constitutive_dislotwin_postResults(c+j),state(ipc,ip,el)%p(4*ns+2*nt+j)) enddo; enddo @@ -1730,12 +1651,12 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) !* Stress ratios StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(5_pInt*ns+3_pInt*nt+j))**& constitutive_dislotwin_p(instance) @@ -1755,21 +1676,21 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) j = 0_pInt do f = 1_pInt,lattice_maxNtwinFamily ! loop over all twin families - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt !* Resolved shear stress on twin system - tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID)) + tau = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) !* Stress ratios StressRatio_r = (state(ipc,ip,el)%p(7_pInt*ns+4_pInt*nt+j)/tau)**constitutive_dislotwin_r(instance) !* Shear rates due to twin if ( tau > 0.0_pReal ) then - select case(constitutive_dislotwin_structureID(instance)) + select case(lattice_structure(phase)) case (LATTICE_fcc_ID) - s1=lattice_fcc_corellationTwinSlip(1,index_myFamily+i) - s2=lattice_fcc_corellationTwinSlip(2,index_myFamily+i) + s1=lattice_fcc_twinNucleationSlipPair(1,index_myFamily+i) + s2=lattice_fcc_twinNucleationSlipPair(2,index_myFamily+i) if (tau < constitutive_dislotwin_tau_r(j,instance)) then Ndot0=(abs(gdot_slip(s1))*(state(ipc,ip,el)%p(s2)+state(ipc,ip,el)%p(ns+s2))+& abs(gdot_slip(s2))*(state(ipc,ip,el)%p(s1)+state(ipc,ip,el)%p(ns+s1)))/& @@ -1784,7 +1705,7 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) Ndot0=constitutive_dislotwin_Ndot0PerTwinSystem(j,instance) end select constitutive_dislotwin_postResults(c+j) = & - (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*& + (constitutive_dislotwin_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& state(ipc,ip,el)%p(7_pInt*ns+5_pInt*nt+j)*Ndot0*exp(-StressRatio_r) endif @@ -1801,10 +1722,10 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) if (nt > 0_pInt) then j = 0_pInt do f = 1_pInt,lattice_maxNtwinFamily ! loop over all slip families - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_dislotwin_Ntwin(f,instance) ! process each (active) slip system in family j = j + 1_pInt - constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID)) + constitutive_dislotwin_postResults(c+j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) enddo; enddo endif c = c + nt @@ -1814,42 +1735,42 @@ function constitutive_dislotwin_postResults(Tstar_v,Temperature,state,ipc,ip,el) case (stress_exponent_ID) j = 0_pInt do f = 1_pInt,lattice_maxNslipFamily ! loop over all slip families - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family - j = j + 1_pInt + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_dislotwin_Nslip(f,instance) ! process each (active) slip system in family + j = j + 1_pInt - !* Resolved shear stress on slip system - tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) - !* Stress ratios - StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& - constitutive_dislotwin_p(instance) - StressRatio_pminus1 = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& - (constitutive_dislotwin_p(instance)-1.0_pReal) - !* Boltzmann ratio - BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) - !* Initial shear rates - DotGamma0 = & - state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & - constitutive_dislotwin_v0PerSlipSystem(j,instance) + !* Resolved shear stress on slip system + tau = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + !* Stress ratios + StressRatio_p = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& + constitutive_dislotwin_p(instance) + StressRatio_pminus1 = (abs(tau)/state(ipc,ip,el)%p(6_pInt*ns+4_pInt*nt+j))**& + (constitutive_dislotwin_p(instance)-1.0_pReal) + !* Boltzmann ratio + BoltzmannRatio = constitutive_dislotwin_QedgePerSlipSystem(j,instance)/(kB*Temperature) + !* Initial shear rates + DotGamma0 = & + state(ipc,ip,el)%p(j)*constitutive_dislotwin_burgersPerSlipSystem(j,instance)* & + constitutive_dislotwin_v0PerSlipSystem(j,instance) - !* Shear rates due to slip - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - constitutive_dislotwin_q(instance))*sign(1.0_pReal,tau) + !* Shear rates due to slip + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + constitutive_dislotwin_q(instance))*sign(1.0_pReal,tau) - !* Derivatives of shear rates - dgdot_dtauslip = & - ((abs(gdot_slip(j))*BoltzmannRatio*& - constitutive_dislotwin_p(instance)*constitutive_dislotwin_q(instance))/state(ipc,ip,el)%p(6*ns+4*nt+j))*& - StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(instance)-1.0_pReal) + !* Derivatives of shear rates + dgdot_dtauslip = & + ((abs(gdot_slip(j))*BoltzmannRatio*& + constitutive_dislotwin_p(instance)*constitutive_dislotwin_q(instance))/state(ipc,ip,el)%p(6*ns+4*nt+j))*& + StressRatio_pminus1*(1_pInt-StressRatio_p)**(constitutive_dislotwin_q(instance)-1.0_pReal) - !* Stress exponent - if (gdot_slip(j)==0.0_pReal) then - constitutive_dislotwin_postResults(c+j) = 0.0_pReal - else - constitutive_dislotwin_postResults(c+j) = (tau/gdot_slip(j))*dgdot_dtauslip - endif - enddo ; enddo - c = c + ns + !* Stress exponent + if (gdot_slip(j)==0.0_pReal) then + constitutive_dislotwin_postResults(c+j) = 0.0_pReal + else + constitutive_dislotwin_postResults(c+j) = (tau/gdot_slip(j))*dgdot_dtauslip + endif + enddo ; enddo + c = c + ns case (sb_eigenvalues_ID) forall (j = 1_pInt:3_pInt) & constitutive_dislotwin_postResults(c+j) = eigValues(j) diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index dec517f9b..255e5da51 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -66,8 +66,6 @@ module constitutive_j2 constitutive_j2_tausat_SinhFitC, & !< fitting parameter for normalized strain rate vs. stress function constitutive_j2_tausat_SinhFitD !< fitting parameter for normalized strain rate vs. stress function - real(pReal), dimension(:,:,:), allocatable, private :: & - constitutive_j2_Cslip_66 enum, bind(c) enumerator :: undefined_ID, & flowstress_ID, & @@ -80,7 +78,6 @@ module constitutive_j2 constitutive_j2_init, & constitutive_j2_stateInit, & constitutive_j2_aTolState, & - constitutive_j2_homogenizedC, & constitutive_j2_LpAndItsTangent, & constitutive_j2_dotState, & constitutive_j2_postResults @@ -128,7 +125,7 @@ subroutine constitutive_j2_init(fileUnit) integer(pInt), parameter :: MAXNCHUNKS = 7_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt) :: section = 0_pInt, maxNinstance, instance,o, mySize + integer(pInt) :: phase, maxNinstance, instance,o, mySize character(len=65536) :: & tag = '', & line = '' @@ -152,7 +149,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_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) allocate(constitutive_j2_gdot0(maxNinstance), source=0.0_pReal) @@ -168,11 +164,12 @@ subroutine constitutive_j2_init(fileUnit) allocate(constitutive_j2_tausat_SinhFitD(maxNinstance), source=0.0_pReal) rewind(fileUnit) + phase = 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 phase part + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') then ! stop at next part @@ -180,19 +177,19 @@ subroutine constitutive_j2_init(fileUnit) exit endif if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt ! advance section counter - if (phase_plasticity(section) == PLASTICITY_J2_ID) then - instance = phase_plasticityInstance(section) - constitutive_j2_Cslip_66(1:6,1:6,instance) = lattice_Cslip_66(1:6,1:6,section) + phase = phase + 1_pInt ! advance section counter + if (phase_plasticity(phase) == PLASTICITY_J2_ID) then + instance = phase_plasticityInstance(phase) endif cycle ! skip to next line 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 - instance = phase_plasticityInstance(section) ! which instance of my plasticity is present phase + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_J2_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! 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','covera_ratio',& + case ('plasticity','elasticity','lattice_structure', & + 'covera_ratio','c/a_ratio','c/a', & 'c11','c12','c13','c22','c23','c33','c44','c55','c66') case ('(output)') constitutive_j2_Noutput(instance) = constitutive_j2_Noutput(instance) + 1_pInt @@ -250,7 +247,7 @@ subroutine constitutive_j2_init(fileUnit) call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_J2_label//')') end select endif; endif - enddo + enddo parsingFile instancesLoop: do instance = 1_pInt,maxNinstance outputsLoop: do o = 1_pInt,constitutive_j2_Noutput(instance) @@ -292,42 +289,15 @@ end function constitutive_j2_stateInit pure function constitutive_j2_aTolState(instance) implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity + real(pReal), dimension(1) :: constitutive_j2_aTolState + integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - real(pReal), dimension(constitutive_j2_sizeState(instance)) :: & - constitutive_j2_aTolState constitutive_j2_aTolState = constitutive_j2_aTolResistance(instance) end function constitutive_j2_aTolState -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -pure function constitutive_j2_homogenizedC(ipc,ip,el) - use mesh, only: & - mesh_NcpElems, & - mesh_maxNips - use material, only: & - homogenization_maxNgrains,& - material_phase, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6,6) :: & - constitutive_j2_homogenizedC - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - constitutive_j2_homogenizedC = constitutive_j2_Cslip_66(1:6,1:6,& - phase_plasticityInstance(material_phase(ipc,ip,el))) - -end function constitutive_j2_homogenizedC - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90 index 04d31372f..2ca0786db 100644 --- a/code/constitutive_none.f90 +++ b/code/constitutive_none.f90 @@ -25,11 +25,8 @@ !-------------------------------------------------------------------------------------------------- module constitutive_none use prec, only: & - pReal, & pInt - use lattice, only: & - LATTICE_undefined_ID - + implicit none private integer(pInt), dimension(:), allocatable, public, protected :: & @@ -40,15 +37,8 @@ module constitutive_none integer(pInt), dimension(:,:), allocatable, target, public :: & constitutive_none_sizePostResult !< size of each post result output - integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_none_structureID !< ID of the lattice structure - - real(pReal), dimension(:,:,:), allocatable, private :: & - constitutive_none_Cslip_66 - public :: & - constitutive_none_init, & - constitutive_none_homogenizedC + constitutive_none_init contains @@ -63,43 +53,21 @@ subroutine constitutive_none_init(fileUnit) debug_level, & debug_constitutive, & debug_levelBasic - use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333 use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp + use material, only: & - homogenization_maxNgrains, & phase_plasticity, & - phase_plasticityInstance, & phase_Noutput, & PLASTICITY_NONE_label, & PLASTICITY_NONE_ID, & MATERIAL_partPhase - use lattice - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), parameter :: MAXNCHUNKS = 7_pInt - integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt) :: section = 0_pInt, maxNinstance, instance - character(len=32) :: & - structure = '' - character(len=65536) :: & - tag = '', & - line = '' + integer(pInt), intent(in) :: fileUnit + integer(pInt) :: maxNinstance + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' write(6,'(a)') ' $Id$' @@ -115,106 +83,7 @@ subroutine constitutive_none_init(fileUnit) allocate(constitutive_none_sizeDotState(maxNinstance), source=1_pInt) allocate(constitutive_none_sizeState(maxNinstance), source=1_pInt) allocate(constitutive_none_sizePostResults(maxNinstance), source=0_pInt) - allocate(constitutive_none_structureID(maxNinstance), source=LATTICE_undefined_ID) - allocate(constitutive_none_Cslip_66(6,6,maxNinstance), source=0.0_pReal) - - rewind(fileUnit) - 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 phase 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 ! advance section counter - 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_NONE_ID) then ! one of my sections - instance = 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','covera_ratio') - case ('lattice_structure') - structure = IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(structure(1:3)) - case(LATTICE_iso_label) - constitutive_none_structureID(instance) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_none_structureID(instance) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_none_structureID(instance) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_none_structureID(instance) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_none_structureID(instance) = LATTICE_ort_ID - end select - case ('c11') - constitutive_none_Cslip_66(1,1,instance) = IO_floatValue(line,positions,2_pInt) - case ('c12') - constitutive_none_Cslip_66(1,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c13') - constitutive_none_Cslip_66(1,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c22') - constitutive_none_Cslip_66(2,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c23') - constitutive_none_Cslip_66(2,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c33') - constitutive_none_Cslip_66(3,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c44') - constitutive_none_Cslip_66(4,4,instance) = IO_floatValue(line,positions,2_pInt) - case ('c55') - constitutive_none_Cslip_66(5,5,instance) = IO_floatValue(line,positions,2_pInt) - case ('c66') - constitutive_none_Cslip_66(6,6,instance) = IO_floatValue(line,positions,2_pInt) - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONE_label//')') - end select - endif - endif - enddo - - instancesLoop: do instance = 1_pInt,maxNinstance - constitutive_none_Cslip_66(1:6,1:6,instance) = & - lattice_symmetrizeC66(constitutive_none_structureID(instance),constitutive_none_Cslip_66(1:6,1:6,instance)) - constitutive_none_Cslip_66(1:6,1:6,instance) = & ! Literature data is Voigt, DAMASK uses Mandel - math_Mandel3333to66(math_Voigt66to3333(constitutive_none_Cslip_66(1:6,1:6,instance))) - enddo instancesLoop end subroutine constitutive_none_init - -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -pure function constitutive_none_homogenizedC(ipc,ip,el) - use prec, only: & - p_vec - use mesh, only: & - mesh_NcpElems, & - mesh_maxNips - use material, only: & - homogenization_maxNgrains, & - material_phase, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6,6) :: & - constitutive_none_homogenizedC - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - constitutive_none_homogenizedC = constitutive_none_Cslip_66(1:6,1:6,& - phase_plasticityInstance(material_phase(ipc,ip,el))) - -end function constitutive_none_homogenizedC - end module constitutive_none diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 471b4aa40..3b4929b61 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -29,8 +29,6 @@ use prec, only: & pReal, & pInt, & p_vec -use lattice, only: & - LATTICE_undefined_ID implicit none private @@ -93,10 +91,6 @@ iRhoD, & !< state in iV, & !< state indices for dislcation velocities iD !< state indices for stable dipole height - -integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & -constitutive_nonlocal_structureID !< ID of the lattice structure - integer(pInt), dimension(:), allocatable, public :: & constitutive_nonlocal_structure !< number representing the kind of lattice structure @@ -110,9 +104,6 @@ slipSystemLattice, & !< lookup t colinearSystem !< colinear system to the active slip system (only valid for fcc!) real(pReal), dimension(:), allocatable, private :: & -CoverA, & !< c/a ratio for hex type lattice -mu, & !< shear modulus -nu, & !< poisson's ratio atomicVolume, & !< atomic volume Dsd0, & !< prefactor for self-diffusion coefficient selfDiffusionEnergy, & !< activation enthalpy for diffusion @@ -153,7 +144,6 @@ burgers, & !< absolute interactionSlipSlip !< coefficients for slip-slip interaction for each interaction type and instance real(pReal), dimension(:,:,:), allocatable, private :: & -Cslip66, & !< elasticity matrix in Mandel notation for each instance minDipoleHeightPerSlipFamily, & !< minimum stable edge/screw dipole height for each family and instance minDipoleHeight, & !< minimum stable edge/screw dipole height for each slip system and instance peierlsStressPerSlipFamily, & !< Peierls stress (edge and screw) @@ -168,13 +158,12 @@ rhoDotEdgeJogsOutput, & sourceProbability real(pReal), dimension(:,:,:,:,:), allocatable, private :: & -Cslip3333, & !< elasticity matrix for each instance rhoDotFluxOutput, & rhoDotMultiplicationOutput, & rhoDotSingle2DipoleGlideOutput, & rhoDotAthermalAnnihilationOutput, & rhoDotThermalAnnihilationOutput, & -nonSchmidProjection !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) +nonSchmidProjection !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & compatibility !< slip system compatibility between me and my neighbors @@ -280,7 +269,6 @@ public :: & constitutive_nonlocal_init, & constitutive_nonlocal_stateInit, & constitutive_nonlocal_aTolState, & -constitutive_nonlocal_homogenizedC, & constitutive_nonlocal_microstructure, & constitutive_nonlocal_LpAndItsTangent, & constitutive_nonlocal_dotState, & @@ -338,13 +326,11 @@ integer(pInt), intent(in) :: fileUnit integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt integer(pInt), & dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions -integer(pInt), dimension(7) :: configNchunks -integer(pInt) :: section = 0_pInt, & +integer(pInt) :: phase = 0_pInt, & maxNinstances, & maxTotalNslip, & - structID, & f, & ! index of my slip family - instance, & ! index of my instance of this plasticity + instance, & ! index of my instance of this plasticity l, & ns, & ! short notation for total number of active slip systems for the current instance o, & ! index of my output @@ -358,8 +344,6 @@ integer(pInt) :: section = 0_pInt, & Nchunks_SlipFamilies = 0_pInt, & Nchunks_nonSchmid = 0_pInt, & mySize = 0_pInt ! to suppress warnings, safe as init is called only once - character(len=32) :: & - structure = '' character(len=65536) :: & tag = '', & line = '' @@ -386,15 +370,10 @@ allocate(Noutput(maxNinstances), allocate(constitutive_nonlocal_output(maxval(phase_Noutput), maxNinstances)) constitutive_nonlocal_output = '' allocate(constitutive_nonlocal_outputID(maxval(phase_Noutput), maxNinstances), source=undefined_ID) -allocate(constitutive_nonlocal_structureID(maxNinstances), source=LATTICE_undefined_ID) -allocate(constitutive_nonlocal_structure(maxNinstances), source=0_pInt) allocate(Nslip(lattice_maxNslipFamily,maxNinstances), source=0_pInt) allocate(slipFamily(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(slipSystemLattice(lattice_maxNslip,maxNinstances), source=0_pInt) allocate(totalNslip(maxNinstances), source=0_pInt) -allocate(CoverA(maxNinstances), source=0.0_pReal) -allocate(mu(maxNinstances), source=0.0_pReal) -allocate(nu(maxNinstances), source=0.0_pReal) allocate(atomicVolume(maxNinstances), source=0.0_pReal) allocate(Dsd0(maxNinstances), source=-1.0_pReal) allocate(selfDiffusionEnergy(maxNinstances), source=0.0_pReal) @@ -402,8 +381,6 @@ allocate(aTolRho(maxNinstances), source=0.0_pReal) allocate(aTolShear(maxNinstances), source=0.0_pReal) allocate(significantRho(maxNinstances), source=0.0_pReal) allocate(significantN(maxNinstances), source=0.0_pReal) -allocate(Cslip66(6,6,maxNinstances), source=0.0_pReal) -allocate(Cslip3333(3,3,3,3,maxNinstances), source=0.0_pReal) allocate(cutoffRadius(maxNinstances), source=-1.0_pReal) allocate(doublekinkwidth(maxNinstances), source=0.0_pReal) allocate(solidSolutionEnergy(maxNinstances), source=0.0_pReal) @@ -439,480 +416,436 @@ allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), source=0.0_pReal) -!*** readout data from material.config file + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through phases of phase 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 phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_InteractionSlipSlip(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + endif + cycle + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then ! one of my phases. do not short-circuit here (.and. with next if statement). It's not safe in Fortran + instance = phase_plasticityInstance(phase) ! 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', & + 'covera_ratio','c/a_ratio','c/a', & + 'c11','c12','c13','c22','c23','c33','c44','c55','c66',& + '/nonlocal/') + cycle + case ('(output)') + Noutput(instance) = Noutput(instance) + 1_pInt + constitutive_nonlocal_output(Noutput(instance),instance) = IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + case('rho') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_ID + case('delta') + constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_ID + case('rho_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_edge_ID + case('rho_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_screw_ID + case('rho_sgl') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_ID + case('delta_sgl') + constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_sgl_ID + case('rho_sgl_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_ID + case('rho_sgl_edge_pos') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_ID + case('rho_sgl_edge_neg') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_ID + case('rho_sgl_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_ID + case('rho_sgl_screw_pos') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_ID + case('rho_sgl_screw_neg') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_ID + case('rho_sgl_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_mobile_ID + case('rho_sgl_edge_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_mobile_ID + case('rho_sgl_edge_pos_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID + case('rho_sgl_edge_neg_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID + case('rho_sgl_screw_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_mobile_ID + case('rho_sgl_screw_pos_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID + case('rho_sgl_screw_neg_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID + case('rho_sgl_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_immobile_ID + case('rho_sgl_edge_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_immobile_ID + case('rho_sgl_edge_pos_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID + case('rho_sgl_edge_neg_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID + case('rho_sgl_screw_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_immobile_ID + case('rho_sgl_screw_pos_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID + case('rho_sgl_screw_neg_immobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID + case('rho_dip') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_ID + case('delta_dip') + constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_dip_ID + case('rho_dip_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_edge_ID + case('rho_dip_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_screw_ID + case('excess_rho') + constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_ID + case('excess_rho_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_edge_ID + case('excess_rho_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_screw_ID + case('rho_forest') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_forest_ID + case('shearrate') + constitutive_nonlocal_outputID(Noutput(instance),instance) = shearrate_ID + case('resolvedstress') + constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_ID + case('resolvedstress_external') + constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_external_ID + case('resolvedstress_back') + constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_back_ID + case('resistance') + constitutive_nonlocal_outputID(Noutput(instance),instance) = resistance_ID + case('rho_dot') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ID + case('rho_dot_sgl') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl_ID + case('rho_dot_sgl_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl_mobile_ID + case('rho_dot_dip') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_dip_ID + case('rho_dot_gen') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_ID + case('rho_dot_gen_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_edge_ID + case('rho_dot_gen_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_screw_ID + case('rho_dot_sgl2dip') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_ID + case('rho_dot_sgl2dip_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID + case('rho_dot_sgl2dip_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_screw_ID + case('rho_dot_ann_ath') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_ath_ID + case('rho_dot_ann_the') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_ID + case('rho_dot_ann_the_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_edge_ID + case('rho_dot_ann_the_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_screw_ID + case('rho_dot_edgejogs') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_edgejogs_ID + case('rho_dot_flux') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_ID + case('rho_dot_flux_mobile') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_mobile_ID + case('rho_dot_flux_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_edge_ID + case('rho_dot_flux_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_screw_ID + case('velocity_edge_pos') + constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_edge_pos_ID + case('velocity_edge_neg') + constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_edge_neg_ID + case('velocity_screw_pos') + constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_screw_pos_ID + case('velocity_screw_neg') + constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_screw_neg_ID + case('slipdirection.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectionx_ID + case('slipdirection.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectiony_ID + case('slipdirection.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectionz_ID + case('slipnormal.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormalx_ID + case('slipnormal.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormaly_ID + case('slipnormal.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormalz_ID + case('fluxdensity_edge_pos.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posx_ID + case('fluxdensity_edge_pos.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posy_ID + case('fluxdensity_edge_pos.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posz_ID + case('fluxdensity_edge_neg.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negx_ID + case('fluxdensity_edge_neg.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negy_ID + case('fluxdensity_edge_neg.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negz_ID + case('fluxdensity_screw_pos.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posx_ID + case('fluxdensity_screw_pos.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posy_ID + case('fluxdensity_screw_pos.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posz_ID + case('fluxdensity_screw_neg.x') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negx_ID + case('fluxdensity_screw_neg.y') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negy_ID + case('fluxdensity_screw_neg.z') + constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negz_ID + case('maximumdipoleheight_edge') + constitutive_nonlocal_outputID(Noutput(instance),instance) = maximumdipoleheight_edge_ID + case('maximumdipoleheight_screw') + constitutive_nonlocal_outputID(Noutput(instance),instance) = maximumdipoleheight_screw_ID + case('accumulatedshear') + constitutive_nonlocal_outputID(Noutput(instance),instance) = accumulatedshear_ID + case('dislocationstress') + constitutive_nonlocal_outputID(Noutput(instance),instance) = dislocationstress_ID + case default + call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_NONLOCAL_label//')') + end select + case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') + Nchunks_SlipFamilies = positions(1) - 1_pInt + do f = 1_pInt, Nchunks_SlipFamilies + Nslip(f,instance) = IO_intValue(line,positions,1_pInt+f) + enddo + case ('rhosgledgepos0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglEdgePos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('rhosgledgeneg0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('rhosglscrewpos0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglScrewPos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('rhosglscrewneg0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoSglScrewNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('rhodipedge0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoDipEdge0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('rhodipscrew0') + do f = 1_pInt, Nchunks_SlipFamilies + rhoDipScrew0(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('lambda0') + do f = 1_pInt, Nchunks_SlipFamilies + lambda0PerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case ('burgers') + do f = 1_pInt, Nchunks_SlipFamilies + burgersPerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('cutoffradius','r') + cutoffRadius(instance) = IO_floatValue(line,positions,2_pInt) + case('minimumdipoleheightedge','ddipminedge') + do f = 1_pInt, Nchunks_SlipFamilies + minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('minimumdipoleheightscrew','ddipminscrew') + do f = 1_pInt, Nchunks_SlipFamilies + minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('atomicvolume') + atomicVolume(instance) = IO_floatValue(line,positions,2_pInt) + case('selfdiffusionprefactor','dsd0') + Dsd0(instance) = IO_floatValue(line,positions,2_pInt) + case('selfdiffusionenergy','qsd') + selfDiffusionEnergy(instance) = IO_floatValue(line,positions,2_pInt) + case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') + aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') + aTolShear(instance) = IO_floatValue(line,positions,2_pInt) + case('significantrho','significant_rho','significantdensity','significant_density') + significantRho(instance) = IO_floatValue(line,positions,2_pInt) + case('significantn','significant_n','significantdislocations','significant_dislcations') + significantN(instance) = 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_NONLOCAL_LABEL//')') + do it = 1_pInt,Nchunks_SlipSlip + interactionSlipSlip(it,instance) = IO_floatValue(line,positions,1_pInt+it) + enddo + case('linetension','linetensioneffect','linetension_effect') + linetensionEffect(instance) = IO_floatValue(line,positions,2_pInt) + case('edgejog','edgejogs','edgejogeffect','edgejog_effect') + edgeJogFactor(instance) = IO_floatValue(line,positions,2_pInt) + case('peierlsstressedge','peierlsstress_edge') + do f = 1_pInt, Nchunks_SlipFamilies + peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('peierlsstressscrew','peierlsstress_screw') + do f = 1_pInt, Nchunks_SlipFamilies + peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('doublekinkwidth') + doublekinkwidth(instance) = IO_floatValue(line,positions,2_pInt) + case('solidsolutionenergy') + solidSolutionEnergy(instance) = IO_floatValue(line,positions,2_pInt) + case('solidsolutionsize') + solidSolutionSize(instance) = IO_floatValue(line,positions,2_pInt) + case('solidsolutionconcentration') + solidSolutionConcentration(instance) = IO_floatValue(line,positions,2_pInt) + case('p') + pParam(instance) = IO_floatValue(line,positions,2_pInt) + case('q') + qParam(instance) = IO_floatValue(line,positions,2_pInt) + case('viscosity','glideviscosity') + viscosity(instance) = IO_floatValue(line,positions,2_pInt) + case('attackfrequency','fattack') + fattack(instance) = IO_floatValue(line,positions,2_pInt) + case('rhosglscatter') + rhoSglScatter(instance) = IO_floatValue(line,positions,2_pInt) + case('rhosglrandom') + rhoSglRandom(instance) = IO_floatValue(line,positions,2_pInt) + case('rhosglrandombinning') + rhoSglRandomBinning(instance) = IO_floatValue(line,positions,2_pInt) + case('surfacetransmissivity') + surfaceTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) + case('grainboundarytransmissivity') + grainboundaryTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) + case('cflfactor') + CFLfactor(instance) = IO_floatValue(line,positions,2_pInt) + case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') + fEdgeMultiplication(instance) = IO_floatValue(line,positions,2_pInt) + case('shortrangestresscorrection') + shortRangeStressCorrection(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal + case ('nonschmid_coefficients') + if (positions(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') + do f = 1_pInt,Nchunks_nonSchmid + nonSchmidCoeff(f,instance) = IO_floatValue(line,positions,1_pInt+f) + enddo + case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') + probabilisticMultiplication(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal + case default + call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') + end select + endif; endif + enddo parsingFile -rewind(fileUnit) -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 thru sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt ! advance section counter - cycle - 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_NONLOCAL_ID) then ! one of my sections - instance = 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','/nonlocal/') - cycle - case ('(output)') - Noutput(instance) = Noutput(instance) + 1_pInt - constitutive_nonlocal_output(Noutput(instance),instance) = IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) - case('rho') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_ID - case('delta') - constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_ID - case('rho_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_edge_ID - case('rho_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_screw_ID - case('rho_sgl') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_ID - case('delta_sgl') - constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_sgl_ID - case('rho_sgl_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_ID - case('rho_sgl_edge_pos') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_ID - case('rho_sgl_edge_neg') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_ID - case('rho_sgl_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_ID - case('rho_sgl_screw_pos') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_ID - case('rho_sgl_screw_neg') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_ID - case('rho_sgl_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_mobile_ID - case('rho_sgl_edge_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_mobile_ID - case('rho_sgl_edge_pos_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID - case('rho_sgl_edge_neg_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID - case('rho_sgl_screw_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_mobile_ID - case('rho_sgl_screw_pos_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID - case('rho_sgl_screw_neg_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID - case('rho_sgl_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_immobile_ID - case('rho_sgl_edge_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_immobile_ID - case('rho_sgl_edge_pos_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID - case('rho_sgl_edge_neg_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID - case('rho_sgl_screw_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_immobile_ID - case('rho_sgl_screw_pos_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID - case('rho_sgl_screw_neg_immobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID - case('rho_dip') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_ID - case('delta_dip') - constitutive_nonlocal_outputID(Noutput(instance),instance) = delta_dip_ID - case('rho_dip_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_edge_ID - case('rho_dip_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dip_screw_ID - case('excess_rho') - constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_ID - case('excess_rho_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_edge_ID - case('excess_rho_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = excess_rho_screw_ID - case('rho_forest') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_forest_ID - case('shearrate') - constitutive_nonlocal_outputID(Noutput(instance),instance) = shearrate_ID - case('resolvedstress') - constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_ID - case('resolvedstress_external') - constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_external_ID - case('resolvedstress_back') - constitutive_nonlocal_outputID(Noutput(instance),instance) = resolvedstress_back_ID - case('resistance') - constitutive_nonlocal_outputID(Noutput(instance),instance) = resistance_ID - case('rho_dot') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ID - case('rho_dot_sgl') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl_ID - case('rho_dot_sgl_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl_mobile_ID - case('rho_dot_dip') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_dip_ID - case('rho_dot_gen') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_ID - case('rho_dot_gen_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_edge_ID - case('rho_dot_gen_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_gen_screw_ID - case('rho_dot_sgl2dip') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_ID - case('rho_dot_sgl2dip_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID - case('rho_dot_sgl2dip_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_sgl2dip_screw_ID - case('rho_dot_ann_ath') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_ath_ID - case('rho_dot_ann_the') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_ID - case('rho_dot_ann_the_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_edge_ID - case('rho_dot_ann_the_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_ann_the_screw_ID - case('rho_dot_edgejogs') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_edgejogs_ID - case('rho_dot_flux') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_ID - case('rho_dot_flux_mobile') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_mobile_ID - case('rho_dot_flux_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_edge_ID - case('rho_dot_flux_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = rho_dot_flux_screw_ID - case('velocity_edge_pos') - constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_edge_pos_ID - case('velocity_edge_neg') - constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_edge_neg_ID - case('velocity_screw_pos') - constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_screw_pos_ID - case('velocity_screw_neg') - constitutive_nonlocal_outputID(Noutput(instance),instance) = velocity_screw_neg_ID - case('slipdirection.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectionx_ID - case('slipdirection.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectiony_ID - case('slipdirection.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipdirectionz_ID - case('slipnormal.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormalx_ID - case('slipnormal.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormaly_ID - case('slipnormal.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = slipnormalz_ID - case('fluxdensity_edge_pos.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posx_ID - case('fluxdensity_edge_pos.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posy_ID - case('fluxdensity_edge_pos.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_posz_ID - case('fluxdensity_edge_neg.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negx_ID - case('fluxdensity_edge_neg.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negy_ID - case('fluxdensity_edge_neg.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_edge_negz_ID - case('fluxdensity_screw_pos.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posx_ID - case('fluxdensity_screw_pos.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posy_ID - case('fluxdensity_screw_pos.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_posz_ID - case('fluxdensity_screw_neg.x') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negx_ID - case('fluxdensity_screw_neg.y') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negy_ID - case('fluxdensity_screw_neg.z') - constitutive_nonlocal_outputID(Noutput(instance),instance) = fluxdensity_screw_negz_ID - case('maximumdipoleheight_edge') - constitutive_nonlocal_outputID(Noutput(instance),instance) = maximumdipoleheight_edge_ID - case('maximumdipoleheight_screw') - constitutive_nonlocal_outputID(Noutput(instance),instance) = maximumdipoleheight_screw_ID - case('accumulatedshear') - constitutive_nonlocal_outputID(Noutput(instance),instance) = accumulatedshear_ID - case('dislocationstress') - constitutive_nonlocal_outputID(Noutput(instance),instance) = dislocationstress_ID - case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_NONLOCAL_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_nonlocal_structureID(instance) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_nonlocal_structureID(instance) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_nonlocal_structureID(instance) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_nonlocal_structureID(instance) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_nonlocal_structureID(instance) = LATTICE_ort_ID - end select - configNchunks = lattice_configNchunks(constitutive_nonlocal_structureID(instance)) - Nchunks_SlipFamilies = configNchunks(1) - Nchunks_SlipSlip = configNchunks(3) - Nchunks_nonSchmid = configNchunks(7) - case ('c/a_ratio','covera_ratio') - CoverA(instance) = IO_floatValue(line,positions,2_pInt) - case ('c11') - Cslip66(1,1,instance) = IO_floatValue(line,positions,2_pInt) - case ('c12') - Cslip66(1,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c13') - Cslip66(1,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c22') - Cslip66(2,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c23') - Cslip66(2,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c33') - Cslip66(3,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c44') - Cslip66(4,4,instance) = IO_floatValue(line,positions,2_pInt) - case ('c55') - Cslip66(5,5,instance) = IO_floatValue(line,positions,2_pInt) - case ('c66') - Cslip66(6,6,instance) = IO_floatValue(line,positions,2_pInt) - case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_LABEL//')') - Nchunks_SlipFamilies = positions(1) - 1_pInt - do f = 1_pInt, Nchunks_SlipFamilies - Nslip(f,instance) = IO_intValue(line,positions,1_pInt+f) - enddo - case ('rhosgledgepos0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgePos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('rhosgledgeneg0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglEdgeNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('rhosglscrewpos0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewPos0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('rhosglscrewneg0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoSglScrewNeg0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('rhodipedge0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoDipEdge0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('rhodipscrew0') - do f = 1_pInt, Nchunks_SlipFamilies - rhoDipScrew0(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('lambda0') - do f = 1_pInt, Nchunks_SlipFamilies - lambda0PerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case ('burgers') - do f = 1_pInt, Nchunks_SlipFamilies - burgersPerSlipFamily(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('cutoffradius','r') - cutoffRadius(instance) = IO_floatValue(line,positions,2_pInt) - case('minimumdipoleheightedge','ddipminedge') - do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('minimumdipoleheightscrew','ddipminscrew') - do f = 1_pInt, Nchunks_SlipFamilies - minDipoleHeightPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('atomicvolume') - atomicVolume(instance) = IO_floatValue(line,positions,2_pInt) - case('selfdiffusionprefactor','dsd0') - Dsd0(instance) = IO_floatValue(line,positions,2_pInt) - case('selfdiffusionenergy','qsd') - selfDiffusionEnergy(instance) = IO_floatValue(line,positions,2_pInt) - case('atol_rho','atol_density','absolutetolerancedensity','absolutetolerance_density') - aTolRho(instance) = IO_floatValue(line,positions,2_pInt) - case('atol_shear','atol_plasticshear','atol_accumulatedshear','absolutetoleranceshear','absolutetolerance_shear') - aTolShear(instance) = IO_floatValue(line,positions,2_pInt) - case('significantrho','significant_rho','significantdensity','significant_density') - significantRho(instance) = IO_floatValue(line,positions,2_pInt) - case('significantn','significant_n','significantdislocations','significant_dislcations') - significantN(instance) = 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_NONLOCAL_LABEL//')') - do it = 1_pInt,Nchunks_SlipSlip - interactionSlipSlip(it,instance) = IO_floatValue(line,positions,1_pInt+it) - enddo - case('linetension','linetensioneffect','linetension_effect') - linetensionEffect(instance) = IO_floatValue(line,positions,2_pInt) - case('edgejog','edgejogs','edgejogeffect','edgejog_effect') - edgeJogFactor(instance) = IO_floatValue(line,positions,2_pInt) - case('peierlsstressedge','peierlsstress_edge') - do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,1_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('peierlsstressscrew','peierlsstress_screw') - do f = 1_pInt, Nchunks_SlipFamilies - peierlsStressPerSlipFamily(f,2_pInt,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('doublekinkwidth') - doublekinkwidth(instance) = IO_floatValue(line,positions,2_pInt) - case('solidsolutionenergy') - solidSolutionEnergy(instance) = IO_floatValue(line,positions,2_pInt) - case('solidsolutionsize') - solidSolutionSize(instance) = IO_floatValue(line,positions,2_pInt) - case('solidsolutionconcentration') - solidSolutionConcentration(instance) = IO_floatValue(line,positions,2_pInt) - case('p') - pParam(instance) = IO_floatValue(line,positions,2_pInt) - case('q') - qParam(instance) = IO_floatValue(line,positions,2_pInt) - case('viscosity','glideviscosity') - viscosity(instance) = IO_floatValue(line,positions,2_pInt) - case('attackfrequency','fattack') - fattack(instance) = IO_floatValue(line,positions,2_pInt) - case('rhosglscatter') - rhoSglScatter(instance) = IO_floatValue(line,positions,2_pInt) - case('rhosglrandom') - rhoSglRandom(instance) = IO_floatValue(line,positions,2_pInt) - case('rhosglrandombinning') - rhoSglRandomBinning(instance) = IO_floatValue(line,positions,2_pInt) - case('surfacetransmissivity') - surfaceTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) - case('grainboundarytransmissivity') - grainboundaryTransmissivity(instance) = IO_floatValue(line,positions,2_pInt) - case('cflfactor') - CFLfactor(instance) = IO_floatValue(line,positions,2_pInt) - case('fedgemultiplication','edgemultiplicationfactor','edgemultiplication') - fEdgeMultiplication(instance) = IO_floatValue(line,positions,2_pInt) - case('shortrangestresscorrection') - shortRangeStressCorrection(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal - case ('nonschmid_coefficients') - if (positions(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') - do f = 1_pInt,Nchunks_nonSchmid - nonSchmidCoeff(f,instance) = IO_floatValue(line,positions,1_pInt+f) - enddo - case('probabilisticmultiplication','randomsources','randommultiplication','discretesources') - probabilisticMultiplication(instance) = IO_floatValue(line,positions,2_pInt) > 0.0_pReal - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_NONLOCAL_label//')') - end select - endif - endif -enddo - - -do instance = 1_pInt,maxNinstances - - constitutive_nonlocal_structure(instance) = & - lattice_initializeStructure(constitutive_nonlocal_structureID(instance), CoverA(instance)) ! our lattice structure is defined in the material.config file by the structureName (and the c/a ratio) - structID = constitutive_nonlocal_structure(instance) - - - !*** sanity checks - - if (structID < 1_pInt) & - call IO_error(205_pInt,el=instance) - if (sum(Nslip(:,instance)) <= 0_pInt) & - call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') - do o = 1_pInt,maxval(phase_Noutput) - if(len(constitutive_nonlocal_output(o,instance)) > 64_pInt) & - call IO_error(666_pInt) - enddo - do f = 1_pInt,lattice_maxNslipFamily - if (Nslip(f,instance) > 0_pInt) then - if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoDipEdge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') - if (rhoDipScrew0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') - if (burgersPerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='Burgers ('//PLASTICITY_NONLOCAL_label//')') - if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') - if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') - if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') - if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') - if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') - endif - enddo - if (any(interactionSlipSlip(1:maxval(lattice_interactionSlipSlip(:,:,structID)),instance) < 0.0_pReal)) & - call IO_error(211_pInt,ext_msg='interaction_SlipSlip ('//PLASTICITY_NONLOCAL_label//')') - if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') - if (edgeJogFactor(instance) < 0.0_pReal .or. edgeJogFactor(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='edgejog ('//PLASTICITY_NONLOCAL_label//')') - if (cutoffRadius(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') - if (atomicVolume(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') - if (Dsd0(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') - if (selfDiffusionEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='selfDiffusionEnergy ('//PLASTICITY_NONLOCAL_label//')') - if (aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='aTol_rho ('//PLASTICITY_NONLOCAL_label//')') - if (aTolShear(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='aTol_shear ('//PLASTICITY_NONLOCAL_label//')') - if (significantRho(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='significantRho ('//PLASTICITY_NONLOCAL_label//')') - if (significantN(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='significantN ('//PLASTICITY_NONLOCAL_label//')') - if (doublekinkwidth(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='doublekinkwidth ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionEnergy(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionEnergy ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionSize(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionSize ('//PLASTICITY_NONLOCAL_label//')') - if (solidSolutionConcentration(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='solidSolutionConcentration ('//PLASTICITY_NONLOCAL_label//')') - if (pParam(instance) <= 0.0_pReal .or. pParam(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') - if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & - call IO_error(211_pInt,ext_msg='q ('//PLASTICITY_NONLOCAL_label//')') - if (viscosity(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='viscosity ('//PLASTICITY_NONLOCAL_label//')') - if (fattack(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='attackFrequency ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglScatter(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglRandom(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') - if (rhoSglRandomBinning(instance) <= 0.0_pReal) & - call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') - if (surfaceTransmissivity(instance) < 0.0_pReal .or. surfaceTransmissivity(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='surfaceTransmissivity ('//PLASTICITY_NONLOCAL_label//')') - if (grainboundaryTransmissivity(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='grainboundaryTransmissivity ('//PLASTICITY_NONLOCAL_label//')') - if (CFLfactor(instance) < 0.0_pReal) & - call IO_error(211_pInt,ext_msg='CFLfactor ('//PLASTICITY_NONLOCAL_label//')') - if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & - call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') - - - !*** determine total number of active slip systems - - Nslip(1:lattice_maxNslipFamily,instance) = min(lattice_NslipSystem(1:lattice_maxNslipFamily,structID), & - Nslip(1:lattice_maxNslipFamily,instance) ) ! we can't use more slip systems per family than specified in lattice - totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) - -enddo + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + if (sum(Nslip(:,instance)) <= 0_pInt) & + call IO_error(211_pInt,ext_msg='Nslip ('//PLASTICITY_NONLOCAL_label//')') + do o = 1_pInt,maxval(phase_Noutput) + if(len(constitutive_nonlocal_output(o,instance)) > 64_pInt) & + call IO_error(666_pInt) + enddo + do f = 1_pInt,lattice_maxNslipFamily + if (Nslip(f,instance) > 0_pInt) then + if (rhoSglEdgePos0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglEdgePos0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglEdgeNeg0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglEdgeNeg0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScrewPos0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScrewPos0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScrewNeg0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScrewNeg0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoDipEdge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoDipEdge0 ('//PLASTICITY_NONLOCAL_label//')') + if (rhoDipScrew0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoDipScrew0 ('//PLASTICITY_NONLOCAL_label//')') + if (burgersPerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='Burgers ('//PLASTICITY_NONLOCAL_label//')') + if (lambda0PerSlipFamily(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='lambda0 ('//PLASTICITY_NONLOCAL_label//')') + if (minDipoleHeightPerSlipFamily(f,1,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='minimumDipoleHeightEdge ('//PLASTICITY_NONLOCAL_label//')') + if (minDipoleHeightPerSlipFamily(f,2,instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='minimumDipoleHeightScrew ('//PLASTICITY_NONLOCAL_label//')') + if (peierlsStressPerSlipFamily(f,1,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='peierlsStressEdge ('//PLASTICITY_NONLOCAL_label//')') + if (peierlsStressPerSlipFamily(f,2,instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='peierlsStressScrew ('//PLASTICITY_NONLOCAL_label//')') + endif + enddo + if (any(interactionSlipSlip(1:maxval(lattice_interactionSlipSlip(:,:,phase)),instance) < 0.0_pReal)) & + call IO_error(211_pInt,ext_msg='interaction_SlipSlip ('//PLASTICITY_NONLOCAL_label//')') + if (linetensionEffect(instance) < 0.0_pReal .or. linetensionEffect(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='linetension ('//PLASTICITY_NONLOCAL_label//')') + if (edgeJogFactor(instance) < 0.0_pReal .or. edgeJogFactor(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='edgejog ('//PLASTICITY_NONLOCAL_label//')') + if (cutoffRadius(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='r ('//PLASTICITY_NONLOCAL_label//')') + if (atomicVolume(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='atomicVolume ('//PLASTICITY_NONLOCAL_label//')') + if (Dsd0(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='selfDiffusionPrefactor ('//PLASTICITY_NONLOCAL_label//')') + if (selfDiffusionEnergy(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='selfDiffusionEnergy ('//PLASTICITY_NONLOCAL_label//')') + if (aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='aTol_rho ('//PLASTICITY_NONLOCAL_label//')') + if (aTolShear(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='aTol_shear ('//PLASTICITY_NONLOCAL_label//')') + if (significantRho(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='significantRho ('//PLASTICITY_NONLOCAL_label//')') + if (significantN(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='significantN ('//PLASTICITY_NONLOCAL_label//')') + if (doublekinkwidth(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='doublekinkwidth ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionEnergy(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionEnergy ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionSize(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionSize ('//PLASTICITY_NONLOCAL_label//')') + if (solidSolutionConcentration(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='solidSolutionConcentration ('//PLASTICITY_NONLOCAL_label//')') + if (pParam(instance) <= 0.0_pReal .or. pParam(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='p ('//PLASTICITY_NONLOCAL_label//')') + if (qParam(instance) < 1.0_pReal .or. qParam(instance) > 2.0_pReal) & + call IO_error(211_pInt,ext_msg='q ('//PLASTICITY_NONLOCAL_label//')') + if (viscosity(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='viscosity ('//PLASTICITY_NONLOCAL_label//')') + if (fattack(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='attackFrequency ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglScatter(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglScatter ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglRandom(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglRandom ('//PLASTICITY_NONLOCAL_label//')') + if (rhoSglRandomBinning(instance) <= 0.0_pReal) & + call IO_error(211_pInt,ext_msg='rhoSglRandomBinning ('//PLASTICITY_NONLOCAL_label//')') + if (surfaceTransmissivity(instance) < 0.0_pReal .or. surfaceTransmissivity(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='surfaceTransmissivity ('//PLASTICITY_NONLOCAL_label//')') + if (grainboundaryTransmissivity(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='grainboundaryTransmissivity ('//PLASTICITY_NONLOCAL_label//')') + if (CFLfactor(instance) < 0.0_pReal) & + call IO_error(211_pInt,ext_msg='CFLfactor ('//PLASTICITY_NONLOCAL_label//')') + if (fEdgeMultiplication(instance) < 0.0_pReal .or. fEdgeMultiplication(instance) > 1.0_pReal) & + call IO_error(211_pInt,ext_msg='edgemultiplicationfactor ('//PLASTICITY_NONLOCAL_label//')') + + + !*** determine total number of active slip systems + Nslip(1:lattice_maxNslipFamily,instance) = min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase), & + Nslip(1:lattice_maxNslipFamily,instance) ) ! we can't use more slip systems per family than specified in lattice + totalNslip(instance) = sum(Nslip(1:lattice_maxNslipFamily,instance)) + endif myPhase +enddo sanityChecks !*** allocation of variables whose size depends on the total number of active slip systems @@ -929,13 +862,13 @@ allocate(iRhoF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauF(maxTotalNslip,maxNinstances), source=0_pInt) allocate(iTauB(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(burgers(maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) -allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(burgers(maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(lambda0(maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(minDipoleHeight(maxTotalNslip,2,maxNinstances), source=-1.0_pReal) +allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & source=2.0_pReal) @@ -954,273 +887,259 @@ allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,mesh_maxNi allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), & source=0.0_pReal) -allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) -allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) -allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), source=0.0_pReal) +allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) +allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) +allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), source=0.0_pReal) -instancesLoop: do instance = 1,maxNinstances - - structID = constitutive_nonlocal_structure(instance) ! lattice structure of this instance - - - !*** Inverse lookup of my slip system family and the slip system in lattice - - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,Nslip(f,instance) - l = l + 1_pInt - slipFamily(l,instance) = f - slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, structID)) + s - enddo; enddo - - - !*** determine size of state array - - ns = totalNslip(instance) - constitutive_nonlocal_sizeDotState(instance) = int(size(BASICSTATES),pInt) * ns - constitutive_nonlocal_sizeDependentState(instance) = int(size(DEPENDENTSTATES),pInt) * ns - constitutive_nonlocal_sizeState(instance) = constitutive_nonlocal_sizeDotState(instance) & - + constitutive_nonlocal_sizeDependentState(instance) & - + int(size(OTHERSTATES),pInt) * ns - - !*** determine indices to state array - - l = 0_pInt - do t = 1_pInt,4_pInt - do s = 1_pInt,ns - l = l + 1_pInt - iRhoU(s,t,instance) = l - enddo - enddo - do t = 1_pInt,4_pInt - do s = 1_pInt,ns - l = l + 1_pInt - iRhoB(s,t,instance) = l - enddo - enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,ns - l = l + 1_pInt - iRhoD(s,c,instance) = l - enddo - enddo - do s = 1_pInt,ns - l = l + 1_pInt - iGamma(s,instance) = l - enddo - do s = 1_pInt,ns - l = l + 1_pInt - iRhoF(s,instance) = l - enddo - do s = 1_pInt,ns - l = l + 1_pInt - iTauF(s,instance) = l - enddo - do s = 1_pInt,ns - l = l + 1_pInt - iTauB(s,instance) = l - enddo - do t = 1_pInt,4_pInt - do s = 1_pInt,ns - l = l + 1_pInt - iV(s,t,instance) = l - enddo - enddo - do c = 1_pInt,2_pInt - do s = 1_pInt,ns - l = l + 1_pInt - iD(s,c,instance) = l - enddo - enddo - if (iD(ns,2,instance) /= constitutive_nonlocal_sizeState(instance)) & ! check if last index is equal to size of state - call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') - - - !*** determine size of postResults array - - outputsLoop: do o = 1_pInt,Noutput(instance) - select case(constitutive_nonlocal_outputID(o,instance)) - case( rho_ID, & - delta_ID, & - rho_edge_ID, & - rho_screw_ID, & - rho_sgl_ID, & - delta_sgl_ID, & - rho_sgl_edge_ID, & - rho_sgl_edge_pos_ID, & - rho_sgl_edge_neg_ID, & - rho_sgl_screw_ID, & - rho_sgl_screw_pos_ID, & - rho_sgl_screw_neg_ID, & - rho_sgl_mobile_ID, & - rho_sgl_edge_mobile_ID, & - rho_sgl_edge_pos_mobile_ID, & - rho_sgl_edge_neg_mobile_ID, & - rho_sgl_screw_mobile_ID, & - rho_sgl_screw_pos_mobile_ID, & - rho_sgl_screw_neg_mobile_ID, & - rho_sgl_immobile_ID, & - rho_sgl_edge_immobile_ID, & - rho_sgl_edge_pos_immobile_ID, & - rho_sgl_edge_neg_immobile_ID, & - rho_sgl_screw_immobile_ID, & - rho_sgl_screw_pos_immobile_ID, & - rho_sgl_screw_neg_immobile_ID, & - rho_dip_ID, & - delta_dip_ID, & - rho_dip_edge_ID, & - rho_dip_screw_ID, & - excess_rho_ID, & - excess_rho_edge_ID, & - excess_rho_screw_ID, & - rho_forest_ID, & - shearrate_ID, & - resolvedstress_ID, & - resolvedstress_external_ID, & - resolvedstress_back_ID, & - resistance_ID, & - rho_dot_ID, & - rho_dot_sgl_ID, & - rho_dot_sgl_mobile_ID, & - rho_dot_dip_ID, & - rho_dot_gen_ID, & - rho_dot_gen_edge_ID, & - rho_dot_gen_screw_ID, & - rho_dot_sgl2dip_ID, & - rho_dot_sgl2dip_edge_ID, & - rho_dot_sgl2dip_screw_ID, & - rho_dot_ann_ath_ID, & - rho_dot_ann_the_ID, & - rho_dot_ann_the_edge_ID, & - rho_dot_ann_the_screw_ID, & - rho_dot_edgejogs_ID, & - rho_dot_flux_ID, & - rho_dot_flux_mobile_ID, & - rho_dot_flux_edge_ID, & - rho_dot_flux_screw_ID, & - velocity_edge_pos_ID, & - velocity_edge_neg_ID, & - velocity_screw_pos_ID, & - velocity_screw_neg_ID, & - slipdirectionx_ID, & - slipdirectiony_ID, & - slipdirectionz_ID, & - slipnormalx_ID, & - slipnormaly_ID, & - slipnormalz_ID, & - fluxdensity_edge_posx_ID, & - fluxdensity_edge_posy_ID, & - fluxdensity_edge_posz_ID, & - fluxdensity_edge_negx_ID, & - fluxdensity_edge_negy_ID, & - fluxdensity_edge_negz_ID, & - fluxdensity_screw_posx_ID, & - fluxdensity_screw_posy_ID, & - fluxdensity_screw_posz_ID, & - fluxdensity_screw_negx_ID, & - fluxdensity_screw_negy_ID, & - fluxdensity_screw_negz_ID, & - maximumdipoleheight_edge_ID, & - maximumdipoleheight_screw_ID, & - accumulatedshear_ID ) - mySize = totalNslip(instance) - case(dislocationstress_ID) - mySize = 6_pInt - case default - end select - - if (mySize > 0_pInt) then ! any meaningful output found - constitutive_nonlocal_sizePostResult(o,instance) = mySize - constitutive_nonlocal_sizePostResults(instance) = constitutive_nonlocal_sizePostResults(instance) + mySize - endif - enddo outputsLoop - - - !*** elasticity matrix and shear modulus according to material.config - - Cslip66(:,:,instance) = lattice_symmetrizeC66(constitutive_nonlocal_structureID(instance), Cslip66(:,:,instance)) - mu(instance) = 0.2_pReal * (Cslip66(1,1,instance) - Cslip66(1,2,instance) + 3.0_pReal*Cslip66(4,4,instance)) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 - nu(instance) = (Cslip66(1,1,instance) + 4.0_pReal*Cslip66(1,2,instance) - 2.0_pReal*Cslip66(4,4,instance)) & - / (4.0_pReal*Cslip66(1,1,instance) + 6.0_pReal*Cslip66(1,2,instance) + 2.0_pReal*Cslip66(4,4,instance)) ! C12iso/(C11iso+C12iso) with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 - Cslip66(1:6,1:6,instance) = math_Mandel3333to66(math_Voigt66to3333(Cslip66(1:6,1:6,instance))) - Cslip3333(1:3,1:3,1:3,1:3,instance) = math_Voigt66to3333(Cslip66(1:6,1:6,instance)) - - do s1 = 1_pInt,ns - f = slipFamily(s1,instance) - - !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system - - burgers(s1,instance) = burgersPerSlipFamily(f,instance) - lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) - minDipoleHeight(s1,1:2,instance) = minDipoleHeightPerSlipFamily(f,1:2,instance) - peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) - - do s2 = 1_pInt,ns - - !*** calculation of forest projections for edge and screw dislocations. s2 acts as forest for s1 - - forestProjectionEdge(s1,s2,instance) & - = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),structID), & - lattice_st(1:3,slipSystemLattice(s2,instance),structID))) ! forest projection of edge dislocations is the projection of (t = b x n) onto the slip normal of the respective slip plane - - forestProjectionScrew(s1,s2,instance) & - = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),structID), & - lattice_sd(1:3,slipSystemLattice(s2,instance),structID))) ! forest projection of screw dislocations is the projection of b onto the slip normal of the respective splip plane - - !*** calculation of interaction matrices - - interactionMatrixSlipSlip(s1,s2,instance) & - = interactionSlipSlip(lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & - slipSystemLattice(s2,instance), & - structID), instance) - - !*** colinear slip system (only makes sense for fcc like it is defined here) - - if (lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & - slipSystemLattice(s2,instance), & - structID) == 3_pInt) then - colinearSystem(s1,instance) = s2 - endif - - enddo - - !*** rotation matrix from lattice configuration to slip system - - lattice2slip(1:3,1:3,s1,instance) & - = math_transpose33( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), structID), & - -lattice_st(1:3, slipSystemLattice(s1,instance), structID), & - lattice_sn(1:3, slipSystemLattice(s1,instance), structID)], [3,3])) - enddo - - - !*** combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) - !* four types t: - !* 1) positive screw at positive resolved stress - !* 2) positive screw at negative resolved stress - !* 3) negative screw at positive resolved stress - !* 4) negative screw at negative resolved stress - - do s = 1_pInt,ns - do l = 1_pInt,lattice_NnonSchmid(structID) - nonSchmidProjection(1:3,1:3,1,s,instance) = nonSchmidProjection(1:3,1:3,1,s,instance) & - + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l,slipSystemLattice(s,instance),structID) - nonSchmidProjection(1:3,1:3,2,s,instance) = nonSchmidProjection(1:3,1:3,2,s,instance) & - + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l+1,slipSystemLattice(s,instance),structID) - enddo - nonSchmidProjection(1:3,1:3,3,s,instance) = -nonSchmidProjection(1:3,1:3,2,s,instance) - nonSchmidProjection(1:3,1:3,4,s,instance) = -nonSchmidProjection(1:3,1:3,1,s,instance) - forall (t = 1:4) & - nonSchmidProjection(1:3,1:3,t,s,instance) = nonSchmidProjection(1:3,1:3,t,s,instance) & - + lattice_Sslip(1:3,1:3,1,slipSystemLattice(s,instance),structID) - enddo - -enddo instancesLoop + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_NONLOCAL_ID) then + !*** Inverse lookup of my slip system family and the slip system in lattice + + l = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + do s = 1_pInt,Nslip(f,instance) + l = l + 1_pInt + slipFamily(l,instance) = f + slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt, phase)) + s + enddo; enddo + + + !*** determine size of state array + + ns = totalNslip(instance) + constitutive_nonlocal_sizeDotState(instance) = int(size(BASICSTATES),pInt) * ns + constitutive_nonlocal_sizeDependentState(instance) = int(size(DEPENDENTSTATES),pInt) * ns + constitutive_nonlocal_sizeState(instance) = constitutive_nonlocal_sizeDotState(instance) & + + constitutive_nonlocal_sizeDependentState(instance) & + + int(size(OTHERSTATES),pInt) * ns + + !*** determine indices to state array + + l = 0_pInt + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoU(s,t,instance) = l + enddo + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoB(s,t,instance) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iRhoD(s,c,instance) = l + enddo + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iGamma(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iRhoF(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iTauF(s,instance) = l + enddo + do s = 1_pInt,ns + l = l + 1_pInt + iTauB(s,instance) = l + enddo + do t = 1_pInt,4_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iV(s,t,instance) = l + enddo + enddo + do c = 1_pInt,2_pInt + do s = 1_pInt,ns + l = l + 1_pInt + iD(s,c,instance) = l + enddo + enddo + if (iD(ns,2,instance) /= constitutive_nonlocal_sizeState(instance)) & ! check if last index is equal to size of state + call IO_error(0_pInt, ext_msg = 'state indices not properly set ('//PLASTICITY_NONLOCAL_label//')') + + + !*** determine size of postResults array + + outputsLoop: do o = 1_pInt,Noutput(instance) + select case(constitutive_nonlocal_outputID(o,instance)) + case( rho_ID, & + delta_ID, & + rho_edge_ID, & + rho_screw_ID, & + rho_sgl_ID, & + delta_sgl_ID, & + rho_sgl_edge_ID, & + rho_sgl_edge_pos_ID, & + rho_sgl_edge_neg_ID, & + rho_sgl_screw_ID, & + rho_sgl_screw_pos_ID, & + rho_sgl_screw_neg_ID, & + rho_sgl_mobile_ID, & + rho_sgl_edge_mobile_ID, & + rho_sgl_edge_pos_mobile_ID, & + rho_sgl_edge_neg_mobile_ID, & + rho_sgl_screw_mobile_ID, & + rho_sgl_screw_pos_mobile_ID, & + rho_sgl_screw_neg_mobile_ID, & + rho_sgl_immobile_ID, & + rho_sgl_edge_immobile_ID, & + rho_sgl_edge_pos_immobile_ID, & + rho_sgl_edge_neg_immobile_ID, & + rho_sgl_screw_immobile_ID, & + rho_sgl_screw_pos_immobile_ID, & + rho_sgl_screw_neg_immobile_ID, & + rho_dip_ID, & + delta_dip_ID, & + rho_dip_edge_ID, & + rho_dip_screw_ID, & + excess_rho_ID, & + excess_rho_edge_ID, & + excess_rho_screw_ID, & + rho_forest_ID, & + shearrate_ID, & + resolvedstress_ID, & + resolvedstress_external_ID, & + resolvedstress_back_ID, & + resistance_ID, & + rho_dot_ID, & + rho_dot_sgl_ID, & + rho_dot_sgl_mobile_ID, & + rho_dot_dip_ID, & + rho_dot_gen_ID, & + rho_dot_gen_edge_ID, & + rho_dot_gen_screw_ID, & + rho_dot_sgl2dip_ID, & + rho_dot_sgl2dip_edge_ID, & + rho_dot_sgl2dip_screw_ID, & + rho_dot_ann_ath_ID, & + rho_dot_ann_the_ID, & + rho_dot_ann_the_edge_ID, & + rho_dot_ann_the_screw_ID, & + rho_dot_edgejogs_ID, & + rho_dot_flux_ID, & + rho_dot_flux_mobile_ID, & + rho_dot_flux_edge_ID, & + rho_dot_flux_screw_ID, & + velocity_edge_pos_ID, & + velocity_edge_neg_ID, & + velocity_screw_pos_ID, & + velocity_screw_neg_ID, & + slipdirectionx_ID, & + slipdirectiony_ID, & + slipdirectionz_ID, & + slipnormalx_ID, & + slipnormaly_ID, & + slipnormalz_ID, & + fluxdensity_edge_posx_ID, & + fluxdensity_edge_posy_ID, & + fluxdensity_edge_posz_ID, & + fluxdensity_edge_negx_ID, & + fluxdensity_edge_negy_ID, & + fluxdensity_edge_negz_ID, & + fluxdensity_screw_posx_ID, & + fluxdensity_screw_posy_ID, & + fluxdensity_screw_posz_ID, & + fluxdensity_screw_negx_ID, & + fluxdensity_screw_negy_ID, & + fluxdensity_screw_negz_ID, & + maximumdipoleheight_edge_ID, & + maximumdipoleheight_screw_ID, & + accumulatedshear_ID ) + mySize = totalNslip(instance) + case(dislocationstress_ID) + mySize = 6_pInt + case default + end select + + if (mySize > 0_pInt) then ! any meaningful output found + constitutive_nonlocal_sizePostResult(o,instance) = mySize + constitutive_nonlocal_sizePostResults(instance) = constitutive_nonlocal_sizePostResults(instance) + mySize + endif + enddo outputsLoop + + do s1 = 1_pInt,ns + f = slipFamily(s1,instance) + + !*** burgers vector, mean free path prefactor and minimum dipole distance for each slip system + + burgers(s1,instance) = burgersPerSlipFamily(f,instance) + lambda0(s1,instance) = lambda0PerSlipFamily(f,instance) + minDipoleHeight(s1,1:2,instance) = minDipoleHeightPerSlipFamily(f,1:2,instance) + peierlsStress(s1,1:2,instance) = peierlsStressPerSlipFamily(f,1:2,instance) + + do s2 = 1_pInt,ns + + !*** calculation of forest projections for edge and screw dislocations. s2 acts as forest for s1 + + forestProjectionEdge(s1,s2,instance) & + = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & + lattice_st(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of edge dislocations is the projection of (t = b x n) onto the slip normal of the respective slip plane + + forestProjectionScrew(s1,s2,instance) & + = abs(math_mul3x3(lattice_sn(1:3,slipSystemLattice(s1,instance),phase), & + lattice_sd(1:3,slipSystemLattice(s2,instance),phase))) ! forest projection of screw dislocations is the projection of b onto the slip normal of the respective splip plane + + !*** calculation of interaction matrices + + interactionMatrixSlipSlip(s1,s2,instance) & + = interactionSlipSlip(lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & + slipSystemLattice(s2,instance), & + phase), instance) + + !*** colinear slip system (only makes sense for fcc like it is defined here) + + if (lattice_interactionSlipSlip(slipSystemLattice(s1,instance), & + slipSystemLattice(s2,instance), & + phase) == 3_pInt) then + colinearSystem(s1,instance) = s2 + endif + + enddo + + !*** rotation matrix from lattice configuration to slip system + + lattice2slip(1:3,1:3,s1,instance) & + = math_transpose33( reshape([ lattice_sd(1:3, slipSystemLattice(s1,instance), phase), & + -lattice_st(1:3, slipSystemLattice(s1,instance), phase), & + lattice_sn(1:3, slipSystemLattice(s1,instance), phase)], [3,3])) + enddo + + + !*** combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws) + !* four types t: + !* 1) positive screw at positive resolved stress + !* 2) positive screw at negative resolved stress + !* 3) negative screw at positive resolved stress + !* 4) negative screw at negative resolved stress + + do s = 1_pInt,ns + do l = 1_pInt,lattice_NnonSchmid(phase) + nonSchmidProjection(1:3,1:3,1,s,instance) = nonSchmidProjection(1:3,1:3,1,s,instance) & + + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l,slipSystemLattice(s,instance),phase) + nonSchmidProjection(1:3,1:3,2,s,instance) = nonSchmidProjection(1:3,1:3,2,s,instance) & + + nonSchmidCoeff(l,instance) * lattice_Sslip(1:3,1:3,2*l+1,slipSystemLattice(s,instance),phase) + enddo + nonSchmidProjection(1:3,1:3,3,s,instance) = -nonSchmidProjection(1:3,1:3,2,s,phase) + nonSchmidProjection(1:3,1:3,4,s,instance) = -nonSchmidProjection(1:3,1:3,1,s,phase) + forall (t = 1:4) & + nonSchmidProjection(1:3,1:3,t,s,instance) = nonSchmidProjection(1:3,1:3,t,s,phase) & + + lattice_Sslip(1:3,1:3,1,slipSystemLattice(s,instance),phase) + enddo + endif + enddo initializeInstances end subroutine constitutive_nonlocal_init - !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- @@ -1354,7 +1273,6 @@ end subroutine constitutive_nonlocal_stateInit pure function constitutive_nonlocal_aTolState(instance) implicit none - !*** input variables integer(pInt), intent(in) :: instance ! number specifying the current instance of the plasticity @@ -1378,33 +1296,6 @@ constitutive_nonlocal_aTolState(iGamma(1:ns,instance)) = aTolShear(instance) end function constitutive_nonlocal_aTolState - -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -pure function constitutive_nonlocal_homogenizedC(ipc,ip,el) - use mesh, only: & - mesh_NcpElems, & - mesh_maxNips - use material, only: & - homogenization_maxNgrains, & - material_phase, & - phase_plasticityInstance - - implicit none - integer(pInt), intent(in) :: & - ipc, & ! current grain ID - ip, & ! current integration point - el ! current element - real(pReal), dimension(6,6) :: & - constitutive_nonlocal_homogenizedC - - constitutive_nonlocal_homogenizedC = & - Cslip66(1:6,1:6,phase_plasticityInstance(material_phase(ipc,ip,el))) - -end function constitutive_nonlocal_homogenizedC - - !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- @@ -1448,7 +1339,12 @@ use material, only: & phase_plasticityInstance use lattice, only: & lattice_sd, & - lattice_st + lattice_st, & + lattice_mu, & + lattice_nu, & + lattice_structure, & + LATTICE_bcc_ID, & + LATTICE_fcc_ID implicit none @@ -1469,10 +1365,8 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in !*** local variables integer(pInt) neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point - instance, & ! my instance of this plasticity - neighbor_instance, & ! instance of this plasticity of neighboring material point - structID, & ! my lattice structure - neighbor_structID, & ! lattice structure of neighboring material point + instance, & ! my instance of this plasticity + neighbor_instance, & ! instance of this plasticity of neighboring material point phase, & neighbor_phase, & ns, & ! total number of active slip systems at my material point @@ -1515,8 +1409,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(gr,ip, totalNslip(phase_plasticityInstance(material_phase(gr,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & - neighbor_rhoExcess, & ! excess density at neighboring material point - neighbor_rhoTotal ! total density at neighboring material point + neighbor_rhoExcess, & ! excess density at neighboring material point + neighbor_rhoTotal ! total density at neighboring material point real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(gr,ip,el))),2) :: & m ! direction of dislocation motion logical inversionError @@ -1524,7 +1418,6 @@ logical inversionError phase = material_phase(gr,ip,el) instance = phase_plasticityInstance(phase) -structID = constitutive_nonlocal_structure(instance) ns = totalNslip(instance) @@ -1561,7 +1454,7 @@ forall (s = 1_pInt:ns) & myInteractionMatrix = 0.0_pReal myInteractionMatrix(1:ns,1:ns) = interactionMatrixSlipSlip(1:ns,1:ns,instance) -if (structID < 3_pInt) then ! only fcc and bcc +if (lattice_structure(phase) == LATTICE_bcc_ID .or. lattice_structure(phase) == LATTICE_fcc_ID) then ! only fcc and bcc do s = 1_pInt,ns myRhoForest = max(rhoForest(s),significantRho(instance)) correction = ( 1.0_pReal - linetensionEffect(instance) & @@ -1572,7 +1465,7 @@ if (structID < 3_pInt) then enddo endif forall (s = 1_pInt:ns) & - tauThreshold(s) = mu(instance) * burgers(s,instance) & + tauThreshold(s) = lattice_mu(phase) * burgers(s,instance) & * sqrt(dot_product((sum(abs(rhoSgl),2) + sum(abs(rhoDip),2)), myInteractionMatrix(s,1:ns))) @@ -1599,23 +1492,21 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance if (neighbor_el > 0 .and. neighbor_ip > 0) then neighbor_phase = material_phase(gr,neighbor_ip,neighbor_el) neighbor_instance = phase_plasticityInstance(neighbor_phase) - neighbor_structID = constitutive_nonlocal_structure(neighbor_instance) neighbor_ns = totalNslip(neighbor_instance) if (.not. phase_localPlasticity(neighbor_phase) & - .and. neighbor_structID == structID & - .and. neighbor_instance == instance) then + .and. neighbor_instance == instance) then ! same instance should be same structure if (neighbor_ns == ns) then nRealNeighbors = nRealNeighbors + 1_pInt forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) neighbor_rhoExcess(c,s,n) = & - max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) & ! positive mobiles - - max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) ! negative mobiles + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) &! positive mobiles + - max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) ! negative mobiles neighbor_rhoTotal(c,s,n) = & - max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) & ! positive mobiles - + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) & ! negative mobiles - + abs(state(gr,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c-1,neighbor_instance))) & ! positive deads - + abs(state(gr,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c,neighbor_instance))) & ! negative deads - + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoD(s,c,neighbor_instance)), 0.0_pReal) ! dipoles + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c-1,neighbor_instance)), 0.0_pReal) &! positive mobiles + + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoU(s,2*c,neighbor_instance)), 0.0_pReal) & ! negative mobiles + + abs(state(gr,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c-1,neighbor_instance))) & ! positive deads + + abs(state(gr,neighbor_ip,neighbor_el)%p(iRhoB(s,2*c,neighbor_instance))) & ! negative deads + + max(state(gr,neighbor_ip,neighbor_el)%p(iRhoD(s,c,neighbor_instance)), 0.0_pReal) ! dipoles endforall connection_latticeConf(1:3,n) = & math_mul33x3(invFe, mesh_ipCoordinates(1:3,neighbor_ip,neighbor_el) & @@ -1646,8 +1537,8 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance !* 1. interpolation of the excess density in the neighorhood !* 2. interpolation of the dead dislocation density in the central volume - m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),structID) - m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),structID) + m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),phase) + m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),phase) do s = 1_pInt,ns @@ -1681,17 +1572,15 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance rhoExcessGradient_over_rho = 0.0_pReal forall (c = 1_pInt:2_pInt) & - rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) & - + sum(neighbor_rhoTotal(c,s,:))) & + rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) + sum(neighbor_rhoTotal(c,s,:))) & / real(1_pInt + nRealNeighbors,pReal) forall (c = 1_pInt:2_pInt, rhoTotal(c) > 0.0_pReal) & rhoExcessGradient_over_rho(c) = rhoExcessGradient(c) / rhoTotal(c) !* gives the local stress correction when multiplied with a factor - tauBack(s) = - mu(instance) * burgers(s,instance) / (2.0_pReal * pi) & - * (rhoExcessGradient_over_rho(1) / (1.0_pReal - nu(instance)) & - + rhoExcessGradient_over_rho(2)) + tauBack(s) = - lattice_mu(phase) * burgers(s,instance) / (2.0_pReal * pi) & + * (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(phase)) + rhoExcessGradient_over_rho(2)) enddo endif @@ -1926,7 +1815,7 @@ real(pReal), dimension(9,9), intent(out) :: dLp_dTstar99 !< deriv !*** local variables integer(pInt) instance, & !< current instance of this plasticity - structID, & !< current lattice structure + phase, & !< phase ns, & !< short notation for the total number of active slip systems i, & j, & @@ -1955,8 +1844,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal -instance = phase_plasticityInstance(material_phase(ipc,ip,el)) -structID = constitutive_nonlocal_structure(instance) +phase = material_phase(ipc,ip,el) +instance = phase_plasticityInstance(phase) ns = totalNslip(instance) @@ -1980,7 +1869,7 @@ tauThreshold = state%p(iTauF(1:ns,instance)) do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,structID)) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) tauNS(s,1) = tau(s) tauNS(s,2) = tau(s) if (tau(s) > 0.0_pReal) then @@ -2007,7 +1896,7 @@ dv_dtau(1:ns,2) = dv_dtau(1:ns,1) dv_dtauNS(1:ns,2) = dv_dtauNS(1:ns,1) !screws -if (lattice_NnonSchmid(structID) == 0_pInt) then ! no non-Schmid contributions +if (lattice_NnonSchmid(phase) == 0_pInt) then ! no non-Schmid contributions forall(t = 3_pInt:4_pInt) v(1:ns,t) = v(1:ns,1) dv_dtau(1:ns,t) = dv_dtau(1:ns,1) @@ -2040,26 +1929,26 @@ gdotTotal = sum(rhoSgl(1:ns,1:4) * v, 2) * burgers(1:ns,instance) do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,structID) + Lp = Lp + gdotTotal(s) * lattice_Sslip(1:3,1:3,1,sLattice,phase) ! Schmid contributions to tangent forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,structID) * lattice_Sslip(k,l,1,sLattice,structID) & + + lattice_Sslip(i,j,1,sLattice,phase) * lattice_Sslip(k,l,1,sLattice,phase) & * sum(rhoSgl(s,1:4) * dv_dtau(s,1:4)) * burgers(s,instance) ! non Schmid contributions to tangent if (tau(s) > 0.0_pReal) then forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,structID) & + + lattice_Sslip(i,j,1,sLattice,phase) & * ( nonSchmidProjection(k,l,1,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + nonSchmidProjection(k,l,3,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & * burgers(s,instance) else forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt,k=1_pInt:3_pInt,l=1_pInt:3_pInt) & dLp_dTstar3333(i,j,k,l) = dLp_dTstar3333(i,j,k,l) & - + lattice_Sslip(i,j,1,sLattice,structID) & + + lattice_Sslip(i,j,1,sLattice,phase) & * ( nonSchmidProjection(k,l,2,s,instance) * rhoSgl(s,3) * dv_dtauNS(s,3) & + nonSchmidProjection(k,l,4,s,instance) * rhoSgl(s,4) * dv_dtauNS(s,4) ) & * burgers(s,instance) @@ -2098,7 +1987,9 @@ use debug, only: debug_level, & debug_e use math, only: pi, & math_mul6x6 -use lattice, only: lattice_Sslip_v +use lattice, only: lattice_Sslip_v ,& + lattice_mu, & + lattice_nu use mesh, only: mesh_NcpElems, & mesh_maxNips, & mesh_ipVolume @@ -2122,17 +2013,17 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in type(p_vec), intent(out) :: deltaState ! change of state variables / microstructure !*** local variables -integer(pInt) instance, & ! current instance of this plasticity - structID, & ! current lattice structure +integer(pInt) phase, & + instance, & ! current instance of this plasticity ns, & ! short notation for the total number of active slip systems c, & ! character of dislocation t, & ! type of dislocation s, & ! index of my current slip system sLattice ! index of my current slip system according to lattice order real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),10) :: & - deltaRho, & ! density increment - deltaRhoRemobilization, & ! density increment by remobilization - deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) + deltaRho, & ! density increment + deltaRhoRemobilization, & ! density increment by remobilization + deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & rhoSgl ! current single dislocation densities (positive/negative screw and edge without dipoles) real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),4) :: & @@ -2158,8 +2049,8 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip endif #endif -instance = phase_plasticityInstance(material_phase(ipc,ip,el)) -structID = constitutive_nonlocal_structure(instance) +phase = material_phase(ipc,ip,el) +instance = phase_plasticityInstance(phase) ns = totalNslip(instance) @@ -2167,12 +2058,12 @@ ns = totalNslip(instance) forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) v(s,t) = state(ipc,ip,el)%p(iV(s,t,instance)) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities + rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities dUpperOld(s,c) = state(ipc,ip,el)%p(iD(s,c,instance)) endforall tauBack = state(ipc,ip,el)%p(iTauB(1:ns,instance)) @@ -2211,13 +2102,13 @@ enddo do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,structID)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = mu(instance) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - nu(instance)) * abs(tau)) -dUpper(1:ns,2) = mu(instance) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) +dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & + abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), & @@ -2230,8 +2121,7 @@ deltaDUpper = dUpper - dUpperOld deltaRhoDipole2SingleStress = 0.0_pReal forall (c=1_pInt:2_pInt, s=1_pInt:ns, deltaDUpper(s,c) < 0.0_pReal) & - deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) & - / (dUpperOld(s,c) - dLower(s,c)) + deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) / (dUpperOld(s,c) - dLower(s,c)) forall (t=1_pInt:4_pInt) & deltaRhoDipole2SingleStress(1_pInt:ns,t) = -0.5_pReal * deltaRhoDipole2SingleStress(1_pInt:ns,(t-1_pInt)/2_pInt+9_pInt) @@ -2264,10 +2154,8 @@ forall (s = 1:ns, c = 1_pInt:2_pInt) & if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then - write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', & - deltaRhoRemobilization(1:ns,1:8) - write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole dissociation by stress increase', & - deltaRhoDipole2SingleStress + write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8) + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress write(6,*) endif #endif @@ -2320,7 +2208,12 @@ use material, only: homogenization_maxNgrains, & PLASTICITY_NONLOCAL_ID use lattice, only: lattice_Sslip_v, & lattice_sd, & - lattice_st + lattice_st ,& + lattice_mu, & + lattice_nu, & + lattice_structure, & + LATTICE_bcc_ID, & + LATTICE_fcc_ID implicit none @@ -2345,9 +2238,9 @@ real(pReal), dimension(constitutive_nonlocal_sizeDotState(phase_plasticityInstan constitutive_nonlocal_dotState !< evolution of state variables / microstructure !*** local variables -integer(pInt) instance, & !< current instance of this plasticity - neighbor_instance, & !< instance of my neighbor's plasticity - structID, & !< current lattice structure +integer(pInt) :: phase, & + instance, & !< current instance of this plasticity + neighbor_instance, & !< instance of my neighbor's plasticity ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation n, & !< index of my current neighbor @@ -2423,9 +2316,8 @@ logical considerEnteringFlux, & endif #endif - -instance = phase_plasticityInstance(material_phase(ipc,ip,el)) -structID = constitutive_nonlocal_structure(instance) +phase = material_phase(ipc,ip,el) +instance = phase_plasticityInstance(phase) ns = totalNslip(instance) tau = 0.0_pReal @@ -2436,12 +2328,12 @@ gdot = 0.0_pReal forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) v(s,t) = state(ipc,ip,el)%p(iV(s,t,instance)) endforall forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) - rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities + rhoDip(s,c) = max(state(ipc,ip,el)%p(iRhoD(s,c,instance)), 0.0_pReal) ! ensure positive dipole densities endforall rhoForest = state(ipc,ip,el)%p(iRhoF(1:ns,instance)) tauThreshold = state(ipc,ip,el)%p(iTauF(1:ns,instance)) @@ -2500,14 +2392,14 @@ forall (t = 1_pInt:4_pInt) & do s = 1_pInt,ns ! loop over slip systems sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,structID)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = mu(instance) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - nu(instance)) * abs(tau)) -dUpper(1:ns,2) = mu(instance) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & @@ -2521,13 +2413,13 @@ dUpper = max(dUpper,dLower) !*** calculate dislocation multiplication rhoDotMultiplication = 0.0_pReal -if (structID == 2_pInt) then ! BCC +if (lattice_structure(phase) == LATTICE_bcc_ID) then ! BCC forall (s = 1:ns, sum(abs(v(s,1:4))) > 0.0_pReal) - rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + rhoDotMultiplication(s,1:2) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation - rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication - * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path + rhoDotMultiplication(s,3:4) = sum(abs(gdot(s,3:4))) / burgers(s,instance) & ! assuming double-cross-slip of screws to be decisive for multiplication + * sqrt(rhoForest(s)) / lambda0(s,instance) ! & ! mean free path ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation endforall @@ -2606,10 +2498,10 @@ if (.not. phase_localPlasticity(material_phase(ipc,ip,el))) then !*** be aware of the definition of lattice_st = lattice_sd x lattice_sn !!! !*** opposite sign to our p vector in the (s,p,n) triplet !!! - m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), structID) - m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), structID) - m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), structID) - m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), structID) + m(1:3,1:ns,1) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) + m(1:3,1:ns,2) = -lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) + m(1:3,1:ns,3) = -lattice_st(1:3, slipSystemLattice(1:ns,instance), phase) + m(1:3,1:ns,4) = lattice_st(1:3, slipSystemLattice(1:ns,instance), phase) my_Fe = Fe(1:3,1:3,ipc,ip,el) my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,ipc,ip,el)) @@ -2797,7 +2689,7 @@ forall (c=1_pInt:2_pInt) & + 2.0_pReal * (abs(rhoSgl(1:ns,2*c+3)) * abs(gdot(1:ns,2*c)) + abs(rhoSgl(1:ns,2*c+4)) * abs(gdot(1:ns,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single + rhoDip(1:ns,c) * (abs(gdot(1:ns,2*c-1)) + abs(gdot(1:ns,2*c)))) ! single knocks dipole constituent ! annihilated screw dipoles leave edge jogs behind on the colinear system -if (structID == 1_pInt) then ! only fcc +if (lattice_structure(phase) == LATTICE_fcc_ID) then ! only fcc forall (s = 1:ns, colinearSystem(s,instance) > 0_pInt) & rhoDotAthermalAnnihilation(colinearSystem(s,instance),1:2) = - rhoDotAthermalAnnihilation(s,10) & * 0.25_pReal * sqrt(rhoForest(s)) * (dUpper(s,2) + dLower(s,2)) * edgeJogFactor(instance) @@ -2809,12 +2701,11 @@ endif rhoDotThermalAnnihilation = 0.0_pReal selfDiffusion = Dsd0(instance) * exp(-selfDiffusionEnergy(instance) / (KB * Temperature)) vClimb = atomicVolume(instance) * selfDiffusion / ( KB * Temperature ) & - * mu(instance) / ( 2.0_pReal * PI * (1.0_pReal-nu(instance)) ) & + * lattice_mu(phase) / ( 2.0_pReal * PI * (1.0_pReal-lattice_nu(phase)) ) & * 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) ) forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) & rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), & - - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have + - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have @@ -2829,7 +2720,7 @@ rhoDot = rhoDotFlux & + rhoDotAthermalAnnihilation & + rhoDotThermalAnnihilation -if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode +if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode rhoDotFluxOutput(1:ns,1:8,ipc,ip,el) = rhoDotFlux(1:ns,1:8) rhoDotMultiplicationOutput(1:ns,1:2,ipc,ip,el) = rhoDotMultiplication(1:ns,[1,3]) rhoDotSingle2DipoleGlideOutput(1:ns,1:2,ipc,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) @@ -2843,12 +2734,9 @@ endif if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then - write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', & - rhoDotMultiplication(1:ns,1:4) * timestep - write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', & - rhoDotFlux(1:ns,1:8) * timestep - write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', & - rhoDotSingle2DipoleGlide * timestep + write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', rhoDotMultiplication(1:ns,1:4) * timestep + write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', rhoDotFlux(1:ns,1:8) * timestep + write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', rhoDotSingle2DipoleGlide * timestep write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> athermal dipole annihilation', & rhoDotAthermalAnnihilation * timestep write(6,'(a,/,2(12x,12(e12.5,1x),/))') '<< CONST >> thermally activated dipole annihilation', & @@ -2934,8 +2822,7 @@ integer(pInt) Nneighbors, & ! neighbor_phase, & textureID, & neighbor_textureID, & - structID, & ! lattice structure - instance, & ! instance of plasticity + instance, & ! instance of plasticity ns, & ! number of active slip systems s1, & ! slip system index (me) s2 ! slip system index (my neighbor) @@ -2958,10 +2845,9 @@ Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) phase = material_phase(1,i,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(phase) -structID = constitutive_nonlocal_structure(instance) ns = totalNslip(instance) -slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), structID) -slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), structID) +slipNormal(1:3,1:ns) = lattice_sn(1:3, slipSystemLattice(1:ns,instance), phase) +slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), phase) !*** start out fully compatible @@ -3029,8 +2915,8 @@ do n = 1_pInt,Nneighbors !* All values below the threshold are set to zero. else absoluteMisorientation = lattice_qDisorientation(orientation(1:4,1,i,e), & - orientation(1:4,1,neighbor_i,neighbor_e), & - 0_pInt) ! no symmetry + orientation(1:4,1,neighbor_i,neighbor_e), & + 0_pInt) ! no symmetry do s1 = 1_pInt,ns ! my slip systems do s2 = 1_pInt,ns ! my neighbor's slip systems my_compatibility(1,s2,s1,n) = math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2))) & @@ -3042,7 +2928,7 @@ do n = 1_pInt,Nneighbors my_compatibilitySum = 0.0_pReal belowThreshold = .true. do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold(1:ns))) - thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive + thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) == thresholdValue),pReal) where (my_compatibility(2,1:ns,s1,n) >= thresholdValue) & belowThreshold(1:ns) = .false. @@ -3087,18 +2973,20 @@ use material, only: homogenization_maxNgrains, & material_phase, & phase_localPlasticity, & phase_plasticityInstance +use lattice, only: lattice_mu, & + lattice_nu implicit none !*** input variables -integer(pInt), intent(in) :: ipc, & !< current grain ID - ip, & !< current integration point - el !< current element +integer(pInt), intent(in) :: ipc, & ! current grain ID + ip, & ! current integration point + el ! current element real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - Fe !< elastic deformation gradient + Fe ! elastic deformation gradient type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - state !< microstructural state + state ! microstructural state !*** input/output variables @@ -3106,57 +2994,54 @@ type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), in real(pReal), dimension(3,3) :: constitutive_nonlocal_dislocationstress !*** local variables -integer(pInt) neighbor_el, & !< element number of neighbor material point - neighbor_ip, & !< integration point of neighbor material point - instance, & !< my instance of this plasticity - neighbor_instance, & !< instance of this plasticity of neighbor material point - structID, & !< my lattice structure - neighbor_structID, & !< lattice structure of neighbor material point +integer(pInt) neighbor_el, & ! element number of neighbor material point + neighbor_ip, & ! integration point of neighbor material point + instance, & ! my instance of this plasticity + neighbor_instance, & ! instance of this plasticity of neighbor material point phase, & neighbor_phase, & - ns, & !< total number of active slip systems at my material point - neighbor_ns, & !< total number of active slip systems at neighbor material point - c, & !< index of dilsocation character (edge, screw) - s, & !< slip system index - t, & !< index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) + ns, & ! total number of active slip systems at my material point + neighbor_ns, & ! total number of active slip systems at neighbor material point + c, & ! index of dilsocation character (edge, screw) + s, & ! slip system index + t, & ! index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-) dir, & deltaX, deltaY, deltaZ, & side, & j integer(pInt), dimension(2,3) :: periodicImages -real(pReal) x, y, z, & !< coordinates of connection vector in neighbor lattice frame - xsquare, ysquare, zsquare, & !< squares of respective coordinates - distance, & !< length of connection vector - segmentLength, & !< segment length of dislocations +real(pReal) x, y, z, & ! coordinates of connection vector in neighbor lattice frame + xsquare, ysquare, zsquare, & ! squares of respective coordinates + distance, & ! length of connection vector + segmentLength, & ! segment length of dislocations lambda, & R, Rsquare, Rcube, & denominator, & flipSign, & neighbor_ipVolumeSideLength, & detFe -real(pReal), dimension(3) :: connection, & !< connection vector between me and my neighbor in the deformed configuration - connection_neighborLattice, & !< connection vector between me and my neighbor in the lattice configuration of my neighbor - connection_neighborSlip, & !< connection vector between me and my neighbor in the slip system frame of my neighbor +real(pReal), dimension(3) :: connection, & ! connection vector between me and my neighbor in the deformed configuration + connection_neighborLattice, & ! connection vector between me and my neighbor in the lattice configuration of my neighbor + connection_neighborSlip, & ! connection vector between me and my neighbor in the slip system frame of my neighbor maxCoord, minCoord, & meshSize, & - coords, & !< x,y,z coordinates of cell center of ip volume - neighbor_coords !< x,y,z coordinates of cell center of neighbor ip volume -real(pReal), dimension(3,3) :: sigma, & !< dislocation stress for one slip system in neighbor material point's slip system frame - Tdislo_neighborLattice, & !< dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point - invFe, & !< inverse of my elastic deformation gradient + coords, & ! x,y,z coordinates of cell center of ip volume + neighbor_coords ! x,y,z coordinates of cell center of neighbor ip volume +real(pReal), dimension(3,3) :: sigma, & ! dislocation stress for one slip system in neighbor material point's slip system frame + Tdislo_neighborLattice, & ! dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point + invFe, & ! inverse of my elastic deformation gradient neighbor_invFe, & - neighborLattice2myLattice !< mapping from neighbor MPs lattice configuration to my lattice configuration + neighborLattice2myLattice ! mapping from neighbor MPs lattice configuration to my lattice configuration real(pReal), dimension(2,2,maxval(totalNslip)) :: & - neighbor_rhoExcess !< excess density at neighbor material point (edge/screw,mobile/dead,slipsystem) + neighbor_rhoExcess ! excess density at neighbor material point (edge/screw,mobile/dead,slipsystem) real(pReal), dimension(2,maxval(totalNslip)) :: & rhoExcessDead real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: & - rhoSgl !< single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) + rhoSgl ! single dislocation density (edge+, edge-, screw+, screw-, used edge+, used edge-, used screw+, used screw-) logical inversionError phase = material_phase(ipc,ip,el) instance = phase_plasticityInstance(phase) -structID = constitutive_nonlocal_structure(instance) ns = totalNslip(instance) @@ -3164,7 +3049,7 @@ ns = totalNslip(instance) !*** get basic states forall (s = 1_pInt:ns, t = 1_pInt:4_pInt) - rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities + rhoSgl(s,t) = max(state(ipc,ip,el)%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities rhoSgl(s,t+4_pInt) = state(ipc,ip,el)%p(iRhoB(s,t,instance)) endforall @@ -3205,7 +3090,6 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) cycle endif neighbor_instance = phase_plasticityInstance(neighbor_phase) - neighbor_structID = constitutive_nonlocal_structure(neighbor_instance) neighbor_ns = totalNslip(neighbor_instance) call math_invert33(Fe(1:3,1:3,1,neighbor_ip,neighbor_el), neighbor_invFe, detFe, inversionError) neighbor_ipVolumeSideLength = mesh_ipVolume(neighbor_ip,neighbor_el) ** (1.0_pReal/3.0_pReal) ! reference volume used here @@ -3271,10 +3155,9 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) if (abs(neighbor_rhoExcess(1,j,s)) < significantRho(instance)) then cycle elseif (j > 1_pInt) then - x = connection_neighborSlip(1) & - + sign(0.5_pReal * segmentLength, & - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,1,neighbor_instance)) & - - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2,neighbor_instance))) + x = connection_neighborSlip(1) + sign(0.5_pReal * segmentLength, & + state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,1,neighbor_instance)) & + - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2,neighbor_instance))) xsquare = x * x endif @@ -3294,7 +3177,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) * (1.0_pReal + xsquare / Rsquare + xsquare / denominator) & * neighbor_rhoExcess(1,j,s) sigma(2,2) = sigma(2,2) - real(side,pReal) & - * (flipSign * 2.0_pReal * nu(instance) * z / denominator + z * lambda / Rcube) & + * (flipSign * 2.0_pReal * lattice_nu(phase) * z / denominator + z * lambda / Rcube) & * neighbor_rhoExcess(1,j,s) sigma(3,3) = sigma(3,3) + real(side,pReal) & * flipSign * z / denominator & @@ -3307,7 +3190,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) * (1.0_pReal - zsquare / Rsquare - zsquare / denominator) & * neighbor_rhoExcess(1,j,s) sigma(2,3) = sigma(2,3) - real(side,pReal) & - * (nu(instance) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) + * (lattice_nu(phase) / R - zsquare / Rcube) * neighbor_rhoExcess(1,j,s) enddo enddo @@ -3318,10 +3201,9 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) if (abs(neighbor_rhoExcess(2,j,s)) < significantRho(instance)) then cycle elseif (j > 1_pInt) then - y = connection_neighborSlip(2) & - + sign(0.5_pReal * segmentLength, & - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,3,neighbor_instance)) & - - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,4,neighbor_instance))) + y = connection_neighborSlip(2) + sign(0.5_pReal * segmentLength, & + state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,3,neighbor_instance)) & + - state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,4,neighbor_instance))) ysquare = y * y endif @@ -3336,12 +3218,10 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) exit ipLoop endif - sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z & - * (1.0_pReal - nu(instance)) / denominator & - * neighbor_rhoExcess(2,j,s) - sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y & - * (1.0_pReal - nu(instance)) / denominator & - * neighbor_rhoExcess(2,j,s) + sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z * (1.0_pReal - lattice_nu(phase)) / denominator & + * neighbor_rhoExcess(2,j,s) + sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y * (1.0_pReal - lattice_nu(phase)) / denominator & + * neighbor_rhoExcess(2,j,s) enddo enddo @@ -3358,9 +3238,9 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) !* scale stresses and map them into the neighbor material point's lattice configuration - sigma = sigma * mu(neighbor_instance) * burgers(s,neighbor_instance) & - / (4.0_pReal * pi * (1.0_pReal - nu(neighbor_instance))) & - * mesh_ipVolume(neighbor_ip,neighbor_el) / segmentLength ! reference volume is used here (according to the segment length calculation) + sigma = sigma * lattice_mu(neighbor_phase) * burgers(s,neighbor_instance) & + / (4.0_pReal * pi * (1.0_pReal - lattice_nu(neighbor_phase))) & + * mesh_ipVolume(neighbor_ip,neighbor_el) / segmentLength ! reference volume is used here (according to the segment length calculation) Tdislo_neighborLattice = Tdislo_neighborLattice & + math_mul33x33(math_transpose33(lattice2slip(1:3,1:3,s,neighbor_instance)), & math_mul33x33(sigma, lattice2slip(1:3,1:3,s,neighbor_instance))) @@ -3376,17 +3256,17 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el)) else forall (s = 1_pInt:ns, c = 1_pInt:2_pInt) & - rhoExcessDead(c,s) = state(ipc,ip,el)%p(iRhoB(s,2*c-1,instance)) & ! positive deads (here we use symmetry: if this has negative sign it is treated as negative density at positive position instead of positive density at negative position) - + state(ipc,ip,el)%p(iRhoB(s,2*c,instance)) ! negative deads (here we use symmetry: if this has negative sign it is treated as positive density at positive position instead of negative density at negative position) + rhoExcessDead(c,s) = state(ipc,ip,el)%p(iRhoB(s,2*c-1,instance)) & ! positive deads (here we use symmetry: if this has negative sign it is treated as negative density at positive position instead of positive density at negative position) + + state(ipc,ip,el)%p(iRhoB(s,2*c,instance)) ! negative deads (here we use symmetry: if this has negative sign it is treated as positive density at positive position instead of negative density at negative position) do s = 1_pInt,ns if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) then cycle ! not significant endif sigma = 0.0_pReal ! all components except for sigma13 are zero - sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - nu(instance))) & - * neighbor_ipVolumeSideLength * mu(instance) * burgers(s,instance) & - / (sqrt(2.0_pReal) * pi * (1.0_pReal - nu(instance))) + sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(phase))) & + * neighbor_ipVolumeSideLength * lattice_mu(phase) * burgers(s,instance) & + / (sqrt(2.0_pReal) * pi * (1.0_pReal - lattice_nu(phase))) sigma(3,1) = sigma(1,3) Tdislo_neighborLattice = Tdislo_neighborLattice & @@ -3440,8 +3320,10 @@ pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip lattice_Sslip_v, & lattice_sd, & lattice_st, & - lattice_sn - + lattice_sn, & + lattice_mu, & + lattice_nu + implicit none real(pReal), dimension(6), intent(in) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation @@ -3460,8 +3342,8 @@ pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip constitutive_nonlocal_postResults integer(pInt) :: & + phase, & instance, & !< current instance of this plasticity - structID, & !< current lattice structure ns, & !< short notation for the total number of active slip systems c, & !< character of dislocation cs, & !< constitutive result index @@ -3493,8 +3375,8 @@ pure function constitutive_nonlocal_postResults(Tstar_v,Fe,state,dotState,ipc,ip real(pReal), dimension(3,3) :: & sigma -instance = phase_plasticityInstance(material_phase(ipc,ip,el)) -structID = constitutive_nonlocal_structure(instance) +phase = material_phase(ipc,ip,el) +instance = phase_plasticityInstance(phase) ns = totalNslip(instance) cs = 0_pInt @@ -3530,14 +3412,14 @@ forall (t = 1_pInt:4_pInt) & do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,structID)) + tauBack(s) + tau(s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) + tauBack(s) if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal enddo dLower = minDipoleHeight(1:ns,1:2,instance) -dUpper(1:ns,1) = mu(instance) * burgers(1:ns,instance) & - / (8.0_pReal * pi * (1.0_pReal - nu(instance)) * abs(tau)) -dUpper(1:ns,2) = mu(instance) * burgers(1:ns,instance) & +dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) & + / (8.0_pReal * pi * (1.0_pReal - lattice_nu(phase)) * abs(tau)) +dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) & / (4.0_pReal * pi * abs(tau)) forall (c = 1_pInt:2_pInt) & dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) & @@ -3548,13 +3430,13 @@ dUpper = max(dUpper,dLower) !*** dislocation motion -m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),structID) -m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),structID) +m(1:3,1:ns,1) = lattice_sd(1:3,slipSystemLattice(1:ns,instance),phase) +m(1:3,1:ns,2) = -lattice_st(1:3,slipSystemLattice(1:ns,instance),phase) forall (c = 1_pInt:2_pInt, s = 1_pInt:ns) & m_currentconf(1:3,s,c) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), m(1:3,s,c)) forall (s = 1_pInt:ns) & n_currentconf(1:3,s) = math_mul33x3(Fe(1:3,1:3,ipc,ip,el), & - lattice_sn(1:3,slipSystemLattice(s,instance),structID)) + lattice_sn(1:3,slipSystemLattice(s,instance),phase)) outputsLoop: do o = 1_pInt,phase_Noutput(material_phase(ipc,ip,el)) @@ -3715,7 +3597,7 @@ outputsLoop: do o = 1_pInt,phase_Noutput(material_phase(ipc,ip,el)) case (resolvedstress_external_ID) do s = 1_pInt,ns sLattice = slipSystemLattice(s,instance) - constitutive_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,structID)) + constitutive_nonlocal_postResults(cs+s) = math_mul6x6(Tstar_v, lattice_Sslip_v(1:6,1,sLattice,phase)) enddo cs = cs + ns diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 089552a4b..a7c2d7adb 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -34,8 +34,7 @@ module constitutive_phenopowerlaw integer(pInt), dimension(:), allocatable, public, protected :: & constitutive_phenopowerlaw_sizeDotState, & constitutive_phenopowerlaw_sizeState, & - constitutive_phenopowerlaw_sizePostResults, & !< cumulative size of post results - constitutive_phenopowerlaw_structure + constitutive_phenopowerlaw_sizePostResults !< cumulative size of post results integer(pInt), dimension(:,:), allocatable, target, public :: & constitutive_phenopowerlaw_sizePostResult !< size of each post result output @@ -87,8 +86,8 @@ module constitutive_phenopowerlaw constitutive_phenopowerlaw_hardeningMatrix_SlipSlip, & constitutive_phenopowerlaw_hardeningMatrix_SlipTwin, & constitutive_phenopowerlaw_hardeningMatrix_TwinSlip, & - constitutive_phenopowerlaw_hardeningMatrix_TwinTwin, & - constitutive_phenopowerlaw_Cslip_66 + constitutive_phenopowerlaw_hardeningMatrix_TwinTwin + enum, bind(c) enumerator :: undefined_ID, & resistance_slip_ID, & @@ -109,7 +108,6 @@ module constitutive_phenopowerlaw constitutive_phenopowerlaw_init, & constitutive_phenopowerlaw_stateInit, & constitutive_phenopowerlaw_aTolState, & - constitutive_phenopowerlaw_homogenizedC, & constitutive_phenopowerlaw_LpAndItsTangent, & constitutive_phenopowerlaw_dotState, & constitutive_phenopowerlaw_postResults @@ -160,16 +158,13 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt), dimension(7) :: configNchunks integer(pInt) :: & maxNinstance, & - instance,j,k, f,o, & + instance,phase,j,k, f,o, & Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, Nchunks_nonSchmid, & - structID, index_myFamily, index_otherFamily, & - mySize=0_pInt, section = 0_pInt - character(len=32) :: & - structure = '' + index_myFamily, index_otherFamily, & + mySize=0_pInt character(len=65536) :: & tag = '', & line = '' @@ -184,15 +179,7 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - Nchunks_SlipFamilies = lattice_maxNslipFamily - Nchunks_TwinFamilies = lattice_maxNtwinFamily - Nchunks_SlipSlip = lattice_maxNinteraction - Nchunks_SlipTwin = lattice_maxNinteraction - Nchunks_TwinSlip = lattice_maxNinteraction - Nchunks_TwinTwin = lattice_maxNinteraction - Nchunks_nonSchmid = lattice_maxNnonSchmid - + allocate(constitutive_phenopowerlaw_sizeDotState(maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_sizeState(maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) @@ -202,12 +189,10 @@ 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_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) allocate(constitutive_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) allocate(constitutive_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(constitutive_phenopowerlaw_Cslip_66(6,6,maxNinstance), source=0.0_pReal) allocate(constitutive_phenopowerlaw_gdot0_slip(maxNinstance), source=0.0_pReal) allocate(constitutive_phenopowerlaw_n_slip(maxNinstance), source=0.0_pReal) allocate(constitutive_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance), & @@ -243,40 +228,38 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) source=0.0_pReal) rewind(fileUnit) + phase = 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 phase part + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase 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 ! advance section counter - if (phase_plasticity(section) == PLASTICITY_PHENOPOWERLAW_ID) then - instance = phase_plasticityInstance(section) - constitutive_phenopowerlaw_Cslip_66(1:6,1:6,instance) = lattice_Cslip_66(1:6,1:6,section) - constitutive_phenopowerlaw_structure(instance) = 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) + if (IO_getTag(line,'[',']') /= '') then ! next phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) endif cycle ! skip to next line 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 - instance = phase_plasticityInstance(section) ! which instance of my plasticity is present phase + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! 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','covera_ratio',& + case ('plasticity','elasticity','lattice_structure', & + 'covera_ratio','c/a_ratio','c/a', & 'c11','c12','c13','c22','c23','c33','c44','c55','c66') case ('(output)') constitutive_phenopowerlaw_Noutput(instance) = constitutive_phenopowerlaw_Noutput(instance) + 1_pInt @@ -401,47 +384,49 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') end select endif; endif - enddo + enddo parsingFile - sanityChecks: do instance = 1_pInt,maxNinstance - constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,constitutive_phenopowerlaw_structure(instance)),& ! limit active slip systems per family to min of available and requested + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + instance = phase_plasticityInstance(phase) + constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested constitutive_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance)) - constitutive_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,instance) = & - min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,constitutive_phenopowerlaw_structure(instance)),& ! limit active twin systems per family to min of available and requested + constitutive_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,instance) = & + min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested constitutive_phenopowerlaw_Ntwin(:,instance)) - constitutive_phenopowerlaw_totalNslip(instance) = sum(constitutive_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether - constitutive_phenopowerlaw_totalNtwin(instance) = sum(constitutive_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether - - if (any(constitutive_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(constitutive_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(constitutive_phenopowerlaw_a_slip(instance) == 0.0_pReal .and. & - constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(constitutive_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & - constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( constitutive_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( constitutive_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & - any(constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (constitutive_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & - constitutive_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (constitutive_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & - constitutive_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (constitutive_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & - constitutive_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + constitutive_phenopowerlaw_totalNslip(instance) = sum(constitutive_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether + constitutive_phenopowerlaw_totalNtwin(instance) = sum(constitutive_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether + if (any(constitutive_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & + constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (constitutive_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (constitutive_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(constitutive_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & + constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(constitutive_phenopowerlaw_a_slip(instance) == 0.0_pReal .and. & + constitutive_phenopowerlaw_Nslip(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (any(constitutive_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & + constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if ( constitutive_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & + any(constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if ( constitutive_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & + any(constitutive_phenopowerlaw_Ntwin(:,instance) > 0)) & + call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (constitutive_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & + constitutive_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa + if (constitutive_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & + constitutive_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (constitutive_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & + constitutive_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 + endif myPhase enddo sanityChecks !-------------------------------------------------------------------------------------------------- @@ -459,95 +444,95 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) maxval(constitutive_phenopowerlaw_totalNtwin),& maxNinstance), source=0.0_pReal) - instancesLoop: do instance = 1_pInt,maxNinstance - outputsLoop: do o = 1_pInt,constitutive_phenopowerlaw_Noutput(instance) - select case(constitutive_phenopowerlaw_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID & - ) - mySize = constitutive_phenopowerlaw_totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = constitutive_phenopowerlaw_totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_ID & - ) - mySize = 1_pInt - case default - end select - - outputFound: if (mySize > 0_pInt) then - constitutive_phenopowerlaw_sizePostResult(o,instance) = mySize - constitutive_phenopowerlaw_sizePostResults(instance) = constitutive_phenopowerlaw_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop - - constitutive_phenopowerlaw_sizeDotState(instance) = constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance)+ & - 2_pInt + & - constitutive_phenopowerlaw_totalNslip(instance)+ & - constitutive_phenopowerlaw_totalNtwin(instance) ! s_slip, s_twin, sum(gamma), sum(f), accshear_slip, accshear_twin - constitutive_phenopowerlaw_sizeState(instance) = constitutive_phenopowerlaw_sizeDotState(instance) - - structID = constitutive_phenopowerlaw_structure(instance) - - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(constitutive_phenopowerlaw_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(constitutive_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - constitutive_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,structID))+j, & - sum(lattice_NslipSystem(1:o-1,structID))+k, & - structID), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(constitutive_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - constitutive_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo - - enddo; enddo - - do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X - index_myFamily = sum(constitutive_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(constitutive_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - constitutive_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(constitutive_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - constitutive_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - constitutive_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,structID))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,structID))+k, & - structID), instance ) - enddo; enddo - - enddo; enddo - - enddo instancesLoop + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then + instance = phase_plasticityInstance(phase) + outputsLoop: do o = 1_pInt,constitutive_phenopowerlaw_Noutput(instance) + select case(constitutive_phenopowerlaw_outputID(o,instance)) + case(resistance_slip_ID, & + shearrate_slip_ID, & + accumulatedshear_slip_ID, & + resolvedstress_slip_ID & + ) + mySize = constitutive_phenopowerlaw_totalNslip(instance) + case(resistance_twin_ID, & + shearrate_twin_ID, & + accumulatedshear_twin_ID, & + resolvedstress_twin_ID & + ) + mySize = constitutive_phenopowerlaw_totalNtwin(instance) + case(totalshear_ID, & + totalvolfrac_ID & + ) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + constitutive_phenopowerlaw_sizePostResult(o,instance) = mySize + constitutive_phenopowerlaw_sizePostResults(instance) = constitutive_phenopowerlaw_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop + + constitutive_phenopowerlaw_sizeDotState(instance) = constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance)+ & + 2_pInt + & + constitutive_phenopowerlaw_totalNslip(instance)+ & + constitutive_phenopowerlaw_totalNtwin(instance) ! s_slip, s_twin, sum(gamma), sum(f), accshear_slip, accshear_twin + constitutive_phenopowerlaw_sizeState(instance) = constitutive_phenopowerlaw_sizeDotState(instance) + + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X + index_myFamily = sum(constitutive_phenopowerlaw_Nslip(1:f-1_pInt,instance)) + do j = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(constitutive_phenopowerlaw_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) + constitutive_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(constitutive_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + constitutive_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + + do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X + index_myFamily = sum(constitutive_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) + do j = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) + + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(constitutive_phenopowerlaw_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) + constitutive_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + do o = 1_pInt,lattice_maxNtwinFamily + index_otherFamily = sum(constitutive_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) + do k = 1_pInt,constitutive_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) + constitutive_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & + constitutive_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & + phase), instance ) + enddo; enddo + + enddo; enddo + endif + enddo initializeInstances end subroutine constitutive_phenopowerlaw_init @@ -562,7 +547,7 @@ pure function constitutive_phenopowerlaw_stateInit(instance) implicit none integer(pInt), intent(in) :: & - instance !< number specifying the instance of the plasticity + instance !< number specifying the instance of the plasticity real(pReal), dimension(constitutive_phenopowerlaw_sizeDotState(instance)) :: & constitutive_phenopowerlaw_stateInit integer(pInt) :: & @@ -594,9 +579,9 @@ end function constitutive_phenopowerlaw_stateInit pure function constitutive_phenopowerlaw_aTolState(instance) implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity -real(pReal), dimension(constitutive_phenopowerlaw_sizeState(instance)) :: & + real(pReal), dimension(constitutive_phenopowerlaw_sizeState(instance)) :: & constitutive_phenopowerlaw_aTolState constitutive_phenopowerlaw_aTolState(1:constitutive_phenopowerlaw_totalNslip(instance)+ & @@ -617,34 +602,6 @@ real(pReal), dimension(constitutive_phenopowerlaw_sizeState(instance)) :: & end function constitutive_phenopowerlaw_aTolState -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -pure function constitutive_phenopowerlaw_homogenizedC(ipc,ip,el) - use prec, only: & - p_vec - use mesh, only: & - mesh_NcpElems, & - mesh_maxNips - use material, only: & - homogenization_maxNgrains, & - material_phase, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6,6) :: & - constitutive_phenopowerlaw_homogenizedC - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - constitutive_phenopowerlaw_homogenizedC = constitutive_phenopowerlaw_Cslip_66(1:6,1:6,& - phase_plasticityInstance(material_phase(ipc,ip,el))) - -end function constitutive_phenopowerlaw_homogenizedC - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- @@ -690,7 +647,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar integer(pInt) :: & instance, & nSlip, & - nTwin,structID,index_Gamma,index_F,index_myFamily, & + nTwin,phase,index_Gamma,index_F,index_myFamily, & f,i,j,k,l,m,n real(pReal), dimension(3,3,3,3) :: & dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor @@ -701,12 +658,11 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,dgdot_dtautwin,tau_twin - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_phenopowerlaw_structure(instance) - + + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) - index_Gamma = nSlip + nTwin + 1_pInt index_F = nSlip + nTwin + 2_pInt @@ -716,25 +672,25 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt !-------------------------------------------------------------------------------------------------- ! Calculation of Lp - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,structID)) + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) tau_slip_neg(j) = tau_slip_pos(j) - nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,structID) + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(structID) + do k = 1,lattice_NnonSchmid(phase) tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,structID) + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,phase) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,structID) + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,phase) enddo gdot_slip_pos(j) = 0.5_pReal*constitutive_phenopowerlaw_gdot0_slip(instance)* & ((abs(tau_slip_pos(j))/state(ipc,ip,el)%p(j))**constitutive_phenopowerlaw_n_slip(instance))*& @@ -743,7 +699,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar ((abs(tau_slip_neg(j))/state(ipc,ip,el)%p(j))**constitutive_phenopowerlaw_n_slip(instance))*& sign(1.0_pReal,tau_slip_neg(j)) Lp = Lp + (1.0_pReal-state(ipc,ip,el)%p(index_F))*& ! 1-F - (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,structID) + (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp @@ -751,7 +707,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtauslip_pos(j) = gdot_slip_pos(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_pos(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_pos(j)*lattice_Sslip(k,l,1,index_myFamily+i,structID)* & + dgdot_dtauslip_pos(j)*lattice_Sslip(k,l,1,index_myFamily+i,phase)* & nonSchmid_tensor(m,n,1) endif @@ -759,7 +715,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtauslip_neg(j) = gdot_slip_neg(j)*constitutive_phenopowerlaw_n_slip(instance)/tau_slip_neg(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtauslip_neg(j)*lattice_Sslip(k,l,1,index_myFamily+i,structID)* & + dgdot_dtauslip_neg(j)*lattice_Sslip(k,l,1,index_myFamily+i,phase)* & nonSchmid_tensor(m,n,2) endif enddo @@ -767,18 +723,18 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt !-------------------------------------------------------------------------------------------------- ! Calculation of Lp - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,structID)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) gdot_twin(j) = (1.0_pReal-state(ipc,ip,el)%p(index_F))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& (abs(tau_twin(j))/state(ipc,ip,el)%p(nSlip+j))**& constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin(j))) - Lp = Lp + gdot_twin(j)*lattice_Stwin(1:3,1:3,index_myFamily+i,structID) + Lp = Lp + gdot_twin(j)*lattice_Stwin(1:3,1:3,index_myFamily+i,phase) !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp @@ -786,8 +742,8 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar dgdot_dtautwin(j) = gdot_twin(j)*constitutive_phenopowerlaw_n_twin(instance)/tau_twin(j) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtautwin(j)*lattice_Stwin(k,l,index_myFamily+i,structID)* & - lattice_Stwin(m,n,index_myFamily+i,structID) + dgdot_dtautwin(j)*lattice_Stwin(k,l,index_myFamily+i,phase)* & + lattice_Stwin(m,n,index_myFamily+i,phase) endif enddo enddo twinFamiliesLoop @@ -834,7 +790,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) constitutive_phenopowerlaw_dotState integer(pInt) :: & - instance,structID, & + instance,phase, & nSlip,nTwin, & f,i,j,k, & index_Gamma,index_F,index_myFamily, & @@ -848,9 +804,8 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) real(pReal), dimension(constitutive_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_twin,tau_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin - - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_phenopowerlaw_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) @@ -878,8 +833,8 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) ssat_offset = constitutive_phenopowerlaw_spr(instance)*sqrt(state(ipc,ip,el)%p(index_F)) j = 0_pInt slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part @@ -892,13 +847,13 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma - tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,structID)) + tau_slip_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) tau_slip_neg(j) = tau_slip_pos(j) - do k = 1,lattice_NnonSchmid(structID) + do k = 1,lattice_NnonSchmid(phase) tau_slip_pos(j) = tau_slip_pos(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) tau_slip_neg(j) = tau_slip_neg(j) + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) enddo gdot_slip(j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & ((abs(tau_slip_pos(j))/state(ipc,ip,el)%p(j))**constitutive_phenopowerlaw_n_slip(instance) & @@ -909,8 +864,8 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) j = 0_pInt twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt left_TwinSlip(j) = 1.0_pReal ! no system-dependent right part left_TwinTwin(j) = 1.0_pReal ! no system-dependent right part @@ -919,7 +874,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,structID)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) gdot_twin(j) = (1.0_pReal-state(ipc,ip,el)%p(index_F))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& (abs(tau_twin(j))/state(ipc,ip,el)%p(nSlip+j))**& @@ -931,7 +886,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) ! calculate the overall hardening based on above j = 0_pInt slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily - do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family + do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt constitutive_phenopowerlaw_dotState(j) = & ! evolution of slip resistance j c_SlipSlip * left_SlipSlip(j) * & @@ -948,8 +903,8 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) j = 0_pInt twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt constitutive_phenopowerlaw_dotState(j+nSlip) = & ! evolution of twin resistance j c_TwinSlip * left_TwinSlip(j) * & @@ -960,7 +915,7 @@ function constitutive_phenopowerlaw_dotState(Tstar_v,state,ipc,ip,el) right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor if (state(ipc,ip,el)%p(index_F) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 constitutive_phenopowerlaw_dotState(index_F) = constitutive_phenopowerlaw_dotState(index_F) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,structID) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,phase) constitutive_phenopowerlaw_dotState(offset_accshear_twin+j) = abs(gdot_twin(j)) enddo enddo twinFamiliesLoop2 @@ -1008,16 +963,15 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) constitutive_phenopowerlaw_postResults integer(pInt) :: & - instance,structID, & + instance,phase, & nSlip,nTwin, & o,f,i,c,j,k, & index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau - - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_phenopowerlaw_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) nSlip = constitutive_phenopowerlaw_totalNslip(instance) nTwin = constitutive_phenopowerlaw_totalNtwin(instance) @@ -1044,16 +998,16 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (shearrate_slip_ID) j = 0_pInt slipFamiliesLoop1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,structID)) + tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) tau_slip_neg = tau_slip_pos - do k = 1,lattice_NnonSchmid(structID) + do k = 1,lattice_NnonSchmid(phase) tau_slip_pos = tau_slip_pos + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,phase)) tau_slip_neg = tau_slip_neg + constitutive_phenopowerlaw_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,phase)) enddo constitutive_phenopowerlaw_postResults(c+j) = constitutive_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & ((abs(tau_slip_pos)/state(ipc,ip,el)%p(j))**constitutive_phenopowerlaw_n_slip(instance) & @@ -1066,11 +1020,11 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (resolvedstress_slip_ID) j = 0_pInt slipFamiliesLoop2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Nslip(f,instance) ! process each (active) slip system in family j = j + 1_pInt constitutive_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,phase)) enddo enddo slipFamiliesLoop2 c = c + nSlip @@ -1093,11 +1047,11 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (shearrate_twin_ID) j = 0_pInt twinFamiliesLoop1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt - tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,structID)) - constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(ipc,ip,el)%p(index_F))*& ! 1-F + tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) + constitutive_phenopowerlaw_postResults(c+j) = (1.0_pReal-state(ipc,ip,el)%p(index_F))*& ! 1-F constitutive_phenopowerlaw_gdot0_twin(instance)*& (abs(tau)/state(ipc,ip,el)%p(j+nSlip))**& constitutive_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) @@ -1108,11 +1062,11 @@ pure function constitutive_phenopowerlaw_postResults(Tstar_v,state,ipc,ip,el) case (resolvedstress_twin_ID) j = 0_pInt twinFamiliesLoop2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family - do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family + do i = 1_pInt,constitutive_phenopowerlaw_Ntwin(f,instance) ! process each (active) twin system in family j = j + 1_pInt constitutive_phenopowerlaw_postResults(c+j) = & - dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,structID)) + dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,phase)) enddo enddo twinFamiliesLoop2 c = c + nTwin diff --git a/code/constitutive_titanmod.f90 b/code/constitutive_titanmod.f90 index d81ca20fd..9cd22d707 100644 --- a/code/constitutive_titanmod.f90 +++ b/code/constitutive_titanmod.f90 @@ -28,8 +28,6 @@ module constitutive_titanmod use prec, only: & pReal, & pInt - use lattice, only: & - LATTICE_undefined_ID implicit none private @@ -65,13 +63,9 @@ module constitutive_titanmod constitutive_titanmod_output !< name of each post result output integer(pInt), dimension(:), allocatable, private :: & - constitutive_titanmod_Noutput !< number of outputs per instance of this plasticity - - integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public :: & - constitutive_titanmod_structureID !< ID of the lattice structure + constitutive_titanmod_Noutput !< number of outputs per instance of this plasticity !< ID of the lattice structure integer(pInt), dimension(:), allocatable, private :: & - constitutive_titanmod_structure, & !< number representing the kind of lattice structure constitutive_titanmod_totalNslip, & !< total number of active slip systems for each instance constitutive_titanmod_totalNtwin !< total number of active twin systems for each instance @@ -84,10 +78,8 @@ module constitutive_titanmod constitutive_titanmod_twinSystemLattice !< lookup table relating active twin system index to lattice twin system index for each instance real(pReal), dimension(:), allocatable, private :: & - constitutive_titanmod_CoverA, & !< c/a ratio for hex type lattice constitutive_titanmod_debyefrequency, & !< Debye frequency constitutive_titanmod_kinkf0, & !< - constitutive_titanmod_Gmod, & !< shear modulus constitutive_titanmod_CAtomicVolume, & !< atomic volume in Bugers vector unit constitutive_titanmod_dc, & !< prefactor for self-diffusion coefficient constitutive_titanmod_twinhpconstant, & !< activation energy for dislocation climb @@ -160,7 +152,6 @@ module constitutive_titanmod constitutive_titanmod_interactionTwinTwin !< coefficients for twin-twin interaction for each interaction type and instance real(pReal), dimension(:,:,:), allocatable, private :: & - constitutive_titanmod_Cslip_66, & !< elasticity matrix in Mandel notation for each instance constitutive_titanmod_interactionMatrixSlipSlip, & !< interaction matrix of the different slip systems for each instance constitutive_titanmod_interactionMatrix_ee, & !< interaction matrix of e-e for each instance constitutive_titanmod_interactionMatrix_ss, & !< interaction matrix of s-s for each instance @@ -174,13 +165,11 @@ module constitutive_titanmod constitutive_titanmod_TwinforestProjectionScrew !< matrix of forest projections of screw dislocations in twin system for each instance real(pReal), dimension(:,:,:,:), allocatable, private :: & - constitutive_titanmod_Ctwin_66 !< twin elasticity matrix in Mandel notation for each instance - - real(pReal), dimension(:,:,:,:,:), allocatable, private :: & - constitutive_titanmod_Cslip_3333 !< elasticity matrix for each instance + constitutive_titanmod_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & - constitutive_titanmod_Ctwin_3333 !< twin elasticity matrix for each instance + constitutive_titanmod_Ctwin3333 !< twin elasticity matrix for each instance + enum, bind(c) enumerator :: undefined_ID, & rhoedge_ID, rhoscrew_ID, & @@ -256,9 +245,8 @@ subroutine constitutive_titanmod_init(fileUnit) integer(pInt), parameter :: MAXNCHUNKS = LATTICE_maxNinteraction + 1_pInt integer(pInt), dimension(1_pInt+2_pInt*MAXNCHUNKS) :: positions - integer(pInt), dimension(7) :: configNchunks integer(pInt) :: & - section = 0_pInt, & + phase, & instance, j, k, l, m, n, p, q, r, & f, o, & s, s1, s2, & @@ -266,10 +254,8 @@ subroutine constitutive_titanmod_init(fileUnit) ns, nt, & Nchunks_SlipSlip, Nchunks_SlipTwin, Nchunks_TwinSlip, Nchunks_TwinTwin, & Nchunks_SlipFamilies, Nchunks_TwinFamilies, & - mySize, structID, & + mySize, & maxTotalNslip,maxTotalNtwin, maxNinstance - character(len=32) :: & - structure = '' character(len=65536) :: & tag = '', & line = '' @@ -285,14 +271,6 @@ subroutine constitutive_titanmod_init(fileUnit) if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - Nchunks_SlipFamilies = lattice_maxNslipFamily - Nchunks_TwinFamilies = lattice_maxNtwinFamily - Nchunks_SlipSlip = lattice_maxNinteraction - Nchunks_SlipTwin = lattice_maxNinteraction - Nchunks_TwinSlip = lattice_maxNinteraction - Nchunks_TwinTwin = lattice_maxNinteraction - - allocate(constitutive_titanmod_sizeDotState(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_sizeState(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_sizePostResults(maxNinstance), source=0_pInt) @@ -302,8 +280,6 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) allocate(constitutive_titanmod_Noutput(maxNinstance), source=0_pInt) - allocate(constitutive_titanmod_structureID(maxNinstance), source=LATTICE_undefined_ID) - allocate(constitutive_titanmod_structure(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) allocate(constitutive_titanmod_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) allocate(constitutive_titanmod_slipFamily(lattice_maxNslip,maxNinstance), source=0_pInt) @@ -312,10 +288,8 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_twinSystemLattice(lattice_maxNtwin,maxNinstance), source=0_pInt) allocate(constitutive_titanmod_totalNslip(maxNinstance), source=0_pInt) allocate(constitutive_titanmod_totalNtwin(maxNinstance), source=0_pInt) - allocate(constitutive_titanmod_CoverA(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_debyefrequency(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_kinkf0(maxNinstance), source=0.0_pReal) - allocate(constitutive_titanmod_Gmod(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_CAtomicVolume(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_dc(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_twinhpconstant(maxNinstance), source=0.0_pReal) @@ -326,8 +300,6 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_Cmfptwin(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_Cthresholdtwin(maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_aTolRho(maxNinstance), source=0.0_pReal) - allocate(constitutive_titanmod_Cslip_66(6,6,maxNinstance), source=0.0_pReal) - allocate(constitutive_titanmod_Cslip_3333(3,3,3,3,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_rho_edge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_rho_screw0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_shear_system0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) @@ -366,11 +338,12 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_interactionTwinTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to + phase = 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 phase part + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part line = IO_read(fileUnit) if (IO_isBlank(line)) cycle ! skip empty lines if (IO_getTag(line,'<','>') /= '') then ! stop at next part @@ -378,361 +351,324 @@ subroutine constitutive_titanmod_init(fileUnit) exit endif if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt ! advance section counter + phase = phase + 1_pInt ! advance section counter + if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) + Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) + Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) + Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) + 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_TITANMOD_ID) then ! one of my sections - instance = 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') - cycle - case ('(output)') - constitutive_titanmod_Noutput(instance) = constitutive_titanmod_Noutput(instance) + 1_pInt - constitutive_titanmod_output(constitutive_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,positions,2_pInt)) - select case(IO_lc(IO_stringValue(line,positions,2_pInt))) - case ('rhoedge') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_ID - case ('rhoscrew') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_ID - case ('segment_edge') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = segment_edge_ID - case ('segment_screw') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = segment_screw_ID - case ('resistance_edge') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = resistance_edge_ID - case ('resistance_screw') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = resistance_screw_ID - case ('velocity_edge') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = velocity_edge_ID - case ('velocity_screw') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = velocity_screw_ID - case ('tau_slip') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = tau_slip_ID - case ('gdot_slip_edge') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID - case ('gdot_slip_screw') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID - case ('gdot_slip') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_ID - case ('stressratio_edge_p') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID - case ('stressratio_screw_p') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID - case ('shear_system') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_system_ID - case ('twin_fraction') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = twin_fraction_ID - case ('shear_basal') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_basal_ID - case ('shear_prism') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_prism_ID - case ('shear_pyra') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_pyra_ID - case ('shear_pyrca') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_pyrca_ID - case ('rhoedge_basal') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_basal_ID - case ('rhoedge_prism') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_prism_ID - case ('rhoedge_pyra') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID - case ('rhoedge_pyrca') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID - case ('rhoscrew_basal') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID - case ('rhoscrew_prism') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID - case ('rhoscrew_pyra') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID - case ('rhoscrew_pyrca') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID - case ('shear_total') - constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_total_ID - case default - call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_TITANMOD_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_titanmod_structureID(instance) = LATTICE_iso_ID - case(LATTICE_fcc_label) - constitutive_titanmod_structureID(instance) = LATTICE_fcc_ID - case(LATTICE_bcc_label) - constitutive_titanmod_structureID(instance) = LATTICE_bcc_ID - case(LATTICE_hex_label) - constitutive_titanmod_structureID(instance) = LATTICE_hex_ID - case(LATTICE_ort_label) - constitutive_titanmod_structureID(instance) = LATTICE_ort_ID - end select - configNchunks = lattice_configNchunks(constitutive_titanmod_structureID(instance)) - Nchunks_SlipFamilies = configNchunks(1) - Nchunks_TwinFamilies = configNchunks(2) - Nchunks_SlipSlip = configNchunks(3) - Nchunks_SlipTwin = configNchunks(4) - Nchunks_TwinSlip = configNchunks(5) - Nchunks_TwinTwin = configNchunks(6) - case ('covera_ratio') - constitutive_titanmod_CoverA(instance) = IO_floatValue(line,positions,2_pInt) - case ('c11') - constitutive_titanmod_Cslip_66(1,1,instance) = IO_floatValue(line,positions,2_pInt) - case ('c12') - constitutive_titanmod_Cslip_66(1,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c13') - constitutive_titanmod_Cslip_66(1,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c22') - constitutive_titanmod_Cslip_66(2,2,instance) = IO_floatValue(line,positions,2_pInt) - case ('c23') - constitutive_titanmod_Cslip_66(2,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c33') - constitutive_titanmod_Cslip_66(3,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('c44') - constitutive_titanmod_Cslip_66(4,4,instance) = IO_floatValue(line,positions,2_pInt) - case ('c55') - constitutive_titanmod_Cslip_66(5,5,instance) = IO_floatValue(line,positions,2_pInt) - case ('c66') - constitutive_titanmod_Cslip_66(1,3,instance) = IO_floatValue(line,positions,2_pInt) - case ('debyefrequency') - constitutive_titanmod_debyefrequency(instance) = IO_floatValue(line,positions,2_pInt) - case ('kinkf0') - constitutive_titanmod_kinkf0(instance) = IO_floatValue(line,positions,2_pInt) - case ('nslip') - if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('ntwin') - if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) - enddo - case ('rho_edge0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_rho_edge0(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('rho_screw0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_rho_screw0(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('slipburgers') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinburgers') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('f0') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinf0') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('tau0e') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twintau0') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('tau0s') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('capre') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('caprs') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('v0e') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twingamma0') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('v0s') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('kinkcriticallength') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinsize') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('celambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinlambdaslip') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('cslambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('grainsize') - constitutive_titanmod_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) - case ('maxtwinfraction') - constitutive_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) - case ('pe') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinp') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('ps') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('qe') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinq') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('qs') - do j = 1_pInt, Nchunks_SlipFamilies - constitutive_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('twinshearconstant') - do j = 1_pInt, Nchunks_TwinFamilies - constitutive_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('dc') - constitutive_titanmod_dc(instance) = IO_floatValue(line,positions,2_pInt) - case ('twinhpconstant') - constitutive_titanmod_twinhpconstant(instance) = IO_floatValue(line,positions,2_pInt) - case ('atol_rho') - constitutive_titanmod_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) - case ('interactionee') - do j = 1_pInt, lattice_maxNinteraction - constitutive_titanmod_interaction_ee(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interactionss') - do j = 1_pInt, lattice_maxNinteraction - constitutive_titanmod_interaction_ss(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interactiones') - do j = 1_pInt, lattice_maxNinteraction - constitutive_titanmod_interaction_es(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_slipslip','interactionslipslip') - if (positions(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipSlip - constitutive_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_sliptwin','interactionsliptwin') - if (positions(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipTwin - constitutive_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twinslip','interactiontwinslip') - if (positions(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinSlip - constitutive_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case ('interaction_twintwin','interactiontwintwin') - if (positions(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinTwin - constitutive_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) - enddo - case default - call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - end select - endif - endif - enddo - - sanityChecks: do instance = 1_pInt,maxNinstance - constitutive_titanmod_structure(instance) = & - lattice_initializeStructure(constitutive_titanmod_structureID(instance),constitutive_titanmod_CoverA(instance)) - structID = constitutive_titanmod_structure(instance) - - if (structID < 1_pInt) & - call IO_error(205_pInt,el=instance) - if (sum(constitutive_titanmod_Nslip(:,instance)) <= 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='nslip ('//PLASTICITY_TITANMOD_label//')') - if (sum(constitutive_titanmod_Ntwin(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='ntwin ('//PLASTICITY_TITANMOD_label//')') - do f = 1_pInt,lattice_maxNslipFamily - if (constitutive_titanmod_Nslip(f,instance) > 0_pInt) then - if (constitutive_titanmod_rho_edge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_edge0 ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_rho_screw0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_screw0 ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_burgersPerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='slipburgers ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_f0_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='f0 ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_tau0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0e ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_tau0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0s ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_capre_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='capre ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_caprs_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='caprs ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_v0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0e ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_v0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0s ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_kinkcriticallength_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='kinkCriticalLength ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - do f = 1_pInt,lattice_maxNtwinFamily - if (constitutive_titanmod_Ntwin(f,instance) > 0_pInt) then - if (constitutive_titanmod_burgersPerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_twinf0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinf0 ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_twinshearconstant_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinshearconstant ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_twintau0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twintau0 ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_twingamma0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twingamma0 ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - if (constitutive_titanmod_dc(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='dc ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_twinhpconstant(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinhpconstant ('//PLASTICITY_TITANMOD_label//')') - if (constitutive_titanmod_aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_TITANMOD_label//')') - + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then ! one of my sections. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! 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', & + 'covera_ratio','c/a_ratio','c/a', & + 'c11','c12','c13','c22','c23','c33','c44','c55','c66') + case ('(output)') + constitutive_titanmod_Noutput(instance) = constitutive_titanmod_Noutput(instance) + 1_pInt + constitutive_titanmod_output(constitutive_titanmod_Noutput(instance),instance) = & + IO_lc(IO_stringValue(line,positions,2_pInt)) + select case(IO_lc(IO_stringValue(line,positions,2_pInt))) + case ('rhoedge') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_ID + case ('rhoscrew') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_ID + case ('segment_edge') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = segment_edge_ID + case ('segment_screw') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = segment_screw_ID + case ('resistance_edge') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = resistance_edge_ID + case ('resistance_screw') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = resistance_screw_ID + case ('velocity_edge') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = velocity_edge_ID + case ('velocity_screw') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = velocity_screw_ID + case ('tau_slip') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = tau_slip_ID + case ('gdot_slip_edge') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID + case ('gdot_slip_screw') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID + case ('gdot_slip') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = gdot_slip_ID + case ('stressratio_edge_p') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID + case ('stressratio_screw_p') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID + case ('shear_system') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_system_ID + case ('twin_fraction') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = twin_fraction_ID + case ('shear_basal') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_basal_ID + case ('shear_prism') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_prism_ID + case ('shear_pyra') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_pyra_ID + case ('shear_pyrca') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_pyrca_ID + case ('rhoedge_basal') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_basal_ID + case ('rhoedge_prism') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_prism_ID + case ('rhoedge_pyra') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID + case ('rhoedge_pyrca') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID + case ('rhoscrew_basal') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID + case ('rhoscrew_prism') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID + case ('rhoscrew_pyra') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID + case ('rhoscrew_pyrca') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID + case ('shear_total') + constitutive_titanmod_outputID(constitutive_titanmod_Noutput(instance),instance) = shear_total_ID + case default + call IO_error(105_pInt,ext_msg=IO_stringValue(line,positions,2_pInt)//' ('//PLASTICITY_TITANMOD_label//')') + end select + case ('debyefrequency') + constitutive_titanmod_debyefrequency(instance) = IO_floatValue(line,positions,2_pInt) + case ('kinkf0') + constitutive_titanmod_kinkf0(instance) = IO_floatValue(line,positions,2_pInt) + case ('nslip') + if (positions(1) < 1_pInt + Nchunks_SlipFamilies) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_Nslip(j,instance) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('ntwin') + if (positions(1) < 1_pInt + Nchunks_TwinFamilies) & + call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_Ntwin(j,instance) = IO_intValue(line,positions,1_pInt+j) + enddo + case ('rho_edge0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_rho_edge0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('rho_screw0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_rho_screw0(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('slipburgers') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinburgers') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('f0') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinf0') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('tau0e') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twintau0') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('tau0s') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('capre') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('caprs') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('v0e') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twingamma0') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('v0s') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('kinkcriticallength') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinsize') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('celambdaslip') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinlambdaslip') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('cslambdaslip') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('grainsize') + constitutive_titanmod_GrainSize(instance) = IO_floatValue(line,positions,2_pInt) + case ('maxtwinfraction') + constitutive_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,positions,2_pInt) + case ('pe') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinp') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('ps') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('qe') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinq') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('qs') + do j = 1_pInt, Nchunks_SlipFamilies + constitutive_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('twinshearconstant') + do j = 1_pInt, Nchunks_TwinFamilies + constitutive_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('dc') + constitutive_titanmod_dc(instance) = IO_floatValue(line,positions,2_pInt) + case ('twinhpconstant') + constitutive_titanmod_twinhpconstant(instance) = IO_floatValue(line,positions,2_pInt) + case ('atol_rho') + constitutive_titanmod_aTolRho(instance) = IO_floatValue(line,positions,2_pInt) + case ('interactionee') + do j = 1_pInt, lattice_maxNinteraction + constitutive_titanmod_interaction_ee(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interactionss') + do j = 1_pInt, lattice_maxNinteraction + constitutive_titanmod_interaction_ss(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interactiones') + do j = 1_pInt, lattice_maxNinteraction + constitutive_titanmod_interaction_es(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_slipslip','interactionslipslip') + if (positions(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipSlip + constitutive_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_sliptwin','interactionsliptwin') + if (positions(1) < 1_pInt + Nchunks_SlipTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_SlipTwin + constitutive_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twinslip','interactiontwinslip') + if (positions(1) < 1_pInt + Nchunks_TwinSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinSlip + constitutive_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case ('interaction_twintwin','interactiontwintwin') + if (positions(1) < 1_pInt + Nchunks_TwinTwin) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + do j = 1_pInt, Nchunks_TwinTwin + constitutive_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,positions,1_pInt+j) + enddo + case default + call IO_error(210_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') + end select + endif; endif + enddo parsingFile + + sanityChecks: do phase = 1_pInt, size(phase_plasticity) + myPhase: if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + instance = phase_plasticityInstance(phase) + if (sum(constitutive_titanmod_Nslip(:,instance)) <= 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='nslip ('//PLASTICITY_TITANMOD_label//')') + if (sum(constitutive_titanmod_Ntwin(:,instance)) < 0_pInt) & + call IO_error(211_pInt,el=instance,ext_msg='ntwin ('//PLASTICITY_TITANMOD_label//')') + do f = 1_pInt,lattice_maxNslipFamily + if (constitutive_titanmod_Nslip(f,instance) > 0_pInt) then + if (constitutive_titanmod_rho_edge0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rho_edge0 ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_rho_screw0(f,instance) < 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='rho_screw0 ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_burgersPerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='slipburgers ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_f0_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='f0 ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_tau0e_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau0e ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_tau0s_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='tau0s ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_capre_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='capre ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_caprs_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='caprs ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_v0e_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0e ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_v0s_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='v0s ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_kinkcriticallength_PerSlipFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='kinkCriticalLength ('//PLASTICITY_TITANMOD_label//')') + endif + enddo + do f = 1_pInt,lattice_maxNtwinFamily + if (constitutive_titanmod_Ntwin(f,instance) > 0_pInt) then + if (constitutive_titanmod_burgersPerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_twinf0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinf0 ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_twinshearconstant_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinshearconstant ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_twintau0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twintau0 ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_twingamma0_PerTwinFam(f,instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twingamma0 ('//PLASTICITY_TITANMOD_label//')') + endif + enddo + if (constitutive_titanmod_dc(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='dc ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_twinhpconstant(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='twinhpconstant ('//PLASTICITY_TITANMOD_label//')') + if (constitutive_titanmod_aTolRho(instance) <= 0.0_pReal) & + call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_TITANMOD_label//')') + !-------------------------------------------------------------------------------------------------- ! determine total number of active slip or twin systems - constitutive_titanmod_Nslip(:,instance) = min(lattice_NslipSystem(:,structID),constitutive_titanmod_Nslip(:,instance)) - constitutive_titanmod_Ntwin(:,instance) = min(lattice_NtwinSystem(:,structID),constitutive_titanmod_Ntwin(:,instance)) - constitutive_titanmod_totalNslip(instance) = sum(constitutive_titanmod_Nslip(:,instance)) - constitutive_titanmod_totalNtwin(instance) = sum(constitutive_titanmod_Ntwin(:,instance)) + constitutive_titanmod_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),constitutive_titanmod_Nslip(:,instance)) + constitutive_titanmod_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),constitutive_titanmod_Ntwin(:,instance)) + constitutive_titanmod_totalNslip(instance) = sum(constitutive_titanmod_Nslip(:,instance)) + constitutive_titanmod_totalNtwin(instance) = sum(constitutive_titanmod_Ntwin(:,instance)) + endif myPhase enddo sanityChecks !-------------------------------------------------------------------------------------------------- @@ -766,8 +702,8 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_twingamma0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_twinsizePerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_twinLambdaSlipPerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) - allocate(constitutive_titanmod_Ctwin_66 (6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(constitutive_titanmod_Ctwin_3333 (3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(constitutive_titanmod_Ctwin66 (6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) + allocate(constitutive_titanmod_Ctwin3333 (3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_interactionMatrix_ee(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) @@ -781,268 +717,259 @@ subroutine constitutive_titanmod_init(fileUnit) allocate(constitutive_titanmod_TwinforestProjectionEdge(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) allocate(constitutive_titanmod_TwinforestProjectionScrew(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - instancesLoop: do instance = 1_pInt,maxNinstance - structID = constitutive_titanmod_structure(instance) + initializeInstances: do phase = 1_pInt, size(phase_plasticity) + if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then + instance = phase_plasticityInstance(phase) !-------------------------------------------------------------------------------------------------- ! inverse lookup of slip system family - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,constitutive_titanmod_Nslip(f,instance) - l = l + 1_pInt - constitutive_titanmod_slipFamily(l,instance) = f - constitutive_titanmod_slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt,structID)) + s - enddo; enddo + l = 0_pInt + do f = 1_pInt,lattice_maxNslipFamily + do s = 1_pInt,constitutive_titanmod_Nslip(f,instance) + l = l + 1_pInt + constitutive_titanmod_slipFamily(l,instance) = f + constitutive_titanmod_slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt,phase)) + s + enddo; enddo !-------------------------------------------------------------------------------------------------- ! inverse lookup of twin system family - l = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - do t = 1_pInt,constitutive_titanmod_Ntwin(f,instance) - l = l + 1_pInt - constitutive_titanmod_twinFamily(l,instance) = f - constitutive_titanmod_twinSystemLattice(l,instance) = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) + t - enddo; enddo + l = 0_pInt + do f = 1_pInt,lattice_maxNtwinFamily + do t = 1_pInt,constitutive_titanmod_Ntwin(f,instance) + l = l + 1_pInt + constitutive_titanmod_twinFamily(l,instance) = f + constitutive_titanmod_twinSystemLattice(l,instance) = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) + t + enddo; enddo !-------------------------------------------------------------------------------------------------- ! determine size of state array - ns = constitutive_titanmod_totalNslip(instance) - nt = constitutive_titanmod_totalNtwin(instance) - constitutive_titanmod_sizeDotState(instance) = & - size(constitutive_titanmod_listBasicSlipStates)*ns + & - size(constitutive_titanmod_listBasicTwinStates)*nt - constitutive_titanmod_sizeState(instance) = & - constitutive_titanmod_sizeDotState(instance)+ & - size(constitutive_titanmod_listDependentSlipStates)*ns + & - size(constitutive_titanmod_listDependentTwinStates)*nt + ns = constitutive_titanmod_totalNslip(instance) + nt = constitutive_titanmod_totalNtwin(instance) + constitutive_titanmod_sizeDotState(instance) = & + size(constitutive_titanmod_listBasicSlipStates)*ns + & + size(constitutive_titanmod_listBasicTwinStates)*nt + constitutive_titanmod_sizeState(instance) = & + constitutive_titanmod_sizeDotState(instance)+ & + size(constitutive_titanmod_listDependentSlipStates)*ns + & + size(constitutive_titanmod_listDependentTwinStates)*nt !-------------------------------------------------------------------------------------------------- ! determine size of postResults array - outputsLoop: do o = 1_pInt,constitutive_titanmod_Noutput(instance) - mySize = 0_pInt - select case(constitutive_titanmod_outputID(o,instance)) - case(rhoedge_ID, rhoscrew_ID, & - segment_edge_ID, segment_screw_ID, & - resistance_edge_ID, resistance_screw_ID, & - velocity_edge_ID, velocity_screw_ID, & - tau_slip_ID, & - gdot_slip_edge_ID, gdot_slip_screw_ID, & - gdot_slip_ID, & - stressratio_edge_p_ID, stressratio_screw_p_ID, & - shear_system_ID) - mySize = constitutive_titanmod_totalNslip(instance) - case(twin_fraction_ID) - mySize = constitutive_titanmod_totalNtwin(instance) - case(shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & ! use only if all 4 slip families in hex are considered - rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & - rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & - shear_total_ID) - mySize = 1_pInt - case default - call IO_error(105_pInt,ext_msg=constitutive_titanmod_output(o,instance)// & - ' ('//PLASTICITY_TITANMOD_label//')') - end select + outputsLoop: do o = 1_pInt,constitutive_titanmod_Noutput(instance) + mySize = 0_pInt + select case(constitutive_titanmod_outputID(o,instance)) + case(rhoedge_ID, rhoscrew_ID, & + segment_edge_ID, segment_screw_ID, & + resistance_edge_ID, resistance_screw_ID, & + velocity_edge_ID, velocity_screw_ID, & + tau_slip_ID, & + gdot_slip_edge_ID, gdot_slip_screw_ID, & + gdot_slip_ID, & + stressratio_edge_p_ID, stressratio_screw_p_ID, & + shear_system_ID) + mySize = constitutive_titanmod_totalNslip(instance) + case(twin_fraction_ID) + mySize = constitutive_titanmod_totalNtwin(instance) + case(shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & ! use only if all 4 slip families in hex are considered + rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & + rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & + shear_total_ID) + mySize = 1_pInt + case default + call IO_error(105_pInt,ext_msg=constitutive_titanmod_output(o,instance)// & + ' ('//PLASTICITY_TITANMOD_label//')') + end select - outputFound: if (mySize > 0_pInt) then - constitutive_titanmod_sizePostResult(o,instance) = mySize - constitutive_titanmod_sizePostResults(instance) = constitutive_titanmod_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop - - constitutive_titanmod_Cslip_66(1:6,1:6,instance) = & - lattice_symmetrizeC66(constitutive_titanmod_structureID(instance),& - constitutive_titanmod_Cslip_66(1:6,1:6,instance)) ! assign elasticity tensor - constitutive_titanmod_Gmod(instance) = & - 0.2_pReal*(constitutive_titanmod_Cslip_66(1,1,instance)-constitutive_titanmod_Cslip_66(1,2,instance))& - + 0.3_pReal*constitutive_titanmod_Cslip_66(4,4,instance) - constitutive_titanmod_Cslip_66(1:6,1:6,instance) = & - math_Mandel3333to66(math_Voigt66to3333(constitutive_titanmod_Cslip_66(1:6,1:6,instance))) - constitutive_titanmod_Cslip_3333(1:3,1:3,1:3,1:3,instance) = & - math_Voigt66to3333(constitutive_titanmod_Cslip_66(1:6,1:6,instance)) + outputFound: if (mySize > 0_pInt) then + constitutive_titanmod_sizePostResult(o,instance) = mySize + constitutive_titanmod_sizePostResults(instance) = constitutive_titanmod_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! construction of the twin elasticity matrices - do j=1_pInt,lattice_maxNtwinFamily - do k=1_pInt,constitutive_titanmod_Ntwin(j,instance) - do l=1_pInt,3_pInt ; do m=1_pInt,3_pInt ; do n=1_pInt,3_pInt ; do o=1_pInt,3_pInt - do p=1_pInt,3_pInt ; do q=1_pInt,3_pInt ; do r=1_pInt,3_pInt ; do s=1_pInt,3_pInt - constitutive_titanmod_Ctwin_3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) = & - constitutive_titanmod_Ctwin_3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) + & - constitutive_titanmod_Cslip_3333(p,q,r,s,instance)*& - lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* & - lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* & - lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID)* & - lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,structID))+k,structID) - enddo; enddo; enddo; enddo - enddo; enddo; enddo ; enddo - constitutive_titanmod_Ctwin_66(1:6,1:6,k,instance) = & - math_Mandel3333to66(constitutive_titanmod_Ctwin_3333(1:3,1:3,1:3,1:3,k,instance)) - enddo; enddo + do j=1_pInt,lattice_maxNtwinFamily + do k=1_pInt,constitutive_titanmod_Ntwin(j,instance) + do l=1_pInt,3_pInt ; do m=1_pInt,3_pInt ; do n=1_pInt,3_pInt ; do o=1_pInt,3_pInt + do p=1_pInt,3_pInt ; do q=1_pInt,3_pInt ; do r=1_pInt,3_pInt ; do s=1_pInt,3_pInt + constitutive_titanmod_Ctwin3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) = & + constitutive_titanmod_Ctwin3333(l,m,n,o,sum(constitutive_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) + & + lattice_C3333(p,q,r,s,phase)*& + lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & + lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase) + enddo; enddo; enddo; enddo + enddo; enddo; enddo ; enddo + constitutive_titanmod_Ctwin66(1:6,1:6,k,instance) = & + math_Mandel3333to66(constitutive_titanmod_Ctwin3333(1:3,1:3,1:3,1:3,k,instance)) + enddo; enddo !-------------------------------------------------------------------------------------------------- ! Burgers vector, dislocation velocity prefactor for each slip system - do s = 1_pInt,constitutive_titanmod_totalNslip(instance) - f = constitutive_titanmod_slipFamily(s,instance) + do s = 1_pInt,constitutive_titanmod_totalNslip(instance) + f = constitutive_titanmod_slipFamily(s,instance) - constitutive_titanmod_burgersPerSlipSys(s,instance) = & - constitutive_titanmod_burgersPerSlipFam(f,instance) + constitutive_titanmod_burgersPerSlipSys(s,instance) = & + constitutive_titanmod_burgersPerSlipFam(f,instance) - constitutive_titanmod_f0_PerSlipSys(s,instance) = & - constitutive_titanmod_f0_PerSlipFam(f,instance) + constitutive_titanmod_f0_PerSlipSys(s,instance) = & + constitutive_titanmod_f0_PerSlipFam(f,instance) - constitutive_titanmod_tau0e_PerSlipSys(s,instance) = & - constitutive_titanmod_tau0e_PerSlipFam(f,instance) + constitutive_titanmod_tau0e_PerSlipSys(s,instance) = & + constitutive_titanmod_tau0e_PerSlipFam(f,instance) - constitutive_titanmod_tau0s_PerSlipSys(s,instance) = & - constitutive_titanmod_tau0s_PerSlipFam(f,instance) + constitutive_titanmod_tau0s_PerSlipSys(s,instance) = & + constitutive_titanmod_tau0s_PerSlipFam(f,instance) - constitutive_titanmod_capre_PerSlipSys(s,instance) = & - constitutive_titanmod_capre_PerSlipFam(f,instance) + constitutive_titanmod_capre_PerSlipSys(s,instance) = & + constitutive_titanmod_capre_PerSlipFam(f,instance) - constitutive_titanmod_caprs_PerSlipSys(s,instance) = & - constitutive_titanmod_caprs_PerSlipFam(f,instance) + constitutive_titanmod_caprs_PerSlipSys(s,instance) = & + constitutive_titanmod_caprs_PerSlipFam(f,instance) - constitutive_titanmod_v0e_PerSlipSys(s,instance) = & - constitutive_titanmod_v0e_PerSlipFam(f,instance) + constitutive_titanmod_v0e_PerSlipSys(s,instance) = & + constitutive_titanmod_v0e_PerSlipFam(f,instance) - constitutive_titanmod_v0s_PerSlipSys(s,instance) = & - constitutive_titanmod_v0s_PerSlipFam(f,instance) + constitutive_titanmod_v0s_PerSlipSys(s,instance) = & + constitutive_titanmod_v0s_PerSlipFam(f,instance) - constitutive_titanmod_kinkcriticallength_PerSlipSys(s,instance) = & - constitutive_titanmod_kinkcriticallength_PerSlipFam(f,instance) + constitutive_titanmod_kinkcriticallength_PerSlipSys(s,instance) = & + constitutive_titanmod_kinkcriticallength_PerSlipFam(f,instance) - constitutive_titanmod_pe_PerSlipSys(s,instance) = & - constitutive_titanmod_pe_PerSlipFam(f,instance) + constitutive_titanmod_pe_PerSlipSys(s,instance) = & + constitutive_titanmod_pe_PerSlipFam(f,instance) - constitutive_titanmod_ps_PerSlipSys(s,instance) = & - constitutive_titanmod_ps_PerSlipFam(f,instance) + constitutive_titanmod_ps_PerSlipSys(s,instance) = & + constitutive_titanmod_ps_PerSlipFam(f,instance) - constitutive_titanmod_qe_PerSlipSys(s,instance) = & - constitutive_titanmod_qe_PerSlipFam(f,instance) + constitutive_titanmod_qe_PerSlipSys(s,instance) = & + constitutive_titanmod_qe_PerSlipFam(f,instance) - constitutive_titanmod_qs_PerSlipSys(s,instance) = & - constitutive_titanmod_qs_PerSlipFam(f,instance) + constitutive_titanmod_qs_PerSlipSys(s,instance) = & + constitutive_titanmod_qs_PerSlipFam(f,instance) - constitutive_titanmod_CeLambdaSlipPerSlipSys(s,instance) = & - constitutive_titanmod_CeLambdaSlipPerSlipFam(f,instance) + constitutive_titanmod_CeLambdaSlipPerSlipSys(s,instance) = & + constitutive_titanmod_CeLambdaSlipPerSlipFam(f,instance) - constitutive_titanmod_CsLambdaSlipPerSlipSys(s,instance) = & - constitutive_titanmod_CsLambdaSlipPerSlipFam(f,instance) - enddo + constitutive_titanmod_CsLambdaSlipPerSlipSys(s,instance) = & + constitutive_titanmod_CsLambdaSlipPerSlipFam(f,instance) + enddo !-------------------------------------------------------------------------------------------------- ! Burgers vector, nucleation rate prefactor and twin size for each twin system - do t = 1_pInt,constitutive_titanmod_totalNtwin(instance) - f = constitutive_titanmod_twinFamily(t,instance) - - constitutive_titanmod_burgersPerTwinSys(t,instance) = & - constitutive_titanmod_burgersPerTwinFam(f,instance) + do t = 1_pInt,constitutive_titanmod_totalNtwin(instance) + f = constitutive_titanmod_twinFamily(t,instance) + + constitutive_titanmod_burgersPerTwinSys(t,instance) = & + constitutive_titanmod_burgersPerTwinFam(f,instance) - constitutive_titanmod_twinsizePerTwinSys(t,instance) = & - constitutive_titanmod_twinsizePerTwinFam(f,instance) + constitutive_titanmod_twinsizePerTwinSys(t,instance) = & + constitutive_titanmod_twinsizePerTwinFam(f,instance) - constitutive_titanmod_twinf0_PerTwinSys(t,instance) = & - constitutive_titanmod_twinf0_PerTwinFam(f,instance) + constitutive_titanmod_twinf0_PerTwinSys(t,instance) = & + constitutive_titanmod_twinf0_PerTwinFam(f,instance) - constitutive_titanmod_twinshearconstant_PerTwinSys(t,instance) = & - constitutive_titanmod_twinshearconstant_PerTwinFam(f,instance) + constitutive_titanmod_twinshearconstant_PerTwinSys(t,instance) = & + constitutive_titanmod_twinshearconstant_PerTwinFam(f,instance) - constitutive_titanmod_twintau0_PerTwinSys(t,instance) = & - constitutive_titanmod_twintau0_PerTwinFam(f,instance) + constitutive_titanmod_twintau0_PerTwinSys(t,instance) = & + constitutive_titanmod_twintau0_PerTwinFam(f,instance) - constitutive_titanmod_twingamma0_PerTwinSys(t,instance) = & - constitutive_titanmod_twingamma0_PerTwinFam(f,instance) + constitutive_titanmod_twingamma0_PerTwinSys(t,instance) = & + constitutive_titanmod_twingamma0_PerTwinFam(f,instance) - constitutive_titanmod_twinp_PerTwinSys(t,instance) = & - constitutive_titanmod_twinp_PerTwinFam(f,instance) + constitutive_titanmod_twinp_PerTwinSys(t,instance) = & + constitutive_titanmod_twinp_PerTwinFam(f,instance) - constitutive_titanmod_twinq_PerTwinSys(t,instance) = & - constitutive_titanmod_twinq_PerTwinFam(f,instance) + constitutive_titanmod_twinq_PerTwinSys(t,instance) = & + constitutive_titanmod_twinq_PerTwinFam(f,instance) - constitutive_titanmod_twinLambdaSlipPerTwinSys(t,instance) = & - constitutive_titanmod_twinLambdaSlipPerTwinFam(f,instance) - enddo + constitutive_titanmod_twinLambdaSlipPerTwinSys(t,instance) = & + constitutive_titanmod_twinLambdaSlipPerTwinFam(f,instance) + enddo !-------------------------------------------------------------------------------------------------- ! Construction of interaction matrices - do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) - do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) - constitutive_titanmod_interactionMatrixSlipSlip(s1,s2,instance) = & - constitutive_titanmod_interactionSlipSlip(lattice_interactionSlipSlip( & - constitutive_titanmod_slipSystemLattice(s1,instance),& - constitutive_titanmod_slipSystemLattice(s2,instance),structID),instance) + do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) + do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) + constitutive_titanmod_interactionMatrixSlipSlip(s1,s2,instance) = & + constitutive_titanmod_interactionSlipSlip(lattice_interactionSlipSlip( & + constitutive_titanmod_slipSystemLattice(s1,instance),& + constitutive_titanmod_slipSystemLattice(s2,instance),phase),instance) - constitutive_titanmod_interactionMatrix_ee(s1,s2,instance) = & - constitutive_titanmod_interaction_ee(lattice_interactionSlipSlip ( & - constitutive_titanmod_slipSystemLattice(s1,instance), & - constitutive_titanmod_slipSystemLattice(s2,instance), structID),instance) + constitutive_titanmod_interactionMatrix_ee(s1,s2,instance) = & + constitutive_titanmod_interaction_ee(lattice_interactionSlipSlip ( & + constitutive_titanmod_slipSystemLattice(s1,instance), & + constitutive_titanmod_slipSystemLattice(s2,instance), phase),instance) - constitutive_titanmod_interactionMatrix_ss(s1,s2,instance) = & - constitutive_titanmod_interaction_ss(lattice_interactionSlipSlip( & - constitutive_titanmod_slipSystemLattice(s1,instance), & - constitutive_titanmod_slipSystemLattice(s2,instance), structID),instance) + constitutive_titanmod_interactionMatrix_ss(s1,s2,instance) = & + constitutive_titanmod_interaction_ss(lattice_interactionSlipSlip( & + constitutive_titanmod_slipSystemLattice(s1,instance), & + constitutive_titanmod_slipSystemLattice(s2,instance), phase),instance) - constitutive_titanmod_interactionMatrix_es(s1,s2,instance) = & - constitutive_titanmod_interaction_es(lattice_interactionSlipSlip( & - constitutive_titanmod_slipSystemLattice(s1,instance), & - constitutive_titanmod_slipSystemLattice(s2,instance), structID),instance) - enddo; enddo - - do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) - do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - constitutive_titanmod_interactionMatrixSlipTwin(s1,t2,instance) = & - constitutive_titanmod_interactionSlipTwin(lattice_interactionSlipTwin( & - constitutive_titanmod_slipSystemLattice(s1,instance), & - constitutive_titanmod_twinSystemLattice(t2,instance), structID),instance) - enddo; enddo - - do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) - constitutive_titanmod_interactionMatrixTwinSlip(t1,s2,instance) = & - constitutive_titanmod_interactionTwinSlip(lattice_interactionTwinSlip( & + constitutive_titanmod_interactionMatrix_es(s1,s2,instance) = & + constitutive_titanmod_interaction_es(lattice_interactionSlipSlip( & + constitutive_titanmod_slipSystemLattice(s1,instance), & + constitutive_titanmod_slipSystemLattice(s2,instance), phase),instance) + enddo; enddo + + do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) + do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + constitutive_titanmod_interactionMatrixSlipTwin(s1,t2,instance) = & + constitutive_titanmod_interactionSlipTwin(lattice_interactionSlipTwin( & + constitutive_titanmod_slipSystemLattice(s1,instance), & + constitutive_titanmod_twinSystemLattice(t2,instance), phase),instance) + enddo; enddo + + do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) + constitutive_titanmod_interactionMatrixTwinSlip(t1,s2,instance) = & + constitutive_titanmod_interactionTwinSlip(lattice_interactionTwinSlip( & + constitutive_titanmod_twinSystemLattice(t1,instance), & + constitutive_titanmod_slipSystemLattice(s2,instance), phase),instance) + enddo; enddo + + do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + constitutive_titanmod_interactionMatrixTwinTwin(t1,t2,instance) = & + constitutive_titanmod_interactionTwinTwin(lattice_interactionTwinTwin( & constitutive_titanmod_twinSystemLattice(t1,instance), & - constitutive_titanmod_slipSystemLattice(s2,instance), structID),instance) - enddo; enddo - - do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - constitutive_titanmod_interactionMatrixTwinTwin(t1,t2,instance) = & - constitutive_titanmod_interactionTwinTwin(lattice_interactionTwinTwin( & - constitutive_titanmod_twinSystemLattice(t1,instance), & - constitutive_titanmod_twinSystemLattice(t2,instance), structID),instance) - enddo; enddo - - do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) - do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) + constitutive_titanmod_twinSystemLattice(t2,instance), phase),instance) + enddo; enddo + + do s1 = 1_pInt,constitutive_titanmod_totalNslip(instance) + do s2 = 1_pInt,constitutive_titanmod_totalNslip(instance) !-------------------------------------------------------------------------------------------------- ! calculation of forest projections for edge dislocations - constitutive_titanmod_forestProjectionEdge(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,instance),structID), & - lattice_st(:,constitutive_titanmod_slipSystemLattice(s2,instance),structID))) + constitutive_titanmod_forestProjectionEdge(s1,s2,instance) = & + abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,instance),phase), & + lattice_st(:,constitutive_titanmod_slipSystemLattice(s2,instance),phase))) !-------------------------------------------------------------------------------------------------- ! calculation of forest projections for screw dislocations - constitutive_titanmod_forestProjectionScrew(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,instance),structID), & - lattice_sd(:,constitutive_titanmod_slipSystemLattice(s2,instance),structID))) - enddo; enddo + constitutive_titanmod_forestProjectionScrew(s1,s2,instance) = & + abs(math_mul3x3(lattice_sn(:,constitutive_titanmod_slipSystemLattice(s1,instance),phase), & + lattice_sd(:,constitutive_titanmod_slipSystemLattice(s2,instance),phase))) + enddo; enddo !-------------------------------------------------------------------------------------------------- ! calculation of forest projections for edge dislocations in twin system - do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) - constitutive_titanmod_TwinforestProjectionEdge(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,instance),structID), & - lattice_tt(:,constitutive_titanmod_twinSystemLattice(t2,instance),structID))) + do t1 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + do t2 = 1_pInt,constitutive_titanmod_totalNtwin(instance) + constitutive_titanmod_TwinforestProjectionEdge(t1,t2,instance) = & + abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,instance),phase), & + lattice_tt(:,constitutive_titanmod_twinSystemLattice(t2,instance),phase))) !-------------------------------------------------------------------------------------------------- ! calculation of forest projections for screw dislocations in twin system - constitutive_titanmod_TwinforestProjectionScrew(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,instance),structID), & - lattice_td(:,constitutive_titanmod_twinSystemLattice(t2,instance),structID))) - enddo; enddo + constitutive_titanmod_TwinforestProjectionScrew(t1,t2,instance) = & + abs(math_mul3x3(lattice_tn(:,constitutive_titanmod_twinSystemLattice(t1,instance),phase), & + lattice_td(:,constitutive_titanmod_twinSystemLattice(t2,instance),phase))) + enddo; enddo - enddo instancesLoop + endif + enddo initializeInstances end subroutine constitutive_titanmod_init @@ -1050,13 +977,15 @@ end subroutine constitutive_titanmod_init !-------------------------------------------------------------------------------------------------- !> @brief sets the initial microstructural state for a given instance of this plasticity !-------------------------------------------------------------------------------------------------- -pure function constitutive_titanmod_stateInit(instance) +pure function constitutive_titanmod_stateInit(instance,phase) use lattice, only: & lattice_maxNslipFamily, & - lattice_maxNtwinFamily + lattice_maxNtwinFamily, & + lattice_mu implicit none integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity + integer(pInt), intent(in) :: phase !< number specifying the phase of the plasticity real(pReal), dimension(constitutive_titanmod_sizeState(instance)) :: & constitutive_titanmod_stateInit @@ -1114,11 +1043,11 @@ pure function constitutive_titanmod_stateInit(instance) sqrt(dot_product((rho_edge0),constitutive_titanmod_forestProjectionEdge(1:ns,s,instance))+ & dot_product((rho_screw0),constitutive_titanmod_forestProjectionScrew(1:ns,s,instance))) resistance_edge0(s) = & - constitutive_titanmod_Gmod(instance)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & + lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & dot_product((rho_screw0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))) resistance_screw0(s) = & - constitutive_titanmod_Gmod(instance)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & + lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)* & sqrt(dot_product((rho_edge0),constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))+ & dot_product((rho_screw0), constitutive_titanmod_interactionMatrix_ss(1:ns,s,instance))) end forall @@ -1169,6 +1098,8 @@ pure function constitutive_titanmod_homogenizedC(state,ipc,ip,el) homogenization_maxNgrains, & material_phase, & phase_plasticityInstance + use lattice, only: & + lattice_C66 implicit none real(pReal), dimension(6,6) :: & @@ -1182,6 +1113,7 @@ implicit none real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & volumefraction_PerTwinSys integer(pInt) :: & + phase, & instance, & ns, nt, & i @@ -1190,7 +1122,8 @@ real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance !-------------------------------------------------------------------------------------------------- ! shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) @@ -1204,11 +1137,11 @@ real(pReal), dimension(constitutive_titanmod_totalNtwin(phase_plasticityInstance !-------------------------------------------------------------------------------------------------- ! homogenized elasticity matrix - constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*constitutive_titanmod_Cslip_66(1:6,1:6,instance) + constitutive_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,phase) do i=1_pInt,nt constitutive_titanmod_homogenizedC = constitutive_titanmod_homogenizedC & + volumefraction_PerTwinSys(i)*& - constitutive_titanmod_Ctwin_66(1:6,1:6,i,instance) + constitutive_titanmod_Ctwin66(1:6,1:6,i,instance) enddo end function constitutive_titanmod_homogenizedC @@ -1227,6 +1160,8 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) homogenization_maxNgrains, & material_phase,& phase_plasticityInstance + use lattice, only: & + lattice_mu implicit none integer(pInt), intent(in) :: & @@ -1239,9 +1174,9 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) state !< microstructure state integer(pInt) :: & - instance, structID, & + instance, & ns, nt, s, t, & - i + i, phase real(pReal) :: & sumf, & sfe ! stacking fault energy @@ -1250,8 +1185,8 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- !Shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_titanmod_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) @@ -1288,7 +1223,7 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) ! threshold stress or slip resistance for edge dislocation motion forall (s = 1_pInt:ns) & state(ipc,ip,el)%p(5_pInt*ns+nt+s) = & - constitutive_titanmod_Gmod(instance)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& + lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& sqrt(dot_product((state(ipc,ip,el)%p(1:ns)),& constitutive_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & dot_product((state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),& @@ -1297,7 +1232,7 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) ! threshold stress or slip resistance for screw dislocation motion forall (s = 1_pInt:ns) & state(ipc,ip,el)%p(6_pInt*ns+nt+s) = & - constitutive_titanmod_Gmod(instance)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& + lattice_mu(phase)*constitutive_titanmod_burgersPerSlipSys(s,instance)*& sqrt(dot_product((state(ipc,ip,el)%p(1:ns)),& constitutive_titanmod_interactionMatrix_es(1:ns,s,instance))+ & dot_product((state(ipc,ip,el)%p(ns+1_pInt:2_pInt*ns)),& @@ -1306,7 +1241,7 @@ subroutine constitutive_titanmod_microstructure(temperature,state,ipc,ip,el) ! threshold stress or slip resistance for dislocation motion in twin forall (t = 1_pInt:nt) & state(ipc,ip,el)%p(7_pInt*ns+nt+t) = & - constitutive_titanmod_Gmod(instance)*constitutive_titanmod_burgersPerTwinSys(t,instance)*& + lattice_mu(phase)*constitutive_titanmod_burgersPerTwinSys(t,instance)*& (dot_product((abs(state(ipc,ip,el)%p(2_pInt*ns+1_pInt:2_pInt*ns+nt))),& constitutive_titanmod_interactionMatrixTwinTwin(1:nt,t,instance))) @@ -1331,7 +1266,9 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& lattice_maxNslipFamily, & lattice_maxNtwinFamily, & lattice_NslipSystem, & - lattice_NtwinSystem + lattice_NtwinSystem, & + lattice_structure, & + LATTICE_hex_ID use mesh, only: & mesh_NcpElems, & mesh_maxNips @@ -1357,7 +1294,7 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(inout) :: & state !< microstructure state integer(pInt) :: & - index_myFamily, instance,structID, & + index_myFamily, instance,phase, & ns,nt, & f,i,j,k,l,m,n real(pReal) :: sumf, & @@ -1375,8 +1312,8 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& !-------------------------------------------------------------------------------------------------- ! shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_titanmod_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) @@ -1400,14 +1337,14 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& dgdot_dtauslip = 0.0_pReal j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,structID)) - if(structID==3_pInt) then ! only for prismatic and pyr systems in hex + tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,phase)) + if(lattice_structure(phase)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex screwvelocity_prefactor=constitutive_titanmod_debyefrequency(instance)* & state(ipc,ip,el)%p(4_pInt*ns+nt+j)*(constitutive_titanmod_burgersPerSlipSys(j,instance)/ & constitutive_titanmod_kinkcriticallength_PerSlipSys(j,instance))**2 @@ -1529,14 +1466,14 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& !************************************************* !sumf=0.0_pReal !* Plastic velocity gradient for dislocation glide - Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,structID) + Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtauslip(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,structID)*& - lattice_Sslip(m,n,1,index_myFamily+i,structID) + lattice_Sslip(k,l,1,index_myFamily+i,phase)*& + lattice_Sslip(m,n,1,index_myFamily+i,phase) enddo enddo slipFamiliesLoop @@ -1545,13 +1482,13 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& dgdot_dtautwin = 0.0_pReal j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Ntwin(f,instance) ! process each (active) slip system in family j = j+1_pInt !* Calculation of Lp !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) !************************************************************************************** !* Stress ratios @@ -1560,7 +1497,7 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& !* Shear rates and their derivatives due to twin ! if ( tau_twin(j) > 0.0_pReal ) !then ! gdot_twin(j) = 0.0_pReal!& -! (constitutive_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,structID)*& +! (constitutive_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,phase)*& ! state(ipc,ip,el)%p(6*ns+4*nt+j)*constitutive_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) ! dgdot_dtautwin(j) = ((gdot_twin(j)*constitutive_titanmod_r(instance))/tau_twin(j))*StressRatio_r ! endif @@ -1609,15 +1546,15 @@ subroutine constitutive_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,& ) !* sign(1.0_pReal,tau_slip(j)) !* Plastic velocity gradient for mechanical twinning -! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID) - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,structID) +! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) + Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,phase) !* Calculation of the tangent of Lp forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = & dLp_dTstar3333(k,l,m,n) + dgdot_dtautwin(j)*& - lattice_Stwin(k,l,index_myFamily+i,structID)*& - lattice_Stwin(m,n,index_myFamily+i,structID) + lattice_Stwin(k,l,index_myFamily+i,phase)*& + lattice_Stwin(m,n,index_myFamily+i,phase) enddo enddo twinFamiliesLoop @@ -1661,7 +1598,7 @@ implicit none constitutive_titanmod_dotState integer(pInt) :: & - index_myFamily, instance,structID, & + index_myFamily, instance,phase, & ns,nt,& f,i,j real(pReal) :: & @@ -1679,8 +1616,8 @@ implicit none !-------------------------------------------------------------------------------------------------- ! shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_titanmod_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) @@ -1696,7 +1633,7 @@ implicit none j = 0_pInt slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Nslip(f,instance) ! process each (active) slip system in family j = j+1_pInt @@ -1722,12 +1659,12 @@ implicit none !* Twin fraction evolution j = 0_pInt twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,structID)) ! at which index starts my family + index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) ! at which index starts my family do i = 1_pInt,constitutive_titanmod_Ntwin(f,instance) ! process each (active) twin system in family j = j+1_pInt !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,structID)) + tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,phase)) !* Stress ratio for edge twinStressRatio_p = ((abs(tau_twin(j)))/ & @@ -1781,7 +1718,7 @@ pure function constitutive_titanmod_postResults(state,ipc,ip,el) constitutive_titanmod_postResults integer(pInt) :: & - instance, structID,& + instance, phase,& ns,nt,& o,i,c real(pReal) :: sumf @@ -1791,8 +1728,8 @@ pure function constitutive_titanmod_postResults(state,ipc,ip,el) !-------------------------------------------------------------------------------------------------- ! shortened notation - instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - structID = constitutive_titanmod_structure(instance) + phase = material_phase(ipc,ip,el) + instance = phase_plasticityInstance(phase) ns = constitutive_titanmod_totalNslip(instance) nt = constitutive_titanmod_totalNtwin(instance) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 8c53187d0..3021234f9 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -40,8 +40,6 @@ module crystallite crystallite_sizePostResults !< description not available integer(pInt), dimension(:,:), allocatable, private :: & crystallite_sizePostResult !< description not available - integer(pInt), dimension(:,:,:), allocatable, private :: & - crystallite_symmetryID !< crystallographic symmetry 1=cubic 2=hexagonal, needed in all orientation calcs real(pReal), dimension(:,:), allocatable, public :: & crystallite_temperature !< temperature (same on all components on one IP) @@ -189,16 +187,9 @@ subroutine crystallite_init(temperature) IO_EOF use material use lattice, only: & - lattice_symmetryType, & - lattice_structureID + lattice_structure use constitutive, only: & constitutive_microstructure - use constitutive_dislotwin, only: & - constitutive_dislotwin_structureID - use constitutive_titanmod, only: & - constitutive_titanmod_structureID - use constitutive_nonlocal, only: & - constitutive_nonlocal_structureID implicit none real(pReal), intent(in) :: temperature @@ -220,9 +211,8 @@ subroutine crystallite_init(temperature) j, & p, & output = 0_pInt, & - mySize, & - myPhase, & - myMat + mySize + character(len=65536) :: & tag = '', & line= '' @@ -272,7 +262,6 @@ subroutine crystallite_init(temperature) allocate(crystallite_orientation0(4,gMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_rotation(4,gMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_disorientation(4,nMax,gMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_symmetryID(gMax,iMax,eMax), source=0_pInt) allocate(crystallite_localPlasticity(gMax,iMax,eMax), source=.true.) allocate(crystallite_requested(gMax,iMax,eMax), source=.false.) allocate(crystallite_todo(gMax,iMax,eMax), source=.false.) @@ -434,33 +423,6 @@ subroutine crystallite_init(temperature) crystallite_partionedF0 = crystallite_F0 crystallite_partionedF = crystallite_F0 -!-------------------------------------------------------------------------------------------------- -! Initialize crystallite_symmetryID - do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do g = 1_pInt,myNgrains - myPhase = material_phase(g,i,e) - myMat = phase_plasticityInstance(myPhase) - select case (phase_plasticity(myPhase)) - case (PLASTICITY_PHENOPOWERLAW_ID) - 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)) - case (PLASTICITY_DISLOTWIN_ID) - crystallite_symmetryID(g,i,e) = & - lattice_symmetryType(constitutive_dislotwin_structureID(myMat)) - case (PLASTICITY_NONLOCAL_ID) - crystallite_symmetryID(g,i,e) = & - lattice_symmetryType(constitutive_nonlocal_structureID(myMat)) - case default - crystallite_symmetryID(g,i,e) = 0_pInt !< @ToDo: does this happen for j2 material? - end select - enddo - enddo - enddo - call crystallite_orientations() crystallite_orientation0 = crystallite_orientation ! store initial orientations for calculation of grain rotations @@ -496,7 +458,6 @@ subroutine crystallite_init(temperature) write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF: ', shape(crystallite_subF) - write(6,'(a35,1x,7(i8,1x))') 'crystallite_symmetryID: ', shape(crystallite_symmetryID) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subF0: ', shape(crystallite_subF0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFe0: ', shape(crystallite_subFe0) write(6,'(a35,1x,7(i8,1x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) @@ -3060,7 +3021,6 @@ logical function crystallite_integrateStress(& logical error ! flag indicating an error integer(pInt) NiterationStress, & ! number of stress integrations ierr, & ! error indicator for LAPACK - n, & o, & p, & jacoCounter ! counter to check for Jacobian update @@ -3342,7 +3302,8 @@ subroutine crystallite_orientations FE_geomtype, & FE_celltype use lattice, only: & - lattice_qDisorientation + lattice_qDisorientation, & + lattice_structure use constitutive_nonlocal, only: & constitutive_nonlocal_structure, & constitutive_nonlocal_updateCompatibility @@ -3387,8 +3348,7 @@ subroutine crystallite_orientations orientation = math_RtoQ(transpose(R)) endif crystallite_rotation(1:4,g,i,e) = lattice_qDisorientation(crystallite_orientation0(1:4,g,i,e), & ! active rotation from ori0 - orientation, & ! to current orientation - 0_pInt ) ! we don't want symmetry here + orientation) ! to current orientation (with no symmetry) crystallite_orientation(1:4,g,i,e) = orientation enddo enddo @@ -3406,9 +3366,7 @@ subroutine crystallite_orientations myPhase = material_phase(1,i,e) ! get my phase if (.not. phase_localPlasticity(myPhase)) then ! if nonlocal model myInstance = phase_plasticityInstance(myPhase) - myStructure = constitutive_nonlocal_structure(myInstance) ! get my crystal structure - ! --- calculate disorientation between me and my neighbor --- do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) ! loop through my neighbors @@ -3423,7 +3381,7 @@ subroutine crystallite_orientations crystallite_disorientation(:,n,1,i,e) = & lattice_qDisorientation( crystallite_orientation(1:4,1,i,e), & crystallite_orientation(1:4,1,neighboring_i,neighboring_e), & - crystallite_symmetryID(1,i,e)) ! calculate disorientation + lattice_structure(myPhase)) ! calculate disorientation for given symmetry else ! for neighbor with different phase crystallite_disorientation(:,n,1,i,e) = [0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal] ! 180 degree rotation about 100 axis endif diff --git a/code/lattice.f90 b/code/lattice.f90 index d7dff371e..2894eac3b 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -22,6 +22,7 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief defines lattice structure definitions, slip and twin system definitions, Schimd matrix !> calculation and non-Schmid behavior !-------------------------------------------------------------------------------------------------- @@ -75,24 +76,14 @@ module lattice real(pReal), allocatable, dimension(:,:), protected, public :: & lattice_shearTwin !< characteristic twin shear - - integer(pInt), private :: & - lattice_Nhexagonal, & !< total # of hexagonal lattice structure (from tag CoverA_ratio) - lattice_Nstructure !< total # of lattice structures (1: fcc,2: bcc,3+: hexagonal) - - integer(pInt), dimension(:,:), pointer, private :: & - interactionSlipSlip, & - interactionSlipTwin, & - interactionTwinSlip, & - interactionTwinTwin integer(pInt), allocatable, dimension(:), protected, public :: & lattice_NnonSchmid !< total # of non-Schmid contributions for each structure !-------------------------------------------------------------------------------------------------- -! fcc (1) +! fcc integer(pInt), dimension(lattice_maxNslipFamily), parameter, public :: & - lattice_fcc_NslipSystem = int([12, 0, 0, 0, 0, 0],pInt) !< total # of slip systems per family for fcc + LATTICE_fcc_NslipSystem = int([12, 0, 0, 0, 0, 0],pInt) !< total # of slip systems per family for fcc integer(pInt), dimension(lattice_maxNtwinFamily), parameter, public :: & lattice_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< total # of twin systems per family for fcc @@ -102,9 +93,6 @@ module lattice lattice_fcc_Ntwin = 12_pInt, & ! sum(lattice_fcc_NtwinSystem) !< total # of twin systems for fcc lattice_fcc_NnonSchmid = 0_pInt !< total # of non-Schmid contributions for fcc - integer(pInt), private :: & - lattice_fcc_Nstructure = 0_pInt - real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter, private :: & lattice_fcc_systemSlip = reshape(real([& ! Slip direction Plane normal @@ -142,7 +130,7 @@ module lattice lattice_fcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) !< Twin system <112>{111} ??? Sorted according to Eisenlohr & Hantcherli integer(pInt), dimension(2_pInt,lattice_fcc_Ntwin), parameter, public :: & - lattice_fcc_corellationTwinSlip = reshape(int( [& + lattice_fcc_twinNucleationSlipPair = reshape(int( [& 2,3, & 1,3, & 1,2, & @@ -157,7 +145,7 @@ module lattice 10,11 & ],pInt),[2_pInt,lattice_fcc_Ntwin]) - integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Nslip), target, public :: & + integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Nslip), parameter, public :: & lattice_fcc_interactionSlipSlip = reshape(int( [& 1,2,2,4,6,5,3,5,5,4,5,6, & ! ---> slip 2,1,2,6,4,5,5,4,6,5,3,5, & ! | @@ -178,7 +166,7 @@ module lattice !< 4: Hirth locks !< 5: glissile junctions !< 6: Lomer locks - integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin), target, public :: & + integer(pInt), dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin), parameter, public :: & lattice_fcc_interactionSlipTwin = reshape(int( [& 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin 1,1,1,3,3,3,3,3,3,2,2,2, & ! | @@ -196,10 +184,10 @@ module lattice !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction - integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip), target, public :: & + integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip), parameter, public :: & lattice_fcc_interactionTwinSlip = 0_pInt !< Twin--Slip interaction types for fcc - integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin), target, public :: & + integer(pInt), dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin), parameter,public :: & lattice_fcc_interactionTwinTwin = reshape(int( [& 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin 1,1,1,2,2,2,2,2,2,2,2,2, & ! | @@ -218,7 +206,7 @@ module lattice !-------------------------------------------------------------------------------------------------- -! bcc (2) +! bcc integer(pInt), dimension(lattice_maxNslipFamily), parameter, public :: & lattice_bcc_NslipSystem = int([ 12, 12, 0, 0, 0, 0], pInt) !< total # of slip systems per family for bcc @@ -230,9 +218,6 @@ module lattice lattice_bcc_Ntwin = 12_pInt, & ! sum(lattice_bcc_NtwinSystem) !< total # of twin systems for bcc lattice_bcc_NnonSchmid = 6_pInt !< # of non-Schmid contributions for bcc. 6 known non schmid contributions for BCC (A. Koester, A. Ma, A. Hartmaier 2012) - integer(pInt), private :: & - lattice_bcc_Nstructure = 0_pInt - real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter, private :: & lattice_bcc_systemSlip = reshape(real([& ! Slip direction Plane normal @@ -309,7 +294,7 @@ module lattice real(pReal), dimension(lattice_bcc_Ntwin), parameter, private :: & lattice_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) - integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Nslip), target, public :: & + integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Nslip), parameter, public :: & lattice_bcc_interactionSlipSlip = reshape(int( [& 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | @@ -343,7 +328,7 @@ module lattice !< 4: mixed-asymmetrical junction !< 5: mixed-symmetrical junction !< 6: edge junction - integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin), target, public :: & + integer(pInt), dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin), parameter, public :: & lattice_bcc_interactionSlipTwin = reshape(int( [& 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin 3,3,2,3,3,2,3,3,2,3,3,3, & ! | @@ -374,10 +359,10 @@ module lattice !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction - integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip), target, public :: & + integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip), parameter, public :: & lattice_bcc_interactionTwinSlip = 0_pInt !< Twin--slip interaction types for bcc @todo not implemented yet - integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin), target, public :: & + integer(pInt), dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin), parameter, public :: & lattice_bcc_interactionTwinTwin = reshape(int( [& 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin 3,1,3,3,3,3,2,3,3,3,3,2, & ! | @@ -398,7 +383,7 @@ module lattice !-------------------------------------------------------------------------------------------------- -! hex (3+) +! hex integer(pInt), dimension(lattice_maxNslipFamily), parameter, public :: & lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6],pInt) !< # of slip systems per family for hex @@ -409,9 +394,6 @@ module lattice lattice_hex_Nslip = 33_pInt, & ! sum(lattice_hex_NslipSystem), !< total # of slip systems for hex lattice_hex_Ntwin = 24_pInt, & ! sum(lattice_hex_NtwinSystem) !< total # of twin systems for hex lattice_hex_NnonSchmid = 0_pInt !< # of non-Schmid contributions for hex - - integer(pInt), private :: & - lattice_hex_Nstructure = 0_pInt real(pReal), dimension(4+4,lattice_hex_Nslip), parameter, private :: & lattice_hex_systemSlip = reshape(real([& @@ -517,7 +499,7 @@ module lattice 4 & ],pInt),[lattice_hex_Ntwin]) - integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Nslip), target, public :: & + integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Nslip), parameter, public :: & lattice_hex_interactionSlipSlip = reshape(int( [& 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | @@ -560,7 +542,7 @@ module lattice ! ],pInt),[lattice_hex_Nslip,lattice_hex_Nslip],order=[2,1]) !< Slip--slip interaction types for hex (32? in total) - integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Ntwin), target, public :: & + integer(pInt), dimension(lattice_hex_Nslip,lattice_hex_Ntwin), parameter, public :: & lattice_hex_interactionSlipTwin = reshape(int( [& 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | @@ -603,7 +585,7 @@ module lattice ! ],pInt),[lattice_hex_Nslip,lattice_hex_Ntwin],order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) - integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Nslip), target, public :: & + integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Nslip), parameter, public :: & lattice_hex_interactionTwinSlip = reshape(int( [& 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | @@ -634,7 +616,7 @@ module lattice 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & ],pInt),[lattice_hex_Ntwin,lattice_hex_Nslip],order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) - integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Ntwin), target, public :: & + integer(pInt), dimension(lattice_hex_Ntwin,lattice_hex_Ntwin), parameter, public :: & lattice_hex_interactionTwinTwin = reshape(int( [& 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! ---> twin 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | @@ -664,6 +646,13 @@ module lattice 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin],order=[2,1]) !< Twin--slip interaction types for hex (isotropic, 16 in total) + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + lattice_C66 + real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & + lattice_C3333 + real(pReal), dimension(:), allocatable, public, protected :: & + lattice_mu, & + lattice_nu enum, bind(c) enumerator :: LATTICE_undefined_ID, & LATTICE_iso_ID, & @@ -672,12 +661,8 @@ 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 + lattice_structure integer(pInt), dimension(2), parameter, private :: & @@ -789,26 +774,12 @@ real(pReal), dimension(4,36), parameter, private :: & ! [ 1.0,0.0,0.0,0.0 ], ! ] - character(len=*), parameter, public :: & - LATTICE_iso_label = 'iso', & - LATTICE_fcc_label = 'fcc', & - LATTICE_bcc_label = 'bcc', & - LATTICE_hex_label = 'hex', & - LATTICE_ort_label = 'ort' - public :: & lattice_init, & - lattice_initializeStructure, & - lattice_symmetryType, & - lattice_symmetrizeC66, & - lattice_configNchunks, & lattice_qDisorientation, & - LATTICE_undefined_ID, & - LATTICE_iso_ID, & LATTICE_fcc_ID, & LATTICE_bcc_ID, & - LATTICE_hex_ID, & - LATTICE_ort_ID + LATTICE_hex_ID contains @@ -844,23 +815,17 @@ 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 = '' + integer(pInt) :: Nphases 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 + real(pReal), dimension(:), allocatable :: CoverA !< c/a ratio for hex type lattice write(6,'(/,a)') ' <<<+- lattice init -+>>>' write(6,'(a)') ' $Id$' @@ -897,15 +862,40 @@ subroutine lattice_init ! read from material configuration file if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... 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 + Nphases = IO_countSections(FILEUNIT,material_partPhase) - 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) + allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) + allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) + allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) + allocate(lattice_mu(Nphases), source=0.0_pReal) + allocate(lattice_nu(Nphases), source=0.0_pReal) + allocate(lattice_NnonSchmid(Nphases), source=0_pInt) + allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_sn(3,lattice_maxNslip,Nphases),source=0.0_pReal) + + allocate(lattice_Qtwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) + allocate(lattice_Stwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) + allocate(lattice_Stwin_v(6,lattice_maxNtwin,Nphases),source=0.0_pReal) + allocate(lattice_td(3,lattice_maxNtwin,Nphases),source=0.0_pReal) + allocate(lattice_tt(3,lattice_maxNtwin,Nphases),source=0.0_pReal) + allocate(lattice_tn(3,lattice_maxNtwin,Nphases),source=0.0_pReal) + + allocate(lattice_shearTwin(lattice_maxNtwin,Nphases),source=0.0_pReal) + + allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) + allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,Nphases),source=0_pInt) + + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt)! other:me + allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,Nphases),source=0_pInt)! other:me + allocate(lattice_interactionTwinSlip(lattice_maxNtwin,lattice_maxNslip,Nphases),source=0_pInt)! other:me + allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,Nphases),source=0_pInt)! other:me + + allocate(CoverA(Nphases),source=0.0_pReal) rewind(fileUnit) line = '' ! to have it initialized section = 0_pInt ! - " - @@ -928,80 +918,52 @@ subroutine lattice_init 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 + select case(trim(IO_lc(IO_stringValue(line,positions,2_pInt)))) + case('iso','isotropic') + lattice_structure(section) = LATTICE_iso_ID + case('fcc') + lattice_structure(section) = LATTICE_fcc_ID + case('bcc') + lattice_structure(section) = LATTICE_bcc_ID + case('hex','hexagonal') + lattice_structure(section) = LATTICE_hex_ID + case('ort','orthorombic') + lattice_structure(section) = LATTICE_ort_ID case default - !there should be an error here + !there will be an error here end select case ('c11') - - lattice_Cslip_66(1,1,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,1,section) = IO_floatValue(line,positions,2_pInt) case ('c12') - lattice_Cslip_66(1,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,2,section) = IO_floatValue(line,positions,2_pInt) case ('c13') - lattice_Cslip_66(1,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(1,3,section) = IO_floatValue(line,positions,2_pInt) case ('c22') - lattice_Cslip_66(2,2,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(2,2,section) = IO_floatValue(line,positions,2_pInt) case ('c23') - lattice_Cslip_66(2,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(2,3,section) = IO_floatValue(line,positions,2_pInt) case ('c33') - lattice_Cslip_66(3,3,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(3,3,section) = IO_floatValue(line,positions,2_pInt) case ('c44') - lattice_Cslip_66(4,4,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(4,4,section) = IO_floatValue(line,positions,2_pInt) case ('c55') - lattice_Cslip_66(5,5,section) = IO_floatValue(line,positions,2_pInt) + lattice_C66(5,5,section) = IO_floatValue(line,positions,2_pInt) case ('c66') - lattice_Cslip_66(6,6,section) = IO_floatValue(line,positions,2_pInt) - case ('covera_ratio') + lattice_C66(6,6,section) = IO_floatValue(line,positions,2_pInt) + case ('covera_ratio','c/a_ratio','c/a') CoverA(section) = IO_floatValue(line,positions,2_pInt) + if (CoverA(section) < 1.0_pReal .or. CoverA(section) > 2.0_pReal) call IO_error(206_pInt) ! checking physical significance of c/a 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 + write(6,'(a16,1x,i5)') ' # phases:',Nphases endif - 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),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),source= 0.0_pReal) - - 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), 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 - lattice_Cslip_66(1:6,1:6,i) = lattice_symmetrizeC66(lattice_structureID(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 + do i = 1_pInt,Nphases + call lattice_initializeStructure(i, CoverA(i)) + enddo deallocate(CoverA) @@ -1011,7 +973,9 @@ end subroutine lattice_init !-------------------------------------------------------------------------------------------------- !> @brief Calculation of Schmid matrices, etc. !-------------------------------------------------------------------------------------------------- -integer(pInt) function lattice_initializeStructure(struct_ID,CoverA) +subroutine lattice_initializeStructure(myPhase,CoverA) + use prec, only: & + tol_math_check use math, only: & math_vectorproduct, & math_tensorproduct, & @@ -1020,72 +984,74 @@ integer(pInt) function lattice_initializeStructure(struct_ID,CoverA) math_trace33, & math_symmetric33, & math_Mandel33to6, & + math_Mandel3333to66, & + math_Voigt66to3333, & math_axisAngleToR, & INRAD use IO, only: & IO_error implicit none - integer(kind(LATTICE_fcc_ID)), intent(in) :: struct_ID + integer(pInt), intent(in) :: myPhase real(pReal), intent(in) :: CoverA - real(pReal), dimension(3) :: sdU = 0.0_pReal, & - snU = 0.0_pReal, & - np = 0.0_pReal, & - nn = 0.0_pReal - real(pReal), dimension(3,lattice_maxNslip) :: sd = 0.0_pReal, & - sn = 0.0_pReal - real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: sns = 0.0_pReal - real(pReal), dimension(3,lattice_maxNtwin) :: td = 0.0_pReal, & - tn = 0.0_pReal - real(pReal), dimension(lattice_maxNtwin) :: ts = 0.0_pReal - integer(pInt), dimension(lattice_maxNslipFamily) :: myNslipSystem = 0_pInt - integer(pInt), dimension(lattice_maxNtwinFamily) :: myNtwinSystem = 0_pInt - integer(pInt) :: i,j,myNslip,myNtwin,myStructure = 0_pInt - logical :: processMe - processMe = .false. + real(pReal), dimension(3) :: & + sdU, snU, & + np, nn + real(pReal), dimension(3,lattice_maxNslip) :: & + sd, sn + real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: & + sns + real(pReal), dimension(3,lattice_maxNtwin) :: & + td, tn + real(pReal), dimension(lattice_maxNtwin) :: & + ts + integer(pInt) :: & + i,j, & + myNslip, myNtwin - select case(struct_ID) + lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),lattice_C66(1:6,1:6,myPhase)) + lattice_mu(myPhase) = 0.2_pReal * (lattice_C66(1,1,myPhase) - lattice_C66(1,2,myPhase) + 3.0_pReal*lattice_C66(4,4,myPhase)) ! (C11iso-C12iso)/2 with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 + lattice_nu(myPhase) = (lattice_C66(1,1,myPhase) + 4.0_pReal*lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase)) & + / (4.0_pReal*lattice_C66(1,1,myPhase) + 6.0_pReal*lattice_C66(1,2,myPhase) + 2.0_pReal*lattice_C66(4,4,myPhase)) ! C12iso/(C11iso+C12iso) with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 + lattice_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(lattice_C66(1:6,1:6,myPhase)) ! Literature data is Voigt + lattice_C66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel + + + select case(lattice_structure(myPhase)) +!-------------------------------------------------------------------------------------------------- +! fcc case (LATTICE_fcc_ID) - myStructure = 1_pInt - myNslipSystem = lattice_fcc_NslipSystem ! size of slip system families - myNtwinSystem = lattice_fcc_NtwinSystem ! size of twin system families - myNslip = lattice_fcc_Nslip ! overall number of slip systems - myNtwin = lattice_fcc_Ntwin ! overall number of twin systems - lattice_fcc_Nstructure = lattice_fcc_Nstructure + 1_pInt ! count fcc instances - if (lattice_fcc_Nstructure == 1_pInt) then ! me is first fcc structure - processMe = .true. - lattice_NnonSchmid(myStructure) = lattice_fcc_NnonSchmid ! Currently no known non Schmid contributions for FCC (to be changed later) - do i = 1_pInt,myNslip ! assign slip system vectors + myNslip = lattice_fcc_Nslip + myNtwin = lattice_fcc_Ntwin + do i = 1_pInt,lattice_fcc_Nslip ! assign slip system vectors sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) - do j = 1_pInt,lattice_fcc_NnonSchmid - sns(1:3,1:3,1,j,i) = 0.0_pReal - sns(1:3,1:3,2,j,i) = 0.0_pReal enddo - enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears + do i = 1_pInt,lattice_fcc_Ntwin ! assign twin system vectors and shears td(1:3,i) = lattice_fcc_systemTwin(1:3,i) tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) ts(i) = lattice_fcc_shearTwin(i) enddo - interactionSlipSlip => lattice_fcc_interactionSlipSlip - interactionSlipTwin => lattice_fcc_interactionSlipTwin - interactionTwinSlip => lattice_fcc_interactionTwinSlip - interactionTwinTwin => lattice_fcc_interactionTwinTwin - endif + print*, shape(lattice_NslipSystem),shape(lattice_fcc_NslipSystem) + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem + lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_fcc_NtwinSystem + lattice_NnonSchmid(myPhase) = lattice_fcc_NnonSchmid + lattice_interactionSlipSlip(1:lattice_fcc_Nslip,1:lattice_fcc_Nslip,myPhase) = & + lattice_fcc_interactionSlipSlip + lattice_interactionSlipTwin(1:lattice_fcc_Nslip,1:lattice_fcc_Ntwin,myPhase) = & + lattice_fcc_interactionSlipTwin + lattice_interactionTwinSlip(1:lattice_fcc_Ntwin,1:lattice_fcc_Nslip,myPhase) = & + lattice_fcc_interactionTwinSlip + lattice_interactionTwinTwin(1:lattice_fcc_Ntwin,1:lattice_fcc_Ntwin,myPhase) = & + lattice_fcc_interactionTwinTwin +!-------------------------------------------------------------------------------------------------- +! bcc case (LATTICE_bcc_ID) - myStructure = 2_pInt - myNslipSystem = lattice_bcc_NslipSystem ! size of slip system families - myNtwinSystem = lattice_bcc_NtwinSystem ! size of twin system families - myNslip = lattice_bcc_Nslip ! overall number of slip systems - myNtwin = lattice_bcc_Ntwin ! overall number of twin systems - lattice_bcc_Nstructure = lattice_bcc_Nstructure + 1_pInt ! count bcc instances - if (lattice_bcc_Nstructure == 1_pInt) then ! me is first bcc structure - processMe = .true. - lattice_NnonSchmid(myStructure) = lattice_bcc_NnonSchmid - do i = 1_pInt,myNslip ! assign slip system vectors + myNslip = lattice_bcc_Nslip + myNtwin = lattice_bcc_Ntwin + do i = 1_pInt,lattice_bcc_Nslip ! assign slip system vectors sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) sdU = sd(1:3,i) / math_norm3(sd(1:3,i)) @@ -1105,43 +1071,37 @@ integer(pInt) function lattice_initializeStructure(struct_ID,CoverA) sns(1:3,1:3,1,6,i) = math_tensorproduct(sdU, sdU) sns(1:3,1:3,2,6,i) = math_tensorproduct(-sdU, -sdU) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears + do i = 1_pInt,lattice_bcc_Ntwin ! assign twin system vectors and shears td(1:3,i) = lattice_bcc_systemTwin(1:3,i) tn(1:3,i) = lattice_bcc_systemTwin(4:6,i) ts(i) = lattice_bcc_shearTwin(i) enddo - interactionSlipSlip => lattice_bcc_interactionSlipSlip - interactionSlipTwin => lattice_bcc_interactionSlipTwin - interactionTwinSlip => lattice_bcc_interactionTwinSlip - interactionTwinTwin => lattice_bcc_interactionTwinTwin - endif + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem + lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_bcc_NtwinSystem + lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid + lattice_interactionSlipSlip(1:lattice_bcc_Nslip,1:lattice_bcc_Nslip,myPhase) = & + lattice_bcc_interactionSlipSlip + lattice_interactionSlipTwin(1:lattice_bcc_Nslip,1:lattice_bcc_Ntwin,myPhase) = & + lattice_bcc_interactionSlipTwin + lattice_interactionTwinSlip(1:lattice_bcc_Ntwin,1:lattice_bcc_Nslip,myPhase) = & + lattice_bcc_interactionTwinSlip + lattice_interactionTwinTwin(1:lattice_bcc_Ntwin,1:lattice_bcc_Ntwin,myPhase) = & + lattice_bcc_interactionTwinTwin +!-------------------------------------------------------------------------------------------------- +! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) - if (CoverA < 1.0_pReal .or. CoverA > 2.0_pReal) call IO_error(206_pInt) ! checking physical significance of c/a - - lattice_hex_Nstructure = lattice_hex_Nstructure + 1_pInt ! count instances of hex structures - myStructure = 2_pInt + lattice_hex_Nstructure ! 3,4,5,.. for hex - myNslipSystem = lattice_hex_NslipSystem ! size of slip system families - myNtwinSystem = lattice_hex_NtwinSystem ! size of twin system families - myNslip = lattice_hex_Nslip ! overall number of slip systems - myNtwin = lattice_hex_Ntwin ! overall number of twin systems - processMe = .true. - lattice_NnonSchmid(myStructure) = lattice_hex_NnonSchmid ! Currently no known non Schmid contributions for hex (to be changed later) - - ! converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexagonal system (a, b, c) - do i = 1_pInt,myNslip + myNslip = lattice_hex_Nslip + myNtwin = lattice_hex_Ntwin + do i = 1_pInt,lattice_hex_Nslip ! assign slip system vectors sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*(0.5_pReal*sqrt(3.0_pReal)) sd(3,i) = lattice_hex_systemSlip(4,i)*CoverA sn(1,i) = lattice_hex_systemSlip(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA - do j = 1_pInt,lattice_hex_NnonSchmid - sns(1:3,1:3,1,j,i) = 0.0_pReal - sns(1:3,1:3,2,j,i) = 0.0_pReal - enddo - enddo - do i = 1_pInt,myNtwin + enddo + do i = 1_pInt,lattice_hex_Ntwin ! assign twin system vectors and shears td(1,i) = lattice_hex_systemTwin(1,i)*1.5_pReal td(2,i) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*(0.5_pReal*sqrt(3.0_pReal)) td(3,i) = lattice_hex_systemTwin(4,i)*CoverA @@ -1159,100 +1119,99 @@ integer(pInt) function lattice_initializeStructure(struct_ID,CoverA) ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA end select enddo + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem + lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_hex_NtwinSystem + lattice_NnonSchmid(myPhase) = lattice_hex_NnonSchmid + lattice_interactionSlipSlip(1:lattice_hex_Nslip,1:lattice_hex_Nslip,myPhase) = & + lattice_hex_interactionSlipSlip + lattice_interactionSlipTwin(1:lattice_hex_Nslip,1:lattice_hex_Ntwin,myPhase) = & + lattice_hex_interactionSlipTwin + lattice_interactionTwinSlip(1:lattice_hex_Ntwin,1:lattice_hex_Nslip,myPhase) = & + lattice_hex_interactionTwinSlip + lattice_interactionTwinTwin(1:lattice_hex_Ntwin,1:lattice_hex_Ntwin,myPhase) = & + lattice_hex_interactionTwinTwin - interactionSlipSlip => lattice_hex_interactionSlipSlip - interactionSlipTwin => lattice_hex_interactionSlipTwin - interactionTwinSlip => lattice_hex_interactionTwinSlip - interactionTwinTwin => lattice_hex_interactionTwinTwin +!-------------------------------------------------------------------------------------------------- +! orthorombic and isotropic (no crystal plasticity) + case (LATTICE_ort_ID, LATTICE_iso_ID) + myNslip = 0_pInt + myNtwin = 0_pInt + +!-------------------------------------------------------------------------------------------------- +! something went wrong case default - processMe = .false. - myStructure = 0_pInt + print*, 'error' end select - if (processMe) then - if (myStructure > lattice_Nstructure) & - call IO_error(666_pInt,myStructure,ext_msg = 'structure index out of bounds') ! check for memory leakage - do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure - lattice_sd(1:3,i,myStructure) = sd(1:3,i)/math_norm3(sd(1:3,i)) ! make unit vector - lattice_sn(1:3,i,myStructure) = sn(1:3,i)/math_norm3(sn(1:3,i)) ! make unit vector - lattice_st(1:3,i,myStructure) = math_vectorproduct(lattice_sd(1:3,i,myStructure), & - lattice_sn(1:3,i,myStructure)) - lattice_Sslip(1:3,1:3,1,i,myStructure) = math_tensorproduct(lattice_sd(1:3,i,myStructure), & - lattice_sn(1:3,i,myStructure)) - do j = 1_pInt,lattice_NnonSchmid(myStructure) - lattice_Sslip(1:3,1:3,2*j ,i,myStructure) = sns(1:3,1:3,1,j,i) - lattice_Sslip(1:3,1:3,2*j+1,i,myStructure) = sns(1:3,1:3,2,j,i) + + do i = 1_pInt,myNslip ! store slip system vectors and Schmid matrix for my structure + lattice_sd(1:3,i,myPhase) = sd(1:3,i)/math_norm3(sd(1:3,i)) ! make unit vector + lattice_sn(1:3,i,myPhase) = sn(1:3,i)/math_norm3(sn(1:3,i)) ! make unit vector + lattice_st(1:3,i,myPhase) = math_vectorproduct(lattice_sd(1:3,i,myPhase), & + lattice_sn(1:3,i,myPhase)) + lattice_Sslip(1:3,1:3,1,i,myPhase) = math_tensorproduct(lattice_sd(1:3,i,myPhase), & + lattice_sn(1:3,i,myPhase)) + do j = 1_pInt,lattice_NnonSchmid(myPhase) + lattice_Sslip(1:3,1:3,2*j ,i,myPhase) = sns(1:3,1:3,1,j,i) + lattice_Sslip(1:3,1:3,2*j+1,i,myPhase) = sns(1:3,1:3,2,j,i) enddo - do j = 1_pInt,1_pInt+2_pInt*lattice_NnonSchmid(myStructure) - lattice_Sslip_v(1:6,j,i,myStructure) = & - math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myStructure))) + do j = 1_pInt,1_pInt+2_pInt*lattice_NnonSchmid(myPhase) + lattice_Sslip_v(1:6,j,i,myPhase) = & + math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) enddo - if (abs(math_trace33(lattice_Sslip(1:3,1:3,1,i,myStructure))) > 1.0e-8_pReal) & - call IO_error(0_pInt,myStructure,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') + if (abs(math_trace33(lattice_Sslip(1:3,1:3,1,i,myPhase))) > tol_math_check) & + call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_td(1:3,i,myStructure) = td(1:3,i)/math_norm3(td(1:3,i)) ! make unit vector - lattice_tn(1:3,i,myStructure) = tn(1:3,i)/math_norm3(tn(1:3,i)) ! make unit vector - lattice_tt(1:3,i,myStructure) = math_vectorproduct(lattice_td(1:3,i,myStructure), & - lattice_tn(1:3,i,myStructure)) - lattice_Stwin(1:3,1:3,i,myStructure) = math_tensorproduct(lattice_td(1:3,i,myStructure), & - lattice_tn(1:3,i,myStructure)) - lattice_Stwin_v(1:6,i,myStructure) = math_Mandel33to6(math_symmetric33(lattice_Stwin(1:3,1:3,i,myStructure))) - lattice_Qtwin(1:3,1:3,i,myStructure) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) - lattice_shearTwin(i,myStructure) = ts(i) - if (abs(math_trace33(lattice_Stwin(1:3,1:3,i,myStructure))) > 1.0e-8_pReal) & - call IO_error(0_pInt,myStructure,i,0_pInt,ext_msg = 'dilatational twin Schmid matrix') - enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myStructure) = myNslipSystem ! number of slip systems in each family - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myStructure) = myNtwinSystem ! number of twin systems in each family - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myStructure) = interactionSlipSlip(1:myNslip,1:myNslip) - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myStructure) = interactionSlipTwin(1:myNslip,1:myNtwin) - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myStructure) = interactionTwinSlip(1:myNtwin,1:myNslip) - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myStructure) = interactionTwinTwin(1:myNtwin,1:myNtwin) - endif - - lattice_initializeStructure = myStructure ! report my structure index back - -end function lattice_initializeStructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps structure to symmetry type -!> @details fcc(1) and bcc(2) are cubic(1) hex(3+) is hexagonal(2) -!-------------------------------------------------------------------------------------------------- -integer(pInt) pure function lattice_symmetryType(struct_ID) - - implicit none - integer(kind(LATTICE_fcc_ID)), intent(in) :: struct_ID - - select case(struct_ID) - case (LATTICE_fcc_ID,LATTICE_bcc_ID) - lattice_symmetryType = 1_pInt - case (LATTICE_hex_ID) - lattice_symmetryType = 2_pInt - case default - lattice_symmetryType = 0_pInt - end select - - return + lattice_td(1:3,i,myPhase) = td(1:3,i)/math_norm3(td(1:3,i)) ! make unit vector + lattice_tn(1:3,i,myPhase) = tn(1:3,i)/math_norm3(tn(1:3,i)) ! make unit vector + lattice_tt(1:3,i,myPhase) = math_vectorproduct(lattice_td(1:3,i,myPhase), & + lattice_tn(1:3,i,myPhase)) + lattice_Stwin(1:3,1:3,i,myPhase) = math_tensorproduct(lattice_td(1:3,i,myPhase), & + lattice_tn(1:3,i,myPhase)) + lattice_Stwin_v(1:6,i,myPhase) = math_Mandel33to6(math_symmetric33(lattice_Stwin(1:3,1:3,i,myPhase))) + lattice_Qtwin(1:3,1:3,i,myPhase) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) + lattice_shearTwin(i,myPhase) = ts(i) + if (abs(math_trace33(lattice_Stwin(1:3,1:3,i,myPhase))) > tol_math_check) & + call IO_error(301_pInt,myPhase,ext_msg = 'dilatational twin Schmid matrix') + enddo -end function lattice_symmetryType + print*, lattice_Stwin + print*, lattice_C66 + print*, lattice_C3333 + print*, lattice_mu + print*, lattice_nu + print*, lattice_sd + print*, lattice_sn + print*, lattice_st + print*, lattice_sslip + print*, lattice_td + print*, lattice_tn + print*, lattice_tt + print*, lattice_sd + print*, lattice_sn + print*, lattice_stwin + print*, lattice_qtwin + print*, lattice_qtwin + print*, lattice_sheartwin + +end subroutine lattice_initializeStructure !-------------------------------------------------------------------------------------------------- !> @brief Symmetrizes stiffness matrix according to lattice type !-------------------------------------------------------------------------------------------------- -pure function lattice_symmetrizeC66(struct_ID,C66) +pure function lattice_symmetrizeC66(struct,C66) implicit none - integer(kind(LATTICE_fcc_ID)), intent(in) :: struct_ID + integer(kind(LATTICE_undefined_ID)), intent(in) :: struct real(pReal), dimension(6,6), intent(in) :: C66 real(pReal), dimension(6,6) :: lattice_symmetrizeC66 integer(pInt) :: j,k lattice_symmetrizeC66 = 0.0_pReal - select case(struct_ID) + select case(struct) case (LATTICE_iso_ID) forall(k=1_pInt:3_pInt) forall(j=1_pInt:3_pInt) lattice_symmetrizeC66(k,j) = C66(1,2) @@ -1291,6 +1250,8 @@ pure function lattice_symmetrizeC66(struct_ID,C66) lattice_symmetrizeC66(4,4) = C66(4,4) lattice_symmetrizeC66(5,5) = C66(5,5) lattice_symmetrizeC66(6,6) = C66(6,6) + case default + lattice_symmetrizeC66 = C66 end select end function lattice_symmetrizeC66 @@ -1299,25 +1260,25 @@ pure function lattice_symmetrizeC66(struct_ID,C66) !-------------------------------------------------------------------------------------------------- !> @brief figures whether unit quat falls into stereographic standard triangle !-------------------------------------------------------------------------------------------------- -logical pure function lattice_qInSST(Q, symmetryType) +logical pure function lattice_qInSST(Q, struct) use math, only: & math_qToRodrig implicit none real(pReal), dimension(4), intent(in) :: Q ! orientation - integer(pInt), intent(in) :: symmetryType ! Type of crystal symmetry; 1:cubic, 2:hexagonal + integer(kind(LATTICE_undefined_ID)), intent(in) :: struct ! lattice structure real(pReal), dimension(3) :: Rodrig ! Rodrigues vector of Q Rodrig = math_qToRodrig(Q) if (any(Rodrig/=Rodrig)) then lattice_qInSST = .false. else - select case (symmetryType) - case (1_pInt) + select case (struct) + case (LATTICE_bcc_ID,LATTICE_fcc_ID) lattice_qInSST = Rodrig(1) > Rodrig(2) .and. & Rodrig(2) > Rodrig(3) .and. & Rodrig(3) > 0.0_pReal - case (2_pInt) + case (LATTICE_hex_ID) lattice_qInSST = Rodrig(1) > sqrt(3.0_pReal)*Rodrig(2) .and. & Rodrig(2) > 0.0_pReal .and. & Rodrig(3) > 0.0_pReal @@ -1332,103 +1293,67 @@ end function lattice_qInSST !-------------------------------------------------------------------------------------------------- !> @brief calculates the disorientation for 2 unit quaternions !-------------------------------------------------------------------------------------------------- -function lattice_qDisorientation(Q1, Q2, symmetryType) +pure function lattice_qDisorientation(Q1, Q2, struct) use prec, only: & - tol_math_check - use IO, only: & - IO_error + tol_math_check use math, only: & math_qMul, & math_qConj implicit none real(pReal), dimension(4) :: lattice_qDisorientation - real(pReal), dimension(4), intent(in) :: Q1, & ! 1st orientation + real(pReal), dimension(4), intent(in) :: & + Q1, & ! 1st orientation Q2 ! 2nd orientation - integer(pInt), intent(in) :: symmetryType ! Type of crystal symmetry; 1:cubic, 2:hexagonal - -! integer(kind(LATTICE_undefined_ID)), optional, intent(in) :: & ! if given, symmetries between the two orientation will be considered -! struct + integer(kind(LATTICE_undefined_ID)), optional, intent(in) :: & ! if given, symmetries between the two orientation will be considered + struct real(pReal), dimension(4) :: dQ,dQsymA,mis - integer(pInt) :: i,j,k,s - + integer(pInt) :: i,j,k,s,symmetry + integer(kind(LATTICE_undefined_ID)) :: myStruct + +!-------------------------------------------------------------------------------------------------- +! check if a structure with known symmetries is given + if (present(struct)) then + myStruct = struct + select case (struct) + case(LATTICE_fcc_ID,LATTICE_bcc_ID) + symmetry = 1_pInt + case(LATTICE_hex_ID) + symmetry = 2_pInt + case default + symmetry = 0_pInt + end select + else + symmetry = 0_pInt + myStruct = LATTICE_undefined_ID + endif +!-------------------------------------------------------------------------------------------------- +! calculate misorientation, for cubic(1) and hexagonal(2) structure find symmetries dQ = math_qMul(math_qConj(Q1),Q2) lattice_qDisorientation = dQ - select case (symmetryType) - case (0_pInt) - if (lattice_qDisorientation(1) < 0.0_pReal) & - lattice_qDisorientation = -lattice_qDisorientation ! keep omega within 0 to 180 deg + select case(symmetry) case (1_pInt,2_pInt) - s = sum(lattice_NsymOperations(1:symmetryType-1_pInt)) + s = sum(lattice_NsymOperations(1:symmetry-1_pInt)) do i = 1_pInt,2_pInt dQ = math_qConj(dQ) ! switch order of "from -- to" - do j = 1_pInt,lattice_NsymOperations(symmetryType) ! run through first crystal's symmetries + do j = 1_pInt,lattice_NsymOperations(symmetry) ! run through first crystal's symmetries dQsymA = math_qMul(lattice_symOperations(1:4,s+j),dQ) ! apply sym - do k = 1_pInt,lattice_NsymOperations(symmetryType) ! run through 2nd crystal's symmetries + do k = 1_pInt,lattice_NsymOperations(symmetry) ! run through 2nd crystal's symmetries mis = math_qMul(dQsymA,lattice_symOperations(1:4,s+k)) ! apply sym if (mis(1) < 0.0_pReal) & ! want positive angle mis = -mis - if (mis(1)-lattice_qDisorientation(1) > -tol_math_check .and. & - lattice_qInSST(mis,symmetryType)) & - lattice_qDisorientation = mis ! found better one + if (mis(1)-lattice_qDisorientation(1) > -tol_math_check & + .and. lattice_qInSST(mis,LATTICE_undefined_ID)) lattice_qDisorientation = mis ! found better one enddo; enddo; enddo - case default - call IO_error(450_pInt,symmetryType) ! complain about unknown symmetry + case (0_pInt) + if (lattice_qDisorientation(1) < 0.0_pReal) lattice_qDisorientation = -lattice_qDisorientation ! keep omega within 0 to 180 deg end select end function lattice_qDisorientation - -!-------------------------------------------------------------------------------------------------- -!> @brief Number of parameters to expect in material.config section -! NslipFamilies -! NtwinFamilies -! SlipSlipInteraction -! SlipTwinInteraction -! TwinSlipInteraction -! TwinTwinInteraction -! NnonSchmid -!-------------------------------------------------------------------------------------------------- -function lattice_configNchunks(struct_ID) - use prec, only: & - pInt - - implicit none - integer(pInt), dimension(7) :: lattice_configNchunks - integer(kind(LATTICE_fcc_ID)) :: struct_ID - - select case(struct_ID) - case (LATTICE_fcc_ID) - lattice_configNchunks(1) = count(lattice_fcc_NslipSystem > 0_pInt) - lattice_configNchunks(2) = count(lattice_fcc_NtwinSystem > 0_pInt) - lattice_configNchunks(3) = maxval(lattice_fcc_interactionSlipSlip) - lattice_configNchunks(4) = maxval(lattice_fcc_interactionSlipTwin) - lattice_configNchunks(5) = maxval(lattice_fcc_interactionTwinSlip) - lattice_configNchunks(6) = maxval(lattice_fcc_interactionTwinTwin) - lattice_configNchunks(7) = lattice_fcc_NnonSchmid - case (LATTICE_bcc_ID) - lattice_configNchunks(1) = count(lattice_bcc_NslipSystem > 0_pInt) - lattice_configNchunks(2) = count(lattice_bcc_NtwinSystem > 0_pInt) - lattice_configNchunks(3) = maxval(lattice_bcc_interactionSlipSlip) - lattice_configNchunks(4) = maxval(lattice_bcc_interactionSlipTwin) - lattice_configNchunks(5) = maxval(lattice_bcc_interactionTwinSlip) - lattice_configNchunks(6) = maxval(lattice_bcc_interactionTwinTwin) - lattice_configNchunks(7) = lattice_bcc_NnonSchmid - case (LATTICE_hex_ID) - lattice_configNchunks(1) = count(lattice_hex_NslipSystem > 0_pInt) - lattice_configNchunks(2) = count(lattice_hex_NtwinSystem > 0_pInt) - lattice_configNchunks(3) = maxval(lattice_hex_interactionSlipSlip) - lattice_configNchunks(4) = maxval(lattice_hex_interactionSlipTwin) - lattice_configNchunks(5) = maxval(lattice_hex_interactionTwinSlip) - lattice_configNchunks(6) = maxval(lattice_hex_interactionTwinTwin) - lattice_configNchunks(7) = lattice_hex_NnonSchmid - end select - -end function lattice_configNchunks - end module lattice